HP Fortran for OpenVMS
User Manual


Previous Contents Index


Appendix F
Using System Services: Examples

This appendix contains examples that involve accessing OpenVMS system services from HP Fortran programs. The individual examples address the following operations:

Each example includes the free-form source program (with comments), a sample use of the program, and explanatory notes.

See the HP Fortran Web site at http://www.hp.com/go/fortran for more examples.

F.1 Calling RMS Procedures

When you explicitly call an RMS system service, the order of the arguments in the call must correspond with the order shown in the OpenVMS Record Management Services Reference Manual. You must use commas to reserve a place in the call for every argument. If you omit an argument, the procedure uses a default value of zero.

When calling an RMS routine from HP Fortran, the procedure name format is SYS$procedure_name. The following example shows a call to the RMS procedure SYS$SETDDIR. This RMS procedure sets the default directory for a process.

Source Program:


!   File: SETDDIR.F90 
! 
!   This program calls the RMS procedure $SETDDIR to change 
!   the default directory for the process. 
 
    IMPLICIT INTEGER (A - Z) 
    CHARACTER(LEN=17) DIR /'[EX.PROG.FOR]'/     (1)
    STAT = SYS$SETDDIR (DIR,,)                  (2)
    IF (.NOT. STAT) TYPE *, 'ERROR' 
    END PROGRAM 

Sample Use:


$ DIRECTORY            (3)
Directory WORK$:[EX.PROG.FOR.CALL] 
 
BASSUM.BAS;1     BASSUM.OBJ;1     COBSUM.COM;1     DOCOMMAND.F90;2 
GETMSG.EXE;1     GETMSG.F90;4     GETMSG.LIS;2     GETMSG.OBJ;1 
SETDDIR.F90;3    SETDDIR.LIS;1    
 
Total of 10 files. 
$ FORTRAN SETDDIR
$ LINK SETDDIR
$ RUN SETDDIR
$ DIRECTORY            (4)
Directory WORK$:[EX.PROG.FOR] 
 
CALL.DIR;1     COMU.DIR;1     DEVC.DIR;1     FIL.DIR;1 
HAND.DIR;1     INTR.DIR;1     LNKR.DIR;1     MNAG.DIR;1 
RMS.DIR;1      SHAR.DIR;1     SYNC.DIR;1     TERM.DIR;1 
 
Total of 12 files. 

  1. The default directory name is initialized into a CHARACTER variable.
  2. The call to $SETDDIR contains one argument, the directory name, which is passed by descriptor, the default argument passing mechanism for CHARACTERs. The omitted arguments are optional, but commas are necessary to reserve places in the argument list.
  3. The DIRECTORY command executed before the SETDDIR program is run shows that the following directory is the default:


     WORK$:[EX.V4PROG.FOR.CALL] 
    

    This directory contains the file SETDDIR.F90.

  4. Another DIRECTORY command after the SETDDIR program is run shows that the default directory has changed. The following directory is the new default directory:


     WORK$:[EX.PROG.FOR] 
    

For More Information:

On calling RMS system services, see Chapter 11.

F.2 Using an AST Routine

The following example demonstrates how to request and declare an AST procedure. It consists of the following:

For More Information:

On AST routines, see the HP OpenVMS System Services Reference Manual.

Source Programs:


!  Sample program to show enabling of an AST in Fortran 
! 
!  The program uses a Ctrl/C AST to interrupt a work loop in the 
!  main program. 
! 
    PROGRAM CTRLC                          
    IMPLICIT NONE 
 
    LOGICAL CTRLC_FLAG                ! Set to TRUE when Ctrl/C is pressed 
    INTEGER (KIND=2) CHANNEL          ! Channel for terminal 
    COMMON /AST_COM/ CTRLC_FLAG,CHANNEL 
    VOLATILE CTRLC_FLAG               ! Required because variable  (1)
                                      ! can change at any time 
    INTEGER ITERATIONS,I 
 
