w3fi47.f

Go to the documentation of this file.

C> @file
C> @brief Convert label to off. no. 85 format (cray)
C> @author Ralph Jones @date 1985-07-31
 
C> Converts a office note 85 label in IBM370 format
C> to office note 85 cray format. All EBCDIC characters are
C> converted to ASCII. Converts binary or coded label.
C>
C> Program history log:
C> - Ralph Jones 1985-07-31
C> - Ralph Jones 1989-10-24 Convert to cray cft77 fortran
C> - Boi Vuong 2002-10-15 Replaced function ichar with mova2i
C>
C> @param[in] ILABEL 4 words (32 bytes) characters are in EBCDIc or
C> binary.
C> @param[out] NLABEL 4 words (32 bytes), characters are in ASCII or
C> binary.
C>
C> @author Ralph Jones @date 1985-07-31
      SUBROUTINE w3fi47(ILABEL,NLABEL)
C
       CHARACTER*1    ILABEL(32)
       CHARACTER*1    NLABEL(32)
C
C          TEST FOR CODED LABEL, IF SO, CONVERT ALL CHARACTERS
C          TEST FOR EBCDIC C, 195 IN DECIMAL
C
           IF (mova2i(ilabel(7)).EQ.195) THEN
C
             CALL aea(nlabel(1),ilabel(1),32)
C
           ELSE
C
C          BINARY LABEL, CONVERT BYTES 1-8, 21-30 TO ASCII
C
             CALL aea(nlabel(1),ilabel(1),8)
C
C          MOVE BYTES 9 TO 20
C
             DO 10 i = 9,20
               nlabel(i) = ilabel(i)
 10          CONTINUE
C
C          CONVERT WASHINGTON TO ASCII
C
             CALL aea(nlabel(21),ilabel(21),10)
C
C          TEST BYTES 31 AND 32 FOR BINARY ZERO, IF NOT ZERO
C          CONVERT TO ASCII
C
             IF (mova2i(ilabel(31)).EQ.0) THEN
               nlabel(31) = char(0)
             ELSE
               CALL aea(nlabel(31),ilabel(31),1)
             ENDIF
C
             IF (mova2i(ilabel(32)).EQ.0) THEN
               nlabel(32) = char(0)
             ELSE
               CALL aea(nlabel(32),ilabel(32),1)
             ENDIF
C
           ENDIF
C
         RETURN
       END