! $Id: ruralbox.f,v 1.1 2009/06/09 21:51:52 daven Exp $ SUBROUTINE RURALBOX( AD, T, AVGW, ALBD, SUNCOS, & LEMBED, IEBD1, IEBD2, JEBD1, JEBD2 ) ! !****************************************************************************** ! Subroutine RURALBOX computes which boxes are tropospheric and which ! are stratospheric. SMVGEAR arrays are initialized with quantities from ! tropospheric boxes. (amf, bey, ljm, lwh, gmg, bdf, bmy, 7/16/01, 4/10/06) ! ! Arguments as Input: ! ============================================================================ ! (1 ) AD (REAL*8 ) : Array for dry air mass [ kg ] ! (2 ) T (REAL*8 ) : Array for grid box temperatures [ K ] ! (3 ) AVGW (REAL*8 ) : Array for mixing ratio of water [ v/v ] ! (4 ) ALBD (REAL*8 ) : Array for visible albedo [unitless] ! (5 ) SUNCOS (REAL*8 ) : Array for COS( Solar Zenith Angle ) [unitless] ! (6 ) LEMBED (LOGICAL) : Switch for embedded chemistry region [ T or F ] ! (7 ) IEBD1 (INTEGER) : Lon: lower right corner } of the [unitless] ! (8 ) IEBD2 (INTEGER) : Lon: upper left corner } embedded [unitless] ! (9 ) JEBD1 (INTEGER) : Lat: lower right corner } chemistry [unitless] ! (10) JEBD2 (INTEGER) : Lat: upper left corner } region [unitless] ! ! NOTES: ! (1 ) Remove PTOP from the arg list. PTOP is now a parameter ! in "CMN_SIZE". (bmy, 2/10/00) ! (2 ) Add C-preprocessor switch LSLOWJ to bracket code for ! SLOW-J photolysis (bmy, 2/25/00) ! (3 ) Now reference ABHSUM, AIRDENS, IXSAVE, IYSAVE, IZSAVE, JLOP, PRESS3, ! T3, and VOLUME from F90 module "comode_mod.f" (bmy, 10/19/00) ! (4 ) PTOP is already a parameter in "CMN_SIZE", don't declare it here ! (bmy, 7/16/01) ! (5 ) Replace IGCMPAR,JGCMPAR,LGCMPAR with IIPAR,JJPAR,LLPAR. Also moved ! CLOUDREF to SLOW-J block. Also remove IREF, JREF, IOFF, JOFF, these ! are now obsolete. Updated comments. (bmy, 9/25/01) ! (6 ) Eliminate I00 and J00 as arguments, these are obsolete (bmy, 9/28/01) ! (7 ) Removed obsolete, commented out code from 9/01 (bmy, 10/24/01) ! (8 ) Updated comment header. Also updated comments, and made cosmetic ! changes. (bmy, 4/15/02) ! (9 ) Bug fix: declare variables for SLOW-J photolysis. Also eliminated ! obsolete code from 4/15/02. (bmy, 8/5/02) ! (10) Now reference GET_PCENTER and GET_PEDGE from "pressure_mod.f", ! which return the correct "floating" pressure. Also deleted obsolete, ! commented-out code. Also eliminate P, SIG, and NSKIPL from the arg ! list, since we don't need them anymore. (dsa, bdf, bmy, 8/20/02) ! (11) Added modifications for SMVGEAR II (gcc, bdf, bmy, 4/1/03) ! (12) SLOW-J is now obsolete; remove LSLOWJ #ifdef blocks (bmy, 6/23/05) ! (13) Now reference ITS_IN_THE_TROP and ITS_IN_THE_STRAT from ! "tropopause_mod.f" to diagnose trop & strat boxes. Also remove ! LPAUSE from the arg list (bmy, 8/22/05) ! (14) Remove ALT and CLOUDS from arg list -- they are obsolete (bmy, 4/10/06) !****************************************************************************** ! ! References to F90 modules USE COMODE_MOD, ONLY : ABSHUM, AIRDENS, IXSAVE, IYSAVE, & IZSAVE, JLOP, PRESS3, T3, VOLUME USE PRESSURE_MOD, ONLY : GET_PCENTER, GET_PEDGE USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_STRAT, ITS_IN_THE_TROP, & GET_TPAUSE_LEVEL IMPLICIT NONE # include "CMN_SIZE" ! Size parameters # include "comode.h" ! NPVERT LOGICAL, INTENT(IN) :: LEMBED INTEGER, INTENT(IN) :: IEBD1, IEBD2, JEBD1, JEBD2 REAL*8, INTENT(IN) :: AD(IIPAR,JJPAR,LLPAR) REAL*8, INTENT(IN) :: T(IIPAR,JJPAR,LLPAR) REAL*8, INTENT(IN) :: AVGW(IIPAR,JJPAR,LLPAR) REAL*8, INTENT(IN) :: ALBD(IIPAR,JJPAR) REAL*8, INTENT(IN) :: SUNCOS(MAXIJ) ! Local variables LOGICAL :: LDEBUG INTEGER :: I, J, L, JLOOP, IJLOOP, LL ! External functions REAL*8, EXTERNAL :: BOXVL !! testing variables for variable tropopause !real*8 :: temp(iipar,jjpar,llpar) !logical :: templ !temp = 0 !================================================================= ! RURALBOX begins here! !================================================================= LDEBUG = .FALSE. ! Rural Boxes JLOOP = 0 NTLOOPNCS = 0 ! Loop over vertical levels (max = LLTROP) DO L = 1, NVERT ! Loop over surface grid boxes DO J = 1, NLAT DO I = 1, NLONG ! JLOP is the 1-D grid box loop index JLOP(I,J,L) = 0 ! Filter to do chemistry in a window when ! rest of model is running global run. ! LEMBED - Logical for embedded window defined by ! IEBD1, IEBD2, JEBD1, JEBD2 IF ( LEMBED ) THEN IF ( I < IEBD1 .OR. I > IEBD2 .OR. & J < JEBD1 .OR. J > JEBD2 ) GOTO 40 ENDIF IF ( IGLOBCHEM <= 0 ) THEN ! === testing === BDF ! if (i .eq. 30) then ! temp(i,j,1) = dble(get_tpause_level(i,j)) ! write(6,*) i,j, 'val of last trop box: ', temp(i,j,1) ! templ = its_in_the_trop(i,j,l) ! write(6,*) ' ', l, 'trop: ', templ ! templ = its_in_the_strat(i,j,l) ! write(6,*) ' ', l, 'strat: ', templ ! endif ! === end testing === BDF !======================================================= ! Skip over strat boxes !======================================================= IF ( ITS_IN_THE_STRAT( I, J, L ) ) GOTO 40 ! Increment JLOOP for trop boxes JLOOP = JLOOP + 1 JLOP(I,J,L) = JLOOP ! test jlop for variable chem !temp(i,j,l) = dble(jloop) ELSE !======================================================= ! If we're doing a trop/strat run, IGLOBCHEM > 0. ! In that case we have to tell SMVGEAR which boxes are ! tropospheric and which are stratospheric. We do this ! using NTLOOPNCS and NCSLOOP. (gcc, bdf, bmy, 4/1/03) ! ! NTLOOPNCS counts the # of urban, trop, strat boxes ! NCSLOOP holds the 1-D grid box indices for ! ! NOTE: L < LPAUSE(I,J) are tropospheric boxes ! L >= LPAUSE(I,J) are stratospheric boxes !======================================================== ! Increment JLOOP for all boxes JLOOP = JLOOP + 1 JLOP(I,J,L) = JLOOP IF ( ITS_IN_THE_TROP( I, J, L ) ) THEN ! Tropospheric boxes go into the SMVGEAR II "URBAN" slot NTLOOPNCS(NCSURBAN) = NTLOOPNCS(NCSURBAN) + 1 NCSLOOP(NTLOOPNCS(NCSURBAN),NCSURBAN) = JLOOP !----------------------------------------------------------- ! Comment this out for now -- restore it later (bmy, 4/21/03) !ELSE IF ( .FALSE. ) THEN ! ! ! The SMVGEAR II "FREE TROPOSPHERE" slot is unused ! NTLOOPNCS(NCSTROP) = NTLOOPNCS(NCSTROP) + 1 ! NCSLOOP(NTLOOPNCS(NCSTROP),NCSTROP) = JLOOP !----------------------------------------------------------- ELSE ! Stratospheric boxes go into the SMVGEAR II "STRAT" slot ! (for now GEOS-CHEM skips these; later we will define ! a stratospheric chemistry mechanism a la G. Curci). NTLOOPNCS(NCSSTRAT) = NTLOOPNCS(NCSSTRAT) + 1 NCSLOOP(NTLOOPNCS(NCSSTRAT),NCSSTRAT) = JLOOP ENDIF ENDIF ! These translate JLOOP back to an (I,J,L) triplet IXSAVE(JLOOP) = I IYSAVE(JLOOP) = J IZSAVE(JLOOP) = L ! === testing === BDF ! if (i .eq. 18 .and. j .eq. 23 .and. l .eq. 19) then ! write(6,*) 'using offending box' ! endif ! === end testing === BDF ! get box volume [cm3] VOLUME(JLOOP) = BOXVL(I, J, L) ! get air density in (molecs cm^-3) AIRDENS(JLOOP) = AD(I,J,L)*1000.d0/VOLUME(JLOOP)*AVG/WTAIR ! get temperature T3(JLOOP) = T(I,J,L) ! PRESS3 = pressure in bar, multiply mb * 1000 PRESS3(JLOOP) = GET_PCENTER(I,J,L) * 1000d0 ! Get relative humidity (here is absolute #H2O/cc air) ! AVGW is the mixing ratio of water vapor [v/v] ABSHUM(JLOOP) = AVGW(I,J,L) * AIRDENS(JLOOP) ! Go to next I 40 CONTINUE ENDDO ENDDO ! NIJLOOP is the number of surface boxes IF ( L == 1 ) NIJLOOP = JLOOP ENDDO ! === testing === BDF ! write(6,*) ' in ruralbox, number of tropospheric boxes: ', jloop ! call flush(6) ! call write_fields3(temp,'jloptest') ! === testing === BDF ! NTLOOP is the number of total tropospheric boxes NTLOOP = JLOOP ! Return to calling program END SUBROUTINE RURALBOX