MED fichier: Fichier source de test8.f

MED fichier

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

test8.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 C ******************************************************************************
19 C * - Nom du fichier : test8.f
20 C *
21 C * - Description : exemple d'ecriture des familles d'un maillage MED
22 C *
23 C *****************************************************************************
24 program test8
25 C
26 implicit none
27 include 'med.hf'
28 C
29 integer cret, fid
30
31 character*64 maa
32 integer mdim, sdim
33 character*64 nomfam
34 integer numfam
35 integer ngro
36 character*80 gro
37 integer nfamn
38 character*16 str
39 character*16 nomcoo(2)
40 character*16 unicoo(2)
41
42 parameter( mdim = 2, nfamn = 2 , sdim = 2)
43 data maa /"maa1"/
44 data nomcoo /"x","y"/, unicoo /"cm","cm"/
45
46 C ** Creation du fichier test8.med **
47 call mfiope(fid,'test8.med',med_acc_rdwr, cret)
48 print *,cret
49 if (cret .ne. 0 ) then
50 print *,'Erreur creation du fichier'
51 call efexit(-1)
52 endif
53
54 C ** Creation du maillage maa de dimension 2 **
55 call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
56 & 'un maillage pour test8',"",med_sort_dtit,
57 & 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 ** Ecriture des familles **
65 C * Conventions :
66 C - Toujours creer une famille de numero 0 ne comportant aucun attribut
67 C ni groupe (famille de reference pour les noeuds ou les elements
68 C qui ne sont rattaches a aucun groupe ni attribut)
69 C - Les numeros de familles de noeuds sont > 0
70 C - Les numeros de familles des elements sont < 0
71 C - Rien d'imposer sur les noms de familles
72 C ** **
73
74 C * Creation de la famille 0 **
75 numfam = 0
76 nomfam="FAMILLE_0"
77 ngro = 0
78 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
79 print *,cret
80 if (cret .ne. 0 ) then
81 print *,'Erreur creation de la famille 0'
82 call efexit(-1)
83 endif
84
85 C * Creation pour correspondre aux cas tests precedents, 3 familles *
86 C * d'elements (-1,-2,-3) et deux familles de noeuds (1,2) *
87 do numfam=-1,-3,-1
88 write(str,'(I1.0)') (-numfam)
89 nomfam = "FAMILLE_ELEMENT_"//str
90 gro="groupe1"
91 ngro = 1
92 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
93 print *,cret
94 if (cret .ne. 0 ) then
95 print *,'Erreur creation de famille'
96 call efexit(-1)
97 endif
98 end do
99
100 do numfam=1,nfamn
101 write(str,'(I1.0)') numfam
102 nomfam = "FAMILLE_NOEUD_"//str
103 gro="groupe1"
104 ngro = 1
105 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
106 print *,cret
107 if (cret .ne. 0 ) then
108 print *,'Erreur creation de famille'
109 call efexit(-1)
110 endif
111 end do
112
113
114 C * Fermeture du fichier *
115 call mficlo(fid,cret)
116 print *,cret
117 if (cret .ne. 0 ) then
118 print *,'Erreur fermeture du fichier'
119 call efexit(-1)
120 endif
121 C
122 end
123
124
125
126
127
128
mfacre
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
Cette routine permet la création d'une famille portant sur les entités d'un maillage.
Definition: medfamily.f:19
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
test8
program test8
Definition: test8.f:24
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41