Skip to content

Commit

Permalink
Merge pull request NCAR#56 from climbfuji/tanya_ruc_init_updated
Browse files Browse the repository at this point in the history 
Updated version of "Move RUC LSM soil variables initialization to lsm_ruc_init" (PR 51)
  • Loading branch information
@DomHeinzeller
DomHeinzeller authored Oct 15, 2020
2 parents 9fae6f3 + 05b9aba commit 2caf579
Show file tree
Hide file tree
Showing 5 changed files with 657 additions and 226 deletions.
63 changes: 60 additions & 3 deletions physics/GFS_debug.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -311,7 +311,37 @@ module GFS_diagtoscreen

contains

subroutine GFS_diagtoscreen_init ()
!> \section arg_table_GFS_diagtoscreen_init Argument Table
!! \htmlinclude GFS_diagtoscreen_init.html
!!
subroutine GFS_diagtoscreen_init (Model, Data, Interstitial, errmsg, errflg)

use GFS_typedefs, only: GFS_control_type, GFS_data_type, &
GFS_interstitial_type

implicit none

!--- interface variables
type(GFS_control_type), intent(in) :: Model
type(GFS_data_type), intent(in) :: Data(:)
type(GFS_interstitial_type), intent(in) :: Interstitial(:)
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

!--- local variables
integer :: i

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0

do i=1,size(Data)
call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, &
Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, &
Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), &
size(Interstitial), i, errmsg, errflg)
end do

end subroutine GFS_diagtoscreen_init

subroutine GFS_diagtoscreen_finalize ()
Expand All @@ -330,7 +360,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
#ifdef OPENMP
use omp_lib
#endif
use machine, only: kind_phys
use GFS_typedefs, only: GFS_control_type, GFS_statein_type, &
GFS_stateout_type, GFS_sfcprop_type, &
GFS_coupling_type, GFS_grid_type, &
Expand Down Expand Up @@ -831,7 +860,35 @@ module GFS_interstitialtoscreen

contains

subroutine GFS_interstitialtoscreen_init ()
subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, errflg)

use GFS_typedefs, only: GFS_control_type, GFS_data_type, &
GFS_interstitial_type

implicit none

!--- interface variables
type(GFS_control_type), intent(in) :: Model
type(GFS_data_type), intent(in) :: Data(:)
type(GFS_interstitial_type), intent(in) :: Interstitial(:)
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errflg

!--- local variables
integer :: i

! Initialize CCPP error handling variables
errmsg = ''
errflg = 0


do i=1,size(Interstitial)
call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, &
Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, &
Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), &
size(Interstitial), -999, errmsg, errflg)
end do

end subroutine GFS_interstitialtoscreen_init

subroutine GFS_interstitialtoscreen_finalize ()
Expand Down
92 changes: 92 additions & 0 deletions physics/GFS_debug.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,52 @@
type = scheme
dependencies = machine.F

########################################################################
[ccpp-arg-table]
name = GFS_diagtoscreen_init
type = scheme
[Model]
standard_name = GFS_control_type_instance
long_name = instance of derived type GFS_control_type in FV3
units = DDT
dimensions = ()
type = GFS_control_type
intent = in
optional = F
[Data]
standard_name = GFS_data_type_instance_all_blocks
long_name = instance of derived type GFS_data_type
units = DDT
dimensions = (ccpp_block_count)
type = GFS_data_type
intent = in
optional = F
[Interstitial]
standard_name = GFS_interstitial_type_instance_all_threads
long_name = instance of derived type GFS_interstitial_type
units = DDT
dimensions = (omp_threads)
type = GFS_interstitial_type
intent = in
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
units = none
dimensions = ()
type = character
kind = len=*
intent = out
optional = F
[errflg]
standard_name = ccpp_error_flag
long_name = error flag for error handling in CCPP
units = flag
dimensions = ()
type = integer
intent = out
optional = F

########################################################################
[ccpp-arg-table]
name = GFS_diagtoscreen_run
Expand Down Expand Up @@ -135,6 +181,52 @@
type = scheme
dependencies = machine.F

