MED fichier
test27.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 : test27.f
20 C *
21 C * - Description : creation de maillages structures (grille cartesienne |
22 C * grille standard ) dans le fichier test27.med
23 C *
24 C *****************************************************************************
25  program test27
26 C
27  implicit none
28  include 'med.hf'
29 C
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 C ** table des coordonnees **
39  real*8 coo(8)
40  character*16 nomcoo(2), unicoo(2)
41  character*200 desc
42  integer strgri(2)
43 C ** grille cartesienne **
44  integer axe,nind
45  real*8 indice(4)
46 
47 C
48 C
49  data coo /0.0,0.0,1.0,0.0,0.0,1.0,1.0,1.0/
50  data nomcoo /"x","y"/, unicoo /"cm","cm"/
51 C
52 C Creation du fichier test27.med
53  call mfiope(fid,'test27.med',med_acc_rdwr, cret)
54  print *,cret
55  if (cret .ne. 0 ) then
56  print *,'Erreur creation du fichier'
57  call efexit(-1)
58  endif
59  print *,'Creation du fichier test27.med'
60 C
61 C Creation d'un maillage MED_NON_STRUCTURE
62  mdim = 2
63  sdim = 2
64  maa = 'maillage vide'
65  desc = 'un maillage vide'
66  call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
67  & desc,"",med_sort_dtit,med_cartesian,
68  & nomcoo,unicoo,cret)
69  print *,cret
70  if (cret .ne. 0 ) then
71  print *,'Erreur creation du maillage'
72  call efexit(-1)
73  endif
74 C
75 C Creation d'une grille cartesienne
76  mdim = 2
77  maa = 'grille cartesienne'
78  desc = 'un exemple de grille cartesienne'
79  call mmhcre(fid,maa,mdim,sdim,med_structured_mesh,
80  & desc,"",med_sort_dtit,med_cartesian,
81  & nomcoo,unicoo,cret)
82  print *,cret
83  if (cret .ne. 0 ) then
84  print *,'Erreur creation du maillage'
85  call efexit(-1)
86  endif
87  print *,'Creation d un maillage MED_STRUCTURE'
88 
89 C
90 C On specifie la nature du maillage structure
91  call mmhgtw(fid,maa,med_cartesian_grid,cret)
92  print *,cret
93  print *,'On definit la nature de la grille :
94  & MED_GRILLE_CARTESIENNE'
95  if (cret .ne. 0 ) then
96  print *,'Erreur ecriture de la nature de la grille'
97  call efexit(-1)
98  endif
99 C
100 C On definit les indices de la grille selon chaque dimension
101  indice(1) = 1.1d0
102  indice(2) = 1.2d0
103  indice(3) = 1.3d0
104  indice(4) = 1.4d0
105  nind = 4
106  axe = 1
107  call mmhgcw(fid,maa,med_no_dt,med_no_it,med_undef_dt,
108  & axe,nind,indice,cret)
109  print *,cret
110  if (cret .ne. 0 ) then
111  print *,'Erreur ecriture des indices'
112  call efexit(-1)
113  endif
114  print *,'Ecriture des indices des coordonnees selon axe X'
115 C
116  indice(1) = 2.1d0
117  indice(2) = 2.2d0
118  indice(3) = 2.3d0
119  indice(4) = 2.4d0
120  nind = 4
121  axe = 2
122  call mmhgcw(fid,maa,med_no_dt,med_no_it,med_undef_dt,
123  & axe,nind,indice,cret)
124  print *,cret
125  if (cret .ne. 0 ) then
126  print *,'Erreur ecriture des indices'
127  call efexit(-1)
128  endif
129  print *,'Ecriture des indices des coordonnees selon axe Y'
130 C
131 C Creation d'une grille MED_CURVILINEAR_GRID de dimension 2
132  maa = 'grille curviligne'
133  mdim = 2
134  desc = 'un exemple de grille curviligne'
135  call mmhcre(fid,maa,mdim,sdim,med_structured_mesh,
136  & desc,"",med_sort_dtit,med_cartesian,
137  & nomcoo,unicoo,cret)
138  print *,cret
139  if (cret .ne. 0 ) then
140  print *,'Erreur creation de maillage'
141  call efexit(-1)
142  endif
143  print *,'Nouveau maillage MED_STRUCTURE'
144 C
145  call mmhgtw(fid,maa,med_curvilinear_grid,cret)
146  print *,cret
147  if (cret .ne. 0 ) then
148  print *,'Erreur ecriture de la nature de la grille'
149  call efexit(-1)
150  endif
151  print *,'On definit la nature du maillage : MED_GRILLE_STANDARD'
152 C
153 C On ecrit les coordonnes de la grille
154  nnoe = 4
155  call mmhcow(fid,maa,med_no_dt,med_no_it,med_undef_dt,
156  & med_full_interlace,nnoe,coo,cret)
157  print *,cret
158  if (cret .ne. 0 ) then
159  print *,'Erreur ecriture des coordonnees des noeuds'
160  call efexit(-1)
161  endif
162  print *,'Ecriture des coordonnees de la grille'
163 C
164 C On definit la structure des coordonnees de la grille
165  strgri(1) = 2
166  strgri(2) = 2
167  call mmhgsw(fid,maa,med_no_dt,med_no_it,med_undef_dt,
168  & strgri,cret)
169  print *,cret
170  if (cret .ne. 0 ) then
171  print *,'Erreur ecriture de la structure'
172  call efexit(-1)
173  endif
174  print *,'Ecriture de la structure de la grille : / 2,2 /'
175 C
176 C On ferme le fichier
177  call mficlo(fid,cret)
178  print *,cret
179  if (cret .ne. 0 ) then
180  print *,'Erreur fermeture du fichier'
181  call efexit(-1)
182  endif
183  print *,'Fermeture du fichier'
184 C
185  end
186 
187 
188 
189 
190 
191 
subroutine mmhgcw(fid, name, numdt, numit, dt, axis, size, index, cret)
Cette routine permet l'écriture des coordonnées des noeuds d'un maillage structuré selon un axe du re...
Definition: medmesh.f:365
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
program test27
Definition: test27.f:25
subroutine mmhgtw(fid, name, gtype, cret)
Cette routine permet de définir le type d'un maillage structuré (MED_STRUCTURED_MESH).
Definition: medmesh.f:213
subroutine mmhgsw(fid, name, numdt, numit, dt, st, cret)
Cette routine définit la structure (nombre de points sur chaque axe du repère) d'un maillage structur...
Definition: medmesh.f:247
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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