diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 61b68ecabd..ebca24606a 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -5193,19 +5193,19 @@ Interpolate ana fields to constant pressure surfaces Default: FALSE - - template for analysis forcing dataset. -Default: set by build-namelist. +Default: none - templatefull path for analysis forcing dataset. -Default: set by build-namelist. +Default: none + Force scam to compute large-scale forcing from renalysis or 3D model output diff --git a/src/chemistry/mozart/upper_bc.F90 b/src/chemistry/mozart/upper_bc.F90 index 71a4a65b0c..7794ef9f76 100644 --- a/src/chemistry/mozart/upper_bc.F90 +++ b/src/chemistry/mozart/upper_bc.F90 @@ -1,4 +1,3 @@ - module upper_bc !--------------------------------------------------------------------------------- @@ -157,11 +156,16 @@ subroutine ubc_init() use mo_snoe, only: snoe_inti use mo_msis_ubc, only: msis_ubc_inti use constituents,only: cnst_get_ind + use scamMod,only: single_column !---------------------------Local workspace----------------------------- logical :: zonal_avg !----------------------------------------------------------------------- - apply_upper_bc = ptop_ref<1._r8 ! Pa + if ( .not.(single_column) ) then + apply_upper_bc = ptop_ref<1._r8 ! Pa + else + apply_upper_bc = .FALSE. ! Always false for HiTop SCAM config + end if if (.not.apply_upper_bc) return diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index a90d806284..0df724938d 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -90,6 +90,8 @@ module cam_diagnostics integer :: kvh_idx = 0 integer :: cush_idx = 0 integer :: t_ttend_idx = 0 +integer :: t_utend_idx = 0 +integer :: t_vtend_idx = 0 integer :: prec_dp_idx = 0 integer :: snow_dp_idx = 0 @@ -150,6 +152,8 @@ subroutine diag_register_dry() ! Request physics buffer space for fields that persist across timesteps. call pbuf_add_field('T_TTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_ttend_idx) + call pbuf_add_field('T_UTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_utend_idx) + call pbuf_add_field('T_VTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_vtend_idx) end subroutine diag_register_dry subroutine diag_register_moist() @@ -195,6 +199,8 @@ subroutine diag_init_dry(pbuf2d) ! State before physics call addfld ('TBP', (/ 'lev' /), 'A','K', 'Temperature (before physics)') + call addfld ('UBP', (/ 'lev' /), 'A','m/s2', 'Zonal wind (before physics)') + call addfld ('VBP', (/ 'lev' /), 'A','m/s2', 'Meridional Wind (before physics)') call addfld (bpcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (before physics)') ! State after physics call addfld ('TAP', (/ 'lev' /), 'A','K', 'Temperature (after physics)' ) @@ -208,7 +214,11 @@ subroutine diag_init_dry(pbuf2d) call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)') end if call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency') - + + call addfld ('UTEND_TOT', (/ 'lev' /), 'A', 'm/s2', 'Total zonal wind tendency') + call addfld ('VTEND_TOT', (/ 'lev' /), 'A', 'm/s2', 'Total meridional wind tendency') + call register_vector_field('UTEND_TOT','VTEND_TOT') + ! Debugging negative water output fields call addfld ('INEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice tendency due to clipping neg values after microp') call addfld ('LNEGCLPTEND ', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud liq tendency due to clipping neg values after microp') @@ -330,9 +340,13 @@ subroutine diag_init_dry(pbuf2d) call add_default ('U ' , history_budget_histfile_num, ' ') call add_default ('V ' , history_budget_histfile_num, ' ') call add_default ('TTEND_TOT' , history_budget_histfile_num, ' ') + call add_default ('UTEND_TOT' , history_budget_histfile_num, ' ') + call add_default ('VTEND_TOT' , history_budget_histfile_num, ' ') ! State before physics (FV) call add_default ('TBP ' , history_budget_histfile_num, ' ') + call add_default ('UBP ' , history_budget_histfile_num, ' ') + call add_default ('VBP ' , history_budget_histfile_num, ' ') call add_default (bpcnst(1) , history_budget_histfile_num, ' ') ! State after physics (FV) call add_default ('TAP ' , history_budget_histfile_num, ' ') @@ -351,9 +365,73 @@ subroutine diag_init_dry(pbuf2d) end if ! outfld calls in diag_phys_tend_writeout - call addfld ('PTTEND', (/ 'lev' /), 'A', 'K/s','T total physics tendency' ) + call addfld ('PTTEND', (/ 'lev' /), 'A', 'K/s','T total physics tendency') + call addfld ('UTEND_PHYSTOT', (/ 'lev' /), 'A', 'm/s2','U total physics tendency') + call addfld ('VTEND_PHYSTOT', (/ 'lev' /), 'A', 'm/s2','V total physics tendency') + call register_vector_field('UTEND_PHYSTOT','VTEND_PHYSTOT') if ( history_budget ) then call add_default ('PTTEND' , history_budget_histfile_num, ' ') + call add_default ('UTEND_PHYSTOT' , history_budget_histfile_num, ' ') + call add_default ('VTEND_PHYSTOT' , history_budget_histfile_num, ' ') + end if + + ! outfld calls in physpkg +!++jtb + call addfld('UTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Zonal wind tendency due to dynamical core') + call addfld('VTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Meridional wind tendency due to dynamical core') + call register_vector_field('UTEND_CORE','VTEND_CORE') +!--jtb + call addfld ( 'UTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by deep convection') + call addfld ( 'VTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by deep convection') + call register_vector_field ( 'UTEND_DCONV', 'VTEND_DCONV') + call addfld ( 'UTEND_SHCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by shallow convection') + call addfld ( 'VTEND_SHCONV', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by shallow convection') + call register_vector_field ( 'UTEND_SHCONV', 'VTEND_SHCONV') + call addfld ( 'UTEND_MACROP', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by macrophysics') + call addfld ( 'VTEND_MACROP', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by macrophysics') + call register_vector_field ( 'UTEND_MACROP', 'VTEND_MACROP') + call addfld ( 'UTEND_VDIFF', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by vert. diffus.') + call addfld ( 'VTEND_VDIFF', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by vert. diffus.') + call register_vector_field ( 'UTEND_VDIFF', 'VTEND_VDIFF') + call addfld ( 'UTEND_RAYLEIGH', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by Rayleigh Fric.') + call addfld ( 'VTEND_RAYLEIGH', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by Rayleigh Fric.') + call register_vector_field ( 'UTEND_RAYLEIGH', 'VTEND_RAYLEIGH') + call addfld ( 'UTEND_GWDTOT', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by all GWs') + call addfld ( 'VTEND_GWDTOT', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by all GWs') + call register_vector_field ( 'UTEND_GWDTOT', 'VTEND_GWDTOT') + call addfld ( 'UTEND_QBORLX', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by QBO relaxation') + call addfld ( 'VTEND_QBORLX', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by QBO relaxation') + call register_vector_field ( 'UTEND_QBORLX', 'VTEND_QBORLX') + call addfld ( 'UTEND_LUNART', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by lunar tides') + call addfld ( 'VTEND_LUNART', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by lunar tides') + call register_vector_field ( 'UTEND_LUNART', 'VTEND_LUNART') + call addfld ( 'UTEND_IONDRG', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by ion drag') + call addfld ( 'VTEND_IONDRG', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by ion drag') + call register_vector_field ( 'UTEND_IONDRG', 'VTEND_IONDRG') + call addfld ( 'UTEND_NDG', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by nudging') + call addfld ( 'VTEND_NDG', (/ 'lev' /), 'A', 'm/s2', 'Meridional wind tendency by nudging') + call register_vector_field ( 'UTEND_NDG', 'VTEND_NDG') + if ( history_budget ) then + call add_default ( 'UTEND_DCONV' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_DCONV' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_SHCONV' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_SHCONV' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_MACROP' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_MACROP' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_VDIFF' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_VDIFF' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_RAYLEIGH' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_RAYLEIGH' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_GWDTOT' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_GWDTOT' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_QBORLX' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_QBORLX' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_LUNART' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_LUNART' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_IONDRG' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_IONDRG' , history_budget_histfile_num, ' ') + call add_default ( 'UTEND_NDG' , history_budget_histfile_num, ' ') + call add_default ( 'VTEND_NDG' , history_budget_histfile_num, ' ') end if ! create history variables for fourier coefficients of the diurnal @@ -613,6 +691,8 @@ subroutine diag_init_moist(pbuf2d) if ( history_budget ) then call add_default (cnst_name(1), history_budget_histfile_num, ' ') call add_default ('PTTEND' , history_budget_histfile_num, ' ') + call add_default ('UTEND_PHYSTOT' , history_budget_histfile_num, ' ') + call add_default ('VTEND_PHYSTOT' , history_budget_histfile_num, ' ') call add_default (ptendnam( 1), history_budget_histfile_num, ' ') if (ixcldliq > 0) then call add_default (ptendnam(ixcldliq), history_budget_histfile_num, ' ') @@ -862,6 +942,8 @@ subroutine diag_conv_tend_ini(state,pbuf) integer :: i, k, m, lchnk, ncol real(r8), pointer, dimension(:,:) :: t_ttend + real(r8), pointer, dimension(:,:) :: t_utend + real(r8), pointer, dimension(:,:) :: t_vtend lchnk = state%lchnk ncol = state%ncol @@ -885,6 +967,10 @@ subroutine diag_conv_tend_ini(state,pbuf) do m = 1, dyn_time_lvls call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,m/), kount=(/pcols,pver,1/)) t_ttend(:ncol,:) = state%t(:ncol,:) + call pbuf_get_field(pbuf, t_utend_idx, t_utend, start=(/1,1,m/), kount=(/pcols,pver,1/)) + t_utend(:ncol,:) = state%u(:ncol,:) + call pbuf_get_field(pbuf, t_vtend_idx, t_vtend, start=(/1,1,m/), kount=(/pcols,pver,1/)) + t_vtend(:ncol,:) = state%v(:ncol,:) end do end if @@ -2018,6 +2104,8 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) real(r8) :: heat_glob ! global energy integral (FV only) ! CAM pointers to get variables from the physics buffer real(r8), pointer, dimension(:,:) :: t_ttend + real(r8), pointer, dimension(:,:) :: t_utend + real(r8), pointer, dimension(:,:) :: t_vtend integer :: itim_old,m !----------------------------------------------------------------------- @@ -2043,19 +2131,31 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt) ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) end if call outfld('PTTEND',ftem3, pcols, lchnk ) + ftem3(:ncol,:pver) = tend%dudt(:ncol,:pver) + call outfld('UTEND_PHYSTOT',ftem3, pcols, lchnk ) + ftem3(:ncol,:pver) = tend%dvdt(:ncol,:pver) + call outfld('VTEND_PHYSTOT',ftem3, pcols, lchnk ) ! Total (physics+dynamics, everything!) tendency for Temperature !! get temperature stored in physics buffer itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, t_utend_idx, t_utend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) + call pbuf_get_field(pbuf, t_vtend_idx, t_vtend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/)) !! calculate and outfld the total temperature tendency ftem3(:ncol,:) = (state%t(:ncol,:) - t_ttend(:ncol,:))/ztodt call outfld('TTEND_TOT', ftem3, pcols, lchnk) + ftem3(:ncol,:) = (state%u(:ncol,:) - t_utend(:ncol,:))/ztodt + call outfld('UTEND_TOT', ftem3, pcols, lchnk) + ftem3(:ncol,:) = (state%v(:ncol,:) - t_vtend(:ncol,:))/ztodt + call outfld('VTEND_TOT', ftem3, pcols, lchnk) !! update physics buffer with this time-step's temperature t_ttend(:ncol,:) = state%t(:ncol,:) + t_utend(:ncol,:) = state%u(:ncol,:) + t_vtend(:ncol,:) = state%v(:ncol,:) end subroutine diag_phys_tend_writeout_dry @@ -2220,6 +2320,8 @@ subroutine diag_state_b4_phys_write_dry (state) lchnk = state%lchnk call outfld('TBP', state%t, pcols, lchnk ) + call outfld('UBP', state%u, pcols, lchnk ) + call outfld('VBP', state%v, pcols, lchnk ) end subroutine diag_state_b4_phys_write_dry diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 2260792315..bb124c576e 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -1,4 +1,3 @@ - module check_energy !--------------------------------------------------------------------------------- @@ -66,6 +65,8 @@ module check_energy integer :: teout_idx = 0 ! teout index in physics buffer integer :: dtcore_idx = 0 ! dtcore index in physics buffer + integer :: ducore_idx = 0 ! ducore index in physics buffer + integer :: dvcore_idx = 0 ! dvcore index in physics buffer type check_tracers_data real(r8) :: tracer(pcols,pcnst) ! initial vertically integrated total (kinetic + static) energy @@ -137,9 +138,13 @@ subroutine check_energy_register() call pbuf_add_field('TEOUT', 'global',dtype_r8 , (/pcols,dyn_time_lvls/), teout_idx) call pbuf_add_field('DTCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dtcore_idx) + call pbuf_add_field('DUCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),ducore_idx) + call pbuf_add_field('DVCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dvcore_idx) if(is_subcol_on()) then call pbuf_register_subcol('TEOUT', 'phys_register', teout_idx) call pbuf_register_subcol('DTCORE', 'phys_register', dtcore_idx) + call pbuf_register_subcol('DUCORE', 'phys_register', ducore_idx) + call pbuf_register_subcol('DVCORE', 'phys_register', dvcore_idx) end if end subroutine check_energy_register @@ -173,7 +178,7 @@ subroutine check_energy_init() ! Initialize the energy conservation module ! !----------------------------------------------------------------------- - use cam_history, only: addfld, add_default, horiz_only + use cam_history, only: addfld, add_default, horiz_only, register_vector_field use phys_control, only: phys_getopts implicit none @@ -193,12 +198,19 @@ subroutine check_energy_init() call addfld('TEFIX', horiz_only, 'A', 'J/m2', 'Total energy after fixer') call addfld('EFIX', horiz_only, 'A', 'W/m2', 'Effective sensible heat flux due to energy fixer') call addfld('DTCORE', (/ 'lev' /), 'A', 'K/s' , 'T tendency due to dynamical core') + call addfld('DUCORE', (/ 'lev' /), 'A', 'm/s2' , 'U tendency due to dynamical core') + call addfld('DVCORE', (/ 'lev' /), 'A', 'm/s2' , 'V tendency due to dynamical core') + call register_vector_field('DUCORE','DVCORE') if ( history_budget ) then call add_default ('DTCORE', history_budget_histfile_num, ' ') + call add_default ('DUCORE', history_budget_histfile_num, ' ') + call add_default ('DVCORE', history_budget_histfile_num, ' ') end if if ( history_waccm ) then call add_default ('DTCORE', 1, ' ') + call add_default ('DUCORE', 1, ' ') + call add_default ('DVCORE', 1, ' ') end if end subroutine check_energy_init diff --git a/src/physics/cam/gw_drag.F90 b/src/physics/cam/gw_drag.F90 index ba381f48ef..e39db52e40 100644 --- a/src/physics/cam/gw_drag.F90 +++ b/src/physics/cam/gw_drag.F90 @@ -234,7 +234,8 @@ subroutine gw_drag_readnl(nlfile) gw_lndscl_sgh, gw_prndl, gw_apply_tndmax, gw_qbo_hdepth_scaling, & gw_top_taper !---------------------------------------------------------------------- - + ! Gratuitous mod to learn git Dec 2021 + !---------------------------------------------------------------------- if (use_simple_phys) return if (masterproc) then diff --git a/src/physics/cam/nudging.F90 b/src/physics/cam/nudging.F90 index 20b3789f68..274e8b7f22 100644 --- a/src/physics/cam/nudging.F90 +++ b/src/physics/cam/nudging.F90 @@ -1,5 +1,20 @@ +#if PCOLS=1 +#define SCAMRUN +#else +#undef SCAMRUN +#endif module nudging +!++jtb +!===================================================================== +! Don't like using #define to control nudging with SCAM +! but haven't figured out better way given that some variables +! need to be (are) dimensioned differently when single column +! is being run. (12/11/21) +! +! Using PCOLS=1 to key off of may be an interim solution, and this +! is interim code anyway (12/12/21) !===================================================================== +!--jtb ! ! Purpose: Implement Nudging of the model state of U,V,T,Q, and/or PS ! toward specified values from analyses. @@ -200,6 +215,7 @@ module nudging use cam_abortutils, only:endrun use spmd_utils , only:masterproc use cam_logfile , only:iulog + use scamMod, only:single_column #ifdef SPMD use mpishorthand #endif @@ -208,8 +224,13 @@ module nudging ! and then explicitly set their exposure. !---------------------------------------------------------- implicit none + + + + private + public:: Nudge_Model,Nudge_ON public:: nudging_readnl public:: nudging_init @@ -312,6 +333,15 @@ module nudging real(r8),allocatable::Nobs_Q (:,:,:,:) !(pcols,pver,begchunk:endchunk,Nudge_NumObs) real(r8),allocatable::Nobs_PS(:,:,:) !(pcols,begchunk:endchunk,Nudge_NumObs) +!++jtb +! Put these in pre-amble so +! so they can be calculated +! once and remembered +#ifdef SCAMRUN + real(r8) :: scam_lat, scam_lon +#endif +!--jtb + contains !================================================================ subroutine nudging_readnl(nlfile) @@ -557,7 +587,7 @@ subroutine nudging_init integer istat,lchnk,ncol,icol,ilev integer hdim1_d,hdim2_d integer dtime - real(r8) rlat,rlon + real(r8) rlat,rlon real(r8) Wprof(pver) real(r8) lonp,lon0,lonn,latp,lat0,latn real(r8) Val1_p,Val2_p,Val3_p,Val4_p @@ -659,6 +689,8 @@ subroutine nudging_init Model_Step=Nudge_Step endif +!++jtb +#ifndef SCAMRUN ! Initialize column and level dimensions !-------------------------------------------------------- call get_horiz_grid_dim_d(hdim1_d,hdim2_d) @@ -666,6 +698,18 @@ subroutine nudging_init Nudge_nlat=hdim2_d Nudge_ncol=hdim1_d*hdim2_d Nudge_nlev=pver +#else + ! Hard wired for now to FV 0.9x1.25-32L + ! (288 x 192 x 32 ) + ! Really really needs to be generalized + ! in a sensible way!! + Nudge_nlon=288 + Nudge_nlat=192 + Nudge_ncol=Nudge_nlat*Nudge_nlon + Nudge_nlev= pver ! 70 ! 32 + +#endif +!--jtb ! Check the time relative to the nudging window !------------------------------------------------ @@ -771,6 +815,9 @@ subroutine nudging_init !-------------------------- Nudge_Initialized=.true. + +!++jtb +#ifndef SCAMRUN ! Check that this is a valid DYCORE model !------------------------------------------ if((.not.dycore_is('UNSTRUCTURED')).and. & @@ -778,6 +825,10 @@ subroutine nudging_init (.not.dycore_is('LR') ) ) then call endrun('NUDGING IS CURRENTLY ONLY CONFIGURED FOR CAM-SE, FV, or EUL') endif +#else + write(iulog,*) ' Running Single-Column case' +#endif +!--jtb ! Informational Output !--------------------------- @@ -922,6 +973,8 @@ subroutine nudging_init write(iulog,*) 'NUDGING: Reading analyses:',trim(Nudge_Path)//trim(Nudge_File) endif +!++jtb +#ifndef SCAMRUN ! Rotate Nudge_ObsInd() indices for new data, then update ! the Nudge observation arrays with analysis data at the ! NEXT==Nudge_ObsInd(1) time. @@ -933,6 +986,16 @@ subroutine nudging_init else !if(dycore_is('LR')) then call nudging_update_analyses_fv (trim(Nudge_Path)//trim(Nudge_File)) endif +#else + lchnk=begchunk + icol=get_ncols_p(lchnk) + if ((icol /= 1).OR.(begchunk /= endchunk)) call endrun( "Not a Single Column run") + scam_lat=get_rlat_p(lchnk,icol)*180._r8/SHR_CONST_PI + scam_lon=get_rlon_p(lchnk,icol)*180._r8/SHR_CONST_PI + call nudging_update_analyses_fv (trim(Nudge_Path)//trim(Nudge_File) , scam_lon=scam_lon, scam_lat=scam_lat) +#endif +!--jtb + ! Initialize Nudging Coeffcient profiles in local arrays ! Load zeros into nudging arrays @@ -953,6 +1016,7 @@ subroutine nudging_init Nudge_Qtau(icol,:,lchnk)=Wprof(:) Nudge_PStau(icol,lchnk)=nudging_set_PSprofile(rlat,rlon,Nudge_PSprof) + end do Nudge_Utau(:ncol,:pver,lchnk) = & Nudge_Utau(:ncol,:pver,lchnk) * Nudge_Ucoef/float(Nudge_Step) @@ -1159,6 +1223,8 @@ subroutine nudging_timestep_init(phys_state) ! the Nudge observation arrays with analysis data at the ! NEXT==Nudge_ObsInd(1) time. !---------------------------------------------------------- +!++jtb +#ifndef SCAMRUN if(dycore_is('UNSTRUCTURED')) then call nudging_update_analyses_se (trim(Nudge_Path)//trim(Nudge_File)) elseif(dycore_is('EUL')) then @@ -1166,6 +1232,12 @@ subroutine nudging_timestep_init(phys_state) else !if(dycore_is('LR')) then call nudging_update_analyses_fv (trim(Nudge_Path)//trim(Nudge_File)) endif +#else + write(iulog,*) "reading FV grid in SCAM" + write(iulog,*) "SCAM Lat Lon: ",scam_lat, scam_lon + call nudging_update_analyses_fv (trim(Nudge_Path)//trim(Nudge_File) , scam_lon=scam_lon, scam_lat=scam_lat ) +#endif +!--jtb endif ! ((Before_End).and.(Update_Nudge)) then !---------------------------------------------------------------- @@ -1358,6 +1430,7 @@ subroutine nudging_timestep_tend(phys_state,phys_tend) lq(indw)=.true. call physics_ptend_init(phys_tend,phys_state%psetcols,'nudging',lu=.true.,lv=.true.,ls=.true.,lq=lq) + if(Nudge_ON) then lchnk=phys_state%lchnk ncol =phys_state%ncol @@ -1701,12 +1774,18 @@ subroutine nudging_update_analyses_eul(anal_file) call endrun ('UPDATE_ANALYSES_EUL') endif +!++jtb +#ifndef SCAMRUN if((Nudge_nlon.ne.nlon).or.(Nudge_nlat.ne.nlat).or.(plev.ne.pver)) then write(iulog,*) 'ERROR: nudging_update_analyses_eul: nlon=',nlon,' Nudge_nlon=',Nudge_nlon write(iulog,*) 'ERROR: nudging_update_analyses_eul: nlat=',nlat,' Nudge_nlat=',Nudge_nlat write(iulog,*) 'ERROR: nudging_update_analyses_eul: plev=',plev,' pver=',pver call endrun('nudging_update_analyses_eul: analyses dimension mismatch') endif +#else + write( * , *) " SCAM run , dont worry about analysis vs model grid " +#endif +!--jtb ! Read in, transpose lat/lev indices, ! and scatter data arrays @@ -1829,7 +1908,7 @@ subroutine nudging_update_analyses_eul(anal_file) !================================================================ - subroutine nudging_update_analyses_fv(anal_file) + subroutine nudging_update_analyses_fv(anal_file , scam_lon , scam_lat ) ! ! NUDGING_UPDATE_ANALYSES_FV: ! Open the given analyses data file, read in @@ -1838,10 +1917,13 @@ subroutine nudging_update_analyses_fv(anal_file) !=============================================================== use ppgrid ,only: pver,begchunk use netcdf - + ! Arguments !------------- character(len=*),intent(in):: anal_file +!++jtb ; SCAMRUN + real(r8), intent(in), optional :: scam_lon,scam_lat +!--jtb ! Local values !------------- @@ -1851,11 +1933,21 @@ subroutine nudging_update_analyses_fv(anal_file) integer ilat,ilon,ilev real(r8) Xanal(Nudge_nlon,Nudge_nlat,Nudge_nlev) real(r8) PSanal(Nudge_nlon,Nudge_nlat) + real(r8) PHISanal(Nudge_nlon,Nudge_nlat) real(r8) Lat_anal(Nudge_nlat) real(r8) Lon_anal(Nudge_nlon) + real(r8) rlon,rlat +!++jtb +#ifndef SCAMRUN real(r8) Xtrans(Nudge_nlon,Nudge_nlev,Nudge_nlat) +#else + real(r8) Xtrans(Nudge_nlev) + integer iscam_lat(1),iscam_lon(1) +#endif +!--jtb integer nn,Nindex + ! Rotate Nudge_ObsInd() indices, then check the existence of the analyses ! file; broadcast the updated indices and file status to all the other MPI nodes. ! If the file is not there, then just return. @@ -1956,6 +2048,8 @@ subroutine nudging_update_analyses_fv(anal_file) ! Read in, transpose lat/lev indices, ! and scatter data arrays !---------------------------------- + ! First block reads and scatters U + !---------------------------------- istat=nf90_inq_varid(ncid,'U',varid) if(istat.ne.NF90_NOERR) then write(iulog,*) nf90_strerror(istat) @@ -1966,16 +2060,30 @@ subroutine nudging_update_analyses_fv(anal_file) write(iulog,*) nf90_strerror(istat) call endrun ('UPDATE_ANALYSES_FV') endif + !!write(*,*) " ----in- it !!! " +#ifndef SCAMRUN do ilat=1,nlat do ilev=1,plev do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) + Xtrans(ilon,ilev,ilat)= Xanal(ilon,ilat,ilev) end do end do end do +#else + write(iulog,*) 'SCAM lon lat in nudging_update_analyses_fv: ' + write(iulog,*) scam_lon, scam_lat + iscam_lon = MINLOC( ABS( LON_Anal - SCAM_lon ) ) + iscam_lat = MINLOC( ABS( LAT_Anal - SCAM_lat ) ) + Xtrans = Xanal( iscam_lon(1), iscam_lat(1), : ) +#endif endif ! (masterproc) then +#ifndef SCAMRUN call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & Nobs_U(1,1,begchunk,Nudge_ObsInd(1))) +#else + call scatter_field_to_chunk(1, Nudge_nlev, 1, 1 ,Xtrans, & + Nobs_U(1,1,begchunk,Nudge_ObsInd(1))) +#endif if(masterproc) then istat=nf90_inq_varid(ncid,'V',varid) @@ -1988,16 +2096,25 @@ subroutine nudging_update_analyses_fv(anal_file) write(iulog,*) nf90_strerror(istat) call endrun ('UPDATE_ANALYSES_FV') endif +#ifndef SCAMRUN do ilat=1,nlat do ilev=1,plev do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) + Xtrans(ilon,ilev,ilat)= Xanal(ilon,ilat,ilev) end do end do end do +#else + Xtrans = Xanal( iscam_lon(1), iscam_lat(1), : ) +#endif endif ! (masterproc) then +#ifndef SCAMRUN call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & Nobs_V(1,1,begchunk,Nudge_ObsInd(1))) +#else + call scatter_field_to_chunk(1, Nudge_nlev, 1, 1 ,Xtrans, & + Nobs_V(1,1,begchunk,Nudge_ObsInd(1))) +#endif if(masterproc) then istat=nf90_inq_varid(ncid,'T',varid) @@ -2010,16 +2127,25 @@ subroutine nudging_update_analyses_fv(anal_file) write(iulog,*) nf90_strerror(istat) call endrun ('UPDATE_ANALYSES_FV') endif +#ifndef SCAMRUN do ilat=1,nlat do ilev=1,plev do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) + Xtrans(ilon,ilev,ilat)= Xanal(ilon,ilat,ilev) end do end do end do +#else + Xtrans = Xanal( iscam_lon(1), iscam_lat(1), : ) +#endif endif ! (masterproc) then +#ifndef SCAMRUN call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & Nobs_T(1,1,begchunk,Nudge_ObsInd(1))) +#else + call scatter_field_to_chunk(1, Nudge_nlev, 1, 1 ,Xtrans, & + Nobs_T(1,1,begchunk,Nudge_ObsInd(1))) +#endif if(masterproc) then istat=nf90_inq_varid(ncid,'Q',varid) @@ -2032,16 +2158,25 @@ subroutine nudging_update_analyses_fv(anal_file) write(iulog,*) nf90_strerror(istat) call endrun ('UPDATE_ANALYSES_FV') endif +#ifndef SCAMRUN do ilat=1,nlat do ilev=1,plev do ilon=1,nlon - Xtrans(ilon,ilev,ilat)=Xanal(ilon,ilat,ilev) + Xtrans(ilon,ilev,ilat)= Xanal(ilon,ilat,ilev) end do end do end do +#else + Xtrans = Xanal( iscam_lon(1), iscam_lat(1), : ) +#endif endif ! (masterproc) then +#ifndef SCAMRUN call scatter_field_to_chunk(1,Nudge_nlev,1,Nudge_nlon,Xtrans, & Nobs_Q(1,1,begchunk,Nudge_ObsInd(1))) +#else + call scatter_field_to_chunk(1, Nudge_nlev, 1, 1 ,Xtrans, & + Nobs_Q(1,1,begchunk,Nudge_ObsInd(1))) +#endif if(masterproc) then istat=nf90_inq_varid(ncid,'PS',varid) @@ -2055,17 +2190,38 @@ subroutine nudging_update_analyses_fv(anal_file) call endrun ('UPDATE_ANALYSES_SE') endif + ! Close the analyses file + !----------------------- + !istat=nf90_close(ncid) + !if(istat.ne.NF90_NOERR) then + ! write(iulog,*) nf90_strerror(istat) + ! call endrun ('UPDATE_ANALYSES_EUL') + !endif + endif ! (masterproc) then +#ifndef SCAMRUN + call scatter_field_to_chunk(1,1,1,Nudge_nlon,PSanal, & + Nobs_PS(1,begchunk,Nudge_ObsInd(1))) +#else + call scatter_field_to_chunk(1,1,1,1,PSanal(iscam_lon(1), iscam_lat(1) ), & + Nobs_PS(1,begchunk,Nudge_ObsInd(1))) +#endif + + + if(masterproc) then ! Close the analyses file !----------------------- istat=nf90_close(ncid) if(istat.ne.NF90_NOERR) then write(iulog,*) nf90_strerror(istat) - call endrun ('UPDATE_ANALYSES_EUL') + call endrun ('UPDATE_ANALYSES_FV') endif - endif ! (masterproc) then - call scatter_field_to_chunk(1,1,1,Nudge_nlon,PSanal, & - Nobs_PS(1,begchunk,Nudge_ObsInd(1))) + end if + + +#ifdef SCAMRUN + write(*,*) " Finished in nudging_update_analyses_fv " +#endif ! End Routine !------------ return diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 6fd44897f3..86f2addd7f 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -1286,7 +1286,7 @@ subroutine tphysac (ztodt, cam_in, & use perf_mod use flux_avg, only: flux_avg_run use unicon_cam, only: unicon_cam_org_diags - use cam_history, only: hist_fld_active + use cam_history, only: hist_fld_active, outfld use qneg_module, only: qneg4 use co2_cycle, only: co2_cycle_set_ptend use nudging, only: Nudge_Model,Nudge_ON,nudging_timestep_tend @@ -1345,6 +1345,8 @@ subroutine tphysac (ztodt, cam_in, & real(r8), pointer, dimension(:,:) :: cldliqini real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore + real(r8), pointer, dimension(:,:) :: ducore + real(r8), pointer, dimension(:,:) :: dvcore real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction !----------------------------------------------------------------------- @@ -1369,6 +1371,10 @@ subroutine tphysac (ztodt, cam_in, & ifld = pbuf_get_index('DTCORE') call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + ifld = pbuf_get_index('DUCORE') + call pbuf_get_field(pbuf, ifld, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + ifld = pbuf_get_index('DVCORE') + call pbuf_get_field(pbuf, ifld, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) call pbuf_get_field(pbuf, qini_idx, qini) call pbuf_get_field(pbuf, cldliqini_idx, cldliqini) @@ -1521,6 +1527,10 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_VDIFF', ptend%u, pcols, lchnk) + call outfld( 'VTEND_VDIFF', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "vertical_diffusion_section") then @@ -1535,6 +1545,10 @@ subroutine tphysac (ztodt, cam_in, & !=================================================== call t_startf('rayleigh_friction') call rayleigh_friction_tend( ztodt, state, ptend) + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_RAYLEIGH', ptend%u, pcols, lchnk) + call outfld( 'VTEND_RAYLEIGH', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) call t_stopf('rayleigh_friction') @@ -1607,6 +1621,10 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_GWDTOT', ptend%u, pcols, lchnk) + call outfld( 'VTEND_GWDTOT', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "gw_tend") then @@ -1631,6 +1649,10 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_QBORLX', ptend%u, pcols, lchnk) + call outfld( 'VTEND_QBORLX', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "qbo_relax") then @@ -1643,6 +1665,10 @@ subroutine tphysac (ztodt, cam_in, & ! Lunar tides call lunar_tides_tend( state, ptend ) + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_LUNART', ptend%u, pcols, lchnk) + call outfld( 'VTEND_LUNART', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) ! Check energy integrals call check_energy_chng(state, tend, "lunar_tides", nstep, ztodt, zero, zero, zero, zero) @@ -1671,6 +1697,10 @@ subroutine tphysac (ztodt, cam_in, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_IONDRG', ptend%u, pcols, lchnk) + call outfld( 'VTEND_IONDRG', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "iondrag_calc_section") then @@ -1696,6 +1726,10 @@ subroutine tphysac (ztodt, cam_in, & !---------------------------------- if((Nudge_Model).and.(Nudge_ON)) then call nudging_timestep_tend(state,ptend) + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_NDG', ptend%u, pcols, lchnk) + call outfld( 'VTEND_NDG', ptend%v, pcols, lchnk) + end if call physics_update(state,ptend,ztodt,tend) call check_energy_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero) endif @@ -1789,6 +1823,8 @@ subroutine tphysac (ztodt, cam_in, & ! store T in buffer for use in computing dynamics T-tendency in next timestep do k = 1,pver dtcore(:ncol,k) = state%t(:ncol,k) + ducore(:ncol,k) = state%u(:ncol,k) + dvcore(:ncol,k) = state%v(:ncol,k) end do !-------------- Energy budget checks ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ @@ -1907,6 +1943,7 @@ subroutine tphysbc (ztodt, state, & ! type(physics_ptend) :: ptend ! indivdual parameterization tendencies + type(physics_ptend) :: ptend_macp_all ! sum of macrophysics tendencies (e.g. CLUBB) over substeps type(physics_state) :: state_sc ! state for sub-columns type(physics_ptend) :: ptend_sc ! ptend for sub-columns type(physics_ptend) :: ptend_aero ! ptend for microp_aero @@ -1946,6 +1983,8 @@ subroutine tphysbc (ztodt, state, & real(r8), pointer, dimension(:,:) :: cldliqini real(r8), pointer, dimension(:,:) :: cldiceini real(r8), pointer, dimension(:,:) :: dtcore + real(r8), pointer, dimension(:,:) :: ducore + real(r8), pointer, dimension(:,:) :: dvcore real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble @@ -2025,6 +2064,10 @@ subroutine tphysbc (ztodt, state, & ifld = pbuf_get_index('DTCORE') call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + ifld = pbuf_get_index('DUCORE') + call pbuf_get_field(pbuf, ifld, ducore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + ifld = pbuf_get_index('DVCORE') + call pbuf_get_field(pbuf, ifld, dvcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) ifld = pbuf_get_index('FRACIS') call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) @@ -2090,10 +2133,15 @@ subroutine tphysbc (ztodt, state, & ! T tendency due to dynamics if( nstep > dyn_time_lvls-1 ) then dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt + ducore(:ncol,:pver) = (state%u(:ncol,:pver) - ducore(:ncol,:pver))/ztodt + dvcore(:ncol,:pver) = (state%v(:ncol,:pver) - dvcore(:ncol,:pver))/ztodt call outfld( 'DTCORE', dtcore, pcols, lchnk ) + call outfld( 'DUCORE', ducore, pcols, lchnk ) + call outfld( 'DVCORE', dvcore, pcols, lchnk ) end if call t_stopf('energy_fixer') + ! !=================================================== ! Dry adjustment @@ -2143,6 +2191,11 @@ subroutine tphysbc (ztodt, state, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_DCONV', ptend%u, pcols, lchnk) + call outfld( 'VTEND_DCONV', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "convect_deep_tend") then @@ -2200,6 +2253,10 @@ subroutine tphysbc (ztodt, state, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if + if ( ptend%lu .and. ptend%lv ) then + call outfld( 'UTEND_SHCONV', ptend%u, pcols, lchnk) + call outfld( 'VTEND_SHCONV', ptend%v, pcols, lchnk) + end if call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "convect_shallow_tend") then @@ -2208,7 +2265,6 @@ subroutine tphysbc (ztodt, state, & end if flx_cnd(:ncol) = prec_sh(:ncol) + rliq2(:ncol) - call check_energy_chng(state, tend, "convect_shallow", nstep, ztodt, zero, flx_cnd, snow_sh, zero) call check_tracers_chng(state, tracerint, "convect_shallow", nstep, ztodt, zero_tracers) @@ -2282,6 +2338,10 @@ subroutine tphysbc (ztodt, state, & prec_sh_macmic = 0._r8 snow_sh_macmic = 0._r8 !---ARH + +!++jtb + call physics_ptend_init(ptend_macp_all,state%psetcols,'macrophysics',ls=.false.,lu=.true.,lv=.true.) +!---jtb do macmic_it = 1, cld_macmic_num_steps !=================================================== @@ -2321,7 +2381,10 @@ subroutine tphysbc (ztodt, state, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if - call physics_update(state, ptend, ztodt, tend) +!++jtb + call physics_ptend_sum(ptend,ptend_macp_all,ncol) +!--jtb + call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "macrop_driver_tend") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & @@ -2370,7 +2433,10 @@ subroutine tphysbc (ztodt, state, & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) end if - call physics_update(state, ptend, ztodt, tend) +!++jtb + call physics_ptend_sum(ptend,ptend_macp_all,ncol) +!--jtb + call physics_update(state, ptend, ztodt, tend) if (trim(cam_take_snapshot_after) == "clubb_tend_cam") then call cam_snapshot_all_outfld_tphysbc(cam_snapshot_after_num, state, tend, cam_in, cam_out, pbuf, & @@ -2522,6 +2588,10 @@ subroutine tphysbc (ztodt, state, & end do ! end substepping over macrophysics/microphysics + call outfld( 'UTEND_MACROP', ptend_macp_all%u, pcols, lchnk) + call outfld( 'VTEND_MACROP', ptend_macp_all%v, pcols, lchnk) + call physics_ptend_dealloc(ptend_macp_all) + prec_sed(:ncol) = prec_sed_macmic(:ncol)/cld_macmic_num_steps snow_sed(:ncol) = snow_sed_macmic(:ncol)/cld_macmic_num_steps prec_pcw(:ncol) = prec_pcw_macmic(:ncol)/cld_macmic_num_steps diff --git a/src/physics/cam/ref_pres.F90 b/src/physics/cam/ref_pres.F90 index 378a8f52fb..fa28869ac6 100644 --- a/src/physics/cam/ref_pres.F90 +++ b/src/physics/cam/ref_pres.F90 @@ -13,6 +13,7 @@ module ref_pres use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pver, pverp +use scamMod, only: single_column implicit none public @@ -131,10 +132,13 @@ subroutine ref_pres_init(pref_edge_in, pref_mid_in, num_pr_lev_in) top=.true.) ! Find level corresponding to the molecular diffusion bottom. -!+++ARH - !do_molec_diff = (ptop_ref < do_molec_press) - do_molec_diff = .false. -!---ARH +!+++ARH/jtb + if (single_column) then + do_molec_diff = .false. + else + do_molec_diff = (ptop_ref < do_molec_press) + end if +!---ARH/jtb if (do_molec_diff) then nbot_molec = press_lim_idx(molec_diff_bot_press, & top=.false.) diff --git a/src/physics/cam_dev/physpkg.F90 b/src/physics/cam_dev/physpkg.F90 index 78df1d194b..509c70670c 100644 --- a/src/physics/cam_dev/physpkg.F90 +++ b/src/physics/cam_dev/physpkg.F90 @@ -964,6 +964,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! Initialize the snapshot capability call cam_snapshot_init(cam_in, cam_out, pbuf2d, begchunk) +!++jtb : comment this out. these are alos in cam_diagnostics. +#if 0 ! addfld calls for U, V tendency budget variables that are output in ! tphysac, tphysbc call addfld ( 'UTEND_DCONV', (/ 'lev' /), 'A', 'm/s2', 'Zonal wind tendency by deep convection') @@ -999,7 +1001,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call addfld('UTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Zonal wind tendency due to dynamical core') call addfld('VTEND_CORE', (/ 'lev' /), 'A', 'm/s2' , 'Meridional wind tendency due to dynamical core') call register_vector_field('UTEND_CORE','VTEND_CORE') - +#endif +!--jtb call phys_getopts(history_budget_out = history_budget, & history_budget_histfile_num_out = history_budget_histfile_num)