C************************************************************************* C COPYRIGHT (C) 1999 - 2003 EDF R&D C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. C C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. C C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION, C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA C C************************************************************************** C ****************************************************************************** C * - Nom du fichier : test31.f C * C * - Description : ecriture d'une numerotation globale dans un maillage MED C * C ****************************************************************************** program test31 C implicit none include 'med.hf' C C integer cret,fid, domdst character*32 maa , jnt, maadst,nodenn,nodent character*200 des,dcornn,dcornt integer nmaa, mdim ,ncor, nnoe, type, ind integer cor(6),numglb(100),i C ** Ouverture du fichier test31.med ** call efouvr(fid,'test31.med',MED_LECTURE_ECRITURE, cret) print *,cret if (cret .ne. 0 ) then print *,'Erreur ouverture du fichier test31.med' call efexit(-1) endif C ** lecture du nombre de maillage ** call efnmaa(fid,nmaa,cret) print *,cret if (cret .ne. 0 ) then print *,'Erreur lecture du nombre de maillage' call efexit(-1) endif print *,'Nombre de maillages = ',nmaa C ** lecture des infos pour le premier maillage ind=1 call efmaai(fid,ind,maa,mdim,type,des,cret) print *,cret if (cret .ne. 0 ) then print *,'Erreur acces au premier maillage' call efexit(-1) endif nnoe = 0 call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret) if (cret .ne. 0 ) then print *,'Erreur acces au nombre de noeud du premier maillage' call efexit(-1) endif print '(A,I1,A,A4,A,I1,A,I4)','maillage ' & ,i,' de nom ',maa,' et de dimension ',mdim, & ' comportant le nombre de noeud ',nnoe C ** construction des numeros globaux if (nnoe.gt.100) nnoe=100 do i=1,nnoe numglb(i)=i+100 enddo C ** ecriture de la numerotation globale call efgnme(fid,maa,numglb,nnoe,MED_NOEUD,0,cret) if (cret .ne. 0 ) then print *,'Erreur ecriture numerotation globale ' call efexit(-1) endif C ** Fermeture du fichier ** call efferm (fid,cret) print *,cret if (cret .ne. 0 ) then print *,'Erreur fermeture du fichier' call efexit(-1) endif C end