C*********************************************************************** C C SUBROUTINE GPV C C PURPOSE: C TO GET PARAMETER VALUES PASSED FROM A GAMMA MACRO TO A C FORTRAN PROGRAM. C C USAGE: C CALL GPV(NP,NPF,IBLOCK,ERR) C C DESCRIPTION OF INPUT PARAMETERS: C NP - THE NUMBER OF PARAMETERS TO LOOK AFTER C TYPE: INTEGER C C DESCRIPTION OF OUTPUT PARAMETERS: C NPF - THE NUMBER OF PARAMETERS FOUND C TYPE: INTEGER C IBLOCK - BLOCK BUFFER, THE NP FIRST PLACES IN IBLOCK CONTAINS C THE FOUND PARAMETER VALUES C TYPE: INTEGER C DIMENSION: 256 C ERR - ERROR INDICATOR C TYPE: LOGICAL*1 C C REMARKS: C THE PARAMETERS SHOULD BE THE LAST ITEMS IN THE MACRO LINE C THAT CALLS THE CORRESPONDING FORTRAN PROGRAM AND SHOULD BE C PRECEED BY TWO EXCLAMATION SIGNS (!). THE PARAMETERS ARE C SEPERATED BY A COMMA. IF NECESSARY AD A SEMI COLON (;) C BEFORE THE TWO EXCLAMATION SIGNS, FOR INSTANCE IF THE C LAST COMMAND BEFORE THE TWO EXCLAMATION SIGNS IS SA. C IN A MACRO LINE ONLY ONE SET OF PARAMETERS CAN BE PASSED. C THE PARAMETER VALUES SHOULD BE INTEGERS BETWEEN -32767 AND C 32767. C THE CURRENT MACRO LINE IS FOUND IN BLOCK 34 OF SAVE AREA 0. C C ERROR MESSAGES: C - ILLEGAL SYNTAX IN GAMMA PARAMETERS C ILLEGAL SYNTAX IN MACRO LINE, SYNTAX SHOULD BE: C [GAMMA COM];RUPROG;[GAMMA COM]!!PAR1,PAR2,...,PARN C - PARAMETER VALUE OVERFLOW C THE VALUE RANGE OF PARAMETERS PASSED FROM A GAMMA MACRO C TO A FORTRAN PROGRAM IS -32767 TO 32767. C C SUBROUTINE AND FUNCTION SUBPROGRAMS REQUIRED: C BYTE C C METHOD: C BLOCK 34 OF SAVE AREA 0 IS SEARCHED FOR INTEGERS SEPERATED C BYE COMMA, PRECEEDED BY !! (TWO EXCLAMATION SIGNS). C C REFERENCES: C NONE C C DATE/VERSION: C JUNE 1980 C C AUTHORS: C S.P. LIE AND J.H.C. REIBER C THORAXCENTER, ERASMUS UNIVERSITY ROTTERDAM C C*********************************************************************** C C SUBROUTINE GPV(NP,NPF,IBLOCK,ERR) C C LOGICAL*1 ERR !ERROR INDICATOR LOGICAL*1 NEG !NEGATIVE VALUE INDICATOR INTEGER IBLOCK(256) !BLOCK BUFFER INTEGER NP !NUMBER OF PARAMETERS INTEGER NPF !NUMBER OF PARAMETERS FOUND INTEGER CHAN !RT-11 CHANNEL INTEGER RADFN(4) !DEV AND FILE NAME IN RADIX-50 INTEGER CHAR !CHARACTER VALUE INTEGER M,N !HELP COUNTERS C C DATA RADFN/3RSVA,3RSVA,3RR00,3RSYS/ C C 10 FORMAT(' '//' *** ERROR *** ILLEGAL SYNTAX IN GAMMA PARAMETERS'//) 20 FORMAT(' '//' *** ERROR *** PARAMETER VALUE OVERFLOW'//) C C C INITIALIZE C CHAN=IGETC() CALL LOOKUP(CHAN,RADFN) CALL IREAD(256,IBLOCK,33,CHAN) !READ SA0 DESCRIPTOR BLOCK CALL IWAIT(CHAN) CALL CLOSEC(CHAN) CALL IFREEC(CHAN) ERR=.FALSE. NPF=0 DO 1 N=1,NP IBLOCK(N+128)=0 1 CONTINUE C C C SCAN FOR TWO SUCCESSIVE EXCLAMATION SIGNS C DO 2 N=3,51 IF(IGBYTE(IBLOCK,N).EQ.13)GOTO 9 !FOUND EOL IF(IGBYTE(IBLOCK,N).EQ.33.AND.IGBYTE(IBLOCK,N+1).EQ.33)GOTO 3 2 CONTINUE GOTO 9 !FOUND NO PARAMETERS 3 M=N+2 !CORRECT POINTER C C C GET PARAMETER VALUES C DO 8 NPF=1,NP !LOOK FOR ALL PARAMETERS NEG=.FALSE. !POSITIVE VALUE STATE=3 !NEW STATE DO 6 N=M,51 !SCAN MACRO LINE CHAR=IGBYTE(IBLOCK,N) !NEXT CHARACTER IF(CHAR.EQ.32)GOTO 6 !SKIP BLANKS IF(CHAR.EQ.13)GOTO 9 !END OF LINE IF(CHAR.EQ.44)GOTO 7 !NEXT PARAMETER IF(STATE.EQ.4)GOTO 4 !TEST STATE STATE=4 !NEW STATE IF(CHAR.EQ.45.OR.CHAR.EQ.43)GOTO 5 !FOUND SIGN 4 IF(CHAR.LT.48.OR.CHAR.GT.57)GOTO 13 !TEST ON DIGIT IF(IBLOCK(NPF+128).GT.3276)GOTO 14 !TEST ON OVERFLOW IF(IBLOCK(NPF+138).EQ.3276.AND.CHAR.GT.55)GOTO 13 IBLOCK(NPF+128)=IBLOCK(NPF+128)*10+CHAR-48 !PARAMETER VALUE GOTO 6 5 IF(CHAR.EQ.45)NEG=.TRUE. !NEGATIVE SIGN 6 CONTINUE GOTO 9 7 IF(NEG)IBLOCK(NPF+128)=-IBLOCK(NPF+128) !CORRECT SIGN M=N+1 !CORRECT POINTER STATE=3 !NEW STATE IF(NPF.EQ.NP)GOTO 11 !BRANCH IF LAST PARAMETER 8 CONTINUE !NEXT PARAMETER GOTO 13 9 IF(NEG)IBLOCK(NPF+128)=-IBLOCK(NPF+128) !CORRECT SIGN 11 DO 12 N=1,NP IBLOCK(N)=IBLOCK(N+128) 12 CONTINUE GOTO 15 C C C ERROR MESSAGES C 13 WRITE(5,10) !SYNTAX ERROR ERR=.TRUE. GOTO 15 14 WRITE(5,20) !PARAMETER OVERFLOW ERR=.TRUE. C C C 15 RETURN END