UsesCase_MEDmesh_12.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 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
usescase_medmesh_12
program usescase_medmesh_12
Definition UsesCase_MEDmesh_12.f90:23
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
mmhnmh
subroutine mmhnmh(fid, n, cret)
Definition medmesh.f:41
mmhcsi
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Definition medmesh.f:1038
mmhnax
subroutine mmhnax(fid, it, naxis, cret)
Definition medmesh.f:64
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
mmhtfr
subroutine mmhtfr(fid, name, numdt, numit, tsf, cret)
Definition medmesh.f:1270
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition medmesh.f:600
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition medmesh.f:110
mmhcpr
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Definition medmesh.f:362