f/test6.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 : test6.f
C *
C * - Description : exemples d'ecriture d'elements dans un maillage MED
C *
C ******************************************************************************
program test6
C
implicit none
include 'med.hf'
C
C
integer*8 fid
integer cret
integer mdim,nse2,ntr3,sdim
parameter(nse2=5, ntr3=2, mdim=2, sdim=2)
integer se2 (2*nse2)
character*16 nomse2(nse2)
integer numse2(nse2),nufase2(nse2)
character*16 nomcoo(2)
character*16 unicoo(2)
integer tr3 (3*ntr3)
character*16 nomtr3(ntr3)
integer numtr3(ntr3), nufatr3(ntr3)
character*64 maa
real*8 dt
parameter(dt = 0.0)
data nomcoo /"x","y"/, unicoo /"cm","cm"/
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 /, nomtr3 /"tr1","tr2"/,
& numtr3 /4,5/
data nufatr3 /0,-1/, maa /"maa1"/
C ** Ouverture du fichier
call mfiope(fid,'test6.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 maa de dimension 2 **
call mmhcre(fid,maa,mdim,sdim,
& med_unstructured_mesh,'un maillage pour test6',
& "",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 connectivites des segments **
call mmhcyw(fid,maa,med_no_dt,med_no_it,dt,
& med_descending_edge,med_seg2,med_descending,
& med_no_interlace,nse2,se2,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture de la connectivite'
call efexit(-1)
endif
C ** Ecriture (optionnelle) des noms des segments **
call mmheaw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
& med_seg2,nse2,nomse2,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture des noms'
call efexit(-1)
endif
C ** Ecriture (optionnelle) des numeros des segments **
call mmhenw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
& med_seg2,nse2,numse2,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture des numeros'
call efexit(-1)
endif
C ** Ecriture des numeros des familles des segments **
call mmhfnw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
& med_seg2,nse2,nufase2,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture des numéros de famille'
call efexit(-1)
endif
C ** Ecriture des connectivites des triangles **
call mmhcyw(fid,maa,med_no_dt,med_no_it,dt,
& med_cell,med_tria3,med_descending,
& med_no_interlace,ntr3,tr3,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture de la connectivite'
call efexit(-1)
endif
C ** Ecriture (optionnelle) des noms des triangles **
call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
& med_tria3,ntr3,nomtr3,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture des noms'
call efexit(-1)
endif
C ** Ecriture (optionnelle) des numeros des triangles **
call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
& med_tria3,ntr3,numtr3,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture des numeros'
call efexit(-1)
endif
C ** Ecriture des numeros des familles des triangles **
call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
& med_tria3,ntr3,nufatr3,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture des numeros de famille'
call efexit(-1)
endif
C ** Fermeture du fichier **
call mficlo(fid,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur a la fermeture du fichier'
call efexit(-1)
endif
C
end
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
test6
program test6
Definition: test6.f:24
mmhenw
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Cette routine permet d'écrire les numéros d'un type d'entité d'un maillage.
Definition: medmesh.f:424
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
mmheaw
subroutine mmheaw(fid, mname, numdt, numit, entype, geotype, n, ename, cret)
Cette routine permet d'écrire les noms d'un type d'entité d'un maillage.
Definition: medmesh.f:508
mmhfnw
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Cette routine permet l'écriture des numéros de famille d'un type d'entité d'un maillage.
Definition: medmesh.f:466