2.3.6/test11.f90

Aller à la documentation de ce fichier.
00001 !*  This file is part of MED.
00002 !*
00003 !*  COPYRIGHT (C) 1999 - 2015  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

Généré le Thu Oct 8 14:26:17 2015 pour MED fichier par  doxygen 1.6.1