MED fichier
UsesCase_MEDfield_6.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 !*
20 !* Field use case 6 : read a field (generic approach) with computing steps
21 !*
22 
24 
25  implicit none
26  include 'med.hf90'
27 
28  integer cret
29  integer fid
30  integer nfield, i, j
31  character(64) :: mname
32  ! field name
33  character(64) :: finame
34  ! nvalues, local mesh, field type
35  integer nstep, nvals, lcmesh, fitype
36  integer ncompo
37  !geotype
38  integer geotp
39  integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
40  ! mesh num dt, mesh num it
41  integer mnumdt, mnumit
42  integer csit, numit, numdt, it
43  real*8 dt
44  character(16) :: dtunit
45  ! component name
46  character(16), dimension(:), allocatable :: cpname
47  ! component unit
48  character(16), dimension(:), allocatable :: cpunit
49  real*8, dimension(:), allocatable :: values
50 
51  geotps = med_get_cell_geometry_type
52 
53  ! open MED file
54  call mfiope(fid,'UsesCase_MEDfield_4.med',med_acc_rdonly, cret)
55  if (cret .ne. 0 ) then
56  print *,'ERROR : open file'
57  call efexit(-1)
58  endif
59 
60  ! generic approach : how many fields in the file and identification
61  ! of each field.
62  call mfdnfd(fid,nfield,cret)
63  if (cret .ne. 0 ) then
64  print *,'ERROR : How many fields in the file ...'
65  call efexit(-1)
66  endif
67  print *, 'Number of field(s) in the file :', nfield
68 
69  ! read values for each field
70  do i=1,nfield
71  call mfdnfc(fid,i,ncompo,cret)
72  if (cret .ne. 0 ) then
73  print *,'ERROR : number of field components ...'
74  call efexit(-1)
75  endif
76  print *, 'Field number :', nfield
77  print *, 'Number of field(s) component(s) in the file :', ncompo
78 
79  allocate(cpname(ncompo),stat=cret )
80  if (cret > 0) then
81  print *,'Memory allocation'
82  call efexit(-1)
83  endif
84 
85  allocate(cpunit(ncompo),stat=cret )
86  if (cret > 0) then
87  print *,'Memory allocation'
88  call efexit(-1)
89  endif
90 
91  call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
92  if (cret .ne. 0 ) then
93  print *,'ERROR : Reading field infos ...'
94  call efexit(-1)
95  endif
96  print *, 'Field name :', finame
97  print *, 'Mesh name :', mname
98  print *, 'Local mesh :', lcmesh
99  print *, 'Field type :', fitype
100  print *, 'Component name :', cpname
101  print *, 'Component unit :', cpunit
102  print *, 'Dtunit :', dtunit
103  print *, 'Nstep :', nstep
104  deallocate(cpname,cpunit)
105 
106  ! Read field values for each computing step
107  do csit=1, nstep
108  call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
109  if (cret .ne. 0 ) then
110  print *,'ERROR : Computing step info ...'
111  call efexit(-1)
112  endif
113  print *, 'Computing step :',csit
114  print *, 'Numdt :', numdt
115  print *, 'Numit :', numit
116  print *, 'Dt :', dt
117  print *, 'mnumdt :', mnumdt
118  print *, 'mnumit :', mnumit
119 
120  ! ... In our case, we suppose that the field values are only defined on cells ...
121  do it=1,(med_n_cell_fixed_geo)
122 
123  geotp = geotps(it)
124 
125  call mfdnva(fid,finame,numdt,numit,med_cell,geotp,nvals,cret)
126  if (cret .ne. 0 ) then
127  print *,'ERROR : Read number of values ...'
128  call efexit(-1)
129  endif
130  print *, 'Number of values of type :', geotp, ' :', nvals
131 
132  if (nvals .gt. 0) then
133  allocate(values(nvals),stat=cret )
134  if (cret > 0) then
135  print *,'Memory allocation'
136  call efexit(-1)
137  endif
138 
139  call mfdrvr(fid,finame,numdt,numit,med_cell,geotp,&
140  med_full_interlace, med_all_constituent,values,cret)
141  if (cret .ne. 0 ) then
142  print *,'ERROR : Read fields values for cells ...'
143  call efexit(-1)
144  endif
145  print *, 'Fields values for cells :', values
146 
147  deallocate(values)
148  endif
149  enddo
150  enddo
151  enddo
152 
153  ! close file
154  call mficlo(fid,cret)
155  if (cret .ne. 0 ) then
156  print *,'ERROR : close file'
157  call efexit(-1)
158  endif
159 
160 end program usescase_medfield_6
161 
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
program usescase_medfield_6
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
subroutine mfdcmi(fid, fname, it, numdt, numit, dt, mnumdt, mnumit, cret)
Definition: medfield.f:311