test13.f90
Aller à la documentation de ce fichier.
!* This file is part of MED.
!*
!* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
!* MED is free software: you can redistribute it and/or modify
!* it under the terms of the GNU Lesser General Public License as published by
!* the Free Software Foundation, either version 3 of the License, or
!* (at your option) any later version.
!*
!* MED is distributed in the hope that it will be useful,
!* but WITHOUT ANY WARRANTY; without even the implied warranty of
!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!* GNU Lesser General Public License for more details.
!*
!* You should have received a copy of the GNU Lesser General Public License
!* along with MED. If not, see <http://www.gnu.org/licenses/>.
!*
! ******************************************************************************
! * - Nom du fichier : test13.f90
! *
! * - Description : lecture des equivalences dans un maillage MED.
! *
! ******************************************************************************
program test13
implicit none
include 'med.hf90'
!
!
integer*8 fid
integer ret,cret
character*64 maa
integer mdim,nequ,ncor,sdim
integer, allocatable, dimension(:) :: cor
character*64 equ
character*200 desc,des
integer i,j,k
character*255 argc
integer,parameter :: my_nof_descending_face_type = 5
integer,parameter :: my_nof_descending_edge_type = 2
integer, parameter :: med_nbr_maille_equ = 8
integer,parameter :: typmai(med_nbr_maille_equ) = (/ med_point1,med_seg2, &
& med_seg3,med_tria3, &
& med_tria6,med_quad4, &
& med_quad8,med_polygon/)
integer,parameter :: typfac(my_nof_descending_face_type) = (/med_tria3,med_tria6, &
& med_quad4,med_quad8, med_polygon/)
integer,parameter ::typare(my_nof_descending_edge_type) = (/med_seg2,med_seg3/)
integer type
character(16) :: dtunit
integer nstep, stype, atype
character*16 nomcoo(3)
character*16 unicoo(3)
integer nctcor,nstepc
! ** Ouverture du fichier en lecture seule **
call mfiope(fid,'test12.med',med_acc_rdonly, cret)
print *,cret
! ** Lecture des infos sur le premier maillage **
if (cret.eq.0) then
call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
print *,"Maillage de nom : ",maa," et de dimension : ", mdim
endif
print *,cret
! ** Lecture du nombre d'equivalence **
if (cret.eq.0) then
call meqneq(fid,maa,nequ,cret)
if (cret.eq.0) then
print *,"Nombre d'equivalence : ",nequ
endif
endif
!** Lecture de toutes les equivalences **
if (cret.eq.0) then
do i=1,nequ
print *,"Equivalence numero : ",i
!** Lecture des infos sur l'equivalence **
if (cret.eq.0) then
call meqeqi(fid,maa,i,equ,des,nstepc,nctcor,cret)
endif
print *,cret
if (cret.eq.0) then
print *,"Nom de l'equivalence : ",equ
print *,"Description de l'equivalence : ",des
print *,"Nombre de pas de temps sur l'equivalence : ",nstepc
print *,"Nombre de correspondance sur MED_NO_IT, MED_NO_DT : ", nctcor
endif
!** Lecture des correspondances sur les differents types d'entites **
if (cret.eq.0) then
!** Les noeuds **
call meqcsz(fid,maa,equ,med_no_dt,med_no_it,med_node,med_none,ncor,cret)
print *,cret
print *,"Il y a ",ncor," correspondances sur les noeuds "
if (ncor > 0) then
allocate(cor(ncor*2),stat=ret)
call meqcor(fid,maa,equ,med_no_dt,med_no_it,med_node,med_none,cor,cret)
do j=0,(ncor-1)
print *,"Correspondance ",j+1," : ",cor(2*j+1)," et ",cor(2*j+2)
end do
deallocate(cor)
end if
!!$ !** Les mailles : on ne prend pas en compte les mailles 3D **
do j=1,med_nbr_maille_equ
call meqcsz(fid,maa,equ,med_no_dt,med_no_it,med_cell,typmai(j),ncor,cret)
print *,"Il y a ",ncor," correspondances sur les mailles ",typmai(j)
if (ncor > 0 ) then
allocate(cor(2*ncor),stat=ret)
call meqcor(fid,maa,equ,med_no_dt,med_no_it,med_cell,typmai(j),cor,cret)
do k=0,(ncor-1)
print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
end do
deallocate(cor)
endif
end do
!!$ ! ** Les faces **
do j=1,my_nof_descending_face_type
call meqcsz(fid,maa,equ,med_no_dt,med_no_it,med_descending_face,typmai(j),ncor,cret)
print *,"Il y a ",ncor," correspondances sur les faces ",typfac(j)
if (ncor > 0 ) then
allocate(cor(2*ncor),stat=ret)
call meqcor(fid,maa,equ,med_no_dt,med_no_it,med_descending_face,typfac(j),cor,cret)
do k=0,(ncor-1)
print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
end do
deallocate(cor)
endif
end do
!!$ ! ** Les aretes **
do j=1,my_nof_descending_edge_type
call meqcsz(fid,maa,equ,med_no_dt,med_no_it,med_descending_edge,typare(j),ncor,cret)
print *,"Il y a ",ncor," correspondances sur les aretes ",typare(j)
if (ncor > 0 ) then
allocate(cor(2*ncor),stat=ret)
call meqcor(fid,maa,equ,med_no_dt,med_no_it,med_descending_edge,typare(j),cor,cret)
do k=0,(ncor-1)
print *,"Correspondance ",k+1," : ",cor(2*k+1)," et ",cor(2*k+2)
end do
deallocate(cor)
endif
end do
end if
end do
end if
! ** Fermeture du fichier **
call mficlo(fid,cret)
print *,cret
! ** Code retour
call efexit(cret)
end program test13
meqneq
subroutine meqneq(fid, maa, n, cret)
Definition medequivalence.f:60
meqcor
subroutine meqcor(fid, maa, eq, numdt, mumit, typent, typgeo, corr, cret)
Definition medequivalence.f:150
meqeqi
subroutine meqeqi(fid, maa, ind, eq, des, nstep, nctcor, cret)
Definition medequivalence.f:83
meqcsz
subroutine meqcsz(fid, maa, eq, numdt, numit, typent, typgeo, n, cret)
Definition medequivalence.f:103
mfiope
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Definition medfile.f:82
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition medmesh.f:110
test13
program test13
Definition test13.f90:25