C++******************************************************************** C C INTERP.FOR 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 INTERP(LUNO,LUNN,BUF,NSAMO,NROWO,NSAMN,NROWN) C C PURPOSE: C THIS SUBROUTINE INTERPOLATES A GIVEN IMAGE 1 IN A RASTER OF C ARBITRARY DIMENSIONS TO GIVE IMAGE 2. C C PARAMETERS: C LUNO LOGICAL UNIT NUMBER OF INPUT IMAGE C LUNN LOGICAL UNIT NUMBER OF OUTPUT IMAGE C BUF BUFFER ARRAY OF SIZE 2*NSAMO+NSAMN C NSAMO,NROWO DIMENSIONS OF INPUT PICTURE C NSAMN,NROWN DIMENSIONS OF OUTPUT PICTURE C C CODING: BILINEAR INTERPOLATION AS DESCRIBED BY AEBI ET AL., C ULTRASTR. RES. IS APPLIED TO COMPUTE IMAGE ON C NEW RASTER. PARAMETER LABEL IS COPIED OVER. OUTPUT C PICTURE CAN BE LARGER OR SMALLER THAN INPUT PICTURE. C C*RPTX,RPTY SCALES I AND J C*SUBSCRIPTS OF INTERPOLATED C*PICTURE DOWN TO SCALE OF C*ORIGINAL PICTURE, C*X IS DISTANCE IN X DIR. FROM C*POINT TO BE INTERPOLATED AT C*TO OLDIMAGE(NPTY1,NPTX1) C*Y IS Y DISTANCE C* OLDIMAGE(NPTY1,NPTX1)----------OLDIMAGE(NPTY1,NPTX2) C - NEWIMAGE(J,I) - C* OLDIMAGE(NPTY2,NPTX1)----------OLDIMAGE(NPTY2,NPTX2) C*USED FOR ITS INTERPOLATION. C*SEE J. OF SUPRAMOLECULAR STRUCTURE C*PAGE 498 1973 C*************** C--******************************************************************* SUBROUTINE INTERP(LUNO,LUNN,NSAMO,NROWO,NSAMN,NROWN,MAXDIM) COMMON BUF(1) IF (NSAMO.EQ.2*NSAMN .AND. NROWO.EQ.2*NROWN) THEN C TWO-FOLD DECIMATION BY SUMMATION OF NEIGHBOURING PIXELS. K1 = 1 K2 = K1+NSAMO DO J=1,NROWO,2 DO I=1,NSAMN BUF(K2+I-1)=0.0 ENDDO DO K=1,2 CALL REDLIN(LUNO,BUF,NSAMO,J+K-1) DO I=1,NSAMO,2 BUF(K2-1+(I+1)/2)=BUF(K2-1+(I+1)/2)+BUF(I)+BUF(I+1) ENDDO ENDDO DO I=1,NSAMN BUF(K2+I-1)=BUF(K2+I-1)/4 ENDDO CALL WRTLIN(LUNN,BUF(K2),NSAMN,(J+1)/2) ENDDO RETURN ELSEIF (NSAMO.EQ.4*NSAMN .AND. NROWO.EQ.4*NROWN) THEN C Four-fold decimation by summation of neighbouring pixels. K1=1 K2=K1+NSAMO DO J=1,NROWO,4 DO I=1,NSAMN BUF(K2+I-1)=0.0 ENDDO DO K=1,4 CALL REDLIN(LUNO,BUF,NSAMO,J+K-1) DO I=1,NSAMO,4 BUF(K2-1+(I+3)/4)=BUF(K2-1+(I+3)/4)+ & BUF(I)+BUF(I+1)+BUF(I+2)+BUF(I+3) ENDDO ENDDO DO I=1,NSAMN BUF(K2+I-1)=BUF(K2+I-1)/16 ENDDO CALL WRTLIN(LUNN,BUF(K2),NSAMN,(J+3)/4) ENDDO RETURN ELSEIF(NSAMO.EQ.6*NSAMN .AND. NROWO.EQ.6*NROWN) THEN C SIX-FOLD DECIMATION BY SUMMATION OF NEIGHBOURING PIXELS. K1=1 K2=K1+NSAMO DO J=1,NROWO,6 DO I=1,NSAMN BUF(K2+I-1)=0.0 ENDDO DO K=1,6 CALL REDLIN(LUNO,BUF,NSAMO,J+K-1) DO I=1,NSAMO,6 BUF(K2-1+(I+5)/6)=BUF(K2-1+(I+5)/6)+ & BUF(I)+BUF(I+1)+BUF(I+2)+BUF(I+3)+BUF(I+4)+BUF(I+5) ENDDO ENDDO DO I=1,NSAMN BUF(K2+I-1)=BUF(K2+I-1)/36 ENDDO CALL WRTLIN(LUNN,BUF(K2),NSAMN,(J+5)/6) ENDDO RETURN ENDIF C--------------------------------------------------------------- SIZX=FLOAT(NSAMN)/FLOAT(NSAMO) SIZY = FLOAT(NROWN)/FLOAT(NROWO) CORX = (NSAMO-1.)/(NSAMN-1.) CORY = (NROWO-1.)/(NROWN-1.) C WRITE(4,7777)SIZX,CORX,SIZY,CORY C7777 FORMAT(1X,4F8.3) NSAMO2 = NSAMO*2 NSAMO3 = NSAMO2+NSAMN C IF(NSAMO3.LE.MAXDIM) GOTO 20 C CALL ERRT(6,'INTERP',NE) C RETURN C20 NPTX1 = -1 NE = NROWN - 1 NES = NSAMN-1 C DO FIRST LINE CALL REDLIN(LUNO,BUF,NSAMO,1) RPTY = 1. DO J = 2,NES RPTY = RPTY+CORX NPTY1 = INT(RPTY) Y = RPTY-NPTY1 YREM = 1.-Y BUF(NSAMO2+J) = YREM*BUF(NPTY1)+Y*BUF(NPTY1+1) ENDDO BUF(NSAMO2+1) = BUF(1) BUF(NSAMO3) = BUF(NSAMO) CALL WRTLIN(LUNN,BUF(NSAMO2+1),NSAMN,1) NS1 = 1 NS2 = NSAMO+1 RPTX = 1. DO I = 2,NE RPTX=RPTX+CORY NPTX1=INT(RPTX) IF (NPTX1.EQ.NPREV) GOTO 800 NPTX2=NPTX1+1 IF (SIZY .LT. 1) CALL REDLIN(LUNO,BUF(NS1),NSAMO,NPTX1) CALL REDLIN(LUNO,BUF(NS2),NSAMO,NPTX2) NPREV = NPTX1 C ALTERNATE BUFFER ADDRESS NS1P = NS1 NS1 = NS2 NS2 = NS1P 800 X= RPTX-NPTX1 XREM=1.-X C INTERPOLATE LINE (I) RPTY = 1. DO J = 2,NES RPTY=RPTY+CORX NPTY1=INT(RPTY) NPTY2=NPTY1+1 Y=(RPTY-NPTY1) YREM=1.-Y BUF(NSAMO2+J)=X*(YREM*BUF(NPTY1+NS1-1)+Y*BUF(NPTY1+NS1)) & + XREM*(YREM*BUF(NPTY1+NS2-1) + Y*BUF(NPTY1+NS2)) ENDDO BUF(NSAMO2+1) = X*BUF(NS1) + XREM*BUF(NS2) BUF(NSAMO3)=X*BUF(NSAMO+NS1-1) +XREM*BUF(NSAMO+NS2-1) CALL WRTLIN(LUNN,BUF(NSAMO2+1),NSAMN,I) ENDDO C DO LAST LINE RPTY = 1. IF(SIZY .LT. 1) CALL REDLIN(LUNO,BUF(NS1),NSAMO,NROWO) DO J=2,NES RPTY=RPTY+CORX NPTY1=INT(RPTY) Y=RPTY-NPTY1 YREM=1.-Y BUF(NSAMO2+J)=YREM*BUF(NPTY1+NS1-1)+Y*BUF(NPTY1+NS1) ENDDO BUF(NSAMO2+1) = BUF(NS1) BUF(NSAMO3) = BUF(NS1+NSAMO-1) CALL WRTLIN(LUNN,BUF(NSAMO2+1),NSAMN,NROWN) END