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 C ****************************************************************************** 20 C * - Nom du fichier : test3.f 21 C * 22 C * - Description : lecture des informations sur les maillages dans un fichier 23 C* MED. 24 C * 25 C ****************************************************************************** 26 program test3 27 C 28 implicit none 29 include 'med.hf' 30 C 31 C 32 integer cret,fid,cres,type,cnu 33 character*32 maa 34 character*80 nomu 35 character*200 desc 36 integer nmaa,i,mdim,edim 37 38 C ** Ouverture du fichier en lecture seule 39 call efouvr(fid,'test2.med',MED_LECTURE, cret) 40 print *,cret 41 if (cret .ne. 0 ) then 42 print *,'Erreur ouverture du fichier en lecture' 43 call efexit(-1) 44 endif 45 46 C ** lecture du nombre de maillage ** 47 call efnmaa(fid,nmaa,cret) 48 print *,cret 49 if (cret .ne. 0 ) then 50 print *,'Erreur lecture du nombre de maillage' 51 call efexit(-1) 52 endif 53 print *,'Nombre de maillages = ',nmaa 54 55 C ** lecture des infos sur les maillages : ** 56 C ** - nom, dimension, type,description 57 C ** - options : nom universel, dimension de l'espace 58 do i=1,nmaa 59 call efmaai(fid,i,maa,mdim,type,desc,cret) 60 edim = -1 61 call efespl(fid,maa,edim,cres) 62 call efunvl(fid,maa,nomu,cnu) 63 print *,cret 64 if (cret .ne. 0 ) then 65 print *,'Erreur acces au maillage' 66 call efexit(-1) 67 endif 68 print '(A,I1,A,A4,A,I1,A,A65,A65)','maillage ' 69 & ,i,' de nom ',maa,' et de dimension ',mdim, 70 & ' de description ',desc 71 if (type .eq. MED_NON_STRUCTURE) then 72 print *,'Maillage non structure' 73 else 74 print *,'Maillage structure' 75 endif 76 if (cres .eq. 0) then 77 print *,'Dimension espace ', edim 78 else 79 print *,'Dimension espace ', mdim 80 endif 81 if (cnu .eq. 0) then 82 print *,'Nom universel : ',nomu 83 else 84 print *,'Pas de nom universel' 85 endif 86 enddo 87 88 C ** fermeture du fichier 89 call efferm (fid,cret) 90 print *,cret 91 if (cret .ne. 0 ) then 92 print *,'Erreur fermeture du fichier' 93 call efexit(-1) 94 endif 95 C 96 end 97