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)
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)