MED fichier: Fichier source de UsesCase_MEDfield_2.f90

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

UsesCase_MEDfield_2.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 2 : read the field of use case 1
20 !*
21
22 program usescase_medfield_2
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
usescase_medfield_2
program usescase_medfield_2
Definition: UsesCase_MEDfield_2.f90:22
mfdrvr
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
mfdfin
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
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 séquence de calcul...
Definition: medfield.f:364
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41