FTN4 LOGICAL FUNCTION JPAR(IBUFI,LNBYI,NOF,IBUFO,LNBYO,IFLG .,JVAL),. 92903-16001 REV.1805 780221 C C SOURCE 92903-18035 C C C C ************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C ************************************************************** C C C REV: 12/MAY/77 JCM C REV: 11/JAN/77 FG OR FOR MULTIPOINT TERMINAL C C C********************************************************************* C* * C* THIS IS A LOGICAL FUNCTION USED TO PARSE STRINGS. * C* MEANING OF PARAMETERS : * C* IBUFI = INPUT BUFFER * C* LNBYI = LENGTH OF INPUT BUFFER IN BYTES * C* NOF = SEQUENTIAL # OF FIELD TO FIND (FIRST IS 1) * C* IBUFO = OUTPUT BUFFER * C* LNBYO = LENGTH OF OUTPUT BUFFER IN BYTES * C* IFLG = RETURN FLAG * C* JVAL = INTEGER OR REAL VALUE OF IBUFI * C* * C* FIELD SEPARATOR IS = OCT 37 OR = OCT 36 * C* * C* THIS FUNCTION IS .FALSE. IF ALL IS O.K. - THE FIELD # NOF * C* HAS BEEN FOUND AND MOVED IN OUTPUT BUFFER AND : * C* * C* IFLG = 0 FIELD IS ONLY BLANKS * C* IFLG = 1 FIELD IS INTEGER POS OR NE JVAL=INTEGER * C* IFLG = 3 FIELD IS ASCII (FROM SPACE TO _) * C* * C* THIS FUNCTION IS .TRUE. IF : * C* * C* * C* -AN ILLEGAL CHARACTER (NON PRINTABLE OR LOWER CASE) * C* HAS BEEN FOUND (IFLG=5) * C* * C* -THERE IS AN ERROR : * C* NOF IS NEGATIVE OR NOT IN THE BUFFER RANGE * C* IN THIS CASE IFLG = 6 * C* * C* -A SPECIAL STRING HAS BEEN FOUND : * C* -INSERT IFLG=4 * C* -HELP IFLG=7 * C* -LAST SCREEN IFLG=8 * C* -ABORT PROGRAM IFLG=9 * C* * C********************************************************************* C C DECLARATIONS : C LOGICAL ISSPA,INUM DIMENSION IBUFI(1),IBUFO(1),JVAL(2) DATA IUS/17440B/,IRS/17040B/ C C INITIALISE BUFFER AND PARAMETERS C JPAR=.FALSE. IE=(LNBYO+1)/2 DO 3 I=1,IE 3 IBUFO(I)=2H C C FIND BEGINING OF FIELD # NOF C J=0 IFLG=6 IF(NOF.LE.0) GO TO 140 IF(NOF.EQ.1) GO TO 30 DO 20 I=1,NOF-1 10 IF(J.EQ.LNBYI) GO TO 140 J=J+1 N=IGET1(IBUFI,J) IF(N.NE.IUS .AND. N.NE.IRS) GOTO 10 20 CONTINUE C C MOVE CHARACTERS IN OUPUT BUFFER AND CHECK FOR NON PRINTABLE ASCII C 30 IFLG=3 DO 50 I=1,LNBYO J=J+1 M=IGET1(IBUFI,J) L=IAND(IALF2(M),377B) IF((L.LE.36B).OR.(L.GT.137B)) GO TO 130 50 CALL PUTCA(IBUFO,M,I) C C NORMAL RETURN . ONLY BLANKS ? C IF(ISSPA(IBUFO,1,LNBYO)) GO TO 60 IFLG=0 RETURN C C NORMAL RETURN . INTEGER ? C 60 IF(INUM(IBUFO,1,LNBYO,JVAL)) GO TO 120 IFLG=1 120 RETURN C C MISSING INTEGER NEGATIVE AND REAL CHECKS !!!!! C C C ERROR RETURN C 130 IFLG=5 IF(L.EQ.151B) IFLG=4 IF(L.EQ.150B) IFLG=7 IF(L.EQ.163B) IFLG=8 IF(L.EQ.141B) IFLG=9 140 JPAR=.TRUE. 145 RETURN END END$ C