      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 : test2.f
     21 C *
     22 C * - Description : exemples de creations de maillage MED
     23 C *
     24 C ******************************************************************************
     25       program test2
     26 C
     27       implicit none
     28       include 'med.hf'
     29 C
     30 C
     31       integer cret,ret
     32       integer fid
     33       character*200 des
     34
     35 C  ** verifie que le fichier test1.med est au bon format **
     36       call effoco('test1.med',cret)
     37       print *,cret
     38       if (cret .ne. 0 ) then
     39          print *,'Erreur ŕ la vérification du format'
     40          call efexit(-1)
     41       endif
     42
     43 C  ** Ouverture en mode de lecture du fichier test1.med
     44       call efouvr(fid,'test1.med',MED_LECTURE, cret)
     45       print *,cret
     46       if (cret .ne. 0 ) then
     47          print *,'Erreur ouverture du fichier en lecture'
     48          call efexit(-1)
     49       endif
     50
     51 C  ** Lecture de l'en-tete du fichier
     52       call effien (fid, MED_FICH_DES,des,cret)
     53       print *,cret
     54       if (cret .ne. 0 ) then
     55          print *,'Erreur lecture en-tete du fichier'
     56          call efexit(-1)
     57       endif
     58       print *,"DESCRIPTEUR DE FICHIER : ",des
     59
     60
     61 C  ** Fermeture du fichier test1.med
     62       call efferm (fid,cret)
     63       print *,cret
     64       if (cret .ne. 0 ) then
     65          print *,'Erreur fermeture du fichier'
     66          call efexit(-1)
     67       endif
     68
     69
     70 C  ** Ouverture en mode de creation du fichier test2.med
     71       call efouvr(fid,'test2.med',MED_LECTURE_ECRITURE, cret)
     72       print *,cret
     73       if (cret .ne. 0 ) then
     74          print *,'Erreur creation du fichier'
     75          call efexit(-1)
     76       endif
     77
     78 C  **  Creation du maillage maa1 de type MED_NON_STRUCTURE
     79 C  **  et de dimension 3
     80       call efmaac(fid,'maa1',3,
     81      &     MED_NON_STRUCTURE,
     82      &     'un premier maillage',ret)
     83       cret = cret + ret
     84 C     **  Creation du nom universel
     85       call efunvc(fid,'maa1',ret)
     86       cret = cret + ret
     87       print *,cret
     88       if (cret .ne. 0 ) then
     89          print *,'Erreur creation du maillage'
     90          call efexit(-1)
     91       endif
     92
     93 C  **  Creation du maillage maa2 de type MED_NON_STRUCTURE
     94 C  **  et de dimension 2
     95       call efmaac(fid,'maa2',2,
     96      &     MED_NON_STRUCTURE,
     97      &     'un second maillage',ret)
     98       cret = cret + ret
     99 C  **  Ecriture de la dimension de l'espace : maillage
    100 C  **  de dimension 2 dans un espace de dimension 3
    101       call efespc(fid,'maa2',3,ret)
    102       cret = cret + ret
    103       print *,cret
    104       if (cret .ne. 0 ) then
    105          print *,'Erreur creation du maillage'
    106          call efexit(-1)
    107       endif
    108
    109 C  ** Creation du maillage maa3 de type MED_STRUCTURE
    110 C  **  et de dimension 1
    111       call efmaac(fid,'maa3',1,
    112      &     MED_STRUCTURE,
    113      &     'un troisieme  maillage',ret)
    114       cret = cret + ret
    115       print *,cret
    116       if (cret .ne. 0 ) then
    117          print *,'Erreur creation du maillage'
    118          call efexit(-1)
    119       endif
    120
    121 C **  Fermeture du fichier
    122       call efferm (fid,cret)
    123       print *,cret
    124       if (cret .ne. 0 ) then
    125          print *,'Erreur fermeture du fichier'
    126          call efexit(-1)
    127       endif
    128 C
    129       end
    130
    131
    132
    133
    134