MED fichier
UsesCase_MEDfield_2.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2023 EDF R&D, CEA/DEN
4 !* MED is free software: you can redistribute it and/or modify
5 !* it under the terms of the GNU Lesser General Public License as published by
6 !* the Free Software Foundation, either version 3 of the License, or
7 !* (at your option) any later version.
8 !*
9 !* MED is distributed in the hope that it will be useful,
10 !* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 !* GNU Lesser General Public License for more details.
13 !*
14 !* You should have received a copy of the GNU Lesser General Public License
15 !* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 !*
17 
18 !*
19 !* Field use case 2 : read the field of use case 1
20 !*
21 
23 
24  implicit none
25  include 'med.hf90'
26 
27  integer cret
28  integer*8 fid
29 
30  character(64) :: mname
31  ! field name
32  character(64) :: finame = 'TEMPERATURE_FIELD'
33  ! nvalues, local mesh, field type
34  integer nstep, nvals, lcmesh, fitype
35  ! component name
36  character(16) :: cpname
37  ! component unit
38  character(16) :: cpunit
39  character(16) :: dtunit
40 
41  ! vertices values
42  real*8, dimension(:), allocatable :: verval
43  real*8, dimension(:), allocatable :: tria3v
44  real*8, dimension(:), allocatable :: quad4v
45 
46  ! open MED file with READ ONLY access mode **
47  call mfiope(fid,'UsesCase_MEDfield_1.med',med_acc_rdonly,cret)
48  if (cret .ne. 0 ) then
49  print *,'ERROR : opening file'
50  call efexit(-1)
51  endif
52 
53  ! ... we know that the MED file has only one field with one component ,
54  ! a real code working would check ...
55 
56  ! if you know the field name, direct access to field informations
57  call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
58  print *,cret
59  if (cret .ne. 0 ) then
60  print *,'ERROR : field info by name'
61  call efexit(-1)
62  endif
63  print *, 'Mesh name :', mname
64  print *, 'Local mesh :', lcmesh
65  print *, 'Field type :', fitype
66  print *, 'Component name :', cpname
67  print *, 'Component unit :', cpunit
68  print *, 'dtunit :', dtunit
69  print *, 'nstep :', nstep
70 
71  ! ... we know that the field values are defined on vertices and MED_TRIA3
72  ! and MED_QUAD4 cells, a real code working would check ...
73 
74  ! MED_NODE
75  call mfdnva(fid,finame,med_no_dt,med_no_it,med_node,med_none,nvals,cret)
76  if (cret .ne. 0 ) then
77  print *,'ERROR : read number of values ...'
78  call efexit(-1)
79  endif
80 
81  print *, 'Node number :', nvals
82 
83  allocate ( verval(nvals),stat=cret )
84  if (cret > 0) then
85  print *,'Memory allocation'
86  call efexit(-1)
87  endif
88 
89  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_node,med_none,med_full_interlace,med_all_constituent,verval,cret)
90  if (cret .ne. 0 ) then
91  print *,'ERROR : read fields values on vertices ...'
92  call efexit(-1)
93  endif
94 
95  print *, 'Fields values on vertices :', verval
96 
97  deallocate(verval)
98 
99  ! MED_TRIA3
100  call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,nvals,cret)
101  if (cret .ne. 0 ) then
102  print *,'ERROR : read number of values ...'
103  call efexit(-1)
104  endif
105 
106  print *, 'Triangulars cells number :', nvals
107 
108  allocate ( tria3v(nvals),stat=cret )
109  if (cret > 0) then
110  print *,'Memory allocation'
111  call efexit(-1)
112  endif
113 
114  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,med_full_interlace,med_all_constituent,tria3v,cret)
115  if (cret .ne. 0 ) then
116  print *,'ERROR : read fields values for MED_TRIA3 cells ...'
117  call efexit(-1)
118  endif
119 
120  print *, 'Fiels values for MED_TRIA3 cells :', tria3v
121 
122  deallocate(tria3v)
123 
124  ! MED_QUAD4
125  call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,nvals,cret)
126  if (cret .ne. 0 ) then
127  print *,'ERROR : read number of values ...'
128  call efexit(-1)
129  endif
130 
131  print *, 'Quadrangulars cells number :', nvals
132 
133  allocate ( quad4v(nvals),stat=cret )
134  if (cret > 0) then
135  print *,'Memory allocation'
136  call efexit(-1)
137  endif
138 
139  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,med_full_interlace,med_all_constituent,quad4v,cret)
140  if (cret .ne. 0 ) then
141  print *,'ERROR : read fields values for MED_QUAD4 cells ...'
142  call efexit(-1)
143  endif
144 
145  print *, 'Fiels values for MED_QUAD4 cells :', quad4v
146 
147  deallocate(quad4v)
148 
149  ! close file **
150  call mficlo(fid,cret)
151  if (cret .ne. 0 ) then
152  print *,'ERROR : close file'
153  call efexit(-1)
154  endif
155 
156 end program usescase_medfield_2
157 
mfdnva
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
Cette fonction permet de lire le nombre de valeurs dans un champ pour une étape de calcul,...
Definition: medfield.f:380
usescase_medfield_2
program usescase_medfield_2
Definition: UsesCase_MEDfield_2.f90:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfdrvr
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
Cette fonction permet de lire les valeurs d'un champ définies sur des entités d'un maillage pour une ...
Definition: medfield.f:461
mfdfin
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Cette fonction permet de lire les informations concernant le champ de nom fieldname.
Definition: medfield.f:270
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42