test20.f

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

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