!WRF:MODEL_LAYER: PHYSICS ! ! note: this module really belongs in the dyn_em directory since it is ! specific only to the EM core. Leaving here for now, with an ! #if ( EM_CORE == 1 ) directive. JM 20031201 ! ! This MODULE holds the routines which are used to perform updates of the ! model C-grid tendencies with physics A-grid tendencies ! The module consolidates code that was (up to v1.2) duplicated in ! module_em and module_rk and in ! module_big_step_utilities.F and module_big_step_utilities_em.F ! This MODULE CONTAINS the following routines: ! update_phy_ten, phy_ra_ten, phy_bl_ten, phy_cu_ten, advance_ppt, ! add_a2a, add_a2c_u, and add_a2c_v MODULE g_module_physics_addtendc #if ( EM_CORE == 1 ) USE module_state_description USE module_configure CONTAINS SUBROUTINE g_update_phy_ten(rph_tendf,rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf, & rv_tendf,g_rv_tendf,moist_tendf,g_moist_tendf, & scalar_tendf,mu_tendf, & RTHRATEN,RTHBLTEN,g_RTHBLTEN,RTHCUTEN,g_RTHCUTEN,RTHSHTEN, & RUBLTEN,g_RUBLTEN,RUCUTEN,RUSHTEN, & RVBLTEN,g_RVBLTEN,RVCUTEN,RVSHTEN, & RQVBLTEN,g_RQVBLTEN,RQCBLTEN,RQIBLTEN, & RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN, & RQVSHTEN,RQCSHTEN,RQRSHTEN,RQISHTEN,RQSSHTEN,RQGSHTEN,& RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN, & RQVNDGDTEN,RMUNDGDTEN, & rthfrten,rqvfrten, & !fire n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------------- IMPLICIT NONE !------------------------------------------------------------------- TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & n_moist,n_scalar,rk_step LOGICAL , INTENT(IN) :: adv_moist_cond REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) :: & ru_tendf, & g_ru_tendf, & rv_tendf, & g_rv_tendf, & rt_tendf, & g_rt_tendf, & rph_tendf REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) :: mu_tendf REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & INTENT(INOUT) :: moist_tendf, & g_moist_tendf REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), & INTENT(INOUT) :: scalar_tendf REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & RTHRATEN, & RTHBLTEN, & g_RTHBLTEN, & RTHCUTEN, & g_RTHCUTEN, & RTHSHTEN, & RUBLTEN, & g_RUBLTEN, & RUCUTEN, & RUSHTEN, & RVBLTEN, & g_RVBLTEN, & RVCUTEN, & RVSHTEN, & RQVBLTEN, & g_RQVBLTEN, & RQCBLTEN, & RQIBLTEN, & RQVCUTEN, & g_RQVCUTEN, & RQCCUTEN, & RQRCUTEN, & RQICUTEN, & RQSCUTEN, & RQVSHTEN, & RQCSHTEN, & RQRSHTEN, & RQISHTEN, & RQSSHTEN, & RQGSHTEN, & RTHNDGDTEN, & RPHNDGDTEN, & RQVNDGDTEN, & RUNDGDTEN, & RVNDGDTEN REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & ! fire rthfrten, & rqvfrten !------------------------------------------------------------------ ! set up loop bounds for this grid's boundary conditions if (config_flags%ra_lw_physics .gt. 0 .or. & config_flags%ra_sw_physics .gt. 0) & CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (config_flags%bl_pbl_physics .gt. 0) & CALL g_phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, & rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf, & rv_tendf,g_rv_tendf, & moist_tendf, g_moist_tendf, & scalar_tendf,adv_moist_cond, & RTHBLTEN,g_RTHBLTEN, & RUBLTEN,g_RUBLTEN, & RVBLTEN,g_RVBLTEN, & RQVBLTEN,g_RQVBLTEN, & RQCBLTEN,RQIBLTEN, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (config_flags%cu_physics .gt. 0) & CALL g_phy_cu_ten(config_flags,rk_step,n_moist,n_scalar, & rt_tendf,g_rt_tendf,ru_tendf,rv_tendf, & RUCUTEN,RVCUTEN,RTHCUTEN,g_RTHCUTEN, & RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN, & RQICUTEN,RQSCUTEN,moist_tendf,g_moist_tendf,& scalar_tendf,adv_moist_cond, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (config_flags%shcu_physics .gt. 0) & CALL phy_shcu_ten(config_flags,rk_step,n_moist, & rt_tendf,ru_tendf,rv_tendf, & RUSHTEN,RVSHTEN,RTHSHTEN, & RQVSHTEN,RQCSHTEN,RQRSHTEN, & RQISHTEN,RQSSHTEN,RQGSHTEN,moist_tendf, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (config_flags%grid_fdda .gt. 0) & CALL phy_fg_ten(config_flags,rk_step,n_moist, & rph_tendf,rt_tendf,ru_tendf,rv_tendf, & mu_tendf, moist_tendf, & RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, & RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (config_flags%ifire .gt. 0) & ! fire CALL phy_fr_ten(config_flags,rk_step,n_moist, & rt_tendf,ru_tendf,rv_tendf, & mu_tendf, moist_tendf, & rthfrten,rqvfrten, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) END SUBROUTINE g_update_phy_ten !================================================================= SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & RTHRATEN REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: & rt_tendf ! LOCAL VARS INTEGER :: i,j,k CALL add_a2a(rt_tendf,RTHRATEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) END SUBROUTINE phy_ra_ten !================================================================= SUBROUTINE g_phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, & rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf, & rv_tendf,g_rv_tendf,moist_tendf,g_moist_tendf, & scalar_tendf,adv_moist_cond, & RTHBLTEN,g_RTHBLTEN, & RUBLTEN,g_RUBLTEN, & RVBLTEN,g_RVBLTEN, & RQVBLTEN,g_RQVBLTEN, & RQCBLTEN,RQIBLTEN, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & n_moist, n_scalar, rk_step LOGICAL , INTENT(IN) :: adv_moist_cond REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & INTENT(INOUT) :: moist_tendf, & g_moist_tendf REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), & INTENT(INOUT) :: scalar_tendf REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & RTHBLTEN, & g_RTHBLTEN, & RUBLTEN, & g_RUBLTEN, & RVBLTEN, & g_RVBLTEN, & RQVBLTEN, & g_RQVBLTEN, & RQCBLTEN, & RQIBLTEN REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & rt_tendf, & g_rt_tendf, & ru_tendf, & g_ru_tendf, & rv_tendf, & g_rv_tendf ! LOCAL VARS INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND !----------------------------------------------------------------- SELECT CASE(config_flags%bl_pbl_physics) CASE (YSUSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (MRFSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (ACMPBLSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR)THEN CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF ENDIF CASE (MYJPBLSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ! if (P_QT .ge. PARAM_FIRST_SCALAR) & ! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSBLTEN, & ! config_flags, & ! ids,ide, jds, jde, kds, kde, & ! ims, ime, jms, jme, kms, kme, & ! its, ite, jts, jte, kts, kte ) ! ! if (P_QT .ge. PARAM_FIRST_SCALAR) & ! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRBLTEN, & ! config_flags, & ! ids,ide, jds, jde, kds, kde, & ! ims, ime, jms, jme, kms, kme, & ! its, ite, jts, jte, kts, kte ) ! ! if (P_QT .ge. PARAM_FIRST_SCALAR) & ! CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQGBLTEN, & ! config_flags, & ! ids,ide, jds, jde, kds, kde, & ! ims, ime, jms, jme, kms, kme, & ! its, ite, jts, jte, kts, kte ) ELSE if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ! if (P_QS .ge. PARAM_FIRST_SCALAR) & ! CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSBLTEN, & ! config_flags, & ! ids,ide, jds, jde, kds, kde, & ! ims, ime, jms, jme, kms, kme, & ! its, ite, jts, jte, kts, kte ) ! ! if (P_QR .ge. PARAM_FIRST_SCALAR) & ! CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRBLTEN, & ! config_flags, & ! ids,ide, jds, jde, kds, kde, & ! ims, ime, jms, jme, kms, kme, & ! its, ite, jts, jte, kts, kte ) ! ! if (P_QG .ge. PARAM_FIRST_SCALAR) & ! CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGBLTEN, & ! config_flags, & ! ids,ide, jds, jde, kds, kde, & ! ims, ime, jms, jme, kms, kme, & ! its, ite, jts, jte, kts, kte ) ENDIF CASE (QNSEPBLSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ELSE if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (GFSSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (MYNNPBLSCHEME2,MYNNPBLSCHEME3) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (BOULACSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ELSE if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (SURFDRAGSCHEME) CALL g_add_a2a(rt_tendf,g_rt_tendf, & RTHBLTEN,g_RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL g_add_a2c_u(ru_tendf,g_ru_tendf, & RUBLTEN,g_RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL g_add_a2c_v(rv_tendf,g_rv_tendf, & RVBLTEN,g_RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL g_add_a2a(moist_tendf(ims,kms,jms,P_QV), & g_moist_tendf(ims,kms,jms,P_QV), & RQVBLTEN, g_RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (CAMUWPBLSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ELSE if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (TEMFPBLSCHEME) CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE DEFAULT print*,'g_phy_bl_ten: The pbl scheme does not exist' END SELECT END SUBROUTINE g_phy_bl_ten !================================================================= SUBROUTINE g_phy_cu_ten(config_flags,rk_step,n_moist,n_scalar, & rt_tendf,g_rt_tendf,ru_tendf,rv_tendf, & RUCUTEN,RVCUTEN,RTHCUTEN,g_RTHCUTEN, & RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN, & RQICUTEN,RQSCUTEN,moist_tendf,g_moist_tendf,& scalar_tendf,adv_moist_cond, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & n_moist, n_scalar, rk_step LOGICAL , INTENT(IN) :: adv_moist_cond REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & INTENT(INOUT) :: moist_tendf, g_moist_tendf REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), & INTENT(INOUT) :: scalar_tendf REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & RUCUTEN, & RVCUTEN, & RTHCUTEN, & g_RTHCUTEN, & RQVCUTEN, & g_RQVCUTEN, & RQCCUTEN, & RQRCUTEN, & RQICUTEN, & RQSCUTEN REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: & rt_tendf, & g_rt_tendf, & ru_tendf, & rv_tendf ! LOCAL VARS INTEGER :: i,j,k SELECT CASE (config_flags%cu_physics) CASE (KFSCHEME) CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QR .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QS .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (BMJSCHEME) CALL add_a2a(rt_tendf,RTHCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (KFETASCHEME, MSKFSCHEME) CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QR .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QS .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (GDSCHEME, G3SCHEME) CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (NSASSCHEME) CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (SASSCHEME,OSASSCHEME) CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (DUCUSCHEME) CALL g_add_a2a(rt_tendf, g_rt_tendf, & RTHCUTEN, g_RTHCUTEN, config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL g_add_a2a(moist_tendf(ims,kms,jms,P_QV), & g_moist_tendf(ims,kms,jms,P_QV), RQVCUTEN, & g_RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (CAMZMSCHEME) CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (TIEDTKESCHEME, NTIEDTKESCHEME) CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) IF(.not. adv_moist_cond)THEN if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QT .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE DEFAULT END SELECT END SUBROUTINE g_phy_cu_ten !================================================================= SUBROUTINE phy_shcu_ten(config_flags,rk_step,n_moist, & rt_tendf,ru_tendf,rv_tendf, & RUSHTEN,RVSHTEN,RTHSHTEN, & RQVSHTEN,RQCSHTEN,RQRSHTEN, & RQISHTEN,RQSSHTEN,RQGSHTEN,moist_tendf, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & n_moist, rk_step REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & INTENT(INOUT) :: moist_tendf REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & RUSHTEN, & RVSHTEN, & RTHSHTEN, & RQVSHTEN, & RQCSHTEN, & RQRSHTEN, & RQISHTEN, & RQSSHTEN, & RQGSHTEN REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: & rt_tendf, & ru_tendf, & rv_tendf ! LOCAL VARS INTEGER :: i,j,k SELECT CASE (config_flags%shcu_physics) CASE (CAMUWSHCUSCHEME) CALL add_a2c_u(ru_tendf,RUSHTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2c_v(rv_tendf,RVSHTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2a(rt_tendf,RTHSHTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVSHTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QC .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCSHTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QR .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRSHTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QI .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQISHTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QS .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSSHTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) if (P_QG .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGSHTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE DEFAULT END SELECT END SUBROUTINE phy_shcu_ten !================================================================= SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, & rph_tendf,rt_tendf,ru_tendf,rv_tendf, & mu_tendf, moist_tendf, & RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, & RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & n_moist, rk_step REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & INTENT(INOUT) :: moist_tendf REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & RTHNDGDTEN, & RPHNDGDTEN, & RUNDGDTEN, & RVNDGDTEN, & RQVNDGDTEN REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & rph_tendf,& rt_tendf, & ru_tendf, & rv_tendf REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf ! LOCAL VARS INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND !----------------------------------------------------------------- SELECT CASE(config_flags%grid_fdda) CASE (PSUFDDAGD) CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ! note fdda u and v tendencies are staggered CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, & ids,ide, jds, jde, kds, kds, & ims, ime, jms, jme, kms, kms, & its, ite, jts, jte, kts, kts ) if (P_QV .ge. PARAM_FIRST_SCALAR) & CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (SPNUDGING) ! note fdda u and v tendencies are staggered CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2a_ph(rph_tendf,RPHNDGDTEN,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE DEFAULT END SELECT END SUBROUTINE phy_fg_ten !================================================================= SUBROUTINE phy_fr_ten(config_flags,rk_step,n_moist, & rt_tendf,ru_tendf,rv_tendf, & mu_tendf, moist_tendf, & rthfrten,rqvfrten, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !----------------------------------------------------------------- USE module_state_description, ONLY : & FIRE_SFIRE !----------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------- TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & n_moist, rk_step REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & INTENT(INOUT) :: moist_tendf REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & rthfrten, & rqvfrten REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & rt_tendf, & ru_tendf, & rv_tendf REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf ! LOCAL VARS INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND !----------------------------------------------------------------- SELECT CASE(config_flags%ifire) CASE (FIRE_SFIRE) CALL add_a2a(rt_tendf,rthfrten, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),rqvfrten, & config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE DEFAULT END SELECT END SUBROUTINE phy_fr_ten !--------------------------------------------------- ------------------- ! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.5 (r3785) - 22 Mar 2011 18:35 ! ! Differentiation of advance_ppt in forward (tangent) mode: ! variations of useful results: rqccuten rthcuten rqicuten ! rqscuten rainc cuppt nca rqrcuten rqvcuten rainsh ! htop hbot ! with respect to varying inputs: pratesh rqccuten rthcuten rqicuten ! rqscuten rainc pratec cuppt cutop cubot nca rqrcuten ! rqvcuten rainsh htop hbot ! RW status of diff variables: pratesh:in rqccuten:in-out rthcuten:in-out ! rqicuten:in-out rqscuten:in-out rainc:in-out pratec:in ! cuppt:in-out cutop:in cubot:in nca:in-out rqrcuten:in-out ! rqvcuten:in-out rainsh:in-out htop:in-out hbot:in-out SUBROUTINE G_ADVANCE_PPT(rthcuten, rthcutend, rqvcuten, rqvcutend, & & rqccuten, rqccutend, rqrcuten, rqrcutend, rqicuten, rqicutend, & & rqscuten, rqscutend, rainc, raincd, raincv, rainsh, rainshd, pratec, & & pratecd, pratesh, prateshd, nca, ncad, htop, htopd, hbot, hbotd, cutop& & , cutopd, cubot, cubotd, cuppt, cupptd, dt, config_flags, ids, ide, & & jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, & & kts, kte) IMPLICIT NONE ! TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, & & jme, kms, kme, its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthcuten& & , rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthcutend& & , rqvcutend, rqccutend, rqrcutend, rqicutend, rqscutend REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainc, rainsh, & & raincv, pratec, pratesh, nca, htop, hbot, cutop, cubot, cuppt REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: raincd, rainshd, & & pratecd, prateshd, ncad, htopd, hbotd, cutopd, cubotd, cupptd REAL, INTENT(IN) :: dt ! LOCAL VAR INTEGER :: i, j, k, i_start, i_end, j_start, j_end, k_start, k_end INTEGER :: ncutop, ncubot !----------------------------------------------------------------- IF (config_flags%cu_physics .EQ. 0) THEN RETURN ELSE ! SET START AND END POINTS FOR TILES i_start = its IF (ite .GT. ide - 1) THEN i_end = ide - 1 ELSE i_end = ite END IF j_start = jts IF (jte .GT. jde - 1) THEN j_end = jde - 1 ELSE j_end = jte END IF ! ! IF( config_flags%nested .or. config_flags%specified ) THEN ! i_start = max( its,ids+1 ) ! i_end = min( ite,ide-2 ) ! j_start = max( jts,jds+1 ) ! j_end = min( jte,jde-2 ) ! ENDIF ! k_start = kts IF (kte .GT. kde - 1) THEN k_end = kde - 1 ELSE k_end = kte END IF ! Update total cumulus scheme precipitation ! in mm DO j=j_start,j_end DO i=i_start,i_end raincd(i, j) = raincd(i, j) + dt*pratecd(i, j) rainc(i, j) = rainc(i, j) + pratec(i, j)*dt rainshd(i, j) = rainshd(i, j) + dt*prateshd(i, j) rainsh(i, j) = rainsh(i, j) + pratesh(i, j)*dt cupptd(i, j) = cupptd(i, j) + dt*(pratecd(i, j)+prateshd(i, j))/& & 1000. cuppt(i, j) = cuppt(i, j) + (pratec(i, j)+pratesh(i, j))*dt/& & 1000. END DO END DO SELECT CASE (config_flags%cu_physics) CASE (kfscheme) DO j=j_start,j_end DO i=i_start,i_end IF (nca(i, j) .GT. 0) THEN IF (NINT(nca(i, j)/dt) .LE. 0) THEN ! set tendency to zero ! PRATEC(I,J)=0. ! RAINCV(I,J)=0. DO k=k_start,k_end rthcutend(i, k, j) = 0.0 rthcuten(i, k, j) = 0. rqvcutend(i, k, j) = 0.0 rqvcuten(i, k, j) = 0. rqccutend(i, k, j) = 0.0 rqccuten(i, k, j) = 0. rqrcutend(i, k, j) = 0.0 rqrcuten(i, k, j) = 0. IF (p_qi .GE. param_first_scalar) THEN rqicutend(i, k, j) = 0.0 rqicuten(i, k, j) = 0. END IF IF (p_qs .GE. param_first_scalar) THEN rqscutend(i, k, j) = 0.0 rqscuten(i, k, j) = 0. END IF END DO END IF ! Decrease NCA nca(i, j) = nca(i, j) - dt END IF END DO END DO CASE (ducuscheme) ! DO j=j_start,j_end DO i=i_start,i_end IF (nca(i, j) .GT. 0) THEN IF (NINT(nca(i, j)/dt) .LE. 0) THEN ! set tendency to zero !! PRATEC(I,J)=0. !! RAINCV(I,J)=0. DO k=k_start,k_end rthcutend(i, k, j) = 0.0 rthcuten(i, k, j) = 0. rqvcutend(i, k, j) = 0.0 rqvcuten(i, k, j) = 0. END DO END IF ! Decrease NCA nca(i, j) = nca(i, j) - dt END IF END DO END DO CASE (bmjscheme, camzmscheme) ! DO j=j_start,j_end DO i=i_start,i_end ! HTOP, HBOT FOR GFDL RADIATION ncutop = NINT(cutop(i, j)) ncubot = NINT(cubot(i, j)) IF (ncutop .GT. 1 .AND. ncutop .LT. kde) THEN IF (cutop(i, j) .LT. htop(i, j)) THEN htop(i, j) = htop(i, j) ELSE htopd(i, j) = cutopd(i, j) htop(i, j) = cutop(i, j) END IF END IF IF (ncubot .GT. 0 .AND. ncubot .LT. kde) THEN IF (cubot(i, j) .GT. hbot(i, j)) THEN hbot(i, j) = hbot(i, j) ELSE hbotd(i, j) = cubotd(i, j) hbot(i, j) = cubot(i, j) END IF END IF END DO END DO CASE (kfetascheme, MSKFSCHEME) DO j=j_start,j_end DO i=i_start,i_end ! HTOP, HBOT FOR GFDL RADIATION ncutop = NINT(cutop(i, j)) ncubot = NINT(cubot(i, j)) IF (ncutop .GT. 1 .AND. ncutop .LT. kde) THEN IF (cutop(i, j) .LT. htop(i, j)) THEN htop(i, j) = htop(i, j) ELSE htopd(i, j) = cutopd(i, j) htop(i, j) = cutop(i, j) END IF END IF IF (ncubot .GT. 0 .AND. ncubot .LT. kde) THEN IF (cubot(i, j) .GT. hbot(i, j)) THEN hbot(i, j) = hbot(i, j) ELSE hbotd(i, j) = cubotd(i, j) hbot(i, j) = cubot(i, j) END IF END IF IF (nca(i, j) .GT. 0) THEN IF (NINT(nca(i, j)/dt) .LE. 1) THEN ! set tendency to zero ! PRATEC(I,J)=0. ! RAINCV(I,J)=0. DO k=k_start,k_end rthcutend(i, k, j) = 0.0 rthcuten(i, k, j) = 0. rqvcutend(i, k, j) = 0.0 rqvcuten(i, k, j) = 0. rqccutend(i, k, j) = 0.0 rqccuten(i, k, j) = 0. rqrcutend(i, k, j) = 0.0 rqrcuten(i, k, j) = 0. IF (p_qi .GE. param_first_scalar) THEN rqicutend(i, k, j) = 0.0 rqicuten(i, k, j) = 0. END IF IF (p_qs .GE. param_first_scalar) THEN rqscutend(i, k, j) = 0.0 rqscuten(i, k, j) = 0. END IF END DO END IF ! Decrease NCA nca(i, j) = nca(i, j) - dt ! NCA(I,J)=NCA(I,J)-1. ! Decrease NCA END IF END DO END DO END SELECT END IF END SUBROUTINE G_ADVANCE_PPT SUBROUTINE add_a2a(lvar,rvar,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------ TYPE(grid_config_rec_type), INTENT(IN) :: config_flags INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::& rvar REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::& lvar ! LOCAL VARS INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf i_start = its i_end = MIN(ite,ide-1) j_start = jts j_end = MIN(jte,jde-1) ktf = min(kte,kde-1) IF ( config_flags%specified .or. & config_flags%nested) i_start = MAX(ids+1,its) IF ( config_flags%specified .or. & config_flags%nested) i_end = MIN(ide-2,ite) IF ( config_flags%specified .or. & config_flags%nested) j_start = MAX(jds+1,jts) IF ( config_flags%specified .or. & config_flags%nested) j_end = MIN(jde-2,jte) IF ( config_flags%periodic_x ) i_start = its IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) DO j = j_start,j_end DO k = kts,ktf DO i = i_start,i_end lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j) ENDDO ENDDO ENDDO END SUBROUTINE add_a2a SUBROUTINE add_a2a_ph(lvar,rvar,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------ TYPE(grid_config_rec_type), INTENT(IN) :: config_flags INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::& rvar REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::& lvar ! LOCAL VARS INTEGER :: i,j,k,i_start,i_end,j_start,j_end i_start = its i_end = MIN(ite,ide-1) j_start = jts j_end = MIN(jte,jde-1) IF ( config_flags%specified .or. & config_flags%nested) i_start = MAX(ids+1,its) IF ( config_flags%specified .or. & config_flags%nested) i_end = MIN(ide-2,ite) IF ( config_flags%specified .or. & config_flags%nested) j_start = MAX(jds+1,jts) IF ( config_flags%specified .or. & config_flags%nested) j_end = MIN(jde-2,jte) IF ( config_flags%periodic_x ) i_start = its IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) DO j = j_start,j_end DO k = kts,kte DO i = i_start,i_end lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j) ENDDO ENDDO ENDDO END SUBROUTINE add_a2a_ph !------------------------------------------------------------ SUBROUTINE add_a2c_u(lvar,rvar,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------ !------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------ TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::& rvar REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::& lvar ! LOCAL VARS INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf ktf=min(kte,kde-1) i_start = its i_end = ite j_start = jts j_end = MIN(jte,jde-1) IF ( config_flags%specified .or. & config_flags%nested) i_start = MAX(ids+1,its) IF ( config_flags%specified .or. & config_flags%nested) i_end = MIN(ide-1,ite) IF ( config_flags%specified .or. & config_flags%nested) j_start = MAX(jds+1,jts) IF ( config_flags%specified .or. & config_flags%nested) j_end = MIN(jde-2,jte) IF ( config_flags%periodic_x ) i_start = its IF ( config_flags%periodic_x ) i_end = ite DO j = j_start,j_end DO k = kts,ktf DO i = i_start,i_end lvar(i,k,j) = lvar(i,k,j) + & 0.5*(rvar(i,k,j)+rvar(i-1,k,j)) ENDDO ENDDO ENDDO END SUBROUTINE add_a2c_u !------------------------------------------------------------ SUBROUTINE add_a2c_v(lvar,rvar,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------ !------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------ TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::& rvar REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::& lvar ! LOCAL VARS INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf ktf=min(kte,kde-1) i_start = its i_end = MIN(ite,ide-1) j_start = jts j_end = jte IF ( config_flags%specified .or. & config_flags%nested) i_start = MAX(ids+1,its) IF ( config_flags%specified .or. & config_flags%nested) i_end = MIN(ide-2,ite) IF ( config_flags%specified .or. & config_flags%nested) j_start = MAX(jds+1,jts) IF ( config_flags%specified .or. & config_flags%nested) j_end = MIN(jde-1,jte) IF ( config_flags%periodic_x ) i_start = its IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) DO j = j_start,j_end DO k = kts,kte DO i = i_start,i_end lvar(i,k,j) = lvar(i,k,j) + & 0.5*(rvar(i,k,j)+rvar(i,k,j-1)) ENDDO ENDDO ENDDO END SUBROUTINE add_a2c_v ! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.5 (r3785) - 22 Mar 2011 18:35 ! ! Differentiation of add_a2a in forward (tangent) mode: ! variations of useful results: lvar ! with respect to varying inputs: lvar rvar ! RW status of diff variables: lvar:in-out rvar:in SUBROUTINE G_ADD_A2A(lvar, lvard, rvar, rvard, config_flags, ids, ide, & & jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, & & kts, kte) IMPLICIT NONE !------------------------------------------------------------ TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, & & jme, kms, kme, its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard ! LOCAL VARS INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf INTRINSIC MAX INTRINSIC MIN i_start = its IF (ite .GT. ide - 1) THEN i_end = ide - 1 ELSE i_end = ite END IF j_start = jts IF (jte .GT. jde - 1) THEN j_end = jde - 1 ELSE j_end = jte END IF IF (kte .GT. kde - 1) THEN ktf = kde - 1 ELSE ktf = kte END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (ids + 1 .LT. its) THEN i_start = its ELSE i_start = ids + 1 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (ide - 2 .GT. ite) THEN i_end = ite ELSE i_end = ide - 2 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (jds + 1 .LT. jts) THEN j_start = jts ELSE j_start = jds + 1 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (jde - 2 .GT. jte) THEN j_end = jte ELSE j_end = jde - 2 END IF END IF IF (config_flags%periodic_x) i_start = its IF (config_flags%periodic_x) THEN IF (ite .GT. ide - 1) THEN i_end = ide - 1 ELSE i_end = ite END IF END IF DO j=j_start,j_end DO k=kts,ktf DO i=i_start,i_end lvard(i, k, j) = lvard(i, k, j) + rvard(i, k, j) lvar(i, k, j) = lvar(i, k, j) + rvar(i, k, j) END DO END DO END DO END SUBROUTINE G_ADD_A2A ! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.5 (r3785) - 22 Mar 2011 18:35 ! ! Differentiation of add_a2c_u in forward (tangent) mode: ! variations of useful results: lvar ! with respect to varying inputs: lvar rvar ! RW status of diff variables: lvar:in-out rvar:in SUBROUTINE G_ADD_A2C_U(lvar, lvard, rvar, rvard, config_flags, ids, ide& & , jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte& & , kts, kte) IMPLICIT NONE !------------------------------------------------------------ TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, & & jme, kms, kme, its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard ! LOCAL VARS INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf INTRINSIC MAX INTRINSIC MIN IF (kte .GT. kde - 1) THEN ktf = kde - 1 ELSE ktf = kte END IF i_start = its i_end = ite j_start = jts IF (jte .GT. jde - 1) THEN j_end = jde - 1 ELSE j_end = jte END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (ids + 1 .LT. its) THEN i_start = its ELSE i_start = ids + 1 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (ide - 1 .GT. ite) THEN i_end = ite ELSE i_end = ide - 1 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (jds + 1 .LT. jts) THEN j_start = jts ELSE j_start = jds + 1 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (jde - 2 .GT. jte) THEN j_end = jte ELSE j_end = jde - 2 END IF END IF IF (config_flags%periodic_x) i_start = its IF (config_flags%periodic_x) i_end = ite DO j=j_start,j_end DO k=kts,ktf DO i=i_start,i_end lvard(i, k, j) = lvard(i, k, j) + 0.5*(rvard(i, k, j)+rvard(i-1& & , k, j)) lvar(i, k, j) = lvar(i, k, j) + 0.5*(rvar(i, k, j)+rvar(i-1, k, & & j)) END DO END DO END DO END SUBROUTINE G_ADD_A2C_U ! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.5 (r3785) - 22 Mar 2011 18:35 ! ! Differentiation of add_a2c_v in forward (tangent) mode: ! variations of useful results: lvar ! with respect to varying inputs: lvar rvar ! RW status of diff variables: lvar:in-out rvar:in SUBROUTINE G_ADD_A2C_V(lvar, lvard, rvar, rvard, config_flags, ids, ide& & , jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte& & , kts, kte) IMPLICIT NONE !------------------------------------------------------------ TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, & & jme, kms, kme, its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard ! LOCAL VARS INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf INTRINSIC MAX INTRINSIC MIN IF (kte .GT. kde - 1) THEN ktf = kde - 1 ELSE ktf = kte END IF i_start = its IF (ite .GT. ide - 1) THEN i_end = ide - 1 ELSE i_end = ite END IF j_start = jts j_end = jte IF (config_flags%specified .OR. config_flags%nested) THEN IF (ids + 1 .LT. its) THEN i_start = its ELSE i_start = ids + 1 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (ide - 2 .GT. ite) THEN i_end = ite ELSE i_end = ide - 2 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (jds + 1 .LT. jts) THEN j_start = jts ELSE j_start = jds + 1 END IF END IF IF (config_flags%specified .OR. config_flags%nested) THEN IF (jde - 1 .GT. jte) THEN j_end = jte ELSE j_end = jde - 1 END IF END IF IF (config_flags%periodic_x) i_start = its IF (config_flags%periodic_x) THEN IF (ite .GT. ide - 1) THEN i_end = ide - 1 ELSE i_end = ite END IF END IF DO j=j_start,j_end DO k=kts,kte DO i=i_start,i_end lvard(i, k, j) = lvard(i, k, j) + 0.5*(rvard(i, k, j)+rvard(i, k& & , j-1)) lvar(i, k, j) = lvar(i, k, j) + 0.5*(rvar(i, k, j)+rvar(i, k, j-& & 1)) END DO END DO END DO END SUBROUTINE G_ADD_A2C_V !------------------------------------------------------------ SUBROUTINE add_c2c_u(lvar,rvar,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------ !------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------ TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::& rvar REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::& lvar ! LOCAL VARS INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf ktf=min(kte,kde-1) i_start = its i_end = ite j_start = jts j_end = MIN(jte,jde-1) IF ( config_flags%specified .or. & config_flags%nested) i_start = MAX(ids+1,its) IF ( config_flags%specified .or. & config_flags%nested) i_end = MIN(ide-1,ite) IF ( config_flags%specified .or. & config_flags%nested) j_start = MAX(jds+1,jts) IF ( config_flags%specified .or. & config_flags%nested) j_end = MIN(jde-2,jte) ! write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end DO j = j_start,j_end DO k = kts,ktf DO i = i_start,i_end lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j) ENDDO ENDDO ENDDO END SUBROUTINE add_c2c_u SUBROUTINE add_c2c_v(lvar,rvar,config_flags, & ids,ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------ !------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------ TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN ) ::& rvar REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::& lvar ! LOCAL VARS INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf ktf=min(kte,kde-1) i_start = its i_end = MIN(ite,ide-1) j_start = jts j_end = jte IF ( config_flags%specified .or. & config_flags%nested) i_start = MAX(ids+1,its) IF ( config_flags%specified .or. & config_flags%nested) i_end = MIN(ide-2,ite) IF ( config_flags%specified .or. & config_flags%nested) j_start = MAX(jds+1,jts) IF ( config_flags%specified .or. & config_flags%nested) j_end = MIN(jde-1,jte) ! write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end DO j = j_start,j_end DO k = kts,kte DO i = i_start,i_end lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j) ENDDO ENDDO ENDDO END SUBROUTINE add_c2c_v #endif END MODULE g_module_physics_addtendc