MED fichier
UsesCase_MEDfield_5.f90
Aller à la documentation de ce fichier.
1!* This file is part of MED.
2!*
3!* COPYRIGHT (C) 1999 - 2020 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
132end program usescase_medfield_5
133
program usescase_medfield_5
subroutine mfdcmi(fid, fname, it, numdt, numit, dt, mnumdt, mnumit, cret)
Definition medfield.f:311
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Definition medfield.f:270
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 mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82