      1 C*************************************************************************
      2 C COPYRIGHT (C) 1999 - 2007  EDF R&D, CEA/DEN
      3 C THIS LIBRARY IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY
      4 C IT UNDER THE TERMS OF THE GNU LESSER GENERAL PUBLIC LICENSE
      5 C AS PUBLISHED BY THE FREE SOFTWARE FOUNDATION;
      6 C EITHER VERSION 2.1 OF THE LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.
      7 C
      8 C THIS LIBRARY IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT
      9 C WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF
     10 C MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU
     11 C LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS.
     12 C
     13 C YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER GENERAL PUBLIC LICENSE
     14 C ALONG WITH THIS LIBRARY; IF NOT, WRITE TO THE FREE SOFTWARE FOUNDATION,
     15 C INC., 59 TEMPLE PLACE, SUITE 330, BOSTON, MA 02111-1307 USA
     16 C
     17 C**************************************************************************
     18
     19 C******************************************************************************
     20 C* - Nom du fichier : test22.f
     21 C*
     22 C* - Description : lecture des valeurs scalaires numeriques dans un fichier MED
     23 C ******************************************************************************
     24       program test22
     25 C
     26       implicit none
     27       include 'med.hf'
     28 C
     29       integer fid,cret
     30       character*16 dtunit
     31       character*32 nom
     32       character*200 desc
     33       integer vali
     34       real*8 valr,dt
     35       integer n,npdt,i,j,type,numdt,numo
     36 C
     37 C     Ouverture du fichier test21.med en lecture seule
     38 C
     39       call efouvr(fid,'test21.med',MED_LECTURE,cret)
     40       print *,cret
     41       if (cret .ne. 0 ) then
     42          print *,'Erreur ouverture du fichier'
     43          call efexit(-1)
     44       endif
     45       print *,'Ouverture du fichier test21.med'
     46 C
     47 C     Lecture du nombre de variable scalaire
     48 C
     49       call efnsca(fid,n,cret)
     50       print *,cret
     51       if (cret .ne. 0 ) then
     52          print *,'Erreur lecture du nombre de variable'
     53          call efexit(-1)
     54       endif
     55       print *,'Nombre de variables scalaires : ',n
     56 C
     57 C     Lecture des infos (type,description) propres
     58 C     a chaque variable
     59 C
     60       do 10 i=1,n
     61          call efscai(fid,i,nom,type,desc,cret)
     62          print *,cret
     63          if (cret .ne. 0 ) then
     64             print *,'Erreur lecture des infos'
     65             call efexit(-1)
     66          endif
     67          print *,'- Scalaire de nom : ',nom
     68          if (type .eq. MED_FLOAT64) then
     69             print *,'  de type flottant'
     70          else
     71             print *,'  de type entier'
     72          endif
     73          print *,'  Description associee : ',desc
     74 C
     75 C     Pour chaque scalaire, on regarde les valeurs associees
     76 C     eventuellement a un pas de temps et/ou un numero d'ordre
     77 C
     78          call efnspd(fid,nom,npdt,cret)
     79          if (cret .ne. 0 ) then
     80             print *,'Erreur lecture du nombre de pas de temps'
     81             call efexit(-1)
     82          endif
     83          print *,cret
     84          print *,'  Nombre de valeurs : ',npdt
     85 C
     86          do 20 j=1,npdt
     87             call efspdi(fid,nom,j,numdt,dtunit,dt,numo,cret)
     88             print *,cret
     89             if (cret .ne. 0 ) then
     90                print *,'Erreur infos pas de temps'
     91                call efexit(-1)
     92             endif
     93             print *,'   Valeur ', j
     94 C
     95             if (numdt .eq. MED_NOPDT) then
     96                print *,'     - Aucun pas de temps'
     97             else
     98                print *,'     - Pas de temps de numero ',numdt
     99                print *,'      de valeur : ',dt
    100                print *,'      unite : ',dtunit
    101             endif
    102 C
    103             if (numo .eq. MED_NONOR) then
    104                print *,'     - Aucun numero ordre'
    105             else
    106                print *,'     - Numero ordre : ',numo
    107             endif
    108 C
    109             if (type .eq. MED_FLOAT64) then
    110 C           ** Lecture de la valeur flottante associee
    111 C           ** au pas de temps
    112                call efscfl(fid,nom,valr,numdt,numo,cret)
    113                print *,cret
    114                if (cret .ne. 0 ) then
    115                   print *,'Erreur lecture valeur'
    116                   call efexit(-1)
    117                endif
    118                print *,'     - Valeur : ',valr
    119             else
    120 C           ** Lecture de la valeur entiere associee
    121 C           ** au pas de temps
    122                call efscel(fid,nom,vali,numdt,numo,cret)
    123                print *,cret
    124                if (cret .ne. 0 ) then
    125                   print *,'Erreur lecture valeur'
    126                   call efexit(-1)
    127                endif
    128                print *,'     - Valeur : ',vali
    129             endif
    130 C
    131  20      continue
    132 C
    133  10   continue
    134 C
    135 C     Fermeture du fichier
    136 C
    137       call efferm(fid,cret)
    138       print *,cret
    139       if (cret .ne. 0 ) then
    140          print *,'Erreur fermeture du fichier'
    141          call efexit(-1)
    142       endif
    143       print *,'Fermeture du fichier test21.med'
    144 C
    145       end