MED fichier
Unittest_MEDlocalization_2.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
18C******************************************************************************
19C * Tests for localization module
20C *
21C *****************************************************************************
22 program medloc2
23C
24 implicit none
25 include 'med.hf'
26C
27C
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)
52C
53C
54C 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
61C
62C
63C 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
86C
87C
88C 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
96c
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
106c
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
116c
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
123C
124C
125C 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
132C
133C
134C
135 end
136
program medloc2
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mlclni(fid, lname, gtype, sdim, nip, giname, isname, nsmc, sgtype, cret)
subroutine mlclor(fid, lname, swm, ecoo, ipcoo, wght, cret)