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