MED fichier
UsesCase_MEDfield_4.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17 
18 C******************************************************************************
19 C *
20 C * Field use case 4 : write a field with computing steps
21 C *
22 C *****************************************************************************
24 C
25  implicit none
26  include 'med.hf77'
27 C
28 C
29  integer cret
30  integer fid
31 C component number, node number
32  integer ncompo
33 C triangular elements number, quadrangular elements number
34  integer ntria3, nquad4
35 C med file name, link file name
36  character*64 fname, lfname
37 C mesh name, field name, component name, commponent unit
38  character*64 mname, finame, cpname, cpunit
39  character*16 dtunit
40  real*8 dt
41  integer ndt, nit
42 C mesh num dt, mesh num it
43  integer mnumdt, mnumit
44 C
45  real*8 t3vs1(8)
46  real*8 t3vs2(8)
47  real*8 q4vs1(4)
48  real*8 q4vs2(4)
49 C
50  parameter(fname = "UsesCase_MEDfield_4.med")
51  parameter(lfname = "./UsesCase_MEDmesh_1.med")
52  parameter(mname = "2D unstructured mesh")
53  parameter(finame = "TEMPERATURE_FIELD")
54  parameter(cpname ="TEMPERATURE", cpunit = "C")
55  parameter(dtunit = "ms")
56  parameter(ncompo = 1 )
57  parameter(ntria3 = 8, nquad4 = 4)
58 
59  data t3vs1 / 1000., 2000., 3000., 4000.,
60  & 5000., 6000., 7000., 8000. /
61  data q4vs1 / 10000., 20000., 30000., 4000. /
62  data t3vs2 / 1500., 2500., 3500., 4500.,
63  & 5500., 6500., 7500., 8500. /
64  data q4vs2 / 15000., 25000., 35000., 45000. /
65 C
66 C
67 C file creation
68  call mfiope(fid,fname,med_acc_creat,cret)
69  if (cret .ne. 0 ) then
70  print *,'ERROR : file creation'
71  call efexit(-1)
72  endif
73 C
74 C
75 C create mesh link
76  call mlnliw(fid,mname,lfname,cret)
77  if (cret .ne. 0 ) then
78  print *,'ERROR : create mesh link ...'
79  call efexit(-1)
80  endif
81 C
82 C
83 C field creation : temperature field : 1 component in celsius degree
84 C the mesh is the 2D unstructured mesh of
85 C UsecaseMEDmesh_1.f use case. Computation step unit in 'ms'
86  call mfdcre(fid,finame,med_float64,ncompo,cpname,cpunit,dtunit,
87  & mname,cret)
88  if (cret .ne. 0 ) then
89  print *,'ERROR : create field ...'
90  call efexit(-1)
91  endif
92 C
93 C
94 C two computation steps :
95 C - first on meshname MED_NO_DT,MED_NO_IT mesh computation step
96 C - second on meshname 1,3 mesh computation step
97 C write values at cell centers : 8 MED_TRIA3 and 4 MED_QUAD4
98 C
99 C
100 C STEP 1 : dt1 = 5.5, it = 1
101 C
102 C
103 C MED_TRIA3
104  dt = 5.5d0
105  ndt = 1
106  nit = 1
107  call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_tria3,
108  & med_full_interlace,med_all_constituent,
109  & ntria3,t3vs1,cret)
110  if (cret .ne. 0 ) then
111  print *,'ERROR : write field values on MED_TRIA3'
112  call efexit(-1)
113  endif
114 C
115 C
116 C MED_QUAD4
117  call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_quad4,
118  & med_full_interlace,med_all_constituent,
119  & nquad4,q4vs1,cret)
120  if (cret .ne. 0 ) then
121  print *,'ERROR : write field values on MED_TRIA3'
122  call efexit(-1)
123  endif
124 C
125 C
126 C STEP 2 : dt2 = 8.9, it = 1
127 C
128 C MED_TRIA3
129  dt = 8.9d0
130  ndt = 2
131  nit = 1
132  call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_tria3,
133  & med_full_interlace,med_all_constituent,
134  & ntria3,t3vs2,cret)
135  if (cret .ne. 0 ) then
136  print *,'ERROR : write field values on MED_TRIA3'
137  call efexit(-1)
138  endif
139 C
140 C
141 C MED_QUAD4
142  call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_quad4,
143  & med_full_interlace,med_all_constituent,
144  & nquad4,q4vs2,cret)
145  if (cret .ne. 0 ) then
146  print *,'ERROR : write field values on MED_TRIA3'
147  call efexit(-1)
148  endif
149 C
150 C
151 C Write associated mesh computation step
152  mnumdt = 1
153  mnumit = 3
154  call mfdcmw(fid,finame,ndt,nit,mnumdt,mnumit,cret)
155  if (cret .ne. 0 ) then
156  print *,'ERROR : write field mesh computation step error '
157  call efexit(-1)
158  endif
159 C
160 C
161 C close file
162  call mficlo(fid,cret)
163  if (cret .ne. 0 ) then
164  print *,'ERROR : close file'
165  call efexit(-1)
166  endif
167 C
168 C
169 C
170  end
171 C
double med_float64
Definition: med.h:330
subroutine mfdrvw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
Cette fonction permet d'écrire les valeurs d'un champ définies sur des entités d'un maillage pour une...
Definition: medfield.f:41
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
program usescase_medfield_4
subroutine mfdcmw(fid, fname, numdt, numit, mnumdt, mnumit, cret)
Cette fonction permet de définir l'étape de calcul ( meshnumdit , meshnumit ) à utiliser pour le mail...
Definition: medfield.f:319
subroutine mlnliw(fid, mname, lname, cret)
Cette routine permet d'écrire un lien dans un fichier MED.
Definition: medlink.f:21
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
Cette fonction crée un champ dans un fichier.
Definition: medfield.f:22
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41