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