Program SHARED c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c c Dr. Klaus P. Schneider May 1988 c c This Program tests the TSXLIB routines : IDCLSF = declare file to be shared c LKBLK = lock a specific block c LKBLKW = wait to lock a block c IUALBK = unlock all blocks c c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c c Attention: File must be opened with OPEN statment, not with c ASSIGN for shared file access. OPEN (UNIT=1,NAME='DK:SHARED.DAT',TYPE='OLD',ACCESS='DIRECT', 1 RECL=256,MAXREC=20,ASSOCIATEVARIABLE=IREC) c..... get channel # ICHAN = ILUN ( 1 ) IF ( ICHAN .EQ. -1 ) TYPE *,' Logical unit is not open ' c..... Declare File to be shared IACES = 5 ! shared/update CALL IDCLSF ( ICHAN,IACES,IERR )! declare file to be shared TYPE *,' Errorflag for IDCLSF = ',IERR c..... test Error return IF ( IERR .EQ. 0 ) THEN TYPE *,' shared file support not available ' ELSEIF ( IERR .EQ. 1 ) THEN TYPE *,' I/O channel has not been opened to a file' ELSEIF ( IERR .EQ. 2 ) THEN Type *,' attempted to open too many channels to shared files' ELSEIF ( IERR .EQ. 3 ) THEN Type *,' attempted to opne too many shared files' ELSEIF ( IERR .EQ. 4 ) THEN Type *,' a file protection/access conflict exists' ENDIF c..... lock all blocks in File c change comment C character to switch between lock and lock-wait 1234 IBLOCK = 11 CALL LKBLK ( ICHAN,IBLOCK,IERR ) ! lock block # IBLOCK c CALL LKBLKW ( ICHAN,-1,IERR ) ! wait for a block to lock TYPE *,' Errorflag for LKBLK = ',IERR IF( IERR .EQ. 3 ) THEN TYPE *,' The requested block is locked by another user ' TYPE *,' Wait for one second - then next try ' CALL ISLEEP (0,0,1,0) ! sleep 1 second GOTO 1234 ENDIF Pause ' all Blocks locked, switch to a subprocess an run this program' c..... unlock all locked blocks CALL IUALBK (ICHAN,IERR) TYPE *,' Errorflag for IUALBK = ',IERR STOP END