1C* This file is part of MED. 2C* 3C* COPYRIGHT (C) 1999 - 2019 EDF R&D, CEA/DEN 4C* MED is free software: you can redistribute it and/or modify 5C* it under the terms of the GNU Lesser General Public License as published by 6C* the Free Software Foundation, either version 3 of the License, or 7C* (at your option) any later version. 8C* 9C* MED is distributed in the hope that it will be useful, 10C* but WITHOUT ANY WARRANTY; without even the implied warranty of 11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12C* GNU Lesser General Public License for more details. 13C* 14C* You should have received a copy of the GNU Lesser General Public License 15C* along with MED. If not, see <http://www.gnu.org/licenses/>. 16C* 17 18C ****************************************************************************** 19C * - Nom du fichier : test10.f 20C * 21C * - Description : ecriture de champs de resultats MED 22C * 23C ****************************************************************************** 24 program test10 25C 26 implicit none 27 include 'med.hf' 28C 29 integer*8 fid 30 integer ret,USER_INTERLACE,USER_MODE 31 real*8 a,b,p1,p2,dt 32 33 character*32 maa1,maa2,maa3 34 character*13 lien_maa2 35C CHAMP N°1 36 character*32 nomcha1 37 character*16 comp1(2), unit1(2) 38 character*16 dtunit1, nounit 39 integer ncomp1 40C MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1 41 integer ngauss1_1 42 character*32 gauss1_1 43 real*8 refcoo1(12), gscoo1_1(12), wg1_1(6) 44 integer nval1_1 45 real*8 valr1_1(1*6*2) 46C MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1 47 integer ngauss1_2 48 character*32 gauss1_2 49 real*8 gscoo1_2(6), wg1_2(3) 50 integer nval1_2 51 real*8 valr1_2(2*3*2) 52 real*8 valr1_2p(2*3) 53C MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1 54 integer ngauss1_3,nval1_3 55 real*8 valr1_3(2*3*2) 56 real*8 valr1_3p(2*2) 57 58C CHAMP N°2 59 character*32 nomcha2 60 character*16 comp2(3), unit2(3) 61 integer ncomp2, nval2 62 integer valr2(5*3), valr2p(3*3) 63 64C CHAMP N°3 65 character*32 nomcha3 66 character*16 comp3(2), unit3(2) 67 integer ncomp3, nval3 68 integer valr3(5*4*2), valr3p(3*4*2) 69 70C PROFILS UTILISES 71 character*32 nomprofil1 72 integer profil1(2) , profil2(3) 73 74 parameter (USER_INTERLACE = MED_FULL_INTERLACE) 75 parameter (USER_MODE = MED_COMPACT ) 76 parameter ( a=0.446948490915965D0, b=0.091576213509771D0 ) 77 parameter ( p1=0.11169079483905D0, p2=0.0549758718227661D0 ) 78C MAILLAGES 79 parameter ( maa1 = "maa1", maa2 = "maa2", maa3 = "maa3" ) 80 parameter ( lien_maa2= "./testfoo.med" ) 81C CHAMP N°1 82 parameter ( nomcha1 = "champ reel" ) 83 parameter ( ncomp1 = 2 ) 84 parameter ( dtunit1 = " ") 85 parameter ( nounit = " ") 86C MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1 87 parameter ( gauss1_1 = "Model n1" ) 88 parameter ( ngauss1_1 = 6 ) 89C MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1 90 parameter ( gauss1_2 = "Model n2" ) 91 parameter ( ngauss1_2 = 3 ) 92C MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1 93 parameter ( ngauss1_3 = 6 ) 94 parameter ( nval1_3 = 6 ) 95C CHAMP N°2 96 parameter ( nomcha2="champ entier") 97 parameter ( ncomp2 = 3, nval2= 5 ) 98C CHAMP N°3 99 parameter ( nomcha3="champ entier 3") 100 parameter ( ncomp3 = 2, nval3= 5*4 ) 101C PROFILS 102 parameter ( nomprofil1 = "PROFIL(champ(1))" ) 103 104 105C CHAMP N°1 106 data comp1 /"comp1", "comp2"/ 107 data unit1 /"unit1","unit2"/ 108C MODEL N°1 DE LOC. DES PTS DE GAUSS PR CHAMP1 109 data nval1_1 / 1*6 / 110 data refcoo1 / -1.0,1.0, -1.0,-1.0, 1.0,-1.0, -1.0,0.0, 111 1 0.0,-1.0, 0.0,0.0 / 112 data valr1_1 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0, 113 1 20.0,21.0, 22.0,23.0/ 114C MODEL N°2 DE LOC. DES PTS DE GAUSS PR CHAMP1 115 data valr1_2 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 116 1 12.0,13.0, 20.0,21.0, 22.0,23.0 / 117 data valr1_2p / 12.0,13.0, 20.0,21.0, 22.0,23.0 / 118C MODEL N°3 DE LOC. DES PTS DE GAUSS PR CHAMP1 119 data valr1_3 / 0.0,1.0, 2.0,3.0, 10.0,11.0, 12.0,13.0, 120 1 20.0,21.0, 22.0,23.0 / 121 data valr1_3p / 2.0,3.0, 10.0,11.0 / 122C CHAMP N°2 123 data comp2 /"comp1", "comp2", "comp3"/ 124 data unit2 /"unit1","unit2", "unit3"/ 125 data valr2 / 0,1,2, 10,11,12, 20,21,22, 30,31,32, 40,41,42 / 126 data valr2p / 0,1,2, 20,21,22, 40,41,42 / 127C CHAMP N°3 128 data comp3 /"comp1", "comp2"/ 129 data unit3 /"unit1","unit2"/ 130 data valr3 / 0,1, 10,11, 20,21, 30,31, 131 1 40,41, 50,51, 60,61, 70,71, 132 1 80,81, 90,91, 100,101, 110,111, 133 1 120,121, 130,131, 140,141, 150,151, 134 1 160,161, 170,171, 180,181, 190,191 / 135 data valr3p / 0,1, 10,11, 20,21, 30,31, 136 1 80,81, 90,91, 100,101, 110,111, 137 1 160,161, 170,171, 180,181, 190,191 / 138 139 140C PROFILS 141 data profil1 /2,3/ 142 data profil2 /1,3,5/ 143 144 ret = 0 145 146 gscoo1_1(1) = 2*b-1 147 gscoo1_1(2) = 1-4*b 148 gscoo1_1(3) = 2*b-1 149 gscoo1_1(4) = 2*b-1 150 gscoo1_1(5) = 1-4*b 151 gscoo1_1(6) = 2*b-1 152 gscoo1_1(7) = 1-4*a 153 gscoo1_1(8) = 2*a-1 154 gscoo1_1(9) = 2*a-1 155 gscoo1_1(10) = 1-4*a 156 gscoo1_1(11) = 2*a-1 157 gscoo1_1(12) = 2*a-1 158 159 wg1_1(1) = 4*p2 160 wg1_1(2) = 4*p2 161 wg1_1(3) = 4*p2 162 wg1_1(4) = 4*p1 163 wg1_1(5) = 4*p1 164 wg1_1(6) = 4*p1 165 166 nval1_2 = 2*3 167 gscoo1_2(1) = -2.0D0/3 168 gscoo1_2(2) = 1.0D0/3 169 gscoo1_2(3) = -2.0D0/3 170 gscoo1_2(4) = -2.0D0/3 171 gscoo1_2(5) = 1.0D0/3 172 gscoo1_2(6) = -2.0D0/3 173 174 wg1_2(1) = 2.0D0/3 175 wg1_2(2) = 2.0D0/3 176 wg1_2(3) = 2.0D0/3 177 178C ** ouverture du fichier ** 179 call efouvr(fid,'test10.med',MED_LECTURE_ECRITURE, ret) 180 if (ret .ne. 0 ) then 181 print *,'Erreur à l''ouverture du fichier : ','test10.med' 182 call efexit(-1) 183 endif 184 185C ** creation du maillage maa1 de dimension 3 ** 186 call efmaac(fid,maa1,3,MED_NON_STRUCTURE, 187 1 "Maillage vide",ret) 188 if (ret .ne. 0 ) then 189 print *,'Erreur à la création du maillage : ', maa1 190 call efexit(-1) 191 endif 192 193C ** creation du maillage maa3 de dimension 3 ** 194 call efmaac(fid,maa3,3,MED_NON_STRUCTURE, 195 1 "Maillage vide",ret) 196 if (ret .ne. 0 ) then 197 print *,'Erreur à la création du maillage : ', maa3 198 call efexit(-1) 199 endif 200 201 202C ** creation du champ réel n°1 ** 203 call efchac(fid,nomcha1,MED_FLOAT64,comp1,unit1,ncomp1,ret) 204 if (ret .ne. 0 ) then 205 print *,'Erreur à la création du champ : ', nomcha1 206 call efexit(-1) 207 endif 208 209C ** creation du champ entier n°2 ** 210 call efchac(fid,nomcha2,MED_INT32,comp2,unit2,ncomp2,ret) 211 if (ret .ne. 0 ) then 212 print *,'Erreur à la création du champ : ', nomcha2 213 call efexit(-1) 214 endif 215 216C ** creation du lien au fichier distant contenant maa2 ** 217 call efliee(fid,lien_maa2,maa2,ret) 218 if (ret .ne. 0 ) then 219 print *,'Erreur à la création du lien : ', lien_maa2 220 call efexit(-1) 221 endif 222 223C ** creation de la localisation des points de Gauss modèle n°1 ** 224 call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE, 225 1 ngauss1_1, gscoo1_1, wg1_1, gauss1_1, ret) 226 if (ret .ne. 0 ) then 227 print *,'Erreur à la création du modèle n°1 : ', gauss1_1 228 call efexit(-1) 229 endif 230 231C ** creation de la localisation des points de Gauss modèle n°2 ** 232 call efgaue(fid, MED_TRIA6, refcoo1, USER_INTERLACE, 233 1 ngauss1_2, gscoo1_2, wg1_2, gauss1_2, ret) 234 if (ret .ne. 0 ) then 235 print *,'Erreur à la création du modèle n°2 : ', gauss1_2 236 call efexit(-1) 237 endif 238 239 240C ** Ecriture du champ n°1 241C ** - enregistre uniquement la composante n°2 de valr1_1 242C ** - pas de pas de temps, ni de numero d'ordre 243 dt = 0.0D0 244 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1, 245 1 gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD, 246 2 MED_MAILLE,MED_TRIA6, 247 3 MED_NOPDT,dtunit1,dt,MED_NONOR,ret) 248 if (ret .ne. 0 ) then 249 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.1' 250 call efexit(-1) 251 endif 252 253C ** Nouvelle Ecriture du champ reel en mode remplacement 254C ** - complete le champ precedent en enregistrant les composantes 1 255C ** - pas de pas de temps, ni de numero d'ordre 256 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1, 257 1 gauss1_1,1,MED_NOPFL,MED_NO_PFLMOD, 258 2 MED_MAILLE,MED_TRIA6, 259 3 MED_NOPDT,dtunit1,dt,MED_NONOR,ret) 260 if (ret .ne. 0 ) then 261 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.2' 262 call efexit(-1) 263 endif 264 265C ** Ecriture sur le champ reel 266C ** - De la 1ere composante du tableau valr1_2 267C ** - Avec un pas de temps égal a 5.5 268C ** - Pas de numero d'ordre 269C ** - maa2 est distant 270 dt = 5.5D0 271 call efchae(fid,maa2,nomcha1,valr1_2,USER_INTERLACE,nval1_2, 272 1 gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD, 273 2 MED_MAILLE,MED_TRIA6, 274 3 1,"ms",dt,MED_NONOR,ret) 275 if (ret .ne. 0 ) then 276 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.3' 277 call efexit(-1) 278 endif 279 280C ** Ecriture sur le champ reel 281C ** - De la 2ere composante du tableau valr1_2 282C ** - Avec un pas de temps égal a 5.5 283C ** - Pas de numero d'ordre 284C ** - maa1 est local 285 dt = 5.5D0 286 call efchae(fid,maa1,nomcha1,valr1_1,USER_INTERLACE,nval1_1, 287 1 gauss1_1,2,MED_NOPFL,MED_NO_PFLMOD, 288 2 MED_MAILLE,MED_TRIA6, 289 3 1,"ms",dt,MED_NONOR,ret) 290 if (ret .ne. 0 ) then 291 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.4' 292 call efexit(-1) 293 endif 294 295 296C ** Ecriture sur le champ reel 297C ** - De la 1ere composante du tableau valr1_1 298C ** - Avec un pas de temps égal a 5.5 299C ** - Numero d'ordre egal a 2 300C ** - maa3 est local 301 dt = 5.5D0 302 call efchae(fid,maa3,nomcha1,valr1_2,USER_INTERLACE,nval1_2, 303 1 gauss1_2,1,MED_NOPFL,MED_NO_PFLMOD, 304 2 MED_MAILLE,MED_TRIA6, 305 3 1,"ms",dt,2,ret) 306 if (ret .ne. 0 ) then 307 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.5' 308 call efexit(-1) 309 endif 310 311C ** Creation de profil 312C ** - qui selectionne uniquement le 2e element du tableau valr1 313 call efpfle(fid,profil1,1,nomprofil1,ret) 314 if (ret .ne. 0 ) then 315 print *,'Erreur à la création du profil : ', nomprofil1 316 call efexit(-1) 317 endif 318 319 320C ** Ecriture du champ reel 321C ** - Toutes les composantes du 2e element de valr1_1 (MED_ALL) 322C ** - Extrait a partir du profil de nom "profil1(1)" 323C ** - Pas de temps = 5.6 324C ** - Numero d'ordre = 2 325 dt = 5.6D0 326 call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3, 327 1 MED_NOGAUSS,MED_ALL,nomprofil1,USER_MODE, 328 2 MED_MAILLE,MED_TRIA6, 329 3 2,"ms",dt,2,ret) 330 if (ret .ne. 0 ) then 331 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.6' 332 call efexit(-1) 333 endif 334 335C ** Ecriture du champ reel 336C ** - Toutes les composantes du 2e element de valr1_1 (MED_ALL) 337C ** - Extrait a partir du profil de nom "profil1(1)" 338C ** - Pas de temps = 5.6 339C ** - Numero d'ordre = 2 340 dt = 5.6D0 341 call efchae(fid,maa2,nomcha1,valr1_2p,USER_INTERLACE,nval1_2, 342 1 gauss1_2,MED_ALL,nomprofil1,USER_MODE, 343 2 MED_MAILLE,MED_TRIA6, 344 3 2,"ms",dt,2,ret) 345 if (ret .ne. 0 ) then 346 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.7' 347 call efexit(-1) 348 endif 349 350 351C ** Ecriture du champ reel 352C ** - 2e composante du 2e element du champ 353C ** - Extrait a partir du profil de nom "profil1(1)" 354C ** - Pas de temps = 5.7 355C ** - Numero d'ordre = 2 356 dt = 5.7D0 357 call efchae(fid,maa1,nomcha1,valr1_3p,USER_INTERLACE,nval1_3, 358 1 MED_NOGAUSS,2,nomprofil1,USER_MODE, 359 2 MED_MAILLE,MED_TRIA6, 360 3 3,"ms",dt,2,ret) 361 if (ret .ne. 0 ) then 362 print *,'Erreur à l''écriture du champ : ', nomcha1,'et.8' 363 call efexit(-1) 364 endif 365 366 367C ** Ecriture du champ entier n°2 368C ** - 1ere composante des éléments de valr2 369C ** - pas de pas de temps, ni de numero d'ordre 370 dt = 0.0D0 371 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2, 372 1 MED_NOGAUSS,1,MED_NOPFL,MED_NO_PFLMOD,MED_ARETE, 373 1 MED_SEG2,MED_NOPDT,nounit,dt,MED_NONOR,ret) 374 if (ret .ne. 0 ) then 375 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.1' 376 call efexit(-1) 377 endif 378 379C ** Ecriture du champ entier n°2 380C ** - 2ere composante des éléments de valr2 381C ** - pas de pas de temps, ni de numero d'ordre 382C ** - pour des raisons de complétude des tests on change 383C ** le type d'élément (aucun sens phys.)) 384 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2, 385 1 MED_NOGAUSS,2,MED_NOPFL,MED_NO_PFLMOD,MED_NOEUD, 386 1 0,MED_NOPDT,nounit,dt,MED_NONOR,ret) 387 if (ret .ne. 0 ) then 388 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.2' 389 call efexit(-1) 390 endif 391 392 393C ** Ecriture du champ entier n°2 394C ** - 3ere composante des éléments de valr2 395C ** - pas de pas de temps, ni de numero d'ordre 396C ** - pour des raisons de complétude des tests on change 397C ** le type d'élément (aucun sens phys.)) 398 call efchae(fid,maa1,nomcha2,valr2,USER_INTERLACE,nval2, 399 1 MED_NOGAUSS,3,MED_NOPFL,MED_NO_PFLMOD,MED_FACE, 400 1 MED_TRIA6,MED_NOPDT,nounit,dt,MED_NONOR,ret) 401 if (ret .ne. 0 ) then 402 print *,'Erreur à l''écriture du champ : ', nomcha2,'et.3' 403 call efexit(-1) 404 endif 405 406C ** Creation de profil 407C ** - selectionne les elements 1,3,5 du tableau valr2 408 call efpfle(fid,profil2,3,"PROFIL(champ2)",ret) 409 if (ret .ne. 0 ) then 410 print *,'Erreur à l''écriture du profil : ', 411 1 'profil2(champ2)' 412 call efexit(-1) 413 endif 414 415 416C ** Ecriture du champ entier n°2 417C ** - 3eme composante des éléments de valr2 418C ** - pas de pas de temps, ni de numero d'ordre 419C ** - profils 420C ** - pour des raisons de complétude des tests on change 421C ** le type d'élément (aucun sens phys.)) 422 call efchae(fid,maa1,nomcha2,valr2p,USER_INTERLACE,nval2, 423 1 MED_NOGAUSS,3,"PROFIL(champ2)",USER_MODE,MED_MAILLE, 424 1 MED_TRIA6,MED_NOPDT,nounit,dt,MED_NONOR,ret) 425 if (ret .ne. 0 ) then 426 print *,'Erreur à l''écriture du profil : ', 427 1 'profil2(champ2)' 428 call efexit(-1) 429 endif 430 431C ** creation du champ entier n°3 ** 432 call efchac(fid,nomcha3,MED_INT32,comp3,unit3,ncomp3,ret) 433 if (ret .ne. 0 ) then 434 print *,'Erreur à la création du champ : ', nomcha3 435 call efexit(-1) 436 endif 437 438C ** Ecriture du champ entier n°3 439C ** - 1ere composante des éléments de valr3 440C ** - pas de pas de temps, ni de numero d'ordre 441C ** - pour des raisons de complétude des tests on change 442C ** le type d'élément (aucun sens phys.)) 443 call efchae(fid,maa1,nomcha3,valr3,USER_INTERLACE,nval3, 444 1 MED_NOGAUSS,1,MED_NOPFL,MED_NO_PFLMOD,MED_NOEUD_MAILLE, 445 1 MED_QUAD4,MED_NOPDT,nounit,dt,MED_NONOR,ret) 446 if (ret .ne. 0 ) then 447 print *,'Erreur à l''écriture du champ : ', nomcha3,'et.1' 448 call efexit(-1) 449 endif 450 451C ** Ecriture du champ entier n°3 452C ** - les composantes des éléments de valr3 453C ** - pas de pas de temps, ni de numero d'ordre 454C ** - pour des raisons de complétude des tests on change 455C ** le type d'élément (aucun sens phys.)) 456 call efchae(fid,maa2,nomcha3,valr3,USER_INTERLACE,nval3, 457 1 MED_NOGAUSS,MED_ALL,MED_NOPFL,MED_NO_PFLMOD, 458 1 MED_NOEUD_MAILLE, 459 1 MED_QUAD4,MED_NOPDT,nounit,dt,MED_NONOR,ret) 460 if (ret .ne. 0 ) then 461 print *,'Erreur à l''écriture du champ : ', nomcha3,'et.2' 462 call efexit(-1) 463 endif 464 465C ** Ecriture du champ entier n°3 466C ** - les composantes des éléments de valr3 467C ** - pas de pas de temps, ni de numero d'ordre 468C ** - profils 469C ** - pour des raisons de complétude des tests on change 470C ** le type d'élément (aucun sens phys.)) 471 call efchae(fid,maa3,nomcha3,valr3p,USER_INTERLACE,nval3, 472 1 MED_NOGAUSS,MED_ALL,"PROFIL(champ2)",USER_MODE, 473 1 MED_NOEUD_MAILLE, 474 1 MED_QUAD4,MED_NOPDT,nounit,dt,MED_NONOR,ret) 475 if (ret .ne. 0 ) then 476 print *,'Erreur à l''écriture du profil : ', 477 1 'profil2(champ2)' 478 call efexit(-1) 479 endif 480 481C ** Fermeture du fichier * 482 call efferm (fid,ret) 483 if (ret .ne. 0 ) then 484 print *,'Erreur à la fermeture du fichier : ' 485 ret = -1 486 endif 487 488 print *,"Le code retour : ",ret 489 call efexit(ret) 490 491 end 492 493 494 495