f/test14.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 : test14.f
C *
C * - Description : ecriture des noeuds d'un maillage MED
C * a l'aide des routines de niveau 2
C * MED - equivalent a test4.f
C *
C ******************************************************************************
program test14
C
implicit none
include 'med.hf'
C
integer*8 fid
integer cret
C ** la dimension du maillage **
integer mdim,sdim
C ** nom du maillage de longueur maxi MED_TAILLE_NOM **
character*64 maa
C ** le nombre de noeuds **
integer nnoe
parameter(mdim=2,maa="maa1",nnoe=4,sdim=2)
C ** table des coordonnees
real*8 coo(mdim*nnoe)
C ** tables des noms et des unites des coordonnees
character*16 nomcoo(mdim), unicoo(mdim)
C ** tables des noms, numeros, numeros de familles des noeuds
C autant d'elements que de noeuds - les noms ont pout longueur
C MED_TAILLE_PNOM : 8 **
character*16 nomnoe(nnoe)
integer numnoe(nnoe), nufano(nnoe)
real*8 dt
parameter(dt=0.0)
data coo /0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0/
data nomcoo /"x","y"/, unicoo /"cm","cm"/
data nomnoe /"nom1","nom2","nom3","nom4"/
data numnoe /1,2,3,4/,nufano /0,1,2,2/
C ** Creation du fichier test14.med **
call mfiope(fid,'test14.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 test14',"",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 noeuds d'un maillage MED :
C - Des coordonnees en mode MED_FULL_INTERLACE : (X1,Y1,X2,Y2,X3,Y3,...)
C dans un repere cartesien
C - Des noms (optionnel dans un fichier MED)
C - Des numeros (optionnel dans un fichier MED)
C - Des numeros de familles des noeuds **
call mmhnow(fid,maa,med_no_dt,med_no_it,dt,med_full_interlace,
& nnoe,coo,med_true,nomnoe,med_true,numnoe,
& med_true,nufano,cret)
print *,cret
if (cret .ne. 0 ) then
print *,'Erreur ecriture des noeuds'
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
mmhnow
subroutine mmhnow(fid, name, numdt, numit, dt, swm, n, coo, iname, nname, inum, num, ifam, fam, cret)
Cette routine permet l'écriture des noeuds d'un maillage non structuré pour une étape de calcul donné...
Definition: medmesh.f:726
test14
program test14
Definition: test14.f:26