      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