test5.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 : 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
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
mmhcor
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition medmesh.f:320
mmhfnr
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition medmesh.f:487
mmhcar
subroutine mmhcar(fid, name, numdt, numit, flt, coo, cret)
Definition medmesh.f:824
mmhenr
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition medmesh.f:445
test5
program test5
Definition test5.f90:24