MED fichier
UsesCase_MEDfield_3.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 3 : read a field (generic approach)
20 !*
21 
23 
24  implicit none
25  include 'med.hf90'
26 
27  integer cret
28  integer fid
29  integer nfield, i, j
30  character(64) :: mname
31  ! field name
32  character(64) :: finame
33  ! nvalues, local mesh, field type
34  integer nstep, nvals, lcmesh, fitype
35  integer ncompo
36  !geotype
37  integer geotp
38  integer, dimension(MED_N_CELL_FIXED_GEO):: geotps
39  character(16) :: dtunit
40  ! component name
41  character(16), dimension(:), allocatable :: cpname
42  ! component unit
43  character(16), dimension(:), allocatable :: cpunit
44  real*8, dimension(:), allocatable :: values
45 
46  geotps = med_get_cell_geometry_type
47 
48  ! open file
49  call mfiope(fid,'UsesCase_MEDfield_1.med',med_acc_rdonly, cret)
50  if (cret .ne. 0 ) then
51  print *,'ERROR : opening file'
52  call efexit(-1)
53  endif
54 
55  ! generic approach : how many fields in the file and identification
56  ! of each field.
57  call mfdnfd(fid,nfield,cret)
58  if (cret .ne. 0 ) then
59  print *,'ERROR : How many fields in the file ...'
60  call efexit(-1)
61  endif
62  print *, 'Number of field(s) in the file :', nfield
63 
64  do i=1,nfield
65  ! field information
66  ! ... we know that the field has no computation step
67  ! and that the field values type is real*8, a real code working would check ...
68  call mfdnfc(fid,i,ncompo,cret)
69  if (cret .ne. 0 ) then
70  print *,'ERROR : number of field components ...'
71  call efexit(-1)
72  endif
73  print *, 'Number of field(s) component(s) in the file :', ncompo
74 
75  allocate(cpname(ncompo),stat=cret )
76  if (cret > 0) then
77  print *,'Memory allocation'
78  call efexit(-1)
79  endif
80 
81  allocate(cpunit(ncompo),stat=cret )
82  if (cret > 0) then
83  print *,'Memory allocation'
84  call efexit(-1)
85  endif
86 
87  call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
88  if (cret .ne. 0 ) then
89  print *,'ERROR : Reading field infos ...'
90  call efexit(-1)
91  endif
92  print *, 'Field name :', finame
93  print *, 'Mesh name :', mname
94  print *, 'Local mesh :', lcmesh
95  print *, 'Field type :', fitype
96  print *, 'Component name :', cpname
97  print *, 'Component unit :', cpunit
98  print *, 'Dtunit :', dtunit
99  print *, 'Nstep :', nstep
100  deallocate(cpname,cpunit)
101 
102  ! read field values for nodes and cells
103 
104  ! MED_NODE
105  call mfdnva(fid,finame,med_no_dt,med_no_it,med_node,med_none,nvals,cret)
106  if (cret .ne. 0 ) then
107  print *,'ERROR : Read number of values ...'
108  call efexit(-1)
109  endif
110  print *, 'Number of values :', nvals
111 
112  if (nvals .gt. 0) then
113 
114  allocate(values(nvals),stat=cret )
115  if (cret > 0) then
116  print *,'Memory allocation'
117  call efexit(-1)
118  endif
119 
120  call mfdrvr(fid,finame,med_no_dt, med_no_it, med_node, med_none,&
121  med_full_interlace, med_all_constituent,values,cret)
122  if (cret .ne. 0 ) then
123  print *,'ERROR : Read fields values defined on vertices ...'
124  call efexit(-1)
125  endif
126  print *, 'Fields values defined on vertices :', values
127 
128  deallocate(values)
129 
130  endif
131 
132  ! MED_CELL
133 
134  do j=1,(med_n_cell_fixed_geo)
135 
136  geotp = geotps(j)
137 
138  call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,geotp,nvals,cret)
139  if (cret .ne. 0 ) then
140  print *,'ERROR : Read number of values ...'
141  call efexit(-1)
142  endif
143  print *, 'Number of values of type :', geotp, ' :', nvals
144 
145  if (nvals .gt. 0) then
146  allocate(values(nvals),stat=cret )
147  if (cret > 0) then
148  print *,'Memory allocation'
149  call efexit(-1)
150  endif
151 
152  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,geotp,&
153  med_full_interlace, med_all_constituent,values,cret)
154  if (cret .ne. 0 ) then
155  print *,'ERROR : Read fields values for cells ...'
156  call efexit(-1)
157  endif
158  print *, 'Fields values for cells :', values
159 
160  deallocate(values)
161 
162  endif
163  enddo
164  enddo
165 
166  ! close file **
167  call mficlo(fid,cret)
168  if (cret .ne. 0 ) then
169  print *,'ERROR : close file'
170  call efexit(-1)
171  endif
172 
173 end program usescase_medfield_3
174 
subroutine mficlo(fid, cret)
Definition: medfile.f:80
subroutine mfdfdi(fid, it, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Definition: medfield.f:248
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
Definition: medfield.f:380
subroutine mfdnfc(fid, ind, n, cret)
Definition: medfield.f:202
subroutine mfdnfd(fid, n, cret)
Definition: medfield.f:180
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
program usescase_medfield_3