[an error occurred while processing this directive]

HP OpenVMS Systems Documentation
Content starts here

HP Fortran for OpenVMS
User Manual

Previous Contents Index
  1. The library module FORIOSDEF must be included to define the symbolic status codes returned by HP Fortran I/O statements.
  2. This program requires a relative file named REL.DAT.
  3. The SHARED qualifier is used on the OPEN statement to indicate that the file can be shared. Because manual locking was not specified, RMS automatically controls access to the file. Only read and update operations are allowed in this example. No new records can be written to the file.
  4. The second process is not allowed to access record #2 while the first process is accessing it.
  5. Once the first process has finished with record #2, the second process can update it.

F.6 Displaying Data at Terminals

The following example calls SMG routines to format screen output.

No sample run is included for this example because the program requires a video terminal in order to execute properly.

Source Program: 


!   File: SMGOUTPUT.F90
!
!   This program calls Run-Time Library Screen Management routines
!   to format screen output.

    IMPLICIT INTEGER (KIND=4) (A-Z)
    INCLUDE          '($SMGDEF)'                                       (1)

!   Establish terminal screen as pasteboard

    STATUS = SMG$CREATE_PASTEBOARD (NEW_PID,,,)                        (2)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))

!   Establish a virtual display region

    STATUS = SMG$CREATE_VIRTUAL_DISPLAY (15,30,DISPLAY_ID,,,)          (3)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))

!   Paste the virtual display to the screen, starting at
!   row 2, column 15

    STATUS = SMG$PASTE_VIRTUAL_DISPLAY(DISPLAY_ID,NEW_PID,2,15)        (4)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))

!   Put a border around the display area

    STATUS = SMG$LABEL_BORDER(DISPLAY_ID,'This is the Border',,,,,)    (5)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))

