MED fichier
UsesCase_MEDfield_1.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C******************************************************************************
19C *
20C * Field use case 1 : write a field on mesh vertices and elements
21C *
22C *****************************************************************************
24C
25 implicit none
26 include 'med.hf77'
27C
28C
29C
30 integer cret
31 integer*8 fid
32
33C component number, node number
34 integer ncompo, nnodes
35C triangular elements number, quadrangular elements number
36 integer ntria3, nquad4
37C med file name, field name, link file name
38 character*64 fname, finame, lfname
39C component name, commponent unit
40 character*16 cpname, cpunit
41C mesh name
42 character*64 mname
43 character*16 dtunit
44 real*8 dt
45C vertices values
46 real*8 verval(15)
47 real*8 tria3v(8)
48 real*8 quad4v(4)
49C
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)
60C
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. /
67C
68C
69C file creation
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
75C
76C
77C create mesh link
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
83C
84C
85C field creation : temperature field : 1 component in celsius degree
86C the mesh is the 2D unstructured mesh of
87C UsecaseMEDmesh_1.f
88 call mfdcre(fid,finame,med_float64,ncompo,cpname,cpunit,dtunit,
89 & mname,cret)
90 if (cret .ne. 0 ) then
91 print *,'ERROR : create field ...'
92 call efexit(-1)
93 endif
94C
95C
96C write field values at vertices
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
104C
105C
106C write values at cell centers : 8 MED_TRIA3 and 4 MED_QUAD4
107C MED_TRIA3
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
115C
116C
117C MED_QUAD4
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
125C
126C
127C close file
128 call mficlo(fid,cret)
129 if (cret .ne. 0 ) then
130 print *,'ERROR : close file'
131 call efexit(-1)
132 endif
133C
134 end
135C
program usescase_medfield_1
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:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
subroutine mlnliw(fid, mname, lname, cret)
Cette routine permet d'écrire un lien dans un fichier MED.
Definition: medlink.f:21
double med_float64
Definition: med.h:328
subroutine mfdrvw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
Definition: medfield.f:42