test7.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 : test7.f90
! *
! * - Description : lecture des elements du maillage MED ecrits par test6
! *
! ******************************************************************************
program test7
implicit none
include 'med.hf90'
!
!
integer*8 fid
integer cret, ret
integer nse2
integer, allocatable, dimension (:) :: se2,se21
character*16, allocatable, dimension (:) :: nomse2
integer, allocatable, dimension (:) :: numse2,nufase2
integer ntr3
integer, allocatable, dimension (:) :: tr3
character*16, allocatable, dimension (:) :: nomtr3
integer, allocatable, dimension (:) :: numtr3,nufatr3
! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
character*64 :: maa
character*200 :: desc
integer :: mdim,edim,nstep,stype,atype
logical inoele,inuele
integer, parameter :: profil (2) = (/ 2,3 /)
integer type
integer tse2,ttr3, i
character*16 nomcoo(2)
character*16 unicoo(2)
character*16 dtunit
integer :: chgt,tsf
integer flta(1)
integer*8 flt(1)
! ** Ouverture du fichier test6.med en lecture seule **
call mfiope(fid,'test6.med',med_acc_rdonly, cret)
print *,cret
! ** Lecture des infos concernant 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 *,"Maillage de nom : ",maa," et de dimension :", mdim
endif
if (cret.ne.0) then
call efexit(-1)
endif
! ** Combien de segments et de triangles **
if (cret.eq.0) then
nse2 = 0
call mmhnme(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_connectivity,med_descending,chgt,tsf,nse2,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
if (cret.eq.0) then
ntr3 = 0
call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_descending,chgt,tsf,ntr3,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
if (cret.eq.0) then
print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
endif
! ** Allocations memoire **
tse2 = 2
allocate (se2(tse2*nse2),se21(tse2*nse2),nomse2(nse2),numse2(nse2), nufase2(nse2),stat=ret )
se2(:)=0; se21(:)=0
! print *,ret
ttr3 = 3
allocate (tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),stat=ret )
tr3(:)=0
! print *,ret
! ** Lecture de la connectivite des segments **
if (cret.eq.0) then
call mmhcyr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending,med_full_interlace,se2,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
print *,se2
! ** Lecture de de la composante 2 de la connectivite des segments **
! ** On cree un filtre associe
if (cret .eq. 0) then
call mfrall(1,flt,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
! ** on initialise le filtre pour lire uniquement la deuxième composante.
if (cret .eq. 0) then
call mfrcre(fid,nse2,1,edim,2,med_full_interlace,med_global_stmode, &
med_no_profile,med_undef_size,flta,flt(1),cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
! ** Lecture des composantes n°2 des segments
if (cret.eq.0) then
call mmhyar(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending, &
flt(1),se21,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
print *,se21
! ** On desalloue le filtre
if (cret .eq. 0) then
call mfrdea(1,flt,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
! ** Lecture (optionnelle) des noms des segments **
if (cret.eq.0) then
call mmhear(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,nomse2,cret)
endif
if (ret <0) then
inoele = .false.
else
inoele = .true.
endif
! ** Lecture (optionnelle) des numeros des segments **
if (cret.eq.0) then
call mmhenr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,numse2,cret)
endif
if (ret <0) then
inuele = .false.
else
inuele = .true.
endif
! ** Lecture des numeros des familles des segments **
if (cret.eq.0) then
call mmhfnr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,nufase2,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
! ** Lecture de la connectivite des triangles sans profil **
if (cret.eq.0) then
call mmhcyr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_descending,med_no_interlace,tr3,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
! ** Lecture (optionnelle) des noms des triangles **
if (cret.eq.0) then
call mmhear(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,nomtr3,cret)
endif
if (ret <0) then
inoele = .false.
else
inoele = .true.
endif
print *,cret
! ** Lecture (optionnelle) des numeros des segments **
if (cret.eq.0) then
call mmhenr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,numtr3,cret)
endif
if (ret <0) then
inuele = .false.
else
inuele = .true.
endif
print *,cret
! ** Lecture des numeros des familles des segments **
if (cret.eq.0) then
call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,nufatr3,cret)
endif
print *,cret
! ** Fermeture du fichier **
call mficlo(fid,cret)
if (cret.ne.0) then
call efexit(-1)
endif
! ** Affichage des resulats **
if (cret.eq.0) then
print *,"Connectivite des segments : "
print *, se2
if (inoele) then
print *,"Noms des segments :"
print *,nomse2
endif
if (inuele) then
print *,"Numeros des segments :"
print *,numse2
endif
print *,"Numeros des familles des segments :"
print *,nufase2
print *,"Connectivite des triangles :"
print *,tr3
if (inoele) then
print *,"Noms des triangles :"
print *,nomtr3
endif
if (inuele) then
print *,"Numeros des triangles :"
print *,numtr3
endif
print *,"Numeros des familles des triangles :"
print *,nufatr3
endif
! ** Nettoyage memoire **
deallocate (se2,se21,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
! ** Code retour
call efexit(cret)
end program test7
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
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une étape de calcul donnée.
Definition medmesh.f:551
mmhear
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Cette routine permet de lire les noms d'un type d'entité d'un maillage.
Definition medmesh.f:529
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
true
#define true
Definition libmedimport.c:37
false
#define false
Definition libmedimport.c:36
mfrcre
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Definition medfilter.f:22
mfrall
subroutine mfrall(nflt, flt, cret)
Definition medfilter.f:44
mfrdea
subroutine mfrdea(nflt, flt, cret)
Definition medfilter.f:60
mmhfnr
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition medmesh.f:487
mmhenr
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition medmesh.f:445
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition medmesh.f:600
mmhyar
subroutine mmhyar(fid, name, numdt, numit, entype, geotype, cmode, flt, con, cret)
Definition medmesh.f:868