f/test29.f
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 * - Nom du fichier : test29.f
C *
C * - Description : ecriture d'un joint dans un maillage MED
C *
C ******************************************************************************
program test29
C
implicit none
include 'med.hf'
C
C
integer*8 fid
integer cret, domdst
character*64 maa , jnt, maadst
character*200 des
integer mdim ,ncor
integer cor(6)
character*16 nomcoo(2)
character*16 unicoo(2)
data nomcoo /"x","y"/, unicoo /"cm","cm"/
parameter(maa ="maa1",maadst="maa2", domdst=2,
& mdim = 2,ncor = 3 )
data cor /1,2,3,4,5,6/, jnt / "joint"/
data des / "joint avec le sous-domaine 2" /
C ** Creation du fichier test29.med **
call mfiope(fid,'test29.med',med_acc_rdwr,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur creation du fichier'
call efexit(-1)
endif
C ** Creation du maillage **
call mmhcre(fid,maa,mdim,mdim,
& med_unstructured_mesh,'Un maillage pour test29',
& "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur creation du maillage'
call efexit(-1)
endif
C ** Creation du joint **
call msdjcr(fid,maa,jnt,des,domdst,maadst,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur creation joint'
call efexit(-1)
endif
C ** Ecriture de la correspondance Noeud, Noeud **
call msdcrw(fid,maa,jnt,med_no_dt,med_no_it,
& med_node,med_none,med_node,med_none,
& ncor,cor,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture correspondance (Noeud,Noeud)'
call efexit(-1)
endif
C ** Ecriture de la correspondance Noeud, TRIA3 **
call msdcrw(fid,maa,jnt,med_no_dt,med_no_it,
& med_node,med_none,med_cell,med_tria3,
& ncor,cor,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture correspondance (Noeud,Tria3)'
call efexit(-1)
endif
C ** Fermeture du fichier **
call mficlo(fid,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur fermeture du fichier'
call efexit(-1)
endif
C
end
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
msdjcr
subroutine msdjcr(fid, lmname, jname, des, dom, rmname, cret)
Cette routine permet de créer un joint dans un maillage.
Definition: medjoint.f:20
msdcrw
subroutine msdcrw(fid, lmname, jname, numdt, numit, entlcl, geolcl, entdst, geodst, n, corrtab, cret)
Cette routine permet l'écriture d'une correspondance dans un joint pour un type de couple d'entité en...
Definition: medjoint.f:51
test29
program test29
Definition: test29.f:25