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 - 2023 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 
mlclor
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...
Definition: medlocalization.f:106
medloc2
program medloc2
Definition: Unittest_MEDlocalization_2.f:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mlclni
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...
Definition: medlocalization.f:85
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42