      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