      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