MED fichier
Unittest_MEDlocalization_2.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2020 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 localization module
20 C *
21 C *****************************************************************************
22  program medloc2
23 C
24  implicit none
25  include 'med.hf'
26 C
27 C
28  integer cret
29  integer*8 fid
30 
31  character*64 fname,lname1,giname1,isname1
32  character*64 giname,isname
33  parameter(fname="Unittest_MEDlocalization_1.med")
34  parameter(lname1 = "Localization name")
35  parameter(giname1=med_no_interpolation)
36  parameter(isname1=med_no_mesh_support)
37  integer gtype1,sdim1,nip1
38  integer gtype,sdim,nip
39  parameter(gtype1=med_tria3)
40  parameter(sdim1=2)
41  parameter(nip1=3)
42  real*8 ecoo1(6), ipcoo1(6), wght1(3)
43  real*8 ecoo(6), ipcoo(6), wght(3)
44  data ecoo1 / 0.0, 0.0, 1.0, 0.0, 0.0,1.0 /
45  data ipcoo1 / 0.166666, 0.166666, 0.66666, 0.166666,
46  & 0.166666, 0.666666 /
47  data wght1 / 0.166666, 0.166666, 0.166666 /
48  integer nsmc, nsmc1
49  parameter(nsmc1=0)
50  integer sgtype,sgtype1
51  parameter(sgtype1=med_undef_geotype)
52 C
53 C
54 C open file
55  call mfiope(fid,fname,med_acc_rdonly,cret)
56  print *,cret
57  if (cret .ne. 0 ) then
58  print *,'ERROR : open file'
59  call efexit(-1)
60  endif
61 C
62 C
63 C read information
64  call mlclni(fid, lname1, gtype, sdim, nip,
65  & giname, isname, nsmc, sgtype, cret)
66  print *,cret
67  if (cret .ne. 0 ) then
68  print *,'ERROR : read information'
69  call efexit(-1)
70  endif
71  if ((gtype .ne. gtype1) .or.
72  & (sdim .ne. sdim1) .or.
73  & (nip .ne. nip1) .or.
74  & (giname .ne. giname1) .or.
75  & (isname .ne. isname1) .or.
76  & (nsmc .ne. nsmc1) .or.
77  & (sgtype .ne. sgtype1) ) then
78  print *,cret
79  print *,gtype1,sdim1,nip1,"|",giname1,"|","|",
80  & isname1,"|",nsmc1,sgtype1
81  print *,gtype,sdim,nip,"|",giname,"|","|",isname,"|",
82  & nsmc,sgtype
83  print *,'ERROR : read information'
84  call efexit(-1)
85  endif
86 C
87 C
88 C read localization
89  call mlclor(fid,lname1,med_full_interlace,
90  & ecoo,ipcoo,wght,cret)
91  print *,cret
92  if (cret .ne. 0 ) then
93  print *,'ERROR : read localization'
94  call efexit(-1)
95  endif
96 c
97  if ((ecoo(1) .ne. ecoo1(1)) .or.
98  & (ecoo(2) .ne. ecoo1(2)) .or.
99  & (ecoo(3) .ne. ecoo1(3)) .or.
100  & (ecoo(4) .ne. ecoo1(4)) .or.
101  & (ecoo(5) .ne. ecoo1(5)) .or.
102  & (ecoo(6) .ne. ecoo1(6))) then
103  print *,'ERROR : read localization'
104  call efexit(-1)
105  endif
106 c
107  if ((ipcoo(1) .ne. ipcoo1(1)) .or.
108  & (ipcoo(2) .ne. ipcoo1(2)) .or.
109  & (ipcoo(3) .ne. ipcoo1(3)) .or.
110  & (ipcoo(4) .ne. ipcoo1(4)) .or.
111  & (ipcoo(5) .ne. ipcoo1(5)) .or.
112  & (ipcoo(6) .ne. ipcoo1(6))) then
113  print *,'ERROR : read localization'
114  call efexit(-1)
115  endif
116 c
117  if ((wght(1) .ne. wght1(1)) .or.
118  & (wght(2) .ne. wght1(2)) .or.
119  & (wght(3) .ne. wght1(3))) then
120  print *,'ERROR : read localization'
121  call efexit(-1)
122  endif
123 C
124 C
125 C close file
126  call mficlo(fid,cret)
127  print *,cret
128  if (cret .ne. 0 ) then
129  print *,'ERROR : close file'
130  call efexit(-1)
131  endif
132 C
133 C
134 C
135  end
136 
program medloc2
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 mlclni(fid, lname, gtype, sdim, nip, giname, isname, nsmc, sgtype, cret)
Cette routine permet d'obtenir la description d'une localisation de points d'intégration nommée local...
subroutine mlclor(fid, lname, swm, ecoo, ipcoo, wght, cret)