MED fichier: Fichier source de test29.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

test29.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2019 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
msdjcr
subroutine msdjcr(fid, lmname, jname, des, dom, rmname, cret)
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
mfiope
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
test29
program test29
Definition: test29.f:25
mmhcre
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
Definition: medmesh.f:20
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82