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