MED fichier
UsesCase_MEDfield_3.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2017 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 fid
29  integer nfield, i, j
30  character(64) :: mname
31  ! field name
32  character(64) :: finame
33  ! nvalues, local mesh, field type
34  integer nstep, nvals, lcmesh, fitype
35  integer ncompo
36  !geotype
37  integer geotp
38  integer, dimension(MED_N_CELL_FIXED_GEO):: geotps
39  character(16) :: dtunit
40  ! component name
41  character(16), dimension(:), allocatable :: cpname
42  ! component unit
43  character(16), dimension(:), allocatable :: cpunit
44  real*8, dimension(:), allocatable :: values
45 
46  geotps = med_get_cell_geometry_type
47 
48  ! open file
49  call mfiope(fid,'UsesCase_MEDfield_1.med',med_acc_rdonly, cret)
50  if (cret .ne. 0 ) then
51  print *,'ERROR : opening file'
52  call efexit(-1)
53  endif
54 
55  ! generic approach : how many fields in the file and identification
56  ! of each field.
57  call mfdnfd(fid,nfield,cret)
58  if (cret .ne. 0 ) then
59  print *,'ERROR : How many fields in the file ...'
60  call efexit(-1)
61  endif
62  print *, 'Number of field(s) in the file :', nfield
63 
64  do i=1,nfield
65  ! field information
66  ! ... we know that the field has no computation step
67  ! and that the field values type is real*8, a real code working would check ...
68  call mfdnfc(fid,i,ncompo,cret)
69  if (cret .ne. 0 ) then
70  print *,'ERROR : number of field components ...'
71  call efexit(-1)
72  endif
73  print *, 'Number of field(s) component(s) in the file :', ncompo
74 
75  allocate(cpname(ncompo),stat=cret )
76  if (cret > 0) then
77  print *,'Memory allocation'
78  call efexit(-1)
79  endif
80 
81  allocate(cpunit(ncompo),stat=cret )
82  if (cret > 0) then
83  print *,'Memory allocation'
84  call efexit(-1)
85  endif
86 
87  call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
88  if (cret .ne. 0 ) then
89  print *,'ERROR : Reading field infos ...'
90  call efexit(-1)
91  endif
92  print *, 'Field name :', finame
93  print *, 'Mesh name :', mname
94  print *, 'Local mesh :', lcmesh
95  print *, 'Field type :', fitype
96  print *, 'Component name :', cpname
97  print *, 'Component unit :', cpunit
98  print *, 'Dtunit :', dtunit
99  print *, 'Nstep :', nstep
100  deallocate(cpname,cpunit)
101 
102  ! read field values for nodes and cells
103 
104  ! MED_NODE
105  call mfdnva(fid,finame,med_no_dt,med_no_it,med_node,med_none,nvals,cret)
106  if (cret .ne. 0 ) then
107  print *,'ERROR : Read number of values ...'
108  call efexit(-1)
109  endif
110  print *, 'Number of values :', nvals
111 
112  if (nvals .gt. 0) then
113 
114  allocate(values(nvals),stat=cret )
115  if (cret > 0) then
116  print *,'Memory allocation'
117  call efexit(-1)
118  endif
119 
120  call mfdrvr(fid,finame,med_no_dt, med_no_it, med_node, med_none,&
121  med_full_interlace, med_all_constituent,values,cret)
122  if (cret .ne. 0 ) then
123  print *,'ERROR : Read fields values defined on vertices ...'
124  call efexit(-1)
125  endif
126  print *, 'Fields values defined on vertices :', values
127 
128  deallocate(values)
129 
130  endif
131 
132  ! MED_CELL
133 
134  do j=1,(med_n_cell_fixed_geo)
135 
136  geotp = geotps(j)
137 
138  call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,geotp,nvals,cret)
139  if (cret .ne. 0 ) then
140  print *,'ERROR : Read number of values ...'
141  call efexit(-1)
142  endif
143  print *, 'Number of values of type :', geotp, ' :', nvals
144 
145  if (nvals .gt. 0) then
146  allocate(values(nvals),stat=cret )
147  if (cret > 0) then
148  print *,'Memory allocation'
149  call efexit(-1)
150  endif
151 
152  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,geotp,&
153  med_full_interlace, med_all_constituent,values,cret)
154  if (cret .ne. 0 ) then
155  print *,'ERROR : Read fields values for cells ...'
156  call efexit(-1)
157  endif
158  print *, 'Fields values for cells :', values
159 
160  deallocate(values)
161 
162  endif
163  enddo
164  enddo
165 
166  ! close file **
167  call mficlo(fid,cret)
168  if (cret .ne. 0 ) then
169  print *,'ERROR : close file'
170  call efexit(-1)
171  endif
172 
173 end program usescase_medfield_3
174 
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
Definition: medfield.f:173
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:442
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
Definition: medfield.f:194
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
Cette fonction permet de lire le nombre de valeurs dans un champ pour une séquence de calcul...
Definition: medfield.f:364
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:238
program usescase_medfield_3
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41