 |
» |
|
|
|
This example shows the access of the sample catalog called FORMAT (created in the Chapter 2); the source of this sample catalog (SOURCE) is listed below.
$SET 1 Prompts
1 ENTER FIRST NAME
2 ENTER LAST NAME
$
$
$set 2 Error Messages
1 NAME NOT ON DATA BASE
2 ILLEGAL INPUT
3 AN ERROR OCCURRED DURING THE LOADING %
OF THE DATA BASE.
98 THE NUMBER OF FILES &
DOES NOT MATCH THE &
SYSTEM'S CALCULATIONS.
$
$set 13 Run-Time Messages
400 INPUT FROM ! ON TERMINAL NUMBER ! RESULTS IN SUCCESSFUL &
OPERATION
401 INPUT FROM TERMINAL NUMBER !2 BY !1 RESULTS IN SUCCESSFUL &
OPERATION
|
The program uses message 1 in set 1 to prompt for a first name, substitutes the name in message 400 of set 13, and outputs the message. All output is written to the terminal.
$control standard_level system
*
program MSGCAT
*
system intrinsic QUIT
*
*
logical STATUS_RETURN
*
character DESIGNATOR*20
*
call OPEN_A_CATALOG (STATUS_RETURN)
if (STATUS_RETURN) go to 10
print *,'OPEN_A_CATALOG Failed. Terminating.'
call QUIT (1)
*
|
10 call READ_A_CATALOG (STATUS_RETURN)
*
if (STATUS_RETURN) go to 20
print *,'READ_A_CATALOG Failed. Terminating.'
call QUIT (2)
*
20 call CLOSE_A_CATALOG (STATUS_RETURN)
if (STATUS_RETURN) go to 30
print *,'CLOSE_A_CATALOG Failed. Terminating'
call QUIT (3)
*
30 stop
end
|
*
*******************************************************
*
subroutine OPEN_A_CATALOG (STATUS_RETURN)
*
system intrinsic CATOPEN
*
integer CATINDEX
2 ,CATSTATUS(2)
*
logical STATUS_RETURN
*
character DESIGNATOR*20
*
STATUS_RETURN = .true.
DESIGNATOR = 'FORMAT'
CATINDEX = CATOPEN (DESIGNATOR, CATSTATUS)
if (CATSTATUS(1) .ne. 0) STATUS_RETURN = .false.
*
return
end
*
*******************************************************
*
subroutine READ_A_CATALOG (STATUS_RETURN)
*
system intrinsic CATREAD
*
integer*2 SETNUM
2 ,MSGNUM
3 ,MSGDEST
4 ,MSGLENGTH
5 ,CATSTATUS(2)
*
integer*4 CATINDEX
2 ,DUMY
*
logical STATUS_RETURN
*
character PARM1*6
2 ,PARM2*2
*
|
STATUS_RETURN = .true.
SETNUM = 1
MSGNUM = 1
MSGDEST = 0
MSGLENGTH = CATREAD (CATINDEX
2 ,SETNUM
3 ,MSGNUM
4 ,CATSTATUS,,,
5 ,,,,,MSGDEST)
if (CATSTATUS(1) .ne. 0) STATUS_RETURN = .false.
*
SETNUM = 13
MSGNUM = 400
read *,PARM1(1:5)
write (PARM1(6:6),15) 0b
PARM2(1:1) = '3'
write (PARM2(2:2),15) 0b
15 format (r1)
*
MSGLENGTH = CATREAD (CATINDEX
2 ,SETNUM
3 ,MSGNUM
4 ,CATSTATUS
5 ,,,PARM1
6 ,PARM2
7 ,,,,MSGDEST)
if (CATSTATUS(1) .ne. 0) STATUS_RETURN = .false.
return
end
*
*******************************************************
*
subroutine CLOSE_A_CATALOG (STATUS_RETURN)
*
system intrinsic CATCLOSE
*
integer*2 CATSTATUS(2)
*
integer*4 CATINDEX
*
logical STATUS_RETURN
*
STATUS_RETURN = .true.
call CATCLOSE (CATINDEX
2 ,CATSTATUS)
if (CATSTATUS(1) .ne. 0) STATUS_RETURN = .false.
return
end
|
When this program is executed, the output is:
ENTER FIRST NAME
MARY
INPUT FROM MARY ON TERMINAL NUMBER 3
|
|
