
C                   Data Transfer Mechanism (DTM) v. 2.3
C                           May 1, 1992
C
C
C UNIVERSITY OF ILLINOIS (UI), NATIONAL CENTER FOR SUPERCOMPUTING
C APPLICATIONS (NCSA), Software Distribution Policy for Public Domain
C Software
C 
C The NCSA software Data Transfer Mechanism [both binary and source (if
C released)] is * in the public domain, available without fee for education,
C research, non-commercial and commercial purposes.  Users may distribute the
C binary or * source code to third parties provided that this statement
C appears on all copies and that no charge is made for such copies.
C 
C UI MAKES NO REPRESENTATIONS ABOUT THE SUITABILITY OF THE SOFTWARE FOR ANY
C PURPOSE.  IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.  THE
C UI SHALL NOT BE LIABLE FOR ANY DAMAGES SUFFERED BY THE USER OF THIS
C SOFTWARE.  The software may have been developed under agreements between
C the UI and the Federal Government which entitle the Government to certain
C rights.
C 
C By copying this program, you, the user, agree to abide by the conditions
C and understandings with respect to any software which is marked with a
C public domain notice.
C



C   Cray_to_Sun_32-bit_floating-point (with packing) conversion routine.
C   USAGE:   call cspk32 (carray, sarray, size)
C   WHERE    carray is the array of Cray floating point numbers
C            (64 bit) to be converted to 32-bit IEEE format
C            reals and packed 2 to 1 (high to low order) in sarray.
C            Size is the dimension of the input carray.
C            (sarray is assumed to be (size+1)/2 )
C            Icheck, if 1, provides checking for over/underflow
C            and writes the appropriate "infinity" pattern.
C
       subroutine DTMCSF (carray,sarray,size,icheck)
       integer size,carray(0:size-1),sarray(0:(size+1)/2-1)
       integer stemp1,stemp2,exp1,exp2,mant1,mant2
       if (icheck.eq.1) goto 30
       do 20 i=0,(size+1)/2-1
          sign1=and(carray(2*i),x'8000000000000000')
          sign2=and(carray(2*i+1),x'8000000000000000')
          exp1=shiftr(and(carray(2*i),x'7fff000000000000'),48)-16258
          exp2=shiftr(and(carray(2*i+1),x'7fff000000000000'),48)-16258
          mant1=shiftr(and(carray(2*i),x'00007fffff000000'),24)
     &    +shiftr(and(carray(2*i),x'0000000000800000'),23)
          mant2=shiftr(and(carray(2*i+1),x'00007fffff000000'),24)
     &    +shiftr(and(carray(2*i+1),x'0000000000800000'),23)
          stemp1=or(sign1, (shiftl(exp1,55) + shiftl(mant1,32)) )
          stemp2=or(sign2, (shiftl(exp2,55) + shiftl(mant2,32)) )
          stemp1=cvmgn(stemp1,0,carray(2*i))
          stemp2=cvmgn(stemp2,0,carray(2*i+1))
          sarray(i)=or(stemp1,shiftr(stemp2,32))
20     continue
       return
30     continue
       do 10 i=0,(size+1)/2-1
          sign1=and(carray(2*i),x'8000000000000000')
          sign2=and(carray(2*i+1),x'8000000000000000')
          exp1=shiftr(and(carray(2*i),x'7fff000000000000'),48)-16258
          exp2=shiftr(and(carray(2*i+1),x'7fff000000000000'),48)-16258
          mant1=shiftr(and(carray(2*i),x'00007fffff000000'),24)
     &    +shiftr(and(carray(2*i),x'0000000000800000'),23)
          mant2=shiftr(and(carray(2*i+1),x'00007fffff000000'),24)
     &    +shiftr(and(carray(2*i+1),x'0000000000800000'),23)
          stemp1=or(sign1, (shiftl(exp1,55) + shiftl(mant1,32)) )
          stemp2=or(sign2, (shiftl(exp2,55) + shiftl(mant2,32)) )
          stemp1=cvmgm(or(sign1,x'7f80000000000000'),stemp1,254-exp1)
          stemp2=cvmgm(or(sign2,x'7f80000000000000'),stemp2,254-exp2)
          stemp1=cvmgn(stemp1,0,carray(2*i))
          stemp2=cvmgn(stemp2,0,carray(2*i+1))
          stemp1=cvmgm(0,stemp1,exp1-1)
          stemp2=cvmgm(0,stemp2,exp2-1)
          sarray(i)=or(stemp1,shiftr(stemp2,32))
