1 !************************************************************************* 2 ! COPYRIGHT (C) 1999 - 2003 EDF R&D 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 : test7.f90 21 ! * 22 ! * - Description : lecture des elements du maillage MED ecrits par test6 23 ! * 24 ! ****************************************************************************** 25 program test7 26 27 implicit none 28 include 'med.hf' 29 ! 30 ! 31 integer cret, ret, fid 32 33 integer nse2 34 integer, allocatable, dimension (:) :: se2 35 character*16, allocatable, dimension (:) :: nomse2 36 integer, allocatable, dimension (:) :: numse2,nufase2 37 38 integer ntr3 39 integer, allocatable, dimension (:) :: tr3 40 character*16, allocatable, dimension (:) :: nomtr3 41 integer, allocatable, dimension (:) :: numtr3,nufatr3 42 43 ! ** nom du maillage de longueur maxi MED_TAILLE_NOM ** 44 character*32 :: maa = "maa1" 45 character*200 :: desc 46 integer :: mdim 47 logical inoele,inuele 48 integer, parameter :: profil (2) = (/ 2,3 /) 49 integer type 50 integer tse2,ttr3, i 51 52 ! ** Ouverture du fichier test6.med en lecture seule ** 53 call efouvr(fid,'test6.med',MED_LECTURE, cret) 54 print *,cret 55 56 ! ** Lecture des infos concernant le premier maillage ** 57 if (cret.eq.0) then 58 call efmaai(fid,1,maa,mdim,type,desc,cret) 59 print *,"Maillage de nom : ",maa," et de dimension :", mdim 60 endif 61 print *,cret 62 63 ! ** Combien de segments et de triangles ** 64 if (cret.eq.0) then 65 nse2 = 0 66 call efnema(fid,maa,MED_CONN,MED_ARETE,MED_SEG2,MED_DESC, & 67 & nse2,cret) 68 endif 69 print *,cret 70 71 if (cret.eq.0) then 72 ntr3 = 0 73 call efnema(fid,maa,MED_CONN,MED_MAILLE,MED_TRIA3,MED_DESC, & 74 & ntr3,cret) 75 endif 76 print *,cret 77 78 if (cret.eq.0) then 79 print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 " 80 & ,ntr3 81 endif 82 83 ! ** Allocations memoire ** 84 tse2 = 2 85 allocate (se2(tse2*nse2),nomse2(nse2),numse2(nse2),nufase2(nse2), 86 & STAT=ret ) 87 ! print *,ret 88 89 ttr3 = 3 90 allocate (tr3(ntr3*ttr3),nomtr3(ntr3),numtr3(ntr3),nufatr3(ntr3), 91 & STAT=ret ) 92 ! print *,ret 93 94 95 ! ** Lecture de la connectivite des segments avec profil ** 96 if (cret.eq.0) then 97 call efconl(fid,maa,mdim,se2,MED_NO_INTERLACE,profil,2,MED_ARETE, & 98 & MED_SEG2,MED_DESC,cret) 99 endif 100 print *,cret 101 print *,se2 102 103 ! ** Lecture (optionnelle) des noms des segments ** 104 if (cret.eq.0) then 105 call efnoml(fid,maa,nomse2,nse2,MED_ARETE, & 106 & MED_SEG2,ret) 107 endif 108 109 if (ret <0) then 110 inoele = .FALSE. 111 else 112 inoele = .TRUE. 113 endif 114 115 ! ** Lecture (optionnelle) des numeros des segments ** 116 if (cret.eq.0) then 117 call efnuml(fid,maa,numse2,nse2,MED_ARETE,MED_SEG2,ret) 118 endif 119 120 if (ret <0) then 121 inuele = .FALSE. 122 else 123 inuele = .TRUE. 124 endif 125 126 ! ** Lecture des numeros des familles des segments ** 127 if (cret.eq.0) then 128 call effaml(fid,maa,nufase2,nse2,MED_ARETE,MED_SEG2,cret) 129 endif 130 print *,cret 131 132 ! ** Lecture de la connectivite des triangles sans profil ** 133 if (cret.eq.0) then 134 call efconl(fid,maa,mdim,tr3,MED_NO_INTERLACE,profil,0,MED_MAILLE, & 135 & MED_TRIA3,MED_DESC,cret) 136 endif 137 print *,cret 138 139 ! ** Lecture (optionnelle) des noms des triangles ** 140 if (cret.eq.0) then 141 call efnoml(fid,maa,nomtr3,ntr3,MED_MAILLE, & 142 & MED_TRIA3,ret) 143 endif 144 145 if (ret <0) then 146 inoele = .FALSE. 147 else 148 inoele = .TRUE. 149 endif 150 print *,cret 151 152 ! ** Lecture (optionnelle) des numeros des segments ** 153 if (cret.eq.0) then 154 call efnuml(fid,maa,numtr3,ntr3,MED_MAILLE,MED_TRIA3,ret) 155 endif 156 157 if (ret <0) then 158 inuele = .FALSE. 159 else 160 inuele = .TRUE. 161 endif 162 print *,cret 163 164 ! ** Lecture des numeros des familles des segments ** 165 if (cret.eq.0) then 166 call effaml(fid,maa,nufatr3,ntr3,MED_MAILLE,MED_TRIA3,cret) 167 endif 168 print *,cret 169 170 ! ** Fermeture du fichier ** 171 call efferm (fid,cret) 172 print *,cret 173 174 ! ** Affichage des resulats ** 175 if (cret.eq.0) then 176 177 print *,"Connectivite des segments : " 178 print *, se2 179 180 if (inoele) then 181 print *,"Noms des segments :" 182 print *,nomse2 183 endif 184 185 if (inuele) then 186 print *,"Numeros des segments :" 187 print *,numse2 188 endif 189 190 print *,"Numeros des familles des segments :" 191 print *,nufase2 192 193 print *,"Connectivite des triangles :" 194 print *,tr3 195 196 if (inoele) then 197 print *,"Noms des triangles :" 198 print *,nomtr3 199 endif 200 201 if (inuele) then 202 print *,"Numeros des triangles :" 203 print *,numtr3 204 endif 205 206 print *,"Numeros des familles des triangles :" 207 print *,nufatr3 208 209 endif 210 211 ! ** Nettoyage memoire ** 212 deallocate (se2,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3) 213 214 end program test7 215