C ============================================================================= C SUBROUTINE TO DETERMINE PIERCE POINT (OR ENDPOINT) FOR EXIT C FROM CURRENT CELL, NEEDED IN SEVERAL PROCEDURES. C [31Jan02 JBishop] C ----------------------------------------------------------------------------- C IKNT,BRAD . number of and boundaries for radial grid C JKNT,BCHI . number of and boundaries for solar angle grid C THETA . . . LOS zenith angle at LOS initial point (R1,X1) C C I_A . . . . radial grid boundary of cell entrance (or current location) C J_A . . . . solar angle grid boundary of cell entrance (or current location) C T_A . . . . entrance (or current) LOS zenith angle C C I_B . . . . radial grid boundary of cell exit (pierce point) C J_B . . . . solar angle grid boundary of cell exit (pierce point) C R_B . . . . radial distance of cell exit (pierce point) C X_B . . . . solar angle for cell exit (pierce point) C T_B . . . . exit (or pierce point) LOS zenith angle C C OMEGA . . . angular displacement from LOS initial point (R1,X1) C ----------------------------------------------------------------------------- SUBROUTINE FAR_SIDE(IKNT, JKNT, BRAD, BCHI, PARAM_IN, INSIDE, & I_A, J_A, T_A, R_A, X_A, PASS, IPHASE, & I_B, J_B, T_B, R_B, X_B, OMEGA) IMPLICIT REAL*8 (A-H,O-Z) LOGICAL PASS, INSIDE DIMENSION BRAD(IKNT+1), BCHI(JKNT+1) DIMENSION PARAM_IN(13) C COMMON / LOSREF_PARM / C & CX1, SX1, CU1, SU1, CP1, SP1, C & RSMU, DSMU, XSKIM, XTOT, OSKIM, OTOT, IPHASE, PASS COMMON /NMBR/ PI,RTPI,PID2,OFFSET C ----------------------------------------------------------------------------- C LOS PARAMETERS FROM PARAM_IN C ----------------------------------------------------------------------------- THETA = PARAM_IN( 1) CX1 = PARAM_IN( 2) SX1 = PARAM_IN( 3) CU1 = PARAM_IN( 4) SU1 = PARAM_IN( 5) CP1 = PARAM_IN( 6) SP1 = PARAM_IN( 7) RSMU = PARAM_IN( 8) DSMU = PARAM_IN( 9) XSKIM = PARAM_IN(10) XTOT = PARAM_IN(11) OSKIM = PARAM_IN(12) OTOT = PARAM_IN(13) C ----------------------------------------------------------------------------- C FIND INITIAL POINT INTO MEDIUM IF NOT ALREADY THERE C ----------------------------------------------------------------------------- C DEFAULT CONDITION: INSIDE MEDIUM INSIDE = .TRUE. C GROUND OBSERVATION IF ((R_A .LT. BRAD(1)) .OR. (I_A .LT. 1)) THEN INSIDE = .FALSE. R2R = BRAD(1) THETR = ASIN(RSMU/R2R) I_B = 1 OMEGR = THETA - THETR OMEGA = OMEGR T_B = THETR R_B = R2R X_B = ACOS( CX1*COS(OMEGA) + SX1*SIN(OMEGA)*CP1 ) DO JLOOP = 1,JKNT IF ((X_B.GE.BCHI(JLOOP)).AND.(X_B.LT.BCHI(JLOOP+1))) THEN J_B = JLOOP GO TO 9009 END IF END DO END IF C WAY-OUT OBSERVATION IF ((R_A .GT. BRAD(IKNT+1)) .OR. (I_A .GT. IKNT+1)) THEN INSIDE = .FALSE. R2R = BRAD(IKNT+1) THETR = PI - ASIN(RSMU/R2R) I_B = IKNT+1 OMEGR = THETA - THETR OMEGA = OMEGR T_B = THETR R_B = R2R X_B = ACOS( CX1*COS(OMEGA) + SX1*SIN(OMEGA)*CP1 ) DO JLOOP = 1,JKNT IF ((X_B.GE.BCHI(JLOOP)).AND.(X_B.LT.BCHI(JLOOP+1))) THEN J_B = JLOOP GO TO 9009 END IF END DO END IF C ----------------------------------------------------------------------------- C LINE-OF-SIGHT EXIT POINT OUT OF CURRENT BIN/CELL C ----------------------------------------------------------------------------- C write(06,*)'inside far_side: ', I_A, J_A, T_A, R_A, X_A, C & PASS, IPHASE C write(06,*)'inside far_side: ', IKNT, BRAD C RADIAL BIN DETERMINATION IF ( (COS(T_A) .GT. 0.0D0) .OR. (RSMU .GT. BRAD(I_A)) ) THEN R2R = BRAD(I_A + 1) THETR = ASIN(RSMU/R2R) I_B = I_A + 1 ELSE R2R = BRAD(I_A) THETR = PI - ASIN(RSMU/R2R) I_B = I_A - 1 END IF OMEGR = THETA - THETR C SOLAR ANGLE BIN DETERMINATION C _____ HERE PASS=.T., SO XSKIM PASSAGE IS STILL AHEAD IF ( PASS ) THEN IF ( IPHASE .EQ. 1 ) THEN IF ( XSKIM .GT. BCHI(J_A + 1) ) THEN X2X = BCHI(J_A + 1) IPHASX = IPHASE J_B = J_A + 1 ELSE IF ( XTOT .LT. BCHI(J_A) ) THEN X2X = BCHI(J_A) IPHASX = -IPHASE J_B = J_A - 1 ELSE X2X = XTOT IPHASX = -IPHASE J_B = J_A END IF ELSE IF ( IPHASE .EQ. -1 ) THEN IF ( XSKIM .LT. BCHI(J_A) ) THEN X2X = BCHI(J_A) IPHASX = IPHASE J_B = J_A - 1 ELSE IF ( XTOT .GT. BCHI(J_A + 1) ) THEN X2X = BCHI(J_A + 1) IPHASX = -IPHASE J_B = J_A + 1 ELSE X2X = XTOT IPHASX = -IPHASE J_B = J_A END IF END IF C _____ HERE PASS=.F., SO CHI IS MONOTONICALLY APPROACHING XTOT ELSE IPHASX = IPHASE IF ( XTOT .GT. BCHI(J_A + 1) ) THEN X2X = BCHI(J_A + 1) J_B = J_A + 1 ELSE IF ( XTOT .LT. BCHI(J_A) ) THEN X2X = BCHI(J_A) J_B = J_A - 1 ELSE X2X = XTOT J_B = J_A END IF END IF SX2 = SIN(X2X) CX2 = COS(X2X) SP2 = SP1*SX1/SX2 CP2 = IPHASX * SQRT(1.0D0 - SP2**2) ANUM = CX1*CX2 - SX1*SX2*CP1*CP2 DNOM = 1.0D0 - SX1*SX2*SP1*SP2 OMEGX = ACOS(ANUM/DNOM) C DETERMINING "NEAREST" CROSSING IF (OMEGX.LT.OMEGR) THEN OMEGA = OMEGX T_B = THETA - OMEGA R_B = RSMU/SIN(T_B) X_B = X2X I_B = I_A ELSE OMEGA = OMEGR T_B = THETR R_B = R2R X_B = ACOS( CX1*COS(OMEGA) + SX1*SIN(OMEGA)*CP1 ) J_B = J_A END IF C UPDATE RELATION TO "SKIMMING" LATITUDE 9009 CONTINUE IF ( (OMEGA .GE. OSKIM) .AND. (PASS) ) THEN IPHASE = -IPHASE PASS = .FALSE. END IF C ----------------------------------------------------------------------------- RETURN END C =============================================================================