<p><b>laura@ucar.edu</b> 2011-02-09 10:02:13 -0700 (Wed, 09 Feb 2011)</p><p>revised drivers for land-surface parameterization<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_driver_lsm.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_lsm.F 2011-02-09 16:58:18 UTC (rev 731)
+++ branches/atmos_physics/src/core_physics/module_driver_lsm.F 2011-02-09 17:02:13 UTC (rev 732)
@@ -3,56 +3,337 @@
use grid_types
use configure
+ use module_physics_constants
+ use module_physics_landuse
use module_physics_lsm_noahinit
use module_physics_vars
+
+!wrf physics
+ use module_sf_noahdrv
implicit none
private
- public:: init_lsm
+ public:: init_lsm, &
+ allocate_lsm, &
+ deallocate_lsm, &
+ driver_lsm
logical,parameter:: rdxmaxalb = .true. !use snow albedo from geogrid;false use table values
logical,parameter:: usemonalb = .false. !use climatological albedo instead of table values
+ logical,parameter:: myj = .false. !true if using Mellor-Yamada PBL scheme.
+ logical,parameter:: frpcpn = .false.
+ logical,parameter:: rdlai2d = .false.
integer,parameter:: isice = 0
integer,parameter:: isurban = 0
integer,parameter:: sf_urban_physics = 0 !activate urban canopy model (=0: no urban canopy)
+ integer,private:: i,j,k,n
+
+!DOCUMENTATION:
+!./physics_wrf/module_sf_noahdrv.F: main driver for the "NOAH" land-surface parameterization.
+!In the argument list,I added "OPTIONAL" to the declaration of a few arrays to avoid compiling
+!with the "urban physics" option. These arrays are:
+!.. num_roof_layers; num_wall_layers; num_road_layers;num_urban_layers.
+!.. ust_urb2d;frc_urb2d;utype_urb2d.
+!Laura D. Fowler (01-18-2011).
+
contains
!=============================================================================================
subroutine allocate_lsm
!=============================================================================================
+!arrays for soil layer properties:
+ if(.not.allocated(dzs_p) ) allocate(dzs_p(1:num_soils) )
+ if(.not.allocated(smcrel_p) ) allocate(smcrel_p(ims:ime,1:num_soils,jms:jme) )
+ if(.not.allocated(sh2o_p) ) allocate(sh2o_p(ims:ime,1:num_soils,jms:jme) )
+ if(.not.allocated(smois_p) ) allocate(smois_p(ims:ime,1:num_soils,jms:jme) )
+ if(.not.allocated(tslb_p) ) allocate(tslb_p(ims:ime,1:num_soils,jms:jme) )
+!other arrays:
+ if(.not.allocated(acsnom_p) ) allocate(acsnom_p(ims:ime,jms:jme) )
+ if(.not.allocated(acsnow_p) ) allocate(acsnow_p(ims:ime,jms:jme) )
+ if(.not.allocated(canwat_p) ) allocate(canwat_p(ims:ime,jms:jme) )
+ if(.not.allocated(chs_p) ) allocate(chs_p(ims:ime,jms:jme) )
+ if(.not.allocated(chs2_p) ) allocate(chs2_p(ims:ime,jms:jme) )
+ if(.not.allocated(chklowq_p) ) allocate(chklowq_p(ims:ime,jms:jme) )
+ if(.not.allocated(cpm_p) ) allocate(cpm_p(ims:ime,jms:jme) )
+ if(.not.allocated(cqs2_p) ) allocate(cqs2_p(ims:ime,jms:jme) )
+ if(.not.allocated(isltyp_p) ) allocate(isltyp_p(ims:ime,jms:jme) )
+ if(.not.allocated(ivgtyp_p) ) allocate(ivgtyp_p(ims:ime,jms:jme) )
+ if(.not.allocated(glw_p) ) allocate(glw_p(ims:ime,jms:jme) )
+ if(.not.allocated(grdflx_p) ) allocate(grdflx_p(ims:ime,jms:jme) )
+ if(.not.allocated(gsw_p) ) allocate(gsw_p(ims:ime,jms:jme) )
+ if(.not.allocated(hfx_p) ) allocate(hfx_p(ims:ime,jms:jme) )
+ if(.not.allocated(lai_p) ) allocate(lai_p(ims:ime,jms:jme) )
+ if(.not.allocated(lh_p) ) allocate(lh_p(ims:ime,jms:jme) )
+ if(.not.allocated(noahres_p) ) allocate(noahres_p(ims:ime,jms:jme) )
+ if(.not.allocated(potevp_p) ) allocate(potevp_p(ims:ime,jms:jme) )
+ if(.not.allocated(qfx_p) ) allocate(qfx_p(ims:ime,jms:jme) )
+ if(.not.allocated(qgh_p) ) allocate(qgh_p(ims:ime,jms:jme) )
+ if(.not.allocated(qsfc_p) ) allocate(qsfc_p(ims:ime,jms:jme) )
+ if(.not.allocated(qz0_p) ) allocate(qz0_p(ims:ime,jms:jme) )
+ if(.not.allocated(rainbl_p) ) allocate(rainbl_p(ims:ime,jms:jme) )
+ if(.not.allocated(rib_p) ) allocate(rib_p(ims:ime,jms:jme) )
+ if(.not.allocated(sfc_albbck_p) ) allocate(sfc_albbck_p(ims:ime,jms:jme) )
+ if(.not.allocated(sfc_albedo_p) ) allocate(sfc_albedo_p(ims:ime,jms:jme) )
+ if(.not.allocated(sfc_emibck_p) ) allocate(sfc_emibck_p(ims:ime,jms:jme) )
+ if(.not.allocated(sfc_emiss_p) ) allocate(sfc_emiss_p(ims:ime,jms:jme) )
+ if(.not.allocated(sfcrunoff_p) ) allocate(sfcrunoff_p(ims:ime,jms:jme) )
+ if(.not.allocated(shdmin_p) ) allocate(shdmin_p(ims:ime,jms:jme) )
+ if(.not.allocated(shdmax_p) ) allocate(shdmax_p(ims:ime,jms:jme) )
+ if(.not.allocated(smstav_p) ) allocate(smstav_p(ims:ime,jms:jme) )
+ if(.not.allocated(smstot_p) ) allocate(smstot_p(ims:ime,jms:jme) )
+ if(.not.allocated(snoalb_p) ) allocate(snoalb_p(ims:ime,jms:jme) )
+ if(.not.allocated(snotime_p) ) allocate(snotime_p(ims:ime,jms:jme) )
+ if(.not.allocated(snopcx_p) ) allocate(snopcx_p(ims:ime,jms:jme) )
+ if(.not.allocated(snow_p) ) allocate(snow_p(ims:ime,jms:jme) )
+ if(.not.allocated(snowc_p) ) allocate(snowc_p(ims:ime,jms:jme) )
+ if(.not.allocated(snowh_p) ) allocate(snowh_p(ims:ime,jms:jme) )
+ if(.not.allocated(sr_p) ) allocate(sr_p(ims:ime,jms:jme) )
+ if(.not.allocated(swdown_p) ) allocate(swdown_p(ims:ime,jms:jme) )
+ if(.not.allocated(tmn_p) ) allocate(tmn_p(ims:ime,jms:jme) )
+ if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) )
+ if(.not.allocated(udrunoff_p) ) allocate(udrunoff_p(ims:ime,jms:jme) )
+ if(.not.allocated(vegfra_p) ) allocate(vegfra_p(ims:ime,jms:jme) )
+ if(.not.allocated(xice_p) ) allocate(xice_p(ims:ime,jms:jme) )
+ if(.not.allocated(xland_p) ) allocate(xland_p(ims:ime,jms:jme) )
+ if(.not.allocated(z0_p) ) allocate(z0_p(ims:ime,jms:jme) )
+ if(.not.allocated(znt_p) ) allocate(znt_p(ims:ime,jms:jme) )
-
end subroutine allocate_lsm
!=============================================================================================
subroutine deallocate_lsm
!=============================================================================================
+!arrays for soil layer properties:
+ if(allocated(dzs_p) ) deallocate(dzs_p )
+ if(allocated(smcrel_p) ) deallocate(smcrel_p )
+ if(allocated(sh2o_p) ) deallocate(sh2o_p )
+ if(allocated(smois_p) ) deallocate(smois_p )
+ if(allocated(tslb_p) ) deallocate(tslb_p )
+!other arrays:
+ if(allocated(acsnom_p) ) deallocate(acsnom_p )
+ if(allocated(acsnow_p) ) deallocate(acsnow_p )
+ if(allocated(canwat_p) ) deallocate(canwat_p )
+ if(allocated(chs_p) ) deallocate(chs_p )
+ if(allocated(chs2_p) ) deallocate(chs2_p )
+ if(allocated(chklowq_p) ) deallocate(chklowq_p )
+ if(allocated(cpm_p) ) deallocate(cpm_p )
+ if(allocated(cqs2_p) ) deallocate(cqs2_p )
+ if(allocated(glw_p) ) deallocate(glw_p )
+ if(allocated(grdflx_p) ) deallocate(grdflx_p )
+ if(allocated(gsw_p) ) deallocate(gsw_p )
+ if(allocated(hfx_p) ) deallocate(hfx_p )
+ if(allocated(isltyp_p) ) deallocate(isltyp_p )
+ if(allocated(ivgtyp_p) ) deallocate(ivgtyp_p )
+ if(allocated(lai_p) ) deallocate(lai_p )
+ if(allocated(lh_p) ) deallocate(lh_p )
+ if(allocated(noahres_p) ) deallocate(noahres_p )
+ if(allocated(potevp_p) ) deallocate(potevp_p )
+ if(allocated(qfx_p) ) deallocate(qfx_p )
+ if(allocated(qgh_p) ) deallocate(qgh_p )
+ if(allocated(qsfc_p) ) deallocate(qsfc_p )
+ if(allocated(qz0_p) ) deallocate(qz0_p )
+ if(allocated(rainbl_p) ) deallocate(rainbl_p )
+ if(allocated(rib_p) ) deallocate(rib_p )
+ if(allocated(sfc_albbck_p) ) deallocate(sfc_albbck_p )
+ if(allocated(sfc_albedo_p) ) deallocate(sfc_albedo_p )
+ if(allocated(sfc_emibck_p) ) deallocate(sfc_emibck_p )
+ if(allocated(sfc_emiss_p) ) deallocate(sfc_emiss_p )
+ if(allocated(sfcrunoff_p) ) deallocate(sfcrunoff_p )
+ if(allocated(shdmin_p) ) deallocate(shdmin_p )
+ if(allocated(shdmax_p) ) deallocate(shdmax_p )
+ if(allocated(smstav_p) ) deallocate(smstav_p )
+ if(allocated(smstot_p) ) deallocate(smstot_p )
+ if(allocated(snoalb_p) ) deallocate(snoalb_p )
+ if(allocated(snotime_p) ) deallocate(snotime_p )
+ if(allocated(snopcx_p) ) deallocate(snopcx_p )
+ if(allocated(snow_p) ) deallocate(snow_p )
+ if(allocated(snowc_p) ) deallocate(snowc_p )
+ if(allocated(snowh_p) ) deallocate(snowh_p )
+ if(allocated(sr_p) ) deallocate(sr_p )
+ if(allocated(swdown_p) ) deallocate(swdown_p )
+ if(allocated(tmn_p) ) deallocate(tmn_p )
+ if(allocated(tsk_p) ) deallocate(tsk_p )
+ if(allocated(udrunoff_p) ) deallocate(udrunoff_p )
+ if(allocated(vegfra_p) ) deallocate(vegfra_p )
+ if(allocated(xice_p) ) deallocate(xice_p )
+ if(allocated(xland_p) ) deallocate(xland_p )
+ if(allocated(z0_p) ) deallocate(z0_p )
+ if(allocated(znt_p) ) deallocate(znt_p )
-
end subroutine deallocate_lsm
!=============================================================================================
- subroutine lsm_from_MPAS
+ subroutine lsm_from_MPAS(diag_physics,sfc_physics,sfc_input)
!=============================================================================================
+!input arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+ type(sfc_physics_type) ,intent(inout):: sfc_physics
+ type(sfc_input_type) ,intent(inout):: sfc_input
+!---------------------------------------------------------------------------------------------
+ do n = 1,num_soils
+ dzs_p(n) = diag_physics % dzs % array(n,1)
+ enddo
+ do j = jts,jte
+ do n = 1,num_soils
+ do i = its,ite
+ sh2o_p(i,n,j) = diag_physics % sh2o % array(n,i)
+ smcrel_p(i,n,j) = diag_physics % smcrel % array(n,i)
+ tslb_p(i,n,j) = diag_physics % tslb % array(n,i)
+ enddo
+ enddo
+ enddo
+
+ do j = jts,jte
+ do i = its,ite
+ acsnom_p(i,j) = diag_physics % acsnom % array(i)
+ acsnow_p(i,j) = diag_physics % acsnow % array(i)
+ canwat_p(i,j) = diag_physics % canwat % array(i)
+ chs_p(i,j) = diag_physics % chs % array(i)
+ chs2_p(i,j) = diag_physics % chs2 % array(i)
+ chklowq_p(i,j) = diag_physics % chklowq % array(i)
+ cpm_p(i,j) = diag_physics % cpm % array(i)
+ cqs2_p(i,j) = diag_physics % cqs2 % array(i)
+ glw_p(i,j) = diag_physics % glw % array(i)
+ grdflx_p(i,j) = diag_physics % grdflx % array(i)
+ gsw_p(i,j) = diag_physics % gsw % array(i)
+ hfx_p(i,j) = diag_physics % hfx % array(i)
+ lh_p(i,j) = diag_physics % lh % array(i)
+ noahres_p(i,j) = diag_physics % noahres % array(i)
+ potevp_p(i,j) = diag_physics % potevp % array(i)
+ qfx_p(i,j) = diag_physics % qfx % array(i)
+ qgh_p(i,j) = diag_physics % qgh % array(i)
+ qsfc_p(i,j) = diag_physics % qsfc % array(i)
+ qz0_p(i,j) = diag_physics % qz0 % array(i)
+ rib_p(i,j) = diag_physics % rib % array(i)
+ sfc_albedo_p(i,j) = diag_physics % sfc_albedo % array(i)
+ sfc_emiss_p(i,j) = diag_physics % sfc_emiss % array(i)
+ sfcrunoff_p(i,j) = diag_physics % sfcrunoff % array(i)
+ smstav_p(i,j) = diag_physics % smstav % array(i)
+ smstot_p(i,j) = diag_physics % smstot % array(i)
+ snotime_p(i,j) = diag_physics % snotime % array(i)
+ snopcx_p(i,j) = diag_physics % snopcx % array(i)
+ snow_p(i,j) = diag_physics % snow % array(i)
+ snowh_p(i,j) = diag_physics % snowh % array(i)
+ sr_p(i,j) = diag_physics % sr % array(i)
+ tmn_p(i,j) = diag_physics % tmn % array(i)
+ tsk_p(i,j) = diag_physics % tsk % array(i)
+ udrunoff_p(i,j) = diag_physics % udrunoff % array(i)
+ z0_p(i,j) = diag_physics % z0 % array(i)
+ znt_p(i,j) = diag_physics % znt % array(i)
+
+ sfc_albbck_p(i,j) = sfc_physics % sfc_albbck % array(i)
+ sfc_emibck_p(i,j) = sfc_physics % sfc_emibck % array(i)
+ xland_p(i,j) = sfc_physics % xland % array(i)
+
+ lai_p(i,j) = sfc_input % lai % array(i)
+ isltyp_p(i,j) = sfc_input % isltyp % array(i)
+ ivgtyp_p(i,j) = sfc_input % ivgtyp % array(i)
+ shdmin_p(i,j) = sfc_input % shdmin % array(i)
+ shdmax_p(i,j) = sfc_input % shdmax % array(i)
+ snoalb_p(i,j) = sfc_input % snoalb % array(i)
+ snowc_p(i,j) = sfc_input % snowc % array(i)
+ vegfra_p(i,j) = sfc_input % vegfra % array(i)
+ xice_p(i,j) = sfc_input % xice % array(i)
+
+ enddo
+ enddo
+
+ do j = jts,jte
+ do i = its,ite
+ rainbl_p(i,j) = diag_physics % raincv % array(i) + diag_physics % rainncv % array(i)
+ swdown_p(i,j) = diag_physics % gsw % array(i) &
+ / (1. - diag_physics % sfc_albedo % array(i))
+ enddo
+ enddo
+
end subroutine lsm_from_MPAS
!=============================================================================================
- subroutine lsm_to_MPAS
+ subroutine lsm_to_MPAS(diag_physics,sfc_physics,sfc_input)
!=============================================================================================
+!input arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+ type(sfc_physics_type) ,intent(inout):: sfc_physics
+ type(sfc_input_type) ,intent(inout):: sfc_input
+!---------------------------------------------------------------------------------------------
+ do j = jts,jte
+ do n = 1,num_soils
+ do i = its,ite
+ diag_physics % sh2o % array(n,i) = sh2o_p(i,n,j)
+ diag_physics % smcrel % array(n,i) = smcrel_p(i,n,j)
+ diag_physics % tslb % array(n,i) = tslb_p(i,n,j)
+ enddo
+ enddo
+ enddo
+
+ do j = jts,jte
+ do i = its,ite
+ diag_physics % acsnom % array(i) = acsnom_p(i,j)
+ diag_physics % acsnow % array(i) = acsnow_p(i,j)
+ diag_physics % canwat % array(i) = canwat_p(i,j)
+ diag_physics % chs % array(i) = chs_p(i,j)
+ diag_physics % chs2 % array(i) = chs2_p(i,j)
+ diag_physics % chklowq % array(i) = chklowq_p(i,j)
+ diag_physics % cpm % array(i) = cpm_p(i,j)
+ diag_physics % cqs2 % array(i) = cqs2_p(i,j)
+ diag_physics % glw % array(i) = glw_p(i,j)
+ diag_physics % grdflx % array(i) = grdflx_p(i,j)
+ diag_physics % gsw % array(i) = gsw_p(i,j)
+ diag_physics % hfx % array(i) = hfx_p(i,j)
+ diag_physics % lh % array(i) = lh_p(i,j)
+ diag_physics % noahres % array(i) = noahres_p(i,j)
+ diag_physics % potevp % array(i) = potevp_p(i,j)
+ diag_physics % qfx % array(i) = qfx_p(i,j)
+ diag_physics % qgh % array(i) = qgh_p(i,j)
+ diag_physics % qsfc % array(i) = qsfc_p(i,j)
+ diag_physics % qz0 % array(i) = qz0_p(i,j)
+ diag_physics % rib % array(i) = rib_p(i,j)
+ diag_physics % sfc_albedo % array(i) = sfc_albedo_p(i,j)
+ diag_physics % sfc_emiss % array(i) = sfc_emiss_p(i,j)
+ diag_physics % sfcrunoff % array(i) = sfcrunoff_p(i,j)
+ diag_physics % smstav % array(i) = smstav_p(i,j)
+ diag_physics % smstot % array(i) = smstot_p(i,j)
+ diag_physics % snotime % array(i) = snotime_p(i,j)
+ diag_physics % snopcx % array(i) = snopcx_p(i,j)
+ diag_physics % snow % array(i) = snow_p(i,j)
+ diag_physics % snowh % array(i) = snowh_p(i,j)
+ diag_physics % sr % array(i) = sr_p(i,j)
+ diag_physics % tmn % array(i) = tmn_p(i,j)
+ diag_physics % tsk % array(i) = tsk_p(i,j)
+ diag_physics % udrunoff % array(i) = udrunoff_p(i,j)
+ diag_physics % z0 % array(i) = z0_p(i,j)
+ diag_physics % znt % array(i) = znt_p(i,j)
+
+ sfc_physics % sfc_albbck % array(i) = sfc_albbck_p(i,j)
+ sfc_physics % sfc_emibck % array(i) = sfc_emibck_p(i,j)
+ sfc_physics % xland % array(i) = xland_p(i,j)
+
+ !not needed ?:
+ sfc_input % lai % array(i) = lai_p(i,j)
+ sfc_input % shdmin % array(i) = shdmin_p(i,j)
+ sfc_input % shdmax % array(i) = shdmax_p(i,j)
+ sfc_input % snoalb % array(i) = snoalb_p(i,j)
+ sfc_input % snowc % array(i) = snowc_p(i,j)
+ sfc_input % vegfra % array(i) = vegfra_p(i,j)
+ sfc_input % xice % array(i) = xice_p(i,j)
+
+ enddo
+ enddo
+
end subroutine lsm_to_MPAS
!=============================================================================================
@@ -87,42 +368,69 @@
end subroutine init_lsm
!=============================================================================================
- subroutine driver_lsm
+ subroutine driver_lsm(itimestep,diag_physics,sfc_physics,sfc_input)
!=============================================================================================
+!input arguments:
+ integer,intent(in):: itimestep
+
+!inout arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+ type(sfc_physics_type),intent(inout) :: sfc_physics
+ type(sfc_input_type),intent(inout) :: sfc_input
+
!---------------------------------------------------------------------------------------------
write(0,*) '--- enter subroutine driver_lsm:'
+!formats:
+ 101 format(2i6,8(1x,e15.8))
+ 102 format(3i6,8(1x,e15.8))
+
!copy all MPAS arrays to rectangular grid:
- call lsm_from_MPAS
+ call lsm_from_MPAS(diag_physics,sfc_physics,sfc_input)
+ write(0,*) '--- end subroutine lsm_from_MPAS:'
!call to land-surface scheme:
lsm_select: select case (trim(lsm_scheme))
-! case("noah")
-! write(0,*) '--- enter subroutine lsm:'
-! call lsm( &
-! dz8w = dz_p , qv3d = qv_p , p8w3d = pres2_p ,
-! t3d = t_phy , tsk = tsk_p , hfx = hfx_p ,
-! qfx = qfx_p , lh = lh_p , grdflx = grdflx_p ,
-! qgh = qgh_p , gsw = gsw_p , swdown = swdown_p , &
-! glw = glw_p , smstav = smstav_p , smstot = smstot_p ,
-! sfcrunoff = sfcrunoff_p , udrunoff = udrunoff_p , ivgtyp = ivgtyp_p ,
-! isltyp = isltyp_p , isurban = isurban , isice = isice ,
-! veg_fra = vegfra_p , albedo = albedo_p , albbck = albbck_p ,
-! znt = znt_p , z0 = z0_p , tmn = tmn_p ,
-! xland = xlan_p , xice = xice_p , snowc = snowc_p ,
-! qsfc = qsfc_p , rainbl = rainbl_p , mminlu = mminlu ,
-! num_soil_layers = num_soil_layers , dt = dt , dzs = dzs_p ,
-! itimestep = itimestep
-! rib = rib_p ,
-! noahres = noahres_p ,
-! sf_urban_physics = sf_urban_physics ,
-! ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
-! ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
-! its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
-! )
-
+ case("noah")
+ write(0,*) '--- enter subroutine lsm:'
+ call lsm( &
+ dz8w = dz_p , p8w3d = pres2_p , t3d = t_p , &
+ qv3d = qv_p , xland = xland_p , xice = xice_p , &
+ ivgtyp = ivgtyp_p , isltyp = isltyp_p , tmn = tmn_p , &
+ vegfra = vegfra_p , shdmin = shdmin_p , shdmax = shdmax_p , &
+ snoalb = snoalb_p , glw = glw_p , gsw = gsw_p , &
+ swdown = swdown_p , rainbl = rainbl_p , embck = sfc_emibck_p , &
+ sr = sr_p , qgh = qgh_p , cpm = cpm_p , &
+ qz0 = qz0_p , tsk = tsk_p , hfx = hfx_p , &
+ qfx = qfx_p , lh = lh_p , grdflx = grdflx_p , &
+ qsfc = qsfc_p , cqs2 = cqs2_p , chs = chs_p , &
+ chs2 = chs2_p , snow = snow_p , snowc = snowc_p , &
+ snowh = snowh_p , canwat = canwat_p , smstav = smstav_p , &
+ smstot = smstot_p , sfcrunoff = sfcrunoff_p , udrunoff = udrunoff_p , &
+ acsnom = acsnom_p , acsnow = acsnow_p , snotime = snotime_p , &
+ snopcx = snopcx_p , emiss = sfc_emiss_p , rib = rib_p , &
+ potevp = potevp_p , albedo = sfc_albedo_p , albbck = sfc_albbck_p , &
+ z0 = z0_p , znt = znt_p , lai = lai_p , &
+ noahres = noahres_p , chklowq = chklowq_p , sh2o = sh2o_p , &
+ smois = smois_p , tslb = tslb_p , smcrel = smcrel_p , &
+ dzs = dzs_p , isurban = isurban , isice = isice , &
+ rovcp = rcp , dt = dt_pbl , myj = myj , &
+ itimestep = itimestep , frpcpn = frpcpn , rdlai2d = rdlai2d , &
+ xice_threshold = xice_threshold , &
+ usemonalb = input_sfc_albedo , &
+ mminlu = input_landuse_data , &
+ num_soil_layers = num_soil_layers , &
+ num_roof_layers = num_soil_layers , &
+ num_wall_layers = num_soil_layers , &
+ num_road_layers = num_soil_layers , &
+ num_urban_layers = num_soil_layers , &
+ sf_urban_physics = sf_urban_physics , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
write(0,*) '--- exit subroutine lsm'
case default
@@ -130,11 +438,9 @@
end select lsm_select
!copy all arrays back to MPAS geodesic grid:
- call lsm_to_MPAS
+ call lsm_to_MPAS(diag_physics,sfc_physics,sfc_input)
+ write(0,*) '--- end subroutine lsm_to_MPAS:'
- write(0,*) '--- end subroutine driver_lsm'
- write(0,*)
-
end subroutine driver_lsm
!=============================================================================================
Modified: branches/atmos_physics/src/core_physics/module_physics_landuse.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_landuse.F 2011-02-09 16:58:18 UTC (rev 731)
+++ branches/atmos_physics/src/core_physics/module_physics_landuse.F 2011-02-09 17:02:13 UTC (rev 732)
@@ -24,8 +24,21 @@
! input_sfc_data = SiB (16 land types / summer and winter).
! input_sfc_data = LW12 ( 3 land types / all seasons).
+!Given the value of the input index lu_index, and the julian day julday, landuse_init_forMPAS
+!initializes the variables:
+!.. background roughness length (z0).
+!.. background surface albedo (sfc_albbck).
+!.. background surface emissivity (sfc_emibck).
+!.. roughness length (znt).
+!.. surface albedo (sfc_albedo).
+!.. surface emissivity (sfc_emiss).
+!.. land mask (xland).
+!.. thermal inertia (thc).
+!.. surface moisture availability (mavail).
+
integer,parameter:: frac_seaice = 0. ! = 1: treats seaice as fractional field.
! = 0: ice/no-ice flag.
+ real(kind=RKIND),public:: xice_threshold
contains
@@ -53,7 +66,7 @@
integer:: ic,is,isice,isn,iswater,lucats,lumatch,luseas
integer:: iCell,nCells
- real(kind=RKIND):: li,xice_threshold
+ real(kind=RKIND):: li
real(kind=RKIND),dimension(max_cats,max_seas):: albd,slmo,sfem,sfz0,therin,scfx,sfhc
real(kind=RKIND),dimension(:),pointer:: latCell
@@ -73,29 +86,29 @@
snowc => sfc_input % snowc % array
xice => sfc_input % xice % array
- albbck => sfc_physics % albbck % array
- embck => sfc_physics % embck % array
- xicem => sfc_physics % xicem % array
- xland => sfc_physics % xland % array
- z0 => sfc_physics % z0 % array
+ albbck => sfc_physics % sfc_albbck % array
+ embck => sfc_physics % sfc_emibck % array
+ xicem => sfc_physics % xicem % array
+ xland => sfc_physics % xland % 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
+ z0 => diag_physics % z0 % array
znt => diag_physics % znt % array
!reads in the landuse properties from landuse.tbl:
if(dminfo % my_proc_id == IO_NODE) then
- open(land_unit,file='LANDUSE.TBL',form='FORMATTED',status='OLD',iostat=istat)
+ open(land_unit,file='LANDUSE.TBL',action='READ',status='OLD',iostat=istat)
if(istat /= open_ok) &
- call physics_error_fatal(istat,'subroutine landuse_init_forMPAS: ' // &
+ call physics_error_fatal('subroutine landuse_init_forMPAS: ' // &
'failure opening LANDUSE.TBL')
lumatch=0
find_lutype : do while (lumatch == 0)
- read(unit=land_unit,*,iostat=ierr) lutype
- read(unit=land_unit,*,iostat=ierr) lucats,luseas
+ read(unit=land_unit,fmt='(a35)') lutype
+ read(unit=land_unit,fmt=*) lucats,luseas
if(lutype .eq. input_landuse_data)then
write(mess,*) 'landuse type = ' // trim (lutype) // ' found', lucats, &
@@ -106,18 +119,18 @@
write(mess,*) 'skipping over lutype = ' // trim (lutype)
call physics_message(mess)
do is = 1,luseas
- read(unit=land_unit,*,iostat=ierr)
+ read(unit=land_unit,fmt=*,iostat=ierr)
do ic = 1,lucats
- read(unit=land_unit,*)
+ read(unit=land_unit,fmt=*,iostat=ierr)
enddo
enddo
endif
enddo find_lutype
do is = 1, luseas
- read(unit=land_unit,*,iostat=ierr)
+ read(unit=land_unit,fmt=*,iostat=ierr)
do ic = 1, lucats
- read(unit=land_unit,*) li,albd(ic,is),slmo(ic,is),sfem(ic,is),sfz0(ic,is), &
+ 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
enddo
@@ -156,6 +169,8 @@
DM_BCAST_MACRO(sfhc)
DM_BCAST_MACRO(scfx)
+ write(mess,*) trim(lutype)
+ call physics_message(mess)
do is = 1, luseas
do ic = 1, lucats
write(0,101) ic,albd(ic,is),slmo(ic,is),sfem(ic,is),sfz0(ic,is), &
Modified: branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F 2011-02-09 16:58:18 UTC (rev 731)
+++ branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F 2011-02-09 17:02:13 UTC (rev 732)
@@ -76,18 +76,19 @@
nSoilLevels = mesh % nSoilLevels
sh2o => diag_physics % sh2o % array
+ smois => diag_physics % smois % array
snow => diag_physics % snow % array
snowh => diag_physics % snowh % array
+ tslb => diag_physics % tslb % array
isltyp => sfc_input % isltyp % array
ivgtyp => sfc_input % ivgtyp % array
- smois => sfc_input % smois % array
- tslb => sfc_input % tslb % array
snoalb => sfc_input % snoalb % array
!reads the 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' )
if(.not.restart) then
@@ -101,9 +102,9 @@
endif
if(.not. input_sfc_albedo) snoalb(iCell) = maxalb(ivgtyp(iCell))*0.01
enddo
-! if(errflag .eq. 1) &
-! call physics_error_fatal("module_sf_noahlsm.F: lsminit: out of range value "// &
-! "of ISLTYP. Is this field in the input?" )
+ if(errflag .eq. 1) &
+ call physics_error_fatal("module_sf_noahlsm.F: lsminit: out of range value "// &
+ "of ISLTYP. Is this field in the input?" )
!initializes soil liquid water content SH2O:
do iCell = 1, nCells
@@ -124,26 +125,26 @@
psisat = satpsi(isltyp(iCell))
if(bx > blim) bx = blim
fk = (((hlice/(grav*(-psisat))) * &
- ((tslb(iCell,ns)-t0)/tslb(iCell,ns)) )**(-1/bx) )*smcmax
+ ((tslb(ns,iCell)-t0)/tslb(ns,iCell)) )**(-1/bx) )*smcmax
if (fk < 0.02) fk = 0.02
- sh2o(iCell,ns) = min(fk,smois(iCell,ns))
+ sh2o(ns,iCell) = min(fk,smois(ns,iCell))
! ----------------------------------------------------------------------
! now use iterative solution for liquid soil water content using
! FUNCTION FRH2O with the initial guess for SH2O from above explicit
! first guess.
- call frh2o(free,tslb(iCell,ns),smois(iCell,ns),sh2o(iCell,ns), &
+ call frh2o(free,tslb(ns,iCell),smois(ns,iCell),sh2o(ns,iCell), &
smcmax,bx,psisat)
- sh2o(iCell,ns) = free
+ sh2o(ns,iCell) = free
else ! of if (tslb(i,ns,j)
! ----------------------------------------------------------------------
! SH2O = SMOIS ( for T => 273.149K (-0.001C)
- sh2o(iCell,ns)=smois(iCell,ns)
+ sh2o(ns,iCell)=smois(ns,iCell)
! ----------------------------------------------------------------------
endif ! of if (tslb(i,ns,j)
enddo
else ! of if ((bx > 0.0)
do ns = 1, nSoilLevels
- sh2o(iCell,ns)=smois(iCell,ns)
+ sh2o(ns,iCell)=smois(ns,iCell)
enddo
endif ! of if ((bx > 0.0)
enddo ! do iCell
@@ -168,7 +169,7 @@
!input arguments:
type(dm_info),intent(in):: dminfo
- character(len=15),intent(in):: mminlu, mminsl
+ character(len=*),intent(inout):: mminlu, mminsl
!local variables:
character*128:: mess , message
@@ -208,7 +209,7 @@
if(dminfo % my_proc_id == IO_NODE) then
open(16,file='VEGPARM.TBL',form='FORMATTED',status='OLD',iostat=istat)
if(istat /= open_ok) &
- call physics_error_fatal(istat,'subroutine soil_veg_gen_arm: ' // &
+ call physics_error_fatal('subroutine soil_veg_gen_arm: ' // &
'failure opening VEGPARM.TBL')
lumatch=0
@@ -270,9 +271,8 @@
2002 continue
close (16)
- if(lumatch == 0) then
-! call wrf_error_fatal ("land use dataset '"//mminlu//"' not found in vegparm.tbl.")
- endif
+ if(lumatch == 0) &
+ call physics_error_fatal ("land use dataset '"//mminlu//"' not found in vegparm.tbl.")
endif ! end dminfo
@@ -328,7 +328,7 @@
if(dminfo % my_proc_id == IO_NODE) then
open(16,file='SOILPARM.TBL',form='FORMATTED',status='OLD',iostat=istat)
if(istat /= open_ok) &
- call physics_error_fatal(istat,'module_sf_noahlsm.F: soil_veg_gen_parm: ' // &
+ call physics_error_fatal('module_sf_noahlsm.F: soil_veg_gen_parm: ' // &
'failure opening SOILPARM.TBL' )
write(0,*)
@@ -343,7 +343,7 @@
if(sltype.eq.mminsl)then
write(mess,*) 'soil texture classification = ', trim ( sltype ) , ' found', &
slcats,' categories'
-! call wrf_message ( mess )
+ call physics_message ( mess )
lumatch=1
endif
@@ -372,7 +372,7 @@
if(lumatch.eq.0)then
call physics_message( 'soil texture in input file does not ' )
call physics_message( 'match soilparm table' )
-! call wrf_error_fatal ( 'inconsistent or missing soilparm file' )
+ call physics_error_fatal( 'inconsistent or missing soilparm file' )
endif
endif
@@ -380,7 +380,7 @@
!distribute data to all processors:
DM_BCAST_INTEGER(lumatch)
DM_BCAST_CHAR(sltype)
-!DM_BCAST_CHAR(trim(mminsl))
+ DM_BCAST_CHAR(mminsl)
DM_BCAST_INTEGER(slcats)
DM_BCAST_INTEGER(iindex)
DM_BCAST_REALS(bb)
@@ -407,66 +407,74 @@
!read in general parameters from genparm.tbl:
-!if(dminfo % my_proc_id == IO_NODE) then
-! open(16,file='GENPARM.TBL',form='FORMATTED',status='OLD',iostat=istat)
-! if(istat /= open_ok) &
-! call physics_error_fatal(istat,'module_sf_noahlsm.F: soil_veg_gen_parm: ' // &
-! 'failure opening GENPARM.TBL' )
-! read(16,*)
-! read(16,*)
-! read(16,*) num_slope
+ if(dminfo % my_proc_id == IO_NODE) then
+ open(16,file='GENPARM.TBL',form='FORMATTED',status='OLD',iostat=istat)
+ if(istat /= open_ok) &
+ call physics_error_fatal('module_sf_noahlsm.F: soil_veg_gen_parm: ' // &
+ 'failure opening GENPARM.TBL' )
+ read(16,*)
+ read(16,*)
+ read(16,*) num_slope
-! slpcats=num_slope
+ slpcats=num_slope
!prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008:
-! if(size(slope_data) < num_slope) &
-! call wrf_error_fatal('NUM_SLOPE too large for slope_data array in module_sf_noahdrv')
+ if(size(slope_data) < num_slope) &
+ call physics_error_fatal('NUM_SLOPE too large for slope_data array' // &
+ 'in module_sf_noahdrv')
-! do lc = 1, slpcats
-! read(16,*)slope_data(lc)
-! enddo
-! read(16,*)
-! read(16,*)sbeta_data
-! read(16,*)
-! read(16,*)fxexp_data
-! read(16,*)
-! read(16,*)csoil_data
-! read(16,*)
-! read(16,*)salp_data
-! read(16,*)
-! read(16,*)refdk_data
-! read(16,*)
-! read(16,*)refkdt_data
-! read(16,*)
-! read(16,*)frzk_data
-! read(16,*)
-! read(16,*)zbot_data
-! read(16,*)
-! read(16,*)czil_data
-! read(16,*)
-! read(16,*)smlow_data
-! read(16,*)
-! read(16,*)smhigh_data
-! read(16,*)
-! read(16,*)lvcoef_data
-! close(16)
-!endif
+ do lc = 1, slpcats
+ read(16,*)slope_data(lc)
+ enddo
+ read(16,*)
+ read(16,*)sbeta_data
+ read(16,*)
+ read(16,*)fxexp_data
+ read(16,*)
+ read(16,*)csoil_data
+ read(16,*)
+ read(16,*)salp_data
+ read(16,*)
+ read(16,*)refdk_data
+ read(16,*)
+ read(16,*)refkdt_data
+ read(16,*)
+ read(16,*)frzk_data
+ read(16,*)
+ read(16,*)zbot_data
+ read(16,*)
+ read(16,*)czil_data
+ read(16,*)
+ read(16,*)smlow_data
+ read(16,*)
+ read(16,*)smhigh_data
+ read(16,*)
+ read(16,*)lvcoef_data
+ close(16)
+ endif
-!DM_BCAST_INTEGER(num_slope)
-!DM_BCAST_INTEGER(slpcats)
-!DM_BCAST_REALS(slope_data)
-!DM_BCAST_REAL(sbeta_data)
-!DM_BCAST_REAL(fxexp_data)
-!DM_BCAST_REAL(csoil_data)
-!DM_BCAST_REAL(salp_data)
-!DM_BCAST_REAL(refdk_data)
-!DM_BCAST_REAL(refkdt_data)
-!DM_BCAST_REAL(frzk_data)
-!DM_BCAST_REAL(zbot_data)
-!DM_BCAST_REAL(czil_data)
-!DM_BCAST_REAL(smlow_data)
-!DM_BCAST_REAL(smhigh_data)
-!DM_BCAST_REAL(lvcoef_data)
-
+ DM_BCAST_INTEGER(num_slope)
+ DM_BCAST_INTEGER(slpcats)
+ DM_BCAST_REALS(slope_data)
+ DM_BCAST_REAL(sbeta_data)
+ DM_BCAST_REAL(fxexp_data)
+ DM_BCAST_REAL(csoil_data)
+ DM_BCAST_REAL(salp_data)
+ DM_BCAST_REAL(refdk_data)
+ DM_BCAST_REAL(refkdt_data)
+ DM_BCAST_REAL(frzk_data)
+ DM_BCAST_REAL(zbot_data)
+ DM_BCAST_REAL(czil_data)
+ DM_BCAST_REAL(smlow_data)
+ 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:'
end subroutine soil_veg_gen_parm
</font>
</pre>