C++********************************************************************* C C ROT2QS.F BUFOUT RETURN ADDED, SPEEDED UP 12/28/06 ArDean Leith C MERGED WITH ROT2QS_DL 1/12/11 ArDean Leith C ROT2QS_PAD ADDED 8/12/11 ArDean Leith C ROT2QS_BACK ADDED 10/05/11 ArDean Leith C ********************************************************************** C C ROT2QS(XIMG,BUFOUT,NSAM,NROW,THETA,SCLI,SHXI,SHYI,IREC1,LUN) C C PURPOSE: ROTATES AND SHIFTS A SLICE OF AN IMAGE, ROW BY ROW C C PARAMETERS: XIMG INPUT IMAGE (INPUT) C BUFOUT OUTPUT IMAGE OR LINE BUFFER (OUTPUT) C NSAM,NROW IMAGE SIZE (INPUT) C THETA,SCLI ROTATION AND SCALE (INPUT) C SHXI,SHYI SHIFTS (INPUT) C USEBACK USE BACKGROUND (INPUT) C BACK BACKGROUND (INPUT) C IREC1 IMAGE STARTING RECORD (INPUT) C LUN LUN FOR OUTPUT (0 IS NO FILE OUT) (INPUT) C C--********************************************************************* SUBROUTINE ROT2QS_BACK(XIMG,BUFOUT, NSAM,NROW, & THETA,SCLI,SHXI,SHYI, & USEBACK,BACK, IRECOFF,LUN) IMPLICIT NONE REAL :: XIMG(NSAM,NROW) REAL :: BUFOUT(NSAM,*) ! Y MAY BE: 1 INTEGER :: NSAM,NROW REAL :: THETA,SCLI,SHXI,SHYI LOGICAL :: USEBACK REAL :: BACK INTEGER :: IRECOFF,LUN REAL, PARAMETER :: QUADPI = 3.14159265358979323846 REAL, PARAMETER :: DGR_TO_RAD = (QUADPI/180) REAL :: SHX,SHY,RN2,SN2,RW2,RS2,COD,SID,XI REAL :: CODDSCLI,SIDDSCLI,FKCENTMSHX,FICENTMSHY REAL :: RE1,RE2,RF1,RF2,YI,YCOD,YSID,X1,YOLD,XOLD INTEGER :: ICENT,KCENT,IT,I,K REAL :: quadri SHX = AMOD(SHXI,FLOAT(NSAM)) SHY = AMOD(SHYI,FLOAT(NROW)) ICENT = NROW/2+1 KCENT = NSAM/2+1 RN2 = -NROW/2 SN2 = -NSAM/2 RW2 = -RN2 RS2 = -SN2 IF (MOD(NSAM,2) .EQ. 0) RW2 = RW2 - 1.0 IF (MOD(NROW,2) .EQ. 0) RS2 = RS2 - 1.0 COD = COS(THETA * DGR_TO_RAD) SID = SIN(THETA * DGR_TO_RAD) CODDSCLI = COD / SCLI SIDDSCLI = SID / SCLI FKCENTMSHX = -KCENT - SHX FICENTMSHY = -ICENT - SHY RE1 = RW2 - RN2 + 1.0 RE2 = RN2 - RW2 - 1.0 RF1 = RS2 - SN2 + 1.0 RF2 = SN2 - RS2 - 1.0 IT = 1 ! IF WRITING TO OUTPUT DO I=1,NROW IF (LUN .LE. 0) IT = I YI = I + FICENTMSHY IF (YI < RN2) YI = MIN(YI+RE1, RW2) IF (YI > RW2) YI = MAX(YI+RE2, RN2) YCOD = YI * CODDSCLI + ICENT YSID = -YI * SIDDSCLI + KCENT if (USEBACK) THEN c$omp parallel do private(k,xi,xold,yold) DO K=1,NSAM XI = K + FKCENTMSHX IF (XI < SN2) XI = MIN(XI+RF1, RS2) IF (XI > RS2) XI = MAX(XI+RF2, SN2) YOLD = XI * SIDDSCLI + YCOD XOLD = XI * CODDSCLI + YSID IF (YOLD < 1 .OR. YOLD > NROW .OR. & XOLD < 1 .OR. XOLD > NSAM) THEN C CORNER LOCATION BUFOUT(K,IT) = BACK ELSE C could use quadri_fast?? al BUFOUT(K,IT) = QUADRI(XOLD,YOLD, NSAM,NROW, XIMG) ENDIF ENDDO ELSE c$omp parallel do private(k,xi,xold,yold) DO K=1,NSAM XI = K + FKCENTMSHX IF (XI < SN2) XI = MIN(XI+RF1, RS2) IF (XI > RS2) XI = MAX(XI+RF2, SN2) YOLD = XI * SIDDSCLI + YCOD XOLD = XI * CODDSCLI + YSID BUFOUT(K,IT) = QUADRI(XOLD,YOLD, NSAM,NROW, XIMG) ENDDO ENDIF IF (LUN .GT. 0) THEN C WRITE CURRENT LINE TO FILE CALL WRTLIN(LUN,BUFOUT,NSAM,IRECOFF+I) ENDIF ENDDO END C******************************** ROT2QS ***************************** SUBROUTINE ROT2QS(XIMG,BUFOUT, NSAM,NROW, & THETA,SCLI,SHXI,SHYI, IRECOFF,LUN) IMPLICIT NONE REAL :: XIMG(NSAM,NROW) REAL :: BUFOUT(NSAM,*) ! Y MAY BE: 1 INTEGER :: NSAM,NROW REAL :: THETA,SCLI,SHXI,SHYI INTEGER :: IRECOFF,LUN REAL, PARAMETER :: QUADPI = 3.14159265358979323846 REAL, PARAMETER :: DGR_TO_RAD = (QUADPI/180) REAL :: SHX,SHY,RN2,SN2,RW2,RS2,COD,SID,XI REAL :: CODDSCLI,SIDDSCLI,FKCENTMSHX,FICENTMSHY REAL :: RE1,RE2,RF1,RF2,YI,YCOD,YSID,X1,YOLD,XOLD INTEGER :: ICENT,KCENT,IT,I,K REAL :: QUADRI SHX = AMOD(SHXI,FLOAT(NSAM)) SHY = AMOD(SHYI,FLOAT(NROW)) ICENT = NROW/2+1 KCENT = NSAM/2+1 RN2 = -NROW/2 SN2 = -NSAM/2 RW2 = -RN2 RS2 = -SN2 IF (MOD(NSAM,2) .EQ. 0) RW2 = RW2 - 1.0 IF (MOD(NROW,2) .EQ. 0) RS2 = RS2 - 1.0 COD = COS(THETA * DGR_TO_RAD) SID = SIN(THETA * DGR_TO_RAD) CODDSCLI = COD / SCLI SIDDSCLI = SID / SCLI FKCENTMSHX = -KCENT - SHX FICENTMSHY = -ICENT - SHY RE1 = RW2 - RN2 + 1.0 RE2 = RN2 - RW2 - 1.0 RF1 = RS2 - SN2 + 1.0 RF2 = SN2 - RS2 - 1.0 IT = 1 ! IF WRITING TO OUTPUT DO I=1,NROW IF (LUN .LE. 0) IT = I YI = I + FICENTMSHY IF (YI.LT.RN2) YI = MIN(YI+RE1, RW2) IF (YI.GT.RW2) YI = MAX(YI+RE2, RN2) YCOD = YI * CODDSCLI + ICENT YSID = -YI * SIDDSCLI + KCENT c$omp parallel do private(k,xi,xold,yold) DO K=1,NSAM XI = K + FKCENTMSHX IF (XI .LT. SN2) XI = MIN(XI+RF1, RS2) IF (XI .GT. RS2) XI = MAX(XI+RF2, SN2) YOLD = XI * SIDDSCLI + YCOD XOLD = XI * CODDSCLI + YSID BUFOUT(K,IT) = QUADRI(XOLD, YOLD, NSAM, NROW, XIMG) ENDDO IF (LUN .GT. 0) THEN C WRITE CURRENT LINE TO FILE CALL WRTLIN(LUN,BUFOUT,NSAM,IRECOFF+I) ENDIF ENDDO END C******************************** ROT2QS ***************************** SUBROUTINE ROT2QS_PAD(XIMG,BUFOUT, NSAM,NROW, NSAMP,NROWP, & THETA,SCLI,SHXI,SHYI, IRECOFF,LUN) IMPLICIT NONE REAL :: XIMG(NSAM,NROW) REAL :: BUFOUT(NSAMP,NROWP) ! Y MAY BE: 1 INTEGER :: NSAM,NROW, NSAMP,NROWP REAL :: THETA,SCLI,SHXI,SHYI INTEGER :: IRECOFF,LUN REAL, PARAMETER :: QUADPI = 3.14159265358979323846 REAL, PARAMETER :: DGR_TO_RAD = (QUADPI/180) REAL :: SHX,SHY,RN2,SN2,RW2,RS2,COD,SID,XI REAL :: CODDSCLI,SIDDSCLI,FKCENTMSHX,FICENTMSHY REAL :: RE1,RE2,RF1,RF2,YI,YCOD,YSID,X1,YOLD,XOLD INTEGER :: ICENT,KCENT,IT,I,K REAL :: QUADRI SHX = AMOD(SHXI,FLOAT(NSAM)) SHY = AMOD(SHYI,FLOAT(NROW)) ICENT = NROW/2+1 KCENT = NSAM/2+1 RN2 = -NROW/2 SN2 = -NSAM/2 RW2 = -RN2 RS2 = -SN2 IF (MOD(NSAM,2) .EQ. 0) RW2 = RW2 - 1.0 IF (MOD(NROW,2) .EQ. 0) RS2 = RS2 - 1.0 COD = COS(THETA * DGR_TO_RAD) SID = SIN(THETA * DGR_TO_RAD) CODDSCLI = COD / SCLI SIDDSCLI = SID / SCLI FKCENTMSHX = -KCENT - SHX FICENTMSHY = -ICENT - SHY RE1 = RW2 - RN2 + 1.0 RE2 = RN2 - RW2 - 1.0 RF1 = RS2 - SN2 + 1.0 RF2 = SN2 - RS2 - 1.0 IT = 1 ! IF WRITING TO OUTPUT DO I=1,NROW IF (LUN .LE. 0) IT = I YI = I + FICENTMSHY IF (YI.LT.RN2) YI = MIN(YI+RE1, RW2) IF (YI.GT.RW2) YI = MAX(YI+RE2, RN2) YCOD = YI * CODDSCLI + ICENT YSID = -YI * SIDDSCLI + KCENT c$omp parallel do private(k,xi,xold,yold) DO K=1,NSAM XI = K + FKCENTMSHX IF (XI .LT. SN2) XI = MIN(XI+RF1, RS2) IF (XI .GT. RS2) XI = MAX(XI+RF2, SN2) YOLD = XI * SIDDSCLI + YCOD XOLD = XI * CODDSCLI + YSID BUFOUT(K,IT) = QUADRI(XOLD, YOLD, NSAM, NROW, XIMG) ENDDO IF (LUN .GT. 0) THEN C WRITE CURRENT LINE TO FILE CALL WRTLIN(LUN,BUFOUT,NSAM,IRECOFF+I) ENDIF ENDDO END