# f/test22.f

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2012  EDF R&D, CEA/DEN
    00004 C*  MED is free software: you can redistribute it and/or modify
    00005 C*  it under the terms of the GNU Lesser General Public License as published by
    00006 C*  the Free Software Foundation, either version 3 of the License, or
    00007 C*  (at your option) any later version.
    00008 C*
    00009 C*  MED is distributed in the hope that it will be useful,
    00010 C*  but WITHOUT ANY WARRANTY; without even the implied warranty of
    00011 C*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    00012 C*  GNU Lesser General Public License for more details.
    00013 C*
    00014 C*  You should have received a copy of the GNU Lesser General Public License
    00015 C*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
    00016 C*
    00017
    00018 C******************************************************************************
    00019 C* - Nom du fichier : test22.f
    00020 C*
    00021 C* - Description : lecture des valeurs scalaires numeriques dans un fichier MED
    00022 C ******************************************************************************
    00023       program test22
    00024 C
    00025       implicit none
    00026       include 'med.hf'
    00027 C
    00028       integer fid,cret
    00029       character*16 dtunit
    00030       character*64 nom
    00031       character*200 desc
    00032       integer vali
    00033       real*8 valr,dt
    00034       integer n,npdt,i,j,type,numdt,numo
    00035 C
    00036 C     Ouverture du fichier test21.med en lecture seule
    00037 C
    00038       call mfiope(fid,'test21.med',MED_ACC_RDONLY, cret)
    00039       print *,cret
    00040       if (cret .ne. 0 ) then
    00041          print *,'Erreur ouverture du fichier'
    00042          call efexit(-1)
    00043       endif
    00044       print *,'Ouverture du fichier test21.med'
    00045 C
    00046 C     Lecture du nombre de variable scalaire
    00047 C
    00048       call  mprnpr(fid,n,cret)
    00049       print *,cret
    00050       if (cret .ne. 0 ) then
    00051          print *,'Erreur lecture du nombre de variable'
    00052          call efexit(-1)
    00053       endif
    00054       print *,'Nombre de variables scalaires : ',n
    00055 C
    00056 C     Lecture des infos (type,description) propres
    00057 C     a chaque variable
    00058 C
    00059       do 10 i=1,n
    00060          call mprpri(fid,i,nom,type,desc,
    00061      &               dtunit,npdt,cret)
    00062          print *,cret
    00063          if (cret .ne. 0 ) then
    00064             print *,'Erreur lecture des infos'
    00065             call efexit(-1)
    00066          endif
    00067          print *,'- Scalaire de nom : ',nom
    00068          if (type.eq.MED_FLOAT64) then
    00069             print *,'  de type flottant'
    00070          else
    00071             print *,'  de type entier'
    00072          endif
    00073          print *,'  Description associee : ',desc
    00074          print *,'  Nombre de valeurs : ',npdt
    00075          print *,'  Unite : ',dtunit
    00076 C
    00077 C     Pour chaque scalaire, on regarde les valeurs associees
    00078 C     eventuellement a un pas de temps et/ou un numero d'ordre
    00079 C
    00080          do 20 j=1,npdt
    00081             call mprcsi(fid,nom,j,numdt,numo,dt,cret)
    00082             print *,cret
    00083             if (cret .ne. 0 ) then
    00084                print *,'Erreur infos pas de temps'
    00085                call efexit(-1)
    00086             endif
    00087             print *,'   Valeur ', j
    00088 C
    00089             if (numdt.eq.MED_NO_DT) then
    00090                print *,'     - Aucun pas de temps'
    00091             else
    00092                print *,'     - Pas de temps de numero ',numdt
    00093                print *,'      de valeur : ',dt
    00094             endif
    00095 C
    00096             if (numo.eq.MED_NO_IT) then
    00097                print *,'     - Aucun numero ordre'
    00098             else
    00099                print *,'     - Numero ordre : ',numo
    00100             endif
    00101 C
    00102             if (type.eq.MED_FLOAT64) then
    00103 C           ** Lecture de la valeur flottante associee
    00104 C           ** au pas de temps
    00105                call mprrvr(fid,nom,numdt,numo,valr,cret)
    00106                print *,cret
    00107                if (cret .ne. 0 ) then
    00108                   print *,'Erreur lecture valeur'
    00109                   call efexit(-1)
    00110                endif
    00111                print *,'     - Valeur : ',valr
    00112             else
    00113 C           ** Lecture de la valeur entiere associee
    00114 C           ** au pas de temps
    00115                call mprivr(fid,nom,numdt,numo,vali,cret)
    00116                print *,cret
    00117                if (cret .ne. 0 ) then
    00118                   print *,'Erreur lecture valeur'
    00119                   call efexit(-1)
    00120                endif
    00121                print *,'     - Valeur : ',vali
    00122             endif
    00123 C
    00124  20      continue
    00125 C
    00126  10   continue
    00127 C
    00128 C     Fermeture du fichier
    00129 C
    00130       call mficlo(fid,cret)
    00131       print *,cret
    00132       if (cret .ne. 0 ) then
    00133          print *,'Erreur fermeture du fichier'
    00134          call efexit(-1)
    00135       endif
    00136       print *,'Fermeture du fichier test21.med'
    00137 C
    00138       end