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