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