← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to test/prim/kcompare.prg

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/prim/kcompare.prg
 
1
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
2
!
 
3
!  MIDAS procedure kcompare.prg
 
4
!  K. Banse     920910, 980526, 090717, 100319, 110427
 
5
!
 
6
!  use as @@ kcompare labref:keyref keynew indexa,indexb eps
 
7
!      or             keyref keynew indexa,indexb eps
 
8
!  with   labref: = optional reference label displayed for failed checks
 
9
!         keyref = name of reference keyword
 
10
!         keynew = name of new keyword
 
11
!         indexa,indexb = start + end index for comparison
 
12
!  and following params only for real/double keywords
 
13
!         eps = epsilon for difference from indexa-b
 
14
!         indexc,indexd = start + end index for comparison
 
15
!         eps = epsilon for difference from indexc-d
 
16
!         indexe,indexf = start + end index for comparison
 
17
!         eps = epsilon for difference from indexe-f
 
18
! 
 
19
!  we use he global integer keyword errsum to pass error info 
 
20
!  back to the calling procedure, i.e. keyw. errsum must exist!
 
21
!
 
22
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
23
!
 
24
define/par p1 ? ? "Enter labref:refkey "
 
25
define/par p2 ? ? "Enter newkey: "
 
26
define/par p3 1,1 n "Enter indexa,indexb: "
 
27
define/par p4 0. n "Enter epsilon for difference check: "
 
28
!
 
29
define/local myp5/c/1/20 {p5}           !optional 2nd interval
 
30
define/local myp7/c/1/20 {p7}           !optional 3rd interval
 
31
define/local mypara/c/1/20 {p3}
 
32
define/local myparb/c/1/20 {p4}
 
33
define/local loopi/i/1/3 0 all +lower
 
34
define/local failindx/i/1/1 0 ? +lower          !index of 1st difference
 
35
define/local labref/c/1/20 "? " ? +lower
 
36
! 
 
37
define/local ktype/i/1/1 0 
 
38
define/local idif/i/1/1 0 
 
39
define/local rdif/d/1/1 0.
 
40
define/local reps/r/1/1 0.
 
41
define/local ddif/d/1/1 0.
 
42
define/local deps/d/1/1 0.
 
43
define/local idx/i/1/1 0 
 
44
! 
 
45
idx = m$index(p1,":") 
 
46
if idx .gt. 1 then
 
47
   idx = idx - 1
 
48
   labref(1:) = "["//p1(1:{idx})//"]  "
 
49
   idx = idx + 2
 
50
   p1(1:) = p1({idx}:)
 
51
endif
 
52
! 
 
53
info/keyw {p1}
 
54
ktype = mid$info(1)                     !save keytype
 
55
if ktype .eq. 0 .or. ktype .eq. 3 then
 
56
   write/out invalid keyword {p1}, or invalid type ...
 
57
   errsum = errsum+1
 
58
   return
 
59
endif
 
60
! 
 
61
again:
 
62
write/keyw loopi/i/1/3 0,{mypara} 
 
63
! 
 
64
if ktype .eq. 1 then
 
65
   ! 
 
66
   do loopi = {loopi(2)} {loopi(3)}
 
67
      idif = m$abs({p1}({loopi}) - {p2}({loopi}))
 
68
      if idif .gt. 0 then
 
69
         if failindx .eq. 0 failindx = loopi
 
70
      endif
 
71
   enddo
 
72
   !
 
73
! 
 
74
else if ktype .eq. 2 then
 
75
   reps = {myparb}
 
76
   ! 
 
77
   do loopi = {loopi(2)} {loopi(3)}
 
78
      rdif = m$abs({p1}({loopi}) - {p2}({loopi}))
 
79
      if rdif .gt. reps then
 
80
         if failindx .eq. 0 failindx = loopi
 
81
      endif
 
82
   enddo
 
83
   ! 
 
84
else 
 
85
   deps = {myparb}
 
86
   ! 
 
87
   do loopi = {loopi(2)} {loopi(3)}
 
88
      ddif = m$abs({p1}({loopi}) - {p2}({loopi}))
 
89
      if ddif .gt. deps then
 
90
         if failindx .eq. 0 failindx = loopi
 
91
      endif
 
92
   enddo
 
93
   ! 
 
94
endif
 
95
if failindx .ne. 0 then
 
96
   @@ kcompare,out {p1} {p2} 
 
97
   return
 
98
endif
 
99
if myp5(1:1) .ne. "?" then
 
100
   write/keyw mypara/c/1/20 {p5}
 
101
   write/keyw myparb/c/1/20 {p6}
 
102
   failindx = 0
 
103
   myp5(1:2) = "? "
 
104
   goto again
 
105
endif
 
106
if myp7(1:1) .ne. "?" then
 
107
   write/keyw mypara/c/1/20 {p7}
 
108
   write/keyw myparb/c/1/20 {p8}
 
109
   failindx = 0
 
110
   myp7(1:2) = "? "
 
111
   goto again
 
112
endif
 
113
! 
 
114
entry out
 
115
set/format j2 g15.10
 
116
write/out
 
117
if labref(1:1) .eq. "?" then
 
118
   write/out "     reference:         new:     "
 
119
else
 
120
   write/out "     reference:         new:         label: " {labref}
 
121
endif
 
122
do loopi = {loopi(2)} {loopi(3)}
 
123
   if loopi .eq. failindx then
 
124
      write/out ({loopi}) {{p1}({loopi})} " *** " {{p2}({loopi})}
 
125
   else
 
126
      write/out ({loopi}) {{p1}({loopi})} "     " {{p2}({loopi})}
 
127
   endif
 
128
enddo
 
129
errsum = errsum+1
 
130