!  Do first-time initialization 
       
    CHANNEL = 0 
    CTRLC_FLAG = .FALSE. 
    CALL ENABLE_AST 
 
!  Read iteration count 
       
100 WRITE (*,'($,A)') ' Enter iteration count (0 to exit): ' 
    READ (*,*) ITERATIONS 
    DO I=1,ITERATIONS 
       IF (CTRLC_FLAG) GOTO 200       ! Was Ctrl/C pressed? 
       WRITE (*,*) 'Count is ',I 
       CALL LIB$WAIT (2.0)            ! Pause 2 seconds 
    END DO 
    IF (ITERATIONS .EQ. 0) GOTO 999 
    GOTO 100    ! Loop back 
 
200 WRITE (*,*) 'Ctrl/C pressed' 
    CTRLC_FLAG = .FALSE. 
    GOTO 100 
 
999 END PROGRAM CTRLC                          
 
!  Subroutine ENABLE_AST 
 
   SUBROUTINE ENABLE_AST                                   (2)
   IMPLICIT NONE 
 
   INCLUDE '($SYSSRVNAM)'             ! System services 
   INCLUDE '($IODEF)'                 ! $QIO function codes 
 
   LOGICAL CTRLC_FLAG 
   VOLATILE CTRLC_FLAG                                     (1)
   INTEGER (KIND=2) CHANNEL 
   COMMON /AST_COM/ CTRLC_FLAG,CHANNEL 
 
   EXTERNAL AST_ROUTINE 
 
   INTEGER ASSIGN_STATUS, QIO_STATUS, IOSB(2) 
 
!  Assign channel if not already assigned 
     
   IF (CHANNEL .EQ. 0) THEN 
     ASSIGN_STATUS = SYS$ASSIGN ('TT:', CHANNEL,,,) 
     IF (.NOT. ASSIGN_STATUS) CALL LIB$SIGNAL(%VAL(ASSIGN_STATUS)) 
   END IF 
 
!  Enable AST so that AST_ROUTINE is called when Ctrl/C is pressed. 
        
 
   QIO_STATUS = SYS$QIOW (,   &                         (3)
                %VAL(CHANNEL), & 
                %VAL(IO$_SETMODE .OR. IO$M_CTRLCAST), & 
                IOSB,,, & 
                AST_ROUTINE,,,,,) 
 
   IF (.NOT. QIO_STATUS) CALL LIB$SIGNAL(%VAL(QIO_STATUS)) 
 
   RETURN 
   END SUBROUTINE ENABLE_AST 
 
!  Subroutine AST_ROUTINE 
 
   SUBROUTINE AST_ROUTINE                                  (4)
   IMPLICIT NONE 
 
   LOGICAL CTRLC_FLAG 
   VOLATILE CTRLC_FLAG                                     (1)
   INTEGER (KIND=2) CHANNEL 
   COMMON /AST_COM/ CTRLC_FLAG,CHANNEL 
 
!  Indicate that a CTRL/C has been pressed 
        
   CTRLC_FLAG = .TRUE. 
 
!  Reenable the AST.  This must be done by calling ENABLE_AST rather than 
!  doing it here as we would need a recursive reference to AST_ROUTINE, 
!  which is disallowed unless /RECURSIVE is used. 
 
   CALL ENABLE_AST                                         (5)
 
   RETURN 
   END SUBROUTINE AST_ROUTINE 

Sample Use:


$ RUN CTRLC
Enter iteration count (0 to exit):
9
Count is            1
Count is            2
Count is            3
Ctrl/C                    (5)
Cancel
 
