1  C*************************************************************************
  2  C COPYRIGHT (C) 1999 - 2003  EDF R&D
  3  C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
  4  C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 
  5  C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 
  6  C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
  7  C
  8  C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
  9  C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
 10  C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
 11  C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
 12  C
 13  C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
 14  C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
 15  C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
 16  C
 17  C**************************************************************************
 18
 19  C       ******************************************************************************
 20  C       * - Nom du fichier : test28.f
 21  C       *
 22  C       * - Description : lecture des maillages structures (grille cartesienne |
 23  C       *                 grille de-structuree ) dans le fichier test27.med
 24  C       *
 25  C       *****************************************************************************
 26        program test28
 27  C       
 28          implicit none
 29          include 'med.hf'
 30  C       
 31  C       
 32          integer       cret, fid,i,j
 33  C       ** la dimension du maillage                         **
 34          integer       mdim,nind,nmaa,type,quoi,rep,typmaa
 35  C       ** nom du maillage de longueur maxi MED_TAILLE_NOM  **
 36          character*32  maa
 37  C       ** le nombre de noeuds                              **
 38          integer       nnoe
 39  C       ** table des coordonnees                            **
 40          real*8        coo(8)
 41          character*16  comp, comp2(2)
 42          character*16  unit, unit2(2)
 43          character*200 desc
 44          integer       strgri(2)
 45  C       ** grille cartesienne                               **
 46          integer       axe
 47          real*8        indice(4)
 48          integer tmp
 49
 50  C
 51  C       On ouvre le fichier test27.med en lecture seule
 52          call efouvr(fid,'test27.med',MED_LECTURE, cret)
 53          print *,cret
 54          print *,'Ouverture du fichier test27.med'
 55  C   
 56  C       Combien de maillage ?
 57          if (cret .eq. 0) then
 58              call efnmaa(fid,nmaa,cret)
 59              print *,cret
 60          endif
 61  C
 62  C       On boucle sur les maillages et on ne lit que les
 63  C       maillages structures
 64          if (cret .eq. 0) then
 65  C
 66             do 10 i=1,nmaa
 67  C
 68  C          On repere les maillages qui nous interessent
 69  C
 70                if (cret .eq. 0) then
 71                  call efmaai(fid,i,maa,mdim,typmaa,desc,cret)
 72                  print *,'Maillage de nom : ',maa
 73                  print *,'- Dimension : ',mdim
 74                  if (typmaa .eq. MED_STRUCTURE) then
 75                      print *,'- Type : MED_STRUCTURE'
 76                  else
 77                      print *,'- Type : MED_NON_STRUCTURE'
 78                  endif
 79                  print *,cret
 80                endif
 81  C
 82  C          On repere le type de la grille
 83                if (cret .eq. 0 .and. typmaa .eq. MED_STRUCTURE) then
 84                  call efnagl(fid,maa,type,cret)
 85                  print *,cret
 86                  if (type .eq. MED_GRILLE_CARTESIENNE) then
 87                      print *,'- Nature de la grille : MED_GRILLE_CARTESIE
 88       &                         NNE'
 89                  endif
 90                  if (type .eq. MED_GRILLE_STANDARD) then
 91                     print *,'- Nature de la grille : MED_GRILLE_STANDARD'
 92                  endif
 93                endif
 94  C
 95  C          On regarde la structure et les coordonnees de la grille MED_GRILLE_STANDARD
 96                if ((cret .eq. 0) .and. (type .eq. MED_GRILLE_STANDARD)
 97       &            .and. (typmaa .eq. MED_STRUCTURE)) then
 98  C
 99                  call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret)
100                  print *,cret
101                  print *,'- Nombre de noeuds : ',nnoe
102  C
103                  if (cret .eq. 0) then
104                      call efscol(fid,maa,mdim,strgri,cret)
105                      print *,cret
106                      print *,'- Structure de la grille : ',strgri
107                  endif
108  C
109                  if (cret .eq. 0) then
110                      call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE,MED_ALL,tmp,
111       &                          0,rep,comp2,unit2,cret)
112                      print *,cret
113                      print *,'- Coordonnees :'
114                      do 20 j=1,nnoe*mdim
115                          print *,coo(j)
116   20                continue
117                  endif
118  C
119                endif
120  C
121                if ((cret .eq. 0) .and. (type .eq. MED_GRILLE_CARTESIENNE)
122       &             .and. (typmaa .eq. MED_STRUCTURE)) then
123  C
124                  do 30 axe=1,mdim
125                      if (axe .eq. 1) then
126                          quoi = MED_COOR_IND1
127                      endif
128                      if (axe .eq. 2) then
129                          quoi = MED_COOR_IND2
130                      endif
131                      if (axe .eq. 3) then
132                          quoi = MED_COOR_IND3
133                      endif
134  C                   Lecture de la taille de l'indice selon la dimension
135  C                   fournie par le parametre quoi
136                      if (cret.eq. 0) then
137                          call efnema(fid,maa,quoi,MED_NOEUD,0,0,nind,
138       &                              cret)
139                          print *,cret
140                          print *,'- Axe ',axe
141                          print *,'- Nombre d indices : ',nind
142                      endif
143  C                   Lecture des indices des coordonnees de la grille
144                      if (cret .eq. 0) then
145                          call eficol(fid,maa,mdim,indice,nind,axe,comp,unit,cret)
146                          print *,cret
147                          print *,'- Axe ',comp
148                          print *,'  unite : ',unit
149                          do 40 j=1,nind
150                              print *,indice(j)
151   40                     continue
152                      endif
153   30             continue
154  C
155                endif
156  C
157   10        continue
158  C
159          endif
160  C
161  C       On ferme le fichier
162          call efferm (fid,cret)
163          print *,cret
164          print *,'Fermeture du fichier'
165  C   
166          end