!   Write text lines to the screen

    STATUS = SMG$PUT_LINE (DISPLAY_ID,' ',,,,,)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))
    STATUS = SMG$PUT_LINE (DISPLAY_ID,'Howdy, pardner',2,,,,)          (6)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))
    STATUS = SMG$PUT_LINE (DISPLAY_ID,'Double spaced lines...',2,,,,)  (6)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))

    STATUS = SMG$PUT_LINE (DISPLAY_ID,'This line is blinking',2, &      (7)
                           SMG$M_BLINK,0,,)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))
    STATUS = SMG$PUT_LINE (DISPLAY_ID,'This line is reverse video',2, & (7)
                           SMG$M_REVERSE,0,,)
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))
    DO I = 1, 5                                                         (8)
      STATUS = SMG$PUT_LINE (DISPLAY_ID,'Single spaced lines...',,,,,)
      IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS))
    ENDDO

    END PROGRAM
  1. The INCLUDE statement incorporates the $SMGDEF library module from FORSYSDEF.TLB into the source program. This library module contains symbol definitions used by the screen management routines.
  2. The call to SMG$CREATE_PASTEBOARD creates a pasteboard upon which output will be written. The pasteboard ID is returned in the variable NEW_PID.
    No value is specified for the output device parameter, so the output device defaults to SYS$OUTPUT. Also, no values are specified for the PB_ROWS or PB_COLS parameters, so the pasteboard is created with the default number of rows and columns. The defaults are the number of rows and the number of columns on the physical screen of the terminal to which SYS$OUTPUT is assigned.
  3. The created virtual display is 15 lines long and 30 columns wide. The virtual display initially contains blanks.
  4. The virtual display is pasted to the pasteboard, with its upper left corner positioned at row 2, column 15 of the pasteboard. Pasting the virtual display to the pasteboard causes all data written to the virtual display to appear on the pasteboard's output device, which is SYS$OUTPUT---the terminal screen.
    At this point, nothing appears on the screen because the virtual display contains only blanks. However, because the virtual display is pasted to the pasteboard, the program statements described below cause text to be written to the screen.
  5. A labeled border is written to the virtual display.
  6. Using a call to the RTL routine SMG$PUT_LINE, the text line ("Howdy, pardner" is written to the virtual display.
    To specify double spacing, a call to SMG$PUT_LINE displays "Double spaced lines..." by specifying the line-adv (third) argument to SMG$PUT_LINE as 2.
  7. Two subsequent calls to SMG$PUT_LINE specify the SMG$M_BLINK and SMG$M_REVERSE parameters (rendition-set argument) display the double-spaced lines "This line is blinking" as blinking and "This line is reverse video" in reverse video. The parameter mask constants like SMG$M_BLINK are defined in the $SMGDEF library module in FORSYSDEF.TLB.
  8. The program displays single-spaced text by omitting a value for the line-adv argument (third argument) to SMG$PUT_LINE. The DO loop displays the line "Single spaced lines..." five times.

F.7 Creating, Accessing, and Ordering Files

In the following example, each record in a relative file is assigned to a specific cell in that file. On sequential write operations, the records are written to consecutive empty cells. Random write operations place the records into cell numbers as provided by the REC=n parameter.

Source Program: 


!   File: RELATIVE.F90
!
!   This program demonstrates how to access a relative file
!   randomly. It also performs some I/O status checks.

    IMPLICIT          INTEGER (KIND=4) (A - Z)
    STRUCTURE /EMPLOYEE_STRUC/
      CHARACTER(LEN=5)       ID_NUM
      CHARACTER(LEN=6)       NAME
      CHARACTER(LEN=3)       DEPT
      CHARACTER(LEN=2)       SKILL
      CHARACTER(LEN=4)       SALARY
    END STRUCTURE
    RECORD /EMPLOYEE_STRUC/ EMPLOYEE_REC
    INTEGER (KIND=4) REC_LEN
    INCLUDE   '($FORIOSDEF)'                         (1)

    OPEN (UNIT=1, FILE='REL', STATUS='OLD', ORGANIZATION='RELATIVE',  & (2)
         ACCESS='DIRECT', FORM='UNFORMATTED',RECORDTYPE='VARIABLE')

!  Get records by record number until e-o-f
!  Prompt for record number

100 TYPE 10
 10 FORMAT ('$Record number: ')
    READ (*,*, END=999) REC_NUM                      (3)

!   Read record by record number

    READ (1,REC=REC_NUM,IOSTAT=STATUS) EMPLOYEE_REC

!   Check I/O status

    IF (STATUS .EQ. 0) THEN
       WRITE (6) EMPLOYEE_REC                        (4)
    ELSE IF (STATUS .EQ. FOR$IOS_ATTACCNON) THEN
       TYPE *,  'Nonexistent record.'
    ELSE IF (STATUS .EQ. FOR$IOS_RECNUMOUT) THEN
       TYPE *, 'Record number out of range.'
    ELSE
       CALL ERRSNS (, RMS_STS, RMS_STV,,)            (5)
       CALL LIB$SIGNAL (%VAL(RMS_STS), %VAL(RMS_STV))
    ENDIF

!   Loop

    GOTO 100
999 END

Sample Use: 


$ FORTRAN RELATIVE
$ LINK RELATIVE
$ RUN RELATIVE
Record number: 7
08001FLANJE119PL1920
Record number: 1
07672ALBEHA210SE2100
Record number: 30
Nonexistent record.
Record number: Ctrl/Z
$
  1. The INCLUDE statement defines all Fortran I/O status codes.
  2. The OPEN statement defines the file and record processing characteristics. Although the file organization is specified as relative, RMS would in fact obtain the file organization from an existing file. If the file's organization were not relative, the file OPEN statement would fail.
    The file is being opened for unformatted I/O because the data records will be read into an HP Fortran record (EMPLOYEE_REC), and HP Fortran does not allow records to be used in formatted I/O.
  3. The READ statement reads the record specified in REC_NUM, rather than the next consecutive record. The status code for the record operation is returned in the variable STATUS.
  4. These statements test the record operation status obtained in comment 3. Note, the status codes returned by RMS and HP Fortran are not numerically or functionally similar.
  5. RMS status codes actually require two parameters. These values can be obtained using the ERRSNS subroutine.

F.8 Measuring and Improving Performance

This example demonstrates how to adjust the size of the process working set from a program.

Source Program: 


!   File: ADJUST.F90
!
!   This program demonstrates how a program can control
!   its working set size using the $ADJWSL system service.

    IMPLICIT      INTEGER (A-Z)
    INCLUDE       '($SYSSRVNAM)'
    INTEGER (KIND=4)    ADJUST_AMT      /0/
    INTEGER (KIND=4)    NEW_LIMIT       /0/

    CALL LIB$INIT_TIMER

    DO ADJUST_AMT= -50,70,10

!   Modify working set limit

      RESULT = SYS$ADJWSL( %VAL(ADJUST_AMT), NEW_LIMIT)    (1)
      IF (.NOT. RESULT) CALL LIB$STOP(%VAL(RESULT))

      TYPE 50, ADJUST_AMT, NEW_LIMIT
 50   FORMAT(' Modify working set by', I4, '   New working set size =', I5)
    END DO
    CALL LIB$SHOW_TIMER
    END PROGRAM

Sample Use: 


$ SET WORKING_SET/NOADJUST                                (2)
$ SHOW WORKING_SET
  Working Set      /Limit=2000  /Quota=4000  /Extent=98304
  Adjustment disabled   Authorized Quota=4000  Authorized Extent=98304

  Working Set (8Kb pages) /Limit=125  /Quota=250  /Extent=6144
                           Authorized Quota=250  Authorized Extent=6144
$ FORTRAN ADJUST
$ LINK ADJUST
$ RUN ADJUST
Modify working set by -50    New working set size = 1936   (3)
Modify working set by -40    New working set size = 1888
Modify working set by -30    New working set size = 1856
Modify working set by -20    New working set size = 1824
Modify working set by -10    New working set size = 1808
Modify working set by   0    New working set size = 1808
Modify working set by  10    New working set size = 1824
Modify working set by  20    New working set size = 1856
Modify working set by  30    New working set size = 1888
Modify working set by  40    New working set size = 1936
Modify working set by  50    New working set size = 2000
Modify working set by  60    New working set size = 2064
Modify working set by  70    New working set size = 2144
ELAPSED:  0 00:00:00.01  CPU: 0:00:00.01  BUFIO: 13  DIRIO: 0  FAULTS: 24
$
  1. The call to SYS$ADJWSL call uses a function invocation.
  2. The DCL SHOW WORKING_SET command displays the current working set limit and the maximum quota.
  3. The SYS$ADJWSL is used to increase or decrease the number of pages in the process working set.

The program cannot decrease the working set limit beneath the minimum established by the operating system, nor can the process working set be expanded beyond the authorized quota.

F.9 Accessing Help Libraries

The following example demonstrates how to obtain text from a help library. After the initial help request has been satisfied, the user is prompted and can request additional information.

Source Program: 


!   File: HELPOUT.F90
!
!   This program satisfies an initial help request and enters interactive
!   HELP mode.  The library used is SYS$HELP:HELPLIB.HLB.

    IMPLICIT  INTEGER (KIND=4) (A - Z)
    CHARACTER(LEN=32)   KEY
    EXTERNAL       LIB$PUT_OUTPUT,LIB$GET_INPUT          (1)

!   Request a HELP key

    WRITE (6,200)
200 FORMAT(1X,'What Topic would you like HELP with? ',$)
    READ (5,100) KEY
100 FORMAT (A32)

!   Locate and print the help text

    STATUS = LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,KEY,   &    (2)
                             'HELPLIB',,LIB$GET_INPUT)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))
    END PROGRAM

