C                         NCSA DTM version 2.0
C                               June 10, 1991
C
C NCSA DTM Version 2.0 source code and documentation are in the public
C domain.  Specifically, we give to the public domain all rights for future
C licensing of the source code, all resale rights, and all publishing rights.
C
C We ask, but do not require, that the following message be included in all
C derived works:
C
C Portions developed at the National Center for Supercomputing Applications at
C the University of Illinois at Urbana-Champaign.
C
C THE UNIVERSITY OF ILLINOIS GIVES NO WARRANTY, EXPRESSED OR IMPLIED, FOR THE
C SOFTWARE AND/OR DOCUMENTATION PROVIDED, INCLUDING, WITHOUT LIMITATION,
C WARRANTY OF MERCHANTABILITY AND WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE
C

C	/X11/marca/cvsroot/xmosaic/libdtm/crayrtns.f,v 1.1 1993/01/18 21:50:08 marca Exp

C	crayrtns.f,v
c Revision 1.1  1993/01/18  21:50:08  marca
c I think I got it now.
c
c Revision 1.2  1993/01/18  21:46:47  marca
c Plugging DTM in...
c
c Revision 1.4  91/06/11  15:21:47  sreedhar
c disclaimer added
c 
c Revision 1.3  1991/05/16  04:40:13  jefft
c Fixed bugs in TRIPLET conversion
c
c Revision 1.2  1991/01/31  17:06:05  jefft
c Fixed bug in Cray floating point conversion routines.
c
c Revision 1.1  90/11/08  16:30:17  jefft
c Initial revision
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

