Unittest_MEDstructElement_9.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 medstructelement9
C
implicit none
include 'med.hf'
C
C
integer cret
integer*8 fid
character*64 fname
parameter(fname = "Unittest_MEDstructElement_9.med")
character*64 mname2
parameter(mname2 = "model name 2")
integer dim2
parameter(dim2=2)
character*64 smname2
parameter(smname2="support mesh name")
integer setype2
parameter(setype2=med_node)
integer sgtype2
parameter(sgtype2=med_no_geotype)
integer mtype2
integer sdim1
parameter(sdim1=2)
character*200 description1,description2
parameter(description1="support mesh1 description")
parameter(description2="computation mesh description")
character*16 nomcoo2d(2)
character*16 unicoo2d(2)
data nomcoo2d /"x","y"/, unicoo2d /"cm","cm"/
real*8 coo(2*3), ccoo(2*3)
data coo /0.0, 0.0, 1.0,1.0, 2.0,2.0/
data ccoo /0.1, 0.1, 1.1,1.1, 2.1,2.1/
integer nnode
parameter(nnode=3)
integer nseg2
parameter(nseg2=2)
integer seg2(4), mcon(1)
data seg2 /1,2, 2,3/
data mcon /1/
character*64 aname1, aname2, aname3
parameter(aname1="integer attribute name")
parameter(aname2="real attribute name")
parameter(aname3="string attribute name")
integer atype1,atype2,atype3
parameter(atype1=med_att_int)
parameter(atype2=med_att_float64)
parameter(atype3=med_att_name)
integer anc1,anc2,anc3
parameter(anc1=2)
parameter(anc2=1)
parameter(anc3=2)
integer aval1(2)
data aval1 /1,2/
real*8 aval2(1)
data aval2 /1./
character*64 aval3(2)
data aval3 /"VAL1","VAL2"/
character*64 pname,cname
parameter(cname="computation mesh")
integer nentity
parameter(nentity=1)
C
C
C file creation
call mfiope(fid,fname,med_acc_creat,cret)
print *,'Open file',cret
if (cret .ne. 0 ) then
print *,'ERROR : file creation'
call efexit(-1)
endif
C
C
C support mesh creation : 2D
call msmcre(fid,smname2,dim2,dim2,description1,
& med_cartesian,nomcoo2d,unicoo2d,cret)
print *,'Support mesh creation : 2D space dimension',cret
if (cret .ne. 0 ) then
print *,'ERROR : support mesh creation'
call efexit(-1)
endif
c
call mmhcow(fid,smname2,med_no_dt,med_no_it,
& med_undef_dt,med_full_interlace,
& nnode,coo,cret)
c
call mmhcyw(fid,smname2,med_no_dt,med_no_it,
& med_undef_dt,med_cell,med_seg2,
& med_nodal,med_full_interlace,
& nseg2,seg2,cret)
C
C struct element creation
C
call msecre(fid,mname2,dim2,smname2,setype2,
& sgtype2,mtype2,cret)
print *,'Create struct element',mtype2, cret
if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
print *,'ERROR : struct element creation'
call efexit(-1)
endif
C
C attribute creation
C
call msevac(fid,mname2,aname1,atype1,anc1,cret)
print *,'Create attribute',aname1, cret
if (cret .ne. 0) then
print *,'ERROR : attribute creation'
call efexit(-1)
endif
c
call msevac(fid,mname2,aname2,atype2,anc2,cret)
print *,'Create attribute',aname2, cret
if (cret .ne. 0) then
print *,'ERROR : attribute creation'
call efexit(-1)
endif
c
call msevac(fid,mname2,aname3,atype3,anc3,cret)
print *,'Create attribute',aname3, cret
if (cret .ne. 0) then
print *,'ERROR : attribute creation'
call efexit(-1)
endif
C
C computation mesh creation
C
call mmhcre(fid,cname,dim2,dim2,med_unstructured_mesh,
& description2,"",med_sort_dtit,med_cartesian,
& nomcoo2d,unicoo2d,cret)
print *,'Create computation mesh',cname, cret
if (cret .ne. 0) then
print *,'ERROR : computation mesh creation'
call efexit(-1)
endif
c
call mmhcow(fid,cname,med_no_dt,med_no_it,med_undef_dt,
& med_full_interlace,nnode,ccoo,cret)
print *,'Write nodes coordinates',cret
if (cret .ne. 0) then
print *,'ERROR : write nodes coordinates'
call efexit(-1)
endif
c
call mmhcyw(fid,cname,med_no_dt,med_no_it,med_undef_dt,
& med_struct_element,mtype2,med_nodal,
& med_no_interlace,nentity,mcon,cret)
print *,'Write cells connectivity',cret
if (cret .ne. 0) then
print *,'ERROR : write cells connectivity'
call efexit(-1)
endif
C
C write attributes values
C
call mmhiaw(fid,cname,med_no_dt,med_no_it,
& mtype2,aname1,nentity,
& aval1,cret)
print *,'Write attribute values',cret
if (cret .ne. 0) then
print *,'ERROR : write attribute values'
call efexit(-1)
endif
c
call mmhraw(fid,cname,med_no_dt,med_no_it,
& mtype2,aname2,nentity,
& aval2,cret)
print *,'Write attribute values',cret
if (cret .ne. 0) then
print *,'ERROR : write attribute values'
call efexit(-1)
endif
c
call mmhsaw(fid,cname,med_no_dt,med_no_it,
& mtype2,aname3,nentity,
& aval3,cret)
print *,'Write attribute values',cret
if (cret .ne. 0) then
print *,'ERROR : write attribute values'
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
mmhcow
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Cette routine permet d'écrire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:299
mmhcyw
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Cette routine permet d'écrire dans un maillage le tableau des connectivités pour un type géométrique ...
Definition: medmesh.f:578
mmhsaw
subroutine mmhsaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Cette routine écrit les valeurs d'un attribut caractéristique variable sur les éléments de structure ...
Definition: medmesh.f:1142
mmhcre
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
Cette routine permet de créer un maillage dans un fichier.
Definition: medmesh.f:20
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
mmhraw
subroutine mmhraw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Cette routine écrit les valeurs d'un attribut caractéristique variable sur les éléments de structure ...
Definition: medmesh.f:1096
medstructelement9
program medstructelement9
Definition: Unittest_MEDstructElement_9.f:22
msecre
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, cret)
Cette routine permet de créer un nouveau modèle d'éléments de structure dans un fichier MED.
Definition: medstructelement.f:20
mmhiaw
subroutine mmhiaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Cette routine écrit les valeurs d'un attribut caractéristique variable sur les éléments de structure ...
Definition: medmesh.f:1119
msmcre
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
Cette routine permet de créer un maillage support.
Definition: medsupport.f:20
msevac
subroutine msevac(fid, mname, aname, atype, anc, cret)
Cette routine déclare la présence d'un attribut caractéristique variable attaché aux éléments de type...
Definition: medstructelement.f:150