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