Sample Use: 


$ FORTRAN HELPOUT
$ LINK HELPOUT
$ RUN HELPOUT
What topic would you like HELP with? TYPE

TYPE
    Displays the contents of a file or a group of files on the
    current output device.

    Format:

        TYPE file-spec[,...]

    Additional information available:

    Parameters  Qualifiers
    /BACKUP    /BEFORE    /BY_OWNER  /CONFIRM   /CONTINUOUS           /CREATED
    /EXACT     /EXCLUDE   /EXPIRED   /HEADER    /HIGHLIGHT /MODIFIED  /OUTPUT
    /PAGE      /SEARCH    /SINCE     /TAIL      /WRAP
    Examples

TYPE Subtopic? /HIGHLIGHT

TYPE

  /HIGHLIGHT

          /HIGHLIGHT[=keyword]
          /NOHIGHLIGHT (default)

    Use with the /PAGE=SAVE and /SEARCH qualifiers to specify the
    type of highlighting you want when a search string is found. When
    a string is found, the entire line is highlighted. You can use
    the following keywords: BOLD, BLINK, REVERSE, and UNDERLINE. BOLD
    is the default highlighting.

TYPE Subtopic?  Ctrl/Z
$
  1. To pass the address of LIB$PUT_OUTPUT and LIB$GET_INPUT, they must be declared as EXTERNAL. You can supply your own routines for handling input and output.
  2. The address of an output routine is a required argument. When requesting prompting mode, the default mode, an input routine must be specified.

