MED fichier
test12.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 
19 C ******************************************************************************
20 C * - Nom du fichier : test12.f
21 C *
22 C * - Description : ecriture d'une equivalence dans un maillage MED
23 C *
24 C ******************************************************************************
25  program test12
26 C
27  implicit none
28  include 'med.hf'
29 C
30 C
31  integer cret,fid
32  character*64 maa , equ
33  character*200 des
34  integer mdim ,ncor, sdim
35  integer cor(6)
36  character*16 nomcoo(3)
37  character*16 unicoo(3)
38 
39  parameter(maa ="maa1",mdim = 3,ncor = 3 , sdim=3)
40  data cor /1,2,3,4,5,6/, equ / "equivalence"/
41  data des / "equivalence sur les mailles MED_TRIA3" /
42  data nomcoo /"x","y","z"/, unicoo /"cm","cm","cm"/
43 
44 
45 C ** Creation du fichier test12.med **
46  call mfiope(fid,'test12.med',med_acc_rdwr, cret)
47  print *,cret
48  if (cret .ne. 0 ) then
49  print *,'Erreur creation du fichier'
50  call efexit(-1)
51  endif
52 
53 
54 C ** Creation du maillage **
55  call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
56  & 'Un maillage pour test12',"",
57  & med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
58  print *,cret
59  if (cret .ne. 0 ) then
60  print *,'Erreur creation du maillage'
61  call efexit(-1)
62  endif
63 
64 C ** Creation de l'equivalence **
65  call meqcre(fid,maa,equ,des,cret)
66  print *,cret
67  if (cret .ne. 0 ) then
68  print *,'Erreur creation equivalence'
69  call efexit(-1)
70  endif
71 
72 C ** Ecriture des correspondances sur les mailles MED_TRIA3 **
73  call meqcow(fid,maa,equ,med_no_dt,med_no_it,med_cell,
74  & med_tria3,ncor,cor,cret)
75  print *,cret
76  if (cret .ne. 0 ) then
77  print *,'Erreur ecriture de correspondances'
78  call efexit(-1)
79  endif
80 
81 C ** Fermeture du fichier **
82  call mficlo(fid,cret)
83  print *,cret
84  if (cret .ne. 0 ) then
85  print *,'Erreur fermeture du fichier'
86  call efexit(-1)
87  endif
88 C
89  end
subroutine meqcre(fid, maa, eq, des, cret)
Cette routine permet la création d'une équivalence portant sur les entités d'un maillage.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
program test12
Definition: test12.f:25
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
subroutine meqcow(fid, maa, eq, numdt, numit, typent, typgeo, n, corr, cret)
Cette routine permet d'écrire un tableau de correspondances entre les entités d'un maillage dans une ...
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41