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