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