MED fichier: Fichier source de test13.f90

MED fichier

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

test13.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 ! * - Nom du fichier : test13.f90
20 ! *
21 ! * - Description : lecture des equivalences dans un maillage MED.
22 ! *
23 ! ******************************************************************************
24
25 program test13
26
27 implicit none
28 include 'med.hf90'
29 !
30 !
31 integer*8 fid
32 integer ret,cret
33 character*64 maa
34 integer mdim,nequ,ncor,sdim
35 integer, allocatable, dimension(:) :: cor
36 character*64 equ
37 character*200 desc,des
38 integer i,j,k
39 character*255 argc
40 integer,parameter :: MY_NOF_DESCENDING_FACE_TYPE = 5
41 integer,parameter :: MY_NOF_DESCENDING_EDGE_TYPE = 2
42
43
44 integer, parameter :: MED_NBR_MAILLE_EQU = 8
45 integer,parameter :: typmai(med_nbr_maille_equ) = (/ med_point1,med_seg2, &
46 & med_seg3,med_tria3, &
47 & med_tria6,med_quad4, &
48 & med_quad8,med_polygon/)
49
50 integer,parameter :: typfac(my_nof_descending_face_type) = (/med_tria3,med_tria6, &
51 & med_quad4,med_quad8, med_polygon/)
52 integer,parameter ::typare(my_nof_descending_edge_type) = (/med_seg2,med_seg3/)
53 integer type
54 character(16) :: dtunit
55 integer nstep, stype, atype
56 character*16 nomcoo(3)
57 character*16 unicoo(3)
58 integer nctcor,nstepc
59
60
61 ! ** Ouverture du fichier en lecture seule **
62 call mfiope(fid,'test12.med',med_acc_rdonly, cret)
63 print *,cret
64
65
66 ! ** Lecture des infos sur le premier maillage **
67 if (cret.eq.0) then
68 call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
69 print *,"Maillage de nom : ",maa," et de dimension : ", mdim
70 endif
71 print *,cret
72
73
74 ! ** Lecture du nombre d'equivalence **
75 if (cret.eq.0) then
76 call meqneq(fid,maa,nequ,cret)
77 if (cret.eq.0) then
78 print *,"Nombre d'equivalence : ",nequ
79 endif
80 endif
81
82
83 !** Lecture de toutes les equivalences **
84 if (cret.eq.0) then
85 do i=1,nequ
86 print *,"Equivalence numero : ",i
87 !** Lecture des infos sur l'equivalence **
88 if (cret.eq.0) then
89 call meqeqi(fid,maa,i,equ,des,nstepc,nctcor,cret)
90 endif
91 print *,cret
92 if (cret.eq.0) then
93 print *,"Nom de l'equivalence : ",equ
94 print *,"Description de l'equivalence : ",des
95 print *,"Nombre de pas de temps sur l'equivalence : ",nstepc
96 print *,"Nombre de correspondance sur MED_NO_IT, MED_NO_DT : ", nctcor
97 endif
98
99 !** Lecture des correspondances sur les differents types d'entites **
100 if (cret.eq.0) then
101 !** Les noeuds **
102 call meqcsz(fid,maa,equ,med_no_dt,med_no_it,med_node,med_none,ncor,cret)
103 print *,cret
104 print *,"Il y a ",ncor," correspondances sur les noeuds "
105 if (ncor > 0) then
106 allocate(cor(ncor*2),stat=ret)
107 call meqcor(fid,maa,equ,med_no_dt,med_no_it,med_node,med_none,cor,cret)
108 do j=0,(ncor-1)
109 print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
110 end do
111 deallocate(cor)
112 end if
113
114 !!$ !** Les mailles : on ne prend pas en compte les mailles 3D **
115
116 do j=1,med_nbr_maille_equ
117 call meqcsz(fid,maa,equ,med_no_dt,med_no_it,med_cell,typmai(j),ncor,cret)
118 print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
119 if (ncor > 0 ) then
120 allocate(cor(2*ncor),stat=ret)
121 call meqcor(fid,maa,equ,med_no_dt,med_no_it,med_cell,typmai(j),cor,cret)
122 do k=0,(ncor-1)
123 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
124 end do
125 deallocate(cor)
126 endif
127 end do
128
129 !!$ ! ** Les faces **
130 do j=1,my_nof_descending_face_type
131 call meqcsz(fid,maa,equ,med_no_dt,med_no_it,med_descending_face,typmai(j),ncor,cret)
132 print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
133 if (ncor > 0 ) then
134 allocate(cor(2*ncor),stat=ret)
135 call meqcor(fid,maa,equ,med_no_dt,med_no_it,med_descending_face,typfac(j),cor,cret)
136 do k=0,(ncor-1)
137 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
138 end do
139 deallocate(cor)
140 endif
141 end do
142
143 !!$ ! ** Les aretes **
144 do j=1,my_nof_descending_edge_type
145 call meqcsz(fid,maa,equ,med_no_dt,med_no_it,med_descending_edge,typare(j),ncor,cret)
146 print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
147 if (ncor > 0 ) then
148 allocate(cor(2*ncor),stat=ret)
149 call meqcor(fid,maa,equ,med_no_dt,med_no_it,med_descending_edge,typare(j),cor,cret)
150 do k=0,(ncor-1)
151 print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
152 end do
153 deallocate(cor)
154 endif
155 end do
156
157 end if
158 end do
159 end if
160
161 ! ** Fermeture du fichier **
162 call mficlo(fid,cret)
163 print *,cret
164
165 ! ** Code retour
166 call efexit(cret)
167
168 end program test13
169
170
171
172
173
meqcsz
subroutine meqcsz(fid, maa, eq, numdt, numit, typent, typgeo, n, cret)
Definition: medequivalence.f:103
test13
program test13
Definition: test13.f90:25
meqeqi
subroutine meqeqi(fid, maa, ind, eq, des, nstep, nctcor, cret)
Definition: medequivalence.f:83
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
mfiope
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
meqneq
subroutine meqneq(fid, maa, n, cret)
Definition: medequivalence.f:60
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82
meqcor
subroutine meqcor(fid, maa, eq, numdt, mumit, typent, typgeo, corr, cret)
Definition: medequivalence.f:150