MED fichier
Unittest_MEDstructElement_7.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 * Tests for struct element module
20 C *
21 C *****************************************************************************
23 C
24  implicit none
25  include 'med.hf'
26 C
27 C
28  integer cret
29  integer fid
30  character*64 fname
31  parameter(fname = "Unittest_MEDstructElement_7.med")
32  character*64 mname2
33  parameter(mname2 = "model name 2")
34  integer dim2
35  parameter(dim2=2)
36  character*64 smname2
37  parameter(smname2="support mesh name")
38  integer setype2
39  parameter(setype2=med_node)
40  integer sgtype2
41  parameter(sgtype2=med_no_geotype)
42  integer mtype2
43  integer sdim1
44  parameter(sdim1=2)
45  character*200 description1
46  parameter(description1="support mesh1 description")
47  character*16 nomcoo2D(2)
48  character*16 unicoo2D(2)
49  data nomcoo2d /"x","y"/, unicoo2d /"cm","cm"/
50  real*8 coo(2*3)
51  data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
52  integer nnode
53  parameter(nnode=3)
54  integer nseg2
55  parameter(nseg2=2)
56  integer seg2(4)
57  data seg2 /1,2, 2,3/
58  character*64 aname1, aname2, aname3
59  parameter(aname1="integer constant attribute name")
60  parameter(aname2="real constant attribute name")
61  parameter(aname3="string constant attribute name")
62  integer atype1,atype2,atype3
63  parameter(atype1=med_att_int)
64  parameter(atype2=med_att_float64)
65  parameter(atype3=med_att_name)
66  integer anc1,anc2,anc3
67  parameter(anc1=2)
68  parameter(anc2=1)
69  parameter(anc3=1)
70  integer aval1(2*2)
71  data aval1 /1,2,5,6/
72  real*8 aval2(2*1)
73  data aval2 /1., 3. /
74  character*64 aval3(2*1)
75  data aval3 /"VAL1","VAL3"/
76  character*64 pname
77  parameter(pname="profil name")
78  integer psize
79  parameter(psize=2)
80  integer profil(2)
81  data profil / 1,3 /
82 C
83 C
84 C file creation
85  call mfiope(fid,fname,med_acc_creat,cret)
86  print *,'Open file',cret
87  if (cret .ne. 0 ) then
88  print *,'ERROR : file creation'
89  call efexit(-1)
90  endif
91 C
92 C
93 C support mesh creation : 2D
94  call msmcre(fid,smname2,dim2,dim2,description1,
95  & med_cartesian,nomcoo2d,unicoo2d,cret)
96  print *,'Support mesh creation : 2D space dimension',cret
97  if (cret .ne. 0 ) then
98  print *,'ERROR : support mesh creation'
99  call efexit(-1)
100  endif
101 c
102  call mmhcow(fid,smname2,med_no_dt,med_no_it,
103  & med_undef_dt,med_full_interlace,
104  & nnode,coo,cret)
105 c
106  call mmhcyw(fid,smname2,med_no_dt,med_no_it,
107  & med_undef_dt,med_cell,med_seg2,
108  & med_nodal,med_full_interlace,
109  & nseg2,seg2,cret)
110 C
111 C struct element creation
112 C
113  call msecre(fid,mname2,dim2,smname2,setype2,
114  & sgtype2,mtype2,cret)
115  print *,'Create struct element',mtype2, cret
116  if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
117  print *,'ERROR : struct element creation'
118  call efexit(-1)
119  endif
120 C
121 C write profile
122 C
123  call mpfprw(fid,pname,psize,profil,cret)
124  print *,'Create a profile : ',pname, cret
125  if (cret .ne. 0) then
126  print *,'ERROR : profile creation'
127  call efexit(-1)
128  endif
129 C
130 C write constant attributes with profiles
131 C
132  call mseipw(fid,mname2,aname1,atype1,anc1,
133  & setype2,pname,aval1,cret)
134  print *,'Create a constant attribute with profile : ',aname1, cret
135  if (cret .ne. 0) then
136  print *,'ERROR : constant attribute with profile creation'
137  call efexit(-1)
138  endif
139 c
140  call mserpw(fid,mname2,aname2,atype2,anc2,
141  & setype2,pname,aval2,cret)
142  print *,'Create a constant attribute with profile : ',aname2, cret
143  if (cret .ne. 0) then
144  print *,'ERROR : constant attribute with profile creation'
145  call efexit(-1)
146  endif
147 c
148  call msespw(fid,mname2,aname3,atype3,anc3,
149  & setype2,pname,aval3,cret)
150  print *,'Create a constant attribute with profile : ',aname3, cret
151  if (cret .ne. 0) then
152  print *,'ERROR : constant attribute with profile creation'
153  call efexit(-1)
154  endif
155 C
156 C
157 C close file
158  call mficlo(fid,cret)
159  print *,'Close file',cret
160  if (cret .ne. 0 ) then
161  print *,'ERROR : close file'
162  call efexit(-1)
163  endif
164 C
165 C
166 C
167  end
168 
subroutine mpfprw(fid, pname, psize, profil, cret)
Cette routine permet d'écrire un profil dans un fichier MED.
Definition: medprofile.f:21
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
Cette routine permet de créer un maillage support.
Definition: medsupport.f:20
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, cret)
Cette routine permet de créer un nouveau modèle d'éléments de structure dans un fichier MED...
subroutine msespw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure...
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
subroutine mseipw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure...
subroutine mserpw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure...
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Cette routine permet d'écrire dans un maillage le tableau des connectivités pour un type géométrique ...
Definition: medmesh.f:551
program medstructelement7
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Cette routine permet d'écrire dans un maillage le tableau des coordonnées des noeuds, selon une séquence de calcul donnée.
Definition: medmesh.f:285