SUBROUTINE RGRTEX (FIELD) C***************************************************************************** C C Description : Routine to write relative text to the page lay-out workfile C C Arguments : FIELD = STRING containing the field-name 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 : RGRTEX.FTN C C Package : TRAMP C C Compilation/Linking : FOR/F4P/TR:NONE RGRTEX 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 relative text name-record BYTE TEXFLD(8) EQUIVALENCE (TEXFLD,TEXREC(1)) ! field name EQUIVALENCE (IRTEX ,TEXREC(9)) ! abs./rel. row number EQUIVALENCE (ICTEX ,TEXREC(11)) ! abs./rel. column number EQUIVALENCE (IARTEX,TEXREC(13)) ! abs./rel. flag EQUIVALENCE (NRTR ,TEXREC(15)) ! number of text records C BYTE FIELD(1),PROG(8) DATA PROG /'R','G','R','T','E','X',2*0/ C C search field with appropriate name C IF (FIELD(1).EQ.0 .OR. NRFRTR.EQ.0) GOTO 9000 CALL SCVTLU(FIELD) IF (ISCOMP(FIELD,TEXFLD).EQ.0) GOTO 30 ! same name as in last call IREC=NRFRTR 10 IF (IREC.GT.NRLRTR) GOTO 9000 READ (NUNITR'IREC,ERR=9010) TEXREC ! read relative text name-record IREC=IREC+NRTR+1 IF (ISCOMP(FIELD,TEXFLD).NE.0) GOTO 10 C C compose text in string buffer C IBUFOF=1 IREC=IREC-NRTR 20 READ (NUNITR'IREC,ERR=9020) RREC CALL SCOPY(RREC,SBUF(IBUFOF),MAXBUF) IREC=IREC+1 IBUFOF=IBUFOF+MAXBUF IF (RREC(MAXBUF).NE.0) GOTO 20 C C put string buffer in page lay-out workfile C 30 CALL RGRPS(IRTEX,ICTEX,IARTEX,SBUF,0) C C go back to calling routine C RETURN C C errors C 9000 CALL FATAL(PROG,'Field not found') 9010 CALL FATAL(PROG,'READ-error relative text name-record') 9020 CALL FATAL(PROG,'READ-error relative text data-record') END