      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
     20 C ******************************************************************************
     21 C * - Nom du fichier : test32.f
     22 C *
     23 C * - Description : lecture nominale d'une numerotation globale dans un maillage MED
     24 C *
     25 C ******************************************************************************
     26         program test32
     27 C
     28         implicit none
     29         include 'med.hf'
     30 C
     31 C
     32         integer cret,fid
     33         character*32 maa
     34         character*200 des
     35         integer nmaa, mdim ,  nnoe,type
     36
     37         integer numglb(100),i
     38
     39
     40 C  ** Ouverture du fichier test31.med **
     41         call efouvr(fid,'test31.med',MED_LECTURE, cret)
     42         print '(I1)',cret
     43         if (cret .ne. 0 ) then
     44            print *,'Erreur ouverture du fichier test31.med'
     45            call efexit(-1)
     46         endif
     47
     48
     49 C ** lecture du nombre de maillage                      **
     50
     51         call efnmaa(fid,nmaa,cret)
     52         print '(I1)',cret
     53         if (cret .ne. 0 ) then
     54            print *,'Erreur lecture du nombre de maillage'
     55            call efexit(-1)
     56         endif
     57         print '(A,I1)','Nombre de maillages = ',nmaa
     58
     59 C ** lecture des infos pour le premier maillage
     60
     61
     62         call efmaai(fid,1,maa,mdim,type,des,cret)
     63         print '(I1)',cret
     64         if (cret .ne. 0 ) then
     65            print *,'Erreur acces au premier maillage'
     66            call efexit(-1)
     67         endif
     68
     69         nnoe = 0
     70         call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret)
     71         if (cret .ne. 0 ) then
     72            print *,'Erreur acces au nombre de noeud du premier maillage'
     73            call efexit(-1)
     74         endif
     75
     76
     77          print '(A,I1,A,A4,A,I1,A,I4)','maillage '
     78      &        ,0,' de nom ',maa,' et de dimension ',mdim,
     79      &        ' comportant le nombre de noeud ',nnoe
     80
     81
     82 C ** lecture de la numerotation globale
     83
     84          call efgnml(fid,maa,numglb,min(nnoe,100),MED_NOEUD,0,cret)
     85
     86         if (cret .ne. 0 ) then
     87            print *,'Erreur lecture numerotation globale '
     88            call efexit(-1)
     89         endif
     90
     91
     92 C ** Ecriture à l'ecran des numeros globaux
     93
     94          do i=1,min(nnoe,100)
     95             print '(A,I3,A,I4)',
     96      &   'Numero global du noeud ',i,' : ',numglb(i)
     97          enddo
     98
     99
    100 C ** Fermeture du fichier                                **
    101         call efferm (fid,cret)
    102         print '(I1)',cret
    103         if (cret .ne. 0 ) then
    104            print *,'Erreur fermeture du fichier'
    105            call efexit(-1)
    106         endif
    107 C
    108         end