MED fichier: Fichier source de test13.f90

MED fichier

test13.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2023 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
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
Definition: medmesh.f:110
meqeqi
subroutine meqeqi(fid, maa, ind, eq, des, nstep, nctcor, cret)
Cette routine permet lire les informations d'une équivalence portant sur les entités d'un maillage.
Definition: medequivalence.f:83
meqcsz
subroutine meqcsz(fid, maa, eq, numdt, numit, typent, typgeo, n, cret)
Cette routine permet de lire le nombre de correspondances dans une équivalence pour une étape de calc...
Definition: medequivalence.f:103
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
meqcor
subroutine meqcor(fid, maa, eq, numdt, mumit, typent, typgeo, corr, cret)
Cette routine permet de lire un tableau de correspondances entre les entités d'un maillage dans une é...
Definition: medequivalence.f:150
meqneq
subroutine meqneq(fid, maa, n, cret)
Cette routine permet de lire le nombre d'équivalence dans un fichier.
Definition: medequivalence.f:60
test13
program test13
Definition: test13.f90:25
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42