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 : test27.f 21 C * 22 C * - Description : creation de maillages structures (grille cartesienne | 23 C * grille standard ) dans le fichier test27.med 24 C * 25 C ***************************************************************************** 26 program test27 27 C 28 implicit none 29 include 'med.hf' 30 C 31 C 32 integer cret, fid 33 C ** la dimension du maillage ** 34 integer mdim 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,nind 47 real*8 indice(4) 48 49 C 50 C 51 data coo /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/ 52 data comp2 /"x","y"/, unit2 /"cm","cm"/ 53 C 54 C Creation du fichier test27.med 55 call efouvr(fid,'test27.med',MED_LECTURE_ECRITURE, cret) 56 print *,cret 57 if (cret .ne. 0 ) then 58 print *,'Erreur creation du fichier' 59 call efexit(-1) 60 endif 61 print *,'Creation du fichier test27.med' 62 C 63 C Creation d'un maillage MED_NON_STRUCTURE 64 mdim = 3 65 maa = 'maillage vide' 66 desc = 'un maillage vide' 67 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,desc,cret) 68 print *,cret 69 if (cret .ne. 0 ) then 70 print *,'Erreur creation du maillage' 71 call efexit(-1) 72 endif 73 C 74 C Creation d'une grille cartesienne 75 mdim = 2 76 maa = 'grille cartesienne' 77 desc = 'un exemple de grille cartesienne' 78 call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret) 79 print *,cret 80 if (cret .ne. 0 ) then 81 print *,'Erreur creation du maillage' 82 call efexit(-1) 83 endif 84 print *,'Creation d un maillage MED_STRUCTURE' 85 86 C 87 C On specifie la nature du maillage structure 88 call efnage(fid,maa,MED_GRILLE_CARTESIENNE,cret) 89 print *,cret 90 print *,'On definit la nature de la grille : 91 & MED_GRILLE_CARTESIENNE' 92 if (cret .ne. 0 ) then 93 print *,'Erreur ecriture de la nature de la grille' 94 call efexit(-1) 95 endif 96 C 97 C On definit les indices de la grille selon chaque dimension 98 indice(1) = 1.1D0 99 indice(2) = 1.2D0 100 indice(3) = 1.3D0 101 indice(4) = 1.4D0 102 nind = 4 103 axe = 1 104 comp = 'X' 105 unit = 'cm' 106 call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret) 107 print *,cret 108 if (cret .ne. 0 ) then 109 print *,'Erreur ecriture des indices' 110 call efexit(-1) 111 endif 112 print *,'Ecriture des indices des coordonnees selon axe X' 113 C 114 indice(1) = 2.1D0 115 indice(2) = 2.2D0 116 indice(3) = 2.3D0 117 indice(4) = 2.4D0 118 nind = 4 119 axe = 2 120 comp = 'Y' 121 unit = 'cm' 122 call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret) 123 print *,cret 124 if (cret .ne. 0 ) then 125 print *,'Erreur ecriture des indices' 126 call efexit(-1) 127 endif 128 print *,'Ecriture des indices des coordonnees selon axe Y' 129 C 130 C Creation d'une grille MED_GRILLE_STANDARD de dimension 2 131 maa = 'grille standard' 132 mdim = 2 133 desc = 'un exemple de grille standard' 134 call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret) 135 print *,cret 136 if (cret .ne. 0 ) then 137 print *,'Erreur creation de maillage' 138 call efexit(-1) 139 endif 140 print *,'Nouveau maillage MED_STRUCTURE' 141 C 142 call efnage(fid,maa,MED_GRILLE_STANDARD,cret) 143 print *,cret 144 if (cret .ne. 0 ) then 145 print *,'Erreur ecriture de la nature de la grille' 146 call efexit(-1) 147 endif 148 print *,'On definit la nature du maillage : MED_GRILLE_STANDARD' 149 C 150 C On ecrit les coordonnes de la grille 151 nnoe = 4 152 call efcooe(fid,maa,mdim,coo,MED_FULL_INTERLACE,nnoe,MED_CART, 153 & comp2,unit2,cret) 154 print *,cret 155 if (cret .ne. 0 ) then 156 print *,'Erreur ecriture des coordonnees des noeuds' 157 call efexit(-1) 158 endif 159 print *,'Ecriture des coordonnees de la grille' 160 C 161 C On definit la structure des coordonnees de la grille 162 strgri(1) = 2 163 strgri(2) = 2 164 call efscoe(fid,maa,mdim,strgri,cret) 165 print *,cret 166 if (cret .ne. 0 ) then 167 print *,'Erreur ecriture de la structure' 168 call efexit(-1) 169 endif 170 print *,'Ecriture de la structure de la grille : / 2,2 /' 171 C 172 C On ferme le fichier 173 call efferm (fid,cret) 174 print *,cret 175 if (cret .ne. 0 ) then 176 print *,'Erreur fermeture du fichier' 177 call efexit(-1) 178 endif 179 print *,'Fermeture du fichier' 180 C 181 end 182 183 184 185 186 187