test16.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 * - Nom du fichier : test16.f
C *
C * - Description : ecriture d'elements d'un maillage MED
C * via les routines de niveau 2
C * - equivalent a test6.f
C *
C ******************************************************************************
program test16
C
implicit none
include 'med.hf'
C
C
integer*8 fid
integer cret, mdim, nse2, ntr3, sdim
character*64 maa
parameter(mdim = 2,nse2 = 5,maa = "maa1", ntr3 = 2, sdim=2)
integer se2 (2*nse2)
character*16 nomse2(nse2)
integer numse2(nse2),nufase2(nse2)
integer tr3 (3*ntr3)
character*16 nomtr3(ntr3)
integer numtr3(ntr3), nufatr3(ntr3)
data se2 /1,2,1,3,2,4,3,4,2,3/
data nomse2 /"se1","se2","se3","se4","se5"/
data numse2 /1,2,3,4,5/, nufase2 /-1,-1,0,-2,-3/
data tr3 /1,2,-5,-5,3,-4/
data nomtr3 /"tr1","tr2"/,numtr3/4,5/,nufatr3/0,-1/
character*16 nomcoo(2)
character*16 unicoo(2)
real*8 dt
data nomcoo /"x","y"/, unicoo /"cm","cm"/
parameter(dt=0.0)
C ** Creation du fichier test16.med **
call mfiope(fid,'test16.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,sdim,med_unstructured_mesh,
& 'Un maillage pour test16',"",
& 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 ** Ecriture des aretes segments MED_SEG2 :
C - Connectivite
C - Noms (optionnel)
C - Numeros (optionnel)
C - Numeros des familles **
call mmhelw(fid,maa,med_no_dt,med_no_it,dt,med_descending_edge,
& med_seg2,med_descending,med_no_interlace,nse2,se2,
& med_true,nomse2,med_true,numse2,med_true,nufase2,
& cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur des elements'
call efexit(-1)
endif
C ** Ecriture des mailles MED_TRIA3 :
C - Connectivite
C - Noms (optionnel)
C - Numeros (optionnel)
C - Numeros des familles **
call mmhelw(fid,maa,med_no_dt,med_no_it,dt,med_cell,
& med_tria3,med_descending,med_no_interlace,ntr3,tr3,
& med_true,nomtr3,med_true,numtr3,med_true,nufatr3,
& cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture des elements'
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
test16
program test16
Definition: test16.f:27
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
mmhelw
subroutine mmhelw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, iname, nname, inum, num, ifam, fam, cret)
Cette routine permet l'écriture d'un type d'élément d'un maillage non structuré pour une étape de cal...
Definition: medmesh.f:751