HP 3000 Manuals

Message Catalogs:Programmer's Guide

Appendix D  FORTRAN Progam Examples 

Example of Accessing an Application Message Catalog 

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

MPE/iX 5.0 Documentation