HP 3000 Manuals HP 3000 Manuals
Sample Programs
This section lists the HP COBOL II, HP FORTRAN 77, and HP Pascal source
files used in the examples in the previous sections of this chapter.
These source are listed in:
files:
EX1SRC Figure 2-15
EX2ASRC Figure 2-16
EX2BSRC Figure 2-17
LIB1SRC Figure 2-18
LIB2SRC Figure 2-19
LIB3SRC Figure 2-20
LIB4SRC Figure 2-21
LIB5SRC Figure 2-22
EX3ASRC Figure 2-23
EX3BSRC Figure 2-24
EX3CSRC Figure 2-25
EX3DSRC Figure 2-26
____________________________________________________________________
| |
| IDENTIFICATION DIVISION. |
| PROGRAM-ID. EX1. |
| ENVIRONMENT DIVISION. |
| INPUT-OUTPUT SECTION. |
| FILE-CONTROL. |
| SELECT IFILE ASSIGN "IFILE". |
| SELECT PFILE ASSIGN "PFILE". |
| DATA DIVISION. |
| FILE SECTION. |
| FD IFILE. |
| 01 IREC. |
| 05 NAME PIC X(30). |
| 05 SOC-SEC PIC X(9). |
| 05 HIRE-DATE. |
| 10 MO PIC XX. |
| 10 DA PIC XX. |
| 10 YR PIC XX. |
| 05 SALARY PIC S9(6). |
| 05 PIC X(29). |
| FD PFILE. |
| 01 PREC. |
| 05 SOC-SEC PIC X(9). |
| 05 PIC XX. |
| 05 NAME PIC X(30). |
| 05 PIC XX. |
| 05 HIRE-DATE. |
| 10 MO PIC XX. |
| 10 PIC X. |
| 10 DA PIC XX. |
| 10 PIC X. |
| 10 YR PIC XX. |
| 05 PIC X(81). |
| 01 HREC. |
| 05 HSOC-SEC PIC X(11). |
| 05 HNAME PIC X(32). |
| 05 HHIRE-DATE PIC X(89). |
____________________________________________________________________
Figure 2-15. The HP COBOL II Source File, EX1SRC
____________________________________________________________________
| |
| WORKING-STORAGE SECTION. |
| 01 LNCNT PIC S9(4) BINARY VALUE 60. |
| 01 W-DATE. |
| 05 WYR PIC XX. |
| 05 PIC X(4). |
| PROCEDURE DIVISION. |
| P1. |
| ACCEPT W-DATE FROM DATE. |
| OPEN INPUT IFILE OUTPUT PFILE. |
| PERFORM WITH TEST AFTER UNTIL SOC-SEC OF IREC = ALL "9" |
| READ IFILE |
| AT END MOVE ALL "9" TO SOC-SEC OF IREC |
| NOT AT END |
| IF WYR = YR OF IREC THEN |
| ADD 1 TO LNCNT |
| IF LNCNT > 50 PERFORM HEADINGS END-IF |
| MOVE SPACES TO PREC |
| MOVE CORR IREC TO PREC |
| WRITE PREC AFTER ADVANCING 1 LINE |
| END-IF |
| END-READ |
| END-PERFORM |
| CLOSE IFILE PFILE |
| STOP RUN. |
| HEADINGS. |
| MOVE "SOC SEC NO" TO HSOC-SEC. |
| MOVE "NAME" TO HNAME. |
| MOVE "HIRE DATE" TO HHIRE-DATE. |
| WRITE PREC AFTER ADVANCING PAGE. |
| MOVE 0 TO LNCNT. |
____________________________________________________________________
Figure 2-15. The HP COBOL II Source File, EX1SRC (Continued)
____________________________________________________________________
| |
| C This program prints an amortization table for a loan |
| C with regular payments on the first of each month. |
| C It calculates prepaid interest from the current |
| C date until the end of the current month, and begins |
| C the amortization at the beginning of the next month. |
| C Input to the program is the current date (in month, |
| C day, year form), the principal amount, annual interest |
| C rate, and the term of the loan in years. |
| |
| PROGRAM EX2 |
| INTEGER TODAY, NXTMON, TERM |
| DOUBLE PRECISION PRIN, RATE, PREPD, PAYMNT, PCT |
| INTEGER JULIAN |
| DOUBLE PRECISION AMORT |
| COMMON MONTH, DAY, YEAR |
| INTEGER MONTH, DAY, YEAR |
| |
| READ (5,*) MONTH, DAY, YEAR |
| READ (5,*) PRIN, RATE, TERM |
| |
| C Determine the number of days remaining in the current |
| C month. The Julian dates for today and the first of the |
| C next month are used for this calculation. |
| |
| TODAY = JULIAN(MONTH, DAY, YEAR) |
| DAY = 1 |
| CALL ADDDAT(MONTH, DAY, YEAR, 1, 0, 0) |
| NXTMON = JULIAN(MONTH, DAY, YEAR) |
| |
| C Calculate the prepaid interest and the monthly payments. |
| C The prepaid interest is calculated as simple interest. |
| |
| PREPD = PRIN * (NXTMON-TODAY) * (RATE/365.0D0) |
| PAYMNT = AMORT(PRIN, RATE/12.0D0, TERM*12) |
| PCT = RATE * 100.0D0 |
| WRITE (6, 100) PREPD, PRIN, PCT, TERM, PAYMNT |
| 100 FORMAT ('1', 'Prepaid Interest: ', F10.2/ |
| * '0', 'Principal: ', F10.2/ |
| * ' ', 'Interest Rate: ', F10.2, '%'/ |
| * ' ', 'Number of Years: ', I7/ |
| * ' ', 'Monthly Payment: ', F10.2) |
| |
| CALL PRTTAB(PRIN, RATE/12.0D0, TERM*12, PAYMNT) |
| STOP |
| END |
____________________________________________________________________
Figure 2-16. The HP FORTRAN 77 Source File, EX2ASRC
_______________________________________________________________________
| |
| C Print the amortization table |
| |
| SUBROUTINE PRTTAB(PRIN, RATE, TERM, PAYMNT) |
| DOUBLE PRECISION PRIN, RATE, PAYMNT |
| INTEGER TERM |
| DOUBLE PRECISION ACCINT, PPRIN, PINT, RPRIN |
| CHARACTER*3 DW, WKDAY |
| COMMON MONTH, DAY, YEAR |
| INTEGER MONTH, DAY, YEAR |
| ACCINT = 0.0 |
| WRITE (6, 101) |
| 101 FORMAT ('0', ' Beginning Payment to ', |
| * 'Payment to Accumulated Remaining'/ |
| * ' ', ' Due Date Principal Principal ', |
| * ' Interest Interest Principal') |
| DO 1 I = 1, TERM |
| CALL ADDDAT(MONTH, DAY, YEAR, 1, 0, 0) |
| PINT = PRIN * RATE |
| PPRIN = PAYMNT - PINT |
| ACCINT = ACCINT + PINT |
| RPRIN = PRIN - PPRIN |
| DW = WKDAY(MONTH, DAY, YEAR) |
| WRITE (6, 102) DW, MONTH, DAY, YEAR, PRIN, PPRIN, PINT,|
| * ACCINT, RPRIN |
| 102 FORMAT (' ', A3, ' ', I2, '/', I2, '/', I4, 2X, F10.2, |
| * 4X, F8.2, 4X, F8.2, 4X, F10.2, 4X, F10.2) |
| PRIN = RPRIN |
| 1 CONTINUE |
| RETURN |
| END |
_______________________________________________________________________
Figure 2-16. The HP FORTRAN 77 Source File, EX2ASRC (Continued)
_______________________________________________________________________
| |
| C JULIAN returns the Julian date for the given month, day, |
| C and year. The Julian date calculated here is valid from |
| C Mar 1, 1900 to Feb 28, 2100. It is the astronomical date |
| C for noon on that day. |
| |
| INTEGER FUNCTION JULIAN(MONTH, DAY, YEAR) |
| INTEGER MONTH, DAY, YEAR |
| PARAMETER (J1900 = 2415020) |
| INTEGER JAN1, MON1 |
| INTEGER MTABLE(12) |
| DATA MTABLE /0,31,59,90,120,151,181,212,243,273,304,334/ |
| |
| C Find Julian date for Jan 1 of given year. |
| |
| JAN1 = J1900 + INT(365.25D0 * (YEAR-1900) + 0.75) |
| |
| C Find number of days to 1st of given month. |
| |
| MON1 = MTABLE(MONTH) |
| IF (MOD(YEAR,4) .EQ. 0 .AND. MONTH .GE. 3) MON1 = MON1 + 1|
| JULIAN = JAN1 + MON1 + DAY - 1 |
| RETURN |
| END |
| |
| |
| C MDY converts a Julian date to month, day, year format. |
| |
| SUBROUTINE MDY(JDATE, MONTH, DAY, YEAR) |
| INTEGER JDATE, MONTH, DAY, YEAR, YDATE |
| PARAMETER (J1900 = 2415020) |
| INTEGER MTABLE(12) |
| DATA MTABLE /31,28,31,30,31,30,31,31,30,31,30,31/ |
| YEAR = 1900 + INT((JDATE-J1900) / 365.25D0) |
| DAY = JDATE - JULIAN(1, 1, YEAR) + 1 |
| MTABLE(2) = 28 |
| IF (MOD(YEAR,4) .EQ. 0) MTABLE(2) = 29 |
| MONTH = 1 |
| 1 IF (DAY .LE. MTABLE(MONTH) .OR. MONTH .GE. 12) GOTO 2 |
| DAY = DAY - MTABLE(MONTH) |
| MONTH = MONTH + 1 |
_______________________________________________________________________
Figure 2-17. The HP FORTRAN 77 Source File, EX2BSRC
__________________________________________________________________________
| |
| GOTO 1 |
| 2 RETURN |
| END |
| |
| C WKDAY returns a 3-letter name of the day of the week |
| C given the month, day, and year. |
| |
| CHARACTER*3 FUNCTION WKDAY(MONTH, DAY, YEAR) |
| INTEGER MONTH, DAY, YEAR, JDATE, DW |
| INTEGER JULIAN |
| CHARACTER*3 DAYTAB(7) |
| DATA DAYTAB /'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'/|
| JDATE = JULIAN(MONTH, DAY, YEAR) |
| DW = MOD(JDATE+1, 7) |
| WKDAY = DAYTAB(DW+1) |
| RETURN |
| END |
| |
| |
| C ADDDAT adds the given number of months, days, and years |
| C to the date supplied in the first three arguments. |
| |
| SUBROUTINE ADDDAT(MONTH, DAY, YEAR, NMONS, NDAYS, NYRS) |
| INTEGER MONTH, DAY, YEAR, NMONS, NDAYS, NYRS |
| INTEGER JDATE, JULIAN |
| YEAR = YEAR + NYRS |
| MONTH = MONTH + NMONS |
| |
| IF (MONTH .GT. 12) THEN |
| YEAR = YEAR + (MONTH-1)/12 |
| MONTH = MOD(MONTH-1,12) + 1 |
| END IF |
| |
| IF (NDAYS .GT. 0) THEN |
| JDATE = JULIAN(MONTH, DAY, YEAR) + NDAYS |
| CALL MDY(JDATE, MONTH, DAY, YEAR) |
| END IF |
| |
| RETURN |
| END |
__________________________________________________________________________
Figure 2-17. The HP FORTRAN 77 Source File, EX2BSRC (Continued)
___________________________________________________________________
| |
| C AMORT returns the periodic payment for an amortized loan|
| C given principal, periodic interest rate, and term. |
| |
| DOUBLE PRECISION FUNCTION AMORT(PRIN, RATE, TERM) |
| DOUBLE PRECISION PRIN, RATE |
| INTEGER TERM |
| |
| AMORT = PRIN * RATE / (1.0 - (1.0+RATE) ** (-TERM)) |
| |
| RETURN |
| END |
___________________________________________________________________
Figure 2-17. The HP FORTRAN 77 Source File, EX2BSRC (Continued)
_______________________________________________________________________
| |
| C JULIAN returns the Julian date for the given month, day, |
| C and year. The Julian date calculated here is valid from |
| C Mar 1, 1900 to Feb 28, 2100. It is the astronomical date |
| C for noon on that day. |
| |
| INTEGER FUNCTION JULIAN(MONTH, DAY, YEAR) |
| INTEGER MONTH, DAY, YEAR |
| PARAMETER (J1900 = 2415020) |
| INTEGER JAN1, MON1 |
| INTEGER MTABLE(12) |
| DATA MTABLE /0,31,59,90,120,151,181,212,243,273,304,334/ |
| |
| C Find Julian date for Jan 1 of given year. |
| |
| JAN1 = J1900 + INT(365.25D0 * (YEAR-1900) + 0.75) |
| |
| C Find number of days to 1st of given month. |
| |
| MON1 = MTABLE(MONTH) |
| IF (MOD(YEAR,4) .EQ. 0 .AND. MONTH .GE. 3) MON1 = MON1 + 1|
| JULIAN = JAN1 + MON1 + DAY - 1 |
| RETURN |
| END |
_______________________________________________________________________
Figure 2-18. The HP FORTRAN 77 Source File, LIB1SRC
__________________________________________________________________
| |
| C MDY converts a Julian date to month, day, year format. |
| |
| SUBROUTINE MDY(JDATE, MONTH, DAY, YEAR) |
| INTEGER JDATE, MONTH, DAY, YEAR, YDATE |
| PARAMETER (J1900 = 2415020) |
| INTEGER MTABLE(12) |
| DATA MTABLE /31,28,31,30,31,30,31,31,30,31,30,31/ |
| YEAR = 1900 + INT((JDATE-J1900) / 365.25D0) |
| DAY = JDATE - JULIAN(1, 1, YEAR) + 1 |
| MTABLE(2) = 28 |
| IF (MOD(YEAR,4) .EQ. 0) MTABLE(2) = 29 |
| MONTH = 1 |
| 1 IF (DAY .LE. MTABLE(MONTH) .OR. MONTH .GE. 12) GOTO 2|
| DAY = DAY - MTABLE(MONTH) |
| MONTH = MONTH + 1 |
| GOTO 1 |
| 2 RETURN |
| END |
__________________________________________________________________
Figure 2-19. The HP FORTRAN 77 Source File, LIB2SRC
__________________________________________________________________________
| |
| C WKDAY returns a 3-letter name of the day of the week |
| C given the month, day, and year. |
| |
| CHARACTER*3 FUNCTION WKDAY(MONTH, DAY, YEAR) |
| INTEGER MONTH, DAY, YEAR, JDATE, DW |
| INTEGER JULIAN |
| CHARACTER*3 DAYTAB(7) |
| DATA DAYTAB /'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'/|
| JDATE = JULIAN(MONTH, DAY, YEAR) |
| DW = MOD(JDATE+1, 7) |
| WKDAY = DAYTAB(DW+1) |
| RETURN |
| END |
__________________________________________________________________________
Figure 2-20. The HP FORTRAN 77 Source File, LIB3SRC
____________________________________________________________________
| |
| C ADDDAT adds the given number of months, days, and years |
| C to the date supplied in the first three arguments. |
| |
| SUBROUTINE ADDDAT(MONTH, DAY, YEAR, NMONS, NDAYS, NYRS)|
| INTEGER MONTH, DAY, YEAR, NMONS, NDAYS, NYRS |
| INTEGER JDATE, JULIAN |
| YEAR = YEAR + NYRS |
| MONTH = MONTH + NMONS |
| |
| IF (MONTH .GT. 12) THEN |
| YEAR = YEAR + (MONTH-1)/12 |
| MONTH = MOD(MONTH-1,12) + 1 |
| END IF |
| |
| IF (NDAYS .GT. 0) THEN |
| JDATE = JULIAN(MONTH, DAY, YEAR) + NDAYS |
| CALL MDY(JDATE, MONTH, DAY, YEAR) |
| END IF |
| |
| RETURN |
| END |
____________________________________________________________________
Figure 2-21. The HP FORTRAN 77 Source File, LIB4SRC
___________________________________________________________________
| |
| C AMORT returns the periodic payment for an amortized loan|
| C given principal, periodic interest rate, and term. |
| |
| DOUBLE PRECISION FUNCTION AMORT(PRIN, RATE, TERM) |
| DOUBLE PRECISION PRIN, RATE |
| INTEGER TERM |
| |
| AMORT = PRIN * RATE / (1.0 - (1.0+RATE) ** (-TERM)) |
| |
| RETURN |
| END |
___________________________________________________________________
Figure 2-22. The HP FORTRAN 77 Source File, LIB5SRC
____________________________________________________________________
| |
| {This program queries the system using defined system |
| intrinsics in order to print the device number, the user, |
| group, and account name, and the current date and time.} |
| |
| program myprog (input, output); |
| |
| type |
| pac1 = packed array [1..10] of char; |
| pac2 = packed array [1..30] of char; |
| |
| var |
| user, group, acct: pac1; |
| date : pac2; |
| dev : shortint; |
| |
| {"external" signifies these routines will be |
| found in other modules.} |
| procedure p1(var dev: shortint); external; |
| |
| procedure p2(var user, group, acct: pac1); external; |
| |
| procedure p3(var date: pac2); external; |
| |
| begin |
| p1(dev); |
| p2(user, group, account); |
| p3(date); |
| |
| {output the required information} |
| write('Device number', dev, 'is logged on as '); |
| write(user, '.', group, '.', acct); |
| writeln('on', date); |
| end. |
____________________________________________________________________
Figure 2-23. The HP Pascal Source File, EX3ASRC
___________________________________________________________________
| |
| $subprogram$ |
| program sub1; |
| |
| {Here, who is specified as an intrinsic.} |
| procedure who; intrinsic; |
| |
| {This procedure calls the system intrinsic who |
| to return the device the current user is logged |
| on to. who command defaults are used for the |
| 1st 7 parameters, as documented in the MPE XL |
| Intrinsics Reference Manual.} |
| procedure p1(var dev: shortint); |
| begin |
| who(,,,,,,,dev); |
| end; |
| |
| {The main program is defined elsewhere.} |
| |
| begin |
| end. |
___________________________________________________________________
Figure 2-24. The HP Pascal Source File, EX3BSRC
___________________________________________________________________
| |
| $subprogram$ |
| |
| program sub2; |
| |
| type |
| pac1 = packed array [1..10] of char; |
| |
| procedure who; intrinsic; |
| |
| {This procedure calls the system intrinsic who to |
| return the name of the current user, group, and account. |
| who command defaults are used for the 1st 3 parameters, |
| as documented in the MPE XL Intrinsics Reference Manual.} |
| procedure p2(var user, group, acct: pac1); |
| begin |
| who(,,,user, group, acct); |
| end; |
| |
| {The main program is defined elsewhere.} |
| |
| begin |
| end. |
___________________________________________________________________
Figure 2-25. The HP Pascal Source File, EX3CSRC
___________________________________________________________________
| |
| $subprogram$ |
| |
| program sub3; |
| |
| type |
| pac2 = packed array [1..30] of char; |
| |
| {dateline is specified as an intrinsic} |
| procedure dateline; intrinsic; |
| |
| {This procedure calls the system intrinsic dateline |
| to return the current date and time. dateline is |
| documented in the MPE XL System Intrinsics Manual.} |
| procedure p3(var date: pac2); |
| begin |
| dateline(date); |
| end; |
| |
| {The main program is defined elsewhere.} |
| |
| begin |
| end. |
___________________________________________________________________
Figure 2-26. The HP Pascal Source File, EX3DSRC