# 2.3.6/test11.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2011  EDF R&D, CEA/DEN
    00004 !*  MED is free software: you can redistribute it and/or modify
    00005 !*  it under the terms of the GNU Lesser General Public License as published by
    00006 !*  the Free Software Foundation, either version 3 of the License, or
    00007 !*  (at your option) any later version.
    00008 !*
    00009 !*  MED is distributed in the hope that it will be useful,
    00010 !*  but WITHOUT ANY WARRANTY; without even the implied warranty of
    00011 !*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    00012 !*  GNU Lesser General Public License for more details.
    00013 !*
    00014 !*  You should have received a copy of the GNU Lesser General Public License
    00015 !*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
    00016 !*
    00017
    00018
    00019 ! ******************************************************************************
    00020 ! * - Nom du fichier : test11.f90
    00021 ! *
    00022 ! * - Description : lecture de champs de resultats MED
    00023 ! *
    00024 ! *****************************************************************************
    00025
    00026 program test11
    00027
    00028   implicit none
    00029   include 'med.hf'
    00030
    00031
    00032   integer       cret,ret,lret,retmem, fid
    00033   integer       USER_INTERLACE,USER_MODE
    00034   character*32  :: maa,nomcha,pflname,nomlien,locname
    00035   character*200 desc
    00036   character*255 argc
    00037   character*16, allocatable, dimension(:) :: comp,unit
    00038   character*16  dtunit
    00039   integer       mdim,ncomp,ncha,npro,nln,pflsize,nval
    00040   integer,      allocatable, dimension(:) :: pflval
    00041   integer       ngauss,nloc
    00042   integer       t1,t2,t3,typcha,type,type_geo
    00043   real*8,       allocatable, dimension(:) :: refcoo, gscoo, wg
    00044   character*255 lien
    00045   integer       i,j
    00046   integer       getFieldsOn
    00047
    00048   parameter (USER_INTERLACE = MED_FULL_INTERLACE)
    00049   parameter (USER_MODE = MED_COMPACT )
    00050
    00051   cret=0;ret=0;lret=0;retmem=0
    00052   print *,"Indiquez le fichier med a decrire : "
    00053   !!read(*,'(A)') argc
    00054   argc="test10.med"
    00055
    00056   !  ** ouverture du fichier **
    00057   call efouvr(fid,argc,MED_LECTURE, ret)
    00058   if (ret .ne. 0) call efexit(-1)
    00059
    00060   !  ** info sur le premier maillage **
    00061   call efmaai(fid,1,maa,mdim,type,desc,ret)
    00062   if (ret.ne.0) then
    00063      print *, "Erreur a la lecture des informations sur le maillage : ", &
    00064           & maa,mdim,type,desc
    00065      call efexit(-1)
    00066   endif
    00067
    00068   write (*,'(/A,A,A,I1)') "Maillage de nom |",TRIM(maa),"| et de dimension ",mdim
    00069
    00070   !  ** combien de champs dans le fichier **
    00071   call efncha(fid,0,ncha,ret)
    00072   if (ret.ne.0) then
    00073      print *, "Impossible de lire le nombre de champs : ",ncha
    00074      call efexit(-1)
    00075   endif
    00076
    00077   write (*,'(A,I1/)') "Nombre de champs : ",ncha
    00078
    00079
    00080   ! ** lecture de tous les champs associes a <maa> **
    00081   do i=1,ncha
    00082      lret = 0
    00083      write(*,'(A,I5)') "- Champ numero : ",i
    00084
    00085      ! ** combien de composantes **
    00086      call efncha(fid,i,ncomp,ret)
    00087      if (ret.ne.0) then
    00088         print *, "Erreur a la lecture du nombre de composantes : ",ncomp
    00089         cret = -1
    00090      endif
    00091
    00092      ! ** allocation memoire de comp et unit **
    00093      allocate(comp(ncomp),unit(ncomp),STAT=retmem)
    00094      if (retmem .ne. 0) then
    00095         print *, "Erreur a l'allocation mémoire de comp et unit : "
    00096         call efexit(-1)
    00097      endif
    00098
    00099      ! ** Info sur les champs
    00100      call efchai(fid,i,nomcha,typcha,comp,unit,ncomp,ret)
    00101      if (ret .ne. 0) then
    00102         print *, "Erreur a la demande d'information sur les champs : ",nomcha,typcha,comp,unit,ncomp
    00103         cret = -1
    00104         continue
    00105      endif
    00106
    00107      write(*,'(/5X,A,A)') 'Nom du champ  : ', TRIM(nomcha)
    00108      write(*,'(5X,A,I5)') 'Type du champ : ', typcha
    00109      do j=1,ncomp
    00110         write(*,'(5X,A,I1,A,A,A,A)') 'Composante ',j,'  : ',TRIM(comp(j)),' ',TRIM(unit(j))
    00111      enddo
    00112
    00113      deallocate(comp,unit)
    00114      print *,""
    00115
    00116      lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_NOEUD, USER_INTERLACE )
    00117
    00118      if (lret .eq. 0) then
    00119         lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_MAILLE, USER_INTERLACE )
    00120      else
    00121         print *, "Erreur a la lecture des champs aux noeuds "; cret = -1; continue
    00122      endif
    00123
    00124      if (lret .eq. 0) then
    00125         lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_FACE,USER_INTERLACE)
    00126      else
    00127         print *,"Erreur a la lecture des champs aux mailles "; cret = -1; continue
    00128      endif
    00129
    00130      if (lret .eq. 0) then
    00131         lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_ARETE,USER_INTERLACE)
    00132      else
    00133         print *,"Erreur a la lecture des champs aux faces "; cret = -1; continue
    00134      endif
    00135
    00136      if (lret .eq. 0) then
    00137         lret = getFieldsOn(fid, nomcha, typcha, ncomp, MED_NOEUD_MAILLE,USER_INTERLACE)
    00138      else
    00139         print *,"Erreur a la lecture des champs aux aretes "; cret = -1; continue
    00140      endif
    00141
    00142      if  (lret .ne. 0) then
    00143         print *,"Erreur a la lecture des champs aux noeuds des mailles "; cret = -1
    00144      endif
    00145
    00146   enddo
    00147
    00148
    00149   call efnpro(fid,nval,ret)
    00150   write (*,'(5X,A,I2)') 'Nombre de profils stockés : ', nval
    00151
    00152   if (nval .gt. 0 ) then
    00153      do i=1,nval
    00154         call efproi(fid,i,pflname,nval,ret)
    00155         write (*,'(5X,A,I2,A,A,A,I2)') 'Profil n ',i,' : ',pflname, ' et de taille',nval
    00156      enddo
    00157   endif
    00158
    00159   !  ** Interrogation des liens **
    00160   call efnlie(fid,nln,ret)
    00161   if (ret.ne.0) then
    00162      print *,"Erreur a la lecture du nombre de liens : " &
    00163           & ,nln
    00164      cret = -1;
    00165   else
    00166      print *,""
    00167      print *,"Nombre de liens stockes : ",nln;print *,"";print *,""
    00168      do i=1,nln
    00169         call efliei(fid, i, nomlien, nval, ret)
    00170         if (ret.ne.0) then
    00171            print *,"Erreur a la demande d'information sur le lien n° : ",i
    00172            cret = -1;continue;
    00173         endif
    00174         write (*,'(5X,A,I4,A,A,A,I4)') "- Lien n°",i," de nom |",TRIM(nomlien),"| et de taille ",nval
    00175         !! allocate
    00176         lien = ""
    00177         call efliel(fid,lien,nval,nomlien,ret)
    00178         if (ret.ne.0) then
    00179            print *,"Erreur a la lecture du lien : ", lien,nval,nomlien
    00180            ret = -1;
    00181         else
    00182            write (*,'(5X,A,A,A)') "|",TRIM(lien),"|";print *,"";print *,""
    00183         endif
    00184         !!deallocate
    00185      end do
    00186   endif
    00187
    00188   !  ** Interrogation des localisations des points de GAUSS **
    00189   call efngau(fid,nloc,ret)
    00190   if (ret.ne.0) then
    00191      print *,"Erreur a la lecture du nombre de points de Gauss : " &
    00192           & ,nloc
    00193      cret = -1;
    00194   else
    00195      print *,"Nombre de localisations stockees : ",nloc;print *,"";print *,""
    00196      do i=1,nloc
    00197         call efgaui(fid, i, locname, type_geo, ngauss, ret)
    00198         if (ret.ne.0) then
    00199            print *,"Erreur a la demande d'information sur la localisation n° : ",i
    00200            cret = -1;continue;
    00201         endif
    00202         write (*,'(5X,A,I4,A,A,A,I4)') "- Loc n°",i," de nom |",TRIM(locname) &
    00203              &,"| et nbr. de pts Gauss ",ngauss
    00204         t1 = MOD(type_geo,100)*(type_geo/100)
    00205         t2 = ngauss*(type_geo/100)
    00206         t3 = ngauss
    00207         allocate(refcoo(t1),STAT=retmem)
    00208         if (retmem .ne. 0) then
    00209            print *, "Erreur a l'allocation mémoire de refcoo : "
    00210            call efexit(-1)
    00211         endif;
    00212         allocate(gscoo(t2),STAT=retmem)
    00213         if (retmem .ne. 0) then
    00214            print *, "Erreur a l'allocation mémoire de gscoo : "
    00215            call efexit(-1)
    00216         endif;
    00217         allocate(wg(t3),STAT=retmem)
    00218         if (retmem .ne. 0) then
    00219            print *, "Erreur a l'allocation mémoire de wg : "
    00220            call efexit(-1)
    00221         endif;
    00222         call efgaul(fid, refcoo, gscoo, wg, USER_INTERLACE, locname, ret )
    00223         if (ret.ne.0) then
    00224            print *,"Erreur a la lecture  des valeurs de la localisation : " &
    00225                 & ,locname
    00226            cret = -1;
    00227         else
    00228            write (*,'(5X,A,I4)') "Coordonnees de l'element de reference de type ",type_geo
    00229            do j=1,t1
    00230               write (*,'(5X,E20.8)') refcoo(j)
    00231            enddo
    00232            print *,""
    00233            write (*,'(5X,A)') "Localisation des points de GAUSS : "
    00234            do j=1,t2
    00235               write (*,'(5X,E20.8)') gscoo(j)
    00236            enddo
    00237            print *,""
    00238            write (*,'(5X,A)') "Poids associes aux points de GAUSS "
    00239            do j=1,t3
    00240               write (*,'(5X,E20.8)') wg(j)
    00241            enddo
    00242            print *,""
    00243         endif
    00244         deallocate(refcoo)
    00245         deallocate(gscoo)
    00246         deallocate(wg)
    00247      enddo
    00248   endif
    00249
    00250   call efferm (fid,ret)
    00251
    00252   call efexit(cret)
    00253
    00254 end program test11
    00255
    00256
    00257 integer function getFieldsOn(fid, nomcha, typcha, ncomp, entite, stockage)
    00258   implicit none
    00259   include 'med.hf'
    00260
    00261   integer      ::fid,typcha,ncomp,entite,stockage
    00262   character(LEN=*)  nomcha
    00263
    00264   integer      :: j,k,l,m,n,nb_geo,cret,ret,retmem,nvl,nref
    00265   integer      :: nbpdtnor,pflsize,ngauss,ngroup,nval
    00266   integer,     allocatable, dimension(:) :: pflval
    00267   integer,     allocatable, dimension(:) :: vale
    00268   integer      :: numdt,numo,lnsize,nbrefmaa
    00269   real*8,      allocatable, dimension(:) :: valr
    00270   real*8       dt
    00271   logical      local
    00272   character*32 :: pflname,locname,maa_ass
    00273   character*16 :: dt_unit
    00274   character*255:: lien
    00275   integer       USER_MODE
    00276
    00277   integer,pointer,dimension(:) :: type_geo
    00278   integer,target  :: typ_noeud(1) = (/ MED_NONE /)
    00279   integer,target  :: typmai(MED_NBR_GEOMETRIE_MAILLE+2) =  (/ MED_POINT1,MED_SEG2,
    00280          MED_SEG3,MED_TRIA3,     &
    00281          MED_QUAD4,MED_TRIA6,    &
    00282          MED_QUAD8,MED_TETRA4,   &
    00283          MED_PYRA5,MED_PENTA6,   &
    00284          MED_HEXA8,MED_TETRA10,  &
    00285          MED_PYRA13,MED_PENTA15,  &
    00286          MED_HEXA20,MED_POLYGONE,&
    00287          MED_POLYEDRE/)
    00288
    00289   integer,target :: typfac(MED_NBR_GEOMETRIE_FACE+1) = (/MED_TRIA3,MED_TRIA6,
    00290          MED_QUAD4,MED_QUAD8,MED_POLYGONE/)
    00291   integer,target ::typare(MED_NBR_GEOMETRIE_ARETE) = (/MED_SEG2,MED_SEG3/)
    00292
    00293   character(LEN=12),pointer,dimension(:) :: AFF
    00294   character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_MAILLE+2) :: FMED_GEOMETRIE_MAILLE_AFF = (/
    00295          "MED_POINT1  ",&
    00296          "MED_SEG2    ",&
    00297          "MED_SEG3    ",&
    00298          "MED_TRIA3   ",&
    00299          "MED_QUAD4   ",&
    00300          "MED_TRIA6   ",&
    00301          "MED_QUAD8   ",&
    00302          "MED_TETRA4  ",&
    00303          "MED_PYRA5   ",&
    00304          "MED_PENTA6  ",&
    00305          "MED_HEXA8   ",&
    00306          "MED_TETRA10 ",&
    00307          "MED_PYRA13  ",&
    00308          "MED_PENTA15 ",&
    00309          "MED_HEXA20  ",&
    00310          "MED_POLYGONE",&
    00311          "MED_POLYEDRE"  /)
    00312
    00313   character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_FACE+1) :: FMED_GEOMETRIE_FACE_AFF = (/
    00314          "MED_TRIA3   ",&
    00315          "MED_TRIA6   ",&
    00316          "MED_QUAD4   ",&
    00317          "MED_QUAD8   ",&
    00318          "MED_POLYGONE" /)
    00319
    00320   character(LEN=12),target,dimension(MED_NBR_GEOMETRIE_ARETE) :: FMED_GEOMETRIE_ARETE_AFF = (/
    00321          "MED_SEG2    ",&
    00322          "MED_SEG3    " /)
    00323
    00324   character(LEN=12),target,dimension(1) :: FMED_GEOMETRIE_NOEUD_AFF = (/
    00325          "(AUCUN)     "/)
    00326
    00327
    00328   character(LEN=17),target,dimension(0:4) :: FMED_ENTITE_MAILLAGE_AFF =(/
    00329          "MED_MAILLE       ", &
    00330          "MED_FACE         ", &
    00331          "MED_ARETE        ", &
    00332          "MED_NOEUD        ", &
    00333          "MED_NOEUD_MAILLE "/)
    00334
    00335   parameter (USER_MODE = MED_COMPACT )
    00336
    00337   !!  write (*,'(A0)')  FMED_GEOMETRIE_NOEUD_AFF(1)
    00338   !!  write (*,'(A0)')  FMED_GEOMETRIE_MAILLE_AFF(1)
    00339   !!  write (*,'(A0)')  FMED_GEOMETRIE_FACE_AFF(1)
    00340   !!  write (*,'(A0)')  FMED_GEOMETRIE_ARETE_AFF(1)
    00341
    00342   nbpdtnor=0;pflsize=0;ngauss=0;nval=0
    00343   numdt = 0;numo=0;retmem=0
    00344   cret=0;ret=0
    00345
    00346   nullify(type_geo)
    00347   nullify(AFF)
    00348
    00349
    00350   select case (entite)
    00351   case (MED_NOEUD)
    00352      type_geo => typ_noeud
    00353      nb_geo   = 1
    00354      AFF      => FMED_GEOMETRIE_NOEUD_AFF
    00355   case (MED_MAILLE)
    00356      type_geo => typmai
    00357      nb_geo   = MED_NBR_GEOMETRIE_MAILLE+2
    00358      AFF      => FMED_GEOMETRIE_MAILLE_AFF
    00359   case (MED_NOEUD_MAILLE)
    00360      type_geo => typmai
    00361      nb_geo   = MED_NBR_GEOMETRIE_MAILLE+2
    00362      AFF      => FMED_GEOMETRIE_MAILLE_AFF
    00363   case (MED_FACE)
    00364      type_geo => typfac;
    00365      nb_geo   = MED_NBR_GEOMETRIE_FACE+1
    00366      AFF      =>  FMED_GEOMETRIE_FACE_AFF
    00367   case  (MED_ARETE)
    00368      type_geo => typare
    00369      nb_geo   = MED_NBR_GEOMETRIE_ARETE
    00370      AFF      =>  FMED_GEOMETRIE_ARETE_AFF
    00371   end select
    00372
    00373   do k=1,nb_geo
    00374
    00375      ! ** Combien de (PDT,NOR) a lire **
    00376      call efnpdt(fid,nomcha,entite,type_geo(k),nbpdtnor,ret)
    00377      if (ret.ne.0) then
    00378         print *, "Impossible de lire le nombre de pas de temps : " &
    00379              & ,k,nomcha,entite,FMED_ENTITE_MAILLAGE_AFF(entite) &
    00380              & ,type_geo(k),AFF(type_geo(k))
    00381         cret = -1
    00382      end if
    00383      if(nbpdtnor < 1 ) continue
    00384
    00385      do j=1,nbpdtnor
    00386
    00387
    00388         call efpdti(fid, nomcha, entite, type_geo(k), &
    00389              & j, ngauss, numdt, numo, dt_unit,  &
    00390              & dt, maa_ass, local, nbrefmaa, ret )
    00391         if (ret.ne.0) then
    00392            print *, "Erreur a la demande d'information sur (pdt,nor) : " &
    00393                 & ,nomcha,entite, type_geo(k), ngauss, numdt, numo, dt_unit &
    00394                 & ,dt, maa_ass, local, nbrefmaa
    00395            cret = -1
    00396         end if
    00397
    00398         if (numdt .eq. MED_NOPDT) then
    00399            write(*,'(5X,A)') 'Pas de pas de temps'
    00400         else
    00401            write(*,'(5X,A,I5,A,E20.8,A,A,A)') 'Pas de temps n° ' &
    00402                 &  ,numdt,' (', dt ,') ', 'et d''unite ',TRIM(dt_unit)
    00403         endif
    00404         if (numo .eq. MED_NONOR) then
    00405            write(*,'(5X,A)')     'Pas de numero d''ordre'
    00406         else
    00407            write(*,'(5X,A,I5)')  'Numero d ordre            : ', numo
    00408         endif
    00409         write(*,'(5X,A,I5)') 'Nombre de points de gauss : ',ngauss
    00410         write(*,'(5X,A,A)')  'Maillage associe          : ', TRIM(maa_ass)
    00411
    00412         ! ** Le maillage reference est-il porte par un autre fichier **
    00413         if ( .not. local ) then
    00414            call efnvli(fid,maa_ass,nvl,ret)
    00415            if (ret.ne.0) then
    00416               print *, "Erreur a la lecture de la taille du lien : " &
    00417                    & , maa_ass, local, nvl
    00418               cret = -1
    00419            end if
    00420            !! allocate(lien(nvl),STAT=retmem)
    00421            if (retmem .ne. 0) then
    00422               print *, "Erreur a l'allocation mémoire de lien : "
    00423               call efexit(-1)
    00424            endif
    00425            lien =""
    00426            call efliel(fid,lien,nvl,maa_ass,ret)
    00427            if (ret.ne.0) then
    00428               print *,"Erreur a la lecture du lien : " &
    00429                    & ,maa_ass,lien
    00430               cret = -1
    00431            else
    00432               write (*,'(5X,A,A,A,A,A)') 'Le maillage |',TRIM(maa_ass), &
    00433                    & '| est porte par un fichier distant |', &
    00434                    & TRIM(lien),'|'
    00435            endif
    00436            !! deallocate(lien)
    00437         endif
    00438
    00439         ! ** Combien de maillages lies aux (nomcha,ent,geo,numdt,numo)  **
    00440         ! ** Notons que cette information est egalement disponible **
    00441         ! ** a partir de MEDpasdetempsInfo **
    00442         call efnref(fid,nomcha,entite,type_geo(k),numdt,numo,nref,ret)
    00443         if (ret.ne.0) then
    00444            print *,"Erreur a la demande du nombre de maillages references par le champ : ", &
    00445                 & nomcha,numdt,numo
    00446            cret = -1; continue
    00447         endif
    00448
    00449         do l=1,nbrefmaa
    00450
    00451            call efrefi(fid,nomcha,entite,type_geo(k), &
    00452                 & l,numdt, numo, maa_ass, local, ngauss, ret)
    00453            if (ret.ne.0) then
    00454               print *,"Erreur a la demande d'information sur le maillage utilise par le champ n° : " &
    00455                    & ,nomcha,entite,type_geo(k), &
    00456                    & l,numdt, numo, maa_ass
    00457               cret = -1; continue
    00458            endif
    00459
    00460            ! ** Prend en compte le nbre de pt de gauss automatiquement **
    00461            call efnval(fid,nomcha,entite,type_geo(k),numdt,numo,maa_ass,USER_MODE,nval,cret)
    00462            if (ret.ne.0) then
    00463               print *,"Erreur a la lecture du nombre de valeurs du champ : " &
    00464                    & ,nomcha,entite,type_geo(k), &
    00465                    & numdt, numo, maa_ass
    00466               cret = -1; continue
    00467            endif
    00468            write(*,'(5X,A,I5,A,I5,A,A,A,A,A,A,A,I5,A)') &
    00469                 & 'Il y a ',nval,' valeurs en mode ',USER_MODE, &
    00470                 & ' . Chaque entite ',TRIM(FMED_ENTITE_MAILLAGE_AFF(entite)), &
    00471                 & ' de type geometrique ',TRIM(AFF(k)),' associes au maillage |',&
    00472                 & TRIM(maa_ass),'| a ',ngauss,' pts de gauss '
    00473
    00474            ! ** Le maillage reference est-il porte par un autre fichier **
    00475            if ( .not. local ) then
    00476
    00477               call efnvli(fid,maa_ass,nvl,ret)
    00478               if (ret.ne.0) then
    00479                  print *, "Erreur a la lecture de la taille du lien : " &
    00480                       & , maa_ass, local, nvl
    00481                  cret = -1
    00482               end if
    00483
    00484               !! allocate(lien(nvl),STAT=retmem)
    00485               if (retmem .ne. 0) then
    00486                  print *, "Erreur a l'allocation mémoire de comp et unit : "
    00487                  call efexit(-1)
    00488               endif
    00489
    00490               call efliel(fid,lien,nvl,maa_ass,ret)
    00491               if (ret.ne.0) then
    00492                  print *,"Erreur a la lecture du lien : " &
    00493                       & ,maa_ass,lien
    00494                  cret = -1
    00495               else
    00496                  write(*,'(5X,A,A,A,A,A)') 'Le maillage |',TRIM(maa_ass), &
    00497                       & '| est porte par un fichier distant |',TRIM(lien),'|'
    00498               endif
    00499               !! deallocate(lien)
    00500            endif
    00501
    00502            ! **Lecture des valeurs du champ **
    00503            if (typcha .eq. MED_FLOAT64) then
    00504               allocate(valr(ncomp*nval),STAT=retmem)
    00505
    00506               call efchal(fid,maa_ass,nomcha,valr,stockage,MED_ALL,locname, &
    00507                    & pflname,USER_MODE,entite,type_geo(k),numdt,numo,ret)
    00508
    00509               if (ret.ne.0) then
    00510                  print *,"Erreur a la lecture du nombre de valeurs du champ : ", &
    00511                       &  maa_ass,nomcha,valr,stockage,MED_ALL,locname, &
    00512                       &  pflname,USER_MODE,entite,type_geo(k),numdt,numo
    00513                  cret = -1;
    00514               endif
    00515            else
    00516               allocate(vale(ncomp*nval),STAT=retmem)
    00517
    00518               call efchal(fid,maa_ass,nomcha,vale,stockage,MED_ALL,locname, &
    00519                    &  pflname,USER_MODE,entite,type_geo(k),numdt,numo,ret)
    00520               if (ret.ne.0) then
    00521                  print *,"Erreur a la lecture des valeurs du champ : ",&
    00522                       & maa_ass,nomcha,vale,stockage,MED_ALL,locname, &
    00523                       & pflname,USER_MODE,entite,type_geo(k),numdt,numo
    00524                  cret = -1;
    00525               endif
    00526
    00527            endif
    00528
    00529            if (ngauss .gt. 1 ) then
    00530               write (*,'(5X,A,A,A)') "- Modèle de localisation des ", &
    00531                    & "points de Gauss de nom ", TRIM(locname)
    00532            end if
    00533
    00534            if ( entite .eq. MED_NOEUD_MAILLE ) then
    00535               ngroup = MOD(type_geo(k),100)
    00536            else
    00537               ngroup = ngauss
    00538            end if
    00539
    00540            select case (stockage)
    00541            case (MED_FULL_INTERLACE)
    00542               write(*,'(5X,A)') "- Valeurs :";  write(*,'(5X,A)') ""
    00543               do m=0,(nval/ngroup-1)
    00544                  write(*,*) "|"
    00545                  do n=0,(ngroup*ncomp-1)
    00546                     if (typcha .eq. MED_FLOAT64) then
    00547                        write (*,'(1X,E20.5,1X)') valr( m*ngroup*ncomp+n +1 )
    00548                     else
    00549                        write (*,'(1X,I8,1X)') vale( m*ngroup*ncomp+n +1 )
    00550                     end if
    00551                  enddo
    00552               enddo
    00553            case (MED_NO_INTERLACE)
    00554               write(*,'(5X,A)') "- Valeurs :";  write(*,'(5X,A)') ""
    00555               do m=0,ncomp-1
    00556                  write(*,*) "|"
    00557                  do n=0,nval-1
    00558                     if (typcha .eq. MED_FLOAT64) then
    00559                        write (*,'(1X,E20.5,1X)') valr(m*nval+n +1)
    00560                     else
    00561                        write (*,'(1X,I8,1X)') vale(m*nval+n +1)
    00562                     endif
    00563                  enddo
    00564               enddo
    00565            end select
    00566
    00567            write(*,*) "|"
    00568            if (typcha .eq. MED_FLOAT64) then
    00569               deallocate(valr)
    00570            else
    00571               deallocate(vale)
    00572            endif
    00573
    00574            !* Profils
    00575            if (pflname .eq. MED_NOPFL) then
    00576               write(*,'(5X,A)') 'Pas de profil'
    00577            else
    00578               write(*,'(5X,A,A)') 'Profil :',pflname
    00579               call efnpfl(fid,pflname,pflsize,ret)
    00580               if (ret .ne. 0) then
    00581                  print *,"Erreur a la lecture du nombre de valeurs du profil : ", &
    00582                       & pflname,pflsize
    00583                  cret = -1;continue
    00584               endif
    00585               write(*,'(5X,A,I5)') 'Taille du profil : ',pflsize
    00586
    00587               ! ** allocation memoire de pflval **
    00588               allocate(pflval(pflsize),STAT=retmem)
    00589               if (retmem .ne. 0) then
    00590                  print *, "Erreur a l'allocation mémoire de pflsize : "
    00591                  call efexit(-1)
    00592               endif
    00593
    00594               call efpfll(fid,pflval,pflname,ret)
    00595               if (cret .ne. 0) write(*,'(I1)') cret
    00596               if (ret .ne. 0) then
    00597                  print *,"Erreur a la lecture du profil : ", &
    00598                       & pflname,pflval
    00599                  cret = -1;continue
    00600               endif
    00601               write(*,'(5X,A)') 'Valeurs du profil : '
    00602               do m=1,pflsize
    00603                  write (*,'(5X,I6)') pflval(m)
    00604               enddo
    00605
    00606               deallocate(pflval)
    00607
    00608            endif
    00609
    00610         enddo
    00611
    00612      enddo
    00613
    00614   enddo
    00615
    00616   print *,""
    00617   getFieldsOn=ret
    00618
    00619 end function getFieldsOn