Ctrl/C pressed
Enter iteration count (0 to exit):
0
$ 

  1. The CTRLC_FLAG logical variable is declared volatile in the routines that reference it because its value could change at any point during program execution (other than an assignment statement or subroutine argument).
  2. By providing two subroutines, you allow the Ctrl/C AST routine to be executed repeatedly, rather than just once. The ENABLE_AST subroutine is called by the main program and the AST_ROUTINE subroutine. It enables Ctrl/C trapping using the SYS$QIOW system service and sets the CTRLC_FLAGS logical variable. For a subroutine to call itself, it must be recursive.
  3. The call to the SYS$QIOW system service enables Ctrl/C AST use by specifying that the subroutine AST_ROUTINE be called when Ctrl/C is pressed.
  4. When the AST is delivered, the AST_ROUTINE receives control, resets the CTRLC_FLAG logical variable, and returns control back to where Ctrl/C was pressed (main program), which eventually displays "Ctrl/C pressed".
    The arguments to AST_ROUTINE are platform dependent.
  5. The example shows the program executing within the DO loop in the main program (with a two second delay between DO loop executions). When the user types Ctrl/C, control is transferred briefly to the AST_ROUTINE subroutine and it then returns back to the main program. Within the DO loop, the main program tests the value of logical variable CTRLC_FLAG and, if set to .TRUE., transfers control to label 200 which displays "Ctrl/C pressed".

For More Information:

On the VOLATILE statement, see the HP Fortran for OpenVMS Language Reference Manual.

F.3 Accessing Devices Using Synchronous I/O

The following example performs output to a terminal via the SYS$QIOW system service.

Source Program:


!  File: QIOW.F90 
! 
!  This program demonstrates the use of the $QIOW system service to 
!  perform synchronous I/O to a terminal. 
 
   IMPLICIT         INTEGER (KIND=4) (A - Z) 
   INCLUDE          '($SYSSRVNAM)' 
   INCLUDE          '($IODEF)' 
   CHARACTER(LEN=24)    TEXT_STRING /'This is from a SYS$QIOW.'/   (1)
   CHARACTER(LEN=11)    TERMINAL /'SYS$COMMAND'/ 
   INTEGER KIND=2)      TERM_CHAN 
   STRUCTURE /TT_WRITE_IOSB/ 
           INTEGER (KIND=2)   STATUS 
           INTEGER (KIND=2)   BYTES_WRITTEN 
           INTEGER (KIND=4)   %FILL 
   END STRUCTURE 
   RECORD /TT_WRITE_IOSB/  IOSB 
 
!  Assign the channel number 
 
   STAT = SYS$ASSIGN (TERMINAL, TERM_CHAN,,) 
   IF (.NOT. STAT) CALL LIB$STOP (%VAL(STAT))                      (2)
 
!  Initialize STATUS to zero (0) 
 
   STATUS = 0 
 
!  Output the message twice 
 
   DO I=1,2 
      STAT = SYS$QIOW (%VAL(1),%VAL(TERM_CHAN), &        (3)
                       %VAL(IO$_WRITEVBLK),IOSB,,, & 
                       %REF(TEXT_STRING), & 
                       %VAL(LEN(TEXT_STRING)),, & 
                       %VAL(32),,) 
 
       IF (.NOT. STAT) CALL LIB$STOP (%VAL(STATUS)) 
       IF (.NOT. IOSB.STATUS) CALL LIB$STOP (%VAL(IOSB.STATUS)) 
   ENDDO 
   END PROGRAM 

Sample Use:


 
$ FORTRAN QIOW
$ LINK QIOW
$ RUN QIOW
This is from a SYS$QIOW.
This is from a SYS$QIOW.

  1. If SYS$QIO and a SYS$WAITFR are used instead of SYS$QIOW, you must use a VOLATILE declaration for any program variables and arrays that can be changed while the operation is pending.
  2. TERM_CHAN receives the channel number from the SYS$ASSIGN system service.
    The process permanent logical name SYS$COMMAND is assigned to your terminal when you log in. The SYS$ASSIGN system service translates the logical name to the actual device name.
  3. SYS$QIO and SYS$QIOW accept the CHAN argument by immediate value, unlike SYS$ASSIGN, which requires that it be passed by reference. Note the use of %VAL in the call to SYS$QIOW but not in the previous call to SYS$ASSIGN.
    The function IO$_WRITEVBLK requires values for parameters P1, P2, and P4.
    A SYS$QIOW is issued, ensuring that the output operation will be completed before the program terminates.

