C ++********************************************************************
C                                                                      *
C                                                                      *
C                                                                      *
C **********************************************************************
C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM.   AUTHOR: J.FRANK  *
C=* Copyright (C) 1985-2005  Health Research Inc.                      *
C=*                                                                    *
C=* HEALTH RESEARCH INCORPORATED (HRI),                                *   
C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455.                   *
C=*                                                                    *
C=* Email:  spider@wadsworth.org                                       *
C=*                                                                    *
C=* This program is free software; you can redistribute it and/or      *
C=* modify it under the terms of the GNU General Public License as     *
C=* published by the Free Software Foundation; either version 2 of the *
C=* License, or (at your option) any later version.                    *
C=*                                                                    *
C=* This program is distributed in the hope that it will be useful,    *
C=* but WITHOUT ANY WARRANTY; without even the implied warranty of     *
C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU  *
C=* General Public License for more details.                           *
C=*                                                                    *
C=* You should have received a copy of the GNU General Public License  *
C=* along with this program; if not, write to the                      *
C=* Free Software Foundation, Inc.,                                    *
C=* 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.      *
C=*                                                                    *
C **********************************************************************
C                                                                      *
C                                                                      *
C                                                                      *
C  PURPOSE:                                                            *
C                                                                      *
C  PARAMETERS:                                                         *
C                                                                      *
C        0         2         3         4         5         6         7 *
C23456789012345678901234567890123456789012345678901234567890123456789012
C***********************************************************************

#ifdef SP_DISTRIB 
 
C   THIS ROUTINE SPECIFIC TO WADSWORTH LABS AND IS NOT 
C       DISTRIBUTED TO OUTSIDE SITES
 
       SUBROUTINE trinter(L1,L2,L3,L4,L5,L6,L7,L8)
 
       COMMON /UNITS/LUNC,NIN,NOUT
 
       WRITE(NOUT,*) 'DUMMY CALL: trinter'
       RETURN
       END
 
#else
 

        SUBROUTINE TRINTER(LUNO,LUNN,
     $  OLDIMX,OLDIMY,OLDIMZ,NEWDIMX,NEWDIMY,NEWDIMZ)
        COMMON BUF(1)
C------------------------------------------------------------------------------
C       SUBROUTINE TO DO A BILINEAR INTERPOLATION USING ONLY
C       THREE POINTS OF A FACET.
C       M.RADERMACHER, JUNE 1984
C       IN PARTS BASED ON SUBROUTINE GENINT, AUTHOR: R.SMITH 1983
C------------------------------------------------------------------------------
        INTEGER OLDIMX,OLDIMY,OLDIMZ,ZCOLD,XCOLD,YCOLD,YLINE,XLINE
        INTEGER YLINEO,XLINEO,YLINE2,XLINE2

        NS1=1
        NS2=OLDIMX+1
        NS3=NS2+OLDIMX
	WRITE(6,100)LUNO,LUNN,OLDIMX,OLDIMY,OLDIMZ,NEWDIMX,NEWDIMY,
     $  NEWDIMZ,NS1,NS2,NS3
100     FORMAT(' ',11I5)
        FACZ=FLOAT(OLDIMZ)/FLOAT(NEWDIMZ)
        FACX=FLOAT(OLDIMX)/FLOAT(NEWDIMX)
        FACY=FLOAT(OLDIMY)/FLOAT(NEWDIMY)
        DO  I=1,NEWDIMZ
        ZCOO=FLOAT(I)*FACZ
        ZCOLD=INT(ZCOO)
        ZDIF=AMOD(ZCOO,1.)
        ZLINE=(ZCOLD-1)*OLDIMY
        DO  K=1,NEWDIMY
        YLINEO=YLINE
        YLINEO2=YLINE2
        YCOO=FLOAT(K)*FACY
        YCOLD=INT(YCOO)
        YLINE=ZLINE+YCOLD
        YLINE2=YLINE+1
        IF(YLINE2.GT.(ZLINE+OLDIMY)) YLINE2=YLINE
        IF(YLINE.EQ.ZLINE) YLINE=YLINE2
        YDIF=AMOD(YCOO,1.)
        IF(YLINE.NE.YLINEO) THEN 
            
          IF(YLINE.EQ.YLINEO2) THEN
            
            NS1P=NS1
            NS1=NS2
            NS2=NS1P
            CALL REDLIN(LUNO,BUF(NS2),OLDIMX,YLINE2) 
          ELSE
            CALL REDLIN(LUNO,BUF(NS1),OLDIMX,YLINE)
            CALL REDLIN(LUNO,BUF(NS2),OLDIMX,YLINE2)        
          ENDIF
        ENDIF
        DO  L=1,NEWDIMX
        XCOO=FLOAT(L)*FACX
        XCOLD=INT(XCOO)       
C  FIRST SOLVE THE TWODIMENSIONAL PROBLEM:
        XDIF=AMOD(XCOO,1.)
        IC1=NS1+XCOLD
        IC2=IC1+1
        IC3=NS2+XCOLD
        IC4=IC3+1
        Z1=BUF(IC1)
        Z2=BUF(IC2)
        Z3=BUF(IC3)
        Z4=BUF(IC4)
        Z5=Z2-Z1
        Z6=Z4-Z3
        Z7=Z4-Z2
        Z8=Z1-Z3
        IF(ABS(Z1-Z4)-ABS(Z2-Z3).LT.0) GOTO 21
        IF(XDIF+YDIF.GT.1) GOTO 22
        Z=Z1+XDIF*Z5-YDIF*Z8
        GOTO 200
22      Z=Z4+(XDIF-1.)*Z6+(YDIF-1)*Z7
        GOTO 200
21      IF(XDIF.GT.YDIF) GOTO 23
        Z=Z3+Z8*(1-YDIF)+Z6*XDIF
        GOTO 200
23      Z=Z2+Z5*(XDIF-1.)+Z7*YDIF
200     BUF(NS3+L)=Z
	ENDDO
C       WRITE(6,100)K
        CALL WRTLIN(LUNN,BUF(NS3),NEWDIMX,K)
	ENDDO
	ENDDO
        END
 
#endif