1 C*************************************************************************
  2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
  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         if (cret .ne. 0 ) then
 54            print *,'Erreur ouverture du fichier'
 55            call efexit(-1)
 56         endif
 57         print *,cret
 58 
 59         print *,'Ouverture du fichier test27.med'
 60 C       
 61 C       Combien de maillage ?
 62         call efnmaa(fid,nmaa,cret)
 63         print *,cret
 64         if (cret .ne. 0 ) then
 65            print *,'Erreur lecture du nombre de maillage'
 66            call efexit(-1)
 67         endif
 68 C
 69 C       On boucle sur les maillages et on ne lit que les
 70 C       maillages structures
 71         do 10 i=1,nmaa
 72 C
 73 C          On repere les maillages qui nous interessent
 74 C
 75            call efmaai(fid,i,maa,mdim,typmaa,desc,cret)
 76            print *,cret
 77            if (cret .ne. 0 ) then
 78               print *,'Erreur lecture maillage info'
 79               call efexit(-1)
 80            endif
 81            print *,'Maillage de nom : ',maa
 82            print *,'- Dimension : ',mdim
 83            if (typmaa .eq. MED_STRUCTURE) then
 84               print *,'- Type : MED_STRUCTURE'
 85            else
 86               print *,'- Type : MED_NON_STRUCTURE'
 87            endif
 88 C
 89 C          On repere le type de la grille
 90            if (typmaa .eq. MED_STRUCTURE) then
 91               call efnagl(fid,maa,type,cret)
 92               print *,cret
 93               if (cret .ne. 0 ) then
 94                  print *,'Erreur lecture nature de la grille'
 95                  call efexit(-1)
 96               endif
 97               if (type .eq. MED_GRILLE_CARTESIENNE) then
 98                  print *,'- Nature de la grille :',
 99      &                   'MED_GRILLE_CARTESIENNE'
100               endif
101               if (type .eq. MED_GRILLE_STANDARD) then
102                  print *,'- Nature de la grille : MED_GRILLE_STANDARD'
103               endif
104            endif
105 C
106 C          On regarde la structure et les coordonnees de la grille MED_GRILLE_STANDARD
107            if ((type .eq. MED_GRILLE_STANDARD)
108      &           .and. (typmaa .eq. MED_STRUCTURE)) then
109 C
110               call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret)
111               print *,cret
112               if (cret .ne. 0 ) then
113                  print *,'Erreur lecture nombre de noeud'
114                  call efexit(-1)
115               endif
116               print *,'- Nombre de noeuds : ',nnoe
117 C
118               call efscol(fid,maa,mdim,strgri,cret)
119               print *,cret
120               if (cret .ne. 0 ) then
121                  print *,'Erreur lecture structure de la grille'
122                  call efexit(-1)
123               endif
124               print *,'- Structure de la grille : ',strgri
125 C
126               call efcool(fid,maa,mdim,coo,
127      &                        MED_FULL_INTERLACE,MED_ALL,tmp,
128      &                        0,rep,comp2,unit2,cret)
129               print *,cret
130               if (cret .ne. 0 ) then
131                  print *,'Erreur lecture des coordonnees des noeuds'
132                  call efexit(-1)
133               endif
134               print *,'- Coordonnees :'
135               do 20 j=1,nnoe*mdim
136                  print *,coo(j)
137  20           continue
138            endif
139 C
140            if ((type .eq. MED_GRILLE_CARTESIENNE)
141      &          .and. (typmaa .eq. MED_STRUCTURE)) then
142 C
143               do 30 axe=1,mdim
144                  if (axe .eq. 1) then
145                     quoi = MED_COOR_IND1
146                  endif
147                  if (axe .eq. 2) then
148                     quoi = MED_COOR_IND2
149                  endif
150                  if (axe .eq. 3) then
151                     quoi = MED_COOR_IND3
152                  endif
153 C                Lecture de la taille de l'indice selon la dimension
154 C                fournie par le parametre quoi
155                  call efnema(fid,maa,quoi,MED_NOEUD,0,0,nind,cret)
156                  print *,cret
157                  if (cret .ne. 0 ) then
158                     print *,'Erreur lecture taille indice'
159                     call efexit(-1)
160                  endif      
161                  print *,'- Axe ',axe
162                  print *,'- Nombre d indices : ',nind
163 C                Lecture des indices des coordonnees de la grille
164                  call eficol(fid,maa,mdim,indice,nind,axe,comp,unit,
165      &                       cret)
166                  print *,cret
167                  if (cret .ne. 0 ) then
168                     print *,'Erreur lecture indices de coordonnées'
169                     call efexit(-1)
170                  endif      
171                  print *,'- Axe ',comp
172                  print *,'  unite : ',unit
173                  do 40 j=1,nind
174                     print *,indice(j)
175  40              continue
176  30           continue
177 C
178            endif
179 C
180  10     continue
181 C
182 C       On ferme le fichier
183         call efferm (fid,cret)
184         print *,cret
185         if (cret .ne. 0 ) then
186            print *,'Erreur fermeture du fichier'
187            call efexit(-1)
188         endif      
189         print *,'Fermeture du fichier'
190 C
191         end
192