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