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 : 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 C 49 C 50 data coo /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/ 51 data comp2 /"x","y"/, unit2 /"cm","cm"/ 52 C 53 C Creation du fichier test27.med 54 call efouvr(fid,'test27.med',MED_CREATION, cret) 55 print *,cret 56 print *,'Creation du fichier test27.med' 57 C 58 C Creation d'un maillage MED_NON_STRUCTURE 59 if (cret .eq. 0) then 60 mdim = 3 61 maa = 'maillage vide' 62 desc = 'un maillage vide' 63 call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,desc,cret) 64 print *,cret 65 endif 66 C 67 C Creation d'une grille cartesienne 68 if (cret .eq. 0) then 69 mdim = 2 70 maa = 'grille cartesienne' 71 desc = 'un exemple de grille cartesienne' 72 call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret) 73 print *,cret 74 print *,'Creation d un maillage MED_STRUCTURE' 75 endif 76 C 77 C On specifie la nature du maillage structure 78 if (cret .eq. 0) then 79 call efnage(fid,maa,MED_GRILLE_CARTESIENNE,cret) 80 print *,cret 81 print *,'On definit la nature de la grille : MED_GRILLE_CART 82 & ESIENNE' 83 endif 84 C 85 C On definit les indices de la grille selon chaque dimension 86 if (cret .eq. 0) then 87 indice(1) = 1.1 88 indice(2) = 1.2 89 indice(3) = 1.3 90 indice(4) = 1.4 91 nind = 4 92 axe = 1 93 comp = 'X' 94 unit = 'cm' 95 call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret) 96 print *,cret 97 print *,'Ecriture des indices des coordonnees selon axe X' 98 endif 99 C 100 if (cret .eq. 0) then 101 indice(1) = 2.1 102 indice(2) = 2.2 103 indice(3) = 2.3 104 indice(4) = 2.4 105 nind = 4 106 axe = 2 107 comp = 'Y' 108 unit = 'cm' 109 call eficoe(fid,maa,mdim,indice,nind,axe,comp,unit,cret) 110 print *,cret 111 print *,'Ecriture des indices des coordonnees selon axe Y' 112 endif 113 C 114 C Creation d'une grille MED_GRILLE_STANDARD de dimension 2 115 if (cret .eq. 0) then 116 maa = 'grille standard' 117 mdim = 2 118 desc = 'un exemple de grille standard' 119 call efmaac(fid,maa,mdim,MED_STRUCTURE,desc,cret) 120 print *,cret 121 print *,'Nouveau maillage MED_STRUCTURE' 122 endif 123 C 124 if (cret .eq. 0) then 125 call efnage(fid,maa,MED_GRILLE_STANDARD,cret) 126 print *,cret 127 print *,'On definit la nature du maillage structure : MED_GR 128 & ILLE_STANDARD' 129 endif 130 C 131 C On ecrit les coordonnes de la grille 132 if (cret .eq. 0) then 133 nnoe = 4 134 call efcooe(fid,maa,mdim,coo,MED_FULL_INTERLACE,nnoe,MED_CART, 135 & comp2,unit2,cret) 136 print *,cret 137 print *,'Ecriture des coordonnees de la grille' 138 endif 139 C 140 C On definit la structure des coordonnees de la grille 141 if (cret .eq. 0) then 142 strgri(1) = 2 143 strgri(2) = 2 144 call efscoe(fid,maa,mdim,strgri,cret) 145 print *,cret 146 print *,'Ecriture de la structure de la grille : / 2,2 /' 147 endif 148 C 149 C On ferme le fichier 150 call efferm (fid,cret) 151 print *,cret 152 print *,'Fermeture du fichier' 153 C 154 end 155 156 157 158 159 160