MED fichier
UsesCase_MEDfield_2.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2017 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 fid
29  character(64) :: mname
30  ! field name
31  character(64) :: finame = 'TEMPERATURE_FIELD'
32  ! nvalues, local mesh, field type
33  integer nstep, nvals, lcmesh, fitype
34  ! component name
35  character(16) :: cpname
36  ! component unit
37  character(16) :: cpunit
38  character(16) :: dtunit
39 
40  ! vertices values
41  real*8, dimension(:), allocatable :: verval
42  real*8, dimension(:), allocatable :: tria3v
43  real*8, dimension(:), allocatable :: quad4v
44 
45  ! open MED file with READ ONLY access mode **
46  call mfiope(fid,'UsesCase_MEDfield_1.med',med_acc_rdonly,cret)
47  if (cret .ne. 0 ) then
48  print *,'ERROR : opening file'
49  call efexit(-1)
50  endif
51 
52  ! ... we know that the MED file has only one field with one component ,
53  ! a real code working would check ...
54 
55  ! if you know the field name, direct access to field informations
56  call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
57  print *,cret
58  if (cret .ne. 0 ) then
59  print *,'ERROR : field info by name'
60  call efexit(-1)
61  endif
62  print *, 'Mesh name :', mname
63  print *, 'Local mesh :', lcmesh
64  print *, 'Field type :', fitype
65  print *, 'Component name :', cpname
66  print *, 'Component unit :', cpunit
67  print *, 'dtunit :', dtunit
68  print *, 'nstep :', nstep
69 
70  ! ... we know that the field values are defined on vertices and MED_TRIA3
71  ! and MED_QUAD4 cells, a real code working would check ...
72 
73  ! MED_NODE
74  call mfdnva(fid,finame,med_no_dt,med_no_it,med_node,med_none,nvals,cret)
75  if (cret .ne. 0 ) then
76  print *,'ERROR : read number of values ...'
77  call efexit(-1)
78  endif
79 
80  print *, 'Node number :', nvals
81 
82  allocate ( verval(nvals),stat=cret )
83  if (cret > 0) then
84  print *,'Memory allocation'
85  call efexit(-1)
86  endif
87 
88  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_node,med_none,med_full_interlace,med_all_constituent,verval,cret)
89  if (cret .ne. 0 ) then
90  print *,'ERROR : read fields values on vertices ...'
91  call efexit(-1)
92  endif
93 
94  print *, 'Fields values on vertices :', verval
95 
96  deallocate(verval)
97 
98  ! MED_TRIA3
99  call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,nvals,cret)
100  if (cret .ne. 0 ) then
101  print *,'ERROR : read number of values ...'
102  call efexit(-1)
103  endif
104 
105  print *, 'Triangulars cells number :', nvals
106 
107  allocate ( tria3v(nvals),stat=cret )
108  if (cret > 0) then
109  print *,'Memory allocation'
110  call efexit(-1)
111  endif
112 
113  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,med_full_interlace,med_all_constituent,tria3v,cret)
114  if (cret .ne. 0 ) then
115  print *,'ERROR : read fields values for MED_TRIA3 cells ...'
116  call efexit(-1)
117  endif
118 
119  print *, 'Fiels values for MED_TRIA3 cells :', tria3v
120 
121  deallocate(tria3v)
122 
123  ! MED_QUAD4
124  call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,nvals,cret)
125  if (cret .ne. 0 ) then
126  print *,'ERROR : read number of values ...'
127  call efexit(-1)
128  endif
129 
130  print *, 'Quadrangulars cells number :', nvals
131 
132  allocate ( quad4v(nvals),stat=cret )
133  if (cret > 0) then
134  print *,'Memory allocation'
135  call efexit(-1)
136  endif
137 
138  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,med_full_interlace,med_all_constituent,quad4v,cret)
139  if (cret .ne. 0 ) then
140  print *,'ERROR : read fields values for MED_QUAD4 cells ...'
141  call efexit(-1)
142  endif
143 
144  print *, 'Fiels values for MED_QUAD4 cells :', quad4v
145 
146  deallocate(quad4v)
147 
148  ! close file **
149  call mficlo(fid,cret)
150  if (cret .ne. 0 ) then
151  print *,'ERROR : close file'
152  call efexit(-1)
153  endif
154 
155 end program usescase_medfield_2
156 
subroutine mficlo(fid, cret)
Definition: medfile.f:80
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
Definition: medfield.f:380
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Definition: medfield.f:270
program usescase_medfield_2
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
Definition: medfield.f:461
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:41