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