########################################################################
[ccpp-arg-table]
name = GFS_interstitialtoscreen_init
type = scheme
[Model]
standard_name = GFS_control_type_instance
long_name = instance of derived type GFS_control_type in FV3
units = DDT
dimensions = ()
type = GFS_control_type
intent = in
optional = F
[Data]
standard_name = GFS_data_type_instance_all_blocks
long_name = instance of derived type GFS_data_type
units = DDT
dimensions = (ccpp_block_count)
type = GFS_data_type
intent = in
optional = F
[Interstitial]
standard_name = GFS_interstitial_type_instance_all_threads
long_name = instance of derived type GFS_interstitial_type
units = DDT
dimensions = (omp_threads)
type = GFS_interstitial_type
intent = in
optional = F
[errmsg]
standard_name = ccpp_error_message
long_name = error message for error handling in CCPP
units = none
dimensions = ()
type = character
kind = len=*
intent = out
optional = F
[errflg]
standard_name = ccpp_error_flag
long_name = error flag for error handling in CCPP
units = flag
dimensions = ()
type = integer
intent = out
optional = F

########################################################################
[ccpp-arg-table]
name = GFS_interstitialtoscreen_run
Expand Down
130 changes: 60 additions & 70 deletions physics/module_sf_ruclsm.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7022,8 +7022,8 @@ END SUBROUTINE SOILVEGIN
!> This subroutine computes liquid and forezen soil moisture from the
!! total soil moisture, and also computes soil moisture availability in
!! the top soil layer.
SUBROUTINE RUCLSMINIT( debug_print, landmask, &
nzs, isltyp, ivgtyp, xice, mavail, &
SUBROUTINE RUCLSMINIT( debug_print, slmsk, &
nzs, isltyp, ivgtyp, mavail, &
sh2o, smfr3d, tslb, smois, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
Expand All @@ -7035,35 +7035,32 @@ SUBROUTINE RUCLSMINIT( debug_print, landmask, &
#endif
IMPLICIT NONE
LOGICAL, INTENT(IN ) :: debug_print

REAL, DIMENSION( ims:ime), INTENT(IN ) :: slmsk

INTEGER, INTENT(IN ) :: &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
nzs

REAL, DIMENSION( ims:ime, 1:nzs, jms:jme ) , &
INTENT(IN) :: TSLB, &
SMOIS

REAL, DIMENSION( ims:ime, jms:jme ) , &
INTENT(IN) :: LANDMASK
REAL, DIMENSION( ims:ime, 1:nzs, jms:jme ) , &
INTENT(IN) :: TSLB, &
SMOIS

INTEGER, DIMENSION( ims:ime, jms:jme ) , &
INTENT(INOUT) :: ISLTYP,IVGTYP
INTEGER, DIMENSION( ims:ime, jms:jme ) , &
INTENT(INOUT) :: ISLTYP,IVGTYP

REAL, DIMENSION( ims:ime, 1:nzs, jms:jme ) , &
INTENT(INOUT) :: SMFR3D, &
SH2O
REAL, DIMENSION( ims:ime, 1:nzs, jms:jme ) , &
INTENT(OUT) :: SMFR3D, &
SH2O

REAL, DIMENSION( ims:ime, jms:jme ) , &
INTENT(INOUT) :: XICE,MAVAIL
REAL, DIMENSION( ims:ime, jms:jme ) , &
INTENT(OUT) :: MAVAIL

REAL, DIMENSION ( 1:nzs ) :: SOILIQW
!-- local
REAL, DIMENSION ( 1:nzs ) :: SOILIQW

!
INTEGER :: I,J,L,itf,jtf
REAL :: RIW,XLMELT,TLN,DQM,REF,PSIS,QMIN,BCLH
INTEGER :: I,J,L,itf,jtf
REAL :: RIW,XLMELT,TLN,DQM,REF,PSIS,QMIN,BCLH

INTEGER :: errflag

Expand All @@ -7077,9 +7074,7 @@ SUBROUTINE RUCLSMINIT( debug_print, landmask, &
errflag = 0
DO j = jts,jtf
DO i = its,itf
! land-only version
IF ( LANDMASK( i,j ) .NE. 1 ) CYCLE
!

IF ( ISLTYP( i,j ) .LT. 0 ) THEN
errflag = 1
print *, &
Expand All @@ -7096,65 +7091,60 @@ SUBROUTINE RUCLSMINIT( debug_print, landmask, &
DO J=jts,jtf
DO I=its,itf

! land-only version
IF ( LANDMASK( i,j ) .NE. 1 ) CYCLE

!--- Computation of volumetric content of ice in soil
!--- and initialize MAVAIL
if(ISLTYP(I,J) > 0) then
DQM = MAXSMC (ISLTYP(I,J)) - &
DRYSMC (ISLTYP(I,J))
REF = REFSMC (ISLTYP(I,J))
PSIS = - SATPSI (ISLTYP(I,J))
QMIN = DRYSMC (ISLTYP(I,J))
BCLH = BB (ISLTYP(I,J))
endif

! in Zobler classification isltyp=0 for water. Statsgo classification
! has isltyp=14 for water
if (isltyp(i,j) == 0) isltyp(i,j)=14

if(slmsk(i) == 1. ) then
!-- land
!-- Computate volumetric content of ice in soil
!-- and initialize MAVAIL
DQM = MAXSMC (ISLTYP(I,J)) - &
DRYSMC (ISLTYP(I,J))
REF = REFSMC (ISLTYP(I,J))
PSIS = - SATPSI (ISLTYP(I,J))
QMIN = DRYSMC (ISLTYP(I,J))
BCLH = BB (ISLTYP(I,J))

mavail(i,j) = max(0.00001,min(1.,(smois(i,1,j)-qmin)/(ref-qmin)))

! in Zobler classification isltyp=0 for water. Statsgo classification
! has isltyp=14 for water
if (isltyp(i,j) == 0) isltyp(i,j)=14
DO L=1,NZS
!-- for land points initialize soil ice
tln=log(TSLB(i,l,j)/273.15)

if(tln.lt.0.) then
soiliqw(l)=(dqm+qmin)*(XLMELT* &
(tslb(i,l,j)-273.15)/tslb(i,l,j)/9.81/psis) &
**(-1./bclh)
!**(-1./bclh)-qmin
soiliqw(l)=max(0.,soiliqw(l))
soiliqw(l)=min(soiliqw(l),smois(i,l,j))
sh2o(i,l,j)=soiliqw(l)
smfr3d(i,l,j)=(smois(i,l,j)-soiliqw(l))/RIW

else
smfr3d(i,l,j)=0.
sh2o(i,l,j)=smois(i,l,j)
endif
ENDDO

IF(xice(i,j).gt.0.) THEN
!-- for ice
elseif( slmsk(i) == 2.) then
!-- ice
mavail(i,j) = 1.
DO L=1,NZS
smfr3d(i,l,j)=1.
sh2o(i,l,j)=0.
mavail(i,j) = 1.
ENDDO
ELSE
if(isltyp(i,j).ne.14 ) then
!-- land
mavail(i,j) = max(0.00001,min(1.,(smois(i,1,j)-qmin)/(ref-qmin)))
DO L=1,NZS
!-- for land points initialize soil ice
tln=log(TSLB(i,l,j)/273.15)

if(tln.lt.0.) then
soiliqw(l)=(dqm+qmin)*(XLMELT* &
(tslb(i,l,j)-273.15)/tslb(i,l,j)/9.81/psis) &
**(-1./bclh)
! **(-1./bclh)-qmin
soiliqw(l)=max(0.,soiliqw(l))
soiliqw(l)=min(soiliqw(l),smois(i,l,j))
sh2o(i,l,j)=soiliqw(l)
smfr3d(i,l,j)=(smois(i,l,j)-soiliqw(l))/RIW

else
smfr3d(i,l,j)=0.
sh2o(i,l,j)=smois(i,l,j)
endif
ENDDO

else
!-- for water ISLTYP=14
!-- water ISLTYP=14
mavail(i,j) = 1.
DO L=1,NZS
smfr3d(i,l,j)=0.
sh2o(i,l,j)=1.
mavail(i,j) = 1.
ENDDO
endif
ENDIF

endif ! land

ENDDO
ENDDO
Expand Down
Loading

0 comments on commit 2caf579

Please sign in to comment.