SUBROUTINE RGRWR (NREC) C***************************************************************************** C C Description : Routine to write the actual page line to the page lay-out C workfile and to read the new actual line C This routine is reserved for RGR-subroutines only C C Arguments : NREC = INTEGER record number new actual page line C C Author : F.A.Minkema C AKZO PHARMA, Oss Holland C dept. SDA C C Version : V2.0 Date : 10-jun-1983 C C Module name : RGRWR.FTN C C Package : TRAMP C C Compilation/Linking : FOR/F4P/TR:NONE RGRWR C C Updates : name version C C description : C C***************************************************************************** C BYTE DEVNAM,OFNTAB,SETPAG,SETSCR,DAT,TIM, 1 TEXREC,DATREC,RREC,SBUF,WPGREC COMMON/RGRCOM/NUNITR,NUNITS,NOS,MNOS,NUCTAB(4,4), 1 MAXBUF,NFRXR,LENREC,NPAG,NWPGR,NWPGC,NFXHL, 2 NRNXRE,NRFFTR,NRLFTR,NRFRTR,NRLRTR,NRFRDR,NRLRDR, 3 IPHLEN,LOGLEN,LOGWID,NRFLDW,NRLLDW,NRDATE,NCDATE, 4 NRTIME,NCTIME,NRPAGE,NCPAGE,NRRELS,NCRELS, 5 DEVNAM(14),SETPAG(6),SETSCR(6),DAT(10),TIM(10), 6 OFNTAB(32,4),TEXREC(40),DATREC(40),RREC(40), 7 SBUF(120),WPGREC(133) C BYTE PROG(6) DATA PROG /'R','G','R','W','R',0/ C C IF (NREC.EQ.NWPGR) GOTO 99 ! check if line is new IF (NWPGR.GT.0) 1 WRITE (NUNITS'NWPGR,ERR=9000) (WPGREC(J),J=1,LENREC) NWPGR=NREC IF (NWPGR.GT.0) 1 READ (NUNITS'NWPGR,ERR=9010) (WPGREC(J),J=1,LENREC) C C go back to calling program C 99 RETURN C C errors C 9000 CALL FATAL(PROG,'WRITE-error page lay-out workfile') 9010 CALL FATAL(PROG,'READ-error page lay-out workfile') END