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