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 - 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 : 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 cret,fid, domdst
32 character*64 maa , jnt, maadst
33 character*200 des
34 integer mdim ,ncor
35 integer cor(6)
36 character*16 nomcoo(2)
37 character*16 unicoo(2)
38 data nomcoo /"x","y"/, unicoo /"cm","cm"/
39
40 parameter(maa ="maa1",maadst="maa2", domdst=2,
41 & mdim = 2,ncor = 3 )
42 data cor /1,2,3,4,5,6/, jnt / "joint"/
43 data des / "joint avec le sous-domaine 2" /
44
45
46
47 C ** Creation du fichier test29.med **
48 call mfiope(fid,'test29.med',med_acc_rdwr,cret)
49 print *,cret
50 if (cret .ne. 0 ) then
51 print *,'Erreur creation du fichier'
52 call efexit(-1)
53 endif
54
55
56 C ** Creation du maillage **
57 call mmhcre(fid,maa,mdim,mdim,
58 & med_unstructured_mesh,'Un maillage pour test29',
59 & "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
60 print *,cret
61 if (cret .ne. 0 ) then
62 print *,'Erreur creation du maillage'
63 call efexit(-1)
64 endif
65
66 C ** Creation du joint **
67 call msdjcr(fid,maa,jnt,des,domdst,maadst,cret)
68 print *,cret
69 if (cret .ne. 0 ) then
70 print *,'Erreur creation joint'
71 call efexit(-1)
72 endif
73
74
75 C ** Ecriture de la correspondance Noeud, Noeud **
76 call msdcrw(fid,maa,jnt,med_no_dt,med_no_it,
77 & med_node,med_none,med_node,med_none,
78 & ncor,cor,cret)
79 print *,cret
80 if (cret .ne. 0 ) then
81 print *,'Erreur ecriture correspondance (Noeud,Noeud)'
82 call efexit(-1)
83 endif
84
85
86 C ** Ecriture de la correspondance Noeud, TRIA3 **
87 call msdcrw(fid,maa,jnt,med_no_dt,med_no_it,
88 & med_node,med_none,med_cell,med_tria3,
89 & ncor,cor,cret)
90 print *,cret
91 if (cret .ne. 0 ) then
92 print *,'Erreur ecriture correspondance (Noeud,Tria3)'
93 call efexit(-1)
94 endif
95
96 C ** Fermeture du fichier **
97 call mficlo(fid,cret)
98 print *,cret
99 if (cret .ne. 0 ) then
100 print *,'Erreur fermeture du fichier'
101 call efexit(-1)
102 endif
103 C
104 end
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
test29
program test29
Definition: test29.f:25
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:50
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:41