| products/sources/formale Sprachen/Cobol/verschiedene-Autoren/Zing-COBOL/sample COCOL code.html |
 |
<html><head><title>Sample Code</title>
<script src="sam-Dateien/common.js">
</script><link rel="stylesheet" href="sam-Dateien/zingcob.css" type="text/css"></head><body onload="setVariables();checkLocation();MessageOn()" alink="#00ffa5" background="sam-Dateien/t2sam.jpg" link="#dc0000" vlink="#272773"> <a href="http://www.404i.com/cobol/samprint.html">Print-friendly version</a>
<script language="Javascript">
function MessageOn() {
var MessText = '------------- 10. SAMPLE CODE -------------';
window.status = MessText;
}
</script>
<div id="object1" style="position: absolute; left: 90%; top: 0px; z-index: 2;">
<form>
<font face="Arial" size="1"><input value="SITE MENU" onclick="showRemote();" type="button"></font>
</form>
</div>
<hr size="1" width="70%">
<center>
<table bgcolor="#ecf7f4" border="0" cellpadding="10" width="450">
<tbody><tr><td>
<b><font face="Arial" size="4">
10. Sample COBOL code
</font></b><font face="Arial,Helvetica"><font size="+1"></font></font>
<p><font face="Arial">
<a href="http://www.404i.com/cobol/cng/index.html">10.0 Complete program specification for suite of 3 linked programs</a>:<br>
includes structure and flow charts,
program description, test data, and full code listing.<br>
<a href="#ADD">10.1 Add line number program</a>
<br>
<a href="#REF">10.2 Refresh line numbers program</a>
<br>
<a href="#LEA">10.3 League table program</a>
<br>
<a href="#CAL">10.4 Calculate prime numbers program</a>
<br>
<a href="#CIN">10.5 Create INDEXED file program</a>
<br>
<a href="#RIN">10.6 Read INDEXED file program</a><br><br><br>
<br>
</font></p><p><font face="Arial">The sample code here was written while learning COBOL so they aren't particularly well
structured. Also, they are not the usual type of COBOL program that you would normally come
across. COBOL is more likely written for business applications such as payroll programs
or stock control etc... Hopefully they might give an indication of how COBOL works.
</font></p><p><font face="Arial"><a name="ADD"> </a><br>
<b><font face="Arial">10.1 Add line numbers program</font></b>
</font></p><p><font face="Arial">This program is designed to add line numbers to COBOL code that has been
typed into a text editor (e.g. Notepad) in the following format:<br>
</font></p><center>
<table border="1">
<tbody><tr><td>
<font face="Courier New">
<b><pre> :
PROCEDURE DIVISION.
MAIN-PARAGRAPH.
MOVE X TO Y
*the comment asterisk will be placed in position 7
/as will the page break solidus
IF Y > Z THEN
ADD Z TO X
MOVE X TO Z
ELSE DISPLAY 'The hypen for continuing a string
- 'onto the next line also goes into position 7'
END-IF
*all other text is placed from position 8
*so you still need to indent where required
STOP RUN.
*lastly, there is a limit of about
*70 characters per line (from position 8)
</pre>
</b>
</font>
</td></tr>
</tbody></table><font face="Arial"><br>
</font></center>
<font face="Arial">The text file containing COBOL code as above should be call named <b>input.txt</b>. Following execution,
the program will produce a new file called <b>output.cob</b> although it will still be a simply text file, but
can be compiled. The output.cob file for the above code would be:<br>
</font><center>
<table border="1">
<tbody><tr><td>
<font face="Courier New">
<b><pre> :
000010 PROCEDURE DIVISION.
000020
000030 MAIN-PARAGRAPH.
000040 MOVE X TO Y
000050*the comment asterisk will be placed in position 7
000060/as will the page break solidus
000070 IF Y > Z THEN
000080 ADD Z TO X
000090 MOVE X TO Z
000100 ELSE DISPLAY 'The hypen for continuing a string
000110- 'onto the next line also goes into position 7'
000120 END-IF
000130*all other text is placed from position 8
000140*so you still need to indent where required
000150 STOP RUN.
000160
000170*lastly, there is a limit of about
000180*70 characters per line (from position 8)
</pre>
</b>
</font>
</td></tr>
</tbody></table><font face="Arial"><br><br>
</font></center>
<form name="form1">
<p></p><center><font face="Arial"><font face="Courier New">
<textarea rows="25" cols="69" wrap="NO" name="txt">000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. LINE-NO-PROG.
000030 AUTHOR. TIM R P BROWN.
000040****************************************************
000050* Program to add line numbers to typed code *
000060* Allows for comment asterisk, solidus, or hyphen ,*
000070* moving it into position 7. *
000080* *
000090****************************************************
000100
000110 ENVIRONMENT DIVISION.
000120 INPUT-OUTPUT SECTION.
000130 FILE-CONTROL.
000140 SELECT IN-FILE ASSIGN TO 'INPUT.TXT'
000150 ORGANIZATION IS LINE SEQUENTIAL.
000160 SELECT OUT-FILE ASSIGN TO 'OUTPUT.COB'
000170 ORGANIZATION IS LINE SEQUENTIAL.
000180
000185*****************************************************
000187
000190 DATA DIVISION.
000200 FILE SECTION.
000210
000220 FD IN-FILE.
000230 01 LINE-CODE-IN.
000240 03 CHAR-1 PIC X.
000250 03 CODE-LINE PIC X(110).
000260
000270 FD OUT-FILE.
000280 01 LINE-CODE-OUT PIC X(120).
000290
000300
000310 WORKING-STORAGE SECTION.
000320
000330 01 EOF-FLAG PIC X VALUE 'N'.
000340 88 END-OF-FILE VALUE 'Y'.
000350
000360 01 NUMBER-CODE.
000370 03 L-NUM-CODE PIC 9(6) VALUE ZEROS.
000380 03 B-SPACE PIC X VALUE SPACE.
000390 03 L-CODE PIC X(100) VALUE SPACES.
000400
000410 01 NUMBER-COMMENT.
000420 03 L-NUM-COM PIC 9(6) VALUE ZEROS.
000430 03 L-COMMENT PIC X(100) VALUE SPACES.
000440
000450 01 LINE-NUMBER PIC 9(6) VALUE ZEROS.
000460
000470
000480*****************************************************
000490
000500 PROCEDURE DIVISION.
000510
000510 MAIN-PARA.
000520 OPEN INPUT IN-FILE
000530 OUTPUT OUT-FILE
000535
000540 PERFORM UNTIL END-OF-FILE
000550 ADD 10 TO LINE-NUMBER
000560 READ IN-FILE AT END
000570 MOVE 'Y' TO EOF-FLAG
000580 NOT AT END
000590 IF (CHAR-1 = '*')
000600 OR (CHAR-1 = '/')
000610 OR (CHAR-1 = '-') THEN
000620 MOVE LINE-CODE-IN TO L-COMMENT
000630 MOVE LINE-NUMBER TO L-NUM-COM
000640 WRITE LINE-CODE-OUT FROM NUMBER-COMMENT
000660 ELSE
000670 MOVE LINE-CODE-IN TO L-CODE
000680 MOVE LINE-NUMBER TO L-NUM-CODE
000690 WRITE LINE-CODE-OUT FROM NUMBER-CODE
000720 END-IF
000730 END-READ
000740 INITIALIZE NUMBER-CODE NUMBER-COMMENT
000750 END-PERFORM
000760
000770 CLOSE IN-FILE OUT-FILE
000780 STOP RUN.
</textarea></font>
<input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">
</font></center>
<p><font face="Arial"><a name="REF"> </a><br>
<b><font face="Arial">10.2 Refresh line numbers program</font></b>
</font></p><p><font face="Arial">This program is designed to refresh COBOL code line numbers following editing that would
result in uneven line number increases (or even no line number at all) where lines have been
inserted or deleted.
</font></p><form name="form2">
<p></p><center><font face="Arial"><font face="Courier New">
<textarea rows="25" cols="70" wrap="yes" name="txt"> 00010 IDENTIFICATION DIVISION.
00020 PROGRAM-ID. RENUMBER-PROG.
00030 AUTHOR. TIMOTHY R P BROWN.
00040
00045******************************************************
00050* Program to refresh numbers to typed code *
00060* Allows for comment all characters at position 7 *
00065******************************************************
00070
00080
00090 ENVIRONMENT DIVISION.
00100 INPUT-OUTPUT SECTION.
00110 FILE-CONTROL.
00120 SELECT IN-FILE ASSIGN TO 'INPUT.COB'
00130 ORGANIZATION IS LINE SEQUENTIAL.
00140 SELECT OUT-FILE ASSIGN TO 'RENUM.COB'
00150 ORGANIZATION IS LINE SEQUENTIAL.
00160
00170 DATA DIVISION.
00180 FILE SECTION.
00190
00200 FD IN-FILE.
00210 01 CODE-IN.
00230 03 OLD-NUM PIC 9(6).
00240 03 IN-CODE PIC X(150).
00250
00260 FD OUT-FILE.
00270 01 CODE-OUT PIC X(91).
00280
00290
00300 WORKING-STORAGE SECTION.
00310
00320 01 EOF-FLAG PIC X VALUE 'N'.
00330 88 END-OF-FILE VALUE 'Y'.
00340
00350
00360 01 W-RENUMBER-CODE.
00370 03 W-NUM PIC 9(6) VALUE ZEROS.
00380 03 W-CODE PIC X(85) VALUE SPACES.
00390
00400 01 LINE-NUMBER PIC 9(6) VALUE ZEROS.
00403
00407*****************************************************
00410
00420 PROCEDURE DIVISION.
00430 MAIN-PARA.
00440 OPEN INPUT IN-FILE
00450 OUTPUT OUT-FILE
00460
00470 PERFORM UNTIL END-OF-FILE
00480 ADD 10 TO LINE-NUMBER
00490 READ IN-FILE
00495 AT END MOVE 'Y' TO EOF-FLAG
00500 NOT AT END
00510 MOVE IN-CODE TO W-CODE
00520 MOVE LINE-NUMBER TO W-NUM
00530 WRITE CODE-OUT FROM W-RENUMBER-CODE
00550 END-READ
00570 END-PERFORM
00580
00590 CLOSE IN-FILE OUT-FILE
00600 STOP RUN.
</textarea></font>
<input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">
</font></center>
<p><font face="Arial"><a name="LEA"> </a><br>
<b><font face="Arial">10.3 League table program</font></b>
</font></p><p><font face="Arial">This program is designed to update a football league table and print out a table
when any scores have been added. The diplay prompts the user to input the score from
a game. The points for each team involved are updated, as are the goals for, against and
difference. The program will search the data file and update the relevant team record.
When score input is complete, the program then sorts the data into a temporary file before
printing out an updated league table. An OUTPUT PROCEDURE could have been used
instead of producing a temporary sorted file.
</font></p><p><font face="Arial"> This program would probably benefit from using an indexed file for the team records rather
than searching the sequentail file, as done here.
</font></p><p><font face="Arial"> This code is written for the 1999-2000 season of the English FA Premiership.
The team data is stored on a sequential file in alphabetical order. If you wish to download
a copy of this data file (with mostly fictional scores etc..) <a href="http://www.404i.com/cobol/dlfiles/footprog.zip">
click here</a> and a better program description <a href="http://www.404i.com/cobol/dlfiles/foot-prog-desc.html">click here</a>.
</font></p><p></p><center><font face="Arial"><font face="Courier New">
</font></font><form name="form3">
<textarea rows="25" cols="70" wrap="no" name="txt">000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. TABLE-PROG.
000030 AUTHOR. TIMOTHY R P BROWN.
000035
000037*****************************************************
000040* Program to update a football league table *
000045* and output a new updated table *
000046* Based on English Premiership season 1999-2000 *
000047*****************************************************
000048
000050 ENVIRONMENT DIVISION.
000060 INPUT-OUTPUT SECTION.
000070 FILE-CONTROL.
000080 SELECT TEAM-REC-IN ASSIGN TO "INPUT.REC"
000090 ORGANIZATION IS SEQUENTIAL.
000100 SELECT WORK-FILE ASSIGN TO SORTWK01.
000105* for MicroFocus compiler
000107* replace SORTWK01 with 'WORKFILE.DAT'
000110 SELECT SORT-OUT ASSIGN TO "SORTED.REC"
000120 ORGANIZATION IS SEQUENTIAL.
000130 SELECT PRINT-FILE ASSIGN TO PRINTER.
000140
000150
000160 DATA DIVISION.
000170 FILE SECTION.
000180 FD TEAM-REC-IN.
000190 01 TEAM-REC.
000200 03 TEAM-CODE PIC XXX.
000210 03 TEAM-NAME PIC X(20).
000220 03 PLAYED PIC 99.
000230 03 GOALS-FOR PIC 99.
000240 03 GOALS-AGST PIC 99.
000250 03 G-WON PIC 99.
000260 03 G-LOST PIC 99.
000270 03 G-DRAWN PIC 99.
000280 03 GOAL-DIFF PIC S99 SIGN LEADING SEPARATE.
000290 03 POINTS PIC 99.
000300
000310 SD WORK-FILE.
000320 01 WORK-REC.
000330 03 TEAM-CODE-KEY PIC XXX.
000340 03 PIC X(22).
000350 03 GF-KEY PIC 99.
000360 03 PIC X(8).
000370 03 GD-KEY PIC S99 SIGN LEADING SEPARATE.
000380 03 POINTS-KEY PIC 99.
000390
000400
000410 FD PRINT-FILE.
000420 01 TEXT-OUT PIC X(60).
000430
000440 FD SORT-OUT.
000450 01 TEAM-REC-OUT.
000460 03 STEAM-CODE PIC XXX.
000470 03 STEAM-NAME PIC X(20).
000480 03 SPLAYED PIC 99.
000490 03 SGOALS-FOR PIC 99.
000500 03 SGOALS-AGST PIC 99.
000510 03 SG-WON PIC 99.
000520 03 SG-LOST PIC 99.
000530 03 SG-DRAWN PIC 99.
000540 03 SGOAL-DIFF PIC S999.
000550 03 SPOINTS PIC 99.
000560
000570
000580
000590
000600 WORKING-STORAGE SECTION.
000610
000620 01 M PIC 99.
000630 01 REAL-GOAL-DIFF PIC S999.
000640
000650 01 W-DATE.
000660 03 W-YEAR PIC 99.
000670 03 W-MON PIC 99.
000680 03 W-DAY PIC 99.
000690
000700
000710 01 SCORE.
000720 03 W-H-SCR PIC 9.
000730 03 PIC X VALUE "-".
000740 03 W-A-SCR PIC 9.
000750
000760 01 P-TITLE.
000770 03 PIC X(5) VALUE SPACES.
000780 03 TAB-TITLE PIC X(34)
000790 VALUE "The English FA Premier League".
000800
000810 03 P-DATE.
000820 05 P-DAY PIC XX.
000830 05 PIC X VALUE "/".
000840 05 P-MON PIC XX.
000850 05 PIC X VALUE "/".
000860 05 P-YEAR PIC XX.
000870
000880 01 P-UNDERLINE PIC X(45) VALUE ALL "-".
000890 01 P-GAP PIC X VALUE SPACE.
000900
000910 01 P-HEADER.
000920 03 PIC X(6) VALUE SPACES.
000930 03 TAB-TEAM PIC X(4) VALUE "TEAM".
000940 03 PIC X(11) VALUE SPACES.
000950 03 PLY PIC X(5) VALUE "Playd".
000960 03 PIC X VALUE SPACE.
000970 03 WO PIC XXX VALUE "Won".
000980 03 PIC X VALUE SPACE.
000990 03 DR PIC XXXX VALUE "Drwn".
001000 03 PIC X VALUE SPACE.
001010 03 LO PIC XXXX VALUE "Lost".
001020 03 PIC X VALUE SPACE.
001030 03 GF PIC XXX VALUE "For".
001040 03 PIC X VALUE SPACE.
001050 03 GA PIC X(5) VALUE "Agnst".
001060 03 PIC X VALUE SPACE.
001070 03 GD PIC XX VALUE "GD".
001080 03 PIC X VALUE SPACE.
001090 03 PTS PIC XXX VALUE "PTS".
001100
001110 01 W-TEXT-OUT.
001120 03 P-TAB-POS PIC 99.
001130 03 PIC X VALUE SPACE.
001140 03 P-TEAM PIC X(20).
001150 03 P-PLAYED PIC 99.
001160 03 PIC XXX VALUE SPACES.
001170 03 P-G-WON PIC Z9.
001180 03 PIC XX VALUE SPACES.
001190 03 P-G-DRAWN PIC Z9.
001200 03 PIC XXX VALUE SPACES.
001210 03 P-G-LOST PIC Z9.
001220 03 PIC XXX VALUE SPACES.
001230 03 P-GOALS-FOR PIC 99.
001240 03 PIC XX VALUE SPACES.
001250 03 P-GOALS-AGST PIC 99.
001260 03 PIC XX VALUE SPACES.
001270 03 P-GOAL-DIFF PIC ZZ9.
001280 03 PIC XX VALUE SPACES.
001290 03 P-POINTS PIC Z9.
001300
001310
001320 01 SCORE-TAB.
001330 03 TAB-SCORE PIC 9 OCCURS 2.
001340 01 T-POINTS-TAB.
001350 03 T-POINTS PIC 99 OCCURS 20.
001360 01 POINTS-TAB.
001370 03 TAB-POINTS PIC 9 OCCURS 2.
001380 01 T-G-FOR-TAB.
001390 03 T-G-FOR PIC 99 OCCURS 20.
001400 01 T-G-AGST-TAB.
001410 03 T-G-AGST PIC 99 OCCURS 20.
001420 01 T-G-DIFF-TAB.
001430 03 T-G-DIFF PIC 99 OCCURS 20.
001440 01 TAB-TEAM-NAME.
001450 03 TEAM PIC XXX OCCURS 2.
001460
001470
001480 01 V-TEAM-FLAG PIC X.
001490 88 V-TEAM VALUE "Y".
001500 01 V-SCORE-FLAG PIC X.
001510 88 V-SCORE VALUE "Y".
001520 01 SORT-ONLY-FLAG PIC X.
001530 88 SORT-ONLY VALUE "Y".
001540
001550
001560 01 ENDING-KEY PIC X VALUE SPACE.
001570 01 SWITCH PIC 9.
001580 01 EOF-FLAG PIC X VALUE "N".
001590 01 COUNTER PIC 99.
001600 01 W-GOAL-DIFF PIC 99.
001610 01 LAST-SCORE PIC X.
001620 01 N PIC 99.
001630
001640*****************************************************
001650
001660 PROCEDURE DIVISION.
001670
001680 MAIN-PARAGRAPH.
001690
001700 PERFORM DISPLAY-INSTRUCTIONS
001710 PERFORM INPUT-DATA
001720 PERFORM SORT-TABLE
001730 PERFORM PRINT-TABLE
001740 DISPLAY " Type Q or X to exit program."
001750 ACCEPT ENDING-KEY
001760 STOP RUN.
001770*******************************************************************
001780 DISPLAY-INSTRUCTIONS.
001790 DISPLAY " Instructions"
001800 DISPLAY " "
001810 DISPLAY " Following prompts, enter the first "
001820 DISPLAY "3 letters of the team in lower case. "
001830 DISPLAY " Then enter the score (home team score first)."
001840 DISPLAY " To perform SORT ONLY function, type 'xxx' "
001850 DISPLAY "at both team prompts. ".
001860*******************************************************************
001870 INPUT-DATA.
001880 MOVE "n" TO LAST-SCORE
001890 MOVE "N" TO SORT-ONLY-FLAG
001900 PERFORM UNTIL LAST-SCORE = "y" OR "Y"
001910 MOVE "N" TO V-SCORE-FLAG
001920 MOVE "N" TO V-TEAM-FLAG
001930 PERFORM UNTIL V-TEAM
001940 DISPLAY "INPUT HOME TEAM >"
001950 ACCEPT TEAM (1)
001960 DISPLAY "INPUT AWAY TEAM >"
001970 ACCEPT TEAM (2)
001980 PERFORM VAL-TEAM
001990 END-PERFORM
002000 IF TEAM (1) = "XXX" OR "xxx" THEN
002010 MOVE "Y" TO LAST-SCORE
002020 PERFORM SORT-TABLE
002030 ELSE
002040 PERFORM UNTIL V-SCORE or SORT-ONLY
002050 DISPLAY "INPUT RESULT AS 'X-Y'"
002060 ACCEPT SCORE
002070 MOVE W-H-SCR TO TAB-SCORE (1)
002080 MOVE W-A-SCR TO TAB-SCORE (2)
002090 PERFORM VAL-SCORE
002100 END-PERFORM
002110 DISPLAY "LAST RESULT? Y/N"
002120 ACCEPT LAST-SCORE
002130 PERFORM CALC-POINTS
002140 PERFORM UPDATE-RECORD
002150 END-IF
002160 END-PERFORM.
002170*******************************************************************
002180 VAL-TEAM.
002190 PERFORM VARYING COUNTER FROM 1 BY 1
002200 UNTIL COUNTER > 2
002210
002220 EVALUATE TRUE
002230 WHEN TEAM (COUNTER) = "ars" or "ast" or "bra" or
002240 "che" or "cov" or "der" or
002250 "eve" or "lee" or "lei" or
002260 "liv" or "man" or "mid" or
002270 "new" or "she" or "sou" or
002280 "sun" or "tot" or "wat" or
002290 "wes" or "wim"
002300 MOVE "Y" TO V-TEAM-FLAG
002310 WHEN OTHER MOVE "N" TO V-TEAM-FLAG
002320 END-EVALUATE
002340 END-PERFORM
002350 IF NOT V-TEAM THEN DISPLAY
002360 "INVALID TEAM CODE ENTERED-"
002370 "RE-ENTER BOTH TEAM CODES AGAIN."
002380 END-IF.
002390*******************************************************************
002400 VAL-SCORE.
002410 IF ( W-H-SCR > 9 ) OR ( W-A-SCR > 9 )
002420 THEN PERFORM BIG-SCORE
002430 END-IF
002440 IF ( W-H-SCR NOT NUMERIC) OR ( W-H-SCR NOT NUMERIC)
002450 THEN MOVE "N" TO V-SCORE-FLAG
002460 ELSE MOVE "Y" TO V-SCORE-FLAG
002470 END-IF
002480 IF NOT V-SCORE THEN
002490 DISPLAY "INVALID SCORE ENTRY. PLEASE RE-ENTER SCORE."
002500 END-IF.
002510*******************************************************************
002520 BIG-SCORE.
002525* Putting a STOP RUN in this paragraph is probably
002527* very bad programming practise. Better logic could be used!
002530 DISPLAY "A team has scored more than 10 goals. "
002540 DISPLAY "This program will terminate now. "
002550 DISPLAY "Following this, the record in Input.rec "
002560 DISPLAY "will have to be ammended manually"
002580 DISPLAY " Following this perform SORT ONLY procedure."
002600 ACCEPT ENDING-KEY
002610 STOP RUN.
002620
002630*******************************************************************
002640 CALC-POINTS.
002650 IF TAB-SCORE (1) > TAB-SCORE (2) THEN
002660 MOVE 3 TO TAB-POINTS (1)
002670 ELSE
002680 IF TAB-SCORE (2) > TAB-SCORE (1) THEN
002690 ADD 3 TO TAB-POINTS (2)
002700 ELSE
002710 MOVE 1 TO TAB-POINTS (1)
002720 MOVE 1 TO TAB-POINTS (2)
002730 END-IF
002740 END-IF.
002750
002760*******************************************************************
002770 UPDATE-RECORD.
002790 MOVE 1 TO N
002800 MOVE 1 TO M
002810 OPEN I-O TEAM-REC-IN
002820 PERFORM UNTIL M > 20
002830 READ TEAM-REC-IN
002840 AT END
002850 DISPLAY TEAM (1) " has details ammended"
002860 NOT AT END
002870 IF TEAM (1) = TEAM-CODE THEN
002880 PERFORM ADJUST-DATA
002890
002900 END-IF
002910 ADD 1 TO M
002920 END-READ
002930 END-PERFORM
002940
002950 CLOSE TEAM-REC-IN
002955
002970 MOVE 2 TO N
002980 MOVE 1 TO M
002980
002990 OPEN I-O TEAM-REC-IN
003000 PERFORM UNTIL M > 20
003010 READ TEAM-REC-IN
003020 AT END
003030 DISPLAY TEAM (2) " has details ammended"
003040 NOT AT END
003050 IF TEAM (2) = TEAM-CODE THEN
003060 PERFORM ADJUST-DATA
003080 END-IF
003090 ADD 1 TO M
003100 END-READ
003110 END-PERFORM
003120 CLOSE TEAM-REC-IN
003130 DISPLAY "Table has been updated".
003140*******************************************************************
003150 ADJUST-DATA.
003160 IF N = 1 THEN MOVE 2 TO SWITCH
003170 ELSE MOVE 1 TO SWITCH
003180 END-IF
003190 ADD TAB-SCORE (N) TO GOALS-FOR
003200 ADD TAB-SCORE (SWITCH) TO GOALS-AGST
003210 SUBTRACT GOALS-AGST FROM GOALS-FOR GIVING GOAL-DIFF
003220 ADD TAB-POINTS (N) TO POINTS
003230 ADD 1 TO PLAYED
003240 EVALUATE TAB-POINTS (N)
003250 WHEN 3 ADD 1 TO G-WON
003260 WHEN ZERO ADD 1 TO G-LOST
003270 WHEN 1 ADD 1 TO G-DRAWN
003280 END-EVALUATE
003290 REWRITE TEAM-REC.
003300*******************************************************************
003310 SORT-TABLE.
003320 SORT WORK-FILE
003330 ON DESCENDING KEY POINTS-KEY GD-KEY GF-KEY
003340 USING TEAM-REC-IN
003350 GIVING SORT-OUT.
003360
003370*******************************************************************
003380 PRINT-TABLE.
003390 ACCEPT W-DATE FROM DATE
003400 MOVE W-DAY TO P-DAY
003410 MOVE W-MON TO P-MON
003420 MOVE W-YEAR TO P-YEAR
003430
003440 OPEN INPUT SORT-OUT
003450 OUTPUT PRINT-FILE
003460
003470 WRITE TEXT-OUT FROM P-TITLE AFTER 1 LINE
003480 WRITE TEXT-OUT FROM P-UNDERLINE AFTER 1 LINE
003490 WRITE TEXT-OUT FROM P-GAP AFTER 1 LINE
003500 WRITE TEXT-OUT FROM P-HEADER AFTER 1 LINE
003510 MOVE 1 TO N
003520 PERFORM UNTIL N > 20
003530 READ SORT-OUT
003540 AT END MOVE "Y" TO EOF-FLAG
003550 NOT AT END
003560 MOVE N TO P-TAB-POS
003570 MOVE STEAM-NAME TO P-TEAM
003580 MOVE SPLAYED TO P-PLAYED
003590 MOVE SG-WON TO P-G-WON
003600 MOVE SG-LOST TO P-G-LOST
003610 MOVE SG-DRAWN TO P-G-DRAWN
003620 MOVE SGOALS-FOR TO P-GOALS-FOR
003630 MOVE SGOALS-AGST TO P-GOALS-AGST
003650 MOVE SGOAL-DIFF TO P-GOAL-DIFF
003660 MOVE SPOINTS TO P-POINTS
003670
003680 WRITE TEXT-OUT FROM W-TEXT-OUT
003700 END-READ
003710 ADD 1 TO N
003720 END-PERFORM
003730 CLOSE SORT-OUT PRINT-FILE
003740 DISPLAY "Table is now written to the printer".
003750*******************************************************************
</textarea>
<font face="Arial"><input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">
</font></form></center>
<p><font face="Arial"><a name="CAL"> </a><br>
<b><font face="Arial">10.4 Calculate prime numbers program</font></b>
</font></p><p><font face="Arial">This is a little program that calulates prime numbers. You are prompted to enter
a number (up to 1999) and the program will produce a file, 'PRIME-NO.TXT,
which contains a table of all prime numbers up to the value entered.</font></p>
<p></p><center><font face="Arial"><font face="Courier New">
</font></font><form name="form4">
<textarea rows="25" cols="70" wrap="no" name="txt">000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. PRIME-NO-PROG.
000030 AUTHOR. TIMOTHY R P BROWN.
000040
000050******************************************
000060* PROGRAM TO CALCULATE PRIME NUMBERS *
000070******************************************
000080
000090 ENVIRONMENT DIVISION.
000100 INPUT-OUTPUT SECTION.
000110 FILE-CONTROL.
000120
000130 SELECT OUT-FILE ASSIGN TO 'PRIME-NO.TXT'
000140 ORGANIZATION IS LINE SEQUENTIAL.
000150********************************************
000160 DATA DIVISION.
000170 FILE SECTION.
000180
000190 FD OUT-FILE.
000200 01 NO-OUT PIC X(80).
000210********************************************
000220 WORKING-STORAGE SECTION.
000230
000240 01 EVEN-FLAG PIC X.
000250 88 NUM-EVEN VALUE 'Y'.
000260 01 PRIME-FLAG PIC X .
000270 88 IS-PRIME VALUE 'Y'.
000280
000290 01 TOP-VALUE PIC 9(7) VALUE ZERO.
000300
000310 01 COUNTERS.
000320 03 Y-COUNT PIC 9(6) OCCURS 1000.
000330
000340 01 CALC-NO PIC 9(6) VALUE ZERO.
000350
000360 01 SUBS.
000370 03 X-SUB PIC 9(6) VALUE 3.
000380 01 PRINT-SUBS.
000390 03 P-COUNT-X PIC 9(6) VALUE 1.
000400
000410 01 A PIC 9(6) VALUE ZERO.
000420 01 B PIC 9(6) VALUE ZERO.
000430 01 C PIC 9(6) VALUE ZERO.
000440 01 D PIC 9(6) VALUE ZERO.
000450 01 Z PIC 9(6) VALUE ZERO.
000460 01 PRIME-NO-COUNT PIC 9(6) VALUE 2.
000465
000470 01 PRINT-LINE.
000480 03 P-NUM1 PIC Z(5)9 VALUE ZERO.
000490 03 P-NUM2 PIC Z(5)9 VALUE ZERO.
000500 03 P-NUM3 PIC Z(5)9 VALUE ZERO.
000510 03 P-NUM4 PIC Z(5)9 VALUE ZERO.
000520 03 P-NUM5 PIC Z(5)9 VALUE ZERO.
000530
000540 01 EXIT-KEY PIC X VALUE SPACE.
000545
000550*******************************************************
000560 PROCEDURE DIVISION.
000570 MAIN-PARA.
000580 OPEN OUTPUT OUT-FILE
000590 DISPLAY 'ENTER VALUE TO WHICH PRIME NUMBERS '
000600 DISPLAY 'ARE TO BE CALCULATED BETWEEN 1 AND 999,999'
000602 MOVE 1 TO Y-COUNT (1)
000605 MOVE 2 TO Y-COUNT (2)
000610
000620*ENTER VALUE
000630 PERFORM UNTIL TOP-VALUE > 0
000640 ACCEPT TOP-VALUE
000650 END-PERFORM
000660
000670*ZEROISE TABLE
000680 MOVE ZEROS TO COUNTERS
000690
000700*DETERMINE PRIME NUMBERS AND PLACE IN TABLE
000710
000720 PERFORM VARYING CALC-NO FROM 3 BY 1
000730 UNTIL CALC-NO > TOP-VALUE
000740 DISPLAY CALC-NO
000750 MOVE 1 TO C
000760 MOVE 'N' TO PRIME-FLAG
000770
000780*IS NUMBER EVEN (BUT NOT 2)?
000790
000800 DIVIDE CALC-NO BY 2 GIVING A REMAINDER Z
000830 IF Z = 0 THEN MOVE 'Y' TO EVEN-FLAG
000840 ELSE MOVE 'N' TO EVEN-FLAG
000850 END-IF
000860
000865**********************************************************
000870*DIVIDE EACH ODD NUMBER BY NUMBERS UP TO HALF THE CALC-NO
000880*LOOP EXITED WHEN A NUMBER DIVIDES IT WITH NO REMAINDER
000890*OR WHEN ALL NUMBERS CHECKED
000895**********************************************************
000900 IF NOT NUM-EVEN THEN
000910 PERFORM VARYING D FROM 3 BY 1
000920 UNTIL (C = 0) OR (D > ((CALC-NO + 1) / 2))
000930 DIVIDE CALC-NO BY D GIVING A REMAINDER C
000940 END-PERFORM
000950 END-IF
000960
000970 IF C = 0 THEN MOVE 'N' TO PRIME-FLAG
000980 ELSE MOVE 'Y' TO PRIME-FLAG
000990 END-IF
001000
001010*WHEN PRIME NUMBER DEFINED, MOVE IT INTO TABLE
001020 IF IS-PRIME THEN
001030 MOVE CALC-NO TO Y-COUNT (X-SUB)
001040 ADD 1 TO X-SUB PRIME-NO-COUNT
001050 END-IF
001060 END-PERFORM
001070
001080*STORE THE FINAL VALUE OF X-SUB BEFORE RE-USING IT
001090 MOVE X-SUB TO P-COUNT-X
001100 MOVE ZERO TO X-SUB
001110***************************************************
001120*WRITE TABLE
001130 PERFORM VARYING X-SUB FROM 1 BY 5
001140 UNTIL X-SUB > P-COUNT-X
001150 MOVE Y-COUNT (X-SUB) TO P-NUM1
001160 MOVE Y-COUNT (X-SUB + 1) TO P-NUM2
001170 MOVE Y-COUNT (X-SUB + 2) TO P-NUM3
001180 MOVE Y-COUNT (X-SUB + 3) TO P-NUM4
001190 MOVE Y-COUNT (X-SUB + 4) TO P-NUM5
001200 WRITE NO-OUT FROM PRINT-LINE AFTER 2 LINE
001230 END-PERFORM
001240
001250 DISPLAY 'CALCULATIONS COMPLETE - ' PRIME-NO-COUNT
001260 ' PRIME NUMBERS CALCULATED'
001270 CLOSE OUT-FILE
001280 STOP RUN.
</textarea>
<font face="Arial"><input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">
</font></form></center>
<p><font face="Arial"><a name="CIN"> </a><br>
<b><font face="Arial">10.5 Create INDEXED file program</font></b>
</font></p><p><font face="Arial"><b></b>
</font></p><p><font face="Arial">This program takes a line sequential record file and converts it to an indexed file.
The records must contain a unique key field that is in strict ascending order. The input
file (from a text editor) should be called 'LINESEQFILE.TXT'. The program output will be 'INDEXEDFILE.DAT'.
You can change these in the ENVIRONMENT DIVISION if you want.
</font></p><p></p><center><font face="Arial"><font face="Courier New">
</font></font><form name="form5">
<textarea rows="25" cols="70" wrap="yes" name="txt">000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. CREATE-INDEX-PROG.
000030 AUTHOR. TIMOTHY R P BROWN.
000040
000045*****************************************************
000050* Program to convert a sorted (ascending) *
000060* line sequential file ('LINESEQFILE.TXT') to *
000070* an indexed file (output 'INDEXEDFILE.DAT'). *
000075*****************************************************
000080
000090 ENVIRONMENT DIVISION.
000100 INPUT-OUTPUT SECTION.
000110 FILE-CONTROL.
000120
000130 SELECT OUT-FILE ASSIGN TO 'INDEXEDFILE.DAT'
000140 ORGANIZATION IS INDEXED
000150 ACCESS MODE IS SEQUENTIAL
000160 RECORD KEY IS INDEX-KEY.
000170 SELECT IN-FILE ASSIGN TO 'LINESEQFILE.TXT'
000180 ORGANIZATION IS LINE SEQUENTIAL.
000190
000200 DATA DIVISION.
000210 FILE SECTION.
000220
000230 FD OUT-FILE.
000240 01 MAKE-OUT.
000250 03 INDEX-KEY PIC X(6).
000260 03 PIC X(120).
000270
000280 FD IN-FILE.
000290 01 IN-REC PIC X(126).
000300
000310
000320 WORKING-STORAGE SECTION.
000340
000350 01 EOF-FLAG PIC X VALUE 'N'.
000360 88 END-OF-FILE VALUE 'Y'.
000370
000375*****************************************************
000377
000380 PROCEDURE DIVISION.
000390 MAIN-PARA.
000400 OPEN INPUT IN-FILE
000410 OUTPUT OUT-FILE
000420
000430 PERFORM UNTIL END-OF-FILE
000440 READ IN-FILE
000450 AT END MOVE 'Y' TO EOF-FLAG
000460 NOT AT END
000470 MOVE IN-REC TO MAKE-OUT
000480 WRITE MAKE-OUT
000490 END-READ
000500 END-PERFORM
000510
000520 CLOSE OUT-FILE IN-FILE
000530 STOP RUN.
</textarea>
<font face="Arial"><input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">
</font></form></center>
<p>
<font face="Arial"><a name="RIN"> </a><br>
<b><font face="Arial">10.6 Read INDEXED file program</font></b>
</font></p><p><font face="Arial"><b></b>
</font></p><p>
<font face="Arial">This program allows you to view the contents of an indexed file by generating a
line sequential file of the original indexed file. If you tried to open an indexed file
with a text editor you would just see gibberish. The input file for this program is
'INDEXEDFILE.DAT' giving an output text file called READFILE.TXT. Again, you can change these
in the ENVIRONMENT DIVISION if you wish.
</font></p><p></p><center><font face="Arial"><font face="Courier New">
</font></font><form name="form6">
<textarea rows="25" cols="70" wrap="yes" name="txt">000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. INDEXED-TO-READ-PROG.
000030 AUTHOR. TIMOTHY R P BROWN.
000040
000045*****************************************************
000050* Program to convert indexed file 'INDEXEDFILE.DAT' *
000060* to line sequential (output called 'READFILE.TXT') *
000070* for viewing with text editor. *
000075*****************************************************
000080
000090 ENVIRONMENT DIVISION.
000100 INPUT-OUTPUT SECTION.
000110 FILE-CONTROL.
000120
000130 SELECT IN-FILE ASSIGN TO 'INDEXEDFILE.DAT'
000140 ORGANIZATION IS INDEXED
000150 ACCESS MODE IS DYNAMIC
000160 RECORD KEY IS S-KEY-NO.
000170 SELECT OUT-FILE ASSIGN TO 'READFILE.TXT'
000180 ORGANIZATION IS LINE SEQUENTIAL.
000190
000200 DATA DIVISION.
000210 FILE SECTION.
000220
000230 FD IN-FILE.
000240 01 IN-REC.
000250 03 S-KEY-NO PIC X(6).
000260 03 PIC X(43).
000270
000280 FD OUT-FILE.
000290 01 OUT-REC PIC X(49).
000300
000310
000320 WORKING-STORAGE SECTION.
000340
000350 01 EOF-FLAG PIC X VALUE 'N'.
000360 88 END-OF-FILE VALUE 'Y'.
000370
000373*****************************************************
000377
000380 PROCEDURE DIVISION.
000390 MAIN-PARA.
000400 OPEN INPUT IN-FILE
000410 OUTPUT OUT-FILE
000420
000430 PERFORM UNTIL END-OF-FILE
000440 READ IN-FILE NEXT
000450 AT END MOVE 'Y' TO EOF-FLAG
000460 NOT AT END
000470 WRITE OUT-REC FROM IN-REC
000480 END-READ
000490 END-PERFORM
000500
000510 CLOSE IN-FILE OUT-FILE
000520 STOP RUN.
</textarea>
<font face="Arial"><input value="Highlight code" onclick="javascript:this.form.txt.focus();this.form.txt.select();" type="button">
</font></form></center>
<font face="Arial"><br><br>
<!-- forward and reverse buttons -->
</font><p></p><center>
<font face="Arial"><a href="http://www.404i.com/cobol/linx.html"><img src="sam-Dateien/backward.gif" border="0"></a>
<a href="http://www.404i.com/cobol/feedback.html"><img src="sam-Dateien/forward.gif" border="0"></a>
</font><p></p></center>
<!-- end buttons -->
</form></form></td></tr>
</tbody></table></center>
<hr>
<center>
<table border="3" cellpadding="1" cellspacing="0">
<tbody><tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/getstart.html">1. Getting started</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/fil.html">7. File handling</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/basics.html">2. COBOL basics</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/bug.html">8. Debugging COBOL</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/4div.html">3. The Four Divisions</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/linx.html">9. Useful links</a></font></td></tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/data1.html">4. Defining Data Part 1</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/sam.html">10. Sample Code</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/data2.html">5. Defining Data Part 2</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/feedback.html">11. Feedback</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/comlog1.html">6. Commands and logic</a></font></td>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/qref.html">12. Quick reference</a></font></td>
</tr>
<tr>
<td><font face="Arial" size="1"><a href="http://www.404i.com/cobol/awards.html"> Awards</a></font></td>
<td><font face="Arial" size="2"><a href="http://www.404i.com/cobol/start.html"><b> HOME</b></a></font></td>
</tr>
</tbody></table>
</center>
<font face="Arial"><h6 align="right">Copyright Timothy R P Brown 2002</h6></font>
</body></html>
¤ Dauer der Verarbeitung: 0.25 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
