SUBROUTINE RGRDAT (FIELD, DATA) C***************************************************************************** C C Description : Routine to write relative data to the page lay-out workfile C C Arguments : FIELD = STRING containing the field-name C DATA = string, integer or real data (according to data type C specified for the appropriate field) 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 : RGRDAT.FTN C C Package : TRAMP C C Compilation/Linking : FOR/F4P/TR:NONE RGRDAT 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 data-record BYTE DATFLD(8),DATYP(2),PICT(24) EQUIVALENCE (DATFLD,DATREC(1)) ! field name EQUIVALENCE (IRDAT ,DATREC(9)) ! abs./rel. row number EQUIVALENCE (ICDAT ,DATREC(11)) ! abs./rel. column number EQUIVALENCE (IARDAT,DATREC(13)) ! abs./rel. flag EQUIVALENCE (DATYP ,DATREC(15)) ! data type I(nt.),R(eal) or S(tring) EQUIVALENCE (DATPIC,DATREC(17)) ! picture field for I- & R-type EQUIVALENCE (LDASTR,DATREC(17)) ! string length for S-type C BYTE FIELD(1),DATA(1),DATBUF(4),PROG(8),VALSTR(28) EQUIVALENCE (IDATA ,DATBUF(1)) EQUIVALENCE (RDATA ,DATBUF(1)) DATA PROG /'R','G','R','D','A','T',2*0/ C C C search field with appropriate name C IF (FIELD(1).EQ.0 .OR. NRFRDR.EQ.0) GOTO 9000 CALL SCVTLU(FIELD) IREC=NRFRDR 10 IF (ISCOMP(FIELD,DATFLD).EQ.0) GOTO 20 IF (IREC.GT.NRLRDR) GOTO 9000 READ (NUNITR'IREC,ERR=9010) DATREC ! read realtive data record IREC=IREC+1 GOTO 10 C C put data in page lay-out workfile C 20 IF (DATYP(1).EQ.'S') 22,30,30 C THEN 22 CALL RGRPS(IRDAT,ICDAT,IARDAT,DATA,LDASTR) GOTO 99 C ELSE 30 DO 40 J=1,4 DATBUF(J)=DATA(J) 40 CONTINUE IF (DATYP(1).EQ.'I') CALL SCVTI(IDATA,DATPIC,VALSTR) IF (DATYP(1).EQ.'R') CALL SCVTR(RDATA,DATPIC,VALSTR) CALL RGRPS(IRDAT,ICDAT,IARDAT,VALSTR,0) C ENDIF C C go back to calling routine C 99 RETURN C C errors C 9000 CALL FATAL(PROG,'Field not found') 9010 CALL FATAL(PROG,'READ-error relative data-record') END