MED fichier
usecases/f/UsesCase_MEDfield_1.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2021 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*8 fid
32 
33 C component number, node number
34  integer ncompo, nnodes
35 C triangular elements number, quadrangular elements number
36  integer ntria3, nquad4
37 C med file name, field name, link file name
38  character*64 fname, finame, lfname
39 C component name, commponent unit
40  character*16 cpname, cpunit
41 C mesh name
42  character*64 mname
43  character*16 dtunit
44  real*8 dt
45 C vertices values
46  real*8 verval(15)
47  real*8 tria3v(8)
48  real*8 quad4v(4)
49 C
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)
60 C
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. /
67 C
68 C
69 C 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
75 C
76 C
77 C 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
83 C
84 C
85 C field creation : temperature field : 1 component in celsius degree
86 C the mesh is the 2D unstructured mesh of
87 C 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
94 C
95 C
96 C 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
104 C
105 C
106 C write values at cell centers : 8 MED_TRIA3 and 4 MED_QUAD4
107 C 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
115 C
116 C
117 C 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
125 C
126 C
127 C close file
128  call mficlo(fid,cret)
129  if (cret .ne. 0 ) then
130  print *,'ERROR : close file'
131  call efexit(-1)
132  endif
133 C
134  end
135 C
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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
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:42
usescase_medfield_1
program usescase_medfield_1
Definition: UsesCase_MEDfield_1.f:23
med_float64
double med_float64
Definition: med.h:337