SUBROUTINE RGRPOS (REPORT, NPAGE) C***************************************************************************** C C Description : Routine to initialize settings for a specified report C C Arguments : REPORT = STRING containing the name of the report C NPAGE = INTEGER to reset page number if greater than zero 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 : RGRPOS.FTN C C Package : TRAMP C C Compilation/Linking : FOR/F4P/TR:NONE RGRPOS 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 C report name-record BYTE RENAM(8) C RENAM ! report name C NRNXRE ! rec.nr. next report C NRFFTR ! rec.nr. first fix text rec. C NRLFTR ! rec.nr. last fix text rec. C NRFRTR ! rec.nr. first relative text rec. C NRLRTR ! rec.nr. last relative text rec. C NRFRDR ! rec.nr. first relative data rec. C NRLRDR ! rec.nr. last relative data rec. C NFXHL ! number of fix header lines C C report page info-record C IPHLEN ! phys. page length/hardware form-feed C LOGLEN ! logical length of report page C LOGWID ! logical width of report page C NRFLDW ! number of first line of data window C NRLLDW ! number of last line of data window C NRDATE ! row number of date string C NCDATE ! column number of date string C NRTIME ! row number of time string C NCTIME ! column number of time string C NRPAGE ! row number of page number C NCPAGE ! column number of page number C NRRELS ! starting row relative text/data C NCRELS ! starting column relative text/data C BYTE REPORT(1),PROG(8) DATA PROG /'R','G','R','P','O','S',2*0/ C C C search file for specified report C NEXT=NRNXRE CALL SCVTLU(REPORT) 10 NFRXR=NRNXRE READ (NUNITR'NFRXR,ERR=9000) RENAM,NRNXRE,NRFFTR, 1 NRLFTR,NRFRTR,NRLRTR,NRFRDR,NRLRDR,NFXHL IF (ISCOMP(REPORT,RENAM).EQ.0) GOTO 20 IF (NRNXRE.EQ.NEXT) GOTO 9010 GOTO 10 C C read report info-record and open page lay-out workfile C 20 IF (NFXHL.NE.0) 22,24,24 C THEN 22 CALL RGRWR(0) ! force last line in page lay-out workfile GOTO 30 C ELSE 24 READ (NUNITR'NFRXR+1,ERR=9020) IPHLEN,LOGLEN,LOGWID,NRFLDW,NRLLDW, 1 NRDATE,NCDATE,NRTIME,NCTIME,NRPAGE,NCPAGE,NRRELS,NCRELS C IF (NUNITS.GT.0) CLOSE(UNIT=NUNITS) NUNITS=IABS(NUNITS) IRCSIZ=LOGWID/4+1 LENREC=MIN0(IRCSIZ*4,133) NBLK=(LOGLEN*LENREC/512)+1 SBUF(1)=0 CALL SBUILD(SBUF,,DEVNAM,'RGRWRK.TMP') OPEN (UNIT=NUNITS,NAME=SBUF,TYPE='SCRATCH',ACCESS='DIRECT', 1 RECORDSIZE=IRCSIZ,INITIALSIZE=NBLK,MAXREC=LOGLEN+1,ERR=9030) C ENDIF C C set up blank page in lay-out workfile C 30 TEXREC(1)=0 DATREC(1)=0 IF (NPAGE.GT.0) NPAG=NPAGE CALL RGRIP C C go back to calling routine C RETURN C C errors C 9000 CALL FATAL(PROG,'READ-error report name-record') 9010 CALL FATAL(PROG,'Report not found') 9020 CALL FATAL(PROG,'READ-error report page info-record') 9030 CALL FATAL(PROG,'Can''t open page lay-out workfile') END