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 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 mlclor(fid, lname, swm, ecoo, ipcoo, wght, cret)
Cette routine permet la lecture d'une localisation localizationname de points d'intégration dans/auto...
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 mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
program medloc2
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41