1C* This file is part of MED. 2C* 3C* COPYRIGHT (C) 1999 - 2019 EDF R&D, CEA/DEN 4C* MED is free software: you can redistribute it and/or modify 5C* it under the terms of the GNU Lesser General Public License as published by 6C* the Free Software Foundation, either version 3 of the License, or 7C* (at your option) any later version. 8C* 9C* MED is distributed in the hope that it will be useful, 10C* but WITHOUT ANY WARRANTY; without even the implied warranty of 11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12C* GNU Lesser General Public License for more details. 13C* 14C* You should have received a copy of the GNU Lesser General Public License 15C* along with MED. If not, see <http://www.gnu.org/licenses/>. 16C* 17 18C ****************************************************************************** 19C * - Nom du fichier : test3.f 20C * 21C * - Description : lecture des informations sur les maillages dans un fichier 22C* MED. 23C * 24C ****************************************************************************** 25 program test3 26C 27 implicit none 28 include 'med.hf' 29C 30C 31 integer*8 fid 32 integer cret,cres,type,cnu 33 character*32 maa 34 character*80 nomu 35 character*200 desc 36 integer nmaa,i,mdim,edim 37 38C ** 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 46C ** 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 55C ** lecture des infos sur les maillages : ** 56C ** - nom, dimension, type,description 57C ** - 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 88C ** 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 95C 96 end 97 98