MED fichier: Fichier source de test14.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

test14.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17
18 C ******************************************************************************
19 C * - Nom du fichier : test14.f
20 C *
21 C * - Description : ecriture des noeuds d'un maillage MED
22 C * a l'aide des routines de niveau 2
23 C * MED - equivalent a test4.f
24 C *
25 C ******************************************************************************
26 program test14
27 C
28 implicit none
29 include 'med.hf'
30 C
31 integer cret, fid
32 C ** la dimension du maillage **
33 integer mdim,sdim
34 C ** nom du maillage de longueur maxi MED_TAILLE_NOM **
35 character*64 maa
36 C ** le nombre de noeuds **
37 integer nnoe
38 parameter(mdim=2,maa="maa1",nnoe=4,sdim=2)
39 C ** table des coordonnees
40 real*8 coo(mdim*nnoe)
41 C ** tables des noms et des unites des coordonnees
42 character*16 nomcoo(mdim), unicoo(mdim)
43 C ** tables des noms, numeros, numeros de familles des noeuds
44 C autant d'elements que de noeuds - les noms ont pout longueur
45 C MED_TAILLE_PNOM : 8 **
46 character*16 nomnoe(nnoe)
47 integer numnoe(nnoe), nufano(nnoe)
48 real*8 dt
49 parameter(dt=0.0)
50
51 data coo /0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0/
52 data nomcoo /"x","y"/, unicoo /"cm","cm"/
53 data nomnoe /"nom1","nom2","nom3","nom4"/
54 data numnoe /1,2,3,4/,nufano /0,1,2,2/
55
56 C ** Creation du fichier test14.med **
57 call mfiope(fid,'test14.med',med_acc_rdwr, cret)
58 print *,cret
59 if (cret .ne. 0 ) then
60 print *,'Erreur creation du fichier'
61 call efexit(-1)
62 endif
63
64 C ** Creation du maillage **
65 call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
66 & 'un maillage pour test14',"",med_sort_dtit,
67 & med_cartesian,nomcoo,unicoo,cret)
68 print *,cret
69 if (cret .ne. 0 ) then
70 print *,'Erreur creation du maillage'
71 call efexit(-1)
72 endif
73
74 C ** Ecriture des noeuds d'un maillage MED :
75 C - Des coordonnees en mode MED_FULL_INTERLACE : (X1,Y1,X2,Y2,X3,Y3,...)
76 C dans un repere cartesien
77 C - Des noms (optionnel dans un fichier MED)
78 C - Des numeros (optionnel dans un fichier MED)
79 C - Des numeros de familles des noeuds **
80 call mmhnow(fid,maa,med_no_dt,med_no_it,dt,med_full_interlace,
81 & nnoe,coo,med_true,nomnoe,med_true,numnoe,
82 & med_true,nufano,cret)
83 print *,cret
84 if (cret .ne. 0 ) then
85 print *,'Erreur ecriture des noeuds'
86 call efexit(-1)
87 endif
88
89 C ** Fermeture du fichier **
90 call mficlo(fid,cret)
91 print *,cret
92 if (cret .ne. 0 ) then
93 print *,'Erreur fermeture du fichier'
94 call efexit(-1)
95 endif
96 C
97 end
98
99
100
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
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 séquence de calcul do...
Definition: medmesh.f:693
test14
program test14
Definition: test14.f:26
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41