C===========================================================================
C Copyright (C) 1995-2005 European Southern Observatory (ESO)
C
C This program is free software; you can redistribute it and/or 
C modify it under the terms of the GNU General Public License as 
C published by the Free Software Foundation; either version 2 of 
C the License, or (at your option) any later version.
C
C This program is distributed in the hope that it will be useful,
C but WITHOUT ANY WARRANTY; without even the implied warranty of
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C GNU General Public License for more details.
C
C You should have received a copy of the GNU General Public 
C License along with this program; if not, write to the Free 
C Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
C MA 02139, USA.
C
C Correspondence concerning ESO-MIDAS should be addressed as follows:
C	Internet e-mail: midas@eso.org
C	Postal address: European Southern Observatory
C			Data Management Division 
C			Karl-Schwarzschild-Strasse 2
C			D 85748 Garching bei Muenchen 
C			GERMANY
C===========================================================================
C
C++++++++++++++++
C.IDENTIFICATION for_try.f
C.LANGUAGE       F77
C.AUTHOR         K. Banse
C.ENVIRONMENT    Any
C.KEYWORDS       FOR to C
C.PURPOSE        Check Fortran to C interface
C.COMMENTS       
C.VERSION  1.0   16-Oct-1990
C 
C 050725	last modif
C 
C 
C this is an extended version of the for_test.for program, to be used
C with ftoc_stack.fc
C to get a look at the stack
C 
C----------------
C 
      CHARACTER*79  s1
      CHARACTER*161 s2
      CHARACTER*4   s3
      CHARACTER*6   s4
      CHARACTER*2   s5
      CHARACTER*23  s6
      CHARACTER*40  st1, st2, st3
C 
      INTEGER    ls1, ls2, ls3, ls4, ls5, ls6
C 
      s1 = 'sY<01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ>'
      s2 = 's2<abcdefghijklmnopqrstuvwxyz01234567890>XYZ'
      s3 = 's3.X'
      st1 = 'where does this string go? '
      s4 = 'sKlaus'
      st2 = 'filling up space... '
      st3 = '&now, occupying 40 characters over here&& '
      s5 = 'sS'
      s6 = 's[1234567890]AB'
C 
      ls1 = 79
      ls2 = 161
      ls3 = 4
      ls4 = 6
      ls5 = 2
      ls6 = 23
C 
      WRITE(*,998)
C 
CC      WRITE(*,1000) s5,ls5
CC      CALL SSS(s5)
CC      WRITE(*,997)
CC      WRITE(*,1000) s2,ls2
CC      CALL SSS(s2)
      WRITE(*,997)
C 
CC      WRITE(*,1400) s5,ls5,s3,ls3
CC      CALL SSU(s5,s3)
CC      WRITE(*,997)
CC      WRITE(*,1400) s6,ls6,s1,ls1
CC      CALL SSU(s6,s1)
CC      WRITE(*,997)
C 
CC      WRITE(*,1700) s5,ls5,s3,ls3,s4,ls4
CC      CALL SST(s5,s3,s4)
CC      WRITE(*,997)
CC      WRITE(*,1700) s6,ls6,s1,ls1,s2,ls2
CC      CALL SST(s6,s1,s2)
CC      WRITE(*,997)
C 
CC      WRITE(*,1500) -7543,s2,ls2,s4,ls4,s1,ls1
CC      CALL SSW(s2,s4,-7543,s1)
CC      WRITE(*,997)
CC      WRITE(*,1500) 3255,s6,ls6,s3,ls3,s5,ls5
CC      CALL SSW(s6,s3,3255,s5)
CC      WRITE(*,997)
C 
      WRITE(*,2100) 99123
      CALL SSA(99123)
      WRITE(*,997)
C 
      WRITE(*,2200) 8855,-12
      CALL SSB(8855,-12)
      WRITE(*,997)
C 
      WRITE(*,2300) 1000,2000,3000
      CALL SSC(1000,2000,3000)
      WRITE(*,997)
C 
      WRITE(*,1100) -99,101,7788,-4455
      CALL SSD(-99,101,7788,-4455)
      WRITE(*,997)
C 
      WRITE(*,2400) -1,2,-3,4,-5
      CALL SSE(-1,2,-3,4,-5)
      WRITE(*,997)
C 
      WRITE(*,2500) 66,-1,77,0,222,1009
      CALL SSF(66,-1,77,0,222,1009)
      WRITE(*,997)
C 
      WRITE(*,1800) -99,101,7788,-4455,22,33,44
      CALL SSX(-99,101,7788,-4455,22,33,44)
      WRITE(*,997)
C 
      WRITE(*,2800) -9,-8,-7,-6,123,0,125,-8467
      CALL SSG(-9,-8,-7,-6,123,0,125,-8467)
      WRITE(*,997)
C 
      WRITE(*,2900) 1,2,3,22000,-1,66123,99,-12,333
      CALL SSH(1,2,3,22000,-1,66123,99,-12,333)
      WRITE(*,997)
C 
      WRITE(*,2100) -5432
      CALL SSA(-5432)
      WRITE(*,997)
C 
      WRITE(*,2200) -55,-7689
      CALL SSB(-55,-7689)
      WRITE(*,997)
