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