UsesCase_MEDmesh_12.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/>.
!*
!*
!*
!* Use case 12 : read a 2D unstructured mesh with moving grid (generic approach)
!*
!*
program usescase_medmesh_12
implicit none
include 'med.hf90'
integer cret
integer*8 fid
! mesh number
integer nmesh
! mesh name
character(MED_NAME_SIZE) :: mname = ""
! mesh description
character(MED_COMMENT_SIZE) :: mdesc = ""
! mesh dimension, space dimension
integer mdim, sdim
! mesh sorting type
integer stype
integer nstep
! mesh type, axis type
integer mtype, atype
! axis name, axis unit
character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
character(MED_SNAME_SIZE) :: dtunit = ""
! coordinates
real*8, dimension(:), allocatable :: coords
integer ngeo
integer nnodes
! connectivity
integer , dimension(:), allocatable :: conity
! coordinate changement, geometry transformation, matrix transformation
integer coocha, geotra, matran
! matrix size
integer matsiz
real*8 :: matrix(7) = 0.0
integer i, it, j
! profil size
integer profsz
! profil name
character(MED_NAME_SIZE) :: profna = ""
integer numdt, numit
real*8 dt
! geometry type
integer geotyp
integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
geotps = med_get_cell_geometry_type
! open MED file with READ ONLY access mode
call mfiope(fid, "UsesCase_MEDmesh_9.med", med_acc_rdonly, cret)
if (cret .ne. 0 ) then
print *, "ERROR : open file"
call efexit(-1)
endif
! read how many mesh in the file
call mmhnmh(fid, nmesh, cret)
if (cret .ne. 0 ) then
print *, "ERROR : read how many mesh"
call efexit(-1)
endif
print *, "nmesh :", nmesh
do i=1, nmesh
! read computation space dimension
call mmhnax(fid, i, sdim, cret)
if (cret .ne. 0 ) then
print *, "ERROR : read computation space dimension"
call efexit(-1)
endif
! memory allocation
allocate ( aname(sdim), aunit(sdim) ,stat=cret )
if (cret > 0) then
print *, "ERROR : memory allocation"
call efexit(-1)
endif
! read mesh informations
call mmhmii(fid, i, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, &
atype, aname, aunit, cret)
if (cret .ne. 0 ) then
print *, "ERROR : read mesh informations"
call efexit(-1)
endif
print *,"mesh name =", mname
print *,"space dim =", sdim
print *,"mesh dim =", mdim
print *,"mesh type =", mtype
print *,"mesh description =", mdesc
print *,"dt unit = ", dtunit
print *,"sorting type =", stype
print *,"number of computing step =", nstep
print *,"coordinates axis type =", atype
print *,"coordinates axis name =", aname
print *,"coordinates axis units =", aunit
deallocate(aname, aunit)
! read how many nodes in the mesh **
call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
if (cret .ne. 0 ) then
print *, "ERROR : read how many nodes in the mesh"
call efexit(-1)
endif
print *, "number of nodes in the mesh =", nnodes
! read mesh nodes coordinates
allocate (coords(nnodes*sdim),stat=cret)
if (cret > 0) then
print *,"ERROR : memory allocation"
call efexit(-1)
endif
call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
if (cret .ne. 0 ) then
print *,"ERROR : nodes coordinates"
call efexit(-1)
endif
print *,"Nodes coordinates =", coords
deallocate(coords)
! read all MED geometry cell types
do it=1, med_n_cell_fixed_geo
geotyp = geotps(it)
print *, "geotps(it) :", geotps(it)
call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, geotyp, &
med_connectivity, med_nodal, coocha, &
geotra, ngeo, cret)
if (cret .ne. 0 ) then
print *,"ERROR : number of cells"
call efexit(-1)
endif
print *,"Number of cells =", ngeo
! print *, "mod(ngeo, 100) : ", mod(geotyp,100)
if (ngeo .ne. 0) then
allocate (conity(ngeo*mod(geotyp,100)), stat=cret)
if (cret > 0) then
print *,"ERROR : memory allocation"
call efexit(-1)
endif
call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, &
geotyp, med_nodal, med_full_interlace, &
conity, cret)
if (cret > 0) then
print *,"ERROR : cellconnectivity", conity
call efexit(-1)
endif
deallocate(conity)
endif !ngeo .ne. 0
end do ! read all MED geometry cell types
! read nodes coordinates changements step by step
do it=1, nstep-1
call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
if (cret .ne. 0 ) then
print *,"ERROR : computing step info"
call efexit(-1)
endif
print *,"numdt =", numdt
print *,"numit =", numit
print *,"dt =", dt
! test for nodes coordinates change
call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
med_coordinate, med_no_cmode, med_global_stmode, &
profna, profsz, coocha, geotra, nnodes, cret)
if (cret .ne. 0 ) then
print *,"ERROR : nodes coordinates"
call efexit(-1)
endif
print *, "profna =", profna
print *, "coocha =", coocha
print *, "geotra =", geotra
! if only coordinates have changed, then read the new coordinates
! to verify if there is a matrix transformation => UsesCase_MEDmesh12
if (coocha == 1 .and. geotra == 1) then
allocate (coords(nnodes*2),stat=cret)
if (cret > 0) then
print *,"ERROR : memory allocation"
call efexit(-1)
endif
call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
med_full_interlace,med_all_constituent, coords, cret)
if (cret .ne. 0 ) then
print *,"ERROR : nodes coordinates"
call efexit(-1)
endif
print *,"Nodes coordinates =", coords
deallocate(coords)
end if
if (coocha == 1 .and. .not. geotra == 1) then
call mmhnme(fid,mname,numdt,numit, &
med_node,med_none,med_coordinate_trsf,med_nodal,coocha, &
matran, matsiz, cret)
if (cret .ne. 0 ) then
print *,"ERROR : transformation matrix"
call efexit(-1)
endif
print *,"Transformation matrix flag =", matran
print *,"Matrix size = ", matsiz
if (matran == 1) then
call mmhtfr(fid, mname, numdt, numit, matrix, cret)
if (cret .ne. 0 ) then
print *,"ERROR : transformation matrix"
call efexit(-1)
endif
print *,"Transformation matrix =", matrix
end if
end if
end do ! it=1, nstep-1
end do ! i=0, nmesh-1
! close file
call mficlo(fid,cret)
if (cret .ne. 0 ) then
print *,"ERROR : close file"
call efexit(-1)
endif
end program usescase_medmesh_12
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
usescase_medmesh_12
program usescase_medmesh_12
Definition: UsesCase_MEDmesh_12.f90:23
mmhnep
subroutine mmhnep(fid, name, numdt, numit, entype, geotype, datype, cmode, stmode, pname, psize, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une étape de calcul et un prof...
Definition: medmesh.f:670
mmhnmh
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:41
mmhcpr
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Cette routine permet de lire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:362
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
mmhtfr
subroutine mmhtfr(fid, name, numdt, numit, tsf, cret)
Cette routine lit les paramètres de translation rotation à appliquer aux noeuds de l'étape de calcul ...
Definition: medmesh.f:1270
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
mmhnax
subroutine mmhnax(fid, it, naxis, cret)
Cette routine permet de lire dans un maillage le nombre d'axes du repère des coordonnées des noeuds.
Definition: medmesh.f:64
mmhcsi
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Cette routine permet de lire les informations relatives à une étape de calcul d'un maillage.
Definition: medmesh.f:1038
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