付録D.1　例題プログラム

(1)　主プログラム（AVERAGE）

入力ファイルinputdata.txtからEnglish，Japanese，Mathematicsの得点を入力し，３教科の平均点を表示するプログラムです。

000010 IDENTIFICATION  DIVISION.
000020 PROGRAM-ID.     AVERAGE.
000030
000040 ENVIRONMENT     DIVISION.
000050 INPUT-OUTPUT    SECTION.
000060 FILE-CONTROL.
000070      SELECT     IN-FILE  ASSIGN TO SYS001
000080        ORGANIZATION IS LINE SEQUENTIAL.
000090      SELECT     OUT-FILE ASSIGN TO SYS002.
000100 DATA            DIVISION.
000110 FILE            SECTION.
000120 FD   IN-FILE.
000130 01   IN-REC.
000140  02   IN-POINT  PIC 9(9).
000150  02   FILLER    PIC X.
000160 FD   OUT-FILE   LABEL RECORD OMITTED.
000170 01   OUT-REC    PIC X(80).
000180 WORKING-STORAGE SECTION.
000190 01  PR-REC.
000200  02  FILLER     PIC X(13) VALUE SPACE.
000210  02  E-POINT    PIC Z(3)9.
000220  02  FILLER     PIC X(6)  VALUE SPACE.
000230  02  K-POINT    PIC Z(3)9.
000240  02  FILLER     PIC X(8)  VALUE SPACE.
000250  02  S-POINT    PIC Z(3)9.
000260  02  FILLER     PIC X(5)  VALUE SPACE.
000270  02  A-POINT    PIC Z(3)9.
000280  02  FILLER     PIC X(31) VALUE SPACE.
000290 01  TITLE.
000300  02  FILLER     PIC X(10) VALUE SPACE.
000310  02  T-REC      PIC X(40)
000320              VALUE 'English  Japanese  Mathematics  Average'.
000330  02  FILLER     PIC X(30) VALUE SPACE.
000340 01  ERR-MSG.
000350  02  FILLER     PIC X(10)  VALUE SPACE.
000360  02  ERMSG      PIC X(34)
000370              VALUE '** Error:  Input data is mistaken.'.
000380  02  ERMSG2     PIC X(18) VALUE ' ==> error data:'.
000390  02  ER-REC.
000400   03  ER-DATA   PIC 9(9).
000410  02  FILLER     PIC X(9)  VALUE SPACE.
000420 01  NO-MSG.
000430  02  FILLER     PIC X(10) VALUE SPACE.
000440  02  NMSG       PIC X(40)
000450              VALUE '** Information:  There is no input data.'.
000460  02  FILLER     PIC X(30) VALUE SPACE.
000470 77  ENDM        PIC X(3).
000480 88  END-OF-FIL  VALUE 'EOF'.
000490 01  WORK-TBL.
000500  02  W-TBL      OCCURS 20.
000510   03  W-REC.
000520    04  WE-P     PIC 9(3).
000530    04  WK-P     PIC 9(3).
000540    04  WS-P     PIC 9(3).
000550   03  WA-P      PIC 9(4).
000560   03  R-CODE    PIC 9.
000570 77  I           PIC 9(3).
000580 77  J           PIC 9(3).
000590*
000600 PROCEDURE       DIVISION.
000610 MAIN-PROCESS    SECTION.
000620 OPEN-FILE.
000630        OPEN INPUT  IN-FILE
000640             OUTPUT OUT-FILE.
000650 MAKING-WTBL.
000660        READ IN-FILE
000670             AT END MOVE 'EOF' TO ENDM.
000680        PERFORM VARYING I FROM 1 BY 1 UNTIL END-OF-FIL
000690          MOVE IN-POINT TO W-REC(I)
000700          READ IN-FILE AT END MOVE 'EOF' TO ENDM
000710          END-READ
000720         END-PERFORM.
000730 ZERO-CHECK.
000740        COMPUTE I = I - 1.
000750        IF I = 0
000760          WRITE OUT-REC FROM NO-MSG AFTER 1
000770          GO TO CLOSE-FILE
000780        ELSE
000790          CONTINUE
000800        END-IF.
000810 CALCULATE.
000820        CALL 'SUBAV' USING WORK-TBL I.
000830 PRINTING-DATA.
000840        PERFORM  DATA-PUT.
000850 CLOSE-FILE.
000860       CLOSE IN-FILE OUT-FILE.
000870       STOP RUN.
000880*
000890 DATA-PUT        SECTION.
000900 PRINTING-TITLE.
000910        WRITE OUT-REC FROM TITLE AFTER 1.
000920 PRINTING-AVERAGE.
000930        PERFORM VARYING J FROM 1 BY 1 UNTIL J > I
000940          IF R-CODE(J) = 8
000950            MOVE W-REC(J) TO ER-REC
000960            WRITE OUT-REC FROM ERR-MSG AFTER 1
000970          ELSE
000980            MOVE WE-P(J) TO E-POINT
000990            MOVE WK-P(J) TO K-POINT
001000            MOVE WS-P(J) TO S-POINT
001010            MOVE WA-P(J) TO A-POINT
001020            WRITE OUT-REC FROM PR-REC AFTER 1
001030          END-IF
001040        END-PERFORM.
001050 END PROGRAM AVERAGE.

(2)　副プログラム（SUBAV）

平均点を計算するプログラムです。

