<p><b>laura@ucar.edu</b> 2011-09-27 14:57:41 -0600 (Tue, 27 Sep 2011)</p><p>updates made in conjunction with updated Registry<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/Makefile
===================================================================
--- branches/atmos_physics/src/core_physics/Makefile 2011-09-27 20:52:05 UTC (rev 1030)
+++ branches/atmos_physics/src/core_physics/Makefile 2011-09-27 20:57:41 UTC (rev 1031)
@@ -25,6 +25,7 @@
module_driver_pbl.o \
module_physics_aquaplanet.o \
module_physics_control.o \
+ module_physics_date_time.o \
module_physics_driver.o \
module_physics_init.o \
module_physics_landuse.o \
@@ -33,6 +34,7 @@
module_physics_rrtmg_lwinit.o \
module_physics_rrtmg_swinit.o \
module_physics_todynamics.o \
+ module_physics_update_surface.o \
module_physics_update.o \
module_physics_vars.o
@@ -115,8 +117,8 @@
module_physics_landuse.o
module_physics_landuse.o: \
- module_physics_manager.o \
- module_physics_utilities.o
+ module_physics_utilities.o \
+ module_physics_vars.o
module_physics_lsm_noahinit.o: \
module_physics_constants.o \
@@ -124,7 +126,10 @@
./physics_wrf/module_sf_noahlsm.o
module_physics_manager.o: \
- module_physics_vars.o
+ module_physics_constants.o \
+ module_physics_vars.o \
+ module_physics_update_surface.o \
+ module_physics_utilities.o
module_physics_rrtmg_lwinit.o: \
module_physics_constants.o \
@@ -139,6 +144,12 @@
module_physics_todynamics.o: \
module_physics_vars.o
+module_physics_update_surface.o: \
+ module_physics_date_time.o \
+ module_physics_constants.o \
+ module_physics_landuse.o \
+ module_physics_vars.o
+
module_physics_update.o: \
module_driver_convection_deep.o
Modified: branches/atmos_physics/src/core_physics/module_physics_constants.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_constants.F 2011-09-27 20:52:05 UTC (rev 1030)
+++ branches/atmos_physics/src/core_physics/module_physics_constants.F 2011-09-27 20:57:41 UTC (rev 1031)
@@ -11,6 +11,9 @@
!=============================================================================================
+ real(kind=RKIND),parameter:: c0 = 0.00000
+ real(kind=RKIND),parameter:: c1 = 1.00000
+
real(kind=RKIND),parameter:: P0 = 100000. !reference pressure [Pa]
real(kind=RKIND),parameter:: t00 = 273.15 !reference temperarure [K]
real(kind=RKIND),parameter:: R_v = 461.6 !gas constant for water vapor [J/kg/K]
@@ -50,7 +53,8 @@
real(kind=RKIND),parameter:: psat = 610.78
!constants specific to long- and short-wave radiation codes:
- real(kind=RKIND),parameter:: solcon_0 = 1365. !solar constant [W/m2]
+!real(kind=RKIND),parameter:: solcon_0 = 1365. !solar constant [W/m2]
+ real(kind=RKIND),parameter:: solcon_0 = 1370. !solar constant [W/m2]
real(kind=RKIND),parameter:: degrad = 3.1415926/180. !conversion from degree to radiant [-]
real(kind=RKIND),parameter:: dpd = 360./365.
Modified: branches/atmos_physics/src/core_physics/module_physics_driver.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_driver.F 2011-09-27 20:52:05 UTC (rev 1030)
+++ branches/atmos_physics/src/core_physics/module_physics_driver.F 2011-09-27 20:57:41 UTC (rev 1031)
@@ -25,21 +25,17 @@
contains
!=============================================================================================
- subroutine physics_driver(domain,itimestep, xtime_s)
+ subroutine physics_driver(domain,itimestep,xtime_s)
!=============================================================================================
!input arguments:
-!----------------
integer,intent(in):: itimestep
- real (kind=RKIND), intent(in) :: xtime_s
+ real(kind=RKIND),intent(in):: xtime_s
-
!inout arguments:
-!----------------
type(domain_type),intent(inout):: domain
!local variables:
-!----------------
type(block_type),pointer:: block
integer:: i,j,k
@@ -111,7 +107,7 @@
!call to pbl schemes:
if(config_pbl_scheme .ne. 'off' .and. config_sfclayer_scheme .ne. 'off') then
call allocate_pbl
- call driver_pbl(block%diag_physics,block%tend_physics)
+ call driver_pbl(block%sfc_input,block%diag_physics,block%tend_physics)
call deallocate_pbl
endif
@@ -131,6 +127,7 @@
endif
write(0,*)
write(0,*) '--- end physics_driver:'
+ write(0,*)
end subroutine physics_driver
Modified: branches/atmos_physics/src/core_physics/module_physics_init.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_init.F 2011-09-27 20:52:05 UTC (rev 1030)
+++ branches/atmos_physics/src/core_physics/module_physics_init.F 2011-09-27 20:57:41 UTC (rev 1031)
@@ -8,6 +8,7 @@
config_sfclayer_scheme, &
config_radt_lw_scheme, &
config_radt_sw_scheme
+ use mpas_timekeeping
use module_driver_convection_deep, only: init_convection_deep
use module_driver_lsm,only: init_lsm
@@ -25,29 +26,52 @@
contains
!=============================================================================================
- subroutine physics_init(dminfo,config_do_restart,mesh,state,diag_physics,sfc_input)
+ subroutine physics_init(dminfo,clock,config_do_restart,mesh,state,diag_physics,sfc_input)
!=============================================================================================
-!input and output arguments:
-!---------------------------
+!input arguments:
logical,intent(in):: config_do_restart
type (dm_info), intent(in):: dminfo
type(mesh_type),intent(in):: mesh
+ type(MPAS_Clock_type),intent(in):: clock
+
+!inout arguments:
type(state_type),intent(inout):: state
type(diag_physics_type),intent(inout):: diag_physics
type(sfc_input_type) ,intent(inout):: sfc_input
+!local variables:
+ type(MPAS_Time_Type):: currTime
+ integer:: iCell,iLag,ierr,julday
+
!---------------------------------------------------------------------------------------------
+ write(0,*)
write(0,*) '--- enter subroutine physics_init:'
+ currTime = MPAS_getClockTime(clock,MPAS_NOW,ierr)
+ call MPAS_getTime(curr_time=currTime,DoY=julday,ierr=ierr)
+
!initialization of east-north directions to convert u-tendencies from cell centers to cell
!edges:
call init_dirs_forphys(mesh)
+!initialization of temperatures needed for updating the deep soil temperature:
+ do iCell = 1, mesh % nCellsSolve
+ diag_physics % nsteps_accum % array(iCell) = 0
+ diag_physics % ndays_accum % array(iCell) = 1
+
+ diag_physics % tday_accum % array(iCell) = sfc_input % tmn % array(iCell)
+ diag_physics % tyear_mean % array(iCell) = sfc_input % tmn % array(iCell)
+ diag_physics % tyear_accum % array(iCell) = sfc_input % tmn % array(iCell)
+ do iLag = 1, mesh % nLags
+ diag_physics % tlag % array(iLag,iCell) = sfc_input % tmn % array(iCell)
+ enddo
+ enddo
+
!initialization of global surface properties. set here for now, but may be moved when time
!manager is implemented:
if(.not. config_do_restart) &
- call landuse_init_forMPAS(dminfo,mesh,diag_physics,sfc_input)
+ call landuse_init_forMPAS(dminfo,julday,mesh,diag_physics,sfc_input)
!initialization of parameterized deep convective processes:
if(config_conv_deep_scheme .ne. 'off') &
@@ -71,10 +95,9 @@
!initialization of longwave radiation processes:
if(config_radt_lw_scheme.ne.'off') call init_radiation_lw(dminfo)
-!initialization of shortwave radiation processes:
- if(config_radt_sw_scheme.ne.'off') call init_radiation_sw(dminfo)
-
+ write(0,*)
write(0,*) '--- end subroutine physics_init'
+ write(0,*)
end subroutine physics_init
Modified: branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F 2011-09-27 20:52:05 UTC (rev 1030)
+++ branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F 2011-09-27 20:57:41 UTC (rev 1031)
@@ -456,10 +456,11 @@
end subroutine microphysics_from_MPAS
!=============================================================================================
- subroutine microphysics_to_MPAS(mesh,state,diag,tend)
+ subroutine microphysics_to_MPAS(mesh,state,diag,tend,itimestep)
!=============================================================================================
!input variables:
+ integer,intent(in):: itimestep
type(mesh_type),intent(in):: mesh
!output variables:
Modified: branches/atmos_physics/src/core_physics/module_physics_landuse.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_landuse.F 2011-09-27 20:52:05 UTC (rev 1030)
+++ branches/atmos_physics/src/core_physics/module_physics_landuse.F 2011-09-27 20:57:41 UTC (rev 1031)
@@ -4,12 +4,11 @@
!=============================================================================================
module module_physics_landuse
- use configure,only: input_sfc_albedo,input_landuse_data
+ use configure,only: input_landuse_data, &
+ config_sfc_albedo
use dmpar
use grid_types
- !use module_physics_aquaplanet !for now,we set the julian day to March 21.
- use module_physics_manager
use module_physics_utilities
use module_physics_vars
@@ -17,6 +16,9 @@
private
public:: landuse_init_forMPAS
+!global variables:
+ integer,public:: isice,iswater
+
!This module reads the file LANDUSE.TBL which defines the land type of each cell, depending on
!the origin of the input data, as defined by the value of the variable "sfc_input_data".
!The allowed values for sfc_input_data are:
@@ -43,7 +45,7 @@
contains
!=============================================================================================
- subroutine landuse_init_forMPAS(dminfo,mesh,diag_physics,sfc_input)
+ subroutine landuse_init_forMPAS(dminfo,julday,mesh,diag_physics,sfc_input)
!=============================================================================================
!input arguments:
@@ -52,6 +54,8 @@
type(diag_physics_type),intent(in):: diag_physics
type(sfc_input_type) ,intent(in):: sfc_input
+ integer,intent(in):: julday
+
!local variables:
character(len=35) :: lutype
character(len=128):: mess
@@ -62,8 +66,9 @@
integer,parameter:: max_seas = 12
integer:: ierr,istat
- integer:: ic,is,isice,isn,iswater,lucats,lumatch,luseas
+ integer:: ic,is,isn,lucats,lumatch,luseas
integer:: iCell,nCells
+ integer:: julday_init
integer,dimension(:),pointer:: ivgtyp
integer,dimension(:),pointer:: landmask
@@ -76,26 +81,26 @@
real(kind=RKIND),dimension(:),pointer:: mavail,sfc_albedo,sfc_emiss,thc,znt
!---------------------------------------------------------------------------------------------
+ write(0,*)
+ write(0,*) '--- enter subroutine landuse_init_forMPAS: julian day=', julday
- write(0,*) '--- enter subroutine landuse_init_forMPAS: julday=',julday
-
nCells = mesh % nCells
latCell => mesh % latCell % array
- landmask => sfc_input % landmask % array
- ivgtyp => sfc_input % ivgtyp % array
- snoalb => sfc_input % snoalb % array
- snowc => sfc_input % snowc % array
- xice => sfc_input % xice % array
+ landmask => sfc_input % landmask % array
+ ivgtyp => sfc_input % ivgtyp % array
+ snoalb => sfc_input % snoalb % array
+ snowc => sfc_input % snowc % array
+ xice => sfc_input % xice % array
+ xland => sfc_input % xland % array
+ albbck => sfc_input % sfc_albbck % array
- albbck => diag_physics % sfc_albbck % array
embck => diag_physics % sfc_emibck % array
mavail => diag_physics % mavail % array
sfc_albedo => diag_physics % sfc_albedo % array
sfc_emiss => diag_physics % sfc_emiss % array
thc => diag_physics % thc % array
xicem => diag_physics % xicem % array
- xland => diag_physics % xland % array
z0 => diag_physics % z0 % array
znt => diag_physics % znt % array
@@ -112,12 +117,12 @@
read(unit=land_unit,fmt=*) lucats,luseas
if(lutype .eq. input_landuse_data)then
- write(mess,*) 'landuse type = ' // trim (lutype) // ' found', lucats, &
+ write(mess,*) ' landuse type = ' // trim (lutype) // ' found', lucats, &
' categories', luseas, ' seasons'
call physics_message(mess)
lumatch=1
else
- write(mess,*) 'skipping over lutype = ' // trim (lutype)
+ write(mess,*) ' skipping over lutype = ' // trim (lutype)
call physics_message(mess)
do is = 1,luseas
read(unit=land_unit,fmt=*,iostat=ierr)
@@ -134,11 +139,11 @@
read(unit=land_unit,fmt=*) li,albd(ic,is),slmo(ic,is),sfem(ic,is),sfz0(ic,is), &
therin(ic,is),scfx(ic,is),sfhc(ic,is)
enddo
- do ic = 1, lucats
- write(0,101) ic,albd(ic,is),slmo(ic,is),sfem(ic,is),sfz0(ic,is), &
- therin(ic,is),scfx(ic,is),sfhc(ic,is)
- enddo
- if(is .lt. luseas) write(0,*)
+! do ic = 1, lucats
+! write(0,101) ic,albd(ic,is),slmo(ic,is),sfem(ic,is),sfz0(ic,is), &
+! therin(ic,is),scfx(ic,is),sfhc(ic,is)
+! enddo
+! if(is .lt. luseas) write(0,*)
enddo
!defines the index iswater and isice as a function of sfc_input_data:
@@ -195,11 +200,11 @@
!set no data points to water:
if(is.eq.0) is = iswater
- if(.not. input_sfc_albedo) albbck(iCell) = albd(is,isn)/100.
+ if(.not. config_sfc_albedo) albbck(iCell) = albd(is,isn)/100.
sfc_albedo(iCell) = albbck(iCell)
if(snowc(iCell) .gt. 0.5) then
- if(input_sfc_albedo) then
+ if(config_sfc_albedo) then
sfc_albedo(iCell) = snoalb(iCell)
else
sfc_albedo(iCell) = albbck(iCell) / (1+scfx(is,isn))
Modified: branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F 2011-09-27 20:52:05 UTC (rev 1030)
+++ branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F 2011-09-27 20:57:41 UTC (rev 1031)
@@ -9,7 +9,7 @@
use configure, only: restart => config_do_restart, &
mminlu => input_landuse_data, &
mminsl => input_soil_data , &
- input_sfc_albedo
+ input_sfc_albedo => config_sfc_albedo
use dmpar
use grid_types
@@ -75,20 +75,19 @@
nCells = mesh % nCells
nSoilLevels = mesh % nSoilLevels
- snowh => diag_physics % snowh % array
-
isltyp => sfc_input % isltyp % array
ivgtyp => sfc_input % ivgtyp % array
- sh2o => sfc_input % sh2o % array
- smois => sfc_input % smois % array
- tslb => sfc_input % tslb % array
+ sh2o => sfc_input % sh2o % array
+ smois => sfc_input % smois % array
+ tslb => sfc_input % tslb % array
snoalb => sfc_input % snoalb % array
snow => sfc_input % snow % array
+ snowh => sfc_input % snowh % array
!reads the NOAH LSM tables:
- call physics_message( 'initialize NOAH LSM tables' )
+ call physics_message( ' initialize NOAH LSM tables' )
call soil_veg_gen_parm(dminfo,mminlu,mminsl)
- call physics_message( 'end initialize NOAH LSM tables' )
+ call physics_message( ' end initialize NOAH LSM tables' )
if(.not.restart) then
@@ -202,7 +201,7 @@
!---------------------------------------------------------------------------------------------
- write(0,*) ' enter subroutine soil_veg_gen_parm:'
+!write(0,*) ' enter subroutine soil_veg_gen_parm:'
!read in the vegetation properties from vegparm.tbl:
@@ -219,7 +218,8 @@
read(16,*) lucats,iindex
if(lutype.eq.trim(mminlu))then
- write(mess,*) 'landuse type = ' // trim ( lutype ) // ' found', lucats,' categories'
+ write(mess,*) ' landuse type = ' // trim ( lutype ) // ' found', &
+ lucats, ' categories'
call physics_message(mess)
lumatch=1
else
@@ -303,25 +303,26 @@
DM_BCAST_INTEGER(bare)
DM_BCAST_INTEGER(natural)
- write(0,*) ' LUTYPE = ',trim(lutype)
- write(0,*) ' LUCATS = ',lucats
- write(0,*) ' IINDEX = ',iindex
- write(0,*) ' LUMATCH = ',lumatch
+!write(0,*) ' LUTYPE = ',trim(lutype)
+!write(0,*) ' LUCATS = ',lucats
+!write(0,*) ' IINDEX = ',iindex
+!write(0,*) ' LUMATCH = ',lumatch
- write(0,*) ' TOPT_DATA = ',topt_data
- write(0,*) ' CMCMAX_DATA = ',cmcmax_data
- write(0,*) ' CFACTR_DATA = ',cfactr_data
- write(0,*) ' RSMAX_DATA = ',rsmax_data
- write(0,*) ' BARE = ',bare
- write(0,*) ' NATURAL = ',natural
+!write(0,*) ' TOPT_DATA = ',topt_data
+!write(0,*) ' CMCMAX_DATA = ',cmcmax_data
+!write(0,*) ' CFACTR_DATA = ',cfactr_data
+!write(0,*) ' RSMAX_DATA = ',rsmax_data
+!write(0,*) ' BARE = ',bare
+!write(0,*) ' NATURAL = ',natural
- write(0,*)
- do lc = 1, lucats
- write(0,101) lc,shdtbl(lc),float(nrotbl(lc)),rstbl(lc),rgltbl(lc),hstbl(lc),snuptbl(lc), &
- maxalb(lc),laimintbl(lc),laimaxtbl(lc),emissmintbl(lc),emissmaxtbl(lc), &
- albedomintbl(lc),albedomaxtbl(lc),z0mintbl(lc),z0maxtbl(lc)
- enddo
- 101 format(i4,15(3x,f9.5))
+!write(0,*)
+!do lc = 1, lucats
+! write(0,101) lc,shdtbl(lc),float(nrotbl(lc)),rstbl(lc),rgltbl(lc),hstbl(lc),snuptbl(lc), &
+! maxalb(lc),laimintbl(lc),laimaxtbl(lc),emissmintbl(lc),emissmaxtbl(lc), &
+! albedomintbl(lc),albedomaxtbl(lc),z0mintbl(lc),z0maxtbl(lc)
+!enddo
+!101 format(i4,15(3x,f9.5))
+ write(0,*) ' end read VEGPARM.TBL'
!read in soil properties from soilparm.tbl:
@@ -331,8 +332,7 @@
call physics_error_fatal('module_sf_noahlsm.F: soil_veg_gen_parm: ' // &
'failure opening SOILPARM.TBL' )
- write(0,*)
- write(mess,*) 'input soil texture classification = ', trim (mminsl)
+ write(mess,*) ' input soil texture classification = ', trim (mminsl)
call physics_message(mess)
lumatch=0
@@ -341,7 +341,7 @@
2000 format(a4)
read(16,*)slcats,iindex
if(sltype.eq.mminsl)then
- write(mess,*) 'soil texture classification = ', trim ( sltype ) , ' found', &
+ write(mess,*) ' soil texture classification = ', trim ( sltype ) , ' found', &
slcats,' categories'
call physics_message ( mess )
lumatch=1
@@ -394,16 +394,17 @@
DM_BCAST_REALS(wltsmc)
DM_BCAST_REALS(qtz)
- write(0,*) ' LUMATCH=',lumatch
- write(0,*) ' SLTYPE =',trim(sltype)
- write(0,*) ' MMINSL =',mminsl
- write(0,*) ' SLCATS =',slcats
- write(0,*) ' IINDEX =',iindex
- write(0,*)
- do lc = 1, slcats
- write(0,101) lc,bb(lc),drysmc(lc),f11(lc),maxsmc(lc),refsmc(lc),satpsi(lc), &
- satdk(lc),satdw(lc),wltsmc(lc),qtz(lc)
- enddo
+!write(0,*) ' LUMATCH=',lumatch
+!write(0,*) ' SLTYPE =',trim(sltype)
+!write(0,*) ' MMINSL =',mminsl
+!write(0,*) ' SLCATS =',slcats
+!write(0,*) ' IINDEX =',iindex
+!write(0,*)
+!do lc = 1, slcats
+! write(0,101) lc,bb(lc),drysmc(lc),f11(lc),maxsmc(lc),refsmc(lc),satpsi(lc), &
+! satdk(lc),satdw(lc),wltsmc(lc),qtz(lc)
+!enddo
+ write(0,*) ' end read SOILPARM.TBL'
!read in general parameters from genparm.tbl:
@@ -468,14 +469,15 @@
DM_BCAST_REAL(smhigh_data)
DM_BCAST_REAL(lvcoef_data)
- write(0,*)
- write(mess,*) 'input general parameters'
- call physics_message(mess)
- write(0,*) 'NUM_SLOPE=',num_slope
- do lc = 1, slpcats
- write(0,101) lc,slope_data(lc)
- enddo
- write(0,*) ' end subroutine soil_veg_gen_parm:'
+!write(0,*)
+!write(mess,*) 'input general parameters'
+!call physics_message(mess)
+!write(0,*) 'NUM_SLOPE=',num_slope
+!do lc = 1, slpcats
+! write(0,101) lc,slope_data(lc)
+!enddo
+!write(0,*) ' end subroutine soil_veg_gen_parm:'
+ write(0,*) ' end read GENPARM.TBL'
end subroutine soil_veg_gen_parm
Modified: branches/atmos_physics/src/core_physics/module_physics_manager.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_manager.F 2011-09-27 20:52:05 UTC (rev 1030)
+++ branches/atmos_physics/src/core_physics/module_physics_manager.F 2011-09-27 20:57:41 UTC (rev 1031)
@@ -4,37 +4,114 @@
use grid_types
use mpas_timekeeping
+ use module_physics_constants
use module_physics_vars
+ use module_physics_update_surface
+ use module_physics_utilities
implicit none
private
public:: physics_timetracker,physics_run_init
- integer, public :: julday !Julian day
- real(kind=RKIND), public :: gmt !Greenwich mean time hour of model start (hr)
+ integer, public:: year !Current year.
+ integer, public:: julday !Initial Julian day.
+ real(kind=RKIND), public:: curr_julday !Current Julian day (= 0.0 at 0Z on January 1st).
+ real(kind=RKIND), public:: gmt !Greenwich mean time hour of model start (hr)
-
logical, public:: l_physics
integer, private:: i,k,j,n
+!defines alarms for calling the long- and short-wave radiation codes, for calling the convec-
+!tion scheme:
+ integer, parameter:: radtlwAlarmID = 11
+ integer, parameter:: radtswAlarmID = 12
+ integer, parameter:: convAlarmID = 13
+!defines alarms to update the surface boundary conditions:
+ integer, parameter:: sfcbdyAlarmID = 14
+
+ integer :: h, m, s, s_n, s_d, DoY, yr
+ real(kind=RKIND) :: utc_h
+
contains
!=============================================================================================
- subroutine physics_timetracker(domain,dt,itimestep)
+ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s)
!=============================================================================================
!input arguments:
- type(domain_type),intent(in):: domain
integer,intent(in):: itimestep
real(kind=RKIND),intent(in):: dt
+ real(kind=RKIND),intent(in) :: xtime_s
+!inout arguments:
+ type(MPAS_Clock_type),intent(inout):: clock
+ type(domain_type),intent(inout) :: domain
+
!local variables:
- real(kind=RKIND):: ptime
+ type(block_type),pointer:: block
+ type(MPAS_Time_Type):: currTime
+ logical:: LeapYear
+ character(len=32) :: timeStamp
+ integer:: ierr
+ real(kind=RKIND):: utc_s
+ real(kind=RKIND):: xtime_m
+
!=============================================================================================
write(0,*)
write(0,*) '--- enter subroutine physics_timetracker: itimestep = ', itimestep
+
+!update the current julian day and current year:
+ 100 format(' YEAR =', i5 ,/, &
+ ' JULDAY =', i5 ,/, &
+ ' GMT =', f16.9,/, &
+ ' UTC_H =', f16.9,/, &
+ ' CURR_JULDAY =', f16.9,/, &
+ ' LEAP_YEAR =', 1x,l1,/)
+
+ currTime = MPAS_getClockTime(clock,MPAS_NOW,ierr)
+ call MPAS_getTime(curr_time=currTime,dateTimeString=timeStamp,YYYY=yr,H=h,M=m, &
+ S=s,S_n=s_n,S_d=s_d,DoY=DoY,ierr=ierr)
+
+ utc_h = real(h) + real(m) / 60.0 + real(s + s_n / s_d) / 3600.0
+ utc_s = real(s + s_n + s_d)
+ year = yr
+ julday = DoY
+ curr_julday = real(julday-1) + utc_h / 24.0
+ LeapYear = isLeapYear(year)
+ write(0,100) year,julday,gmt,utc_h,curr_julday,LeapYear
+
+ block => domain % blocklist
+ do while(associated(block))
+
+ !update the background surface albedo and greeness of vegetation: interpolation of input
+ !monthly values to current day:
+ write(0,*) '--- update background surface albedo, greeness fraction:', timeStamp
+ call physics_update_surface(timeStamp,block%mesh,block%sfc_input)
+
+ !update surface boundary conditions with input sea-surface temperatures and fractional
+ !sea-ice coverage:
+ if(MPAS_isAlarmRinging(clock,sfcbdyAlarmID,ierr=ierr)) then
+ call MPAS_resetClockAlarm(clock,sfcbdyAlarmID,ierr=ierr)
+ if(config_sst_update) &
+ call physics_update_sst(block%mesh,block%sfc_input,block%diag_physics)
+ endif
+
+ !apply a diurnal cycle to the sea-surface temperature:
+ if(config_sstdiurn_update) &
+ call physics_update_sstskin(dt_dyn,block%mesh,block%diag_physics,block%sfc_input)
+
+ !update the deep soil temperature:
+ if(config_deepsoiltemp_update) &
+ call physics_update_deepsoiltemp(LeapYear,dt_dyn,curr_julday,block%mesh, &
+ block%sfc_input,block%diag_physics)
+
+ block => block % next
+ end do
+
+ xtime_m = xtime_s/60.
+
l_physics = .false.
l_radtlw = .false.
l_radtsw = .false.
@@ -45,40 +122,85 @@
l_radtlw = .true.
if(config_radt_sw_scheme .ne. 'off' .and. mod(itimestep-1,config_n_radt_sw) == 0) &
l_radtsw = .true.
- ptime = (itimestep-1)*dt/60.
- write(0,101) itimestep,ptime,l_physics,l_radtlw,l_radtsw
+!write(0,101) xtime_m,l_physics,l_radtlw,l_radtsw
+!write(0,*) xtime_m,l_physics,l_radtlw,l_radtsw
!formats:
- 101 format(i4,3x,f6.0,' mns',3x,'l_physics = ',l1,3x,'l_radtlw = ',l1,3x,'l_radtsw = ',l1)
+ 101 format(i4,3x,f13.7,3x,'l_physics = ',l1,3x,'l_radtlw = ',l1,3x,'l_radtsw = ',l1)
end subroutine physics_timetracker
!=============================================================================================
- subroutine physics_run_init(mesh, clock)
+ subroutine physics_run_init(mesh,clock)
!=============================================================================================
!input arguments:
type(mesh_type),intent(in):: mesh
- type (MPAS_Clock_type) :: clock
+ type(MPAS_Clock_type):: clock
- type (MPAS_Time_Type) :: startTime
- integer :: h, m, s, s_n, s_d, DoY
- real(kind=RKIND) :: utc_h
- integer :: ierr
+!local variables:
+ type(MPAS_Time_Type):: startTime,alarmStartTime
+ type(MPAS_TimeInterval_Type):: alarmTimeStep
+ integer:: ierr
!=============================================================================================
write(0,*)
- write(0,*) '--- enter subroutine physics_wrf_interface:'
+ write(0,*) '--- enter subroutine physics_run_init:'
!initialization of gmt, julian day, and alarms:
+ 100 format(' YEAR =', i5 ,/, &
+ ' JULDAY =', i5 ,/, &
+ ' GMT =', f16.9,/, &
+ ' UTC_H =', f16.9,/, &
+ ' CURR_JULDAY =', f16.9,/)
startTime = MPAS_getClockTime(clock, MPAS_START_TIME, ierr)
- call MPAS_getTime(curr_time=startTime, H=h, M=m, S=s, S_n=s_n, S_d=s_d, DoY=DoY, ierr=ierr)
- utc_h = real(h) + real(m) / 60.0 + real(s + s_n / s_d) / 3600.0
- gmt = utc_h
+ call MPAS_getTime(curr_time=startTime,YYYY=yr,H=h,M=m,S=s,S_n=s_n,S_d=s_d,DoY=DoY,ierr=ierr)
+ utc_h = real(h) + real(m) / 60.0 + real(s + s_n / s_d) / 3600.0
+ year = yr
+ gmt = utc_h
julday = DoY
+ curr_julday = real(julday-1)
+ write(0,100) year,julday,gmt,utc_h,curr_julday
+!set alarms for calling the longwave radiation, shortwave radiation, and convection schemes:
+ if(trim(config_radtlw_interval) /= "none") then
+ call MPAS_setTimeInterval(alarmTimeStep,timeString=config_radtlw_interval,ierr=ierr)
+ alarmStartTime = startTime
+ call MPAS_addClockAlarm(clock,radtlwAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr)
+ if(ierr /= 0) &
+ call physics_error_fatal('subroutine physics_init: error creating alarm radtlw')
+ write(0,*) '--- end define alarm lw ierr: ',ierr
+ endif
+
+ if(trim(config_radtsw_interval) /= "none") then
+ call MPAS_setTimeInterval(alarmTimeStep,timeString=config_radtsw_interval,ierr=ierr)
+ alarmStartTime = startTime
+ call MPAS_addClockAlarm(clock,radtswAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr)
+ if(ierr /= 0) &
+ call physics_error_fatal('subroutine physics_init: error creating alarm radtsw')
+ write(0,*) '--- end define alarm sw ierr: ',ierr
+ endif
+
+ if(trim(config_conv_interval) /= "none") then
+ call MPAS_setTimeInterval(alarmTimeStep,timeString=config_conv_interval,ierr=ierr)
+ alarmStartTime = startTime
+ call MPAS_addClockAlarm(clock,convAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr)
+ if(ierr /= 0) &
+ call physics_error_fatal('subroutine physics_init: error creating alarm conv')
+ write(0,*) '--- end define alarm conv:'
+ endif
+
+!set alarms for updating the surface boundary conditions:
+ if(trim(config_sfc_update_interval) /= "none") then
+ call MPAS_setTimeInterval(alarmTimeStep,timeString=config_sfc_update_interval,ierr=ierr)
+ alarmStartTime = startTime
+ call MPAS_addClockAlarm(clock,sfcbdyAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr)
+ if(ierr /= 0) &
+ call physics_error_fatal('subroutine physics_init: error creating alarm sfcbdy')
+ endif
+
!initialization of wrf dimensions:
!ldf (10-10-201): changed initialization
@@ -129,9 +251,9 @@
lsm_scheme = trim(config_lsm_scheme)
num_soils = mesh% nSoilLevels
- if(config_frac_seaice == 0) then
+ if(.not. config_frac_seaice) then
xice_threshold = 0.5
- else
+ elseif(config_frac_seaice) then
xice_threshold = 0.02
endif
</font>
</pre>