Unittest_MEDstructElement_3.f
Aller à la documentation de ce fichier.
C* This file is part of MED.
C*
C* COPYRIGHT (C) 1999 - 2020 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
medstructelement3
program medstructelement3
Definition Unittest_MEDstructElement_3.f:22
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition medfile.f:42
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition medfile.f:82
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
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
msense
subroutine msense(fid, n, cret)
Cette routine renvoie le nombre de modèles d'éléments de structure.
Definition medstructelement.f:44