# f/2.3.6/test2.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 : test2.f
    00020 C *
    00021 C * - Description : exemples de creations de maillage MED
    00022 C *
    00023 C ******************************************************************************
    00024       program test2
    00025 C
    00026       implicit none
    00027       include 'med.hf'
    00028 C
    00029 C
    00030       integer cret,ret
    00031       integer fid
    00032       character*200 des
    00033
    00034 C  ** verifie que le fichier test1.med est au bon format **
    00035       call effoco('test1.med',cret)
    00036       print *,cret
    00037       if (cret .ne. 0 ) then
    00038          print *,'Erreur à la vérification du format'
    00039          call efexit(-1)
    00040       endif
    00041
    00042 C  ** Ouverture en mode de lecture du fichier test1.med
    00043       call efouvr(fid,'test1.med',MED_LECTURE, cret)
    00044       print *,cret
    00045       if (cret .ne. 0 ) then
    00046          print *,'Erreur ouverture du fichier en lecture'
    00047          call efexit(-1)
    00048       endif
    00049
    00050 C  ** Lecture de l'en-tete du fichier
    00051       call effien (fid, MED_FICH_DES,des,cret)
    00052       print *,cret
    00053       if (cret .ne. 0 ) then
    00054          print *,'Erreur lecture en-tete du fichier'
    00055          call efexit(-1)
    00056       endif
    00057       print *,"DESCRIPTEUR DE FICHIER : ",des
    00058
    00059
    00060 C  ** Fermeture du fichier test1.med
    00061       call efferm (fid,cret)
    00062       print *,cret
    00063       if (cret .ne. 0 ) then
    00064          print *,'Erreur fermeture du fichier'
    00065          call efexit(-1)
    00066       endif
    00067
    00068
    00069 C  ** Ouverture en mode de creation du fichier test2.med
    00070       call efouvr(fid,'test2.med',MED_LECTURE_ECRITURE, cret)
    00071       print *,cret
    00072       if (cret .ne. 0 ) then
    00073          print *,'Erreur creation du fichier'
    00074          call efexit(-1)
    00075       endif
    00076
    00077 C  **  Creation du maillage maa1 de type MED_NON_STRUCTURE
    00078 C  **  et de dimension 3
    00079       call efmaac(fid,'maa1',3,
    00080      &     MED_NON_STRUCTURE,
    00081      &     'un premier maillage',ret)
    00082       cret = cret + ret
    00083 C     **  Creation du nom universel
    00084       call efunvc(fid,'maa1',ret)
    00085       cret = cret + ret
    00086       print *,cret
    00087       if (cret .ne. 0 ) then
    00088          print *,'Erreur creation du maillage'
    00089          call efexit(-1)
    00090       endif
    00091
    00092 C  **  Creation du maillage maa2 de type MED_NON_STRUCTURE
    00093 C  **  et de dimension 2
    00094       call efmaac(fid,'maa2',2,
    00095      &     MED_NON_STRUCTURE,
    00096      &     'un second maillage',ret)
    00097       cret = cret + ret
    00098 C  **  Ecriture de la dimension de l'espace : maillage
    00099 C  **  de dimension 2 dans un espace de dimension 3
    00100       call efespc(fid,'maa2',3,ret)
    00101       cret = cret + ret
    00102       print *,cret
    00103       if (cret .ne. 0 ) then
    00104          print *,'Erreur creation du maillage'
    00105          call efexit(-1)
    00106       endif
    00107
    00108 C  ** Creation du maillage maa3 de type MED_STRUCTURE
    00109 C  **  et de dimension 1
    00110       call efmaac(fid,'maa3',1,
    00111      &     MED_STRUCTURE,
    00112      &     'un troisieme  maillage',ret)
    00113       cret = cret + ret
    00114       print *,cret
    00115       if (cret .ne. 0 ) then
    00116          print *,'Erreur creation du maillage'
    00117          call efexit(-1)
    00118       endif
    00119
    00120 C **  Fermeture du fichier
    00121       call efferm (fid,cret)
    00122       print *,cret
    00123       if (cret .ne. 0 ) then
    00124          print *,'Erreur fermeture du fichier'
    00125          call efexit(-1)
    00126       endif
    00127 C
    00128       end
    00129
    00130
    00131
    00132
    00133