MED fichier
UsesCase_MEDfield_3.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 !* Field use case 3 : read a field (generic approach)
20 !*
21 
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 
program usescase_medfield_3
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
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
Definition: medfield.f:180
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
Definition: medfield.f:202
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
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
Definition: medfield.f:461