SUBROUTINE FP_TEST(ID) C*************************************************************************** C This subroutine tests the byte order of a floating point number on a C computer. C If ID = -1 this is an unknown machine. This is an error condition C ID = 0 this is a VAX machine C ID = 1 this is IEEE fp machine (Ultrix/RISC, Intel 80x86) C ID = 2 this is a Stardent or Sun C C*************************************************************************** REAL AA LOGICAL*1 BB(4) EQUIVALENCE (AA,BB(1)) DATA BB/-6,71,-102,-10/ C ID = -1 ! DEFAULT is unknown IF(AA.EQ.32123.3)THEN ID = 0 ! machine is a VAX ELSEIF(AA.EQ.-1.5645968E33)THEN ID = 1 ! machine is a Ultrix/RISC, Intel 80x86 ELSEIF(AA.EQ.-2.5910251E35)THEN ID = 2 ! machine is a Stardent END IF RETURN END SUBROUTINE INT_CONV4(TYP_IN,TYP_OUT,BUFFER,NCNT) C****************************************************************************** C This subroutine converts the integer*4 format from TYP_IN to TYP_OUT. The C machine numbering scheme is contained in FP_TEST. NCNT is the number of C points contained in BUFFER. C***************************************************************************** INTEGER*4 BUFFER(NCNT),TYP_IN,TYP_OUT,IDUM LOGICAL*1 BB(4),BDUM EQUIVALENCE(BB(1),IDUM) C IF(TYP_IN.EQ.TYP_OUT)RETURN ! no conversion necessary IF(TYP_IN.EQ.0.AND.TYP_OUT.EQ.1)RETURN ! VAX to Ultrix/RISC IF(TYP_OUT.EQ.0.AND.TYP_IN.EQ.1)RETURN ! Ultrix/RISC to VAX C IF(TYP_IN.EQ.2.OR.TYP_OUT.EQ.2)THEN DO K = 1,NCNT IDUM = BUFFER(K) BDUM = BB(1) BB(1) = BB(4) BB(4) = BDUM BDUM = BB(2) BB(2) = BB(3) BB(3) = BDUM BUFFER(K) = IDUM END DO END IF C RETURN END C SUBROUTINE INT_CONV2(TYP_IN,TYP_OUT,BUFFER,NCNT) C****************************************************************************** C This subroutine converts the integer*4 format from TYP_IN to TYP_OUT. The C machine numbering scheme is contained in FP_TEST. NCNT is the number of C points contained in BUFFER C***************************************************************************** INTEGER*4 TYP_IN,TYP_OUT ! ID numbers from FP_TEST INTEGER*2 BUFFER(NCNT),IDUM ! buffer contains the data LOGICAL*1 BB(2),BDUM EQUIVALENCE(BB(1),IDUM) C IF(TYP_IN.EQ.TYP_OUT)RETURN ! no conversion necessary IF(TYP_IN.EQ.0.AND.TYP_OUT.EQ.1)RETURN ! VAX to Ultrix/RISC IF(TYP_OUT.EQ.0.AND.TYP_IN.EQ.1)RETURN ! Ultrix/RISC to VAX C IF(TYP_IN.EQ.2.OR.TYP_OUT.EQ.2)THEN DO K = 1,NCNT IDUM = BUFFER(K) BDUM = BB(1) BB(1) = BB(2) BB(2) = BDUM BUFFER(K) = IDUM END DO END IF C RETURN END SUBROUTINE FP_CONV(TYP_IN,TYP_OUT,BUFFER,NCNT) C****************************************************************************** C This subroutine converts the FLOATING POINT format from TYP_IN to TYP_OUT. C The machine numbering scheme is contained in fp_test. C***************************************************************************** INTEGER*4 TYP_IN,TYP_OUT REAL*4 BUFFER(NCNT),DUM LOGICAL*1 BB(4),BDUM EQUIVALENCE(BB(1),DUM) C IF(TYP_IN.EQ.TYP_OUT)RETURN ! no conversion necessary C C . . . conversion involving Ultrix/RISC with IEEE floating point . . . C IF(TYP_IN.EQ.0.AND.TYP_OUT.EQ.1)THEN ! VAX --> RISC DO K = 1,NCNT DUM = BUFFER(K) BDUM = BB(1) BB(1) = BB(3) BB(3) = BDUM BDUM = BB(2) BB(2) = BB(4) BB(4) = BDUM - 1 BUFFER(K) = DUM END DO ELSEIF(TYP_IN.EQ.1.AND.TYP_OUT.EQ.0)THEN ! RISC --> VAX DO K = 1,NCNT DUM = BUFFER(K) BDUM = BB(1) BB(1) = BB(3) BB(3) = BDUM BDUM = BB(4) BB(4) = BB(2) BB(2) = BDUM + 1 BUFFER(K) = DUM END DO C C . . . STARDENT . . . C ELSEIF(TYP_IN.EQ.0.AND.TYP_OUT.EQ.2)THEN ! VAX -> Stardent DO K = 1,NCNT DUM = BUFFER(K) BDUM = BB(1) BB(1) = BB(2) - 1 BB(2) = BDUM BDUM = BB(4) BB(4) = BB(3) BB(3) = BDUM BUFFER(K) = DUM END DO ELSEIF(TYP_IN.EQ.2.AND.TYP_OUT.EQ.0)THEN ! Stardent -> VAX DO K = 1,NCNT DUM = BUFFER(K) BDUM = BB(2) BB(2) = BB(1) + 1 BB(1) = BDUM BDUM = BB(4) BB(4) = BB(3) BB(3) = BDUM BUFFER(K) = DUM END DO END IF C RETURN END