SUBROUTINE MOUT(INDEX,RETCD) INCLUDE 'VKLUGPRM.FTN' C PARAMETER RRW = 32 C PARAMETER RCL = 32 C RRW=MAX REAL ROWS C RCL=MAX REAL COLS C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS C VBLS AND TYPE DIMENSIONED RRW,RCL C ************************************************** C * * C * SUBROUTINE MOUT (INDEX,RETCD) * C * * C ************************************************** C C C THIS ROUTINE OUTPUTS VALUE OF A MULTIPLE PRECISION VARIABLE C C C C RETCD MEANING C C 1 O.K. C 2 ERROR C C C MODIFICATION CLASSES: M1,M3 C C C C C MOUT CALLS C C ERRMSG PRINTS ERROR MESSAGES C PRTCON CONVERTS 1-10 TO PRINTABLE 1,2,...9,0 C C C C C MOUT IS CALLED BY VAROUT C C C C MODIFIED 5-DEC-1979 P.B. C FIXED PROBLEM FOR COMPILERS WHOSE RUN-TIME SYSTEM DOESN'T ALLOW C EXTRA COMMAS IN DYNAMICALLY CREATED FORMAT STATEMENTS C C C C C C C VARIABLE USE C C BVEC(3) HOLDS BASE VALUES TO BE INDEXED BY IBASE AND PRINTED C UNDER I2 FORMAT. C DIGITS(16,3) PRINTABLE ASCII DIGITS. C FORHEX HOLDS OUTPUT FORMAT STATEMENT WHEN OUTPUTTING HEXADECIMAL C NUMBERS (SEPARATES GROUPS OF 4 DIGITS WITH COMMAS). C FORMAT HOLDS OUTPUT FORMAT STATEMENT WHEN OUTPUTTING NUMBERS WITH C COMMAS EVERY 3 DIGITS. FIRST PART IS USED WHEN LESS THAN C 4 DIGITS OR HEXADECIMAL AND EXACTLY 4 DIGITS IS OUTPUT. C I,I1,I2 TEMPORARY VALUES C IBASE CODES BASE: 1=BASE 10, 2=BASE 8, 3=BASE 16 C IGRP NUMBER OF COMMAS NEEDED TO SEPARATE DIGITS. C INDEX POINTER TO VARIABLE TO BE OUTPUT. C LOG1 LOGICAL*1 USED AS ARGUMENT IN PRTCON CALLS. C NONE NUMBER OF DIGITS TO BE PRINTED. C RPAR ')' C SIGN(2) VECTOR USED TO PRINT APPROPRIATE SIGN ('+' OR '-') C TYPE HOLDS TYPE OF EACH VARIABLE. C C C C C SUBROUTINE MOUT(INDEX,RETCD) C C C INDEX POINTS TO AN ELEMENT IN VBLS TO BE OUTPUT C (A MULTIPLE PRECISION NUMBER BASE 10, 8, OR 16) C C C INTEGER*2 RETCD,VLEN(9) INTEGER*2 TYPE(RRW,RCL) INTEGER*2 BVEC(3) INTEGER*2 I,I1,I2 INTEGER*2 IBASE,INDEX,NONE,IGRP C C LOGICAL*1 AVBLS(100,27),LOG1 LOGICAL*1 VBLS(8,RRW,RCL) LOGICAL*1 PRTCON LOGICAL*1 SIGN(2),FORMAT(24),FORHEX(24),RPAR,COMMA C C COMMON /V/ TYPE,AVBLS,VBLS,VLEN C C DATA COMMA/','/ DATA BVEC/10,8,16/ DATA SIGN/' ','-'/, RPAR/')'/ DATA FORMAT/'(', '1', 'X', ',', '1', 'A', '1', ',', ' ', 2 'A', '1', ',', ' ', ' ', '(', '''', ',', '''', ',', '3', 3 'A', '1', ')', ')'/ C C DATA FORHEX/'(', '1', 'X', ',', '1', 'A', '1', ',', ' ', 2 'A', '1', ',', ' ', ' ', '(', '''', ',', '''', ',', '4', 3 'A', '1', ')', ')'/ C C C SET DEFAULT RETURN CODE (O.K.) RETCD=1 C C IBASE = 1 IF BASE 10, 2 IF BASE 8, 3 IF BASE 16 IBASE=TYPE(INDEX,1)-4 C C C C MAKE SURE THE VARIABLE IS DEFINED IF(TYPE(INDEX,1).NE.0)GO TO 10 STOP 10 C C C DETERMINE THE NUMBER OF DIGITS TO BE PRINTED. 10 DO 20 I=2,100 NONE=101-I IF(AVBLS(NONE,INDEX).NE.0)GO TO 30 20 CONTINUE NONE=1 C C NONE POINTS TO THE NUMBER OF DIGITS TO BE PRINTED 30 IF(NONE.GT.4.OR.(NONE.EQ.4.AND.IBASE.NE.3)) GOTO 50 C C C ************************************************** C ****** ONLY 1,2, OR 3 DIGITS (4 IF HEX) ********** C ************************************************** LOG1=NONE C C PUT IN NUMBER OF DIGITS. FORMAT(9)=PRTCON(LOG1,1) C C END FORMAT STATEMENT. C IF RUN-TIME SYSTEM ALLOWS EXTRA COMMAS IN DYNAMICALLY CREATED C FORMAT STATEMENTS, USE C FORMAT(13)=RPAR C INSTEAD OF FORMAT(12)=RPAR 40 CONTINUE C C C C ///// WRITE NON-HEXADECIMAL NUMBER ///// WRITE(1,FORMAT) SIGN(AVBLS(100,INDEX)+1),(PRTCON(AVBLS( 2 NONE+1-I,INDEX),IBASE),I=1,NONE) C C NEED THE FOLLOWING ONLY IF C FORMAT(12)=RPAR C INSTEAD OF C FORMAT(13)=RPAR C ABOVE FORMAT(12)=COMMA GO TO 10000 C C C MORE THAN 3 DIGITS SO USE COMMAS TO SEPARATE GROUPS 50 IF(IBASE.EQ.3) GO TO 200 C C C ****************************************************** C ** DECIMAL OR OCTAL NUMBER WITH MORE THAN 3 DIGITS ** C ****************************************************** C C FIRST CALCULATE THE NUMBER OF COMMAS NEEDED. IGRP=NONE/3 LOG1=NONE-IGRP*3 IF(LOG1.NE.0)GO TO 55 IGRP=IGRP-1 LOG1=3 C C CONVERT GROUP COUNT TO PRINTABLE ASCII FOR FORMAT STATEMENT. 55 I1=IGRP/10 I2=IGRP-I1*10 FORMAT(9)=PRTCON(LOG1,1) LOG1=I1 FORMAT(13)=PRTCON(LOG1,1) LOG1=I2 FORMAT(14)=PRTCON(LOG1,1) GO TO 40 C C C C C ************************************************** C *** HEXADECIMAL NUMBER WITH MORE THAN 4 DIGITS *** C ************************************************** C C CALCULATE THE NUMBER OF COMMAS NEEDED. 200 IGRP=NONE/4 LOG1=NONE-IGRP*4 IF(LOG1.NE.0)GO TO 210 IGRP=IGRP-1 LOG1=4 C C CONVERT GROUPT COUNT TO ASCII FOR FORMAT STATEMENT. 210 I1=IGRP/10 I2=IGRP-I1*10 FORHEX(9)=PRTCON(LOG1,1) LOG1=I1 FORHEX(13)=PRTCON(LOG1,1) LOG1=I2 FORHEX(14)=PRTCON(LOG1,1) C C C ///// WRITE OUT HEXADECIMAL NUMBER ///// WRITE(1,FORHEX) SIGN(AVBLS(100,INDEX)+1), 2 (PRTCON(AVBLS(NONE+1-I,INDEX),IBASE),I=1,NONE) GO TO 10000 C C C C C ************************* C **** EXIT PROCESSING **** C ************************* 10000 CONTINUE WRITE(1,10010) BVEC(IBASE) 10010 FORMAT(' (BASE ',I2,')') RETURN END C C C ********************************** C * * C * INTERNAL FUNCTION PRTCON * C * * C ********************************** C CALLED BY MOUT ONLY C CONVERTS 0 TO APPROPRIATE NUMBER FOR PRINTING WITH VECTOR DIGITS FUNCTION PRTCON(L1,IBASE) INTEGER*2 BASE(3) INTEGER*2 IBASE,K LOGICAL*1 L1,PRTCON,DIGITS(16,3) COMMON /DIGV/ DIGITS DATA BASE /10,8,16/ PRTCON=L1 IF(L1.EQ.0)PRTCON=BASE(IBASE) K=PRTCON PRTCON=DIGITS(K,IBASE) RETURN END