# test20.f

Aller à la documentation de ce fichier.

    00001 C*  This file is part of MED.
    00002 C*
    00003 C*  COPYRIGHT (C) 1999 - 2011  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 : test20.f
    00020 C *
    00021 C * - Description : montage/demontage de fichiers MED.
    00022 C *
    00023 C ******************************************************************************
    00024       program test20
    00025 C
    00026       implicit none
    00027       include 'med.hf'
    00028 C
    00029 C
    00030       integer cret, fid, ncha, nmaa, mid, mid2
    00031       integer i, ncomp, type
    00032       character*16  comp(3), unit(3), dtunit
    00033       character*64  nomcha,nommaa
    00034       integer lmesh, ncst
    00035 C
    00036 C     ** Ouverture du fichier test2.med en mode lecture ajout
    00037       call mfiope(fid,'test2.med',MED_ACC_RDEXT, cret)
    00038       print *,cret
    00039       if (cret .ne. 0 ) then
    00040          print *,'Erreur ouverture du fichier'
    00041          call efexit(-1)
    00042       endif
    00043       print *,'On ouvre le fichier test2.med'
    00044 C
    00045 C     ** Lecture du nombre de champ
    00046       call mfdnfd(fid,ncha,cret)
    00047       print *,cret
    00048       if (cret .ne. 0 ) then
    00049          print *,'Erreur lecture du nombre de champ'
    00050          call efexit(-1)
    00051       endif
    00052       print *,'Nombre de champs dans test2.med : ',ncha
    00053 C
    00054 C     ** Montage du fichier test10.med (acces aux champs et maillages)
    00055       call mfiomn(fid, 'test10.med', MED_FIELD, mid, cret)
    00056       print *,cret
    00057       if (cret .ne. 0 ) then
    00058          print *,'Erreur montage du fichier'
    00059          call efexit(-1)
    00060       endif
    00061       print *,'On monte les champs du fichier test10.med'
    00062 C
    00063 C     ** Lecture du nombre de champ apres montage
    00064       call mfdnfd(fid,ncha,cret)
    00065       print *,cret
    00066       if (cret .ne. 0 ) then
    00067          print *,'Erreur lecture du nombre de champ'
    00068          call efexit(-1)
    00069       endif
    00070       print *,'Nombre de champs dans test2.med apres montage : ',ncha
    00071 C
    00072 C     ** Acces a tous les champs de test10.med a travers le point de
    00073 C     ** montage
    00074 C
    00075       do 10 i = 1,ncha
    00076 C
    00077 C        ** Lecture du nombre de composante dans le champ
    00078          call mfdnfc(fid,i,ncomp,cret)
    00079          print *,cret
    00080          if (cret .ne. 0 ) then
    00081             print *,'Erreur lecture du nombre de composante'
    00082             call efexit(-1)
    00083          endif
    00084 C
    00085  10   continue
    00086 C
    00087 C
    00088 C     ** Demontage de test10.med
    00089       call mfioun(fid, mid, MED_FIELD, cret)
    00090       print *,cret
    00091       if (cret .ne. 0 ) then
    00092          print *,'Erreur demontage du fichier'
    00093          call efexit(-1)
    00094       endif
    00095       print *,'On demonte le fichier test10.med'
    00096 C
    00097 C     ** Lecture du nombre de champ apres demontage
    00098       call mfdnfd(fid,ncha,cret)
    00099       print *,cret
    00100       if (cret .ne. 0 ) then
    00101          print *,'Erreur lecture du nombre de champ'
    00102          call efexit(-1)
    00103       endif
    00104       print *,'Nombre de champs apres demontage : ',ncha
    00105 C
    00106 C     ** Fermeture du fichier
    00107       call mficlo(fid,cret)
    00108       print *, cret
    00109       if (cret .ne. 0 ) then
    00110          print *,'Erreur fermeture du fichier'
    00111          call efexit(-1)
    00112       endif
    00113       print *,'On ferme le fichier test2.med'
    00114 C
    00115 C     ** Creation du fichier test20.med
    00116       call mfiope(fid,'test20.med',MED_ACC_RDWR,cret)
    00117       print *,cret
    00118       if (cret .ne. 0 ) then
    00119          print *,'Erreur creation du fichier'
    00120          call efexit(-1)
    00121       endif
    00122       print *,'Creation du fichier test20.med'
    00123 C
    00124 C     ** Montage du fichier test2.med (acces aux maillages)
    00125       call mfiomn(fid, 'test2.med', MED_MESH, mid, cret)
    00126       print *,cret
    00127       if (cret .ne. 0 ) then
    00128          print *,'Erreur montage du fichier'
    00129          call efexit(-1)
    00130       endif
    00131       print *,'On monte le fichier test2.med'
    00132 C
    00133 C     ** Lecture du nombre de maillage apres montage
    00134       call mmhnmh(fid,nmaa,cret)
    00135       print *,cret
    00136       if (cret .ne. 0 ) then
    00137          print *,'Erreur lecture du nombre de maillage'
    00138          call efexit(-1)
    00139       endif
    00140       print *,'Nombre de maillage apres montage : ', nmaa
    00141 C
    00142 C     ** Montage du fichier test10.med (acces aux champs)
    00143       call mfiomn(fid, 'test10.med', MED_FIELD, mid2, cret)
    00144       print *,cret
    00145       if (cret .ne. 0 ) then
    00146          print *,'Erreur montage du fichier'
    00147          call efexit(-1)
    00148       endif
    00149       print *,'On monte le fichier test10.med'
    00150 C
    00151 C     ** Lecture du nombre de champs apres montage
    00152       call mfdnfd(fid,ncha,cret)
    00153       print *,cret
    00154       if (cret .ne. 0 ) then
    00155          print *,'Erreur lecture du nombre de champ'
    00156          call efexit(-1)
    00157       endif
    00158       print *,'Nombre de champ  apres montage : ',ncha
    00159 C
    00160 C     ** Demontage de test10.med
    00161       call mfioun(fid, mid2,MED_FIELD,cret)
    00162       print *,cret
    00163       if (cret .ne. 0 ) then
    00164          print *,'Erreur demontage du fichier'
    00165          call efexit(-1)
    00166       endif
    00167       print *,'On demonte test10.med'
    00168 C
    00169 C     ** Demontage de test2.med
    00170       call mfioun(fid, mid,MED_MESH,cret)
    00171       print *,cret
    00172       if (cret .ne. 0 ) then
    00173          print *,'Erreur demontage du fichier'
    00174          call efexit(-1)
    00175       endif
    00176       print *,'On demonte test2.med'
    00177 C
    00178 C     ** Fermeture du fichier
    00179       call mficlo(fid,cret)
    00180       print *,cret
    00181       if (cret .ne. 0 ) then
    00182          print *,'Erreur fermeture du fichier'
    00183          call efexit(-1)
    00184       endif
    00185       print *,'Fermeture du fichier test20.med'
    00186 C
    00187       end
    00188 C