1  C*************************************************************************
  2  C COPYRIGHT (C) 1999 - 2003  EDF R&D
  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
 32        integer cret,ret
 33        integer fid
 34        character*200 des
 35
 36  C  ** verifie que le fichier test1.med est utilisable par MED2.2 **
 37        call effoco('test1.med',cret)
 38        print *,cret
 39
 40  C  ** Ouverture en mode de lecture du fichier test1.med
 41        if (cret .eq. 0) then
 42           call efouvr(fid,'test1.med',MED_LECTURE, cret)
 43        endif
 44        print *,cret
 45
 46  C  ** Lecture de l'en-tete du fichier
 47        if (cret .eq. 0) then
 48           call effien (fid, MED_FICH_DES,des,cret)
 49        endif
 50        if (cret .eq. 0) then
 51           print *,"DESCRIPTEUR DE FICHIER : ",des
 52        endif
 53        print *,cret
 54
 55
 56  C  ** Fermeture du fichier test1.med 
 57        call efferm (fid,cret)
 58        print *,cret
 59
 60
 61  C  ** Ouverture en mode de creation du fichier test2.med
 62        if (cret .eq. 0) then
 63           call efouvr(fid,'test2.med',MED_CREATION, cret)
 64           print *,cret
 65        endif
 66
 67  C  **  Creation du maillage maa1 de type MED_NON_STRUCTURE
 68  C  **  et de dimension 3
 69        if (cret .eq. 0) then
 70           call efmaac(fid,'maa1',3,
 71       &               MED_NON_STRUCTURE,
 72       &               'un premier maillage',ret)
 73           cret = cret + ret
 74  C  **  Creation du nom universel
 75           call efunvc(fid,'maa1',ret)
 76           cret = cret + ret
 77        endif
 78        print *,cret
 79
 80  C  **  Creation du maillage maa2 de type MED_NON_STRUCTURE
 81  C  **  et de dimension 2
 82         if (cret .eq. 0) then
 83           call efmaac(fid,'maa2',2,
 84       &               MED_NON_STRUCTURE,
 85       &               'un second maillage',ret)
 86           cret = cret + ret
 87  C  **  Ecriture de la dimension de l'espace : maillage
 88  C  **  de dimension 2 dans un espace de dimension 3
 89           call efespc(fid,'maa2',3,ret)
 90           cret = cret + ret
 91        endif
 92        print *,cret
 93
 94  C  ** Creation du maillage maa3 de type MED_STRUCTURE
 95  C  **  et de dimension 1
 96        if (cret .eq. 0) then
 97           call efmaac(fid,'maa3',1,
 98       &               MED_STRUCTURE,
 99       &               'un troisieme  maillage',ret)
100           cret = cret + ret
101        endif
102        print *,cret
103
104  C **  Fermeture du fichier
105        call efferm (fid,cret)
106        print *,cret
107
108        end
109
110
111
112
113