test7.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 : 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
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
mfrall
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:44
mmhfnr
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet la lecture des numéros de famille d'un type d'entité d'un maillage.
Definition: medmesh.f:487
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mmhenr
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet de lire les numéros d'un type d'entité d'un maillage.
Definition: medmesh.f:445
false
#define false
Definition: libmedimport.c:36
true
#define true
Definition: libmedimport.c:37
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
mfrdea
subroutine mfrdea(nflt, flt, cret)
Desalloue un tableau de filtre de taille nfilter.
Definition: medfilter.f:60
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
mfrcre
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Crée une selection d'entités grâce a un tableau d'index filterarray de taille filterarraysize....
Definition: medfilter.f:22
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
mmhyar
subroutine mmhyar(fid, name, numdt, numit, entype, geotype, cmode, flt, con, cret)
Cette routine permet de lire dans un maillage le tableau des connectivités pour un type géométrique d...
Definition: medmesh.f:868
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Cette routine permet de lire dans un maillage le tableau des connectivités pour un type géométrique d...
Definition: medmesh.f:600