1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2003 EDF R&D 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,ret, fid,cres,type 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 42 C ** lecture du nombre de maillage ** 43 if (cret .eq. 0) then 44 call efnmaa(fid,nmaa,cret) 45 print *,'Nombre de maillages = ',nmaa 46 endif 47 print *,cret 48 49 C ** lecture des infos sur les maillages : ** 50 C ** - nom, dimension, type,description 51 C ** - options : nom universel, dimension de l'espace 52 if (cret.eq.0) then 53 do i=1,nmaa 54 if (cret.eq.0) then 55 call efmaai(fid,i,maa,mdim,type,desc,cret) 56 edim = -1 57 call efespl(fid,maa,edim,cres) 58 call efunvl(fid,maa,nomu,ret) 59 cret = cret + ret 60 print '(A,I1,A,A4,A,I1,A,A65,A65)','maillage ' 61 & ,i,' de nom ',maa,' et de dimension ',mdim, 62 & ' de description ',desc 63 & ,'et de nom univ. ',nomu 64 if (type .eq. MED_NON_STRUCTURE) then 65 print *,'Maillage non structure' 66 else 67 print *,'Maillage structure' 68 endif 69 if (cres .eq. 0) then 70 print *,'Dimension espace ', edim 71 else 72 print *,'Dimension espace ', mdim 73 endif 74 print *,cret 75 endif 76 enddo 77 endif 78 79 C ** fermeture du fichier 80 call efferm (fid,cret) 81 print *,cret 82 83 end 84