MED fichier
UsesCase_MEDfield_2.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 !* Field use case 2 : read the field of use case 1
20 !*
21 
23 
24  implicit none
25  include 'med.hf90'
26 
27  integer cret
28  integer fid
29  character(64) :: mname
30  ! field name
31  character(64) :: finame = 'TEMPERATURE_FIELD'
32  ! nvalues, local mesh, field type
33  integer nstep, nvals, lcmesh, fitype
34  ! component name
35  character(16) :: cpname
36  ! component unit
37  character(16) :: cpunit
38  character(16) :: dtunit
39 
40  ! vertices values
41  real*8, dimension(:), allocatable :: verval
42  real*8, dimension(:), allocatable :: tria3v
43  real*8, dimension(:), allocatable :: quad4v
44 
45  ! open MED file with READ ONLY access mode **
46  call mfiope(fid,'UsesCase_MEDfield_1.med',med_acc_rdonly,cret)
47  if (cret .ne. 0 ) then
48  print *,'ERROR : opening file'
49  call efexit(-1)
50  endif
51 
52  ! ... we know that the MED file has only one field with one component ,
53  ! a real code working would check ...
54 
55  ! if you know the field name, direct access to field informations
56  call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
57  print *,cret
58  if (cret .ne. 0 ) then
59  print *,'ERROR : field info by name'
60  call efexit(-1)
61  endif
62  print *, 'Mesh name :', mname
63  print *, 'Local mesh :', lcmesh
64  print *, 'Field type :', fitype
65  print *, 'Component name :', cpname
66  print *, 'Component unit :', cpunit
67  print *, 'dtunit :', dtunit
68  print *, 'nstep :', nstep
69 
70  ! ... we know that the field values are defined on vertices and MED_TRIA3
71  ! and MED_QUAD4 cells, a real code working would check ...
72 
73  ! MED_NODE
74  call mfdnva(fid,finame,med_no_dt,med_no_it,med_node,med_none,nvals,cret)
75  if (cret .ne. 0 ) then
76  print *,'ERROR : read number of values ...'
77  call efexit(-1)
78  endif
79 
80  print *, 'Node number :', nvals
81 
82  allocate ( verval(nvals),stat=cret )
83  if (cret > 0) then
84  print *,'Memory allocation'
85  call efexit(-1)
86  endif
87 
88  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_node,med_none,med_full_interlace,med_all_constituent,verval,cret)
89  if (cret .ne. 0 ) then
90  print *,'ERROR : read fields values on vertices ...'
91  call efexit(-1)
92  endif
93 
94  print *, 'Fields values on vertices :', verval
95 
96  deallocate(verval)
97 
98  ! MED_TRIA3
99  call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,nvals,cret)
100  if (cret .ne. 0 ) then
101  print *,'ERROR : read number of values ...'
102  call efexit(-1)
103  endif
104 
105  print *, 'Triangulars cells number :', nvals
106 
107  allocate ( tria3v(nvals),stat=cret )
108  if (cret > 0) then
109  print *,'Memory allocation'
110  call efexit(-1)
111  endif
112 
113  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,med_full_interlace,med_all_constituent,tria3v,cret)
114  if (cret .ne. 0 ) then
115  print *,'ERROR : read fields values for MED_TRIA3 cells ...'
116  call efexit(-1)
117  endif
118 
119  print *, 'Fiels values for MED_TRIA3 cells :', tria3v
120 
121  deallocate(tria3v)
122 
123  ! MED_QUAD4
124  call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,nvals,cret)
125  if (cret .ne. 0 ) then
126  print *,'ERROR : read number of values ...'
127  call efexit(-1)
128  endif
129 
130  print *, 'Quadrangulars cells number :', nvals
131 
132  allocate ( quad4v(nvals),stat=cret )
133  if (cret > 0) then
134  print *,'Memory allocation'
135  call efexit(-1)
136  endif
137 
138  call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,med_full_interlace,med_all_constituent,quad4v,cret)
139  if (cret .ne. 0 ) then
140  print *,'ERROR : read fields values for MED_QUAD4 cells ...'
141  call efexit(-1)
142  endif
143 
144  print *, 'Fiels values for MED_QUAD4 cells :', quad4v
145 
146  deallocate(quad4v)
147 
148  ! close file **
149  call mficlo(fid,cret)
150  if (cret .ne. 0 ) then
151  print *,'ERROR : close file'
152  call efexit(-1)
153  endif
154 
155 end program usescase_medfield_2
156 
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 mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
Cette fonction permet de lire les informations concernant le champ de nom fieldname.
Definition: medfield.f:259
program usescase_medfield_2
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41