|
Hi,
The open statement has made on two different file handle
because:
1)First read is on the first record of the file. This record contains
the address of data record. This record must be locked until
data record is written and until this record is updated with
new address.
2)The file is opened with different file handle to write data
record.
What's happening?
Sometimes program executed by user A opens the file, it reads
record 1, this record contains (for example address 10), now
opens again the same file, gets the record 10 and updates the
record with data obtained from serial line, at this point the
program can write record 1 (with address 11).
Program executed by user B have to find the record 1 locked
until above operation have been completed.
Once every ~3000 write user A and user B gets both the same
address 10 for data record, so data record is written twice.
Thanks and best regards
Anna Della Pergola
Follow the program subroutine:
C
C=======WRITE_SUM_REC=======
C
C
C SUBROUTINE to write a record of file SUMMARY.DAY
C =============================================================
C
C
SUBROUTINE WRITE_SUM_REC
IMPLICIT NONE
INCLUDE 'MAIN.CMN'
INTEGER*2 K,I,K1,K2
INTEGER*4 IOSTAT,
2 STATUS,
3 STATU2,
4 PHY_REC
C
C Group to modify file protection
C --------------------------------------------------
C New protection is needed to make file to be opened
C shared by Owner, and by other user with the same
C UIC group.
C
INTEGER*4 SYS$SETDFPROT !System Service Routine
INTEGER*2 NEW_PROT /'F800'X/, !Nuova Protezione Scritta
!(S:RWED,O:RWED,G:RWE,W:)
2 CUR_PROT !Protezione Corrente Letta
INTEGER*2 PROT_ENABLE /'07FF'X/, !Protection Enable
2 PROT_VALUE /'0000'X/ !Protection Value
VOLATILE / PROT_ENABLE /
VOLATILE / PROT_VALUE /
C Variables needed to create subdirectory
INCLUDE '($SSDEF)'
INTEGER*4 LIB$CREATE_DIR
INTEGER*2 DIR_LEN
C
C
C Group to read node parameter to use at new file creation
C ------------------------------------------------------------
C
INCLUDE '($LNMDEF)'
INTEGER*4 SYS$TRNLNM
C
C Item list for SYS$TRLNM
C
STRUCTURE /LNM_ITEM/
INTEGER*2 NAME_LEN /20/, !Max Buffer Size (Byte)
2 NAME_CODE /LNM$_STRING/ !Return String of Name
INTEGER*4 NAME_ADR,
2 RET_ADR,
3 END_LIST /0/
END STRUCTURE
RECORD /LNM_ITEM/ LNMLST
C
C If it is a Slave, change directory of summary file
C in which datas will be rewritten.
K1=0
K2=0
IF ( RX.USRCID .EQ. '02'X)THEN !Si tratta di uno Slave
K1 = INDEX(RS.FILE,'.')
IF(K1 .NE. 0)THEN
K2=INDEX(RS.FILE(K1+1:),'_')
IF(K2 .NE. 0)THEN
RS.FILE(K2+K1+1:K2+K1+3)=MASTER(1:3)
ELSE
END IF
ELSE
END IF
ELSE !Si tratta di un Master
END IF
C
C Opens the file as OLD and verifies if it exists and
C if not, opens a NEW file
C ------------------------------------------------------
C
ERR.SLROU = 'S' !Routine di secondo livello
RS.POINTER = 0
K = 30 !Numero di tentativi
IOSTAT = 30 !File locked by
!another user
DO WHILE ((K .GT. 0) .AND. (IOSTAT .EQ. 30) )
OPEN(UNIT = ASGNUN_RS + 10*(HEAD_NUM-1),
2 FILE = RS.FILE,
3 TYPE ='OLD',
4 FORM ='UNFORMATTED',
5 ACCESS ='DIRECT',
6 ORGANIZATION ='RELATIVE',
7 SHARED,
8 RECL = RS.REC_LEN,
9 IOSTAT = IOSTAT)
IF (IOSTAT .EQ. 30) THEN !File Locked
CALL LIB$WAIT(%REF(0.2))
END IF
K = K - 1
END DO
C
C
C Checks and reads pointer to record to write
C ------------------------------------------------
C Record 1 must be locked until there is an I/O operation
C on the same unit.
C
IF (IOSTAT .EQ. 0) THEN !File Esistente
RS.LOGUN = ASGNUN_RS + 10*(HEAD_NUM-1)
STATUS = 52 !Record Locked
K = 30 !Numero di tentativi
DO WHILE ((K .GT. 0) .AND. (STATUS .EQ. 52))
READ (UNIT = RS.LOGUN,
2 REC = 1,
3 IOSTAT = STATUS) RS.R1.BUF
IF (STATUS .NE. 0) THEN
CALL LIB$WAIT(%REF(0.2))
END IF
K = K - 1
END DO
IF (STATUS .NE. 0) THEN
ERR.SEVERITY = 'F'
ERR.STATUS = STATUS
WRITE ( UNIT = ERR.STRING,
2 FMT = '(1X,''Unable to Read Summary Pointer'',
3 '' : '', I6)',
4 IOSTAT = IOSTAT) RS.R1.REC_PNT
CALL ERR_MESS
CLOSE (UNIT = ASGNUN_RS + 10*(HEAD_NUM-1))
RS.LOGUN = 0
IOSTAT = 30
END IF
END IF
C
C
C Open new file (Protezione=(S:RWED,O:RWED,G:RWE,W:))
C -------------------------------------------------------------
C
IF (IOSTAT .NE. 0) THEN
C
C Legge il livello corrente di protezione e lo salva
C
STATUS = SYS$SETDFPROT (
1 ,
2 %REF(CUR_PROT) )
C
C La modifica e crea il File
C
STATUS = SYS$SETDFPROT (
1 %REF(NEW_PROT)
2 , )
C Directory creation
C Routine LIB$CREATE_DIR gets SS$_NORMAL if directory
C exists ann SS$_CREATED if has been created.
C
C Building name of directory to be created
DIR_LEN = INDEX(RS.FILE,']')
STATUS = LIB$CREATE_DIR (
1 %DESCR(RS.FILE(1:DIR_LEN)),
2 %REF(0), !Owner UIC = Parent Directory
3 %REF(PROT_ENABLE), !Protection Mask Enable
4 %REF(PROT_VALUE), !Protection Mask Value
5 , !Max Versions
6 ) !Volume Number
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
OPEN(UNIT = ASGNUN_RS + 10*(HEAD_NUM-1),
2 FILE = RS.FILE,
3 TYPE ='NEW',
4 FORM ='UNFORMATTED',
5 ACCESS ='DIRECT',
6 ORGANIZATION ='RELATIVE',
7 SHARED,
8 RECL = RS.REC_LEN,
9 IOSTAT = IOSTAT)
C
C Ripristina la protezione di default
C
STATUS = SYS$SETDFPROT (
1 %REF(CUR_PROT)
2 , )
C
C
C
C Build data to be write on record 1
C ----------------------------------------------
C
C Node
C
LNMLST.NAME_ADR = %LOC(RS.R1.NODE)
LNMLST.RET_ADR = %LOC(RS.R1.NODE_LEN)
STATUS = SYS$TRNLNM( , !Mask
2 %DESCR('LNM$SYSTEM'), !Table
3 %DESCR( 'SYS$NODE') , !Logic Name
4 , !Access mode
4 LNMLST) !Item list
C
C Plant
C
LNMLST.NAME_ADR = %LOC(RS.R1.PLANT)
LNMLST.RET_ADR = %LOC(RS.R1.PLANT_LEN)
STATUS = SYS$TRNLNM( , !Mask
2 %DESCR('LNM$GROUP'), !Table
3 %DESCR( 'PLANT') , !Logic name
4 , !Access mode
4 LNMLST) !Item list
IF (.NOT. STATUS) THEN
RS.R1.PLANT_LEN = 7
RS.R1.PLANT = 'UNKNOWN'
END IF
C
C Department
C
LNMLST.NAME_ADR = %LOC(RS.R1.DEPARTMENT)
LNMLST.RET_ADR = %LOC(RS.R1.DEP_LEN)
STATUS = SYS$TRNLNM( , !Mask
2 %DESCR('LNM$GROUP'), !Table
3 %DESCR( 'DEPARTMENT'), !Logic name
4 , !Access mode
4 LNMLST) !Item list
IF (.NOT. STATUS) THEN
RS.R1.DEP_LEN = 7
RS.R1.DEPARTMENT = 'UNKNOWN'
END IF
C
RS.LOGUN = ASGNUN_RS + 10*(HEAD_NUM-1)
RS.R1.REC_PNT = 0 !Puntatore Record da
!scrivere
RS.R1.REV = 1 !Revisione File
RS.R1.N_REC = MAX_SUM_REC !Numero massimo di Records
RS.R1.L_REC = RS.REC_LEN !Lunghezza Record in
!Long Words
RS.R1.TESTER_LEN = 10
RS.R1.TESTER = STR.TESTER_NAME
END IF
C
IF (IOSTAT .NE. 0) THEN
ERR.SEVERITY = 'F'
ERR.STATUS = IOSTAT
WRITE ( UNIT = ERR.STRING,
2 FMT = '(1X,''Unable to Open '',A<RS.FILE_LEN>)',
4 IOSTAT = IOSTAT) RS.FILE
CALL ERR_MESS
GOTO 30 !Return
END IF
C
C
C If record is a Summary (00,01,02) add the pointer to
C record
C
IF (RS.SR.BYTE_IDEN .GE. 0) THEN
RS.SR.CID_R = RS.R1.COMM_REC
ELSE IF (RS.SR.BYTE_IDEN .EQ. -2) THEN
RS.R1.COMM_REC = RS.R1.REC_PNT
END IF
C
C Opens file as OLD using a different unit to prevent
C that other I/o operations to unlock record 1
C If it isn't able to open the file as OLD
C exits with error message.
C
C
ERR.SLROU = 'S' !Routine di secondo livello
RS.POINTER = 0
K = 30 !Numero di tentativi
IOSTAT = 30 !File locked by
!another user
DO WHILE ((K .GT. 0) .AND. (IOSTAT .EQ. 30) )
OPEN(UNIT = ASGNUN_RS2 + 10*(HEAD_NUM-1),
2 FILE = RS.FILE,
3 TYPE ='OLD',
4 FORM ='UNFORMATTED',
5 ACCESS ='DIRECT',
6 ORGANIZATION ='RELATIVE',
7 SHARED,
8 RECL = RS.REC_LEN,
9 IOSTAT = IOSTAT)
IF (IOSTAT .EQ. 30) THEN !File Locked
CALL LIB$WAIT(%REF(0.2))
END IF
K = K - 1
END DO
IF (IOSTAT .NE. 0) THEN
ERR.SEVERITY = 'F'
ERR.STATUS = IOSTAT
WRITE ( UNIT = ERR.STRING,
2 FMT = '(1X,''Unable to Open '',A<RS.FILE_LEN>)',
4 IOSTAT = IOSTAT) RS.FILE
CALL ERR_MESS
GOTO 30 !Return
END IF
C
C Write record
C --------------------
C
K1 = RS.REC_LEN * 4 !Number of Bytes
PHY_REC = MOD(RS.R1.REC_PNT , 1000) + 2 !Record fisico
RS.LOGUN = ASGNUN_RS2 + 10*(HEAD_NUM-1)
K = 30 !Numero di tentativi
STATUS = 52 !Record locked by
!another user
DO WHILE ((K .GT. 0) .AND. (STATUS .EQ. 52) )
WRITE ( UNIT = RS.LOGUN,
2 REC = PHY_REC,
3 IOSTAT = STATUS) RS.SR.BUFF(1:K1)
IF (IOSTAT .EQ. 52) THEN !Record Locked
CALL LIB$WAIT(%REF(0.2))
END IF
K = K - 1
END DO
IF (IOSTAT .NE. 0) THEN
ERR.SEVERITY = 'F'
ERR.STATUS = IOSTAT
WRITE ( UNIT = ERR.STRING,
2 FMT = '(1X,''Unable to Write Summary Record '', I7)',
4 IOSTAT = IOSTAT) RS.R1.REC_PNT
CALL ERR_MESS
GOTO 30 !Return
END IF
C
C
C Rewrites the pointer and unlock record 1
C -------------------------------------------------------
C (Only if previous operations have been completed successfully)
C
RS.R1.REC_PNT = RS.R1.REC_PNT + 1
K = 30 !Numero di tentativi
STATU2 = 52 !Record Locked
RS.LOGUN = ASGNUN_RS + 10*(HEAD_NUM-1) !Unita` logica del
!puntatore
DO WHILE ( (STATU2 .EQ. 52) .AND. (K .GT. 0) )
WRITE ( UNIT = RS.LOGUN,
2 REC = 1,
3 IOSTAT = STATU2) RS.R1.BUF
IF (STATU2 .EQ. 52) THEN
CALL LIB$WAIT(%REF(0.2))
END IF
K = K - 1
END DO
IF (STATU2 .NE. 0) THEN
ERR.SEVERITY = 'F'
ERR.STATUS = IOSTAT
ERR.STRING = 'Unable to Write Summary Record 1'
CALL ERR_MESS
END IF
C
C Close two units and return to main program
C ---------------------------------------------------------
C
30 CLOSE ( UNIT = ASGNUN_RS + 10*(HEAD_NUM-1)) ! unita` logica
! legata al puntatore
CLOSE ( UNIT = ASGNUN_RS2+ 10*(HEAD_NUM-1)) ! unita` logica
! legata al record di dati,
! commenti ed istogrammi
RS.LOGUN = 0
ERR.SLROU = '.' !Routine di secondo livello
END
|