%begin
%owninteger failures=0

%routine pass
  printstring(" -- Pass"); newline
%end
%routine fail
  printstring(" -- FAIL"); newline
  failures = failures+1
%end

%own%integer one=1, two=2, three=3, four=4, dump

%routine SINGLE
%own%integer%array one10(1:10) =
 1,2,3,4,5,6,7,8,9,10
%own%integer%array two11(1:11) =
 2,4,6,8,10,12,14,16,18,20,22
%owninteger j=10
%integer%array three10(1:j)
!%integer%array%name an10(1:10)
!%integer%array%name anstar(1:*)
%integer%array%name an

  three10(j) = j*3 %for j = 1,1,10

!%routine r10(%integer%array%name a(1:10),%integer k)
!%integer i,j;j=0
!  %for i = 1,1,10 %cycle
!    j = 1 %if a(i) # i*k
!  %repeat
!  %if j = 0 %then pass %else fail
!%end
!%routine rstar(%integer%array%name a(1:*),%integer k,l)
!%integer i,j;j=0
!  %for i = 1,1,l %cycle
!    j = 1 %if a(i) # i*k
!  %repeat
!  %if j = 0 %then pass %else fail
!%end
!%routine rv(%integer%array%name a(%integer m:%integer l),%integer k)
!%integer i,j=0
!  %for i = m,1,l %cycle
!    j = 1 %if a(i) # i*k
!  %repeat
!  %if j = 0 %then pass %else fail
!%end
!  printstring("r10(one10,1)"); r10(one10,1)

!  printstring("rstar(one10,1,10)"); rstar(one10,1,10)
!  printstring("rstar(two11,2,11)"); rstar(two11,2,11)
!  printstring("rstar(three10,3,10)"); rstar(three10,3,10)

!  printstring("rv(one10,1)"); rv(one10,1)
!  printstring("rv(two11,2)"); rv(two11,2)
!  printstring("rv(three10,3)"); rv(three10,3)

!  printstring("an10 == one10; r10(an10,1)")
!  an10 == one10; r10(an10,1)

!  printstring("an10 == one10; rstar(an10,1,10)")
!  an10 == one10; rstar(an10,1,10)
!  printstring("anstar == one10; rstar(anstar,1,10)")
!  anstar == one10; rstar(anstar,1,10)
!  printstring("anstar == two11; rstar(anstar,2,11)")
!  anstar == two11; rstar(anstar,2,11)
!  printstring("anstar == three10; rstar(anstar,3,10)")
!  anstar == three10; rstar(anstar,3,10)

!  printstring("an10 == one10; rv(an10,1)")
!  an10 == one10; rv(an10,1)
!  printstring("an == one10; rv(an,1)")
!  an == one10; rv(an,1)
!  printstring("an == two11; rv(an,2)")
!  an == two11; rv(an,2)
!  printstring("an == three10; rv(an,3)")
!  an == three10; rv(an,3)
%end                        {single}

%routine DOUBLE
%own%integer%array one10(1:10,-1:1) =
 1,101,201,2,102,202,3,103,203,4,104,204,
 5,105,205,6,106,206,7,107,207,8,108,208,
 9,109,209,10,110,210
%own%integer%array two11(1:11,-1:1) =
 2,102,202,4,104,204,6,106,206,8,108,208,
 10,110,210,12,112,212,14,114,214,16,116,216,
 18,118,218,20,120,220,22,122,222
%owninteger i,j,k=10
%integer%array three10(1:k,-1:1)
!%integer%array%name an10(1:10,-1:1)
!%integer%array%name anstar(1:*,-1:1)
!%integer%array(2)%name an
  %for i = 1,1,10 %cycle
    three10(i,j) = i*3+100+j*100 %for j = -1,1,1
  %repeat

!%routine r10(%integer%array%name a(1:10,-1:1),%integer k)
!%integer i,j,e;e=0
!  %for i = 1,1,10 %cycle
!    %for j = -1,1,1 %cycle
!      e = 1 %if a(i,j) # i*k+100+j*100
!    %repeat
!  %repeat
!  %if e = 0 %then pass %else fail
!%end
!%routine rstar(%integer%array%name a(1:*,-1:1),%integer k,l)
!%integer i,j,e;e=0
!  %for i = 1,1,l %cycle
!    %for j = -1,1,1 %cycle
!      e = 1 %if a(i,j) # i*k+100+j*100
!    %repeat
!  %repeat
!  %if e = 0 %then pass %else fail
!%end
!%routine rv(%integer%array%name a(1:%integer l,%short x:%byte y),%integer k)
!%integer i,j,e;e=0
!  %for i = 1,1,l %cycle
!    %for j = x,1,y %cycle
!      e = 1 %if a(i,j) # i*k+100+j*100
!    %repeat
!  %repeat
!  %if e = 0 %then pass %else fail
!%end
!  printstring("r10(one10,1)"); r10(one10,1)

!  printstring("rstar(one10,1,10)"); rstar(one10,1,10)
!  printstring("rstar(two11,2,11)"); rstar(two11,2,11)
!  printstring("rstar(three10,3,10)"); rstar(three10,3,10)

!  printstring("rv(one10,1)"); rv(one10,1)
!  printstring("rv(two11,2)"); rv(two11,2)
!  printstring("rv(three10,3)"); rv(three10,3)

!  printstring("an10 == one10; r10(an10,1)")
!  an10 == one10; r10(an10,1)

!  printstring("an10 == one10; rstar(an10,1,10)")
!  an10 == one10; rstar(an10,1,10)
!  printstring("anstar == one10; rstar(anstar,1,10)")
!  anstar == one10; rstar(anstar,1,10)
!  printstring("anstar == two11; rstar(anstar,2,11)")
!  anstar == two11; rstar(anstar,2,11)
!  printstring("anstar == three10; rstar(anstar,3,10)")
!  anstar == three10; rstar(anstar,3,10)

!  printstring("an10 == one10; rv(an10,1)")
!  an10 == one10; rv(an10,1)
!  printstring("an == one10; rv(an,1)")
!  an == one10; rv(an,1)
!  printstring("an == two11; rv(an,2)")
!  an == two11; rv(an,2)
!  printstring("an == three10; rv(an,3)")
!  an == three10; rv(an,3)
%end                        {double}

%routine STRINGSTAR
%string(3)%array sa(1:4)
%own%string(10)%array sb(1:4)="tom", "dick", "harry", "archibaldy"
  sa(1) = "ABC"; sa(2) = "DEF"; sa(3) = "GHI"; sa(4) = "JKL"
%routine try(%string(*)%array%name s,%integer j)
%integer i
  %for i = 1,1,4 %cycle
    %if j = 1 %start
      %if s(i) = sa(i) %then pass %else fail
    %else
      %if s(i) = sb(i) %then pass %else fail
    %finish
  %repeat
%end
  printstring("Stringstar 1")
  try(sa,1)
  printstring("Stringstar 2")
  try(sb,2)
%end
!  open output(1,"JOURNAL")
  single
  double
  stringstar
select output(0)
write(failures,1);  printstring(" failure(s)");  newline
%endofprogram