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