SUBROUTINE TFRFS (NREC) C***************************************************************************** C C Description : Routine to fill the stringbuffer with 1, 2 or 3 records. C This routine is reserved for TFR-subroutines only C C Arguments : NREC = input : INTEGER number of first record C output: INTEGER number of first or second record C C Author : F.A.Minkema C AKZO PHARMA, Oss Holland C dept. SDA C C Version : V1.0 Date : 1-nov-1982 C C Module name : TFRFS.FTN C C Package : TRAMP C C Compilation/Linking : FOR/F4P/TR:NONE TFRFS C C Updates : name version C C description : C C***************************************************************************** C BYTE HOMSTR,CLRSTR,ERLSTR,NATSTR,HERPOS,ERRATT,HLPATT,FCR,SBUF,FREC COMMON/TFRCOM/NUNIT,MAXBUF,NRNXFR,LLFLD,NLFCR,IHEFLG,ISCR, 1 NRFFFR,NRLFFR,NRFDFR,NRLDFR,NRFUFR,NRLUFR, 2 HOMSTR(4),CLRSTR(4),ERLSTR(4),NATSTR(6),HERPOS(8), 3 ERRATT(8),HLPATT(8),FCR(80),SBUF(120),FREC(40) C BYTE PROG(8),SB1(40),SB2(40),SB3(40) EQUIVALENCE (SB1 ,SBUF(1)) ! first part of buffer EQUIVALENCE (SB2 ,SBUF(41)) ! second part of buffer EQUIVALENCE (SB3 ,SBUF(81)) ! third part of buffer DATA PROG/'T','F','R','F','S',3*0/ C C C read 1, 2 or 3 records into the buffer C READ (NUNIT'NREC,ERR=9000) SB1 10 IF (SB1(MAXBUF).NE.0) 20,99,99 C THEN 20 NREC=NREC+1 READ (NUNIT'NREC,ERR=9010) SB2 IF (SB2(MAXBUF).NE.0) 30,99,99 C THEN 30 NREC=NREC+1 READ (NUNIT'NREC,ERR=9020) SB3 C ENDIF C ENDIF C C go back to calling routine C 99 RETURN C C errors C 9000 CALL FATAL(PROG,'READ-error first record') 9010 CALL FATAL(PROG,'READ-error second record') 9020 CALL FATAL(PROG,'READ-error third record') END