test30.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 : test30.f90
! *
! * - Description : lecture des joints dans un maillage MED.
! *
! ******************************************************************************
program test30
implicit none
include 'med.hf90'
!
!
integer*8 fid
integer ret,cret,edim
character*64 maa,maadst,corr,jnt
integer mdim,njnt,ncor,domdst,nc,nent
character*64 equ,ent, nodenn, nodent
character*200 des, dcornn, dcornt
integer i,j,k
character*255 argc
character*200 desc
integer type
integer nstep,stype,atype
character*16 nomcoo(2)
character*16 unicoo(2)
character*16 dtunit
integer entlcl,geolcl, entdst, geodst
data nodent /"CorresTria3"/
data nodenn /"CorresNodes"/
argc = "test29.med"
! ** Ouverture du fichier en lecture seule **
call mfiope(fid,argc,med_acc_rdonly, cret)
print '(I1)',cret
! ** Lecture des infos sur le premier maillage **
if (cret.eq.0) then
call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
print '(A,A,A,I3)',"Maillage de nom : ",maa
endif
print '(I1)',cret
! ** Lecture du nombre de joints **
if (cret.eq.0) then
call msdnjn(fid,maa,njnt,cret)
if (cret.eq.0) then
print '(A,I3)',"Nombre de joints : ",njnt
endif
endif
!** Lecture de tous les joints **
if (cret.eq.0) then
do i=1,njnt
print '(A,I3)',"Joint numero : ",i
!** Lecture des infos sur le joint **
if (cret.eq.0) then
call msdjni(fid,maa,i,jnt,des,domdst,maadst,nstep,ncor,cret)
endif
print '(I1)',cret
if (cret.eq.0) then
print '(A,A)',"Nom du joint : ",jnt
print '(A,A)' ,"Description du joint : ",des
print '(A,I3)',"Domaine en regard : ",domdst
print '(A,A)' ,"Maillage en regard : ",maadst
print '(A,I3)',"Nombre de sequence : ",nstep
print '(A,I3)',"Nombre de correspondance (NO_DT,NO_IT) : ",ncor
endif
do nc=1,ncor
call msdszi(fid,maa,jnt,med_no_dt,med_no_it,nc,entlcl,geolcl,entdst,geodst,ncor,cret)
print '(I3)',cret
if (cret>=0) then
call affcorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
endif
enddo
end do
end if
! ** Fermeture du fichier **
call mficlo (fid,cret)
print '(I2)',cret
! call flush(6)
! ** Code retour
call efexit(cret)
end program test30
subroutine affcorr(fid,maa,jnt,entlcl,geolcl,entdst,geodst)
implicit none
include 'med.hf90'
character*(*) maa,jnt
character*200 des;
integer*8 fid
integer ret,cret,ncor,ntypnent,i,j,nent,ntypent
integer entlcl,geolcl, entdst, geodst
integer, allocatable, dimension(:) :: cortab
call msdcsz(fid,maa,jnt,med_no_dt,med_no_it,entlcl,geolcl,entdst,geodst,ncor,cret)
print '(I3,i5)',cret,ncor
!** Lecture des correspondances sur les differents types d'entites connus a priori **
if (cret.eq.0) then
print '(A,I4,A,I4,A,I4,A,I4,A)','correspondance entre les types : (',entlcl,'/',geolcl,') et (',entdst,'/',geodst,')'
print '(A,I4)','nombre de type de couples d''entite en regard ',ncor
! call flush(6)
allocate(cortab(ncor*2),stat=ret)
call msdcrr(fid,maa,jnt,med_no_dt,med_no_it,entlcl,geolcl,entdst,geodst,cortab,cret)
do j=0,(ncor-1)
print '(A,I3,A,I4,A,I4)',"Correspondance ",j+1," : ",cortab(2*j+1)," et ",cortab(2*j+2)
end do
deallocate(cortab)
end if
return
end subroutine affcorr
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition medfile.f:82
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
msdjni
subroutine msdjni(fid, lmname, ind, jname, des, dom, rmname, nstep, ncor, cret)
Cette routine permet de lire les informations sur un joint dans un maillage.
Definition medjoint.f:97
msdcsz
subroutine msdcsz(fid, mname, jname, numdt, numit, letype, lgtype, retype, rgtype, ncor, cret)
Cette routine permet la lecture du nombre d'entités en correspondance dans un joint pour un couple d'...
Definition medjoint.f:147
msdnjn
subroutine msdnjn(fid, maa, n, cret)
Cette routine permet la lecture du nombre de joint dans un maillage.
Definition medjoint.f:72
msdszi
subroutine msdszi(fid, mname, jname, numdt, numit, it, letype, lgtype, retype, rgtype, ncor, cret)
Cette routine permet de lire les informations sur les couples d'entités en correspondance dans un joi...
Definition medjoint.f:120
msdcrr
subroutine msdcrr(fid, lmname, jname, numdt, numit, entlcl, geolcl, entdst, geodst, corrtab, cret)
Definition medjoint.f:173
affcorr
subroutine affcorr(fid, maa, jnt, entlcl, geolcl, entdst, geodst)
Definition test30.f90:117
test30
program test30
Definition test30.f90:25