! ! This module contains routines to initialize tracers, handle boundary conditions ! and other stuff related to tracers. As of WRFV3.2 it will users should compile ! WRF-Chem for tracer runs, if they want full dispersion. Only when ! WRF-Chem is compiled will turbulent and non-resolved convective transport be treated. ! When compiled with WRF_CHEM, tracer transport should work properly with nesting or ! supplied boundary conditions. Without compiling WRF-Chem, option ! TRACER_TEST1 will partially work (no boundary conditions, ! no turbulent transport, no subgrid-scale convection) ! ! Original version of the module is written by Georg Grell (Dec 2009). ! Options for TRACER_TEST1 and TRACER_TEST2 supplied by Jeff Lee (NCAR) ! Current tracer options: ! ! (1) TRACER_SMOKE: This needs the biomass burning module to also be active. ! It will then use smoke (CO emissions from fire) as tracer. One ! variabe only. ! ! (2) TRACER_TEST1 and TRACER_TEST2: 8 tracers, the only difference inbetween ! these options are p_tr17_3 and p_tr17_4, which are also filled with ! CO emissions from fire for TRACER_TEST2. The other tracers are defined as: ! ! tr17_1 : horizontal boundaries tracer ! tr17_2 : horizontal boundaries tracer decaying with e-folding time of 1 day ! tr17_3 : surface tracer (smoke for TRACER_TEST2) ! tr17_4 : surface tracer (smoke for TRACER_TEST2) ! decaying with e-folding time of 1 day ! tr17_5 : stratosphere tracer ! tr17_6 : stratosphere tracer decaying with e-folding time of 1 day ! tr17_7 : boundary layer tracer ! tr17_8 : boundary layer tracer decaying with e-folding time of 1 day MODULE module_input_tracer USE module_input_tracer_data #ifdef WRF_CHEM !++mmb !USE module_state_description, only:tracer_smoke,tracer_test1,tracer_test2,param_first_scalar,p_tr17_1,p_tr17_2,p_tr17_3,p_tr17_4,p_tr17_5,p_tr17_6,p_tr17_7,p_tr17_8 USE module_state_description,only:tracer_smoke,tracer_test1,tracer_test2,tracer_test3,param_first_scalar,p_tr17_1,p_tr17_2,p_tr17_3,p_tr17_4,p_tr17_5,p_tr17_6,p_tr17_7,p_tr17_8,p_tr17_9,p_tr17_10,p_tr17_11,p_tr17_12,p_tr17_13,p_tr17_14,p_tr17_15,p_tr17_16,p_tr17_17,p_tr17_18,p_tr17_19,p_tr17_20,p_tr17_21,p_tr17_22,p_tr17_23,p_tr17_24,p_tr17_25,p_tr17_26,p_tr17_27,p_tr17_28,p_tr17_29,p_tr17_30,p_tr17_31,p_tr17_32,p_tr17_33,p_tr17_34,p_tr17_35,p_tr17_36,p_tr17_37,p_tr17_38,p_tr17_39,p_tr17_40,p_tr17_41,p_tr17_42,p_tr17_43,p_tr17_44,p_tr17_45,p_tr17_46,p_tr17_47,p_tr17_48,p_tr17_49,p_tr17_50,p_tr17_51,p_tr17_52,p_tr17_53,p_tr17_54,p_tr17_55,p_tr17_56,p_tr17_57,p_tr17_58,p_tr17_59,p_tr17_60,p_tr17_61,p_tr17_62,p_tr17_63,p_tr17_64,p_tr17_65,p_tr17_66,p_tr17_67,p_tr17_68,p_tr17_69,p_tr17_70,p_tr17_71,p_tr17_72,p_tr17_73,p_tr17_74,p_tr17_75,p_tr17_76,p_tr17_77,p_tr17_78,p_tr17_79,p_tr17_80,p_tr17_81,p_tr17_82,p_tr17_83,p_tr17_84,p_tr17_85,p_tr17_86,p_tr17_87,p_tr17_88,p_tr17_89,p_tr17_90,p_tr17_91,p_tr17_92,p_tr17_93,p_tr17_94,p_tr17_95,p_tr17_96,p_tr17_97 !--mmb #else USE module_state_description, only:tracer_test1,tracer_test2,param_first_scalar,p_tr17_1,p_tr17_2,p_tr17_3,p_tr17_4,p_tr17_5,p_tr17_6,p_tr17_7,p_tr17_8 #endif CONTAINS SUBROUTINE initialize_tracer (chem,chem_in_opt, & !++mmb ! tracer_opt,num_chem,& tracer_opt,num_chem,dm,& !--mmb ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims ips,ipe, jps,jpe, kps,kpe, & ! patch dims its,ite, jts,jte, kts,kte ) INTEGER, INTENT(IN ) :: chem_in_opt,tracer_opt,num_chem !++mmb INTEGER, INTENT(IN ) :: dm ! domain # !--mmb INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme,num_chem ), INTENT(INOUT) :: chem LOGICAL :: rstrt #ifdef WRF_CHEM if(chem_in_opt == 1 )return #endif call nl_get_restart( dm,rstrt ) write(*,*)'dm: ',dm,' rstrt: ',rstrt if( .not. rstrt ) then write(*,*)'NOT RESTART' !++mmb ! if (tracer_opt == TRACER_TEST1)then if (tracer_opt == TRACER_TEST3)then chem(:,:,:,:)=.0 endif !#ifdef WRF_CHEM ! else if(tracer_opt == TRACER_TEST2)then ! chem(:,:,:,:)=.0 ! else if(tracer_opt == TRACER_SMOKE)then ! chem(:,:,:,:)=.08 !#endif ! endif !--mmb endif END SUBROUTINE initialize_tracer #if (EM_CORE == 1 ) SUBROUTINE flow_dep_bdy_tracer ( chem, & chem_bxs,chem_btxs, & chem_bxe,chem_btxe, & chem_bys,chem_btys, & chem_bye,chem_btye, & dt, & spec_bdy_width,z, & have_bcs_chem, & u, v, tracer_opt, alt, & t,pb,p,t0,p1000mb,rcp,ph,phb,g, & spec_zone, ic, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims ips,ipe, jps,jpe, kps,kpe, & ! patch dims its,ite, jts,jte, kts,kte ) ! This subroutine sets zero gradient conditions for outflow and a set profile value ! for inflow in the boundary specified region. Note that field must be unstaggered. ! The velocities, u and v, will only be used to check their sign (coupled vels OK) ! spec_zone is the width of the outer specified b.c.s that are set here. ! (JD August 2000) IMPLICIT NONE INTEGER, INTENT(IN ) :: tracer_opt INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte INTEGER, INTENT(IN ) :: spec_zone,spec_bdy_width,ic REAL, INTENT(IN ) :: dt REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: chem REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width), INTENT(IN ) :: chem_bxs, chem_bxe, chem_btxs, chem_btxe REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width), INTENT(IN ) :: chem_bys, chem_bye, chem_btys, chem_btye REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: z REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: alt REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: u REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: v REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , & INTENT(IN ) :: & ph,phb,t,pb,p real, INTENT (IN) :: g,rcp,t0,p1000mb INTEGER :: i, j, k, numgas INTEGER :: ibs, ibe, jbs, jbe, itf, jtf, ktf INTEGER :: i_inner, j_inner INTEGER :: b_dist integer :: i_bdy_method real tempfac,convfac logical, optional :: have_bcs_chem !++mmb REAL :: nbut(89) nbut=1e-3*(/1.54800, 1.54800, 1.54800, 1.54800, 1.54800, 1.54800, 1.54800, & 1.54800, 1.29000, 1.29000, 1.26120, 1.23205, 0.48600, 0.48600, 0.48600,& 0.47231,& 0.03300, 0.03300, 0.03300, 0.03212, 0.02700, 0.02700, 0.02622, 0.02543,& 0.01100,& 0.01100, 0.01085, 0.01070, 0.01100, 0.01100, 0.01081, 0.00150, 0.00150,& 0.00150,& 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150,& 0.00150,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800/) !--mmb ibs = ids ibe = ide-1 itf = min(ite,ide-1) jbs = jds jbe = jde-1 jtf = min(jte,jde-1) ktf = kde-1 ! i_bdy_method determines which "bdy_chem_value" routine to use ! 1=smoke, CO background i_bdy_method = 0 if (tracer_opt == TRACER_TEST1 ) then i_bdy_method = 2 end if #ifdef WRF_CHEM if (tracer_opt == TRACER_TEST2 ) then i_bdy_method = 2 end if if (tracer_opt == TRACER_SMOKE ) then i_bdy_method = 1 end if if (have_bcs_chem) i_bdy_method =6 #endif if (ic .lt. param_first_scalar) i_bdy_method = 0 !++mmb i_bdy_method = 6 ! WRITE(*,*)'inside flow_dep_bdy_tracer EM' ! WRITE(*,*)'i_bdy_method ',i_bdy_method IF (jts - jbs .lt. spec_zone) THEN ! Y-start boundary DO j = jts, min(jtf,jbs+spec_zone-1) b_dist = j - jbs DO k = kts, ktf DO i = max(its,b_dist+ibs), min(itf,ibe-b_dist) i_inner = max(i,ibs+spec_zone) i_inner = min(i_inner,ibe-spec_zone) IF(v(i,k,j) .lt. 0.)THEN chem(i,k,j) = chem(i_inner,k,jbs+spec_zone) ELSE if (i_bdy_method .eq. 0) then chem(i,k,j) = tracer_bv_def else if (i_bdy_method .eq. 1) then chem(i,k,j)=tr_smoke_value else if (i_bdy_method .eq. 2) then if (ic .eq. p_tr17_1 .or. ic .eq. p_tr17_2) then chem(i,k,j)= tracer_bv_one else chem(i,k,j)= tracer_bv_def endif #ifdef WRF_CHEM else if (i_bdy_method .eq. 6) then !++mmb ! CALL bdy_tracer_value ( chem(i,k,j),chem_bys(i,k,1),chem_btys(i,k,1),dt,ic) chem(i,k,j) = nbut(k) !--mmb #endif else chem(i,k,j) = tracer_bv_def endif ENDIF ENDDO ENDDO ENDDO ENDIF IF (jbe - jtf .lt. spec_zone) THEN ! Y-end boundary DO j = max(jts,jbe-spec_zone+1), jtf b_dist = jbe - j DO k = kts, ktf DO i = max(its,b_dist+ibs), min(itf,ibe-b_dist) i_inner = max(i,ibs+spec_zone) i_inner = min(i_inner,ibe-spec_zone) IF(v(i,k,j+1) .gt. 0.)THEN chem(i,k,j) = chem(i_inner,k,jbe-spec_zone) ELSE if (i_bdy_method .eq. 0) then chem(i,k,j) = tracer_bv_def else if (i_bdy_method .eq. 1) then chem(i,k,j)=tr_smoke_value else if (i_bdy_method .eq. 2) then if (ic .eq. p_tr17_1 .or. ic .eq. p_tr17_2) then chem(i,k,j)= tracer_bv_one else chem(i,k,j)= tracer_bv_def endif #ifdef WRF_CHEM else if (i_bdy_method .eq. 6) then !++mmb ! CALL bdy_tracer_value ( chem(i,k,j),chem_bye(i,k,1),chem_btye(i,k,1),dt,ic) chem(i,k,j) = nbut(k) !--mmb #endif else chem(i,k,j) = tracer_bv_def endif ENDIF ENDDO ENDDO ENDDO ENDIF IF (its - ibs .lt. spec_zone) THEN ! X-start boundary DO i = its, min(itf,ibs+spec_zone-1) b_dist = i - ibs DO k = kts, ktf DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1) j_inner = max(j,jbs+spec_zone) j_inner = min(j_inner,jbe-spec_zone) IF(u(i,k,j) .lt. 0.)THEN chem(i,k,j) = chem(ibs+spec_zone,k,j_inner) ELSE if (i_bdy_method .eq. 0) then chem(i,k,j) = tracer_bv_def else if (i_bdy_method .eq. 1) then chem(i,k,j)=tr_smoke_value else if (i_bdy_method .eq. 2) then if (ic .eq. p_tr17_1 .or. ic .eq. p_tr17_2) then chem(i,k,j)= tracer_bv_one else chem(i,k,j)= tracer_bv_def endif #ifdef WRF_CHEM else if (i_bdy_method .eq. 6) then !++mmb ! CALL bdy_tracer_value ( chem(i,k,j),chem_bxs(j,k,1),chem_btxs(j,k,1),dt,ic) chem(i,k,j) = nbut(k) !--mmb #endif else chem(i,k,j) = tracer_bv_def endif ENDIF ENDDO ENDDO ENDDO ENDIF IF (ibe - itf .lt. spec_zone) THEN ! X-end boundary DO i = max(its,ibe-spec_zone+1), itf b_dist = ibe - i DO k = kts, ktf DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1) j_inner = max(j,jbs+spec_zone) j_inner = min(j_inner,jbe-spec_zone) IF(u(i+1,k,j) .gt. 0.)THEN chem(i,k,j) = chem(ibe-spec_zone,k,j_inner) ELSE if (i_bdy_method .eq. 0) then chem(i,k,j) = tracer_bv_def else if (i_bdy_method .eq. 1) then chem(i,k,j)=tr_smoke_value else if (i_bdy_method .eq. 2) then if (ic .eq. p_tr17_1 .or. ic .eq. p_tr17_2) then chem(i,k,j)= tracer_bv_one else chem(i,k,j)= tracer_bv_def endif #ifdef WRF_CHEM else if (i_bdy_method .eq. 6) then !++mmb ! CALL bdy_tracer_value ( chem(i,k,j),chem_bxe(j,k,1),chem_btxe(j,k,1),dt,ic) chem(i,k,j) = nbut(k) !--mmb #endif else chem(i,k,j) = tracer_bv_def endif ENDIF ENDDO ENDDO ENDDO ENDIF END SUBROUTINE flow_dep_bdy_tracer #else #ifdef WRF_CHEM SUBROUTINE flow_dep_bdy_tracer ( chem, chem_b,chem_bt,dt, & spec_bdy_width,z, & ijds, ijde,have_bcs_chem, & u, v, tracer_opt, alt, & t,pb,p,t0,p1000mb,rcp,ph,phb,g, & spec_zone, ic, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims ips,ipe, jps,jpe, kps,kpe, & ! patch dims its,ite, jts,jte, kts,kte ) ! This subroutine sets zero gradient conditions for outflow and a set profile value ! for inflow in the boundary specified region. Note that field must be unstaggered. ! The velocities, u and v, will only be used to check their sign (coupled vels OK) ! spec_zone is the width of the outer specified b.c.s that are set here. ! (JD August 2000) IMPLICIT NONE INTEGER, INTENT(IN ) :: tracer_opt INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte INTEGER, INTENT(IN ) :: ijds,ijde INTEGER, INTENT(IN ) :: spec_zone,spec_bdy_width,ic REAL, INTENT(IN ) :: dt REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: chem REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN ) :: chem_b REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN ) :: chem_bt REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: z REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: alt REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: u REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: v REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , & INTENT(IN ) :: & ph,phb,t,pb,p real, INTENT (IN) :: g,rcp,t0,p1000mb INTEGER :: i, j, k, numgas INTEGER :: ibs, ibe, jbs, jbe, itf, jtf, ktf INTEGER :: i_inner, j_inner INTEGER :: b_dist integer :: i_bdy_method real tempfac,convfac real :: tracer_bv_def logical :: have_bcs_chem !++mmb REAL :: nbut(89) nbut=1e-3*(/1.54800, 1.54800, 1.54800, 1.54800, 1.54800, 1.54800, 1.54800, & 1.54800, 1.29000, 1.29000, 1.26120, 1.23205, 0.48600, 0.48600, 0.48600,& 0.47231,& 0.03300, 0.03300, 0.03300, 0.03212, 0.02700, 0.02700, 0.02622, 0.02543,& 0.01100,& 0.01100, 0.01085, 0.01070, 0.01100, 0.01100, 0.01081, 0.00150, 0.00150,& 0.00150,& 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150,& 0.00150,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800/) !--mmb tracer_bv_def = conmin ibs = ids ibe = ide-1 itf = min(ite,ide-1) jbs = jds jbe = jde-1 jtf = min(jte,jde-1) ktf = kde-1 i_bdy_method = 0 if (config_flags%tracer_opt == TRACER_SMOKE ) then i_bdy_method = 1 end if if (have_bcs_chem) i_bdy_method =6 if (ic .lt. param_first_scalar) i_bdy_method = 0 WRITE(*,*)'inside flow_dep_bdy_tracer' WRITE(*,*)'i_bdy_method ',i_bdy_method !---------------------------------------------------------------------- IF (jts - jbs .lt. spec_zone) THEN ! Y-start boundary DO j = jts, min(jtf,jbs+spec_zone-1) b_dist = j - jbs DO k = kts, ktf DO i = max(its,b_dist+ibs), min(itf,ibe-b_dist) i_inner = max(i,ibs+spec_zone) i_inner = min(i_inner,ibe-spec_zone) IF(v(i,k,j) .lt. 0.)THEN chem(i,k,j) = chem(i_inner,k,jbs+spec_zone) ELSE if (i_bdy_method .eq. 1) then chem(i,k,j)=tr_smoke_value else if (i_bdy_method .eq. 6) then !++mmb ! CALL bdy_tracer_value ( chem(i,k,j),chem_b(i,k,1,P_YSB),chem_bt(i,k,1,P_YSB),dt,ic) chem(i,k,j)=nbut(k) !--mmb else chem(i,k,j) = tracer_bv_def endif ENDIF ENDDO ENDDO ENDDO ENDIF IF (jbe - jtf .lt. spec_zone) THEN ! Y-end boundary DO j = max(jts,jbe-spec_zone+1), jtf b_dist = jbe - j DO k = kts, ktf DO i = max(its,b_dist+ibs), min(itf,ibe-b_dist) i_inner = max(i,ibs+spec_zone) i_inner = min(i_inner,ibe-spec_zone) IF(v(i,k,j+1) .gt. 0.)THEN chem(i,k,j) = chem(i_inner,k,jbe-spec_zone) ELSE if (i_bdy_method .eq. 1) then chem(i,k,j)=tr_smoke_value else if (i_bdy_method .eq. 6) then !++mmb ! CALL bdy_tracer_value ( chem(i,k,j),chem_b(i,k,1,P_YEB),chem_bt(i,k,1,P_YEB),dt,ic) chem(i,k,j)=nbut(k) !--mmb else chem(i,k,j) = tracer_bv_def endif ENDIF ENDDO ENDDO ENDDO ENDIF IF (its - ibs .lt. spec_zone) THEN ! X-start boundary DO i = its, min(itf,ibs+spec_zone-1) b_dist = i - ibs DO k = kts, ktf DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1) j_inner = max(j,jbs+spec_zone) j_inner = min(j_inner,jbe-spec_zone) IF(u(i,k,j) .lt. 0.)THEN chem(i,k,j) = chem(ibs+spec_zone,k,j_inner) ELSE if (i_bdy_method .eq. 1) then chem(i,k,j)=tr_smoke_value else if (i_bdy_method .eq. 6) then !++mmb ! CALL bdy_tracer_value ( chem(i,k,j),chem_b(j,k,1,P_XSB),chem_bt(j,k,1,P_XSB),dt,ic) chem(i,k,j)=nbut(k) !--mmb else chem(i,k,j) = tracer_bv_def endif ENDIF ENDDO ENDDO ENDDO ENDIF IF (ibe - itf .lt. spec_zone) THEN ! X-end boundary DO i = max(its,ibe-spec_zone+1), itf b_dist = ibe - i DO k = kts, ktf DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1) j_inner = max(j,jbs+spec_zone) j_inner = min(j_inner,jbe-spec_zone) IF(u(i+1,k,j) .gt. 0.)THEN chem(i,k,j) = chem(ibe-spec_zone,k,j_inner) ELSE if (i_bdy_method .eq. 1) then chem(i,k,j)=tr_smoke_value else if (i_bdy_method .eq. 6) then !++mmb ! CALL bdy_tracer_value ( chem(i,k,j),chem_b(j,k,1,P_XEB),chem_bt(j,k,1,P_XEB),dt,ic) chem(i,k,j)=nbut(k) !--mmb else chem(i,k,j) = tracer_bv_def endif ENDIF ENDDO ENDDO ENDDO ENDIF END SUBROUTINE flow_dep_bdy_tracer #endif #endif !++mmb SUBROUTINE set_tracer_DC3(dtstep,ktau,pbl_h,curr_secs, gmt, & tracer,tracer_opt,num_tracer,& z,ht,xlat, xlong, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte, & qc, qr, qi, qs, qg ) ! use module_configure ! use module_state_description ! use module_model_constants INTEGER, INTENT(IN ) :: ktau,tracer_opt,num_tracer INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme,num_tracer ), INTENT(INOUT) :: tracer REAL, DIMENSION(ims:ime,kms:kme,jms:jme ), INTENT(IN) :: z REAL, DIMENSION(ims:ime,jms:jme ), INTENT(IN) :: PBL_H,HT ! time step in seconds REAL, INTENT(IN) :: dtstep REAL, DIMENSION(ims:ime,jms:jme ), INTENT(IN) :: xlat, xlong REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN):: & qc, qr, qi, qs, qg REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: qtot !INTEGER, INTENT(IN) :: itimestep ! ...number of seconds into the simulation REAL(KIND=8), INTENT(IN) :: curr_secs !...GTM hour of start of simulation REAL, INTENT(IN) :: gmt !...minutes since start of run to the middle of the !...current times step (seconds included as decimals) REAL(KIND=8) :: xtime !...the GMT hour of the middle of the current time step !...(can be greater than 24) INTEGER :: ixhour REAL(KIND=8) :: xhour !...minutes past the previous hour mark, at the !...middle of the current time step REAL :: xmin !...the GMT hour of the middle of the current time step !...(between 0 and 24) REAL :: gmtp !...GMT hour plus minutes (in fractaionl hour) of the middle !...of the current time step REAL :: tmidh,dtstepHr REAL :: qtotThresh character(len=132) :: message REAL :: inflow_lon_s(2),inflow_lon_e(2),inflow_lat_s(2),inflow_lat_e(2) REAL :: inflow_hr_s(2),inflow_min_s(2),inflow_s(2),inflow_hr_e(2) REAL :: inflow_sec_s(2),inflow_sec_e(2),inflow_min_e(2),inflow_e(2) REAL :: kmlev_hr_init(2),kmlev_min_init(2),kmlev_sec_init(2),kmlev_init(2) REAL :: nbut_hr_s,nbut_min_s,nbut_sec_s,nbut_s REAL :: nbut(89) nbut=1e-3*(/1.54800, 1.54800, 1.54800, 1.54800, 1.54800, 1.54800, 1.54800, & 1.54800, 1.29000, 1.29000, 1.26120, 1.23205, 0.48600, 0.48600, 0.48600,& 0.47231,& 0.03300, 0.03300, 0.03300, 0.03212, 0.02700, 0.02700, 0.02622, 0.02543,& 0.01100,& 0.01100, 0.01085, 0.01070, 0.01100, 0.01100, 0.01081, 0.00150, 0.00150,& 0.00150,& 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150, 0.00150,& 0.00150,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800, 0.00800,& 0.00800,& 0.00800/) nbut_hr_s=23. nbut_min_s=15. nbut_sec_s=53. nbut_s=nbut_hr_s+nbut_min_s/60.+nbut_sec_s/3600. inflow_lon_s=(/-97.2024,-97.3969/) inflow_lon_e=(/-97.0995,-97.2377/) inflow_lat_s=(/36.3479,35.8273/) inflow_lat_e=(/36.7614,36.0911/) inflow_hr_s=(/23,23/) !++mmb temp inflow_min_s=(/41,51/) ! inflow_min_s=(/0,51/) inflow_sec_s=(/0,0/) !--mmb inflow_s=inflow_hr_s+inflow_min_s/60.+inflow_sec_s/3600. inflow_hr_e=(/23,23/) !++mmb temp inflow_min_e=(/47,56/) ! inflow_min_e=(/1,56/) !--mmb inflow_sec_e=(/0,0/) inflow_e=inflow_hr_e+inflow_min_e/60. write(*,*)'inflow_s ',inflow_s,' inflow_e ',inflow_e !++mmb temp kmlev_hr_init=(/23,0/) kmlev_min_init=(/40,40/) ! kmlev_hr_init=(/23,23/) ! kmlev_min_init=(/0,1/) !--mmb kmlev_sec_init=(/0,0/) kmlev_init=kmlev_hr_init+kmlev_min_init/60.+kmlev_sec_init/3600. !write(message,*) 'tracer message' ! CALL wrf_message( trim(message) ) ! CALL wrf_debug(0,'tracer debug: inside set_tracer_DC3') ! WRITE(*,*)'tracer write: inside set_tracer_DC3' ! WRITE(*,*)'ids',ids,'ide',ide,'kds',kds,'kde',kde,'jds',jds,'jde',jme ! WRITE(*,*)'ims',ims,'ime',ime,'kms',kms,'kme',kme,'jms',jms,'jme',jme ! WRITE(*,*)'its',its,'ite',ite,'kts',kts,'kte',kte,'jts',jts,'jte',jme ! ! this is for tracer options tracer_test1 and tracer_test2 ! !mmb 5.7 hr OH lifetime (Seinfeld and Pandis, 2012) factor_decay_nbutane = 1./(20520./dtstep) tracer(its:ite,kts:kte,jts:jte,p_tr17_1) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_1) * (1. - factor_decay_nbutane) !-- decay, every time step (ktau), whole domain factor_decay = 1./(86400./dtstep) tracer(its:ite,kts:kte,jts:jte,p_tr17_2) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_2) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_4) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_4) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_6) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_6) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_8) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_8) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_10) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_10) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_12) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_12) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_14) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_14) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_16) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_16) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_18) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_18) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_20) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_20) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_22) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_22) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_24) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_24) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_26) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_26) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_28) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_28) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_30) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_30) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_32) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_32) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_34) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_34) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_36) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_36) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_38) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_38) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_40) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_40) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_42) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_42) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_44) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_44) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_46) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_46) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_48) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_48) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_50) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_50) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_52) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_52) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_54) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_54) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_56) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_56) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_58) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_58) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_60) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_60) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_62) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_62) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_64) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_64) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_66) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_66) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_68) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_68) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_70) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_70) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_72) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_72) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_74) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_74) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_76) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_76) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_78) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_78) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_80) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_80) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_82) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_82) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_84) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_84) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_86) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_86) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_88) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_88) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_90) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_90) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_92) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_92) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_94) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_94) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_96) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_96) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_98) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_98) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_100) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_100) * (1. - factor_decay) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! PASSIVE and DECAYING TRACERS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IF (ktau .ge. 2) THEN ! Following module_phot_fastj.F, determine current ! time of day in GMT at the middle of the current ! time step, tmidh. ! ktau - time step counter ! dstep - time step in seconds ! gmt - starting hour (in GMT) of the simulation !...minutes since start of run to the middle of the !...current times step (seconds included as decimals) !(old way in r4 this will fail in about 2 yrs)... ! xtime=(ktau-1)*dtstep/60. + dtstep/120. xtime = curr_secs/60._8 + real(dtstep/120.,8) !...the GMT hour of the middle of the current time step !...(can be greater than 24) ixhour = int(gmt + 0.01) + int(xtime/60._8) xhour=real(ixhour,8) !...minutes past the previous hour mark, at the !...middle of the current time step xmin = 60.*gmt + real(xtime-xhour*60._8,8) !...the GMT hour of the middle of the current time step !...(between 0 and 24) gmtp=MOD(xhour,24._8) !...GMT hour plus minutes (in fractaionl hour) of the middle !...of the current time step tmidh= gmtp + xmin/60. dtstepHr=real(dtstep/3600.,8) ! WRITE(*,*)'tracer write: tmidh ',tmidh ! WRITE(*,*)'PRINT p_tr17_1 ',p_tr17_1 !++mmb TEMPORARY ! WRITE(*,*)'tracer write: num_tracer ',num_tracer if ( ktau .eq. 6000 ) then WRITE(*,*)'initializing tracers 2-97 to value 0.0 ',num_tracer do i = its,ite do j = jts,jte do k=kts,kte tracer(i,k,j,3:num_tracer) = 0.0 enddo enddo enddo endif !--mmb qtot = qc + qr + qi + qs + qg qtotThresh=1e-4 ! kg kg-1 write(*,*)'qtotThresh: ',qtotThresh write(*,*)'dtstep: ',dtstep write(*,*)'kmlev_init(1), dtstepHr, tmidh ',kmlev_init(1),kmlev_init(1)+dtstepHr,tmidh !++mmb do i = its,ite do j = jts,jte do k=kts,kte if ( tmidh .gt. nbut_s .and. tmidh .lt. nbut_s+dtstepHr ) then tracer(i,k,j,p_tr17_1) = nbut(k) write(*,*)'NBUT init ' endif ! WRITE(*,*)i,k,j,'z(i,k,j)',z(i,k,j),'ht(i,j)',ht(i,j),'diff',z(i,k,j)-ht(i,j) ! CALL wrf_debug(0,'tracer debug: tr1/2 all') ! tracer(i,k,j,p_tr17_1) = 1.0 ! tracer(i,k,j,p_tr17_2) = 1.0 if ( (z(i,k,j)-ht(i,j)) .gt. 0 .and. (z(i,k,j)-ht(i,j)) .le. 500 ) then if ( xlong(i,j) .gt. inflow_lon_s(1) .and. xlong(i,j) .lt. & inflow_lon_e(1) .and. xlat(i,j) .gt. inflow_lat_s(1) .and. xlat(i,j) .lt. & inflow_lat_e(1) .and. tmidh .gt. inflow_s(1) .and. tmidh .lt. inflow_e(1) ) then write(*,*)'TR2 init ' tracer(i,k,j,p_tr17_2) = 1.0 tracer(i,k,j,p_tr17_3) = 1.0 endif if ( xlong(i,j) .gt. inflow_lon_s(2) .and. xlong(i,j) .lt. & inflow_lon_e(2) .and. xlat(i,j) .gt. inflow_lat_s(2) .and. xlat(i,j) .lt. & inflow_lat_e(2) .and. tmidh .gt. inflow_s(2) .and. tmidh .lt. inflow_e(2) ) then write(*,*)'TR4 init ' tracer(i,k,j,p_tr17_4) = 1.0 tracer(i,k,j,p_tr17_5) = 1.0 endif if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr)then write(*,*)'TR18 init 1' tracer(i,k,j,p_tr17_18) = 1.0 tracer(i,k,j,p_tr17_19) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr)then write(*,*)'TR58 init 1' tracer(i,k,j,p_tr17_58) = 1.0 tracer(i,k,j,p_tr17_59) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 500 .and. (z(i,k,j)-ht(i,j)) .le. 1000 ) then if ( xlong(i,j) .gt. inflow_lon_s(1) .and. xlong(i,j) .lt. & inflow_lon_e(1) .and. xlat(i,j) .gt. inflow_lat_s(1) .and. xlat(i,j) .lt. & inflow_lat_e(1) .and. tmidh .gt. inflow_s(1) .and. tmidh .lt. inflow_e(1) ) then write(*,*)'TR6 init 1' tracer(i,k,j,p_tr17_6) = 1.0 tracer(i,k,j,p_tr17_7) = 1.0 endif if ( xlong(i,j) .gt. inflow_lon_s(2) .and. xlong(i,j) .lt. & inflow_lon_e(2) .and. xlat(i,j) .gt. inflow_lat_s(2) .and. xlat(i,j) .lt. & inflow_lat_e(2) .and. tmidh .gt. inflow_s(2) .and. tmidh .lt. inflow_e(2) ) then write(*,*)'TR8 init ' tracer(i,k,j,p_tr17_8) = 1.0 tracer(i,k,j,p_tr17_9) = 1.0 endif if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr )then write(*,*)'TR18 init ' tracer(i,k,j,p_tr17_18) = 1.0 tracer(i,k,j,p_tr17_19) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr ) then write(*,*)'TR58 init ' tracer(i,k,j,p_tr17_58) = 1.0 tracer(i,k,j,p_tr17_59) = 1.0 endif endif elseif ((z(i,k,j)-ht(i,j)) .gt. 1000 .and. (z(i,k,j)-ht(i,j)) .le. pbl_h(i,j))then if ( xlong(i,j) .gt. inflow_lon_s(1) .and. xlong(i,j) .lt. & inflow_lon_e(1) .and. xlat(i,j) .gt. inflow_lat_s(1) .and. xlat(i,j) .lt. & inflow_lat_e(1) .and. tmidh .gt. inflow_s(1) .and. tmidh .lt. inflow_e(1) ) then write(*,*)'TR10 init ' tracer(i,k,j,p_tr17_10) = 1.0 tracer(i,k,j,p_tr17_11) = 1.0 endif if ( xlong(i,j) .gt. inflow_lon_s(2) .and. xlong(i,j) .lt. & inflow_lon_e(2) .and. xlat(i,j) .gt. inflow_lat_s(2) .and. xlat(i,j) .lt. & inflow_lat_e(2) .and. tmidh .gt. inflow_s(2) .and. tmidh .lt. inflow_e(2) ) then write(*,*)'TR12 init ' tracer(i,k,j,p_tr17_12) = 1.0 tracer(i,k,j,p_tr17_13) = 1.0 endif if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr)then write(*,*)'TR20 init ' tracer(i,k,j,p_tr17_20) = 1.0 tracer(i,k,j,p_tr17_21) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr)then write(*,*)'TR60 init ' tracer(i,k,j,p_tr17_60) = 1.0 tracer(i,k,j,p_tr17_61) = 1.0 endif endif elseif((z(i,k,j)-ht(i,j)) .gt. pbl_h(i,j) .and. (z(i,k,j)-ht(i,j)) .le. 3000)then if ( xlong(i,j) .gt. inflow_lon_s(1) .and. xlong(i,j) .lt. & inflow_lon_e(1) .and. xlat(i,j) .gt. inflow_lat_s(1) .and. xlat(i,j) .lt. & inflow_lat_e(1) .and. tmidh .gt. inflow_s(1) .and. tmidh .lt. inflow_e(1) ) then write(*,*)'TR14 init ' tracer(i,k,j,p_tr17_14) = 1.0 tracer(i,k,j,p_tr17_15) = 1.0 endif if ( xlong(i,j) .gt. inflow_lon_s(2) .and. xlong(i,j) .lt. & inflow_lon_e(2) .and. xlat(i,j) .gt. inflow_lat_s(2) .and. xlat(i,j) .lt. & inflow_lat_e(2) .and. tmidh .gt. inflow_s(2) .and. tmidh .lt. inflow_e(2) ) then write(*,*)'TR16 init ' tracer(i,k,j,p_tr17_16) = 1.0 tracer(i,k,j,p_tr17_17) = 1.0 endif if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr )then write(*,*)'TR22 init ' tracer(i,k,j,p_tr17_22) = 1.0 tracer(i,k,j,p_tr17_23) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr )then write(*,*)'TR62 init ' tracer(i,k,j,p_tr17_62) = 1.0 tracer(i,k,j,p_tr17_63) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 3000 .and. (z(i,k,j)-ht(i,j)) .le. 4000) then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr ) then write(*,*)'TR24 init ' tracer(i,k,j,p_tr17_24) = 1.0 tracer(i,k,j,p_tr17_25) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR64 init ' tracer(i,k,j,p_tr17_64) = 1.0 tracer(i,k,j,p_tr17_65) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 4000 .and. (z(i,k,j)-ht(i,j)) .le. 5000) then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR26 init ' tracer(i,k,j,p_tr17_26) = 1.0 tracer(i,k,j,p_tr17_27) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR66 init ' tracer(i,k,j,p_tr17_66) = 1.0 tracer(i,k,j,p_tr17_67) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 5000 .and. (z(i,k,j)-ht(i,j)) .le. 6000) then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR28 init ' tracer(i,k,j,p_tr17_28) = 1.0 tracer(i,k,j,p_tr17_29) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr ) then write(*,*)'TR68 init ' tracer(i,k,j,p_tr17_68) = 1.0 tracer(i,k,j,p_tr17_69) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 6000 .and. (z(i,k,j)-ht(i,j)) .le. 7000) then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR30 init ' tracer(i,k,j,p_tr17_30) = 1.0 tracer(i,k,j,p_tr17_31) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr ) then write(*,*)'TR70 init ' tracer(i,k,j,p_tr17_70) = 1.0 tracer(i,k,j,p_tr17_71) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 7000 .and. (z(i,k,j)-ht(i,j)) .le. 8000) then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr ) then write(*,*)'TR32 init ' tracer(i,k,j,p_tr17_32) = 1.0 tracer(i,k,j,p_tr17_33) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr ) then write(*,*)'TR72 init ' tracer(i,k,j,p_tr17_72) = 1.0 tracer(i,k,j,p_tr17_73) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 8000 .and. (z(i,k,j)-ht(i,j)) .le. 9000) then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr)then write(*,*)'TR34 init ' tracer(i,k,j,p_tr17_34) = 1.0 tracer(i,k,j,p_tr17_35) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr)then write(*,*)'TR74 init ' tracer(i,k,j,p_tr17_74) = 1.0 tracer(i,k,j,p_tr17_75) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 9000 .and. (z(i,k,j)-ht(i,j)) .le. 10000) then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR36 init ' tracer(i,k,j,p_tr17_36) = 1.0 tracer(i,k,j,p_tr17_37) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR76 init ' tracer(i,k,j,p_tr17_76) = 1.0 tracer(i,k,j,p_tr17_77) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 10000 .and. (z(i,k,j)-ht(i,j)) .le. 11000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR38 init ' tracer(i,k,j,p_tr17_38) = 1.0 tracer(i,k,j,p_tr17_39) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR78 init ' tracer(i,k,j,p_tr17_78) = 1.0 tracer(i,k,j,p_tr17_79) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 11000 .and. (z(i,k,j)-ht(i,j)) .le. 12000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr)then write(*,*)'TR40 init ' tracer(i,k,j,p_tr17_40) = 1.0 tracer(i,k,j,p_tr17_41) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR80 init ' tracer(i,k,j,p_tr17_80) = 1.0 tracer(i,k,j,p_tr17_81) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 12000 .and. (z(i,k,j)-ht(i,j)) .le. 13000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR42 init ' tracer(i,k,j,p_tr17_42) = 1.0 tracer(i,k,j,p_tr17_43) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR82 init ' tracer(i,k,j,p_tr17_82) = 1.0 tracer(i,k,j,p_tr17_83) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 13000 .and. (z(i,k,j)-ht(i,j)) .le. 14000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR44 init ' tracer(i,k,j,p_tr17_44) = 1.0 tracer(i,k,j,p_tr17_45) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR84 init ' tracer(i,k,j,p_tr17_84) = 1.0 tracer(i,k,j,p_tr17_85) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 14000 .and. (z(i,k,j)-ht(i,j)) .le. 15000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR46 init ' tracer(i,k,j,p_tr17_46) = 1.0 tracer(i,k,j,p_tr17_47) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR86 init ' tracer(i,k,j,p_tr17_86) = 1.0 tracer(i,k,j,p_tr17_87) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 15000 .and. (z(i,k,j)-ht(i,j)) .le. 16000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt.kmlev_init(1)+dtstepHr ) then write(*,*)'TR48 init ' tracer(i,k,j,p_tr17_48) = 1.0 tracer(i,k,j,p_tr17_49) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt.kmlev_init(2)+dtstepHr ) then write(*,*)'TR88 init ' tracer(i,k,j,p_tr17_88) = 1.0 tracer(i,k,j,p_tr17_89) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 16000 .and. (z(i,k,j)-ht(i,j)) .le. 17000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr ) then write(*,*)'TR50 init ' tracer(i,k,j,p_tr17_50) = 1.0 tracer(i,k,j,p_tr17_51) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr ) then write(*,*)'TR90 init ' tracer(i,k,j,p_tr17_90) = 1.0 tracer(i,k,j,p_tr17_91) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 17000 .and. (z(i,k,j)-ht(i,j)) .le. 18000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr ) then write(*,*)'TR52 init ' tracer(i,k,j,p_tr17_52) = 1.0 tracer(i,k,j,p_tr17_53) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr ) then write(*,*)'TR92 init ' tracer(i,k,j,p_tr17_92) = 1.0 tracer(i,k,j,p_tr17_93) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 18000 .and. (z(i,k,j)-ht(i,j)) .le. 19000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr ) then write(*,*)'TR54 init ' tracer(i,k,j,p_tr17_54) = 1.0 tracer(i,k,j,p_tr17_55) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr ) then write(*,*)'TR94 init ' tracer(i,k,j,p_tr17_94) = 1.0 tracer(i,k,j,p_tr17_95) = 1.0 endif endif elseif ( (z(i,k,j)-ht(i,j)) .gt. 19000 .and. (z(i,k,j)-ht(i,j)) .le. 20000)then if ( qtot(i,k,j) .lt. qtotThresh ) then if ( tmidh .gt. kmlev_init(1) .and. tmidh .lt. kmlev_init(1)+dtstepHr ) then write(*,*)'TR56 init ' tracer(i,k,j,p_tr17_56) = 1.0 tracer(i,k,j,p_tr17_57) = 1.0 endif if ( tmidh .gt. kmlev_init(2) .and. tmidh .lt. kmlev_init(2)+dtstepHr ) then write(*,*)'TR96 init ' tracer(i,k,j,p_tr17_96) = 1.0 tracer(i,k,j,p_tr17_97) = 1.0 endif endif endif end do end do end do ENDIF ! ktau END SUBROUTINE set_tracer_DC3 !--mmb SUBROUTINE set_tracer(dtstep,ktau,pbl_h,tracer,t,tracer_opt,num_tracer,& z,ht,ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) INTEGER, INTENT(IN ) :: ktau,tracer_opt,num_tracer INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme,num_tracer ), INTENT(INOUT) :: tracer REAL, DIMENSION(ims:ime,kms:kme,jms:jme ), INTENT(IN) :: t,z REAL, DIMENSION(ims:ime,jms:jme ), INTENT(IN) :: PBL_H,HT REAL, INTENT(IN) :: dtstep INTEGER:: count_trop,count_pbl ! ! this is for tracer options tracer_test1 and tracer_test2 ! factor_decay = 1./(86400./dtstep) !-- decay, every time step (ktau), whole domain tracer(its:ite,kts:kte,jts:jte,p_tr17_2) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_2) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_4) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_4) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_6) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_6) * (1. - factor_decay) tracer(its:ite,kts:kte,jts:jte,p_tr17_8) = & tracer(its:ite,kts:kte,jts:jte,p_tr17_8) * (1. - factor_decay) IF (ktau .ge. 2) THEN !-- every time step, every grid point, restore some tracer !(1)level 1 restore to 1.0 if(tracer_opt == TRACER_TEST1)then tracer(its:ite,kts,jts:jte,p_tr17_3) = 1.0 tracer(its:ite,kts,jts:jte,p_tr17_4) = 1.0 endif do i= its,ite do j= jts,jte !(2)every level above tropopause (t minimum), restore to 1.0 !-- get levels of tropopause (count_trop) count_trop = minloc(t(i,kts:kte,j),1) tracer(i,count_trop:kte,j,p_tr17_5) = 1.0 tracer(i,count_trop:kte,j,p_tr17_6) = 1.0 !(3)every level below pblh, restore to 1.0 !-- get levels in pbl (count_pbl) count_pbl = 0 do k=kts,kte if ( (z(i,k,j)-ht(i,j)) .le. pbl_h(i,j) ) then count_pbl = count_pbl + 1 endif end do if (count_pbl .ge. 1) then tracer(i,kts:count_pbl,j,p_tr17_7) = 1.0 tracer(i,kts:count_pbl,j,p_tr17_8) = 1.0 endif end do ! j end do ! i ENDIF ! ktau END SUBROUTINE set_tracer !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE bdy_tracer_value ( trac, trac_b, trac_bt, dt,ic) IMPLICIT NONE REAL, intent(OUT) :: trac REAL, intent(IN) :: trac_b REAL, intent(IN) :: trac_bt REAL, intent(IN) :: dt INTEGER, intent(IN) :: ic REAL :: epsilc = 1.E-12 ! CHARACTER (LEN=80) :: message !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! if( ntracer .GT. numtracer) then ! message = ' Input_tracer_profile: wrong number of tracers' ! return ! CALL WRF_ERROR_FATAL ( message ) ! endif trac=max(epsilc,trac_b + trac_bt * dt) RETURN END SUBROUTINE bdy_tracer_value !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE module_input_tracer