MED fichier

UsesCase_MEDfield_3.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2021 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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
usescase_medfield_3
program usescase_medfield_3
Definition: UsesCase_MEDfield_3.f90:22
mfdnfd
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
Definition: medfield.f:180
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
mfdfdi
subroutine mfdfdi(fid, it, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Cette fonction permet de lire les informations concernant le champ d'indice ind .
Definition: medfield.f:248
mfdnva
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
Cette fonction permet de lire le nombre de valeurs dans un champ pour une étape de calcul,...
Definition: medfield.f:380
mfdnfc
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
Definition: medfield.f:202
mfdrvr
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
Cette fonction permet de lire les valeurs d'un champ définies sur des entités d'un maillage pour une ...
Definition: medfield.f:461