Quelle sample COCOL code.html

Sprache: HTML

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>


</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>


</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>

Messung V0.5 in Prozent

¤ Dauer der Verarbeitung: 0.21 Sekunden (vorverarbeitet am 2026-06-07) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

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 und die Messung sind noch experimentell.