F.4 Communicating with Other Processes

The following example shows how to create a global pagefile section and how two processes can use it to access the same data. One process executes the program PAGEFIL1, which must first be installed. When run, PAGEFIL1 creates and writes to a global pagefile section. PAGEFIL1 then waits for a second process to update the section. The second process executes PAGEFIL2, which maps and updates the pagefile section.

Because PAGEFIL2 maps to the temporary global pagefile section created in PAGEFIL1, PAGEFIL1 must be run first. The two processes coordinate their activity through common event flags.

Source Program: PAGEFIL1.F90


!   File: PAGEFIL1.F90 
! 
!   This program creates and maps a global page frame section. 
!   Data in the section is accessed through an array. 
 
    IMPLICIT INTEGER (KIND=4)     (A-Z) 
    INCLUDE                  '($SECDEF)' 
    INCLUDE                  '($SYSSRVNAM)' 
    INCLUDE                  '($SYIDEF)' 
    DIMENSION                MY_ADR(2),OUT_ADR(2) 
    COMMON /MYCOM/           IARRAY(50)                    (1)
    CHARACTER(LEN=4)         NAME/'GSEC'/ 
    VOLATILE /MYCOM/                                       (2)
 
 
!   Associate with common cluster MYCLUS 
 
    STATUS = SYS$ASCEFC (%VAL(64),'MYCLUS',,)              (3)
 
!   To calculate the ending address of the page boundary, call 
!   LIB$GETSYIW to get the processor-specific page size, PAGE_MAX 
 
    STATUS = LIB$GETSYI(SYI$_PAGE_SIZE,PAGE_MAX,,,,) 
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) 
 
    MY_ADR(1) = %LOC(IARRAY(1))                            (1)
    MY_ADR(2) = MY_ADR(1) + PAGE_MAX -1 
 
!   Flags for call to SYS$CRMPSC 
 
    SEC_FLAGS = SEC$M_PAGFIL.OR.SEC$M_GBL.OR.SEC$M_WRT.OR.SEC$M_DZRO 
 
!   Create and map the temporary global section 
 
    STATUS = SYS$CRMPSC(MY_ADR,OUT_ADR,,%VAL(SEC_FLAGS), & (4)
                        NAME,,,,%VAL(1),,,) 
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) 
 
!   Manipulate the data in the global section              (5)
 
    DO 10 I  = 1,50 
      IARRAY(I) = I 
    END DO 
      
    STATUS = SYS$SETEF(%VAL(72)) 
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) 
    TYPE *,'Waiting for PAGEFIL2 to update section' 
    STATUS = SYS$WAITFR(%VAL(73)) 
 
!   Print the array modified by PAGEFIL2 in the global section 
 
    TYPE *, 'Modified data in the global section:' 
    WRITE (6,100) (IARRAY(I), I=1,50) 
100 FORMAT(10I5) 
    END PROGRAM 

Source Program: PAGEFIL2.F90


 
!   File: PAGEFIL2.F90 
! 
!   This program maps and modifies a global section after PAGEFIL1 
!   creates the section.  Programs PAGEFIL1 and PAGEFIL2 synchronize 
!   the processing of the global section through the use of common 
!   event flags. 
 
    IMPLICIT INTEGER (KIND=4)       (A - Z) 
    INCLUDE                  '($SECDEF)' 
    INCLUDE                  '($SYSSRVNAM)' 
    INCLUDE                  '($SYIDEF)' 
    DIMENSION                MY_ADR(2)                     (1)
    COMMON /MYCOM/           IARRAY(50) 
    VOLATILE /MYCOM/                                       (2)
 
!   Call LIB$GETSYIW to get page size, PAGE_MAX 
 
    STATUS = LIB$GETSYI(SYI$_PAGE_SIZE,PAGE_MAX,,,,) 
    IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) 
 
    MY_ADR(1) = %LOC(IARRAY(1))                            (1)
    MY_ADR(2) = MY_ADR(1) + PAGE_MAX -1 
                      
