<p><b>laura@ucar.edu</b> 2010-07-23 15:03:49 -0600 (Fri, 23 Jul 2010)</p><p>controls namelist options for physics parameterizations; initialization of arrays in Registry<br>
</p><hr noshade><pre><font color="gray">Added: branches/atmos_physics/src/core_physics/module_physics_control.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_control.F (rev 0)
+++ branches/atmos_physics/src/core_physics/module_physics_control.F 2010-07-23 21:03:49 UTC (rev 407)
@@ -0,0 +1,243 @@
+!=============================================================================================
+ module module_physics_control
+
+! ... description:
+! ... module_physics_namelist controls namelist parameters read in namelist.input.
+! physics_namelist_check: checks that physics namelist parameters are defined correctly.
+! if not, mpas aborts cleanly.
+! Laura D. Fowler (laura@ucar.edu).
+
+! revision history:
+! 06-29-2010: creation of module.
+
+ use configure
+ use grid_types
+!use module_physics_abort
+
+ implicit none
+ private
+ public:: physics_namelist_check, &
+ physics_registry_init
+
+ logical,public:: moist_physics
+
+ contains
+
+!=============================================================================================
+ subroutine physics_namelist_check
+!=============================================================================================
+
+ write(6,*)
+ write(6,*) '--- enter subroutine physics_namelist_check:'
+ write(6,*) ' config_microp_scheme = ', config_microp_scheme
+ write(6,*) ' config_conv_shallow_scheme = ', config_conv_shallow_scheme
+ write(6,*) ' config_conv_deep_scheme = ', config_conv_deep_scheme
+ write(6,*) ' config_eddy_scheme = ', config_eddy_scheme
+ write(6,*) ' config_pbl_scheme = ', config_pbl_scheme
+ write(6,*) ' config_radt_lw_scheme = ', config_radt_lw_scheme
+ write(6,*) ' config_radt_sw_scheme = ', config_radt_sw_scheme
+ write(6,*) ' config_sfclay_scheme = ', config_sfclay_scheme
+
+!cloud microphysics scheme:
+ if(.not. (config_microp_scheme .eq. 'off' .or. &
+ config_microp_scheme .eq. 'kessler' .or. &
+ config_microp_scheme .eq. 'thompson')) then
+
+ write(0,*) 'illegal value for config_microp_scheme:', config_microp_scheme
+ stop
+! call mpas_physics_abort('illegal value for cloud microphysics scheme')
+
+ endif
+
+!shallow convection scheme:
+ if(.not. (trim(config_conv_shallow_scheme) .eq. 'off')) then
+
+ write(0,*) 'illegal value for config_conv_shallow_scheme: ', config_conv_shallow_scheme
+! call mpas__physics_abort('illegal value for shallow convection scheme')
+ stop
+
+ endif
+
+!deep convection scheme:
+ if(.not. (config_conv_deep_scheme .eq. 'off' .or. &
+ config_conv_deep_scheme .eq. 'kain_fritsch')) then
+
+ write(0,*) 'illegal value for config_deep_conv_scheme: ', config_conv_deep_scheme
+! call mpas_physics_abort('illegal value for deep convection scheme')
+ stop
+
+ endif
+
+!pbl scheme:
+ if(.not. (config_pbl_scheme .eq. 'off' .or. &
+ config_pbl_scheme .eq. 'ysu')) then
+
+ write(0,*) 'illegal value for pbl_scheme: ', config_pbl_scheme
+! call mpas_physics_abort('illegal value for pbl scheme')
+ stop
+
+ endif
+
+!diffusion scheme:
+ if(.not. (config_eddy_scheme .eq. 'off')) then
+
+ write(0,*) 'illegal value for diffusion_scheme: ', config_eddy_scheme
+! call mpas_physics_abort('illegal value for eddy scheme')
+ stop
+
+ endif
+
+!lw radiation scheme:
+ if(.not. (config_radt_lw_scheme .eq. 'off ')) then
+
+ write(0,*) 'illegal value for radt_lw_scheme: ', config_radt_lw_scheme
+! call mpas_physics_abort('illegal value for longwave radiation scheme')
+ stop
+
+ endif
+
+!sw radiation scheme:
+ if(.not. (config_radt_sw_scheme .eq. 'off ')) then
+
+ write(0,*) 'illegal value for radt_sw_scheme: ', config_radt_sw_scheme
+! call mpas_physics_abort('illegal value for shortwave radiation scheme')
+ stop
+
+ endif
+
+!surface layer scheme:
+ if(.not. (config_sfclay_scheme .eq. 'off ' .or. &
+ config_sfclay_scheme .eq. 'monin_obukhov')) then
+
+ write(0,*) 'illegal value for sfclay_scheme: ', config_sfclay_scheme
+! call mpas_physics_abort('illegal value for surface layer scheme')
+ stop
+
+ endif
+
+!checks if any physics process is called. if not, return:
+ moist_physics = .true.
+
+ if(config_microp_scheme .eq. 'off' .and. &
+ config_conv_shallow_scheme .eq. 'off' .and. &
+ config_conv_deep_scheme .eq. 'off' .and. &
+ config_pbl_scheme .eq. 'off' .and. &
+ config_eddy_scheme .eq. 'off' .and. &
+ config_radt_lw_scheme .eq. 'off' .and. &
+ config_radt_sw_scheme .eq. 'off' .and. &
+ config_sfclay_scheme .eq. 'off') moist_physics = .false.
+
+ write(6,*) '--- end subroutine physics_namelist_check:'
+
+ end subroutine physics_namelist_check
+
+!=============================================================================================
+ subroutine physics_registry_init(config_do_restart,grid,s)
+!=============================================================================================
+
+!input and output arguments:
+!---------------------------
+logical,intent(in):: config_do_restart
+ type(grid_meta),intent(in):: grid
+ type(grid_state),intent(inout):: s
+
+!local variables:
+ integer:: k,icell
+
+!---------------------------------------------------------------------------------------------
+
+!initialization of non-restart variables, namely diagnostics only:
+
+ do icell = 1, grid%nCells
+
+ s % qv_col % array(icell) = 0.
+ s % qc_col % array(icell) = 0.
+ s % qr_col % array(icell) = 0.
+ s % qi_col % array(icell) = 0.
+ s % qs_col % array(icell) = 0.
+ s % qg_col % array(icell) = 0.
+
+ s % sr % array(icell) = 0.
+
+ enddo
+
+!initialization of restart variables, if needed:
+ if(.not. config_do_restart) then
+
+!.. 1-d variables:
+ do icell = 1, grid%nCells
+
+ !cloud microphysics:
+ s % rainnc % array(icell) = 0.
+ s % rainncv % array(icell) = 0.
+ s % snownc % array(icell) = 0.
+ s % snowncv % array(icell) = 0.
+ s % graupelnc % array(icell) = 0.
+ s % graupelncv % array(icell) = 0.
+
+ !convection:
+ s % rainc % array(icell) = 0.
+ s % raincv % array(icell) = 0.
+ s % nca % array(icell) = 0.
+ s % cubot % array(icell) = 0.
+ s % cutop % array(icell) = 0.
+
+ !.. surface layer:
+ s % flhc % array(icell) = 0.
+ s % flqc % array(icell) = 0.
+ s % hfx % array(icell) = 0.
+ s % lh % array(icell) = 0.
+ s % mavail % array(icell) = 0.
+ s % mol % array(icell) = 0.
+ s % pblh % array(icell) = 0.
+ s % q2 % array(icell) = 0.
+ s % qfx % array(icell) = 0.
+ s % qsfc % array(icell) = 0.
+ s % regime % array(icell) = 0.
+ s % rmol % array(icell) = 0.
+ s % t2 % array(icell) = 0.
+ s % tsk % array(icell) = 0.
+ s % th2 % array(icell) = 0.
+ s % u10 % array(icell) = 0.
+ s % ust % array(icell) = 0.
+ s % ustm % array(icell) = 0.
+ s % v10 % array(icell) = 0.
+ s % xland % array(icell) = 0.
+ s % znt % array(icell) = 0.
+
+ enddo
+
+!2-d variables:
+
+ do icell = 1, grid % nCells
+ do k = 1, grid % nVertLevels
+
+ !convection:
+ s % w0avg % array(k,icell) = 0.
+ s % rthcuten % array(k,icell) = 0.
+ s % rqvcuten % array(k,icell) = 0.
+ s % rqccuten % array(k,icell) = 0.
+ s % rqrcuten % array(k,icell) = 0.
+ s % rqicuten % array(k,icell) = 0.
+ s % rqscuten % array(k,icell) = 0.
+
+ !pbl:
+ s % rublten % array(k,icell) = 0.
+ s % rvblten % array(k,icell) = 0.
+ s % rthblten % array(k,icell) = 0.
+ s % rqvblten % array(k,icell) = 0.
+ s % rqcblten % array(k,icell) = 0.
+ s % rqiblten % array(k,icell) = 0.
+
+ enddo
+ enddo
+
+ endif
+
+ end subroutine physics_registry_init
+
+!=============================================================================================
+ end module module_physics_control
+!=============================================================================================
+
+
</font>
</pre>