      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