1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
24
25 implicit none
26 include 'med.hf77'
27
28
29
30 integer cret
31 integer*8 fid
32
33
34 integer ncompo, nnodes
35
36 integer ntria3, nquad4
37
38 character*64 fname, finame, lfname
39
40 character*16 cpname, cpunit
41
42 character*64 mname
43 character*16 dtunit
44 real*8 dt
45
46 real*8 verval(15)
47 real*8 tria3v(8)
48 real*8 quad4v(4)
49
50 parameter(fname = "./UsesCase_MEDfield_1.med")
51 parameter(lfname= "./UsesCase_MEDmesh_1.med")
52 parameter(mname = "2D unstructured mesh")
53 parameter(finame = "TEMPERATURE_FIELD")
54 parameter(cpname = "TEMPERATURE")
55 parameter(cpunit = "C")
56 parameter(dtunit = " ")
57 parameter(nnodes = 15, ncompo = 1 )
58 parameter(ntria3 = 8, nquad4 = 4)
59 parameter(dt = 0.0d0)
60
61 data verval / 0., 100., 200., 300., 400.,
62 & 500., 600., 700., 800., 900,
63 & 1000., 1100, 1200., 1300., 1500. /
64 data tria3v / 1000., 2000., 3000., 4000.,
65 & 5000., 6000., 7000., 8000. /
66 data quad4v / 10000., 20000., 30000., 4000. /
67
68
69
70 call mfiope(fid,fname,med_acc_creat,cret)
71 if (cret .ne. 0 ) then
72 print *,'ERROR : file creation'
73 call efexit(-1)
74 endif
75
76
77
78 call mlnliw(fid,mname,lfname,cret)
79 if (cret .ne. 0 ) then
80 print *,'ERROR : create mesh link ...'
81 call efexit(-1)
82 endif
83
84
85
86
87
89 & mname,cret)
90 if (cret .ne. 0 ) then
91 print *,'ERROR : create field ...'
92 call efexit(-1)
93 endif
94
95
96
97 call mfdrvw(fid,finame,med_no_dt,med_no_it,dt,med_node,
98 & med_none,med_full_interlace,med_all_constituent,
99 & nnodes,verval,cret)
100 if (cret .ne. 0 ) then
101 print *,'ERROR : write field values on vertices'
102 call efexit(-1)
103 endif
104
105
106
107
108 call mfdrvw(fid,finame,med_no_dt,med_no_it,dt,med_cell,
109 & med_tria3,med_full_interlace,med_all_constituent,
110 & ntria3,tria3v,cret)
111 if (cret .ne. 0 ) then
112 print *,'ERROR : write field values on MED_TRIA3'
113 call efexit(-1)
114 endif
115
116
117
118 call mfdrvw(fid,finame,med_no_dt,med_no_it,dt,med_cell,
119 & med_quad4,med_full_interlace,med_all_constituent,
120 & nquad4,quad4v,cret)
121 if (cret .ne. 0 ) then
122 print *,'ERROR : write field values on MED_QUAD4'
123 call efexit(-1)
124 endif
125
126
127
129 if (cret .ne. 0 ) then
130 print *,'ERROR : close file'
131 call efexit(-1)
132 endif
133
134 end
135
program usescase_medfield_1
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
Cette fonction crée un champ dans un fichier.
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mlnliw(fid, mname, lname, cret)
Cette routine permet d'écrire un lien dans un fichier MED.
subroutine mfdrvw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)