<p><b>laura@ucar.edu</b> 2011-05-09 11:50:41 -0600 (Mon, 09 May 2011)</p><p>corrections to physics drivers for restartibility<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_driver_convection_deep.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_convection_deep.F 2011-05-09 17:47:48 UTC (rev 818)
+++ branches/atmos_physics/src/core_physics/module_driver_convection_deep.F 2011-05-09 17:50:41 UTC (rev 819)
@@ -1,6 +1,5 @@
!=============================================================================================
module module_driver_convection_deep
- use configure, only: restart => config_do_restart
use grid_types
use module_cu_kfeta
@@ -9,10 +8,10 @@
implicit none
private
- public:: convection_deep_allocate, &
- convection_deep_deallocate, &
- convection_deep_init, &
- convection_deep_driver, &
+ public:: allocate_convection_deep, &
+ deallocate_convection_deep, &
+ init_convection_deep, &
+ driver_convection_deep, &
update_convection_deep
integer, private:: i,k,j
@@ -20,7 +19,7 @@
contains
!=============================================================================================
- subroutine convection_deep_allocate
+ subroutine allocate_convection_deep
!=============================================================================================
if(.not.allocated(cu_act_flag)) allocate(cu_act_flag(ims:ime,jms:jme) )
@@ -45,10 +44,10 @@
end select convection_select
- end subroutine convection_deep_allocate
+ end subroutine allocate_convection_deep
!=============================================================================================
- subroutine convection_deep_deallocate
+ subroutine deallocate_convection_deep
!=============================================================================================
if(allocated(cu_act_flag)) deallocate(cu_act_flag)
@@ -73,16 +72,20 @@
end select convection_select
- end subroutine convection_deep_deallocate
+ end subroutine deallocate_convection_deep
!=============================================================================================
- subroutine convection_deep_init(mesh,diag_physics)
+ subroutine init_convection_deep(config_do_restart,mesh,diag_physics)
!=============================================================================================
+!input arguments:
+ logical,intent(in):: config_do_restart
type(mesh_type),intent(in):: mesh
+
+!inout arguments:
type(diag_physics_type),intent(inout):: diag_physics
-!local variables and arrays:
+!local variables:
integer:: iCell
!---------------------------------------------------------------------------------------------
@@ -91,9 +94,11 @@
case ("kain_fritsch")
write(0,*) ' begin kain-fritsch initialization:'
- do iCell = 1, mesh % nCells
- diag_physics % nca % array(iCell) = -100.
- enddo
+ if(.not. config_do_restart) then
+ do iCell = 1, mesh % nCells
+ diag_physics % nca % array(iCell) = -100.
+ enddo
+ endif
call kf_lutab(svp1,svp2,svp3,svpt0)
write(0,*) ' end kain-kritsch initialization:'
@@ -101,10 +106,10 @@
end select convection_select
- end subroutine convection_deep_init
+ end subroutine init_convection_deep
!=============================================================================================
- subroutine convection_deep_driver(itimestep,mesh,diag_physics,tend_physics)
+ subroutine driver_convection_deep(itimestep,mesh,diag_physics,tend_physics)
!=============================================================================================
!input and output arguments:
@@ -240,7 +245,7 @@
write(0,*) '--- end subroutine convection_driver'
- end subroutine convection_deep_driver
+ end subroutine driver_convection_deep
!=============================================================================================
subroutine convection_from_MPAS(dt_dyn,diag_physics,tend_physics)
Modified: branches/atmos_physics/src/core_physics/module_driver_lsm.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_lsm.F 2011-05-09 17:47:48 UTC (rev 818)
+++ branches/atmos_physics/src/core_physics/module_driver_lsm.F 2011-05-09 17:50:41 UTC (rev 819)
@@ -262,6 +262,8 @@
/ (1. - diag_physics % sfc_albedo % array(i))
enddo
enddo
+ write(0,*) 'max rainbl_p=',maxval(rainbl_p(:,:))
+
end subroutine lsm_from_MPAS
@@ -345,6 +347,7 @@
enddo
enddo
+ write(0,*) '--- end subroutine lsm_to_MPAS:'
end subroutine lsm_to_MPAS
Modified: branches/atmos_physics/src/core_physics/module_driver_pbl.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_pbl.F 2011-05-09 17:47:48 UTC (rev 818)
+++ branches/atmos_physics/src/core_physics/module_driver_pbl.F 2011-05-09 17:50:41 UTC (rev 819)
@@ -1,7 +1,6 @@
!=============================================================================================
module module_driver_pbl
use grid_types
- use constants
use module_physics_constants
use module_physics_vars
@@ -13,12 +12,10 @@
private
public:: allocate_pbl, &
deallocate_pbl, &
- pbl_driver
+ driver_pbl
- logical,parameter,private:: pbl_flag_qi = .true. !
+ integer,private:: i,j,k
- integer,private:: i,iCell,j,k
-
contains
!=============================================================================================
@@ -38,12 +35,11 @@
if(.not.allocated(wspd_p) ) allocate(wspd_p(ims:ime,jms:jme) )
if(.not.allocated(xland_p) ) allocate(xland_p(ims:ime,jms:jme) )
if(.not.allocated(znt_p) ) allocate(znt_p(ims:ime,jms:jme) )
-
+!for YSU PBL scheme:
if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) )
if(.not.allocated(kpbl_p) ) allocate(kpbl_p(ims:ime,jms:jme) )
if(.not.allocated(exch_p) ) allocate(exch_p(ims:ime,kms:kme,jms:jme) )
-
-!tendencies
+!tendencies:
if(.not.allocated(rublten_p) ) allocate(rublten_p(ims:ime,kms:kme,jms:jme) )
if(.not.allocated(rvblten_p) ) allocate(rvblten_p(ims:ime,kms:kme,jms:jme) )
if(.not.allocated(rthblten_p)) allocate(rthblten_p(ims:ime,kms:kme,jms:jme) )
@@ -70,11 +66,10 @@
if(allocated(wspd_p) ) deallocate(wspd_p )
if(allocated(xland_p) ) deallocate(xland_p )
if(allocated(znt_p) ) deallocate(znt_p )
-
+!for YSU PBL scheme:
if(allocated(hpbl_p) ) deallocate(hpbl_p )
if(allocated(kpbl_p) ) deallocate(kpbl_p )
if(allocated(exch_p) ) deallocate(exch_p )
-
!tendencies
if(allocated(rublten_p) ) deallocate(rublten_p )
if(allocated(rvblten_p) ) deallocate(rvblten_p )
@@ -86,22 +81,18 @@
end subroutine deallocate_pbl
!=============================================================================================
- subroutine pbl_from_MPAS(mesh,diag_physics,sfc_physics,tend_physics)
+ subroutine pbl_from_MPAS(diag_physics,sfc_physics)
!=============================================================================================
!input arguments:
- type(mesh_type),intent(in):: mesh
- type(diag_physics_type),intent(inout):: diag_physics
- type(sfc_physics_type) ,intent(inout):: sfc_physics
- type(tend_physics_type),intent(inout):: tend_physics
+ type(sfc_physics_type) ,intent(in):: sfc_physics
+ type(diag_physics_type),intent(in):: diag_physics
- integer:: ip,iEdg
-
!---------------------------------------------------------------------------------------------
do j = jts,jte
-
do i = its,ite
+!from surface-layer model:
br_p(i,j) = diag_physics % br % array(i)
gz1oz0_p(i,j) = diag_physics % gz1oz0 % array(i)
hfx_p(i,j) = diag_physics % hfx % array(i)
@@ -114,20 +105,22 @@
v10_p(i,j) = diag_physics % v10 % array(i)
wspd_p(i,j) = diag_physics % wspd % array(i)
znt_p(i,j) = diag_physics % znt % array(i)
- kpbl_p(i,j) = int(diag_physics % kpbl % array(i))
-
- xland_p(i,j) = sfc_physics % xland % array(i)
+ xland_p(i,j) = sfc_physics % xland % array(i)
+!initialization for YSU PBL scheme:
+ kpbl_p(i,j) = 1
enddo
+ enddo
+ do j = jts,jte
do k = kts,kte
do i = its,ite
- exch_p(i,k,j) = diag_physics % exch_h % array(k,i)
- rublten_p(i,k,j) = tend_physics % rublten % array(k,i)
- rvblten_p(i,k,j) = tend_physics % rvblten % array(k,i)
- rthblten_p(i,k,j) = tend_physics % rthblten % array(k,i)
- rqvblten_p(i,k,j) = tend_physics % rqvblten % array(k,i)
- rqcblten_p(i,k,j) = tend_physics % rqcblten % array(k,i)
- rqiblten_p(i,k,j) = tend_physics % rqiblten % array(k,i)
+ exch_p(i,k,j) = 0.
+ rublten_p(i,k,j) = 0.
+ rvblten_p(i,k,j) = 0.
+ rthblten_p(i,k,j) = 0.
+ rqvblten_p(i,k,j) = 0.
+ rqcblten_p(i,k,j) = 0.
+ rqiblten_p(i,k,j) = 0.
enddo
enddo
@@ -136,36 +129,23 @@
end subroutine pbl_from_MPAS
!=============================================================================================
- subroutine pbl_to_MPAS(mesh,diag_physics,tend_physics)
+ subroutine pbl_to_MPAS(diag_physics,tend_physics)
!=============================================================================================
-!input arguments:
- type(mesh_type),intent(in):: mesh
+!inout arguments:
type(diag_physics_type),intent(inout):: diag_physics
type(tend_physics_type),intent(inout):: tend_physics
- integer:: ip,iEdg
-
!---------------------------------------------------------------------------------------------
do j = jts,jte
-
do i = its,ite
- diag_physics % br % array(i) = br_p(i,j)
- diag_physics % gz1oz0 % array(i) = gz1oz0_p(i,j)
- diag_physics % hfx % array(i) = hfx_p(i,j)
- diag_physics % hpbl % array(i) = hpbl_p(i,j)
- diag_physics % kpbl % array(i) = dble(kpbl_p(i,j))
- diag_physics % psim % array(i) = psim_p(i,j)
- diag_physics % psih % array(i) = psih_p(i,j)
- diag_physics % qfx % array(i) = qfx_p(i,j)
- diag_physics % u10 % array(i) = u10_p(i,j)
- diag_physics % ust % array(i) = ust_p(i,j)
- diag_physics % v10 % array(i) = v10_p(i,j)
- diag_physics % wspd % array(i) = wspd_p(i,j)
- diag_physics % znt % array(i) = znt_p(i,j)
+ diag_physics % hpbl % array(i) = hpbl_p(i,j)
+ diag_physics % kpbl % array(i) = kpbl_p(i,j)
enddo
+ enddo
+ do j = jts,jte
do k = kts,kte
do i = its,ite
diag_physics % exch_h % array(k,i) = exch_p(i,k,j)
@@ -177,30 +157,26 @@
tend_physics % rqiblten % array(k,i) = rqiblten_p(i,k,j)
enddo
enddo
-
enddo
end subroutine pbl_to_MPAS
!=============================================================================================
- subroutine pbl_driver(mesh,diag_physics,sfc_physics,tend_physics)
+ subroutine driver_pbl(diag_physics,sfc_physics,tend_physics)
!=============================================================================================
!input and output arguments:
!---------------------------
- type(mesh_type),intent(in):: mesh
+ type(sfc_physics_type) ,intent(in) :: sfc_physics
type(diag_physics_type),intent(inout):: diag_physics
- type(sfc_physics_type) ,intent(inout):: sfc_physics
type(tend_physics_type),intent(inout):: tend_physics
!---------------------------------------------------------------------------------------------
write(0,*)
write(0,*) '--- enter pbl driver: dt_pbl=',dt_pbl
- 101 format(i8,12(1x,e15.8))
!copy all MPAS arrays to rectanguler grid arrays:
- call pbl_from_MPAS(mesh,diag_physics,sfc_physics,tend_physics)
- write(0,*) '--- end pbl_from_MPAS:'
+ call pbl_from_MPAS(diag_physics,sfc_physics)
pbl_select: select case (trim(pbl_scheme))
@@ -211,7 +187,7 @@
qi3d = qi_p , p3d = pres_p , p3di = pres2_p , &
pi3d = pi_p , rublten = rublten_p , rvblten = rvblten_p , &
rthblten = rthblten_p , rqvblten = rqvblten_p , rqcblten = rqcblten_p , &
- rqiblten = rqiblten_p , flag_qi = pbl_flag_qi , cp = cp , &
+ rqiblten = rqiblten_p , flag_qi = f_qi , cp = cp , &
g = g , rovcp = rcp , rd = R_d , &
rovg = rdg , ep1 = ep_1 , ep2 = ep_2 , &
karman = karman , xlv = xlv , rv = R_v , &
@@ -231,10 +207,9 @@
end select pbl_select
!copy all arrays back to the MPAS grid:
- call pbl_to_MPAS(mesh,diag_physics,tend_physics)
- write(0,*) '--- end pbl_to_MPAS:'
+ call pbl_to_MPAS(diag_physics,tend_physics)
- end subroutine pbl_driver
+ end subroutine driver_pbl
!=============================================================================================
end module module_driver_pbl
Modified: branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F 2011-05-09 17:47:48 UTC (rev 818)
+++ branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F 2011-05-09 17:50:41 UTC (rev 819)
@@ -89,10 +89,10 @@
subroutine radiation_lw_from_MPAS(diag_physics,sfc_physics,sfc_input)
!=============================================================================================
-!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
+!input arguments:
+ type(sfc_input_type) ,intent(in):: sfc_input
+ type(sfc_physics_type) ,intent(in):: sfc_physics
+ type(diag_physics_type),intent(in):: diag_physics
!---------------------------------------------------------------------------------------------
@@ -100,9 +100,9 @@
do i = its,ite
sfc_emiss_p(i,j) = diag_physics % sfc_emiss % array(i)
xland_p(i,j) = sfc_physics % xland % array(i)
- tsk_p(i,j) = sfc_input % skintemp % array(i)
- snow_p(i,j) = sfc_input % snow % array(i)
- xice_p(i,j) = sfc_input % xice % array(i)
+ tsk_p(i,j) = sfc_input % skintemp % array(i)
+ snow_p(i,j) = sfc_input % snow % array(i)
+ xice_p(i,j) = sfc_input % xice % array(i)
enddo
enddo
do j = jts,jte
@@ -113,6 +113,7 @@
enddo
enddo
+!initialization:
do j = jts,jte
do i = its,ite
glw_p(i,j) = 0.
@@ -170,15 +171,15 @@
diag_physics % lwuptc % array(i) = lwuptc_p(i,j)
diag_physics % olrtoa % array(i) = olrtoa_p(i,j)
enddo
-
- do k = kts,kte+2
- do i = its,ite
- diag_physics % lwdnflx % array(k,i) = lwdnflx_p(i,k,j)
- diag_physics % lwdnflxc % array(k,i) = lwdnflxc_p(i,k,j)
- diag_physics % lwupflx % array(k,i) = lwupflx_p(i,k,j)
- diag_physics % lwupflxc % array(k,i) = lwupflxc_p(i,k,j)
- enddo
- enddo
+!not needed:
+!do k = kts,kte+2
+!do i = its,ite
+! diag_physics % lwdnflx % array(k,i) = lwdnflx_p(i,k,j)
+! diag_physics % lwdnflxc % array(k,i) = lwdnflxc_p(i,k,j)
+! diag_physics % lwupflx % array(k,i) = lwupflx_p(i,k,j)
+! diag_physics % lwupflxc % array(k,i) = lwupflxc_p(i,k,j)
+!enddo
+!enddo
do k = kts,kte
do i = its,ite
@@ -198,9 +199,7 @@
!---------------------------------------------------------------------------------------------
- write(0,*) '--- begin radiation_lw initialization:'
-
-!call to longwave radiation scheme:
+ write(0,*) '--- enter radiation_lw initialization:'
radiation_lw_select: select case (trim(radt_lw_scheme))
case ("rrtmg_lw")
@@ -211,7 +210,6 @@
case default
end select radiation_lw_select
-
write(0,*) '--- end radiation_lw initialization'
end subroutine init_radiation_lw
@@ -238,7 +236,6 @@
!copy all MPAS arrays to rectangular grid:
call radiation_lw_from_MPAS(diag_physics,sfc_physics,sfc_input)
- write(0,*) '--- end radiation_lw_from_MPAS:'
!call to longwave radiation scheme:
radiation_lw_select: select case (trim(radt_lw_scheme))
@@ -279,7 +276,6 @@
!copy all arrays back to MPAS geodesic grid:
call radiation_lw_to_MPAS(diag_physics,tend_physics)
- write(0,*) '--- radiation_lw_to_MPAS:'
end subroutine driver_radiation_lw
Modified: branches/atmos_physics/src/core_physics/module_driver_sfclayer.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_sfclayer.F 2011-05-09 17:47:48 UTC (rev 818)
+++ branches/atmos_physics/src/core_physics/module_driver_sfclayer.F 2011-05-09 17:50:41 UTC (rev 819)
@@ -1,33 +1,26 @@
!=============================================================================================
module module_driver_sfclayer
use grid_types
- use configure
use module_physics_constants
use module_physics_vars
- use module_physics_aquaplanet
!from wrf physics:
use module_sf_sfclay
implicit none
private
- public:: init_sfclayer, &
- allocate_sfclayer, &
- deallocate_sfclayer, &
- sfclayer_driver
+ public:: init_sfclayer, &
+ allocate_sfclayer, &
+ deallocate_sfclayer, &
+ driver_sfclayer
integer,parameter,private:: isfflx = 1 !=1 for surface heat and moisture fluxes.
integer,parameter,private:: isftcflx = 0 !=0,(Charnock and Carlson-Boland).
integer,parameter,private:: iz0tlnd = 0 !=0,(Carlson-Boland)
- real(kind=RKIND),parameter,private:: xmava = 0.3 !surface moisture availability (0->1).
- real(kind=RKIND),parameter,private:: ust_min = 0.0001 !min. u* in similarity theory.
- real(kind=RKIND),parameter,private:: zzlnd = 0.1 !roughness length over land.
- real(kind=RKIND),parameter,private:: zzwtr = 0.0001 !roughness length over water.
+ integer,private:: i,j
- integer,private:: i,iCell,j
-
contains
!=============================================================================================
@@ -117,162 +110,145 @@
end subroutine deallocate_sfclayer
!=============================================================================================
- subroutine sfclayer_from_MPAS(mesh,diag_physics,sfc_input,sfc_physics)
+ subroutine sfclayer_from_MPAS(diag_physics,sfc_input,sfc_physics)
!=============================================================================================
!input arguments:
- type(mesh_type):: mesh
+ type(sfc_input_type) ,intent(in) :: sfc_input
+ type(sfc_physics_type) ,intent(in) :: sfc_physics
+
+!inout arguments:
type(diag_physics_type),intent(inout):: diag_physics
- type(sfc_input_type),intent(inout) :: sfc_input
- type(sfc_physics_type) ,intent(inout):: sfc_physics
- integer:: ip,iEdg
-
!---------------------------------------------------------------------------------------------
do j = jts,jte
do i = its,ite
-
- br_p(i,j) = diag_physics % br % array(i)
- cd_p(i,j) = diag_physics % cd % array(i)
- cda_p(i,j) = diag_physics % cda % array(i)
- chs_p(i,j) = diag_physics % chs % array(i)
- chs2_p(i,j) = diag_physics % chs2 % array(i)
- cpm_p(i,j) = diag_physics % cpm % array(i)
- cqs2_p(i,j) = diag_physics % cqs2 % array(i)
- ck_p(i,j) = diag_physics % ck % array(i)
- cka_p(i,j) = diag_physics % cka % array(i)
- gz1oz0_p(i,j) = diag_physics % gz1oz0 % array(i)
- flhc_p(i,j) = diag_physics % flhc % array(i)
- flqc_p(i,j) = diag_physics % flqc % array(i)
- hfx_p(i,j) = diag_physics % hfx % array(i)
+ !input variables:
hpbl_p(i,j) = diag_physics % hpbl % array(i)
- lh_p(i,j) = diag_physics % lh % array(i)
mavail_p(i,j) = diag_physics % mavail % array(i)
- mol_p(i,j) = diag_physics % mol % array(i)
- psim_p(i,j) = diag_physics % psim % array(i)
- psih_p(i,j) = diag_physics % psih % array(i)
- q2_p(i,j) = diag_physics % q2 % array(i)
+ tsk_p(i,j) = sfc_input % skintemp % array(i)
+ xland_p(i,j) = sfc_physics % xland % array(i)
+ !inout variables:
+ hfx_p(i,j) = diag_physics % hfx % 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)
- regime_p(i,j) = diag_physics % regime % array(i)
- rmol_p(i,j) = diag_physics % rmol % array(i)
- t2m_p(i,j) = diag_physics % t2m % array(i)
- th2m_p(i,j) = diag_physics % th2m % array(i)
- u10_p(i,j) = diag_physics % u10 % array(i)
+ qsfc_p(i,j) = diag_physics % qsfc % array(i)
+ mol_p(i,j) = diag_physics % mol % array(i)
ust_p(i,j) = diag_physics % ust % array(i)
ustm_p(i,j) = diag_physics % ustm % array(i)
- v10_p(i,j) = diag_physics % v10 % array(i)
- wspd_p(i,j) = diag_physics % wspd % array(i)
- zol_p(i,j) = diag_physics % zol % array(i)
- znt_p(i,j) = diag_physics % znt % array(i)
-
- tsk_p(i,j) = sfc_input % skintemp % array(i)
- xland_p(i,j) = sfc_physics % xland % array(i)
+ znt_p(i,j) = diag_physics % znt % array(i)
+ zol_p(i,j) = diag_physics % zol % array(i)
+ !output variables:
+ br_p(i,j) = 0.
+ cpm_p(i,j) = cp
+ cd_p(i,j) = 0.
+ cda_p(i,j) = 0.
+ chs_p(i,j) = 0.
+ chs2_p(i,j) = 0.
+ ck_p(i,j) = 0.
+ cka_p(i,j) = 0.
+ cqs2_p(i,j) = 0.
+ flhc_p(i,j) = 0.
+ flqc_p(i,j) = 0.
+ gz1oz0_p(i,j) = 0.
+ lh_p(i,j) = 0.
+ psim_p(i,j) = 0.
+ psih_p(i,j) = 0.
+ qgh_p(i,j) = 0.
+ regime_p(i,j) = 0.
+ rmol_p(i,j) = 0.
+ wspd_p(i,j) = 0.
+ q2_p(i,j) = 0.
+ t2m_p(i,j) = 0.
+ th2m_p(i,j) = 0.
+ u10_p(i,j) = 0.
+ v10_p(i,j) = 0.
enddo
enddo
-
+
end subroutine sfclayer_from_MPAS
!=============================================================================================
- subroutine sfclayer_to_MPAS(mesh,diag_physics,sfc_input)
+ subroutine sfclayer_to_MPAS(diag_physics)
!=============================================================================================
-!input arguments:
- type(mesh_type):: mesh
+!inout arguments:
type(diag_physics_type),intent(inout):: diag_physics
- type(sfc_input_type),intent(inout) :: sfc_input
- integer:: ip,iEdg
-
!---------------------------------------------------------------------------------------------
- do j = jts,jte
+ do j = jts,jte
do i = its,ite
-
diag_physics % br % array(i) = br_p(i,j)
+ diag_physics % cpm % array(i) = cpm_p(i,j)
diag_physics % cd % array(i) = cd_p(i,j)
diag_physics % cda % array(i) = cda_p(i,j)
diag_physics % chs % array(i) = chs_p(i,j)
diag_physics % chs2 % array(i) = chs2_p(i,j)
- diag_physics % cpm % array(i) = cpm_p(i,j)
- diag_physics % cqs2 % array(i) = cqs2_p(i,j)
diag_physics % ck % array(i) = ck_p(i,j)
diag_physics % cka % array(i) = cka_p(i,j)
- diag_physics % gz1oz0 % array(i) = gz1oz0_p(i,j)
+ diag_physics % cqs2 % array(i) = cqs2_p(i,j)
diag_physics % flhc % array(i) = flhc_p(i,j)
diag_physics % flqc % array(i) = flqc_p(i,j)
+ diag_physics % gz1oz0 % array(i) = gz1oz0_p(i,j)
diag_physics % hfx % array(i) = hfx_p(i,j)
- diag_physics % hpbl % array(i) = hpbl_p(i,j)
diag_physics % lh % array(i) = lh_p(i,j)
- diag_physics % mavail % array(i) = mavail_p(i,j)
diag_physics % mol % array(i) = mol_p(i,j)
- diag_physics % psim % array(i) = psim_p(i,j)
- diag_physics % psih % array(i) = psih_p(i,j)
- diag_physics % q2 % array(i) = q2_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 % psim % array(i) = psim_p(i,j)
+ diag_physics % psih % array(i) = psih_p(i,j)
diag_physics % regime % array(i) = regime_p(i,j)
diag_physics % rmol % array(i) = rmol_p(i,j)
- diag_physics % t2m % array(i) = t2m_p(i,j)
- diag_physics % th2m % array(i) = th2m_p(i,j)
- diag_physics % u10 % array(i) = u10_p(i,j)
diag_physics % ust % array(i) = ust_p(i,j)
diag_physics % ustm % array(i) = ustm_p(i,j)
- diag_physics % v10 % array(i) = v10_p(i,j)
diag_physics % wspd % array(i) = wspd_p(i,j)
diag_physics % zol % array(i) = zol_p(i,j)
diag_physics % znt % array(i) = znt_p(i,j)
-
- sfc_input % skintemp % array(i) = tsk_p(i,j)
-
+ !diagnostics:
+ diag_physics % q2 % array(i) = q2_p(i,j)
+ diag_physics % t2m % array(i) = t2m_p(i,j)
+ diag_physics % th2m % array(i) = th2m_p(i,j)
+ diag_physics % u10 % array(i) = u10_p(i,j)
+ diag_physics % v10 % array(i) = v10_p(i,j)
enddo
enddo
end subroutine sfclayer_to_MPAS
!=============================================================================================
- subroutine init_sfclayer(mesh,diag_physics,sfc_physics)
+ subroutine init_sfclayer
!=============================================================================================
-!input and output arguments:
-!---------------------------
- type(mesh_type),intent(in):: mesh
- type(diag_physics_type),intent(inout):: diag_physics
- type(sfc_physics_type) ,intent(inout):: sfc_physics
+!local variables:
+ logical:: allowed_to_read
!---------------------------------------------------------------------------------------------
write(0,*) '--- enter sfclayer_initialization:'
- do iCell = 1, mesh % nCells
- diag_physics % ust % array(iCell) = ust_min
-
- if(sfc_physics % xland % array(iCell) .lt. 1.5) then
- diag_physics % znt % array(iCell) = zzlnd
- diag_physics % mavail % array(iCell) = xmava
- else
- diag_physics % znt % array(iCell) = zzwtr
- diag_physics % mavail % array(iCell) = 1.0
- endif
+ sfclayer_select: select case (trim(sfclayer_scheme))
- enddo
+ case("monin_obukhov")
+ call sfclayinit(allowed_to_read)
+
+ case default
+
+ end select sfclayer_select
write(0,*) '--- end sfclayer_initialization'
end subroutine init_sfclayer
!=============================================================================================
- subroutine sfclayer_driver(itimestep,mesh,diag_physics,sfc_input,sfc_physics)
+ subroutine driver_sfclayer(mesh,diag_physics,sfc_input,sfc_physics)
!=============================================================================================
!input and inout arguments:
!--------------------------
- integer,intent(in):: itimestep
- type(mesh_type),intent(in):: mesh
+ type(mesh_type) ,intent(in):: mesh
+ type(sfc_input_type) ,intent(in):: sfc_input
+ type(sfc_physics_type) ,intent(in):: sfc_physics
type(diag_physics_type),intent(inout):: diag_physics
- type(sfc_input_type),intent(inout) :: sfc_input
- type(sfc_physics_type) ,intent(inout):: sfc_physics
!local variables:
!----------------
@@ -282,15 +258,12 @@
write(0,*)
write(0,*) '--- enter sfclayer_driver:'
-!copy all MPAS arrays to rectanguler grid arrays:
- call sfclayer_from_MPAS(mesh,diag_physics,sfc_input,sfc_physics)
- write(0,*) '--- end sfclayer_from_MPAS:'
+!copy all MPAS arrays to rectanguler grid:
+ call sfclayer_from_MPAS(diag_physics,sfc_input,sfc_physics)
sfclayer_select: select case (trim(sfclayer_scheme))
case("monin_obukhov")
- !initialization (this could be moved outside of the monin_obukhov surface scheme if an
- !other scheme needing the same arrays was used):
dx = sqrt(maxval(mesh % areaCell % array))
call sfclay( &
u3d = u_p , v3d = v_p , t3d = t_p , &
@@ -324,12 +297,10 @@
end select sfclayer_select
!copy all arrays back to the MPAS grid:
- call sfclayer_to_MPAS(mesh,diag_physics,sfc_input)
+ call sfclayer_to_MPAS(diag_physics)
- write(0,*) '--- end sfclayer_to_MPAS:'
+ end subroutine driver_sfclayer
- end subroutine sfclayer_driver
-
!=============================================================================================
end module module_driver_sfclayer
!=============================================================================================
</font>
</pre>