SUBROUTINE FCNA(LUN,IF,IC,IN,IA,IDATA,IQ,IX) c c This subroutine is designed to issue a single FCNA using the c Kinetic Systems 3989 serial crate controller. It is assumed c to be connected to logical unit LUN c IDATA is a 32 bit word to be written or read c IQ,IX are zero if no Q or X response c c The controller is assumed to be in hex mode c INTEGER LUN,IF,IC,IN,IA BYTE IAR(50) INTEGER ISUM,COMMA,MASK COMMON /FCNAST/ INDX,ISUM,IAR BYTE IPARAM(9),IDATA(4) DATA COMMA/','/, MASK/"177/ CALL PARAMS(IPARAM,9) ! Test the parameters 5 IF(IPARAM(1) .gt. 7) GO TO 10 ! Sufficient params CALL MSG('Insufficient parameters to FCNA') RETURN 10 Do 20 j = 2,9 IF(IPARAM(J) .EQ. 0) go to 5 ! Null param ? 20 CONTINUE IAR(1) = 1 IF(IF .lt. 0 .or. IF .gt. 31) THEN ! F ok ? CALL MSG('Illegal F in FCNA') ! NO ! RETURN ENDIF IF(IC .lt. 1 .or. IC .gt. 127)THEN ! C ok ? CALL MSG('Illegal C in FCNA') ! NO ! RETURN ENDIF IAR(2) = IC INDX = 2 IF(IN .lt. 1 .or. IN .gt. 31) THEN ! N OK ? CALL MSG('Illegal N in FCNA') ! NO ! RETURN endif IF(IA .lt. 0 .or. IA .gt. 15) THEN ! A OK ? CALL MSG(' Illegal A in FCNA') ! NO ! RETURN ENDIF CALL FCNACV(IN) CALL FCNACV(IA) ! Convert the A VALUE CALL FCNACV(IF) IAR(INDX) = 2 ISUM = 0 ! Zero the check sum IF(IF .GE. 16 .and. IF .le. 23) THEN ! If function is write DO 70 I = 3,1,-1 ! Convert the data 70 CALL FCNACV(IDATA(I)) IAR(INDX) = 3 ! Terminator code ISUM = IEOR(ISUM,Comma) ! Remove last , ELSE ! End of write function CALL FCNAPS(3) ! Put ETX into buffer ISUM = 0 ! Zero checksum for read ENDIF ISUM = IAND(ISUM,MASK) ! And strip result IF( ISUM .EQ. 0 .or. ISUM .eq. 15 1 .or. ISUM .eq. 17 .or. ISUM .eq. 19 .or. ISUM .eq. 27) THEN CALL FCNAPS(27) ! Output an ESC IF( ISUM .ne. 27) ISUM = ISUM + 1 ! Add 1 if not ESC ENDIF ! End special handling of sum CALL FCNAPS(ISUM) ! output the check sum d WRITE(6,1000) (IAR(I),I=1,INDX) ! Display Data to crate c c Write out request and wait for reply c Wait 4 minutes maximum and use ETX (3) as terminal char c CALL IORPR(4,%DESCR(IAR),INDX,%DESCR(IAR),20, 1 4,8,IERR,ISIZE) ! Write to crate D WRITE(6,1000) IERR,ISIZE ! Writout error + size D WRITE(6,1000) (IAR(I),I=1,ISIZE) ! Display result IF(ISIZE .GT. 0) THEN ICOMMA = 0 ! Counts number of commas Do 210 J = 1,ISIZE IF(IAR(J) .eq. ',') ICOMMA = ICOMMA + 1! Count if comma found 210 IF(IAR(J) .lt. ' ') IAR(J) = ' ' DO 220 J=1,5 ISIZE = ISIZE + 1 ! Pad input with commas 220 IAR(ISIZE) = ',' IF(IF .lt. 8 . and. ICOMMA .gt. 1)THEN! IF input + got result DECODE(ISIZE,1001,IAR)IDATA(3),IDATA(2),IDATA(1),ITEMP IDATA(4) = 0 ! Decode data + status ELSE DECODE(ISIZE,1001,IAR) ITEMP ! Decode status only ENDIF IF(ITEMP .ne. 0) THEN ! Status transmitted ? IQ = IAND(1,ITEMP) - 1 ! If 0 no Q IX = IAND(2,ITEMP)/2-1 ! If 0 no x ENDIF ENDIF 1000 FORMAT(/,1x,20O4) 1001 FORMAT(4Z10) END SUBROUTINE FCNACV(ID) BYTE ID INTEGER IDAT BYTE IDIG(16) DATA IDIG/'0','1','2','3','4','5','6','7','8','9' 1 ,'A','B','C','D','E','F'/ IDAT = ID IL = IAND("17,IDAT) ! Low order bits IH = IAND("17,ISHFT(IDAT,-4) ) ! Hi order bits IF(IH .NE. 0) THEN ! HI order digit ? IH = IDIG(IH+1) ! Convert hi order digit CALL FCNAPS(IH) ! Save HI order digit ENDIF IH = IL IH = IDIG(IH+1) CALL FCNAPS(IH) ! Save hi order digit 30 CALL FCNAPS(',') ! Now put in separator END SUBROUTINE FCNAPS(ID) BYTE ID BYTE IAR(50) INTEGER ISUM,IDAT COMMON /FCNAST/ INDX,ISUM,IAR INDX = INDX + 1 ! Next index IAR(INDX) = ID ! Save the byte in output array IDAT = ID ISUM = IEOR(IDAT,ISUM) ! Calculate the checksum END