1 !*************************************************************************
  2 ! COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
  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 .eq. 0) then
138         lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_NOEUD_MAILLE,USER_INTERLACE)
139      else
140         print *,"Erreur a la lecture des champs aux aretes "; cret = -1; continue
141      endif
142 
143      if  (lret .ne. 0) then
144         print *,"Erreur a la lecture des champs aux noeuds des mailles "; cret = -1
145      endif
146 
147   enddo
148 
149 
150   call efnpro(fid,nval,ret)
151   write (*,'(5X,A,I2)') 'Nombre de profils stockés : ', nval
152 
153   if (nval .gt. 0 ) then
154      do i=1,nval
155         call efproi(fid,i,pflname,nval,ret)
156         write (*,'(5X,A,I2,A,A,A,I2)') 'Profil n ',i,' : ',pflname, ' et de taille',nval
157      enddo
158   endif
159 
160   !  ** Interrogation des liens **
161   call efnlie(fid,nln,ret)
162   if (ret.ne.0) then
163      print *,"Erreur a la lecture du nombre de liens : " &
164           & ,nln
165      cret = -1;
166   else
167      print *,""
168      print *,"Nombre de liens stockes : ",nln;print *,"";print *,""
169      do i=1,nln
170         call efliei(fid, i, nomlien, nval, ret)
171         if (ret.ne.0) then
172            print *,"Erreur a la demande d'information sur le lien n° : ",i
173            cret = -1;continue;
174         endif
175         write (*,'(5X,A,I4,A,A,A,I4)') "- Lien n°",i," de nom |",TRIM(nomlien),"| et de taille ",nval
176         !! allocate
177         lien = ""
178         call efliel(fid,lien,nval,nomlien,ret)
179         if (ret.ne.0) then
180            print *,"Erreur a la lecture du lien : ", lien,nval,nomlien
181            ret = -1;
182         else
183            write (*,'(5X,A,A,A)') "|",TRIM(lien),"|";print *,"";print *,""
184         endif
185         !!deallocate
186      end do
187   endif
188 
189   !  ** Interrogation des localisations des points de GAUSS **
190   call efngau(fid,nloc,ret)
191   if (ret.ne.0) then
192      print *,"Erreur a la lecture du nombre de points de Gauss : " &
193           & ,nloc
194      cret = -1;
195   else
196      print *,"Nombre de localisations stockees : ",nloc;print *,"";print *,""
197      do i=1,nloc
198         call efgaui(fid, i, locname, type_geo, ngauss, ret)
199         if (ret.ne.0) then
200            print *,"Erreur a la demande d'information sur la localisation n° : ",i
201            cret = -1;continue;
202         endif
203         write (*,'(5X,A,I4,A,A,A,I4)') "- Loc n°",i," de nom |",TRIM(locname) &
204              &,"| et nbr. de pts Gauss ",ngauss
205         t1 = MOD(type_geo,100)*(type_geo/100)
206         t2 = ngauss*(type_geo/100)
207         t3 = ngauss
208         allocate(refcoo(t1),STAT=retmem)
209         if (retmem .ne. 0) then
210            print *, "Erreur a l'allocation mémoire de refcoo : "
211            call efexit(-1)
212         endif;
213         allocate(gscoo(t2),STAT=retmem)
214         if (retmem .ne. 0) then
215            print *, "Erreur a l'allocation mémoire de gscoo : "
216            call efexit(-1)
217         endif;
218         allocate(wg(t3),STAT=retmem)
219         if (retmem .ne. 0) then
220            print *, "Erreur a l'allocation mémoire de wg : "
221            call efexit(-1)
222         endif;
223         call efgaul(fid, refcoo, gscoo, wg, USER_INTERLACE, locname, ret )
224         if (ret.ne.0) then
225            print *,"Erreur a la lecture  des valeurs de la localisation : " &
226                 & ,locname
227            cret = -1;
228         else
229            write (*,'(5X,A,I4)') "Coordonnees de l'element de reference de type ",type_geo
230            do j=1,t1
231               write (*,'(5X,E20.8)') refcoo(j)
232            enddo
233            print *,""
234            write (*,'(5X,A)') "Localisation des points de GAUSS : "
235            do j=1,t2
236               write (*,'(5X,E20.8)') gscoo(j)
237            enddo
238            print *,""
239            write (*,'(5X,A)') "Poids associes aux points de GAUSS "
240            do j=1,t3
241               write (*,'(5X,E20.8)') wg(j)
242            enddo
243            print *,""
244         endif
245         deallocate(refcoo)
246         deallocate(gscoo)
247         deallocate(wg)
248      enddo
249   endif
250 
251   call efferm (fid,ret)
252 
253   call efexit(cret)
254 
255 end program test11
256 
257 
258 integer function getFieldsOn(fid, nomcha, typcha, ncomp, entite, stockage)
259   implicit none
260   include 'med.hf'
261 
262   integer      ::fid,typcha,ncomp,entite,stockage
263   character(LEN=*)  nomcha
264 
265   integer      :: j,k,l,m,n,nb_geo,cret,ret,retmem,nvl,nref
266   integer      :: nbpdtnor,pflsize,ngauss,ngroup,nval
267   integer,     allocatable, dimension(:) :: pflval
268   integer,     allocatable, dimension(:) :: vale
269   integer      :: numdt,numo,lnsize,nbrefmaa
270   real*8,      allocatable, dimension(:) :: valr
271   real*8       dt
272   logical      local
273   character*32 :: pflname,locname,maa_ass
274   character*16 :: dt_unit
275   character*255:: lien
276   integer       USER_MODE
277 
278   integer,pointer,dimension(:) :: type_geo
279   integer,target  :: typ_noeud(1) = (/ MED_NONE /)
280   integer,target  :: typmai(MED_NBR_GEOMETRIE_MAILLE+2) =  (/ MED_POINT1,MED_SEG2,   &
281        &  MED_SEG3,MED_TRIA3,     &
282        &  MED_QUAD4,MED_TRIA6,    &
283        &  MED_QUAD8,MED_TETRA4,   &
284        &  MED_PYRA5,MED_PENTA6,   &
285        &  MED_HEXA8,MED_TETRA10,  &
286        &  MED_PYRA13,MED_PENTA15,  &
287        &  MED_HEXA20,MED_POLYGONE,&
288        &  MED_POLYEDRE/)
289 
290   integer,target :: typfac(MED_NBR_GEOMETRIE_FACE+1) = (/MED_TRIA3,MED_TRIA6,       &
291        &  MED_QUAD4,MED_QUAD8,MED_POLYGONE/)
292   integer,target ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,MED_SEG3/)
293 
294   character(LEN=12),pointer,dimension(:) :: AFF
295   character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_MAILLE+2) :: FMED_GEOMETRIE_MAILLE_AFF = (/&
296        &  "MED_POINT1  ",&
297        &  "MED_SEG2    ",&
298        &  "MED_SEG3    ",&
299        &  "MED_TRIA3   ",&
300        &  "MED_QUAD4   ",&
301        &  "MED_TRIA6   ",&
302        &  "MED_QUAD8   ",&
303        &  "MED_TETRA4  ",&
304        &  "MED_PYRA5   ",&
305        &  "MED_PENTA6  ",&
306        &  "MED_HEXA8   ",&
307        &  "MED_TETRA10 ",&
308        &  "MED_PYRA13  ",&
309        &  "MED_PENTA15 ",&
310        &  "MED_HEXA20  ",&
311        &  "MED_POLYGONE",&
312        &  "MED_POLYEDRE"  /)
313 
314   character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_FACE+1) :: FMED_GEOMETRIE_FACE_AFF = (/&
315        &  "MED_TRIA3   ",&
316        &  "MED_TRIA6   ",&
317        &  "MED_QUAD4   ",&
318        &  "MED_QUAD8   ",&
319        &  "MED_POLYGONE" /)
320 
321   character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_ARETE) :: FMED_GEOMETRIE_ARETE_AFF = (/&
322        &  "MED_SEG2    ",&
323        &  "MED_SEG3    " /)
324 
325   character(LEN=12),target,dimension(1) :: FMED_GEOMETRIE_NOEUD_AFF = (/ &
326        &  "(AUCUN)     "/)
327 
328 
329   character(LEN=17),target,dimension(0:4) :: FMED_ENTITE_MAILLAGE_AFF =(/ &
330        &  "MED_MAILLE       ", &
331        &  "MED_FACE         ", &
332        &  "MED_ARETE        ", &
333        &  "MED_NOEUD        ", &
334        &  "MED_NOEUD_MAILLE "/)
335 
336   parameter (USER_MODE = MED_COMPACT )
337 
338   !!  write (*,'(A0)')  FMED_GEOMETRIE_NOEUD_AFF(1)
339   !!  write (*,'(A0)')  FMED_GEOMETRIE_MAILLE_AFF(1)
340   !!  write (*,'(A0)')  FMED_GEOMETRIE_FACE_AFF(1)
341   !!  write (*,'(A0)')  FMED_GEOMETRIE_ARETE_AFF(1)
342 
343   nbpdtnor=0;pflsize=0;ngauss=0;nval=0
344   numdt = 0;numo=0;retmem=0
345   cret=0;ret=0
346 
347   nullify(type_geo)
348   nullify(AFF)
349 
350 
351   select case (entite)
352   case (MED_NOEUD)
353      type_geo => typ_noeud
354      nb_geo   = 1
355      AFF      => FMED_GEOMETRIE_NOEUD_AFF
356   case (MED_MAILLE)
357      type_geo => typmai
358      nb_geo   = MED_NBR_GEOMETRIE_MAILLE+2
359      AFF      => FMED_GEOMETRIE_MAILLE_AFF
360   case (MED_NOEUD_MAILLE)
361      type_geo => typmai
362      nb_geo   = MED_NBR_GEOMETRIE_MAILLE+2
363      AFF      => FMED_GEOMETRIE_MAILLE_AFF
364   case (MED_FACE)
365      type_geo => typfac;
366      nb_geo   = MED_NBR_GEOMETRIE_FACE+1
367      AFF      =>  FMED_GEOMETRIE_FACE_AFF
368   case  (MED_ARETE)
369      type_geo => typare
370      nb_geo   = MED_NBR_GEOMETRIE_ARETE
371      AFF      =>  FMED_GEOMETRIE_ARETE_AFF
372   end select
373 
374   do k=1,nb_geo
375 
376      ! ** Combien de (PDT,NOR) a lire **
377      call efnpdt(fid,nomcha,entite,type_geo(k),nbpdtnor,ret)
378      if (ret.ne.0) then
379         print *, "Impossible de lire le nombre de pas de temps : " &
380              & ,k,nomcha,entite,FMED_ENTITE_MAILLAGE_AFF(entite) &
381              & ,type_geo(k),AFF(type_geo(k))
382         cret = -1
383      end if
384      if(nbpdtnor < 1 ) continue
385 
386      do j=1,nbpdtnor
387 
388 
389         call efpdti(fid, nomcha, entite, type_geo(k), &
390              & j, ngauss, numdt, numo, dt_unit,  &
391              & dt, maa_ass, local, nbrefmaa, ret )
392         if (ret.ne.0) then
393            print *, "Erreur a la demande d'information sur (pdt,nor) : " &
394                 & ,nomcha,entite, type_geo(k), ngauss, numdt, numo, dt_unit &
395                 & ,dt, maa_ass, local, nbrefmaa
396            cret = -1
397         end if
398 
399         if (numdt .eq. MED_NOPDT) then
400            write(*,'(5X,A)') 'Pas de pas de temps'
401         else
402            write(*,'(5X,A,I5,A,E20.8,A,A,A)') 'Pas de temps n° ' &
403                 &  ,numdt,' (', dt ,') ', 'et d''unite ',TRIM(dt_unit)
404         endif
405         if (numo .eq. MED_NONOR) then
406            write(*,'(5X,A)')     'Pas de numero d''ordre'
407         else
408            write(*,'(5X,A,I5)')  'Numero d ordre            : ', numo
409         endif
410         write(*,'(5X,A,I5)') 'Nombre de points de gauss : ',ngauss
411         write(*,'(5X,A,A)')  'Maillage associe          : ', TRIM(maa_ass)
412 
413         ! ** Le maillage reference est-il porte par un autre fichier **
414         if ( .not. local ) then
415            call efnvli(fid,maa_ass,nvl,ret)
416            if (ret.ne.0) then
417               print *, "Erreur a la lecture de la taille du lien : " &
418                    & , maa_ass, local, nvl
419               cret = -1
420            end if
421            !! allocate(lien(nvl),STAT=retmem)
422            if (retmem .ne. 0) then
423               print *, "Erreur a l'allocation mémoire de lien : "
424               call efexit(-1)
425            endif
426            lien =""
427            call efliel(fid,lien,nvl,maa_ass,ret)
428            if (ret.ne.0) then
429               print *,"Erreur a la lecture du lien : " &
430                    & ,maa_ass,lien
431               cret = -1
432            else
433               write (*,'(5X,A,A,A,A,A)') 'Le maillage |',TRIM(maa_ass), &
434                    & '| est porte par un fichier distant |', &
435                    & TRIM(lien),'|'
436            endif
437            !! deallocate(lien)
438         endif
439 
440         ! ** Combien de maillages lies aux (nomcha,ent,geo,numdt,numo)  **
441         ! ** Notons que cette information est egalement disponible ** 
442         ! ** a partir de MEDpasdetempsInfo **
443         call efnref(fid,nomcha,entite,type_geo(k),numdt,numo,nref,ret)
444         if (ret.ne.0) then
445            print *,"Erreur a la demande du nombre de maillages references par le champ : ", &
446                 & nomcha,numdt,numo
447            cret = -1; continue
448         endif
449 
450         do l=1,nbrefmaa
451 
452            call efrefi(fid,nomcha,entite,type_geo(k), &
453                 & l,numdt, numo, maa_ass, local, ngauss, ret)
454            if (ret.ne.0) then
455               print *,"Erreur a la demande d'information sur le maillage utilise par le champ n° : " &
456                    & ,nomcha,entite,type_geo(k), &
457                    & l,numdt, numo, maa_ass
458               cret = -1; continue
459            endif
460 
461            ! ** Prend en compte le nbre de pt de gauss automatiquement **
462            call efnval(fid,nomcha,entite,type_geo(k),numdt,numo,maa_ass,USER_MODE,nval,cret)
463            if (ret.ne.0) then
464               print *,"Erreur a la lecture du nombre de valeurs du champ : " &
465                    & ,nomcha,entite,type_geo(k), &
466                    & numdt, numo, maa_ass
467               cret = -1; continue
468            endif
469            write(*,'(5X,A,I5,A,I5,A,A,A,A,A,A,A,I5,A)') &
470                 & 'Il y a ',nval,' valeurs en mode ',USER_MODE, &
471                 & ' . Chaque entite ',TRIM(FMED_ENTITE_MAILLAGE_AFF(entite)), &
472                 & ' de type geometrique ',TRIM(AFF(k)),' associes au maillage |',&
473                 & TRIM(maa_ass),'| a ',ngauss,' pts de gauss '
474 
475            ! ** Le maillage reference est-il porte par un autre fichier **
476            if ( .not. local ) then
477 
478               call efnvli(fid,maa_ass,nvl,ret)
479               if (ret.ne.0) then
480                  print *, "Erreur a la lecture de la taille du lien : " &
481                       & , maa_ass, local, nvl
482                  cret = -1
483               end if
484 
485               !! allocate(lien(nvl),STAT=retmem)
486               if (retmem .ne. 0) then
487                  print *, "Erreur a l'allocation mémoire de comp et unit : "
488                  call efexit(-1)
489               endif
490 
491               call efliel(fid,lien,nvl,maa_ass,ret)
492               if (ret.ne.0) then
493                  print *,"Erreur a la lecture du lien : " &
494                       & ,maa_ass,lien
495                  cret = -1
496               else
497                  write(*,'(5X,A,A,A,A,A)') 'Le maillage |',TRIM(maa_ass), &
498                       & '| est porte par un fichier distant |',TRIM(lien),'|'
499               endif
500               !! deallocate(lien)
501            endif
502 
503            ! **Lecture des valeurs du champ **
504            if (typcha .eq. MED_FLOAT64) then
505               allocate(valr(ncomp*nval),STAT=retmem)
506 
507               call efchal(fid,maa_ass,nomcha,valr,stockage,MED_ALL,locname, &
508                    & pflname,USER_MODE,entite,type_geo(k),numdt,numo,ret)
509 
510               if (ret.ne.0) then
511                  print *,"Erreur a la lecture du nombre de valeurs du champ : ", &
512                       &  maa_ass,nomcha,valr,stockage,MED_ALL,locname, &
513                       &  pflname,USER_MODE,entite,type_geo(k),numdt,numo
514                  cret = -1;
515               endif
516            else 
517               allocate(vale(ncomp*nval),STAT=retmem)
518 
519               call efchal(fid,maa_ass,nomcha,vale,stockage,MED_ALL,locname, &
520                    &  pflname,USER_MODE,entite,type_geo(k),numdt,numo,ret)
521               if (ret.ne.0) then
522                  print *,"Erreur a la lecture des valeurs du champ : ",&
523                       & maa_ass,nomcha,vale,stockage,MED_ALL,locname, &
524                       & pflname,USER_MODE,entite,type_geo(k),numdt,numo
525                  cret = -1;
526               endif
527 
528            endif
529 
530            if (ngauss .gt. 1 ) then
531               write (*,'(5X,A,A,A)') "- Modèle de localisation des ", &
532                    & "points de Gauss de nom ", TRIM(locname)
533            end if
534 
535            if ( entite .eq. MED_NOEUD_MAILLE ) then
536               ngroup = MOD(type_geo(k),100)
537            else
538               ngroup = ngauss
539            end if
540 
541            select case (stockage)
542            case (MED_FULL_INTERLACE)
543               write(*,'(5X,A)') "- Valeurs :";  write(*,'(5X,A)') ""
544               do m=0,(nval/ngroup-1)
545                  write(*,*) "|"
546                  do n=0,(ngroup*ncomp-1)
547                     if (typcha .eq. MED_FLOAT64) then
548                        write (*,'(1X,E20.5,1X)') valr( m*ngroup*ncomp+n +1 )
549                     else
550                        write (*,'(1X,I8,1X)') vale( m*ngroup*ncomp+n +1 )
551                     end if
552                  enddo
553               enddo
554            case (MED_NO_INTERLACE)
555               write(*,'(5X,A)') "- Valeurs :";  write(*,'(5X,A)') ""
556               do m=0,ncomp-1
557                  write(*,*) "|"
558                  do n=0,nval-1
559                     if (typcha .eq. MED_FLOAT64) then
560                        write (*,'(1X,E20.5,1X)') valr(m*nval+n +1)
561                     else
562                        write (*,'(1X,I8,1X)') vale(m*nval+n +1)
563                     endif
564                  enddo
565               enddo
566            end select
567 
568            write(*,*) "|"
569            if (typcha .eq. MED_FLOAT64) then
570               deallocate(valr)
571            else
572               deallocate(vale)
573            endif
574 
575            !* Profils
576            if (pflname .eq. MED_NOPFL) then
577               write(*,'(5X,A)') 'Pas de profil'
578            else
579               write(*,'(5X,A,A)') 'Profil :',pflname
580               call efnpfl(fid,pflname,pflsize,ret)
581               if (ret .ne. 0) then
582                  print *,"Erreur a la lecture du nombre de valeurs du profil : ", &
583                       & pflname,pflsize
584                  cret = -1;continue
585               endif
586               write(*,'(5X,A,I5)') 'Taille du profil : ',pflsize
587 
588               ! ** allocation memoire de pflval **
589               allocate(pflval(pflsize),STAT=retmem)
590               if (retmem .ne. 0) then
591                  print *, "Erreur a l'allocation mémoire de pflsize : "
592                  call efexit(-1)
593               endif
594 
595               call efpfll(fid,pflval,pflname,ret)
596               if (cret .ne. 0) write(*,'(I1)') cret
597               if (ret .ne. 0) then
598                  print *,"Erreur a la lecture du profil : ", &
599                       & pflname,pflval
600                  cret = -1;continue
601               endif
602               write(*,'(5X,A)') 'Valeurs du profil : '
603               do m=1,pflsize
604                  write (*,'(5X,I6)') pflval(m)
605               enddo
606 
607               deallocate(pflval)
608 
609            endif
610 
611         enddo
612 
613      enddo
614 
615   enddo
616 
617   print *,""
618   getFieldsOn=ret
619 
620 end function getFieldsOn