MED fichier: Fichier source de UsesCase_MEDfield_2.f90

MED fichier

UsesCase_MEDfield_2.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2021 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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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:270
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
usescase_medfield_2
program usescase_medfield_2
Definition: UsesCase_MEDfield_2.f90:22
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 étape de calcul,...
Definition: medfield.f:380
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:461