MED fichier
UsesCase_MEDfield_2.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2019 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 
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
Definition: medfield.f:461
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Definition: medfield.f:270
program usescase_medfield_2
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
Definition: medfield.f:380
subroutine mficlo(fid, cret)
Definition: medfile.f:82