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 integer cret
30 integer*8 fid
31
32
33 integer ncompo
34
35 integer ntria3, nquad4
36
37 character*64 fname, lfname
38
39 character*64 mname, finame, cpname, cpunit
40 character*16 dtunit
41 real*8 dt
42 integer ndt, nit
43
44 integer mnumdt, mnumit
45
46 real*8 t3vs1(8)
47 real*8 t3vs2(8)
48 real*8 q4vs1(4)
49 real*8 q4vs2(4)
50
51 parameter(fname = "UsesCase_MEDfield_4.med")
52 parameter(lfname = "./UsesCase_MEDmesh_1.med")
53 parameter(mname = "2D unstructured mesh")
54 parameter(finame = "TEMPERATURE_FIELD")
55 parameter(cpname ="TEMPERATURE", cpunit = "C")
56 parameter(dtunit = "ms")
57 parameter(ncompo = 1 )
58 parameter(ntria3 = 8, nquad4 = 4)
59
60 data t3vs1 / 1000., 2000., 3000., 4000.,
61 & 5000., 6000., 7000., 8000. /
62 data q4vs1 / 10000., 20000., 30000., 4000. /
63 data t3vs2 / 1500., 2500., 3500., 4500.,
64 & 5500., 6500., 7500., 8500. /
65 data q4vs2 / 15000., 25000., 35000., 45000. /
66
67
68
69 call mfiope(fid,fname,med_acc_creat,cret)
70 if (cret .ne. 0 ) then
71 print *,'ERROR : file creation'
72 call efexit(-1)
73 endif
74
75
76
77 call mlnliw(fid,mname,lfname,cret)
78 if (cret .ne. 0 ) then
79 print *,'ERROR : create mesh link ...'
80 call efexit(-1)
81 endif
82
83
84
85
86
88 & mname,cret)
89 if (cret .ne. 0 ) then
90 print *,'ERROR : create field ...'
91 call efexit(-1)
92 endif
93
94
95
96
97
98
99
100
101
102
103
104
105 dt = 5.5d0
106 ndt = 1
107 nit = 1
108 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_tria3,
109 & med_full_interlace,med_all_constituent,
110 & ntria3,t3vs1,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,ndt,nit,dt,med_cell,med_quad4,
119 & med_full_interlace,med_all_constituent,
120 & nquad4,q4vs1,cret)
121 if (cret .ne. 0 ) then
122 print *,'ERROR : write field values on MED_TRIA3'
123 call efexit(-1)
124 endif
125
126
127
128
129
130 dt = 8.9d0
131 ndt = 2
132 nit = 1
133 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_tria3,
134 & med_full_interlace,med_all_constituent,
135 & ntria3,t3vs2,cret)
136 if (cret .ne. 0 ) then
137 print *,'ERROR : write field values on MED_TRIA3'
138 call efexit(-1)
139 endif
140
141
142
143 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_quad4,
144 & med_full_interlace,med_all_constituent,
145 & nquad4,q4vs2,cret)
146 if (cret .ne. 0 ) then
147 print *,'ERROR : write field values on MED_TRIA3'
148 call efexit(-1)
149 endif
150
151
152
153 mnumdt = 1
154 mnumit = 3
155 call mfdcmw(fid,finame,ndt,nit,mnumdt,mnumit,cret)
156 if (cret .ne. 0 ) then
157 print *,'ERROR : write field mesh computation step error '
158 call efexit(-1)
159 endif
160
161
162
164 if (cret .ne. 0 ) then
165 print *,'ERROR : close file'
166 call efexit(-1)
167 endif
168
169
170
171 end
172
program usescase_medfield_4
subroutine mfdrvw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
subroutine mfdcmw(fid, fname, numdt, numit, mnumdt, mnumit, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mlnliw(fid, mname, lname, cret)