MED fichier: f/test4.f

MED fichier

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