test15.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 : test15.f90
! *
! * - Description : lecture des noeuds d'un maillage MED.
! * a l'aide des routines de niveau 2
! * - equivalent a test5.f90
! *
! ******************************************************************************
program test15
implicit none
include 'med.hf90'
!
!
integer*8 fid
integer ret,cret
! ** la dimension du maillage **
integer mdim,sdim
! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
character*64 maa
character*200 desc
! ** le nombre de noeuds **
integer :: nnoe = 0
! ** table des coordonnees **
real*8, allocatable, dimension(:) :: coo
! ** tables des noms et des unites des coordonnees
! profil : (dimension) **
character*16 nomcoo(2)
character*16 unicoo(2)
character*16 dtunit
! ** tables des noms, numeros, numeros de familles des noeuds
! autant d'elements que de noeuds - les noms ont pout longueur
! MED_SNAME_SIZE **
character*16, allocatable, dimension(:) :: nomnoe
integer, allocatable, dimension(:) :: numnoe,nufano
integer rep
integer inonoe,inunoe,inufa
character*16 str
integer i
character*255 argc
integer type,nstep,stype
integer chgt,tsf
! ** Ouverture du fichier **
call mfiope(fid,"test14.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,rep,nomcoo,unicoo,cret)
print *,"Maillage de nom : ",maa," et de dimension : ",mdim
endif
print *,cret
! ** Lecture du nombre de noeud **
if (cret.eq.0) then
call mmhnme(fid,maa,med_no_dt,med_no_it,med_node,med_none,med_coordinate,med_no_cmode,chgt,tsf,nnoe,cret)
print *,"Nombre de noeuds : ",nnoe
endif
print *,cret
! ** Allocations memoires **
! ** table des coordonnees
! ** profil : (dimension * nombre de noeuds ) **
allocate (coo(nnoe*sdim),stat=ret)
! ** table des des numeros, des numeros de familles des noeuds
! profil : (nombre de noeuds) **
allocate (numnoe(nnoe),nufano(nnoe),stat=ret)
! ** table des noms des noeuds
! profil : (nnoe*MED_TAILLE_PNOM+1) **
allocate (nomnoe(nnoe),stat=ret)
! ** Lecture des noeuds :
! - Coordonnees
! - Noms (optionnel dans un fichier MED)
! - Numeros (optionnel dans un fichier MED)
! - Numeros de familles **
if (cret.eq.0) then
call mmhnor(fid,maa,med_no_dt,med_no_it,med_full_interlace,coo,inonoe,nomnoe,inunoe,numnoe,inufa,nufano,cret)
endif
! ** Affichage des resulats **
if (cret.eq.0) then
print *,"Type de repere : ",rep
print *,"Nom des coordonnees : ",nomcoo
print *,"Unites des coordonnees : ",unicoo
print *,"Coordonnees des noeuds : ",coo
if (inonoe .eq. med_true) then
print *,"Noms des noeuds : |",nomnoe,"|"
endif
if (inunoe .eq. med_true) then
print *,"Numeros des noeuds : ",numnoe
endif
if (inufa .eq. med_true) then
print *,"Numeros des familles des noeuds : ",nufano
else
print *,"Numeros des familles des noeuds : 0"
endif
endif
! ** Liberation memoire **
deallocate(coo,nomnoe,numnoe,nufano)
! ** Fermeture du fichier **
call mficlo(fid,cret)
print *,cret
! **Code retour
call efexit(cret)
end program test15
str
#define str(s)
Definition mdump2.c:127
mfiope
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Definition medfile.f:82
mmhnor
subroutine mmhnor(fid, name, numdt, numit, swm, coo, iname, nname, inum, num, ifam, fam, cret)
Definition medmesh.f:701
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition medmesh.f:551
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition medmesh.f:110
test15
program test15
Definition test15.f90:27