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