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