F.10 Creating and Managing Other Processes

The following example demonstrates how a created process can use the SYS$GETJPIW system service to obtain the PID of its creator process. It also shows how to set up an item list to translate a logical name recursively.

Source Program: 


!   File: GETJPI.F90
!   This program demonstrates process creation and control.
!   It creates a subprocess then hibernates until the subprocess wakes it.

    IMPLICIT       INTEGER (KIND=4) (A - Z)
    INCLUDE        '($SSDEF)'
    INCLUDE        '($LNMDEF)'
    INCLUDE        '($SYSSRVNAM)'
    CHARACTER(LEN=255)    TERMINAL       /'SYS$OUTPUT'/
    CHARACTER(LEN=9)      FILE_NAME      /'GETJPISUB'/
    CHARACTER(LEN=5)      SUB_NAME       /'OSCAR'/
    INTEGER (KIND=4)      PROCESS_ID     /0/
    CHARACTER(LEN=17)     TABNAM         /'LNM$PROCESS_TABLE'/
    CHARACTER(LEN=255)    RET_STRING
    CHARACTER(LEN=2)      ESC_NULL
    INTEGER (KIND=4)      RET_ATTRIB
    INTEGER (KIND=4)      RET_LENGTH      /10/
    STRUCTURE /ITMLST3_3ITEMS/
      STRUCTURE    ITEM(3)
        INTEGER (KIND=2)    BUFFER_LENGTH
        INTEGER (KIND=2)    CODE
        INTEGER (KIND=4)    BUFFER_ADDRESS
        INTEGER (KIND=4)    RETLEN_ADDRESS
      END STRUCTURE
      INTEGER (KIND=4)      END_OF_LIST
    END STRUCTURE
    RECORD /ITMLST3_3ITEMS/  TRNLST

!   Translate SYS$OUTPUT
!   Set up TRNLST, the item list for $TRNLNM

    TRNLST.ITEM(1).CODE = LNM$_STRING
    TRNLST.ITEM(1).BUFFER_LENGTH = 255
    TRNLST.ITEM(1).BUFFER_ADDRESS = %LOC(RET_STRING)
    TRNLST.ITEM(1).RETLEN_ADDRESS = 0

    TRNLST.ITEM(2).CODE = LNM$_ATTRIBUTES
    TRNLST.ITEM(2).BUFFER_LENGTH = 4
    TRNLST.ITEM(2).BUFFER_ADDRESS = %LOC(RET_ATTRIB)
    TRNLST.ITEM(2).RETLEN_ADDRESS = 0

    TRNLST.ITEM(3).CODE = LNM$_LENGTH
    TRNLST.ITEM(3).BUFFER_LENGTH = 4
    TRNLST.ITEM(3).BUFFER_ADDRESS = %LOC(RET_LENGTH)
    TRNLST.ITEM(3).RETLEN_ADDRESS = 0

    TRNLST.END_OF_LIST = 0

!   Translate SYS$OUTPUT