000010 IDENTIFICATION  DIVISION.
000020 PROGRAM-ID.     SUBAV.
000030 ENVIRONMENT     DIVISION.
000040 DATA            DIVISION.
000050 WORKING-STORAGE SECTION.
000060 77  I            PIC S9(8) COMP.
000070 77  J            PIC S9(8) COMP.
000080 77  K            PIC S9(8) COMP.
000090 77  L            PIC S9(8) COMP.
000100 77  M            PIC S9(8) COMP.
000110 77  MM           PIC S9(8) COMP.
000120 77  CHGSW        PIC X     VALUE LOW-VALUE.
000130 88  NO-CHANGE    VALUE HIGH-VALUE.
000140 88  ALL-CHANGE   VALUE LOW-VALUE.
000150 01  SORT-TBL.
000160  02  S-TBL       OCCURS 20 INDEXED BY DATA-INDEX
000170                                       COMP-INDEX1
000180                                       COMP-INDEX2.
000190   03  S-P.
000200    04  FILLER    PIC 9(9).
000210   03  SA-P       PIC 9(4).
000220   03  FILLER     PIC 9.
000230 01  SW-TBL.
000240  02  SORT-ITEM   INDEX  OCCURS 20 INDEXED BY SORT-INDEX.
000250 LINKAGE         SECTION.
000260 01  WORK-TBL.
000270  02  W-TBL       OCCURS 20.
000280   03  W-REC.
000290    04  WE-P      PIC 9(3).
000300    04  WK-P      PIC 9(3).
000310    04  WS-P      PIC 9(3).
000320   03  WA-P       PIC 9(4).
000330   03  R-CODE     PIC 9.
000340 77  KOSU         PIC 9(3).
000350*                      
000360 PROCEDURE       DIVISION USING WORK-TBL KOSU.
000370 MAIN-PROCESS    SECTION.
000380 DATA-CHEK-AND-COMPUTE.
000390        PERFORM VARYING I FROM 1 BY 1 UNTIL I > KOSU
000400          MOVE ZERO TO WA-P(I)
000410          IF WE-P(I) > 100 OR
000420             WK-P(I) > 100 OR
000430             WS-P(I) > 100
000440            MOVE 8 TO R-CODE(I)
000450          ELSE
000460            MOVE 0 TO R-CODE(I)
000470            COMPUTE WA-P(I) ROUNDED
000480              = (WE-P(I) + WK-P(I) + WS-P(I)) / 3
000490          END-IF
000500          MOVE W-TBL(I) TO S-TBL(I).
000510        END-PERFORM.
000520        PERFORM DATA-SORT.
000530        EXIT PROGRAM.
000540*
000550 DATA-SORT       SECTION.
000560        IF KOSU = 1 THEN
000570          GO TO DATA-SORT-EXIT
000580        ELSE
000590          CONTINUE 
000600        END-IF.
000610        PERFORM VARYING I FROM 1 BY 1 UNTIL I > 20
000620          SET DATA-INDEX TO I
000630          SET SORT-ITEM(I) TO DATA-INDEX
000640        END-PERFORM.
000650        MOVE 2 TO M.
000660        PERFORM UNTIL M > KOSU
000670          COMPUTE M = M * 2
000680        END-PERFORM.
000690        COMPUTE M = M / 2 - 1.
000700        PERFORM UNTIL M < 1
000710          PERFORM VARYING I FROM 1 BY 1 UNTIL I > M
000720            PERFORM VARYING J FROM I BY M UNTIL J + M > KOSU
000730              COMPUTE K = J + M
000740              SET COMP-INDEX1 TO SORT-ITEM(J)
000750              SET COMP-INDEX2 TO SORT-ITEM(K)
000760              IF SA-P(COMP-INDEX1) < SA-P(COMP-INDEX2) THEN
000770                SET SORT-ITEM(K) TO COMP-INDEX1
000780                MOVE LOW-VALUE TO CHGSW
000790                COMPUTE MM = - M
000800                PERFORM VARYING K FROM J BY MM
000810                        UNTIL K - M < I OR NO-CHANGE
000820                  COMPUTE L = K - M
000830                  SET COMP-INDEX1 TO SORT-ITEM(L)
000840                  IF SA-P(COMP-INDEX1) < SA-P(COMP-INDEX2) THEN
000850                    SET SORT-ITEM(K) TO COMP-INDEX1
000860                  ELSE
000870                    SET SORT-ITEM(K) TO COMP-INDEX2
000880                    MOVE HIGH-VALUE TO CHGSW
000890                  END-IF
000900                END-PERFORM
000910                IF ALL-CHANGE THEN
000920                  IF J = I THEN
000930                    SET SORT-ITEM(J) TO COMP-INDEX2
000940                  ELSE
000950                    SET SORT-ITEM(L) TO COMP-INDEX2
000960                  END-IF
000970                ELSE
000980                  CONTINUE
000990                END-IF
001000              ELSE
001010                CONTINUE
001020              END-IF
001030            END-PERFORM
001040          END-PERFORM
001050          COMPUTE M = M / 2
001060        END-PERFORM.
001070        PERFORM VARYING J FROM 1 BY 1 UNTIL J > KOSU
001080          SET DATA-INDEX TO SORT-ITEM(J)
001090          MOVE S-TBL(DATA-INDEX) TO W-TBL(J)
001100        END-PERFORM.
001110 DATA-SORT-EXIT.
001120        EXIT.
001130 END PROGRAM SUBAV.

(3)　実行結果