home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume20 / cfortran / part01 / cfortex.for < prev    next >
Encoding:
Text File  |  1991-06-26  |  4.3 KB  |  210 lines
  1. C cfortex.f
  2. C Burkhard Burow, University of Toronto, July 1990.
  3.  
  4.       subroutine s1(b)
  5.       character*(*) b
  6.       character*(13) a
  7.       data a/'first'/
  8.       b = a
  9.       return
  10.       end
  11.  
  12.       subroutine abc(a,b,c)
  13.       character*(*) b,a,c
  14.       character*(13) d
  15.       d = a
  16.       a = b
  17.       b = c
  18.       c = d
  19.       return
  20.       end
  21.  
  22.       subroutine forstr1(b)
  23.       character*(*) b
  24.       character*(13) a
  25.       character*(13) forstr
  26.       data a/'firs'/
  27.       b = forstr(a)
  28.       return
  29.       end
  30.  
  31.  
  32.       subroutine EASY(a,b)
  33.       a = b
  34.       return
  35.       end
  36.  
  37.       character*(*) function forstr(a)
  38.       character*(*) a
  39.       forstr = a
  40.       return
  41.       end
  42.  
  43.       function r(i)
  44.       r = i
  45.       return
  46.       end
  47.  
  48.       character*(*) function forstr2()
  49.       character*(13) a
  50.       data a/'first'/
  51.       forstr2 = a
  52.       return
  53.       end
  54.  
  55.       character*(*) function ft(v, w, a)
  56.       character *(*) v(4), w(4)
  57.       print*,'FT:len(v(1 or 2 or 3 or 4))  =',len(v(1))
  58.       print*,'FT:len(w(1 or 2 or 3))    =',len(w(1))
  59.       print*,'FT:a = ',a
  60.       print*,'FT:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
  61.       print*,'FT:w(1,2,3,4) =',w(1),',',w(2),',',w(3),',',w(4)
  62.       ft = v(1)
  63.       return
  64.       end
  65.  
  66.       subroutine st(v, w, a)
  67.       character *(*) v(4), w(4)
  68.       print*,'ST:len(v(1 or 2 or 3 or 4))  =',len(v(1))
  69.       print*,'ST:len(w(1 or 2 or 3))    =',len(w(1))
  70.       print*,'ST:a = ',a
  71.       print*,'ST:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
  72.       print*,'ST:w(1,2,3,4) =',w(1),',',w(2),',',w(3),',',w(4)
  73.       return
  74.       end
  75.  
  76.       subroutine rev(a)
  77.       integer a(2),t
  78.       t    = a(1)
  79.       a(1) = a(2)
  80.       a(2) = t
  81.       return
  82.       end
  83.  
  84.       integer function frev(a)
  85.       integer a(2)
  86.       frev = a(1)
  87.       a(1) = a(2)
  88.       a(2) = frev
  89.       return
  90.       end
  91.  
  92.       subroutine ffcb()
  93.       common /fcb/  v,w,x
  94.       character *(13) v, w(4), x(3,2)
  95.       print*,'FFCB:v =',v,'.'
  96.       print*,'FFCB:w(1,2,3,4) =',w(1),',',w(2),',',w(3),',',w(4),'.'
  97.       print*,'FFCB:x([1,2,3],1) =',x(1,1),',',x(2,1),',',x(3,1),'.'
  98.       print*,'FFCB:x([1,2,3],2) =',x(1,2),',',x(2,2),',',x(3,2),'.'
  99.       v      = 'fcb v'
  100.       w(1)   = 'fcb w(1)'
  101.       w(2)   = 'fcb w(2)'
  102.       w(3)   = 'fcb w(3)'
  103.       x(1,1) = 'fcb x(1,1)'
  104.       x(2,1) = 'fcb x(2,1)'
  105.       x(3,1) = 'fcb x(3,1)'
  106.       x(1,2) = 'fcb x(1,2)'
  107.       x(2,2) = 'fcb x(2,2)'
  108.       x(3,2) = 'fcb x(3,2)'
  109.       end
  110.  
  111.       subroutine feq()
  112.       parameter (kwbank=690)
  113.       common/gcbank/nzebra,gversn,zversn,ixstor,ixdiv,ixcons,fendq(16)
  114.      +             ,lmain,lr1,ws(kwbank)
  115.       dimension iq(2),q(2),lq(80),iws(2)
  116.       equivalence (q(1),iq(1),lq(9)),(lq(1),lmain) ,(iws(1),ws(1))
  117.       nzebra     = 1
  118.       gversn     = 2
  119.       zversn     = 3
  120.       ixstor     = 4
  121.       ixcons     = 5
  122.       fendq(16)  = 6
  123.       lmain      = 7
  124.       lr1        = 8
  125.       ws(kwbank) = 9
  126.       lq(9)      = 10
  127.       end
  128.  
  129.       subroutine fexist()
  130.       print*,'FEXIST: was called'
  131.       call exist()
  132.       return
  133.       end
  134.  
  135.       subroutine fa(i)
  136.       integer i
  137.       print*,'FA: integer argument =',i
  138.       call ca(i)
  139.       return
  140.       end
  141.  
  142.       subroutine fb(i)
  143.       integer i
  144.       print*,'FB: integer argument =',i
  145.       i = i*2
  146.       call cb(i)
  147.       return
  148.       end
  149.  
  150.       subroutine fc(b)
  151.       character*(*) b
  152.       print*,'FC: string argument =',b
  153.       call cc(b)
  154.       return
  155.       end
  156.  
  157.       subroutine fd(b)
  158.       character*(*) b
  159.       character*(13) a
  160.       data a/'birthday'/
  161.       b = a
  162.       call cd(b)
  163.       return
  164.       end
  165.  
  166.       subroutine fe(v)
  167.       character*(*) v(4)
  168.       print*,'FE:len(v(1 or 2 or 3 or 4))  =',len(v(1))
  169.       print*,'FE:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
  170.       call ce(v)
  171.       return
  172.       end
  173.  
  174.       subroutine ff(v,n)
  175.       character*(*) v(4)
  176.       print*,'FF:len(v(1 or 2 or 3 or 4))  =',len(v(1))
  177.       print*,'FF:v(1,2,3,4) =',v(1),',',v(2),',',v(3),',',v(4)
  178.       print*,'FF:n =',n
  179.       call cf(v,n)
  180.       return
  181.       end
  182.  
  183.       integer function fg()
  184.       integer cg
  185.       fg = cg()
  186.       return
  187.       end
  188.  
  189.       character*(*) function fh()
  190.       character*200 ch
  191.       fh = ch()
  192.       return
  193.       end
  194.  
  195.       character*(*) function fi(v)
  196.       character*(*) v(6)
  197.       character*200 ci
  198.       fi = ci(v)
  199.       return
  200.       end
  201.  
  202.       character*(*) function fj(v)
  203.       integer v
  204.       character*200 cj
  205.       print*,'FJ:v =',v
  206.       fj = cj(v)
  207.       return
  208.       end
  209.  
  210.