1 C************************************************************************* 2 C COPYRIGHT (C) 1999 - 2003 EDF R&D 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 print *,cret 54 print *,'Ouverture du fichier test27.med' 55 C 56 C Combien de maillage ? 57 if (cret .eq. 0) then 58 call efnmaa(fid,nmaa,cret) 59 print *,cret 60 endif 61 C 62 C On boucle sur les maillages et on ne lit que les 63 C maillages structures 64 if (cret .eq. 0) then 65 C 66 do 10 i=1,nmaa 67 C 68 C On repere les maillages qui nous interessent 69 C 70 if (cret .eq. 0) then 71 call efmaai(fid,i,maa,mdim,typmaa,desc,cret) 72 print *,'Maillage de nom : ',maa 73 print *,'- Dimension : ',mdim 74 if (typmaa .eq. MED_STRUCTURE) then 75 print *,'- Type : MED_STRUCTURE' 76 else 77 print *,'- Type : MED_NON_STRUCTURE' 78 endif 79 print *,cret 80 endif 81 C 82 C On repere le type de la grille 83 if (cret .eq. 0 .and. typmaa .eq. MED_STRUCTURE) then 84 call efnagl(fid,maa,type,cret) 85 print *,cret 86 if (type .eq. MED_GRILLE_CARTESIENNE) then 87 print *,'- Nature de la grille : MED_GRILLE_CARTESIE 88 & NNE' 89 endif 90 if (type .eq. MED_GRILLE_STANDARD) then 91 print *,'- Nature de la grille : MED_GRILLE_STANDARD' 92 endif 93 endif 94 C 95 C On regarde la structure et les coordonnees de la grille MED_GRILLE_STANDARD 96 if ((cret .eq. 0) .and. (type .eq. MED_GRILLE_STANDARD) 97 & .and. (typmaa .eq. MED_STRUCTURE)) then 98 C 99 call efnema(fid,maa,MED_COOR,MED_NOEUD,0,0,nnoe,cret) 100 print *,cret 101 print *,'- Nombre de noeuds : ',nnoe 102 C 103 if (cret .eq. 0) then 104 call efscol(fid,maa,mdim,strgri,cret) 105 print *,cret 106 print *,'- Structure de la grille : ',strgri 107 endif 108 C 109 if (cret .eq. 0) then 110 call efcool(fid,maa,mdim,coo,MED_FULL_INTERLACE,MED_ALL,tmp, 111 & 0,rep,comp2,unit2,cret) 112 print *,cret 113 print *,'- Coordonnees :' 114 do 20 j=1,nnoe*mdim 115 print *,coo(j) 116 20 continue 117 endif 118 C 119 endif 120 C 121 if ((cret .eq. 0) .and. (type .eq. MED_GRILLE_CARTESIENNE) 122 & .and. (typmaa .eq. MED_STRUCTURE)) then 123 C 124 do 30 axe=1,mdim 125 if (axe .eq. 1) then 126 quoi = MED_COOR_IND1 127 endif 128 if (axe .eq. 2) then 129 quoi = MED_COOR_IND2 130 endif 131 if (axe .eq. 3) then 132 quoi = MED_COOR_IND3 133 endif 134 C Lecture de la taille de l'indice selon la dimension 135 C fournie par le parametre quoi 136 if (cret.eq. 0) then 137 call efnema(fid,maa,quoi,MED_NOEUD,0,0,nind, 138 & cret) 139 print *,cret 140 print *,'- Axe ',axe 141 print *,'- Nombre d indices : ',nind 142 endif 143 C Lecture des indices des coordonnees de la grille 144 if (cret .eq. 0) then 145 call eficol(fid,maa,mdim,indice,nind,axe,comp,unit,cret) 146 print *,cret 147 print *,'- Axe ',comp 148 print *,' unite : ',unit 149 do 40 j=1,nind 150 print *,indice(j) 151 40 continue 152 endif 153 30 continue 154 C 155 endif 156 C 157 10 continue 158 C 159 endif 160 C 161 C On ferme le fichier 162 call efferm (fid,cret) 163 print *,cret 164 print *,'Fermeture du fichier' 165 C 166 end