MED fichier
test12.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18
19C ******************************************************************************
20C * - Nom du fichier : test12.f
21C *
22C * - Description : ecriture d'une equivalence dans un maillage MED
23C *
24C ******************************************************************************
25 program test12
26C
27 implicit none
28 include 'med.hf'
29C
30C
31 integer*8 fid
32 integer cret
33 character*64 maa , equ
34 character*200 des
35 integer mdim ,ncor, sdim
36 integer cor(6)
37 character*16 nomcoo(3)
38 character*16 unicoo(3)
39
40 parameter(maa ="maa1",mdim = 3,ncor = 3 , sdim=3)
41 data cor /1,2,3,4,5,6/, equ / "equivalence"/
42 data des / "equivalence sur les mailles MED_TRIA3" /
43 data nomcoo /"x","y","z"/, unicoo /"cm","cm","cm"/
44
45
46C ** Creation du fichier test12.med **
47 call mfiope(fid,'test12.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
55C ** Creation du maillage **
56 call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
57 & 'Un maillage pour test12',"",
58 & med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
59 print *,cret
60 if (cret .ne. 0 ) then
61 print *,'Erreur creation du maillage'
62 call efexit(-1)
63 endif
64
65C ** Creation de l'equivalence **
66 call meqcre(fid,maa,equ,des,cret)
67 print *,cret
68 if (cret .ne. 0 ) then
69 print *,'Erreur creation equivalence'
70 call efexit(-1)
71 endif
72
73C ** Ecriture des correspondances sur les mailles MED_TRIA3 **
74 call meqcow(fid,maa,equ,med_no_dt,med_no_it,med_cell,
75 & med_tria3,ncor,cor,cret)
76 print *,cret
77 if (cret .ne. 0 ) then
78 print *,'Erreur ecriture de correspondances'
79 call efexit(-1)
80 endif
81
82C ** Fermeture du fichier **
83 call mficlo(fid,cret)
84 print *,cret
85 if (cret .ne. 0 ) then
86 print *,'Erreur fermeture du fichier'
87 call efexit(-1)
88 endif
89C
90 end
subroutine meqcre(fid, maa, eq, des, cret)
Cette routine permet la création d'une équivalence portant sur les entités d'un maillage.
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition medfile.f:82
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
subroutine meqcow(fid, maa, eq, numdt, numit, typent, typgeo, n, corr, cret)
program test12
Definition test12.f:25