1 !************************************************************************* 2 ! COPYRIGHT (C) 1999 - 2003 EDF R&D 3 ! THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY 4 ! IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE 5 ! AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION; 6 ! EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. 7 ! 8 ! THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT 9 ! WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF 10 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU 11 ! LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. 12 ! 13 ! YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE 14 ! ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION, 15 ! INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA 16 ! 17 !************************************************************************** 18 19 20 ! ****************************************************************************** 21 ! * - Nom du fichier : test11.f90 22 ! * 23 ! * - Description : lecture de champs de resultats MED 24 ! * 25 ! ***************************************************************************** 26 27 program test11 28 29 implicit none 30 include 'med.hf' 31 32 33 integer cret,ret,lret,retmem, fid 34 integer USER_INTERLACE,USER_MODE 35 character*32 :: maa,nomcha,pflname,nomlien,locname 36 character*200 desc 37 character*255 argc 38 character*16, allocatable, dimension(:) :: comp,unit 39 character*16 dtunit 40 integer mdim,ncomp,ncha,npro,nln,pflsize,nval 41 integer, allocatable, dimension(:) :: pflval 42 integer ngauss,nloc 43 integer t1,t2,t3,typcha,type,type_geo 44 real*8, allocatable, dimension(:) :: refcoo, gscoo, wg 45 character*255 lien 46 integer i,j 47 integer getFieldsOn 48 49 parameter (USER_INTERLACE = MED_FULL_INTERLACE) 50 parameter (USER_MODE = MED_COMPACT ) 51 52 cret=0;ret=0;lret=0;retmem=0 53 print *,"Indiquez le fichier med a decrire : " 54 !!read(*,'(A)') argc 55 argc="test10.med" 56 57 ! ** ouverture du fichier ** 58 call efouvr(fid,argc,MED_LECTURE, ret) 59 if (ret .ne. 0) call efexit(-1) 60 61 ! ** info sur le premier maillage ** 62 call efmaai(fid,1,maa,mdim,type,desc,ret) 63 if (ret.ne.0) then 64 print *, "Erreur a la lecture des informations sur le maillage : ", & 65 & maa,mdim,type,desc 66 call efexit(-1) 67 endif 68 69 write (*,'(/A,A,A,I1)') "Maillage de nom |",TRIM(maa),"| et de dimension ",mdim 70 71 ! ** combien de champs dans le fichier ** 72 call efncha(fid,0,ncha,ret) 73 if (ret.ne.0) then 74 print *, "Impossible de lire le nombre de champs : ",ncha 75 call efexit(-1) 76 endif 77 78 write (*,'(A,I1/)') "Nombre de champs : ",ncha 79 80 81 ! ** lecture de tous les champs associes a <maa> ** 82 do i=1,ncha 83 lret = 0 84 write(*,'(A,I5)') "- Champ numero : ",i 85 86 ! ** combien de composantes ** 87 call efncha(fid,i,ncomp,ret) 88 if (ret.ne.0) then 89 print *, "Erreur a la lecture du nombre de composantes : ",ncomp 90 cret = -1 91 endif 92 93 ! ** allocation memoire de comp et unit ** 94 allocate(comp(ncomp),unit(ncomp),STAT=retmem) 95 if (retmem .ne. 0) then 96 print *, "Erreur a l'allocation mémoire de comp et unit : " 97 call efexit(-1) 98 endif 99 100 ! ** Info sur les champs 101 call efchai(fid,i,nomcha,typcha,comp,unit,ncomp,ret) 102 if (ret .ne. 0) then 103 print *, "Erreur a la demande d'information sur les champs : ",nomcha,typcha,comp,unit,ncomp 104 cret = -1 105 continue 106 endif 107 108 write(*,'(/5X,A,A)') 'Nom du champ : ', TRIM(nomcha) 109 write(*,'(5X,A,I5)') 'Type du champ : ', typcha 110 do j=1,ncomp 111 write(*,'(5X,A,I1,A,A,A,A)') 'Composante ',j,' : ',TRIM(comp(j)),' ',TRIM(unit(j)) 112 enddo 113 114 deallocate(comp,unit) 115 print *,"" 116 117 lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_NOEUD, USER_INTERLACE ) 118 119 if (lret .eq. 0) then 120 lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_MAILLE, USER_INTERLACE ) 121 else 122 print *, "Erreur a la lecture des champs aux noeuds "; cret = -1; continue 123 endif 124 125 if (lret .eq. 0) then 126 lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_FACE,USER_INTERLACE) 127 else 128 print *,"Erreur a la lecture des champs aux mailles "; cret = -1; continue 129 endif 130 131 if (lret .eq. 0) then 132 lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_ARETE,USER_INTERLACE) 133 else 134 print *,"Erreur a la lecture des champs aux faces "; cret = -1; continue 135 endif 136 137 if (lret .ne. 0) then 138 print *,"Erreur a la lecture des champs aux aretes "; cret = -1 139 endif 140 141 enddo 142 143 144 call efnpro(fid,nval,ret) 145 write (*,'(5X,A,I2)') 'Nombre de profils stockés : ', nval 146 147 if (nval .gt. 0 ) then 148 do i=1,nval 149 call efproi(fid,i,pflname,nval,ret) 150 write (*,'(5X,A,I2,A,A,A,I2)') 'Profil n ',i,' : ',pflname, ' et de taille',nval 151 enddo 152 endif 153 154 ! ** Interrogation des liens ** 155 call efnlie(fid,nln,ret) 156 if (ret.ne.0) then 157 print *,"Erreur a la lecture du nombre de liens : " & 158 & ,nln 159 cret = -1; 160 else 161 print *,"" 162 print *,"Nombre de liens stockes : ",nln;print *,"";print *,"" 163 do i=1,nln 164 call efliei(fid, i, nomlien, nval, ret) 165 if (ret.ne.0) then 166 print *,"Erreur a la demande d'information sur le lien n° : ",i 167 cret = -1;continue; 168 endif 169 write (*,'(5X,A,I4,A,A,A,I4)'),"- Lien n°",i," de nom |",TRIM(nomlien),"| et de taille ",nval 170 !! allocate 171 lien = "" 172 call efliel(fid,lien,nval,nomlien,ret) 173 if (ret.ne.0) then 174 print *,"Erreur a la lecture du lien : ", lien,nval,nomlien 175 ret = -1; 176 else 177 write (*,'(5X,A,A,A)'),"|",TRIM(lien),"|";print *,"";print *,"" 178 endif 179 !!deallocate 180 end do 181 endif 182 183 ! ** Interrogation des localisations des points de GAUSS ** 184 call efngau(fid,nloc,ret) 185 if (ret.ne.0) then 186 print *,"Erreur a la lecture du nombre de points de Gauss : " & 187 & ,nloc 188 cret = -1; 189 else 190 print *,"Nombre de localisations stockees : ",nloc;print *,"";print *,"" 191 do i=1,nloc 192 call efgaui(fid, i, locname, type_geo, ngauss, ret) 193 if (ret.ne.0) then 194 print *,"Erreur a la demande d'information sur la localisation n° : ",i 195 cret = -1;continue; 196 endif 197 write (*,'(5X,A,I4,A,A,A,I4)'),"- Loc n°",i," de nom |",TRIM(locname) & 198 &,"| et nbr. de pts Gauss ",ngauss 199 t1 = MOD(type_geo,100)*(type_geo/100) 200 t2 = ngauss*(type_geo/100) 201 t3 = ngauss 202 allocate(refcoo(t1),STAT=retmem) 203 if (retmem .ne. 0) then 204 print *, "Erreur a l'allocation mémoire de refcoo : " 205 call efexit(-1) 206 endif; 207 allocate(gscoo(t2),STAT=retmem) 208 if (retmem .ne. 0) then 209 print *, "Erreur a l'allocation mémoire de gscoo : " 210 call efexit(-1) 211 endif; 212 allocate(wg(t3),STAT=retmem) 213 if (retmem .ne. 0) then 214 print *, "Erreur a l'allocation mémoire de wg : " 215 call efexit(-1) 216 endif; 217 call efgaul(fid, refcoo, gscoo, wg, USER_INTERLACE, locname, ret ) 218 if (ret.ne.0) then 219 print *,"Erreur a la lecture des valeurs de la localisation : " & 220 & ,locname 221 cret = -1; 222 else 223 write (*,'(5X,A,I4)'),"Coordonnees de l'element de reference de type ",type_geo 224 do j=1,t1 225 write(*,'(5X,E20.8)'),refcoo(j) 226 enddo 227 print *,"" 228 write (*,'(5X,A)'),"Localisation des points de GAUSS : " 229 do j=1,t2 230 write(*,'(5X,E20.8)'),gscoo(j) 231 enddo 232 print *,"" 233 write (*,'(5X,A)'),"Poids associes aux points de GAUSS " 234 do j=1,t3 235 write(*,'(5X,E20.8)'),wg(j) 236 enddo 237 print *,"" 238 endif 239 deallocate(refcoo) 240 deallocate(gscoo) 241 deallocate(wg) 242 enddo 243 endif 244 245 call efferm (fid,ret) 246 247 call efexit(cret) 248 249 end program test11 250 251 252 integer function getFieldsOn(fid, nomcha, typcha, ncomp, entite, stockage) 253 implicit none 254 include 'med.hf' 255 256 integer ::fid,typcha,ncomp,entite,stockage 257 character(LEN=*) nomcha 258 259 integer :: j,k,l,m,n,nb_geo,cret,ret,retmem,nvl,nref 260 integer :: nbpdtnor,pflsize,ngauss,nval 261 integer, allocatable, dimension(:) :: pflval 262 integer, allocatable, dimension(:) :: vale 263 integer :: numdt,numo,lnsize,nbrefmaa 264 real*8, allocatable, dimension(:) :: valr 265 real*8 dt 266 logical local 267 character*32 :: pflname,locname,maa_ass 268 character*16 :: dt_unit 269 character*255:: lien 270 integer USER_MODE 271 272 integer,pointer,dimension(:) :: type_geo 273 integer,target :: typ_noeud(1) = (/ MED_NONE /) 274 integer,target :: typmai(MED_NBR_GEOMETRIE_MAILLE+2) = (/ MED_POINT1,MED_SEG2, & 275 & MED_SEG3,MED_TRIA3, & 276 & MED_QUAD4,MED_TRIA6, & 277 & MED_QUAD8,MED_TETRA4, & 278 & MED_PYRA5,MED_PENTA6, & 279 & MED_HEXA8,MED_TETRA10, & 280 & MED_PYRA13,MED_PENTA15, & 281 & MED_HEXA20,MED_POLYGONE,& 282 & MED_POLYEDRE/) 283 284 integer,target :: typfac(MED_NBR_GEOMETRIE_FACE+1) = (/MED_TRIA3,MED_TRIA6, & 285 & MED_QUAD4,MED_QUAD8,MED_POLYGONE/) 286 integer,target ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,MED_SEG3/) 287 288 character(LEN=12),pointer,dimension(:) :: AFF 289 character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_MAILLE+2) :: FMED_GEOMETRIE_MAILLE_AFF = (/& 290 & "MED_POINT1 ",& 291 & "MED_SEG2 ",& 292 & "MED_SEG3 ",& 293 & "MED_TRIA3 ",& 294 & "MED_QUAD4 ",& 295 & "MED_TRIA6 ",& 296 & "MED_QUAD8 ",& 297 & "MED_TETRA4 ",& 298 & "MED_PYRA5 ",& 299 & "MED_PENTA6 ",& 300 & "MED_HEXA8 ",& 301 & "MED_TETRA10 ",& 302 & "MED_PYRA13 ",& 303 & "MED_PENTA15 ",& 304 & "MED_HEXA20 ",& 305 & "MED_POLYGONE",& 306 & "MED_POLYEDRE" /) 307 308 character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_FACE+1) :: FMED_GEOMETRIE_FACE_AFF = (/& 309 & "MED_TRIA3 ",& 310 & "MED_TRIA6 ",& 311 & "MED_QUAD4 ",& 312 & "MED_QUAD8 ",& 313 & "MED_POLYGONE" /) 314 315 character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_ARETE) :: FMED_GEOMETRIE_ARETE_AFF = (/& 316 & "MED_SEG2 ",& 317 & "MED_SEG3 " /) 318 319 character(LEN=12),target,dimension(1) :: FMED_GEOMETRIE_NOEUD_AFF = (/ & 320 & "(AUCUN) "/) 321 322 character(LEN=12),target,dimension(0:3) :: FMED_ENTITE_MAILLAGE_AFF =(/ & 323 & "MED_MAILLE ", & 324 & "MED_FACE ", & 325 & "MED_ARETE ", & 326 & "MED_NOEUD "/) 327 328 parameter (USER_MODE = MED_COMPACT ) 329 330 !! write(*,'(A0)'), FMED_GEOMETRIE_NOEUD_AFF(1) 331 !! write(*,'(A0)'), FMED_GEOMETRIE_MAILLE_AFF(1) 332 !! write(*,'(A0)'), FMED_GEOMETRIE_FACE_AFF(1) 333 !! write(*,'(A0)'), FMED_GEOMETRIE_ARETE_AFF(1) 334 335 nbpdtnor=0;pflsize=0;ngauss=0;nval=0 336 numdt = 0;numo=0;retmem=0 337 cret=0;ret=0 338 339 nullify(type_geo) 340 nullify(AFF) 341 342 343 select case (entite) 344 case (MED_NOEUD) 345 type_geo => typ_noeud 346 nb_geo = 1 347 AFF => FMED_GEOMETRIE_NOEUD_AFF 348 case (MED_MAILLE) 349 type_geo => typmai 350 nb_geo = MED_NBR_GEOMETRIE_MAILLE+2 351 AFF => FMED_GEOMETRIE_MAILLE_AFF 352 case (MED_FACE) 353 type_geo => typfac; 354 nb_geo = MED_NBR_GEOMETRIE_FACE+1 355 AFF => FMED_GEOMETRIE_FACE_AFF 356 case (MED_ARETE) 357 type_geo => typare 358 nb_geo = MED_NBR_GEOMETRIE_ARETE 359 AFF => FMED_GEOMETRIE_ARETE_AFF 360 end select 361 362 do k=1,nb_geo 363 364 ! ** Combien de (PDT,NOR) a lire ** 365 call efnpdt(fid,nomcha,entite,type_geo(k),nbpdtnor,ret) 366 if (ret.ne.0) then 367 print *, "Impossible de lire le nombre de pas de temps : " & 368 & ,k,nomcha,entite,FMED_ENTITE_MAILLAGE_AFF(entite) & 369 & ,type_geo(k),AFF(type_geo(k)) 370 cret = -1 371 end if 372 if(nbpdtnor < 1 ) continue 373 374 do j=1,nbpdtnor 375 376 377 call efpdti(fid, nomcha, entite, type_geo(k), & 378 & j, ngauss, numdt, numo, dt_unit, & 379 & dt, maa_ass, local, nbrefmaa, ret ) 380 if (ret.ne.0) then 381 print *, "Erreur a la demande d'information sur (pdt,nor) : " & 382 & ,nomcha,entite, type_geo(k), ngauss, numdt, numo, dt_unit & 383 & ,dt, maa_ass, local, nbrefmaa 384 cret = -1 385 end if 386 387 if (numdt .eq. MED_NOPDT) then 388 write(*,'(5X,A)') 'Pas de pas de temps' 389 else 390 write(*,'(5X,A,I5,A,E20.8,A,A,A)') 'Pas de temps n° ' & 391 & ,numdt,' (', dt ,') ', 'et d''unite ',TRIM(dt_unit) 392 endif 393 if (numo .eq. MED_NONOR) then 394 write(*,'(5X,A)') 'Pas de numero d''ordre' 395 else 396 write(*,'(5X,A,I5)') 'Numero d ordre : ', numo 397 endif 398 write(*,'(5X,A,I5)') 'Nombre de points de gauss : ',ngauss 399 write(*,'(5X,A,A)') 'Maillage associe : ', TRIM(maa_ass) 400 401 ! ** Le maillage reference est-il porte par un autre fichier ** 402 if ( local .eq. .false. ) then 403 call efnvli(fid,maa_ass,nvl,ret) 404 if (ret.ne.0) then 405 print *, "Erreur a la lecture de la taille du lien : " & 406 & , maa_ass, local, nvl 407 cret = -1 408 end if 409 !! allocate(lien(nvl),STAT=retmem) 410 if (retmem .ne. 0) then 411 print *, "Erreur a l'allocation mémoire de lien : " 412 call efexit(-1) 413 endif 414 call efliel(fid,lien,nvl,maa_ass,ret) 415 if (ret.ne.0) then 416 print *,"Erreur a la lecture du lien : " & 417 & ,maa_ass,lien 418 cret = -1 419 else 420 print *,lien 421 write(*,'(5X,A,A,A)'),'Le maillage |',maa_ass, & 422 & '| est porte par un fichier distant |' 423 write(*,'(5X,A,A)'),lien,'|' 424 endif 425 !! deallocate(lien) 426 endif 427 428 ! ** Combien de maillages lies aux (nomcha,ent,geo,numdt,numo) ** 429 ! ** Notons que cette information est egalement disponible ** 430 ! ** a partir de MEDpasdetempsInfo ** 431 call efnref(fid,nomcha,entite,type_geo(k),numdt,numo,nref,ret) 432 if (ret.ne.0) then 433 print *,"Erreur a la demande du nombre de maillages references par le champ : ", & 434 & nomcha,numdt,numo 435 cret = -1; continue 436 endif 437 438 do l=1,nbrefmaa 439 440 call efrefi(fid,nomcha,entite,type_geo(k), & 441 & l,numdt, numo, maa_ass, local, ngauss, ret) 442 if (ret.ne.0) then 443 print *,"Erreur a la demande d'information sur le maillage utilise par le champ n° : " & 444 & ,nomcha,entite,type_geo(k), & 445 & l,numdt, numo, maa_ass 446 cret = -1; continue 447 endif 448 449 ! ** Prend en compte le nbre de pt de gauss automatiquement ** 450 call efnval(fid,nomcha,entite,type_geo(k),numdt,numo,maa_ass,USER_MODE,nval,cret) 451 if (ret.ne.0) then 452 print *,"Erreur a la lecture du nombre de valeurs du champ : " & 453 & ,nomcha,entite,type_geo(k), & 454 & numdt, numo, maa_ass 455 cret = -1; continue 456 endif 457 write(*,'(5X,A,I5,A,I5,A,A,A,A,A,A,A,I5,A)') & 458 & 'Il y a ',nval,' valeurs en mode ',USER_MODE, & 459 & ' . Chaque entite ',TRIM(FMED_ENTITE_MAILLAGE_AFF(entite)), & 460 & ' de type geometrique ',TRIM(AFF(k)),' associes au maillage |',maa_ass, & 461 & '| a ',ngauss,' pts de gauss ' 462 463 ! ** Le maillage reference est-il porte par un autre fichier ** 464 if ( local .eq. .false. ) then 465 466 call efnvli(fid,maa_ass,nvl,ret) 467 if (ret.ne.0) then 468 print *, "Erreur a la lecture de la taille du lien : " & 469 & , maa_ass, local, nvl 470 cret = -1 471 end if 472 473 !! allocate(lien(nvl),STAT=retmem) 474 if (retmem .ne. 0) then 475 print *, "Erreur a l'allocation mémoire de comp et unit : " 476 call efexit(-1) 477 endif 478 479 call efliel(fid,lien,nvl,maa_ass,ret) 480 if (ret.ne.0) then 481 print *,"Erreur a la lecture du lien : " & 482 & ,maa_ass,lien 483 cret = -1 484 else 485 write(*,'(5X,A,A,A,A,A)') 'Le maillage |',maa_ass, & 486 & '| est porte par un fichier distant |',lien,'|' 487 endif 488 !! deallocate(lien) 489 endif 490 491 ! **Lecture des valeurs du champ ** 492 if (typcha .eq. MED_FLOAT64) then 493 allocate(valr(ncomp*nval),STAT=retmem) 494 495 call efchal(fid,maa_ass,nomcha,valr,stockage,MED_ALL,locname, & 496 & pflname,USER_MODE,entite,type_geo(k),numdt,numo,ret) 497 498 if (ret.ne.0) then 499 print *,"Erreur a la lecture du nombre de valeurs du champ : ", & 500 & maa_ass,nomcha,valr,stockage,MED_ALL,locname, & 501 & pflname,USER_MODE,entite,type_geo(k),numdt,numo 502 cret = -1; 503 endif 504 else 505 allocate(vale(ncomp*nval),STAT=retmem) 506 507 call efchal(fid,maa_ass,nomcha,vale,stockage,MED_ALL,locname, & 508 & pflname,USER_MODE,entite,type_geo(k),numdt,numo,ret) 509 if (ret.ne.0) then 510 print *,"Erreur a la lecture des valeurs du champ : ",& 511 & maa_ass,nomcha,vale,stockage,MED_ALL,locname, & 512 & pflname,USER_MODE,entite,type_geo(k),numdt,numo 513 cret = -1; 514 endif 515 516 endif 517 518 select case (stockage) 519 case (MED_FULL_INTERLACE) 520 write(*,'(5X,A)'),"- Valeurs :"; write(*,'(5X,A)'),"" 521 do m=0,(nval/ngauss-1) 522 write(*,*),"|" 523 do n=0,(ngauss*ncomp-1) 524 if (typcha .eq. MED_FLOAT64) then 525 write(*,'(1X,E20.5,1X)'),valr( m*ngauss*ncomp+n +1 ) 526 else 527 write(*,'(1X,I8,1X)'),vale( m*ngauss*ncomp+n +1 ) 528 end if 529 enddo 530 enddo 531 case (MED_NO_INTERLACE) 532 write(*,'(5X,A)'),"- Valeurs :"; write(*,'(5X,A)'),"" 533 do m=0,ncomp-1 534 write(*,*),"|" 535 do n=0,nval-1 536 if (typcha .eq. MED_FLOAT64) then 537 write(*,'(1X,E20.5,1X)'),valr(m*nval+n +1) 538 else 539 write(*,'(1X,I8,1X)'),vale(m*nval+n +1) 540 endif 541 enddo 542 enddo 543 end select 544 545 write(*,*),"|" 546 if (typcha .eq. MED_FLOAT64) then 547 deallocate(valr) 548 else 549 deallocate(vale) 550 endif 551 552 !* Profils 553 if (pflname .eq. MED_NOPFL) then 554 write(*,'(5X,A)') 'Pas de profil' 555 else 556 write(*,'(5X,A,A)') 'Profil :',pflname 557 call efnpfl(fid,pflname,pflsize,ret) 558 if (ret .ne. 0) then 559 print *,"Erreur a la lecture du nombre de valeurs du profil : ", & 560 & pflname,pflsize 561 cret = -1;continue 562 endif 563 write(*,'(5X,A,I5)') 'Taille du profil : ',pflsize 564 565 ! ** allocation memoire de pflval ** 566 allocate(pflval(pflsize),STAT=retmem) 567 if (retmem .ne. 0) then 568 print *, "Erreur a l'allocation mémoire de pflsize : " 569 call efexit(-1) 570 endif 571 572 call efpfll(fid,pflval,pflname,ret) 573 if (cret .ne. 0) write(*,'(I1)') cret 574 if (ret .ne. 0) then 575 print *,"Erreur a la lecture du profil : ", & 576 & pflname,pflval 577 cret = -1;continue 578 endif 579 write(*,'(5X,A)') 'Valeurs du profil : ' 580 do m=1,pflsize 581 write (*,'(5X,I6)') pflval(m) 582 enddo 583 584 deallocate(pflval) 585 586 endif 587 588 enddo 589 590 enddo 591 592 enddo 593 594 print *,"" 595 getFieldsOn=ret 596 597 end function getFieldsOn