MED fichier

f/test29.f
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