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 : test5.f90 21 ! * 22 ! * - Description : lecture des noeuds d'un maillage MED. 23 ! * 24 ! ****************************************************************************** 25 program test5 26 ! 27 implicit none 28 include 'med.hf' 29 ! 30 ! 31 integer cret, ret 32 integer fid 33 34 ! ** la dimension du maillage ** 35 integer mdim 36 ! ** nom du maillage de longueur maxi MED_TAILLE_NOM ** 37 character*32 maa 38 character*200 desc 39 ! ** le nombre de noeuds ** 40 integer nnoe 41 ! ** table des coordonnees ** 42 real*8, allocatable, dimension (:) :: coo 43 real*8, allocatable, dimension (:) :: coo2 44 ! ** tables des noms et des unites des coordonnees ** 45 character*16 nomcoo(2) 46 character*16 unicoo(2) 47 ! ** tables des noms, numeros, numeros de familles des noeuds ** 48 ! autant d'elements que de noeuds - les noms ont pout longueur ** 49 ! MED_TAILLE_PNOM=8 50 character*16, allocatable, dimension (:) :: nomnoe 51 integer, allocatable, dimension (:) :: numnoe 52 integer, allocatable, dimension (:) :: nufano 53 integer, parameter :: profil(2) = (/ 2, 3 /) 54 55 integer i,rep 56 logical inonoe,inunoe 57 integer type 58 59 ! Ouverture du fichier en lecture seule ** 60 call efouvr(fid,'test4.med',MED_LECTURE, cret) 61 print *,cret 62 63 ! ** Lecture des infos concernant le premier maillage ** 64 if (cret.eq.0) then 65 call efmaai(fid,1,maa,mdim,type,desc,cret) 66 endif 67 print *,cret 68 69 70 ! ** Combien de noeuds a lire ** 71 if (cret.eq.0) then 72 nnoe = 0 73 call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0, & 74 & nnoe,cret) 75 endif 76 print *,cret,' Nombre de noeuds : ',nnoe 77 78 79 ! ** Allocations memoires : ** 80 ! ** table des coordonnees ** 81 ! profil : (dimension * nombre de noeuds ) ** 82 ! ** table des des numeros, des numeros de familles des noeuds 83 ! ** table des noms des noeuds ** 84 85 allocate( coo(nnoe*mdim),coo2(nnoe*mdim), numnoe(nnoe),nufano(nnoe), & 86 & nomnoe(nnoe),STAT=ret ) 87 print *,ret 88 89 90 ! ** Lecture des composantes n°2 des coordonnees des noeuds ** 91 if (cret.eq.0) then 92 call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE, & 93 & 2,profil,0,rep,nomcoo,unicoo,cret) 94 endif 95 print *,cret 96 print *,'Lecture des composantes 2 des coordonnees : ' 97 print *,coo 98 99 ! ** Lecture des composantes n°1 des coordonnees des noeuds ** 100 if (cret.eq.0) then 101 call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE, & 102 & 1,profil,0,rep,nomcoo,unicoo,cret) 103 endif 104 print *,cret 105 print *,'Lecture des composantes 1 des coordonnees : ' 106 print *,coo 107 108 ! ** Lecture des composantes n°1 des coordonnees des noeuds du profil ** 109 if (cret.eq.0) then 110 call efcool(fid,maa,mdim,coo2,MED_FULL_INTERLACE, & 111 & 1,profil,2,rep,nomcoo,unicoo,cret) 112 endif 113 print *,cret 114 print *,'Lecture des composantes 1 des coordonnees avec le profil' 115 print *,coo2 116 117 ! ** Lecture des toutes les composantes des coordonnees des noeuds ** 118 if (cret.eq.0) then 119 call efcool(fid,maa,mdim,coo2,MED_FULL_INTERLACE, & 120 & MED_ALL,profil,0,rep,nomcoo,unicoo,cret) 121 endif 122 print *,cret 123 print *,'Lecture des toutes les composantes des coordonnees : ' 124 print *,coo2 125 126 ! ** Lecture des noms des noeuds (optionnel dans un fichier MED) ** 127 if (cret.eq.0) then 128 call efnoml(fid,maa,nomnoe,nnoe,MED_NOEUD, & 129 & 0,ret) 130 endif 131 132 if (ret <0) then 133 inonoe = .FALSE. 134 else 135 inonoe = .TRUE. 136 endif 137 138 ! ** Lecture des numeros des noeuds (optionnel dans un fichier MED) ** 139 if (cret.eq.0) then 140 call efnuml(fid,maa,numnoe,nnoe,MED_NOEUD,0,ret) 141 endif 142 if (ret <0) then 143 inunoe = .FALSE. 144 else 145 inunoe = .TRUE. 146 endif 147 148 ! ** Lecture des numeros de familles des noeuds ** 149 if (cret.eq.0) then 150 call effaml(fid,maa,nufano,nnoe,MED_NOEUD,0,cret) 151 endif 152 print *,cret 153 154 ! ** Fermeture du fichier 155 call efferm (fid,cret) 156 print *,cret 157 158 159 ! ** Affichage des resulats ** 160 if (cret.eq.0) then 161 162 163 print *,"Type de repere : ", rep 164 print *,"Nom des coordonnees : " 165 print *, nomcoo 166 167 print *,"Unites des coordonnees : " 168 print *, unicoo 169 170 print *,"Coordonnees des noeuds : " 171 print *, coo 172 173 if (inonoe) then 174 print *,"Noms des noeuds : " 175 print *,nomnoe 176 endif 177 178 if (inunoe) then 179 print *,"Numeros des noeuds : " 180 print *,numnoe 181 endif 182 183 print *,"Numeros des familles des noeuds : " 184 print *,nufano 185 186 endif 187 188 ! ** Liberation memoire ** 189 deallocate(coo,nomnoe,numnoe,nufano); 190 191 end program test5 192 193 194 195 196 197