User Tools

Site Tools


cdc:nos2.source:opl.opl871:deck:acpd.004

Deck ACPD Part 004

9 Modifications

Listing Sections

Source

Seq #  *Modification Id* Act 
----------------------------+
05771  M01S05521.acpd    +++|          N2=DDSM$ET[DDSC$FW[PDTM]];   # TOTAL END TIME #
05772  M01S05522.acpd    +++|          T$WD[0]=EDATE(N1/SHFC);    # CONVERT TO DATE #
05773  M01S05523.acpd    +++|          RPLINEX(OFFA,T,J+11,9,NLFC);
05774  M01S05524.acpd    +++|          RPLINEX(OFFA,"TO ",J+21,3,NLFC);
05775  M01S05525.acpd    +++|          T$WD[0]=EDATE(N2/SHFC);
05776  M01S05526.acpd    +++|          RPLINEX(OFFA,T,J+23,9,LFDC);
05777  M01S05527.acpd    +++|          END  # COMPUTE AND PRINT LENGTH OF TOTAL #
05778  M01S05528.acpd    +++|
05779  M01S05529.acpd    +++|        END  # PRINT TIME #
05780  M01S05530.acpd    +++|
05781  M01S05531.acpd    +++|      ELSE                           # PRINTING SNAPSHOT ELEMENTS #
05782  M01S05532.acpd    +++|        BEGIN
05783  M01S05533.acpd    +++|        RPLINEX(OFFA,BLKC,J,1,LFDC);
05784  M01S05534.acpd    +++|        END
05785  M01S05535.acpd    +++|
05786  M01S05536.acpd    +++|#
05787  M01S05537.acpd    +++|*     PRINT SECOND LINE OF THE SUBTITLE.
05788  M01S05538.acpd    +++|#
05789  M01S05539.acpd    +++|
05790  M01S05540.acpd    +++|      J=BCLC + 1;
05791  M01S05541.acpd    +++|      SLOWFOR I=1 STEP 1 UNTIL NIPP
05792  M01S05542.acpd    +++|      DO
05793  M01S05543.acpd    +++|        BEGIN
05794  M01S05544.acpd    +++|        RPLINEX(OFFA," INTERVAL",J,9,NLFC);
05795  M01S05545.acpd    +++|        J=J+10;
05796  M01S05546.acpd    +++|        END
05797  M01S05547.acpd    +++|
05798  M01S05548.acpd    +++|      IF (TLFG EQ 1)                 # NOT PRINTING SNAPSHOT ELEMENTS #
05799  M01S05549.acpd    +++|      THEN
05800  M01S05550.acpd    +++|        BEGIN  # PRINT SUBTOTAL AND TOTAL HEADERS #
05801  M01S05551.acpd    +++|        IF (NIPP GR (DCDC-3))
05802  M01S05552.acpd    +++|        THEN                         # PRINT TOTAL ON NEXT PAGE #
05803  M01S05553.acpd    +++|          BEGIN
05804  M01S05554.acpd    +++|          RPLINEX(OFFA," SUBTOTAL",J,9,LFDC);
05805  M01S05555.acpd    +++|          END
05806  M01S05556.acpd    +++|
05807  M01S05557.acpd    +++|        ELSE                         # PRINT TOTAL ON THE SAME PAGE #
05808  M01S05558.acpd    +++|          BEGIN  # PRINT SUBTOTAL AND TOTAL HEADERS ON SAME PAGE #
05809  M01S05559.acpd    +++|          IF (NIPP GR 0)             # TOTAL IS NOT FIRST COLUMN #
05810  M01S05560.acpd    +++|            AND (TCOL GR (DCDC-3))
05811  M01S05561.acpd    +++|          THEN
05812  M01S05562.acpd    +++|            BEGIN
05813  M01S05563.acpd    +++|            RPLINEX(OFFA," SUBTOTAL",J,9,NLFC);
05814  M01S05564.acpd    +++|            J=J+10;
05815  M01S05565.acpd    +++|            END
05816  M01S05566.acpd    +++|
05817  M01S05567.acpd    +++|          RPLINEX(OFFA,"    TOTAL",J,9,NLFC);
05818  M01S05568.acpd    +++|          RPLINEX(OFFA,"    *MAX* ",J+10,10,NLFC);
05819  M01S05569.acpd    +++|          RPLINEX(OFFA,"    *MIN* ",J+20,10,LFDC);
05820  M01S05570.acpd    +++|          END  # PRINT SUBTOTAL AND TOTAL HEADERS ON SAME PAGE #
05821  M01S05571.acpd    +++|
05822  M01S05572.acpd    +++|        END  # PRINT SUBTOTAL AND TOTAL HEADERS #
05823  M01S05573.acpd    +++|
05824  M01S05574.acpd    +++|      ELSE                           # PRINTING SNAPSHOT ELEMENTS #
05825  M01S05575.acpd    +++|        BEGIN
05826  M01S05576.acpd    +++|        RPLINEX(OFFA,BLKC,J,1,LFDC);
05827  M01S05577.acpd    +++|        END
05828  M01S05578.acpd    +++|
05829  M01S05579.acpd    +++|      RPLINEX(OFFA,BLKC,1,1,LFDC);   # LINE FEED #
05830  M01S05580.acpd    +++|      RETURN;
05831  M01S05581.acpd    +++|      END  # REPTLE #
05832  M01S05582.acpd    +++|
05833  M01S05583.acpd    +++|      TERM
05834  M01S05584.acpd    +++|PROC WRITEV(PVL,(DTY),(BCL),(FWD),(CRC));
05835  M01S05585.acpd    +++|# TITLE WRITEV - WRITE TO REPORT FILE.  #
05836  M01S05586.acpd    +++|
05837  M01S05587.acpd    +++|      BEGIN  # WRITEV #
05838  M01S05588.acpd    +++|
05839  M01S05589.acpd    +++|#
05840  M01S05590.acpd    +++|**    WRITEV - WRITE TO REPORT FILE.
05841  M01S05591.acpd    +++|*
05842  M01S05592.acpd    +++|*     WRITE ONE VALUE TO THE REPORT FILE.
05843  M01S05593.acpd    +++|*
05844  M01S05594.acpd    +++|*     PROC WRITEV(PVL,(DTY),(BCL),(FWD),(CRC))
05845  M01S05595.acpd    +++|*
05846  M01S05596.acpd    +++|*     ENTRY      PVL = VALUE TO BE PRINTED.
05847  M01S05597.acpd    +++|*                DTY = DATA TYPE.
05848  M01S05598.acpd    +++|*                BCL = BEGINNING COLUMN TO WRITE.
05849  M01S05599.acpd    +++|*                FWD = FIELD WIDTH.
05850  M01S05600.acpd    +++|*                CRC = CARRIAGE CONTROL.
05851  M01S05601.acpd    +++|*                      *LFD* IF LINE FEED AT THE END OF THE LINE
05852  M01S05602.acpd    +++|*                      *NLF* IF NO LINE FEED
05853  M01S05603.acpd    +++|*
05854  M01S05604.acpd    +++|*     EXIT       THE VALUE IS PRINTED TO THE REPORT FILE ACCORDING
05855  M01S05605.acpd    +++|*                TO THE SPECIFIED FORMAT.
05856  M01S05606.acpd    +++|#
05857  M01S05607.acpd    +++|
05858  M01S05608.acpd    +++|#
05859  M01S05609.acpd    +++|*     PARAMETER LIST.
05860  M01S05610.acpd    +++|#
05861  M01S05611.acpd    +++|
05862  M01S05612.acpd    +++|      ITEM PVL        U;             # ADDRESS OF VALUE #
05863  M01S05613.acpd    +++|      ITEM DTY        I;             # DATA TYPE #
05864  M01S05614.acpd    +++|      ITEM BCL        I;             # BEGINNING COLUMN #
05865  M01S05615.acpd    +++|      ITEM FWD        I;             # FIELD WIDTH #
05866  M01S05616.acpd    +++|      ITEM CRC        I;             # CARRIAGE CONTROL #
05867  M01S05617.acpd    +++|
05868  M01S05618.acpd    +++|#
05869  M01S05619.acpd    +++|****  PROC WRITEV - XREF LIST BEGIN.
05870  M01S05620.acpd    +++|#
05871  M01S05621.acpd    +++|
05872  M01S05622.acpd    +++|      XREF
05873  M01S05623.acpd    +++|        BEGIN
05874  M01S05624.acpd    +++|        PROC BZFILL;                 # BLANK/ZERO FILL ITEM #
05875  M01S05625.acpd    +++|        PROC RPLINE;                 # PRINT ONE REPORT LINE #
05876  M01S05626.acpd    +++|        FUNC XCDD C(10);             # BINARY TO DISPLAY DECIMAL #
05877  M01S05627.acpd    +++|        FUNC XCED C(10);             # BINARY TO DISPLAY *E* FORMAT #
05878  M01S05628.acpd    +++|        FUNC XCFD C(10);             # BINARY TO DISPLAY REAL #
05879  M01S05629.acpd    +++|        FUNC XCOD C(10);             # BINARY TO DISPLAY OCTAL #
05880  M01S05630.acpd    +++|        END
05881  M01S05631.acpd    +++|
05882  M01S05632.acpd    +++|#
05883  M01S05633.acpd    +++|****  PROC WRITEV - XREF LIST END.
05884  M01S05634.acpd    +++|#
05885  M01S05635.acpd    +++|
05886  M01S05636.acpd    +++|      DEF BLKC       #" "#;          # BLANK #
05887  M01S05637.acpd    +++|      DEF MAXF       #1.0E4#;        # MAXIMUM VALUE OF *F* FORMAT #
05888  M01S05638.acpd    +++|      DEF ZERC       #"0"#;          # CHARACTER 0 #
05889  M01S05639.acpd    +++|
05890  M01S05640.acpd    +++|      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING #
05891  M01S05641.acpd    +++|
05892  M01S05642.acpd    +++|*CALL     COMUCPD
05893  M01S05643.acpd    +++|*CALL     COMABZF
05894  M01S05644.acpd    +++|
05895  M01S05645.acpd    +++|#
05896  M01S05646.acpd    +++|*     LOCAL VARIABLES.
05897  M01S05647.acpd    +++|#
05898  M01S05648.acpd    +++|
05899  M01S05649.acpd    +++|      ITEM N          I;             # TEMPORARY VARIABLE #
05900  M01S05650.acpd    +++|      ITEM NF         R;             # TEMPORARY VARIABLE #
05901  M01S00038.252l678 +++|      ITEM T1         I;             # TEMPORARY VARIABLE #
05902  M01S00039.252l678 +++|      ITEM T2         I;             # TEMPORARY VARIABLE #
05903  M01S05651.acpd    +++|
05904  M01S05652.acpd    +++|      ARRAY P [0:0] P(1);            # TEMPORARY BUFFER #
05905  M01S05653.acpd    +++|        BEGIN  # ARRAY P #
05906  M01S05654.acpd    +++|        ITEM P$WD       C(00,00,10);  # 10 CHAR VALUE #
05907  M01S05655.acpd    +++|        ITEM P$WF       C(00,06,09);  # 9 LEAST SIGNIFICANT DIGITS #
05908  M01S05656.acpd    +++|        END  # ARRAY P #
05909  M01S05657.acpd    +++|
05910  M01S05658.acpd    +++|      ARRAY TEM [0:0] P(1);          # DISPLAY CODE VALUE #
05911  M01S05659.acpd    +++|        BEGIN  # ARRAY TEM #
05912  M01S05660.acpd    +++|        ITEM T$WD       C(00,00,10);  # VALUE #
05913  M01S05661.acpd    +++|        ITEM T$W1       C(00,00,09);  # VALUE WITH NO POSTFIX #
05914  M01S05662.acpd    +++|        ITEM T$W2       C(00,54,01);  # *B* POSTFIX #
05915  M01S05663.acpd    +++|        END  # ARRAY TEM #
05916  M01S05664.acpd    +++|
05917  M01S05665.acpd    +++|      BASED
05918  M01S05666.acpd    +++|      ARRAY VAL [0:0] P(1);          # VALUE  TO BE PRINTED #
05919  M01S05667.acpd    +++|        BEGIN  # ARRAY VAL #
05920  M01S05668.acpd    +++|        ITEM VAL$C      C(00,00,50);  # CHARACTER TYPE #
05921  M01S05669.acpd    +++|        ITEM VAL$N      I(00,00,60);  # INTEGER TYPE #
05922  M01S05670.acpd    +++|        ITEM VAL$F      R(00,00,60);  # REAL TYPE #
05923  M01S05671.acpd    +++|        END  # ARRAY VAL #
05924  M01S05672.acpd    +++|
05925  M01S05673.acpd    +++|      SWITCH TYPE
05926  M01S05674.acpd    +++|             CHRS,                   # CHARACTER #
05927  M01S05675.acpd    +++|             FLPS,                   # FLOATING POINT #
05928  M01S05676.acpd    +++|             INTS,                   # INTEGER #
05929  M01S05677.acpd    +++|             OC1S,                   # OCTAL WITH *B* POSTFIX #
05930  M01S05678.acpd    +++|             OC2S,                   # OCTAL WITH NO POSTFIX #
05931  M01S05679.acpd    +++|             OC3S,                   # *B* POSTFIX, ZERO FILLED #
05932  M01S00040.252l678 +++|             OC4S,                   # OCTAL, ALLOWING FOR *UESC* #
05933  M01S05680.acpd    +++|             ;                       # END OF TYPE #
05934  M01S05681.acpd    +++|
05935  M01S05682.acpd    +++|      LABEL  EXIT;                   # END CASE #
05936  M01S05683.acpd    +++|
05937  M01S05684.acpd    +++|
05938  M01S05685.acpd    +++|
05939  M01S05686.acpd    +++|
05940  M01S05687.acpd    +++|
05941  M01S05688.acpd    +++|#
05942  M01S05689.acpd    +++|*     BEGIN WRITEV PROC.
05943  M01S05690.acpd    +++|#
05944  M01S05691.acpd    +++|
05945  M01S05692.acpd    +++|      IF (P$L EQ NULL)               # NO REPORT FILE #
05946  M01S05693.acpd    +++|      THEN  # SUPPRESS REPORT FILE #
05947  M01S05694.acpd    +++|        BEGIN
05948  M01S05695.acpd    +++|        RETURN;
05949  M01S05696.acpd    +++|        END
05950  M01S05697.acpd    +++|
05951  M01S05698.acpd    +++|      P<VAL>=LOC(PVL);
05952  M01S05699.acpd    +++|      GOTO TYPE[DTY];
05953  M01S05700.acpd    +++|
05954  M01S05701.acpd    +++|CHRS:                                # CHARACTER #
05955  M01S05702.acpd    +++|      BZFILL(VAL,TYPFILL"BFILL",FWD);
05956  M01S05703.acpd    +++|      RPLINE(OFFA,C<0,FWD>VAL$C[0],BCL,FWD,CRC);
05957  M01S05704.acpd    +++|      RETURN;
05958  M01S05705.acpd    +++|
05959  M01S05706.acpd    +++|FLPS:                                # FLOATING POINT #
05960  M01S05707.acpd    +++|      IF (VAL$F[0] GQ MAXF)          # PRINT IN *E* FORMAT #
05961  M01S05708.acpd    +++|      THEN
05962  M01S05709.acpd    +++|        BEGIN
05963  M01S05710.acpd    +++|        NF=VAL$F[0];
05964  M01S05711.acpd    +++|        T$WD[0]=XCED(NF);
05965  M01S05712.acpd    +++|        END
05966  M01S05713.acpd    +++|
05967  M01S05714.acpd    +++|      ELSE                           # PRINT IN *F* FORMAT #
05968  M01S05715.acpd    +++|        BEGIN
05969  M01S05716.acpd    +++|        N=VAL$F[0]*1000.0 + 0.5;
05970  M01S05717.acpd    +++|        T$WD[0]=XCFD(N);
05971  M01S05718.acpd    +++|        END
05972  M01S05719.acpd    +++|
05973  M01S05720.acpd    +++|      GOTO EXIT;
05974  M01S05721.acpd    +++|
05975  M01S05722.acpd    +++|INTS:                                # INTEGER #
05976  M01S05723.acpd    +++|      T$WD[0]=XCDD(VAL$N[0]);
05977  M01S05724.acpd    +++|      GOTO EXIT;
05978  M01S05725.acpd    +++|
05979  M01S05726.acpd    +++|OC1S:                                # OCTAL POSTFIXED WITH *B* #
05980  M01S05727.acpd    +++|      P$WD[0]=XCOD(VAL$N[0]);
05981  M01S05728.acpd    +++|      T$W1[0]=P$WF[0];
05982  M01S05729.acpd    +++|      T$W2[0]="B";
05983  M01S05730.acpd    +++|      GOTO EXIT;
05984  M01S05731.acpd    +++|
05985  M01S05732.acpd    +++|OC2S:                                # OCTAL WITHOUT *B* POSTFIX #
05986  M01S05733.acpd    +++|      T$WD[0]=XCOD(VAL$N[0]);
05987  M01S05734.acpd    +++|      GOTO EXIT;
05988  M01S05735.acpd    +++|
05989  M01S05736.acpd    +++|OC3S:                                # OCTAL NO POSTFIX, ZERO FILLED #
05990  M01S05737.acpd    +++|      T$WD[0]=XCOD(VAL$N[0]);
05991  M01S05738.acpd    +++|      SLOWFOR N=0 STEP 1 WHILE C<N,1>T$WD[0] EQ BLKC
05992  M01S05739.acpd    +++|      DO   #  CONVERT BLANK TO DISPLAY 0 #
05993  M01S05740.acpd    +++|        BEGIN
05994  M01S05741.acpd    +++|        C<N,1>T$WD[0]=ZERC;
05995  M01S05742.acpd    +++|        END
05996  M01S00041.252l678 +++|      GOTO EXIT;
05997  M01S00042.252l678 +++|
05998  M01S00043.252l678 +++|OC4S:                                # OCTAL WITH *B*, SHIFTED *UESC* #
05999  M01S00044.252l678 +++|      T1 = P<DCHD>;
06000  M01S00045.252l678 +++|      T2 = P<DDSC>;
06001  M01S00046.252l678 +++|      P<DCHD> = LOC(DBUF);
06002  M01S00047.252l678 +++|      P<DDSC> = LOC(DDHD);
06003  M01S00048.252l678 +++|      P$WD[0]=XCOD(VAL$N[0]*2**DCHD$WD[DDSC$FW[UESC]]);
06004  M01S00049.252l678 +++|      P<DCHD> = T1;
06005  M01S00050.252l678 +++|      P<DDSC> = T2;
06006  M01S00051.252l678 +++|      T$W1[0]=P$WF[0];
06007  M01S00052.252l678 +++|      T$W2[0]="B";
06008  M01S05743.acpd    +++|
06009  M01S05744.acpd    +++|EXIT:
06010  M01S05745.acpd    +++|      RPLINE(OFFA,C<10-FWD,FWD>T$WD[0],BCL,FWD,CRC);
06011  M01S05746.acpd    +++|      RETURN;
06012  M01S05747.acpd    +++|      END  # WRITEV #
06013  M01S05748.acpd    +++|
06014  M01S05749.acpd    +++|      TERM
06015  M01S05750.acpd    +++|PROC WRTSUM((NIP));
06016  M01S05751.acpd    +++|# TITLE WRTSUM - WRITE SUMMARY FILE.  #
06017  M01S05752.acpd    +++|
06018  M01S05753.acpd    +++|      BEGIN  # WRTSUM #
06019  M01S05754.acpd    +++|
06020  M01S05755.acpd    +++|#
06021  M01S05756.acpd    +++|**    WRTSUM - WRITE SUMMARY FILE.
06022  M01S05757.acpd    +++|*
06023  M01S05758.acpd    +++|*     WRITE DATA BLOCK ELEMENTS TO SUMMARY FILE.
06024  M01S05759.acpd    +++|*
06025  M01S05760.acpd    +++|*     PROC WRTSUM((NIP))
06026  M01S05761.acpd    +++|*
06027  M01S05762.acpd    +++|*     ENTRY      TABLE *DCDT*.
06028  M01S05763.acpd    +++|*                NIP = NUMBER OF INTERVALS PER PAGE.
06029  M01S05764.acpd    +++|*
06030  M01S05765.acpd    +++|*     EXIT       THE AVERAGE AND STANDARD DEVIATION OF EACH
06031  M01S05766.acpd    +++|*                DATA BLOCK ELEMENT ARE WRITTEN TO THE SUMMARY
06032  M01S05767.acpd    +++|*                FILE.
06033  M01S05768.acpd    +++|#
06034  M01S05769.acpd    +++|
06035  M01S05770.acpd    +++|#
06036  M01S05771.acpd    +++|*     PARAMETER LIST.
06037  M01S05772.acpd    +++|#
06038  M01S05773.acpd    +++|
06039  M01S05774.acpd    +++|      ITEM NIP        I;             # NUMBER OF INTERVALS PER PAGE #
06040  M01S05775.acpd    +++|
06041  M01S05776.acpd    +++|#
06042  M01S05777.acpd    +++|****  PROC WRTSUM - XREF LIST BEGIN.
06043  M01S05778.acpd    +++|#
06044  M01S05779.acpd    +++|
06045  M01S05780.acpd    +++|      XREF
06046  M01S05781.acpd    +++|        BEGIN
06047  M01S05782.acpd    +++|        PROC WRITER;                 # WRITE EOR #
06048  M01S05783.acpd    +++|        PROC WRITEW;                 # *CIO* WRITEW #
06049  M01S05784.acpd    +++|        END
06050  M01S05785.acpd    +++|
06051  M01S05786.acpd    +++|#
06052  M01S05787.acpd    +++|****  PROC WRTSUM - XREF LIST END.
06053  M01S05788.acpd    +++|#
06054  M01S05789.acpd    +++|
06055  M01S05790.acpd    +++|      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING #
06056  M01S05791.acpd    +++|
06057  M01S05792.acpd    +++|*CALL     COMUCPD
06058  M01S05793.acpd    +++|
06059  M01S05794.acpd    +++|#
06060  M01S05795.acpd    +++|*     LOCAL VARIABLES.
06061  M01S05796.acpd    +++|#
06062  M01S05797.acpd    +++|
06063  M01S05798.acpd    +++|      ITEM I          I;             # FOR LOOP CONTROL #
06064  M01S05799.acpd    +++|      ITEM WA         I;             # ADDRESS OF DECODED BUFFER #
06065  M01S05800.acpd    +++|
06066  M01S05801.acpd    +++|      BASED
06067  M01S05802.acpd    +++|      ARRAY SUM [0:0] P(1);;         # DUMMY BUFFER #
06068  M01S05803.acpd    +++|
06069  M01S05804.acpd    +++|
06070  M01S05805.acpd    +++|
06071  M01S05806.acpd    +++|
06072  M01S05807.acpd    +++|
06073  M01S05808.acpd    +++|#
06074  M01S05809.acpd    +++|*     BEGIN WRTSUM PROC.
06075  M01S05810.acpd    +++|#
06076  M01S05811.acpd    +++|
06077  M01S05812.acpd    +++|      P<DCDT>=LOC(DBUF[DCHL]);
06078  M01S05813.acpd    +++|      WA=1;
06079  M01S05814.acpd    +++|      SLOWFOR I=1 STEP 1 UNTIL NIP
06080  M01S05815.acpd    +++|      DO
06081  M01S05816.acpd    +++|        BEGIN
06082  M01S05817.acpd    +++|        P<SUM>=LOC(DCDT$WD[WA]);
06083  M01S05818.acpd    +++|        WRITEW(FETS,SUM,DCDL,0);     # WRITE AVERAGE #
06084  M01S05819.acpd    +++|        P<SUM>=LOC(DCDT$WD[DCDC*DCDL + WA]);
06085  M01S05820.acpd    +++|        WRITEW(FETS,SUM,DCDL,0);     # WRITE STANDARD DEVIATION #
06086  M01S05821.acpd    +++|        WRITER(FETS,1);              # WRITE EOR #
06087  M01S05822.acpd    +++|        WA=WA + DCDL;
06088  M01S05823.acpd    +++|        END
06089  M01S05824.acpd    +++|
06090  M01S05825.acpd    +++|      RETURN;
06091  M01S05826.acpd    +++|      END  # WRTSUM #
06092  M01S05827.acpd    +++|
06093  M01S05828.acpd    +++|      TERM
06094  M01S05829.acpd    +++|FUNC XCED((NUM)) C(10);
06095  M01S05830.acpd    +++|# TITLE XCED - CONVERT NUMBER TO THE DISPLAY *E* FORMAT.  #
06096  M01S05831.acpd    +++|
06097  M01S05832.acpd    +++|      BEGIN  # XCED #
06098  M01S05833.acpd    +++|
06099  M01S05834.acpd    +++|#
06100  M01S05835.acpd    +++|**    XCED - CONVERT NUMBER TO THE DISPLAY *E* FORMAT.
06101  M01S05836.acpd    +++|*
06102  M01S05837.acpd    +++|*     *XCED* CONVERTS A REAL NUMBER TO THE FORTRAN *E* FORMAT.
06103  M01S05838.acpd    +++|*     THE NUMBER HAS TO BE GREATER THAN 1.0E4 AND LESS THAN
06104  M01S05839.acpd    +++|*     (2**32 - 1).
06105  M01S05840.acpd    +++|*     THE RESULT IS A NORMALIZED NUMBER IN DISPLAY CODE.
06106  M01S05841.acpd    +++|*     THE FORMAT OF THE CONVERTED NUMBER IS :
06107  M01S05842.acpd    +++|*
06108  M01S05843.acpd    +++|*     BB.XXXXEYY
06109  M01S05844.acpd    +++|*
06110  M01S05845.acpd    +++|*     THE VALUE IS RIGHT-JUSTIFIED, BLANK FILLED.
06111  M01S05846.acpd    +++|*     IF THE EXPONENT *YY* IS ONLY ONE DIGIT LONG,
06112  M01S05847.acpd    +++|*     THE MANTISSA *XXXX* IS INCREASED TO FIVE DIGITS.
06113  M01S05848.acpd    +++|*
06114  M01S05849.acpd    +++|*     FUNC XCED((NUM)) C(10)
06115  M01S05850.acpd    +++|*
06116  M01S05851.acpd    +++|*     ENTRY     NUM = NUMBER TO BE CONVERTED.
06117  M01S05852.acpd    +++|*
06118  M01S05853.acpd    +++|*     EXIT      THE NUMBER IS NORMALIZED AND CONVERTED TO
06119  M01S05854.acpd    +++|*               DISPLAY CODE.
06120  M01S05855.acpd    +++|#
06121  M01S05856.acpd    +++|
06122  M01S05857.acpd    +++|#
06123  M01S05858.acpd    +++|*     PARAMETER LIST.
06124  M01S05859.acpd    +++|#
06125  M01S05860.acpd    +++|
06126  M01S05861.acpd    +++|      ITEM NUM        R;             # NUMBER TO BE CONVERTED #
06127  M01S05862.acpd    +++|
06128  M01S05863.acpd    +++|#
06129  M01S05864.acpd    +++|****  FUNC XCED - XREF LIST BEGIN.
06130  M01S05865.acpd    +++|#
06131  M01S05866.acpd    +++|
06132  M01S05867.acpd    +++|      XREF
06133  M01S05868.acpd    +++|        BEGIN
06134  M01S05869.acpd    +++|        FUNC XCDD C(10);             # BINARY TO DISPLAY DECIMAL #
06135  M01S05870.acpd    +++|        END
06136  M01S05871.acpd    +++|
06137  M01S05872.acpd    +++|#
06138  M01S05873.acpd    +++|****  FUNC XCED - XREF LIST END.
06139  M01S05874.acpd    +++|#
06140  M01S05875.acpd    +++|
06141  M01S05876.acpd    +++|      DEF LISTCON    #0#;            # TURN OFF COMMON DECK LISTING #
06142  M01S05877.acpd    +++|
06143  M01S05878.acpd    +++|*CALL      COMUCPD
06144  M01S05879.acpd    +++|
06145  M01S05880.acpd    +++|#
06146  M01S05881.acpd    +++|*     LOCAL VARIABLES.
06147  M01S05882.acpd    +++|#
06148  M01S05883.acpd    +++|
06149  M01S05884.acpd    +++|      ITEM EXP        I;             # EXPONENT #
06150  M01S05885.acpd    +++|      ITEM I          I;             # FOR LOOP CONTROL #
06151  M01S05886.acpd    +++|      ITEM J          I;             # FOR LOOP CONTROL #
06152  M01S05887.acpd    +++|      ITEM NUMF       R;             # TEMPORARY VARIABLE #
06153  M01S05888.acpd    +++|      ITEM NUMI       I;             # TEMPORARY VARIABLE #
06154  M01S05889.acpd    +++|      ITEM P          I;             # POSITION OF *E* #
06155  M01S05890.acpd    +++|      ITEM TEM1       C(10);         # TEMPORARY VARIABLE #
06156  M01S05891.acpd    +++|
06157  M01S05892.acpd    +++|      ARRAY TEM [0:0] P(1);          # TEMPORARY STORAGE #
06158  M01S05893.acpd    +++|        BEGIN  # ARRAY TEM #
06159  M01S05894.acpd    +++|        ITEM T$WD       C(00,00,10);  # CONVERTED NUMBER #
06160  M01S05895.acpd    +++|        ITEM T$DP       C(00,12,01);  # DECIMAL POINT #
06161  M01S05896.acpd    +++|        END  # ARRAY TEM #
06162  M01S05897.acpd    +++|
06163  M01S05898.acpd    +++|
06164  M01S05899.acpd    +++|
06165  M01S05900.acpd    +++|
06166  M01S05901.acpd    +++|
06167  M01S05902.acpd    +++|#
06168  M01S05903.acpd    +++|*     BEGIN XCED FUNC.
06169  M01S05904.acpd    +++|#
06170  M01S05905.acpd    +++|
06171  M01S05906.acpd    +++|      NUMF=NUM;
06172  M01S05907.acpd    +++|      EXP=0;
06173  M01S05908.acpd    +++|
06174  M01S05909.acpd    +++|#
06175  M01S05910.acpd    +++|*     NORMALIZE THE NUMBER.
06176  M01S05911.acpd    +++|#
06177  M01S05912.acpd    +++|
06178  M01S05913.acpd    +++|      SLOWFOR I=1 WHILE (NUMF GQ 1.0)
06179  M01S05914.acpd    +++|      DO
06180  M01S05915.acpd    +++|        BEGIN
06181  M01S05916.acpd    +++|        NUMF=NUMF/10.0;
06182  M01S05917.acpd    +++|        EXP=EXP + 1;
06183  M01S05918.acpd    +++|        END
06184  M01S05919.acpd    +++|
06185  M01S05920.acpd    +++|      T$WD[0]=XCDD(EXP);
06186  M01S05921.acpd    +++|      T$DP[0]=".";                   # DECIMAL POINT #
06187  M01S05922.acpd    +++|      P=8;                           # POSITION OF *E* #
06188  M01S05923.acpd    +++|      IF (EXP GQ 10)
06189  M01S05924.acpd    +++|      THEN
06190  M01S05925.acpd    +++|        BEGIN
06191  M01S05926.acpd    +++|        P=7;
06192  M01S05927.acpd    +++|        END
06193  M01S05928.acpd    +++|
06194  M01S05929.acpd    +++|      NUMI=NUM;
06195  M01S05930.acpd    +++|      TEM1=XCDD(NUMI);
06196  M01S05931.acpd    +++|
06197  M01S05932.acpd    +++|#
06198  M01S05933.acpd    +++|*     MOVE THE MOST SIGNIFICANT DIGITS TO *TEM*.
06199  M01S05934.acpd    +++|#
06200  M01S05935.acpd    +++|
06201  M01S05936.acpd    +++|      SLOWFOR I=0 STEP 1 WHILE (C<I,1>TEM1 EQ " ")
06202  M01S05937.acpd    +++|      DO;                            # FIND THE FIRST DIGIT #
06203  M01S05938.acpd    +++|
06204  M01S05939.acpd    +++|      FASTFOR J=3 STEP 1 UNTIL P-1
06205  M01S05940.acpd    +++|      DO
06206  M01S05941.acpd    +++|         BEGIN  # MOVE THE MOST SIGNIFICANT DIGITS #
06207  M01S05942.acpd    +++|         C<J,1>T$WD[0]=C<I,1>TEM1;
06208  M01S05943.acpd    +++|         I=I+1;
06209  M01S05944.acpd    +++|         END  # MOVE THE MOST SIGNIFICANT DIGITS #
06210  M01S05945.acpd    +++|
06211  M01S05946.acpd    +++|      C<P,1>T$WD[0]="E";             # PLACE THE *E* CHARACTER #
06212  M01S05947.acpd    +++|      XCED=T$WD[0];
06213  M01S05948.acpd    +++|      RETURN;
06214  M01S05949.acpd    +++|      END  # XCED #
06215  M01S05950.acpd    +++|
06216  M01S05951.acpd    +++|      TERM
cdc/nos2.source/opl.opl871/deck/acpd.004.txt ยท Last modified: by 127.0.0.1