10     continue
       end


C   Sun_to_Cray_32-bit_Floating-point (with unpacking) conversion routine.
C   USAGE:   call scup32 (sarray, carray, size)
C   WHERE    sarray is the array of 32-bit IEEE floating-point numbers
C            (packed 2 per word) to be converted 64-bit Cray format
C            and stored in carray.  Size is the dimension
C            of the output carray.  (sarray is assumed to be (size+1)/2 ).
C            Icheck is not used.
C
       subroutine DTMSCF (sarray,carray,size,icheck)
       integer size,sarray(0:(size+1)/2-1),carray(0:size-1),temp
cdir$ ivdep
       do 40 i=(size+1)/2-1,0,-1
          carray(2*i)=and(sarray(i),x'ffffffff00000000')
          carray(2*i+1)=shiftl(sarray(i),32)
40     continue
       do 50 i=0, size-1
          temp=carray(i)
          CARRAY(I)=OR(OR(AND(carray(I),X'8000000000000000'),SHIFTR
     &      (AND(carray(I),X'7F80000000000000'),7)+shiftl(16258,48)),or(
     &shiftr(AND(carray(I),X'007FFFFF00000000'),8),X'0000800000000000'))
          carray(i)=cvmgn(carray(i),0,shiftl(temp,1))
50     continue
       end


C
C   Integer_Cray_to_Sun_32-bit (with packing) conversion routine.
C   USAGE:   call icspk32 (carray, sarray, size)
C   WHERE    carray is the array of 64-bit signed integers to be
C            into 32-bit integers packed 2 per word and stored in
C            sarray.  Size is the dimension of the input carray,
C            Sarray is assumed to be (size+1)/2.
C
       subroutine DTMCSI  (sarray,carray,size)
       integer size,sarray(0:(size+1)/2-1),carray(0:size-1),temp
cdir$ ivdep
       do 60 i=0, (size+1)/2-1
          sarray(i)=or(
     &      and(shiftl(carray(2*i),32),x'ffffffff00000000'),
     &      and(carray(2*i+1), x'00000000ffffffff'))
60     continue
       end



C
C   Integer_Sun_32-bit_to_Cray_64-bit with unpacking conversion routine.
C   USAGE:   call iscup32 (sarray, carray, size)
C   WHERE    sarray is the array of 32-bit signed integers packed 2
C            per word to be converted to 64 bit Cray integers and
C            stored in carray.  Size is the dimension of the output
C            carray.  (sarray is assumed to be (size+1)/2 ).
C
       subroutine DTMSCI (sarray,carray,size)
       integer size,sarray(0:(size+1)/2-1),carray(0:size-1),temp
cdir$ ivdep
       do 80 i=(size+1)/2-1,0,-1
          carray(2*i) = shiftr(sarray(i), 32)
          carray(2*i+1)=and(sarray(i),x'ffffffff')
80     continue
       do 90 i=0, size-1
          carray(i) = or(carray(i), cvmgz(0, x'ffffffff00000000',
     &      and(carray(i), x'80000000')))
90     continue
       end



C
C   Cray to Sun Triplet (with packing) conversion routine.
C   USAGE:   call DTMCST (carray, sarray, size)
C   WHERE    carray is the array of DTM triplet structures
C            (cray format) to be converted into standard format
C            and packed into sarray.
C            size is the dimension of the input carray,
C            sarray is assumed to be size/2.
C
       subroutine DTMCST (sarray,carray,size)
       integer size,sarray(0:size*2-1),carray(0:size*4-1)
       integer stemp1,stemp2,exp1,exp2,mant1,mant2