100 STATUS = SYS$TRNLNM (,TABNAM,TERMINAL(1:RET_LENGTH),,TRNLST)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))
    IF (IAND(LNM$M_TERMINAL, RET_ATTRIB).EQ. 0) THEN
        TERMINAL = RET_STRING(1:RET_LENGTH)
        GO TO 100
    ENDIF

!   Check if process permanent file

    ESC_NULL(1:2) = char('1B'x)//char('00'x)
    IF (RET_STRING(1:2) .EQ. ESC_NULL) THEN
         RET_STRING = RET_STRING(5:RET_LENGTH)
         RET_LENGTH = RET_LENGTH - 4
    ENDIF

!   Create the subprocess

    STATUS = SYS$CREPRC (PROCESS_ID, FILE_NAME,,   &       (1)
                         RET_STRING(1:RET_LENGTH),,,, &
                         SUB_NAME,%VAL(4),,,)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))
    TYPE 10, PROCESS_ID
10  FORMAT (' PID of subprocess OSCAR is ', Z)

!   Wait for wakeup by subprocess

    STATUS = SYS$HIBER ()                                  (2)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))

    TYPE *, 'GETJPI has been awakened.'
    END PROGRAM

!   File: GETJPISUB.F90
!   This separately compiled program is run in the subprocess OSCAR
!   which is created by GETJPI.  It  obtains its creator's PID and then
!   wakes it.

    IMPLICIT       INTEGER (KIND=4) (A - Z)                (3)
    INCLUDE        '($JPIDEF)'
    INCLUDE        '($SYSSRVNAM)'
    STRUCTURE /GETJPI_IOSB/
      INTEGER(KIND=4)  STATUS
      INTEGER(KIND=4)  %FILL
    END STRUCTURE
    RECORD /GETJPI_IOSB/  IOSB
    STRUCTURE /ITMLST3_1ITEM/
      STRUCTURE    ITEM
        INTEGER (KIND=2)    BUFFER_LENGTH
        INTEGER (KIND=2)    CODE
        INTEGER (KIND=4)    BUFFER_ADDRESS
        INTEGER (KIND=4)    RETLEN_ADDRESS
      END STRUCTURE
      INTEGER (KIND=4)      END_OF_LIST
    END STRUCTURE
    RECORD /ITMLST3_1ITEM/  JPI_LIST

!   Set up buffer address for GETJPI

    JPI_LIST.ITEM.CODE = JPI$_OWNER                        (4)
    JPI_LIST.ITEM.BUFFER_LENGTH = 4
    JPI_LIST.ITEM.BUFFER_ADDRESS = %LOC(OWNER_PID)
    JPI_LIST.ITEM.RETLEN_ADDRESS = 0

!   Get PID of creator

    STATUS = SYS$GETJPIW (%VAL(1),,, JPI_LIST,IOSB,,)      (5)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))
    IF (.NOT. IOSB.STATUS) CALL LIB$STOP (%VAL(IOSB.STATUS))

!   Wake creator

    TYPE *, 'OSCAR is waking creator.'
    STATUS = SYS$WAKE (OWNER_PID,)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS))

    END PROGRAM

Sample Use: 


$ FORTRAN GETJPI,GETJPISUB
$ LINK GETJPI
$ LINK GETJPISUB
$ RUN GETJPI
PID of subprocess OSCAR is 2120028A
OSCAR is waking creator.
GETJPI has been awakened.
  1. The subprocess is created using SYS$CREPRC.
  2. The process hibernates.
  3. The INCLUDE statement defines the value of all JPI$ codes including JPI$_OWNER. JPI$_OWNER is the item code which requests the PID of the owner process. If there is no owner process (that is, if the process about which information is requested is a detached process), the system service $GETJPIW returns a PID of zero.
  4. Because of the item code JPI$_OWNER in the item list, $GETJPIW returns the PID of the owner of the process about which information is requested. If the item code were JPI$_PID, $GETJPIW would return the PID of the process about which information is requested.
    Because the default value of 0 is used for arguments PIDADR and PRCNAM, the process about which information is requested is the requesting process, namely, OSCAR.
  5. The item list for SYS$GETJPIW consists of a single item descriptor followed by a zero longword.

Index Contents