test5.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 : test5.f90
! *
! * - Description : lecture des noeuds d'un maillage MED.
! *
! ******************************************************************************
program test5
!
implicit none
include 'med.hf90'
!
!
integer cret, ret
integer*8 fid
! ** la dimension du maillage et de l'espace de calcul**
integer mdim, sdim
! ** nom du maillage de longueur maxi MED_SIZE_NAME **
character*64 maa
character*200 desc
! ** le nombre de noeuds **
integer nnoe
! ** table des coordonnees **
real*8, allocatable, dimension (:) :: coo,coo1
! ** tables des noms et des unites des coordonnees **
character*16 nomcoo(2)
character*16 unicoo(2)
! ** tables des noms, numeros, numeros de familles des noeuds **
! autant d'elements que de noeuds - les noms ont pout longueur **
! MED_SNAME_SIZE=16
character*16, allocatable, dimension (:) :: nomnoe
integer, allocatable, dimension (:) :: numnoe
integer, allocatable, dimension (:) :: nufano
integer i
logical inonoe,inunoe
integer type,chgt,tsf
integer flta(1)
integer*8 flt(1)
character(16) :: dtunit
integer nstep, stype, atype
integer swm
! Ouverture du fichier en lecture seule **
call mfiope(fid,'test4.med',med_acc_rdonly, cret)
print *,cret
! ** Lecture des infos concernant le premier maillage **
if (cret.eq.0) then
call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
! ** Combien de noeuds a lire **
if (cret.eq.0) then
nnoe = 0
call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
endif
print *,cret,' Nombre de noeuds : ',nnoe
if (cret.ne.0) then
call efexit(-1)
endif
! ** Allocations memoires : **
! ** table des coordonnees **
! profil : (dimension * nombre de noeuds ) **
! ** table des des numeros, des numeros de familles des noeuds
! ** table des noms des noeuds **
allocate( coo(nnoe*sdim),coo1(nnoe*sdim),numnoe(nnoe),nufano(nnoe),nomnoe(nnoe),stat=ret )
print *,ret
coo1(:)=0.0
! ** Lecture des composantes des coordonnees des noeuds avec et sans filtre **
if (cret.eq.0) then
call mmhcor(fid,maa,med_no_dt,med_no_it,med_full_interlace,coo,cret)
endif
print *,'Lecture des toutes les composantes des coordonnees : '
print *,coo
if (cret.ne.0) then
call efexit(-1)
endif
! ** On cree un filtre
if (cret .eq. 0) then
call mfrall(1,flt,cret)
endif
if (cret.ne.0) then
call efexit(-1)
endif
if (cret .eq. 0) then
call mfrcre(fid,nnoe,1,sdim,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 coordonnees des noeuds
if (cret.eq.0) then
call mmhcar(fid,maa,med_no_dt,med_no_it,flt(1),coo1,cret)
endif
print *,'Lecture de la composante numero 2 des coordonnees : '
print *,coo1
! ** 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 des noms des noeuds (optionnel dans un fichier MED) **
if (cret.eq.0) then
call mmhear(fid,maa,med_no_dt,med_no_it,med_node,med_none,nomnoe,cret)
endif
if (ret <0) then
inonoe = .false.
else
inonoe = .true.
endif
! ** Lecture des numeros des noeuds (optionnel dans un fichier MED) **
if (cret.eq.0) then
call mmhenr(fid,maa,med_no_dt,med_no_it,med_node,med_none,numnoe,cret)
endif
if (ret <0) then
inunoe = .false.
else
inunoe = .true.
endif
! ** Lecture des numeros de familles des noeuds **
if (cret.eq.0) then
call mmhfnr(fid,maa,med_no_dt,med_no_it,med_node,med_none,nufano,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 *,"Type de repere : ", atype
print *,"Nom des coordonnees : "
print *, nomcoo
print *,"Unites des coordonnees : "
print *, unicoo
print *,"Coordonnees des noeuds : "
print *, coo
if (inonoe) then
print *,"Noms des noeuds : "
print *,nomnoe
endif
if (inunoe) then
print *,"Numeros des noeuds : "
print *,numnoe
endif
print *,"Numeros des familles des noeuds : "
print *,nufano
endif
! ** Liberation memoire **
deallocate(coo,coo1,nomnoe,numnoe,nufano);
! ** Code retour
call efexit(cret)
end program test5
mmhcar
subroutine mmhcar(fid, name, numdt, numit, flt, coo, cret)
Cette routine permet de lire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:824
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
mmhcor
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Cette routine permet de lire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:320
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
test5
program test5
Definition: test5.f90:24