cdir$ ivdep
       do 100 i=0, size*2-1, 2
          sign2=and(carray(2*i+1),x'8000000000000000')
          exp2=shiftr(and(carray(2*i+1),x'7fff000000000000'),48)-16258
          mant2=shiftr(and(carray(2*i+1),x'00007fffff000000'),24)
     &    +shiftr(and(carray(2*i+1),x'0000000000800000'),23)
          stemp2=or(sign2, (shiftl(exp2,55) + shiftl(mant2,32)) )
          stemp2=cvmgm(or(sign2,x'7f80000000000000'),stemp2,254-exp2)
          stemp2=cvmgn(stemp2,0,carray(2*i+1))
          stemp2=cvmgm(0,stemp2,exp2-1)
          sarray(i)=or(and(shiftl(carray(2*i),32),x'ffffffff00000000'),
     &      shiftr(stemp2,32))

          sign1=and(carray(2*i+2),x'8000000000000000')
          sign2=and(carray(2*i+3),x'8000000000000000')
          exp1=shiftr(and(carray(2*i+2),x'7fff000000000000'),48)-16258
          exp2=shiftr(and(carray(2*i+3),x'7fff000000000000'),48)-16258
          mant1=shiftr(and(carray(2*i+2),x'00007fffff000000'),24)
     &    +shiftr(and(carray(2*i+2),x'0000000000800000'),23)
          mant2=shiftr(and(carray(2*i+3),x'00007fffff000000'),24)
     &    +shiftr(and(carray(2*i+3),x'0000000000800000'),23)
          stemp1=or(sign1, (shiftl(exp1,55) + shiftl(mant1,32)) )
          stemp2=or(sign2, (shiftl(exp2,55) + shiftl(mant2,32)) )
          stemp1=cvmgm(or(sign1,x'7f80000000000000'),stemp1,254-exp1)
          stemp2=cvmgm(or(sign2,x'7f80000000000000'),stemp2,254-exp2)
          stemp1=cvmgn(stemp1,0,carray(2*i+2))
          stemp2=cvmgn(stemp2,0,carray(2*i+3))
          stemp1=cvmgm(0,stemp1,exp1-1)
          stemp2=cvmgm(0,stemp2,exp2-1)
          sarray(i+1)=or(stemp1,shiftr(stemp2,32))
100    continue
       end



C
C   Sun to Cray Triplet with unpacking conversion routine.
C   USAGE:   call DTMSCT (sarray, carray, size)
C   WHERE    sarray is the array of 32-bit signed integers packed 2
C            per word to be converted to 64 bit Cray integers and
C            stored in carray.  Size is the dimension of the output
C            carray.  (sarray is assumed to be (size+1)/2 ).
C
       subroutine DTMSCT (sarray,carray,size)
       integer size,sarray(0:size*2-1),carray(0:size*4-1),temp
cdir$ ivdep
       do 110 i=size*2-1, 0, -1
          carray(2*i)=and(sarray(i),x'ffffffff00000000')
          carray(2*i+1)=shiftl(sarray(i),32)
110    continue
       do 120 i=0, size-1, 4

C  convert tag
          carray(i) = or(carray(i), cvmgz(0, x'ffffffff00000000',
     &      and(carray(i), x'80000000')))

C  convert 1st float
          temp=carray(i+1)
          CARRAY(I+1)=OR(OR(AND(carray(I+1),X'8000000000000000'),
     &      SHIFTR(AND(carray(I+1),X'7F80000000000000'),7)+
     &      shiftl(16258,48)),or(shiftr(AND(carray(I+1),
     &      X'007FFFFF00000000'),8),X'0000800000000000'))
          carray(i+1)=cvmgn(carray(i+1),0,shiftl(temp,1))

C  convert 2nd float
          temp=carray(i+2)
          CARRAY(I+2)=OR(OR(AND(carray(I+2),X'8000000000000000'),
     &      SHIFTR(AND(carray(I+2),X'7F80000000000000'),7)+
     &      shiftl(16258,48)),or(shiftr(AND(carray(I+2),
     &      X'007FFFFF00000000'),8),X'0000800000000000'))
          carray(i+2)=cvmgn(carray(i+2),0,shiftl(temp,1))

C  convert 3rd float
          temp=carray(i+3)
          CARRAY(I+3)=OR(OR(AND(carray(I+3),X'8000000000000000'),
     &      SHIFTR(AND(carray(I+3),X'7F80000000000000'),7)+
     &      shiftl(16258,48)),or(shiftr(AND(carray(I+3),
     &      X'007FFFFF00000000'),8),X'0000800000000000'))
          carray(i+3)=cvmgn(carray(i+3),0,shiftl(temp,1))

120    continue
       end