!   Associate with common cluster MYCLUS and wait for 
!   event flag to be set 
 
    STATUS = SYS$ASCEFC(%VAL(64),'MYCLUS',,)               (3)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
    STATUS = SYS$WAITFR (%VAL(72)) 
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
 
!   Set flag to allow section to be written 
 
    FLAGS = SEC$M_WRT 
 
!   Map the global section 
 
    STATUS = SYS$MGBLSC(MY_ADR,,,%VAL(FLAGS),'GSEC',,)     (6)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
 
!   Print out the data in the global section and           (7)
!   multiply each value by two 
 
    TYPE *, 'Original data in the global section:' 
    WRITE (6,100) (IARRAY(I), I=1,50) 
100 FORMAT (10I5) 
    DO I=1,50                                              (8)
      IARRAY(I) = IARRAY(I) * 2 
    END DO 
 
!   Set an event flag to allow PAGEFIL1 to continue execution 
 
    STATUS = SYS$SETEF(%VAL(73)) 
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
    END PROGRAM 

The options file PAGEFIL.OPT contains the following line of source text:


PSECT_ATTR=MYCOM,PAGE,SHR,WRT,SOLITARY                     (1)
COLLECT=SHARED_CLUS,MYCOM                                  (9)

Sample Use:


$ FORTRAN /ALIGN=NATURAL PAGEFIL1
$ FORTRAN/ALIGN=NATURAL PAGEFIL2
$ LINK PAGEFIL1,PAGEFIL/OPTIONS                 (1)
$ LINK PAGEFIL2,PAGEFIL/OPTIONS                 (1)
 
$ RUN PAGEFIL1               !***Process 1***
Waiting for PAGEFIL2 to update section              (10)
            
Modified data in the global section:
    2    4    6    8   10   12   14   16   18   20
   22   24   26   28   30   32   34   36   38   40
   42   44   46   48   50   52   54   56   58   60
   62   64   66   68   70   72   74   76   78   80
   82   84   86   88   90   92   94   96   98  100
 
$ 
$ RUN PAGEFIL2               !***Process 2***
Original data in the global section:                (10) 
    1    2    3    4    5    6    7    8    9   10
   11   12   13   14   15   16   17   18   19   20
   21   22   23   24   25   26   27   28   29   30
   31   32   33   34   35   36   37   38   39   40
   41   42   43   44   45   46   47   48   49   50
$ 

  1. PAGEFIL1 and PAGEFIL2 are linked with the same options file, which specifies that the COMMON block program section is shareable, can be written to, and starts on a page boundary. The first argument to the SYS$CRMPSC (and SYS$MGBLSC) system service is a two-element array MYADR which specifies the starting and ending address.
  2. If any variables or arrays are used or modified, you should declare them as volatile in the other routines that reference them.
  3. Associate to a common event flag cluster to coordinate activity. The processes must be in the same UIC group.
  4. The $CRMPSC system service creates and maps a global pagefile section.
    The starting and ending process virtual addresses of the section are placed in MY_ADR. The SEC$M_PAGFIL flag requests a temporary pagefile section. The flag SEC$M_GBL requests a global section. The flag SEC$M_WRT indicates that the pages should be writable as well as readable. The SEC$M_DZRO flag requests pages filled with zeros.
  5. Data is written to the pagefile section by PAGEFIL1.
  6. PAGEFIL2 maps the existing section as writable by specifying the SEC$M_WRT flag.
  7. PAGEFIL2 reads from the pagefile section.
  8. PAGEFIL2 modifies the data in the pagefile section.
  9. The COLLECT option instructs the linker to create a cluster named SHARED_CLUS and to put the PSECT MYCOM into that cluster. This prevents the problem of inadvertently mapping another PSECT in a page containing all or part of MYCOM. Clusters are always positioned on page boundaries.
  10. After PAGEFIL1 is run, creates the global section, writes out the data, and then displays:


    Waiting for PAGEFIL2 to update section 
    

    A separate terminal is used to run PAGEFIL2, which displays the original data written by PAGEFIL1 and then modifies that data and exits. Once modified, PAGEFIL1 displays the data modified by PAGEFIL2 and exits.

