MED fichier
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 *****************************************************************************
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
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
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
program usescase_medfield_1
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41