MED fichier: Fichier source de UsesCase_MEDfield_3.f90

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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