DOUBLE PRECISION FUNCTION RJSRB(I,K) INCLUDE 'PARAMETERS.INC' COMMON & /ONED35/ FLUX(NWAVE) & /ONED44/ SIGSRB(16,IB) & /ONED45/ SRBFLUX(16) & /BLOCK8/ IPHOTO(IB) , LAST(IB) , & LOW(IB) , SIGMA(NWAVE,IB) & /BLOCK19/ TRANS(NWAVE,NALT) & /BLOCK23/ TRANSRB(6,16,NALT) DIMENSION W(6) DATA W/0.05 , 0.20 , 0.25 , 0.25 , 0.20 , 0.05 / C THIS FUNCTION COMPUTES THE SRB CONTRIBUTION TO THE PHOTOLYSIS RATES C BASED UPON THE MINSCHWANER PARAMETERIZATION. C THE FIRST SRB INTERVAL BEGINS MIDWAY THROUGH THE LYMAN+11 INTERVAL. C WE BEGIN BY CUMPUTING THE PORTION IN THIS INTERVAL AND BELOW SRB RJSRB = ((1754.0D0-1725.0D0)/(1775.0D0-1725.0D0))* & FLUX(LYMAN+11)* & TRANS(LYMAN+11,K)*SIGMA(LYMAN+11,IPHOTO(I)) C ADD ON SRB PORTION DO LSRB = 1 , 16 SUM = 0.0D0 DO L = 1 , 6 SUM = SUM + W(L)*TRANSRB(L,LSRB,K) ENDDO RJSRB = RJSRB + SUM*SIGSRB(LSRB,I)*SRBFLUX(LSRB) ENDDO RETURN END C------------------------------------------------------------------------ C------------------------------------------------------------------------ C------------------------------------------------------------------------ SUBROUTINE SRB INCLUDE 'PARAMETERS.INC' INCLUDE 'PLANET.INC' COMMON & /ONED15/ THOUR & /BLOCK14/ MTAU(MB) & /ONED32/ SUNRISE(NALT) , SUNSET(NALT) & /BLOCK22/ O2SRB(6,16) & /BLOCK23/ TRANSRB(6,16,NALT) & /ONED47/ COLUMN(NALT,MB) & /ONED48/ RAYSRB(16) & /BLOCK40/ O3SRB(16) & /ONED50/ COSSZA C THIS SUBROUTINE COMPUTES THE TRANSMITANCE DUE TO O2 IN THE SCHUMANN-RUNGE C BANDS. C *** NOTE: MTAU(1) = O2 , MTAU(3) = M , AND MTAU(2) = O3 *** C########################################################################## C COMPUTE OPTICAL DEPTHS C COMPUTE OPTICAL DEPTH USING SIMPLIFIED CALCULATIONS FOR SZA < 90 DEGREES IF( COSSZA .GE. 0.0d0 ) THEN ! SZA < 90 DEGREES DO K = 1 , NALT COL1 = COLUMN(K,MTAU(1)) COL2 = COLUMN(K,MTAU(2)) COL3 = COLUMN(K,MTAU(3)) DO LSRB = 1 , 16 DO L = 1 , 6 TAU = (COL2*O3SRB(LSRB) + COL3*RAYSRB(LSRB)) + & COL1*O2SRB(L,LSRB) TRANSRB(L,LSRB,K) = DEXP(-TAU) ENDDO ENDDO ENDDO ENDIF C CALCULATE OPTICAL DEPTHS FOR SOLAR ZENITH ANGLES > PI/2. IF( (COSSZA .LT. 0.0d0) .AND. (ISPHERE .EQ. 1) ) THEN DO K = 1 , NALT IF( (THOUR .GE. SUNRISE(K)) .AND. & (THOUR .LT. SUNSET(K)) )THEN COL1 = COLUMN(K,MTAU(1)) COL2 = COLUMN(K,MTAU(2)) COL3 = COLUMN(K,MTAU(3)) DO LSRB = 1 , 16 DO L = 1 , 6 TAU = (COL2*O3SRB(LSRB) + COL3*RAYSRB(LSRB)) + & COL1*O2SRB(L,LSRB) TRANSRB(L,LSRB,K) = DEXP(-TAU) ENDDO ENDDO ELSE DO LSRB = 1 , 16 DO L = 1 , 6 TRANSRB(L,LSRB,K) = 0.0D0 ! IN DARKNESS ENDDO ENDDO ENDIF ENDDO ! END LOOP OVER K ENDIF ! END SZA > 90 (SPHERICAL CASE) IF( (COSSZA .LT. 0.0d0) .AND. (ISPHERE .EQ. 0) ) THEN DO K = 1 , NALT DO LSRB = 1 , 16 DO L = 1 , 6 TRANSRB(L,LSRB,K) = 0.0D0 ENDDO ENDDO ENDDO ENDIF ! (NON-SPHERICAL CASE) RETURN END C------------------------------------------------------------------------ C------------------------------------------------------------------------ C------------------------------------------------------------------------ SUBROUTINE SRBAVG INCLUDE 'PARAMETERS.INC' INCLUDE 'PLANET.INC' COMMON /BLOCK22/ O2SRB(6,16) COMMON & /BLOCK14/ MTAU(MB) & /BLOCK17/ NANGLE(NALT) CC & /BLOCK22/ O2SRB(6,16) COMMON & /BLOCK23/ TRANSRB(6,16,NALT) & /BLOCK30/ NPI2 COMMON & /BLOCK40/ O3SRB(16) & /ONED46/ COLUMN(NTRAP,NALT,MB) COMMON & /ONED48/ RAYSRB(16) DIMENSION TAUSRB(NTRAP,6,16,NALT) C THIS SUBROUTINE COMPUTES THE TRANSMITANCE DUE TO O2 IN THE SCHUMANN-RUNGE C BANDS. C *** NOTE: MTAU(1) = O2 , MTAU(3) = M , AND MTAU(2) = O3 *** C########################################################################## C COMPUTE OPTICAL DEPTHS DO K = 1 , NALT DO NANG = 1 , NPI2 COL1 = COLUMN(NANG,K,MTAU(1)) COL2 = COLUMN(NANG,K,MTAU(2)) COL3 = COLUMN(NANG,K,MTAU(3)) DO LSRB = 1 , 16 DO L = 1 , 6 TAUSRB(NANG,L,LSRB,K) = ( COL2*O3SRB(LSRB) + & COL3*RAYSRB(LSRB) ) + & COL1*O2SRB(L,LSRB) ENDDO ENDDO ENDDO ENDDO IF( ISPHERE .EQ. 1 ) THEN DO K = 1 , NALT N1 = NPI2 + 1 N2 = NANGLE(K) DO NANG = N1 , N2 COL1 = COLUMN(NANG,K,MTAU(1)) COL2 = COLUMN(NANG,K,MTAU(2)) COL3 = COLUMN(NANG,K,MTAU(3)) DO LSRB = 1 , 16 DO L = 1 , 6 TAUSRB(NANG,L,LSRB,K) = ( COL2*O3SRB(LSRB) + & COL3*RAYSRB(LSRB) ) + & COL1*O2SRB(L,LSRB) ENDDO ENDDO ENDDO ENDDO ENDIF ! END RAY-TRACE CALCULATIONS C############################################################################### C USE TRAPEZOIDAL RULE TO COMPUTE DIURNAL AVERAGE DO K = 1 , NALT IF( ISPHERE .EQ. 1 ) THEN NEND = NANGLE(K) - 1 ELSE NEND = NPI2 - 1 ENDIF DO LSRB = 1 , 16 DO L = 1 , 6 AVGSRB = 0.0D0 DO NANG = 1 , NEND AVGSRB = AVGSRB + & DEXP(-TAUSRB(NANG,L,LSRB,K)) + & DEXP(-TAUSRB(NANG+1,L,LSRB,K)) ENDDO IF( NEND .EQ. 0 ) THEN ! SPECIAL CASE AVGSRB = DEXP(-TAUSRB(1,L,LSRB,K)) ENDIF TRANSRB(L,LSRB,K) = (0.5D0)*AVGSRB/(FLOAT(NTRAP-1)) ENDDO ENDDO ENDDO RETURN END C------------------------------------------------------------------------ C------------------------------------------------------------------------ C------------------------------------------------------------------------ DOUBLE PRECISION FUNCTION SIGINT(SIGMA,LSRB) INCLUDE 'PARAMETERS.INC' DIMENSION SIGMA(NWAVE) C THIS FUNCTION INTERPOLATES CROSS-SECTIONS ONTO THE MINSCHWANER SRB GRID IF( LSRB .EQ. 1 ) SIGINT = SIGMA(LYMAN+11) IF( LSRB .GE. 2 .AND. & LSRB .LE. 5 ) SIGINT = SIGMA(LYMAN+12) IF( LSRB .EQ. 6) THEN SIGINT = ((1825.0d0-1816.0d0)/(1831.0d0-1816.0d0))* & SIGMA(LYMAN+12) + & ((1831.0d0-1825.0d0)/(1831.0d0-1816.0d0))* & SIGMA(LYMAN+13) ENDIF IF( LSRB .EQ. 7 .OR. & LSRB .EQ. 8 ) SIGINT = SIGMA(LYMAN+13) IF( LSRB .EQ. 9 ) THEN SIGINT = ((1875.0d0-1863.0d0)/(1882.0d0-1863.0d0))* & SIGMA(LYMAN+13) + & ((1882.0d0-1875.0d0)/(1882.0d0-1863.0d0))* & SIGMA(LYMAN+14) ENDIF IF( LSRB .EQ. 10 .OR. & LSRB .EQ. 11 ) SIGINT = SIGMA(LYMAN+14) IF( LSRB .EQ. 12 .OR. & LSRB .EQ. 13 ) SIGINT = SIGMA(LYMAN+15) IF( LSRB .EQ. 14 ) THEN SIGINT = ((1975.0d0-1972.0d0)/(1985.0d0-1972.0d0))* & SIGMA(LYMAN+15) + & ((1985.0d0-1975.0d0)/(1985.0d0-1972.0d0))* & SIGMA(LYMAN+16) ENDIF IF( LSRB .EQ. 15 .OR. & LSRB .EQ. 16 ) SIGINT = SIGMA(LYMAN+16) RETURN END