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 
161 end program usescase_medfield_6
162 
mfdrvr
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
Definition: medfield.f:461
mfdnfc
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
Definition: medfield.f:202
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
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
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
mfdnfd
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
Definition: medfield.f:180
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
usescase_medfield_6
program usescase_medfield_6
Definition: UsesCase_MEDfield_6.f90:23
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42