1 !************************************************************************* 2 ! COPYRIGHT (C) 1999 - 2007 EDF R&D, CEA/DEN 3 ! THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY 4 ! IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 5 ! AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 6 ! EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. 7 ! 8 ! THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT 9 ! WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF 10 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU 11 ! LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. 12 ! 13 ! YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE 14 ! ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION, 15 ! INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA 16 ! 17 !************************************************************************** 18 19 ! ****************************************************************************** 20 ! * - Nom du fichier : test9.f90 21 ! * 22 ! * - Description : lecture des familles d'un maillage MED 23 ! * 24 ! ****************************************************************************** 25 program test9 26 27 implicit none 28 include 'med.hf' 29 ! 30 integer ret,cret,fid 31 character*32 maa 32 integer mdim 33 integer nfam 34 integer i,j 35 integer natt,ngro 36 character*200, allocatable, dimension (:) :: attdes 37 character*80, allocatable, dimension (:) :: gro 38 integer, allocatable, dimension (:) :: attval,attide 39 character*32 nomfam 40 character*200 desc 41 integer numfam 42 integer type 43 44 45 ! ** Ouverture du fichier test8.med en lecture seule ** 46 call efouvr(fid,'test8.med',MED_LECTURE, cret) 47 print *,cret 48 49 ! ** Lecture des infos sur le 1er maillage ** 50 if (cret.eq.0) then 51 call efmaai(fid,1,maa,mdim,type,desc,cret) 52 print *,"Maillage de nom : ",maa," et de dimension : ", mdim 53 endif 54 print *,cret 55 56 ! ** Lecture du nombre de famille ** 57 if (cret .eq. 0) then 58 call efnfam(fid,maa,nfam,cret) 59 print *,' Nombre de familles a lire : ',nfam 60 endif 61 print *,cret 62 63 ! ** Lecture de chaque famille ** 64 if (cret .eq. 0) then 65 do i=1,nfam 66 67 ! ** Lecture du nombre de groupe ** 68 if (cret .eq. 0) then 69 call efngro(fid,maa,i,ngro,cret) 70 endif 71 print *,cret 72 73 ! ** Lecture du nombre d'attribut ** 74 if (cret .eq. 0) then 75 call efnatt(fid,maa,i,natt,cret) 76 endif 77 print *,cret 78 79 print *,"Famille ",i," a ",natt," attributs et ",ngro," groupes " 80 81 ! ** Lecture de : nom,numero,attributs,groupes ** 82 if (cret .eq. 0) then 83 allocate(attide(natt),attval(natt),attdes(natt),gro(ngro),STAT=ret) 84 ! print *,ret 85 86 call effami(fid,maa,i,nomfam,numfam,attide, & 87 & attval,attdes,natt,gro,ngro,cret) 88 print *,cret 89 print *,"Famille de nom ",nomfam," et de numero ",numfam 90 print *,"Attributs :" 91 do j=1,natt 92 print *,"ide = ",attide(j)," - val = ",attval(j)," - des = ",attdes(j) 93 enddo 94 deallocate(attide,attval,attdes) 95 96 do j=1,ngro 97 print *,"gro = ",gro(j) 98 enddo 99 deallocate(gro) 100 endif 101 enddo 102 endif 103 104 105 ! ** Fermeture du fichier ** 106 call efferm (fid,cret) 107 print *,cret 108 109 ! ** Code retour 110 call efexit(cret) 111 112 end program test9 113 114