MED fichier: Fichier source de UsesCase_MEDfield_4.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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 *****************************************************************************
23 program usescase_medfield_4
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
med_float64
double med_float64
Definition: med.h:330
mfdrvw
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
usescase_medfield_4
program usescase_medfield_4
Definition: UsesCase_MEDfield_4.f:23
mfdcmw
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
mlnliw
subroutine mlnliw(fid, mname, lname, cret)
Cette routine permet d'écrire un lien dans un fichier MED.
Definition: medlink.f:21
mfdcre
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
Cette fonction crée un champ dans un fichier.
Definition: medfield.f:22
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41