MED fichier: Fichier source de UsesCase_MEDfield_6.f90

MED fichier

UsesCase_MEDfield_6.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 !*
20 !* Field use case 6 : read a field (generic approach) with computing steps
21 !*
22
23 program usescase_medfield_6
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
161 end program usescase_medfield_6
162
usescase_medfield_6
program usescase_medfield_6
Definition: UsesCase_MEDfield_6.f90:23
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfdnfd
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
Definition: medfield.f:180
mfdcmi
subroutine mfdcmi(fid, fname, it, numdt, numit, dt, mnumdt, mnumit, cret)
Cette fonction permet de lire les informations caractérisant une étape de calcul : numéro de pas de t...
Definition: medfield.f:311
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