C TAD1.FOR (INFN ROUTINE FOR COMPUTING TIME AFTER DOSE)
C wjb 28feb2002 GloboMax LLC
C DK 20070417
C data items: ID DATE=DROP TIME MDV AMT II ADDL DV EVID TAD

C DATREC(2)=TIME DATA ITEM
C DATREC(6)=ADDL DATA ITEM
C DATREC(5)=II DATA ITEM
C DATREC(8)=EVID DATA ITEM
C DATREC(9)=TAD DATA ITEM
C 
	SUBROUTINE INFN (ICALL,THETA,DATREC,INDXS,NEWIND)
	DIMENSION THETA(*),DATREC(*),INDXS(*)
	DOUBLE PRECISION THETA
	INTEGER IFL
	REAL DATREC, DIV, TDOS, TDOS2, ADLN
	REAL DTIME, DADDL, DII, DEVID, DTAD
	REAL MGN

C maximum delay in PK sampling
	MGN=4.0

C call at termination only 
	IF (ICALL.EQ.3) THEN
	 
C INITIALIZE PASS 
	MODE=0
	CALL PASS (MODE)
	MODE=2
C PASS THROUGH DATA 
    5	CALL PASS (MODE)
    
C MATCH DATREC NUMBER!!!
        DTIME=DATREC(2)
        DADDL=DATREC(6)
        DII=DATREC(5)	
        DEVID=DATREC(8)
     
        IF (MODE.EQ.0) GO TO 10
        IF (NEWIND.LT.2) THEN
          DTAD=0.0
          IFL=0
        ENDIF
        IF(DEVID.EQ.1.OR.DEVID.EQ.4) THEN
          DTAD=0.0
          DIV=DII
          ADLN=DADDL
          TDOS=DTIME
          IFL=1
        ENDIF

        IF(IFL.EQ.1.AND.DEVID.NE.1.AND.DEVID.NE.4) THEN

        IF(DIV.GT.0) THEN
	    DTAD=AMOD(DTIME-TDOS,DIV)
	    IF (((DTIME-TDOS)/DIV).GE.1.AND.DTAD.LT.MGN) DTAD=DTAD+DIV
	    IF (DTAD.EQ.0.AND.DTIME-TDOS.LT.DIV*ADLN+DIV) DTAD=DIV
        ENDIF 
        IF(DIV.LE.0) DTAD=DTIME-TDOS

        IF(DIV*ADLN.GT.0.AND.DTIME-TDOS.GE.DIV*ADLN+DIV) THEN   
          TDOS2=TDOS+DIV*ADLN
          DTAD=DTIME-TDOS2
        ENDIF

        ENDIF
          
C MATCH DATREC NUMBER!!!
        DATREC(9)=DTAD

        GO TO 5 
   10	ENDIF
	END