付録D.1 例題プログラム
- 〈この項の構成〉
(1) 主プログラム(AVERAGE)
入力ファイルinputdata.txtからEnglish,Japanese,Mathematicsの得点を入力し,3教科の平均点を表示するプログラムです。
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.