1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2007 EDF R&D, CEA/DEN 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 : test28.f 21 C * 22 C * - Description : lecture des maillages structures (grille cartesienne | 23 C * grille de-structuree ) dans le fichier test27.med 24 C * 25 C ***************************************************************************** 26 program test28 27 C 28 implicit none 29 include 'med.hf' 30 C 31 C 32 integer cret, fid,i,j 33 C ** la dimension du maillage ** 34 integer mdim,nind,nmaa,type,quoi,rep,typmaa 35 C ** nom du maillage de longueur maxi MED_TAILLE_NOM ** 36 character*32 maa 37 C ** le nombre de noeuds ** 38 integer nnoe 39 C ** table des coordonnees ** 40 real*8 coo(8) 41 character*16 comp, comp2(2) 42 character*16 unit, unit2(2) 43 character*200 desc 44 integer strgri(2) 45 C ** grille cartesienne ** 46 integer axe 47 real*8 indice(4) 48 integer tmp 49 50 C 51 C On ouvre le fichier test27.med en lecture seule 52 call efouvr(fid,'test27.med',MED_LECTURE, cret) 53 if (cret .ne. 0 ) then 54 print *,'Erreur ouverture du fichier' 55 call efexit(-1) 56 endif 57 print *,cret 58 59 print *,'Ouverture du fichier test27.med' 60 C 61 C Combien de maillage ? 62 call efnmaa(fid,nmaa,cret) 63 print *,cret 64 if (cret .ne. 0 ) then 65 print *,'Erreur lecture du nombre de maillage' 66 call efexit(-1) 67 endif 68 C 69 C On boucle sur les maillages et on ne lit que les 70 C maillages structures 71 do 10 i=1,nmaa 72 C 73 C On repere les maillages qui nous interessent 74 C 75 call efmaai(fid,i,maa,mdim,typmaa,desc,cret) 76 print *,cret 77 if (cret .ne. 0 ) then 78 print *,'Erreur lecture maillage info' 79 call efexit(-1) 80 endif 81 print *,'Maillage de nom : ',maa 82 print *,'- Dimension : ',mdim 83 if (typmaa .eq. MED_STRUCTURE) then 84 print *,'- Type : MED_STRUCTURE' 85 else 86 print *,'- Type : MED_NON_STRUCTURE' 87 endif 88 C 89 C On repere le type de la grille 90 if (typmaa .eq. MED_STRUCTURE) then 91 call efnagl(fid,maa,type,cret) 92 print *,cret 93 if (cret .ne. 0 ) then 94 print *,'Erreur lecture nature de la grille' 95 call efexit(-1) 96 endif 97 if (type .eq. MED_GRILLE_CARTESIENNE) then 98 print *,'- Nature de la grille :', 99 & 'MED_GRILLE_CARTESIENNE' 100 endif 101 if (type .eq. MED_GRILLE_STANDARD) then 102 print *,'- Nature de la grille : MED_GRILLE_STANDARD' 103 endif 104 endif 105 C 106 C On regarde la structure et les coordonnees de la grille MED_GRILLE_STANDARD 107 if ((type .eq. MED_GRILLE_STANDARD) 108 & .and. (typmaa .eq. MED_STRUCTURE)) then 109 C 110 call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret) 111 print *,cret 112 if (cret .ne. 0 ) then 113 print *,'Erreur lecture nombre de noeud' 114 call efexit(-1) 115 endif 116 print *,'- Nombre de noeuds : ',nnoe 117 C 118 call efscol(fid,maa,mdim,strgri,cret) 119 print *,cret 120 if (cret .ne. 0 ) then 121 print *,'Erreur lecture structure de la grille' 122 call efexit(-1) 123 endif 124 print *,'- Structure de la grille : ',strgri 125 C 126 call efcool(fid,maa,mdim,coo, 127 & MED_FULL_INTERLACE,MED_ALL,tmp, 128 & 0,rep,comp2,unit2,cret) 129 print *,cret 130 if (cret .ne. 0 ) then 131 print *,'Erreur lecture des coordonnees des noeuds' 132 call efexit(-1) 133 endif 134 print *,'- Coordonnees :' 135 do 20 j=1,nnoe*mdim 136 print *,coo(j) 137 20 continue 138 endif 139 C 140 if ((type .eq. MED_GRILLE_CARTESIENNE) 141 & .and. (typmaa .eq. MED_STRUCTURE)) then 142 C 143 do 30 axe=1,mdim 144 if (axe .eq. 1) then 145 quoi = MED_COOR_IND1 146 endif 147 if (axe .eq. 2) then 148 quoi = MED_COOR_IND2 149 endif 150 if (axe .eq. 3) then 151 quoi = MED_COOR_IND3 152 endif 153 C Lecture de la taille de l'indice selon la dimension 154 C fournie par le parametre quoi 155 call efnema(fid,maa,quoi,MED_NOEUD,0,0,nind,cret) 156 print *,cret 157 if (cret .ne. 0 ) then 158 print *,'Erreur lecture taille indice' 159 call efexit(-1) 160 endif 161 print *,'- Axe ',axe 162 print *,'- Nombre d indices : ',nind 163 C Lecture des indices des coordonnees de la grille 164 call eficol(fid,maa,mdim,indice,nind,axe,comp,unit, 165 & cret) 166 print *,cret 167 if (cret .ne. 0 ) then 168 print *,'Erreur lecture indices de coordonnées' 169 call efexit(-1) 170 endif 171 print *,'- Axe ',comp 172 print *,' unite : ',unit 173 do 40 j=1,nind 174 print *,indice(j) 175 40 continue 176 30 continue 177 C 178 endif 179 C 180 10 continue 181 C 182 C On ferme le fichier 183 call efferm (fid,cret) 184 print *,cret 185 if (cret .ne. 0 ) then 186 print *,'Erreur fermeture du fichier' 187 call efexit(-1) 188 endif 189 print *,'Fermeture du fichier' 190 C 191 end 192