For More Information:

On the VOLATILE statement, see the HP Fortran for OpenVMS Language Reference Manual.

F.5 Sharing Data

The program called SHAREDFIL is used to update records in a relative file. The SHARE qualifier is specified on the OPEN statement to invoke the RMS file sharing facility. In this example, the same program is used to access the file from two processes:

Source Program:


!   File: SHAREDFIL.F90 
! 
!   This program can be run from two or more processes to demonstrate the 
!   use of an RMS shared file to share data.  The program requires the 
!   relative file named REL.DAT. 
 
    IMPLICIT       INTEGER (KIND=4) (A - Z) 
    CHARACTER(LEN=20)   RECORD 
    INCLUDE        '($FORIOSDEF)'                                    (1)
 
    OPEN (UNIT=1, FILE='REL', STATUS='OLD', SHARED,  &               (2)
        ORGANIZATION='RELATIVE', ACCESS='DIRECT', FORM='FORMATTED')  (3)
     
!   Request record to be examined 
 
100 TYPE 10 
 10 FORMAT ('$Record number (Ctrl/Z to quit): ') 
    READ (*,*, END=999) REC_NUM 
 
!   Get record from file 
 
    READ (1,20, REC=REC_NUM, IOSTAT=STATUS), REC_LEN, RECORD 
 20 FORMAT (Q, A) 
 
!   Check I/O status 
 
    IF (STATUS .EQ. 0) THEN 
        TYPE *, RECORD(1:REC_LEN)                     (5)
      ELSE IF (STATUS .EQ. FOR$IOS_ATTACCNON) THEN 
        TYPE *,  'Nonexistent record.' 
        GOTO 100 
      ELSE IF (STATUS .EQ. FOR$IOS_RECNUMOUT) THEN 
        TYPE *, 'Record number out of range.' 
        GOTO 100 
      ELSE IF (STATUS .EQ. FOR$IOS_SPERECLOC) THEN 
        TYPE *, 'Record locked by someone else.'      (4)
        GOTO 100 
      ELSE 
        CALL ERRSNS (, RMS_STS, RMS_STV,,) 
        CALL LIB$SIGNAL (%VAL(RMS_STS), %VAL(RMS_STV)) 
    ENDIF 
 
!  Request updated record 
 
   TYPE 30 
30 FORMAT ('$New Value or CR: ') 
   READ (*,20) REC_LEN, RECORD 
   IF (REC_LEN .NE. 0) THEN 
     WRITE (1,40, REC=REC_NUM, IOSTAT=STATUS) RECORD(1:REC_LEN) 
40   FORMAT (A) 
     IF (STATUS .NE. 0) THEN 
       CALL ERRSNS (, RMS_STS, RMS_STV,,) 
       CALL LIB$SIGNAL(%VAL(RMS_STS),%VAL(RMS_STV)) 
     ENDIF 
   ENDIF 
 
!  Loop 
 
    GOTO 100 
 
999 END PROGRAM 

Sample Use:


$ FORTRAN SHAREDFIL
$ LINK SHAREDFIL
$ RUN SHAREDFIL
Record number (Ctrl/Z to quit): 2
MSPIGGY
New Value or CR: FOZZIE
Record number (Ctrl/Z to quit): 1
KERMIT
New Value or CR:
Record number (Ctrl/Z to quit): Ctrl/Z
$
$ RUN SHAREDFIL
Record number (Ctrl/Z to quit): 2            (4)
Record locked by someone else.
Record number (Ctrl/Z to quit): 2
Record locked by someone else.
Record number (Ctrl/Z to quit): 2
FOZZIE
New Value or CR: MSPIGGY
Record number (Ctrl/Z to quit): Ctrl/Z       (5)
$


Previous Next Contents Index