MED fichier
test13.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2016 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 
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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 é...
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...
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
subroutine meqneq(fid, maa, n, cret)
Cette routine permet de lire le nombre d'équivalence dans un fichier.
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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...
program test13
Definition: test13.f90:25