MED fichier: Fichier source de test4.f

MED fichier

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

test4.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 : test4.f
20 C *
21 C * - Description : ecriture des noeuds d'un maillage MED.
22 C *
23 C *****************************************************************************
24 program test4
25 C
26 implicit none
27 include 'med.hf'
28 C
29 C
30 integer cret, fid
31
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 C ** table des coordonnees **
39 C profil : (dimension * nombre de noeuds) ici 8 **
40 real*8 coo(8)
41 C ** tables des noms et des unites des coordonnees **
42 C profil : (dimension) **
43 character*16 nomcoo(2)
44 character*16 unicoo(2)
45 C ** tables des noms, numeros, numeros de familles des noeuds **
46 C autant d'elements que de noeuds - les noms ont pout longueur **
47 C MED_TAILLE_PNOM **
48 character*16 nomnoe(4)
49 integer numnoe(4)
50 integer nufano(4)
51 real*8 dt
52
53 parameter(mdim = 2, maa = "maa1",nnoe = 4, sdim=2)
54 parameter(dt = 0.0)
55 data coo /0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0/
56 data nomcoo /"x","y"/, unicoo /"cm","cm"/
57 data nomnoe /"nom1","nom2","nom3","nom4"/
58 data numnoe /1,2,3,4/, nufano /0,1,2,2/
59
60 C ** Creation du fichier test4.med **
61 call mfiope(fid,'test4.med',med_acc_rdwr, cret)
62 print *,cret
63 if (cret .ne. 0 ) then
64 print *,'Erreur creation du fichier'
65 call efexit(-1)
66 endif
67
68 C ** Creation du maillage maa de dimension 2 **
69 C ** et de type non structure **
70 call mmhcre(fid,maa,mdim,sdim,
71 & med_unstructured_mesh,'un premier maillage pour test4',
72 & "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
73 print *,cret
74 if (cret .ne. 0 ) then
75 print *,'Erreur creation du maillage'
76 call efexit(-1)
77 endif
78
79 C ** Ecriture des coordonnees en mode MED_FULL_INTERLACE : **
80 C ** (X1,Y1, X2,Y2, X3,Y3, ...) dans un repere cartesien **
81 call mmhcow(fid,maa,med_no_dt,med_no_it,dt,
82 & med_full_interlace,nnoe,coo,cret)
83 print *,cret
84 if (cret .ne. 0 ) then
85 print *,'Erreur ecriture des coordonnees des noeuds'
86 call efexit(-1)
87 endif
88
89 C ** Ecriture des noms des noeuds (optionnel dans un maillage MED) **
90 call mmheaw(fid,maa,med_no_dt,med_no_it,med_node,
91 & med_none,nnoe,nomnoe,cret)
92 print *,cret
93 if (cret .ne. 0 ) then
94 print *,'Erreur ecriture des noms des noeuds'
95 call efexit(-1)
96 endif
97
98 C ** Ecriture des numeros des noeuds (optionnel dans un maillage MED) **
99 call mmhenw(fid,maa,med_no_dt,med_no_it,med_node,
100 & med_none,nnoe,numnoe,cret)
101 print *,cret
102 if (cret .ne. 0 ) then
103 print *,'Erreur ecriture des numeros des noeuds'
104 call efexit(-1)
105 endif
106
107
108 C ** Ecriture des numeros de familles des noeuds **
109 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_node,
110 & med_none,nnoe,nufano,cret)
111 print *,cret
112 if (cret .ne. 0 ) then
113 print *,'Erreur ecriture des numeros de famille'
114 call efexit(-1)
115 endif
116
117 C ** Fermeture du fichier **
118 call mficlo(fid,cret)
119 print *,cret
120 if (cret .ne. 0 ) then
121 print *,'Erreur fermeture du fichier'
122 call efexit(-1)
123 endif
124
125 end
126
127
128
129
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:484
test4
program test4
Definition: test4.f:24
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:444
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
mmhcow
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Cette routine permet d'écrire dans un maillage le tableau des coordonnées des noeuds, selon une séquence de calcul donnée.
Definition: medmesh.f:285
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:404