MED fichier: Fichier source de UsesCase_MEDfield_1.f

MED fichier

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

UsesCase_MEDfield_1.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 1 : write a field on mesh vertices and elements
21 C *
22 C *****************************************************************************
23 program usescase_medfield_1
24 C
25 implicit none
26 include 'med.hf77'
27 C
28 C
29 C
30 integer cret
31 integer fid
32 C component number, node number
33 integer ncompo, nnodes
34 C triangular elements number, quadrangular elements number
35 integer ntria3, nquad4
36 C med file name, field name, link file name
37 character*64 fname, finame, lfname
38 C component name, commponent unit
39 character*16 cpname, cpunit
40 C mesh name
41 character*64 mname
42 character*16 dtunit
43 real*8 dt
44 C vertices values
45 real*8 verval(15)
46 real*8 tria3v(8)
47 real*8 quad4v(4)
48 C
49 parameter(fname = "./UsesCase_MEDfield_1.med")
50 parameter(lfname= "./UsesCase_MEDmesh_1.med")
51 parameter(mname = "2D unstructured mesh")
52 parameter(finame = "TEMPERATURE_FIELD")
53 parameter(cpname = "TEMPERATURE")
54 parameter(cpunit = "C")
55 parameter(dtunit = " ")
56 parameter(nnodes = 15, ncompo = 1 )
57 parameter(ntria3 = 8, nquad4 = 4)
58 parameter(dt = 0.0d0)
59 C
60 data verval / 0., 100., 200., 300., 400.,
61 & 500., 600., 700., 800., 900,
62 & 1000., 1100, 1200., 1300., 1500. /
63 data tria3v / 1000., 2000., 3000., 4000.,
64 & 5000., 6000., 7000., 8000. /
65 data quad4v / 10000., 20000., 30000., 4000. /
66 C
67 C
68 C file creation
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 C
75 C
76 C create mesh link
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 C
83 C
84 C field creation : temperature field : 1 component in celsius degree
85 C the mesh is the 2D unstructured mesh of
86 C UsecaseMEDmesh_1.f
87 call mfdcre(fid,finame,med_float64,ncompo,cpname,cpunit,dtunit,
88 & mname,cret)
89 if (cret .ne. 0 ) then
90 print *,'ERROR : create field ...'
91 call efexit(-1)
92 endif
93 C
94 C
95 C write field values at vertices
96 call mfdrvw(fid,finame,med_no_dt,med_no_it,dt,med_node,
97 & med_none,med_full_interlace,med_all_constituent,
98 & nnodes,verval,cret)
99 if (cret .ne. 0 ) then
100 print *,'ERROR : write field values on vertices'
101 call efexit(-1)
102 endif
103 C
104 C
105 C write values at cell centers : 8 MED_TRIA3 and 4 MED_QUAD4
106 C MED_TRIA3
107 call mfdrvw(fid,finame,med_no_dt,med_no_it,dt,med_cell,
108 & med_tria3,med_full_interlace,med_all_constituent,
109 & ntria3,tria3v,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,med_no_dt,med_no_it,dt,med_cell,
118 & med_quad4,med_full_interlace,med_all_constituent,
119 & nquad4,quad4v,cret)
120 if (cret .ne. 0 ) then
121 print *,'ERROR : write field values on MED_QUAD4'
122 call efexit(-1)
123 endif
124 C
125 C
126 C close file
127 call mficlo(fid,cret)
128 if (cret .ne. 0 ) then
129 print *,'ERROR : close file'
130 call efexit(-1)
131 endif
132 C
133 end
134 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
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
usescase_medfield_1
program usescase_medfield_1
Definition: UsesCase_MEDfield_1.f:23
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41