MED fichier
test29.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2021 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 : test29.f
21 C *
22 C * - Description : ecriture d'un joint dans un maillage MED
23 C *
24 C ******************************************************************************
25  program test29
26 C
27  implicit none
28  include 'med.hf'
29 C
30 C
31  integer*8 fid
32  integer cret, domdst
33  character*64 maa , jnt, maadst
34  character*200 des
35  integer mdim ,ncor
36  integer cor(6)
37  character*16 nomcoo(2)
38  character*16 unicoo(2)
39  data nomcoo /"x","y"/, unicoo /"cm","cm"/
40 
41  parameter(maa ="maa1",maadst="maa2", domdst=2,
42  & mdim = 2,ncor = 3 )
43  data cor /1,2,3,4,5,6/, jnt / "joint"/
44  data des / "joint avec le sous-domaine 2" /
45 
46 
47 
48 C ** Creation du fichier test29.med **
49  call mfiope(fid,'test29.med',med_acc_rdwr,cret)
50  print *,cret
51  if (cret .ne. 0 ) then
52  print *,'Erreur creation du fichier'
53  call efexit(-1)
54  endif
55 
56 
57 C ** Creation du maillage **
58  call mmhcre(fid,maa,mdim,mdim,
59  & med_unstructured_mesh,'Un maillage pour test29',
60  & "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
61  print *,cret
62  if (cret .ne. 0 ) then
63  print *,'Erreur creation du maillage'
64  call efexit(-1)
65  endif
66 
67 C ** Creation du joint **
68  call msdjcr(fid,maa,jnt,des,domdst,maadst,cret)
69  print *,cret
70  if (cret .ne. 0 ) then
71  print *,'Erreur creation joint'
72  call efexit(-1)
73  endif
74 
75 
76 C ** Ecriture de la correspondance Noeud, Noeud **
77  call msdcrw(fid,maa,jnt,med_no_dt,med_no_it,
78  & med_node,med_none,med_node,med_none,
79  & ncor,cor,cret)
80  print *,cret
81  if (cret .ne. 0 ) then
82  print *,'Erreur ecriture correspondance (Noeud,Noeud)'
83  call efexit(-1)
84  endif
85 
86 
87 C ** Ecriture de la correspondance Noeud, TRIA3 **
88  call msdcrw(fid,maa,jnt,med_no_dt,med_no_it,
89  & med_node,med_none,med_cell,med_tria3,
90  & ncor,cor,cret)
91  print *,cret
92  if (cret .ne. 0 ) then
93  print *,'Erreur ecriture correspondance (Noeud,Tria3)'
94  call efexit(-1)
95  endif
96 
97 C ** Fermeture du fichier **
98  call mficlo(fid,cret)
99  print *,cret
100  if (cret .ne. 0 ) then
101  print *,'Erreur fermeture du fichier'
102  call efexit(-1)
103  endif
104 C
105  end
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
msdjcr
subroutine msdjcr(fid, lmname, jname, des, dom, rmname, cret)
Cette routine permet de créer un joint dans un maillage.
Definition: medjoint.f:20
msdcrw
subroutine msdcrw(fid, lmname, jname, numdt, numit, entlcl, geolcl, entdst, geodst, n, corrtab, cret)
Cette routine permet l'écriture d'une correspondance dans un joint pour un type de couple d'entité en...
Definition: medjoint.f:51
test29
program test29
Definition: test29.f:25