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 : test6.f
 21 C       *
 22 C       * - Description : exemples d'ecriture d'elements dans un maillage MED
 23 C       *
 24 C       ******************************************************************************
 25         program test6
 26 C
 27         implicit none
 28         include 'med.hf'
 29 C
 30 C       
 31         integer cret, fid
 32         
 33         integer     mdim,nse2,ntr3
 34         parameter  (nse2 = 5, ntr3 = 2, mdim = 2)
 35         integer     se2 (2*nse2)
 36         character*16 nomse2(nse2)
 37         integer     numse2(nse2),nufase2(nse2)
 38 
 39         integer     tr3 (3*ntr3)
 40         character*16 nomtr3(ntr3)
 41         integer     numtr3(ntr3), nufatr3(ntr3)
 42         character*32 maa
 43 
 44         data se2     / 1,2,1,3,2,4,3,4,2,3 /
 45         data nomse2  /"se1","se2","se3","se4","se5" /
 46         data numse2  / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/
 47         data tr3     /1,2,-5,-5,3,-4 /, nomtr3 /"tr1","tr2"/,
 48      &                                  numtr3 /4,5/
 49         data nufatr3 /0,-1/,  maa /"maa1"/
 50 
 51 C       ** Ouverture du fichier                            **
 52         call efouvr(fid,'test6.med',MED_LECTURE_ECRITURE, cret)
 53         print *,cret
 54         if (cret .ne. 0 ) then
 55            print *,'Erreur creation du fichier'
 56            call efexit(-1)
 57         endif
 58 
 59 C       ** Creation du maillage maa de dimension 2         **
 60         call efmaac(fid,maa,mdim,MED_NON_STRUCTURE,
 61      &                 'un maillage pour test6',cret)
 62         print *,cret
 63         if (cret .ne. 0 ) then
 64            print *,'Erreur creation du maillage'
 65            call efexit(-1)
 66         endif
 67 
 68 C       ** Ecriture des connectivites des segments         **
 69         call efcone(fid,maa,mdim,se2,MED_NO_INTERLACE,
 70      &               nse2,MED_ARETE,
 71      &               MED_SEG2,MED_DESC,cret )
 72         print *,cret
 73         if (cret .ne. 0 ) then
 74            print *,'Erreur ecriture de la connectivite'
 75            call efexit(-1)
 76         endif
 77 
 78 C       ** Ecriture (optionnelle) des noms des segments    **
 79         call efnome(fid,maa,nomse2,nse2,MED_ARETE,
 80      &                        MED_SEG2 ,cret)
 81         print *,cret
 82         if (cret .ne. 0 ) then
 83            print *,'Erreur ecriture des noms'
 84            call efexit(-1)
 85         endif
 86 
 87 C       ** Ecriture (optionnelle) des numeros des segments **
 88         call efnume(fid,maa,numse2,nse2,
 89      &              MED_ARETE ,MED_SEG2,cret)
 90         print *,cret
 91         if (cret .ne. 0 ) then
 92            print *,'Erreur ecriture des numeros'
 93            call efexit(-1)
 94         endif
 95 
 96 C       ** Ecriture des numeros des familles des segments  **
 97         call effame(fid,maa,nufase2,nse2,
 98      &              MED_ARETE,MED_SEG2,cret)
 99         print *,cret
100         if (cret .ne. 0 ) then
101            print *,'Erreur ecriture des numéros de famille'
102            call efexit(-1)
103         endif
104 
105 C       ** Ecriture des connectivites des triangles        **
106         call efcone(fid,maa,mdim,tr3,MED_NO_INTERLACE,
107      &              ntr3,MED_MAILLE,
108      &              MED_TRIA3,MED_DESC,cret )
109         print *,cret
110         if (cret .ne. 0 ) then
111            print *,'Erreur ecriture de la connectivite'
112            call efexit(-1)
113         endif
114 
115 C       ** Ecriture (optionnelle) des noms des triangles   **
116         call efnome(fid,maa,nomtr3,ntr3,MED_MAILLE,
117      &                        MED_TRIA3,cret)
118         print *,cret
119         if (cret .ne. 0 ) then
120            print *,'Erreur ecriture des noms'
121            call efexit(-1)
122         endif
123 
124 C       ** Ecriture (optionnelle) des numeros des triangles **
125         call efnume(fid,maa,numtr3,ntr3,MED_MAILLE,
126      &                       MED_TRIA3,cret)
127         print *,cret
128         if (cret .ne. 0 ) then
129            print *,'Erreur ecriture des numeros'
130            call efexit(-1)
131         endif
132 
133 C      ** Ecriture des numeros des familles des triangles  **
134         call effame(fid,maa,nufatr3,ntr3,MED_MAILLE,
135      &                      MED_TRIA3,cret)
136         print *,cret
137         if (cret .ne. 0 ) then
138            print *,'Erreur ecriture des numeros de famille'
139            call efexit(-1)
140         endif
141 
142 C       ** Fermeture du fichier   **
143         call efferm (fid,cret)
144         print *,cret
145         if (cret .ne. 0 ) then
146            print *,'Erreur a la fermeture du fichier'
147            call efexit(-1)
148         endif
149 C
150         end