UsesCase_MEDmesh_7.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/>.
!*
!*
!*
!* Use case 7 : read a 2D unstructured mesh with nodes coordinates modifications
!*
program usescase_medmesh_7
implicit none
include 'med.hf90'
integer cret
integer*8 fid
! mesh name
character(MED_NAME_SIZE) :: mname = "2D unstructured mesh"
! 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 nnodes
integer, dimension(:), allocatable :: tricon
integer ntria3
integer, dimension(:), allocatable :: quacon
integer nquad4
! coordinate changement, geometry transformation
integer coocha, geotra
integer it
! profil size
integer profsz
! profil name
character(MED_NAME_SIZE) :: profna = ""
integer numdt, numit
real*8 dt
! open MED file with READ ONLY access mode
call mfiope(fid, "UsesCase_MEDmesh_6.med", med_acc_rdonly, cret)
if (cret .ne. 0 ) then
print *, "ERROR : open file"
call efexit(-1)
endif
! ... we know that the MED file has only one mesh,
! a real code working would check ...
! read mesh informations
allocate ( aname(2), aunit(2) ,stat=cret )
if (cret > 0) then
print *, "ERROR : memory allocation"
call efexit(-1)
endif
call mmhmin(fid, 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
! we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh
! a real code working would check all MED geometry cell types
! read how many triangular cells in the mesh
call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, med_connectivity, &
med_nodal, coocha, geotra, ntria3, cret)
if (cret .ne. 0 ) then
print *, "ERROR : read how many nodes in the mesh"
call efexit(-1)
endif
print *,"number of triangular cells in the mesh =", ntria3
! read how many quadrangular cells in the mesh
call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, med_connectivity, &
med_nodal, coocha, geotra, nquad4, cret)
if (cret .ne. 0 ) then
print *, "ERROR : read how many nodes in the mesh"
call efexit(-1)
endif
print *,"number of quadrangular cells in the mesh =", nquad4
! read mesh nodes coordinates in the initial mesh
allocate (coords(nnodes*2),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 cells connectivity in the mesh
allocate ( tricon(ntria3 * 3) ,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, med_tria3, &
med_nodal,med_full_interlace,tricon,cret)
if (cret .ne. 0 ) then
print *,"ERROR : MED_TRIA3 connectivity"
call efexit(-1)
endif
print *,"MED_TRIA3 connectivity =", tricon
deallocate(tricon)
allocate ( quacon(nquad4*4) ,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, med_quad4, &
med_nodal, med_full_interlace, quacon, cret)
if (cret .ne. 0 ) then
print *,"ERROR : MED_QUAD4 connectivity"
call efexit(-1)
endif
print *,"MED_QUAD4 connectivity =", quacon
deallocate(quacon)
! we know that the family number of nodes and elements is 0, a real working would check ...
! 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
! if coordinates have changed, then read the new coordinates
if (coocha == 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
end do
! close file
call mficlo(fid,cret)
if (cret .ne. 0 ) then
print *,"ERROR : close file"
call efexit(-1)
endif
end program usescase_medmesh_7
usescase_medmesh_7
program usescase_medmesh_7
Definition UsesCase_MEDmesh_7.f90:22
mfiope
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Definition medfile.f:82
mmhcor
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition medmesh.f:320
mmhmin
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition medmesh.f:130
mmhcsi
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Definition medmesh.f:1038
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition medmesh.f:551
mmhnep
subroutine mmhnep(fid, name, numdt, numit, entype, geotype, datype, cmode, stmode, pname, psize, chgt, tsf, n, cret)
Definition medmesh.f:670
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition medmesh.f:600
mmhcpr
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Definition medmesh.f:362