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 : test10.f 21 C * 22 C * - Description : ecriture de champs de resultats MED 23 C * 24 C ****************************************************************************** 25 program test10 26 C 27 implicit none 28 include 'med.hf' 29 C 30 integer ret,fid,USER_INTERLACE,USER_MODE 31 real*8 a,b,p1,p2,dt 32 33 character*32 maa1,maa2,maa3 34 character*13 lien_maa2 35 C CHAMP N°1 36 character*32 nomcha1 37 integer mdim 38 character*16 comp1(2), unit1(2) 39 character*16 dtunit1 40 integer ncomp1 41 C MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1 42 integer ngauss1_1 43 character*32 gauss1_1 44 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6) 45 integer nval1_1 46 real*8 valr1_1(1*6*2) 47 C MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1 48 integer ngauss1_2 49 character*32 gauss1_2 50 real*8 gscoo1_2(6), wg1_2(3) 51 integer nval1_2 52 real*8 valr1_2(2*3*2) 53 real*8 valr1_2p(2*3) 54 C MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1 55 integer ngauss1_3,nval1_3 56 real*8 valr1_3(2*3*2) 57 real*8 valr1_3p(2*2) 58 59 C CHAMP N°2 60 character*32 nomcha2 61 character*16 comp2(3), unit2(3) 62 integer ncomp2, nval2 63 integer valr2(5*3), valr2p(3*3) 64 65 C PROFILS UTILISES 66 character*32 nomprofil1 67 integer profil1(2) , profil2(3) 68 69 parameter (USER_INTERLACE = MED_FULL_INTERLACE) 70 parameter (USER_MODE = MED_COMPACT ) 71 parameter ( a=0.446948490915965, b=0.091576213509771 ) 72 parameter ( p1=0.11169079483905, p2=0.0549758718227661 ) 73 C MAILLAGES 74 parameter ( maa1 = "maa1", maa2 = "maa2", maa3 = "maa3" ) 75 parameter ( lien_maa2= "./testfoo.med" ) 76 C CHAMP N°1 77 parameter ( nomcha1 = "champ reel" ) 78 parameter ( ncomp1 = 2 ) 79 parameter ( dtunit1 = "") 80 C MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1 81 parameter ( gauss1_1 = "Model n1" ) 82 parameter ( ngauss1_1 = 6 ) 83 C MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1 84 parameter ( gauss1_2 = "Model n2" ) 85 parameter ( ngauss1_2 = 3 ) 86 C MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1 87 parameter ( ngauss1_3 = 6 ) 88 parameter ( nval1_3 = 6 ) 89 C CHAMP N°2 90 parameter ( nomcha2="champ entier") 91 parameter ( ncomp2 = 3, nval2= 5 ) 92 C PROFILS 93 parameter ( nomprofil1 = "PROFIL(champ(1))" ) 94 95 96 C CHAMP N°1 97 data comp1 /"comp1", "comp2"/ 98 data unit1 /"unit1","unit2"/ 99 C MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1 100 data nval1_1 / 1*6 / 101 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0, 102 1 0.0,-1.0, 0.0,0.0 / 103 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0, 104 1 20.0,21.0, 22.0,23.0/ 105 C MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1 106 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 107 1 12.0,13.0, 20.0,21.0, 22.0,23.0 / 108 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 / 109 C MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1 110 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0, 111 1 20.0,21.0, 22.0,23.0 / 112 data valr1_3p / 2.0,3.0, 10.0,11.0 / 113 C CHAMP N°2 114 data comp2 /"comp1", "comp2", "comp3"/ 115 data unit2 /"unit1","unit2", "unit3"/ 116 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 / 117 data valr2p / 0,1,2, 20,21,22, 40,41,42 / 118 C PROFILS 119 data profil1 /2,3/ 120 data profil2 /1,3,5/ 121 122 ret = 0 123 124 gscoo1_1(1) = 2*b-1 125 gscoo1_1(2) = 1-4*b 126 gscoo1_1(3) = 2*b-1 127 gscoo1_1(4) = 2*b-1 128 gscoo1_1(5) = 1-4*b 129 gscoo1_1(6) = 2*b-1 130 gscoo1_1(7) = 1-4*a 131 gscoo1_1(8) = 2*a-1 132 ygscoo1_1(9) = 2*a-1 133 gscoo1_1(10) = 1-4*a 134 gscoo1_1(11) = 2*a-1 135 gscoo1_1(12) = 2*a-1 136 137 wg1_1(1) = 4*p2 138 wg1_1(2) = 4*p2 139 wg1_1(3) = 4*p2 140 wg1_1(4) = 4*p1 141 wg1_1(5) = 4*p1 142 wg1_1(6) = 4*p1 143 144 nval1_2 = 2*3 145 gscoo1_2(1) = -2.0/3 146 gscoo1_2(2) = 1.0/3 147 gscoo1_2(3) = -2.0/3 148 gscoo1_2(4) = -2.0/3 149 gscoo1_2(5) = 1.0/3 150 gscoo1_2(6) = -2.0/3 151 152 wg1_2(1) = 2.0/3 153 wg1_2(2) = 2.0/3 154 wg1_2(3) = 2.0/3 155 156 C ** ouverture du fichier ** 157 call efouvr(fid,'test10.med',MED_CREATION, ret) 158 if (ret .ne. 0 ) then 159 print *,'Erreur à l''ouverture du fichier : ','test10.med' 160 call efexit(-1) 161 endif 162 163 C ** creation du maillage maa1 de dimension 3 ** 164 call efmaac(fid,maa1,3,MED_NON_STRUCTURE, 165 1 "Maillage vide",ret) 166 if (ret .ne. 0 ) then 167 print *,'Erreur à la création du maillage : ', maa1 168 call efexit(-1) 169 endif 170 171 C ** creation du maillage maa3 de dimension 3 ** 172 call efmaac(fid,maa3,3,MED_NON_STRUCTURE, 173 1 "Maillage vide",ret) 174 if (ret .ne. 0 ) then 175 print *,'Erreur à la création du maillage : ', maa3 176 call efexit(-1) 177 endif 178 179 180 C ** creation du champ réel n°1 ** 181 call efchac(fid,nomcha1,MED_FLOAT64,comp1,unit1,ncomp1,ret) 182 if (ret .ne. 0 ) then 183 print *,'Erreur à la création du champ : ', nomcha1 184 ret = -1 185 endif 186 187 C ** creation du champ entier n°2 ** 188 call efchac(fid,nomcha2,MED_INT32,comp2,unit2,ncomp2,ret) 189 if (ret .ne. 0 ) then 190 print *,'Erreur à la création du champ : ', nomcha2 191 ret = -1 192 endif 193 194 C ** creation du lien au fichier distant contenant maa2 ** 195 call efliee(fid,lien_maa2,maa2,ret) 196 if (ret .ne. 0 ) then 197 print *,'Erreur à la création du lien : ', lien_maa2 198 ret = -1 199 endif 200 201 C ** creation de la localisation des points de Gauss modèle n°1 ** 202 call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE, 203 1 ngauss1_1, gscoo1_1, wg1_1, gauss1_1, ret) 204 if (ret .ne. 0 ) then 205 print *,'Erreur à la création du modèle n°1 : ', gauss1_1 206 ret = -1 207 endif 208 209 C ** creation de la localisation des points de Gauss modèle n°2 ** 210 call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE, 211 1 ngauss1_2, gscoo1_2, wg1_2, gauss1_2, ret) 212 if (ret .ne. 0 ) then 213 print *,'Erreur à la création du modèle n°2 : ', gauss1_2 214 ret = -1 215 endif 216 217 218 C ** Ecriture du champ 1 219 C ** - enregistre uniquement la composante 2 de valr1_1 220 C ** - pas de pas de temps, ni de numero d ordre 221 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1, 222 1 gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD, 223 2 MED_MAILLE,MED_TRIA6, 224 3 MED_NOPDT,dtunit1,0.0,MED_NONOR,ret) 225 if (ret .ne. 0 ) then 226 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.1' 227 ret = -1 228 endif 229 230 C ** Nouvelle Ecriture du champ reel en mode remplacement 231 C ** - complete le champ precedent en enregistrant les composantes 1 232 C ** - pas de pas de temps, ni de numero d ordre 233 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1, 234 1 gauss1_1,1,MED_NOPFL,MED_NO_PFLMOD, 235 2 MED_MAILLE,MED_TRIA6, 236 3 MED_NOPDT,dtunit1,0.0,MED_NONOR,ret) 237 if (ret .ne. 0 ) then 238 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.2' 239 ret = -1 240 endif 241 242 C ** Ecriture sur le champ reel 243 C ** - De la 1ere composante du tableau valr1_2 244 C ** - Avec un pas de temps égal a 5.5 245 C ** - Pas de numero d ordre 246 C ** - maa2 est distant 247 dt = 5.5 248 call efchae(fid,maa2,nomcha1,valr1_2,USER_INTERLACE,nval1_2, 249 1 gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD, 250 2 MED_MAILLE,MED_TRIA6, 251 3 1,"ms",dt,MED_NONOR,ret) 252 if (ret .ne. 0 ) then 253 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.3' 254 ret = -1 255 endif 256 257 C ** Ecriture sur le champ reel 258 C ** - De la 2ere composante du tableau valr1_2 259 C ** - Avec un pas de temps égal a 5.5 260 C ** - Pas de numero d ordre 261 C ** - maa1 est local 262 dt = 5.5 263 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1, 264 1 gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD, 265 2 MED_MAILLE,MED_TRIA6, 266 3 1,"ms",dt,MED_NONOR,ret) 267 if (ret .ne. 0 ) then 268 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.4' 269 ret = -1 270 endif 271 272 273 C ** Ecriture sur le champ reel 274 C ** - De la 1ere composante du tableau valr1_1 275 C ** - Avec un pas de temps égal a 5.5 276 C ** - Numero d ordre egal a 2 277 C ** - maa3 est local 278 dt = 5.5 279 call efchae(fid,maa3,nomcha1,valr1_2,USER_INTERLACE,nval1_2, 280 1 gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD, 281 2 MED_MAILLE,MED_TRIA6, 282 3 1,"ms",dt,2,ret) 283 if (ret .ne. 0 ) then 284 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.5' 285 ret = -1 286 endif 287 288 C ** Creation de profil 289 C ** - qui selectionne uniquement le 2e element du tableau valr1 290 call efpfle(fid,profil1,1,nomprofil1,ret) 291 if (ret .ne. 0 ) then 292 print *,'Erreur à la création du profil : ', nomprofil1 293 ret = -1 294 endif 295 296 297 C ** Ecriture du champ reel 298 C ** - Toutes les composantes du 2e element de valr1_1 (MED_ALL) 299 C ** - Extrait a partir du profil de nom "profil1(1)" 300 C ** - Pas de temps = 5.6 301 C ** - Numero d ordre = 2 302 dt = 5.6 303 call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3, 304 1 MED_NOGAUSS,MED_ALL,nomprofil1,USER_MODE, 305 2 MED_MAILLE,MED_TRIA6, 306 3 2,"ms",dt,2,ret) 307 if (ret .ne. 0 ) then 308 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.6' 309 ret = -1 310 endif 311 312 C ** Ecriture du champ reel 313 C ** - Toutes les composantes du 2e element de valr1_1 (MED_ALL) 314 C ** - Extrait a partir du profil de nom "profil1(1)" 315 C ** - Pas de temps = 5.6 316 C ** - Numero d ordre = 2 317 dt = 5.6 318 call efchae(fid,maa2,nomcha1,valr1_2p,USER_INTERLACE,nval1_2, 319 1 gauss1_2,MED_ALL,nomprofil1,USER_MODE, 320 2 MED_MAILLE,MED_TRIA6, 321 3 2,"ms",dt,2,ret) 322 if (ret .ne. 0 ) then 323 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.7' 324 ret = -1 325 endif 326 327 328 C ** Ecriture du champ reel 329 C ** - 2e composante du 2e element du champ 330 C ** - Extrait a partir du profil de nom "profil1(1)" 331 C ** - Pas de temps = 5.7 332 C ** - Numero d ordre = 2 333 dt = 5.7 334 call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3, 335 1 MED_NOGAUSS,2,nomprofil1,USER_MODE, 336 2 MED_MAILLE,MED_TRIA6, 337 3 3,"ms",dt,2,ret) 338 if (ret .ne. 0 ) then 339 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.8' 340 ret = -1 341 endif 342 343 344 C ** Ecriture du champ entier n°2 345 C ** - 1ere composante des éléments de valr2 346 C ** - pas de pas de temps, ni de numero d ordre 347 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2, 348 1 MED_NOGAUSS,1,MED_NOPFL,MED_NO_PFLMOD,MED_ARETE, 349 1 MED_SEG2,MED_NOPDT,"",0.0,MED_NONOR,ret) 350 if (ret .ne. 0 ) then 351 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.1' 352 ret = -1 353 endif 354 355 C ** Ecriture du champ entier n°2 356 C ** - 2ere composante des éléments de valr2 357 C ** - pas de pas de temps, ni de numero d ordre 358 C ** - pour des raisons de complétude des tests on change 359 C ** le type d élément (aucun sens phys.)) 360 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2, 361 1 MED_NOGAUSS,2,MED_NOPFL,MED_NO_PFLMOD,MED_NOEUD, 362 1 0,MED_NOPDT,"",0.0,MED_NONOR,ret) 363 if (ret .ne. 0 ) then 364 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.2' 365 ret = -1 366 endif 367 368 369 C ** Ecriture du champ entier n°2 370 C ** - 3ere composante des éléments de valr2 371 C ** - pas de pas de temps, ni de numero d'ordre 372 C ** - pour des raisons de complétude des tests on change 373 C ** le type d'élément (aucun sens phys.)) 374 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2, 375 1 MED_NOGAUSS,3,MED_NOPFL,MED_NO_PFLMOD,MED_FACE, 376 1 MED_TRIA6,MED_NOPDT,"",0.0,MED_NONOR,ret) 377 if (ret .ne. 0 ) then 378 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.3' 379 ret = -1 380 endif 381 382 C ** Creation de profil 383 C ** - selectionne les elements 1,3,5 du tableau valr2 384 call efpfle(fid,profil2,3,"PROFIL(champ2)",ret) 385 if (ret .ne. 0 ) then 386 print *,'Erreur à l''écriture du profil : ', 'profil2(champ2)' 387 ret = -1 388 endif 389 390 391 C ** Ecriture du champ entier n°2 392 C ** - 3eme composante des éléments de valr2 393 C ** - pas de pas de temps, ni de numero d'ordre 394 C ** - profils 395 C ** - pour des raisons de complétude des tests on change 396 C ** le type d'élément (aucun sens phys.)) 397 call efchae(fid,maa1,nomcha2,valr2p,USER_INTERLACE,nval2, 398 1 MED_NOGAUSS,3,"PROFIL(champ2)",USER_MODE,MED_MAILLE, 399 1 MED_TRIA6,MED_NOPDT,"",0.0,MED_NONOR,ret) 400 if (ret .ne. 0 ) then 401 print *,'Erreur à l''écriture du profil : ', 'profil2(champ2)' 402 ret = -1 403 endif 404 405 C ** Fermeture du fichier * 406 call efferm (fid,ret) 407 if (ret .ne. 0 ) then 408 print *,'Erreur à la fermeture du fichier : ' 409 ret = -1 410 endif 411 412 print *,"Le code retour : ",ret 413 call efexit(ret) 414 415 end 416 417 418