C 
      WRITE(*,2300) 200,-200,5500
      CALL SSC(200,-200,5500)
      WRITE(*,997)
C 
      WRITE(*,1100) 12345,-33,56789,-1001
      CALL SSD(12345,-33,56789,-1001)
      WRITE(*,997)
C 
      WRITE(*,2400) 10,20,-30,-40,50
      CALL SSE(10,20,-30,-40,50)
      WRITE(*,997)
C 
      WRITE(*,2500) -4,-40,-400,50,55,0
      CALL SSF(-4,-40,-400,50,55,0)
      WRITE(*,997)
C 
      WRITE(*,1800) 1223377,0,-9876,41,270,2847,-5
      CALL SSX(1223377,0,-9876,41,270,2847,-5)
      WRITE(*,997)
C 
      WRITE(*,2800) 10,20,30,-22,-33,-44,0,12546
      CALL SSG(10,20,30,-22,-33,-44,0,12546)
      WRITE(*,997)
C 
      WRITE(*,2900) 12,0,-99,-123,11,22,432,555,6666
      CALL SSH(12,0,-99,-123,11,22,432,555,6666)
      WRITE(*,997)
C 
      WRITE(*,2910) 12,0,-99,-123,11,22,10,-4,10,889977,20
      CALL SSI(12,0,-99,-123,11,22,10,-4,10,889977,20)
      WRITE(*,997)
C 
      WRITE(*,1200) -71,-2,33,s1,ls1,s2,ls2,s3,ls3
      CALL SSP(s1,-71,s2,-2,33,s3)
      WRITE(*,997)
      WRITE(*,1200) -171,-102,133,s3,ls3,s2,ls2,s4,ls4
      CALL SSP(s3,-171,s2,-102,133,s4)
      WRITE(*,997)
C 
CC      WRITE(*,1600) -98765,77543,s4,ls4,s1,ls1
CC      CALL SSV(-98765,s4,77543,s1)
CC      WRITE(*,997)
CC      WRITE(*,1600) 0,-66544,s3,ls3,s2,ls2
CC      CALL SSV(0,s3,-66544,s2)
CC      WRITE(*,997)
C 
CC      WRITE(*,1300) 12345,202,s4,ls4
CC      CALL SSQ(12345,s4,202)
CC      WRITE(*,997)
CC      WRITE(*,1300) -333,444,s1,ls1
CC      CALL SSQ(-333,s1,444)
CC      WRITE(*,997)
C 
997   FORMAT('================================================'//)
998   FORMAT(/'F77 program: for_try.for  to test the F77',
     +       ' -> C parameter passing '/)
999   FORMAT('1 ')
1000  FORMAT('calling SSS(str1), str1 = ',A,' : F77 length = ',I4)
1100  FORMAT('calling SSD(n1,n2,n3,n4), n1,n2,n3,n4 = ',4I8)
2100  FORMAT('calling SSA(n1), n1 = ',I8)
2200  FORMAT('calling SSB(n1,n2), n1,n2 = ',2I8)
2300  FORMAT('calling SSC(n1,n2,n3), n1,n2,n3 = ',3I8)
2400  FORMAT('calling SSE(n1,n2,n3,n4,n5), n1,n2,n3,n4,n5 = '/5I8)
2500  FORMAT('calling SSF(n1,n2,n3,n4,n5,n6), n1,n2,n3,n4,n5,n6 = '/6I8)
2800  FORMAT('calling SSG(n1,n2,n3,n4,n5,n6,n7,n8), n1,...,n8 = '/8I8)
2900  FORMAT('calling SSH(n1,...,n9), n1,...,n9 = '/9I8)
2910  FORMAT('calling SSI(n1,...,n11), n1,...,n11 = '/11I7)
1200  FORMAT('calling SSP(str1,n1,str2,n2,n3,str3), n1,n2,n3 = ',3I8/
     +       'str1 = ',A,': F77 length = ',I4/
     +       'str2 = ',A,': F77 length = ',I4/
     +       'str3 = ',A,': F77 length = ',I4)
1300  FORMAT('calling SSQ(n1,str1,n2), n1, n2 = ',2I8/
     +       'str1 = ',A,': F77 length = ',I4)
1400  FORMAT('calling SSU(str1,str2)'/
     +       'str1 = ',A,': F77 length = ',I4/
     +       'str2 = ',A,': F77 length = ',I4)
1500  FORMAT('calling SSW(str1,str2,n1,str3), n1 = ',I8/
     +       'str1 = ',A,': F77 length = ',I4/
     +       'str2 = ',A,': F77 length = ',I4/
     +       'str3 = ',A,': F77 length = ',I4)
1600  FORMAT('calling SSV(n1,str1,n2,str2), n1, n2 = ',2I8/
     +       'str1 = ',A,': F77 length = ',I4/
     +       'str2 = ',A,': F77 length = ',I4)
1700  FORMAT('calling SST(str1,str2,str3)'/
     +       'str1 = ',A,': F77 length = ',I4/
     +       'str2 = ',A,': F77 length = ',I4/
     +       'str3 = ',A,': F77 length = ',I4)
1800  FORMAT('calling SSX(n1,n2,n3,n4,n5,n6,n7), n1,...,n7 = '/7I8)
C 
      STOP
      END
