test13.f90
Aller à la documentation de ce fichier.
!* This file is part of MED.
!*
!* COPYRIGHT (C) 1999 - 2021 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
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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
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
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
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