Unittest_MEDstructElement_3.f
Aller à la documentation de ce fichier.
C* This file is part of MED.
C*
C* COPYRIGHT (C) 1999 - 2021 EDF R&D, CEA/DEN
C* MED is free software: you can redistribute it and/or modify
C* it under the terms of the GNU Lesser General Public License as published by
C* the Free Software Foundation, either version 3 of the License, or
C* (at your option) any later version.
C*
C* MED is distributed in the hope that it will be useful,
C* but WITHOUT ANY WARRANTY; without even the implied warranty of
C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
C* GNU Lesser General Public License for more details.
C*
C* You should have received a copy of the GNU Lesser General Public License
C* along with MED. If not, see <http://www.gnu.org/licenses/>.
C*
C******************************************************************************
C * Tests for struct element module
C *
C *****************************************************************************
program medstructelement3
C
implicit none
include 'med.hf'
C
C
integer cret
integer*8 fid
character*64 fname
parameter(fname = "Unittest_MEDstructElement_1.med")
character*64 mname1, mname2, mname3
parameter(mname1 = "model name 1")
parameter(mname2 = "model name 2")
parameter(mname3 = "model name 3")
integer dim1, dim2, dim3
parameter(dim1=2)
parameter(dim2=2)
parameter(dim3=2)
character*64 smname1
parameter(smname1=med_no_name)
character*64 smname2
parameter(smname2="support mesh name")
integer setype1
parameter(setype1=med_none)
integer setype2
parameter(setype2=med_node)
integer setype3
parameter(setype3=med_cell)
integer sgtype1
parameter(sgtype1=med_no_geotype)
integer sgtype2
parameter(sgtype2=med_no_geotype)
integer sgtype3
parameter(sgtype3=med_seg2)
integer mtype1,mtype2,mtype3
parameter(mtype1=601)
parameter(mtype2=602)
parameter(mtype3=603)
integer nnode1,nnode2
parameter(nnode1=1)
parameter(nnode2=3)
integer ncell2
parameter(ncell2=2)
integer ncell1
parameter(ncell1=0)
integer ncatt1,profile1,nvatt1
parameter(ncatt1=0)
parameter(nvatt1=0)
parameter(profile1=0)
integer nsm
parameter(nsm=3)
c
integer it,nsmr
integer mgtype,mdim,setype,snnode,sncell
integer sgtype,ncatt,nvatt,profile
character*64 smname,mname
C
C
C open file
call mfiope(fid,fname,med_acc_rdonly,cret)
print *,'Open file',cret
if (cret .ne. 0 ) then
print *,'ERROR : file creation'
call efexit(-1)
endif
C
C
C read number of struct model
call msense(fid,nsmr,cret)
print *,'Read number of struct model',nsmr,cret
if (cret .ne. 0 ) then
print *,'ERROR : number of struct model'
call efexit(-1)
endif
if (nsmr .ne. nsm) then
print *,'ERROR : number of struct model'
call efexit(-1)
endif
C
C
C Read informations by iteration
do it=1,nsmr
c
call msesei(fid,it,mname,mgtype,mdim,smname,
& setype,snnode,sncell,sgtype,
& ncatt,profile,nvatt,cret)
print *,'Read information about struct element',cret
if (cret .ne. 0 ) then
print *,'ERROR : information about struct element'
call efexit(-1)
endif
c
if (it .eq. 1) then
if ( (mname .ne. mname1) .or.
& (mgtype .ne. mtype1) .or.
& (mdim .ne. dim1) .or.
& (smname .ne. smname1) .or.
& (setype .ne. setype1) .or.
& (snnode .ne. nnode1) .or.
& (sncell .ne. ncell1) .or.
& (sgtype .ne. sgtype1) .or.
& (ncatt .ne. ncatt1) .or.
& (profile .ne. profile1) .or.
& (nvatt .ne. nvatt1)
& ) then
print *,'ERROR : information about struct element'
call efexit(-1)
endif
endif
c
if (it .eq. 2) then
if ( (mname .ne. mname2) .or.
& (mgtype .ne. mtype2) .or.
& (mdim .ne. dim2) .or.
& (smname .ne. smname2) .or.
& (setype .ne. setype2) .or.
& (snnode .ne. nnode2) .or.
& (sncell .ne. ncell1) .or.
& (sgtype .ne. sgtype2) .or.
& (ncatt .ne. ncatt1) .or.
& (profile .ne. profile1) .or.
& (nvatt .ne. nvatt1)
& ) then
print *,'ERROR : information about struct element '
call efexit(-1)
endif
endif
c
if (it .eq. 3) then
if ( (mname .ne. mname3) .or.
& (mgtype .ne. mtype3) .or.
& (mdim .ne. dim3) .or.
& (smname .ne. smname2) .or.
& (setype .ne. setype3) .or.
& (snnode .ne. nnode2) .or.
& (sncell .ne. ncell2) .or.
& (sgtype .ne. sgtype3) .or.
& (ncatt .ne. ncatt1) .or.
& (profile .ne. profile1) .or.
& (nvatt .ne. nvatt1)
& ) then
print *,'ERROR : information about struct element'
call efexit(-1)
endif
endif
c
enddo
C
C
C Read struct model name from type
call msesen(fid,mtype1,mname,cret)
print *,'Read struct element name from the type',cret
if (cret .ne. 0 ) then
print *,'ERROR : struct element name from the type'
call efexit(-1)
endif
if (mname .ne. mname1) then
print *,'ERROR : struct element name from the type'
call efexit(-1)
endif
c
call msesen(fid,mtype2,mname,cret)
print *,'Read struct element name from the type',cret
if (cret .ne. 0 ) then
print *,'ERROR : struct element name from the type'
call efexit(-1)
endif
if (mname .ne. mname2) then
print *,'ERROR : struct element name from the type'
call efexit(-1)
endif
c
call msesen(fid,mtype3,mname,cret)
print *,'Read struct element name from the type',cret
if (cret .ne. 0 ) then
print *,'ERROR : struct element name from the type'
call efexit(-1)
endif
if (mname .ne. mname3) then
print *,'ERROR : struct element name from the type'
call efexit(-1)
endif
C
C
C close file
call mficlo(fid,cret)
print *,'Close file',cret
if (cret .ne. 0 ) then
print *,'ERROR : close file'
call efexit(-1)
endif
C
C
C
end
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
msesei
subroutine msesei(fid, it, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
Cette routine décrit les caractéristiques d'un modèle d'élément de structure par itération.
Definition: medstructelement.f:68
medstructelement3
program medstructelement3
Definition: Unittest_MEDstructElement_3.f:22
msense
subroutine msense(fid, n, cret)
Cette routine renvoie le nombre de modèles d'éléments de structure.
Definition: medstructelement.f:44
msesen
subroutine msesen(fid, mgtype, mname, cret)
Cette routine renvoie le nom du modèle d'éléments de structure associé au type mgeotype.
Definition: medstructelement.f:110