MED fichier
UsesCase_MEDfield_6.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2016 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 fid
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  ! mesh num dt, mesh num it
41  integer mnumdt, mnumit
42  integer csit, numit, numdt, it
43  real*8 dt
44  character(16) :: dtunit
45  ! component name
46  character(16), dimension(:), allocatable :: cpname
47  ! component unit
48  character(16), dimension(:), allocatable :: cpunit
49  real*8, dimension(:), allocatable :: values
50 
51  geotps = med_get_cell_geometry_type
52 
53  ! open MED file
54  call mfiope(fid,'UsesCase_MEDfield_4.med',med_acc_rdonly, cret)
55  if (cret .ne. 0 ) then
56  print *,'ERROR : open file'
57  call efexit(-1)
58  endif
59 
60  ! generic approach : how many fields in the file and identification
61  ! of each field.
62  call mfdnfd(fid,nfield,cret)
63  if (cret .ne. 0 ) then
64  print *,'ERROR : How many fields in the file ...'
65  call efexit(-1)
66  endif
67  print *, 'Number of field(s) in the file :', nfield
68 
69  ! read values for each field
70  do i=1,nfield
71  call mfdnfc(fid,i,ncompo,cret)
72  if (cret .ne. 0 ) then
73  print *,'ERROR : number of field components ...'
74  call efexit(-1)
75  endif
76  print *, 'Field number :', nfield
77  print *, 'Number of field(s) component(s) in the file :', ncompo
78 
79  allocate(cpname(ncompo),stat=cret )
80  if (cret > 0) then
81  print *,'Memory allocation'
82  call efexit(-1)
83  endif
84 
85  allocate(cpunit(ncompo),stat=cret )
86  if (cret > 0) then
87  print *,'Memory allocation'
88  call efexit(-1)
89  endif
90 
91  call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
92  if (cret .ne. 0 ) then
93  print *,'ERROR : Reading field infos ...'
94  call efexit(-1)
95  endif
96  print *, 'Field name :', finame
97  print *, 'Mesh name :', mname
98  print *, 'Local mesh :', lcmesh
99  print *, 'Field type :', fitype
100  print *, 'Component name :', cpname
101  print *, 'Component unit :', cpunit
102  print *, 'Dtunit :', dtunit
103  print *, 'Nstep :', nstep
104  deallocate(cpname,cpunit)
105 
106  ! Read field values for each computing step
107  do csit=1, nstep
108  call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
109  if (cret .ne. 0 ) then
110  print *,'ERROR : Computing step info ...'
111  call efexit(-1)
112  endif
113  print *, 'Computing step :',csit
114  print *, 'Numdt :', numdt
115  print *, 'Numit :', numit
116  print *, 'Dt :', dt
117  print *, 'mnumdt :', mnumdt
118  print *, 'mnumit :', mnumit
119 
120  ! ... In our case, we suppose that the field values are only defined on cells ...
121  do it=1,(med_n_cell_fixed_geo)
122 
123  geotp = geotps(it)
124 
125  call mfdnva(fid,finame,numdt,numit,med_cell,geotp,nvals,cret)
126  if (cret .ne. 0 ) then
127  print *,'ERROR : Read number of values ...'
128  call efexit(-1)
129  endif
130  print *, 'Number of values of type :', geotp, ' :', nvals
131 
132  if (nvals .gt. 0) then
133  allocate(values(nvals),stat=cret )
134  if (cret > 0) then
135  print *,'Memory allocation'
136  call efexit(-1)
137  endif
138 
139  call mfdrvr(fid,finame,numdt,numit,med_cell,geotp,&
140  med_full_interlace, med_all_constituent,values,cret)
141  if (cret .ne. 0 ) then
142  print *,'ERROR : Read fields values for cells ...'
143  call efexit(-1)
144  endif
145  print *, 'Fields values for cells :', values
146 
147  deallocate(values)
148  endif
149  enddo
150  enddo
151  enddo
152 
153  ! close file
154  call mficlo(fid,cret)
155  if (cret .ne. 0 ) then
156  print *,'ERROR : close file'
157  call efexit(-1)
158  endif
159 
160 end program usescase_medfield_6
161 
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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 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 mfdcmi(fid, fname, it, numdt, numit, dt, mnumdt, mnumit, cret)
Cette fonction permet de lire les informations caractérisant une séquence de calcul : numéro de pas d...
Definition: medfield.f:298
subroutine mfdnfc(fid, ind, n, cret)
Cette fonction lit le nombre de composantes d'un champ.
Definition: medfield.f:194
subroutine mfdnfd(fid, n, cret)
Cette fonction permet de lire le nombre de champs dans un fichier.
Definition: medfield.f:173
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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_6