MED fichier
UsesCase_MEDfield_5.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 !*
20 !* Field use case 5 : read a field with following with computing steps
21 !*
22 
24 
25  implicit none
26  include 'med.hf90'
27 
28  integer cret
29  integer*8 fid
30 
31  character(64) :: mname
32  ! field name
33  character(64) :: finame = 'TEMPERATURE_FIELD'
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) :: cpname
47  ! component unit
48  character(16) :: 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  ! ... we know that the MED file has only one field with one component ,
61  ! a real code working would check ...
62  !
63  ! if you know the field name, direct access to field informations
64  call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
65  if (cret .ne. 0 ) then
66  print *,'ERROR : Field info by name ...'
67  call efexit(-1)
68  endif
69  print *, 'Mesh name :', mname
70  print *, 'Local mesh :', lcmesh
71  print *, 'Field type :', fitype
72  print *, 'Component name :', cpname
73  print *, 'Component unit :', cpunit
74  print *, 'Dtunit :', dtunit
75  print *, 'Nstep :', nstep
76 
77  ! Read field values for each computing step
78  do csit=1,nstep
79  call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
80  if (cret .ne. 0 ) then
81  print *,'ERROR : Computing step info ...'
82  call efexit(-1)
83  endif
84  print *, 'csit :', csit
85  print *, 'numdt :', numdt
86  print *, 'numit :', numit
87  print *, 'dt :', dt
88  print *, 'mnumdt :', mnumdt
89  print *, 'mnumit :', mnumit
90 
91  ! ... In our case, we suppose that the field values are only defined on cells ...
92 
93  do it=1,(med_n_cell_fixed_geo)
94 
95  geotp = geotps(it)
96 
97  call mfdnva(fid,finame,numdt,numit,med_cell,geotp,nvals,cret)
98  if (cret .ne. 0 ) then
99  print *,'ERROR : Read number of values ...'
100  call efexit(-1)
101  endif
102  print *, 'Number of values of type :', geotp, ' :', nvals
103 
104  if (nvals .gt. 0) then
105  allocate(values(nvals),stat=cret )
106  if (cret > 0) then
107  print *,'Memory allocation'
108  call efexit(-1)
109  endif
110 
111  call mfdrvr(fid,finame,numdt,numit,med_cell,geotp,&
112  med_full_interlace, med_all_constituent,values,cret)
113  if (cret .ne. 0 ) then
114  print *,'ERROR : Read fields values for cells ...'
115  call efexit(-1)
116  endif
117  print *, 'Fields values for cells :', values
118 
119  deallocate(values)
120 
121  endif
122  enddo
123  enddo
124 
125  ! close file
126  call mficlo(fid,cret)
127  if (cret .ne. 0 ) then
128  print *,'ERROR : close file'
129  call efexit(-1)
130  endif
131 
132 end program usescase_medfield_5
133 
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Definition: medfield.f:270
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
program usescase_medfield_5
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
Definition: medfield.f:461
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
Definition: medfield.f:380
subroutine mficlo(fid, cret)
Definition: medfile.f:82
subroutine mfdcmi(fid, fname, it, numdt, numit, dt, mnumdt, mnumit, cret)
Definition: medfield.f:311