From 7e2c86cc71f6dc455cb36cd7d35c7024130a8af6 Mon Sep 17 00:00:00 2001 From: weiwangncar Date: Sat, 27 Jan 2024 21:46:20 -0700 Subject: [PATCH] This is in preparation to make sfclayrev module ccpp-compliant: - module_sf_sfclayrev.F: removed the call to shalwater_init, and moved subroutine to module_physics_init.F. - module_physics_init.F: added call to shalwater_init, and subroutine. --- phys/module_physics_init.F | 71 ++++++++++++++++++++++++++++++--- phys/module_sf_sfclayrev.F | 80 +------------------------------------- 2 files changed, 67 insertions(+), 84 deletions(-) diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F index 0a8595b1e5..76df999a4e 100644 --- a/phys/module_physics_init.F +++ b/phys/module_physics_init.F @@ -3137,11 +3137,14 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & CALL sfclayinit( allowed_to_read ) isfc = 1 CASE (SFCLAYREVSCHEME) - CALL sfclayrevinit(ims,ime,jms,jme, & - its,ite,jts,jte, & - bathymetry_flag, shalwater_z0, & - shalwater_depth, water_depth, & - xland,LakeModel,lake_depth,lakemask ) + CALL sfclayrevinit + IF ( shalwater_z0 .EQ. 1 ) THEN + CALL shalwater_init(ims,ime,jms,jme, & + its,ite,jts,jte, & + bathymetry_flag, shalwater_z0, & + shalwater_depth, water_depth, & + xland,LakeModel,lake_depth,lakemask ) + END IF isfc = 1 CASE (PXSFCSCHEME) CALL pxsfclayinit( allowed_to_read ) @@ -5658,4 +5661,62 @@ subroutine compute_2d_dx_area(dx, dy, msftx, msfty, dx2d, area2d, & end subroutine compute_2d_dx_area + SUBROUTINE shalwater_init(ims,ime,jms,jme, & + its,ite,jts,jte, & + bathymetry_flag, shalwater_z0, & + shalwater_depth, water_depth, & + xland,LakeModel,lake_depth,lakemask ) + + INTEGER, INTENT(IN) :: ims,ime,jms,jme,its,ite,jts,jte + INTEGER, INTENT(IN) :: shalwater_z0 + REAL, INTENT(IN) :: shalwater_depth + INTEGER, INTENT(IN) :: bathymetry_flag + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: water_depth + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: xland + INTEGER :: LakeModel + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: lake_depth + REAL, DIMENSION( ims:ime, jms:jme ) :: lakemask + + ! Local + LOGICAL :: overwrite_water_depth + + overwrite_water_depth = .False. + + IF ( bathymetry_flag .eq. 1 ) THEN + IF ( shalwater_depth .LE. 0.0 ) THEN + IF ( LakeModel .ge. 1 ) THEN + + DO j = jts,jte + DO i = its,ite + IF ( lakemask(i,j) .EQ. 1 ) THEN + water_depth(i,j) = lake_depth(i,j) + END IF + END DO + END DO + END IF + ELSE + overwrite_water_depth = .True. + END IF + ELSE + IF ( shalwater_depth .GT. 0.0 ) THEN + overwrite_water_depth = .True. + ELSE + CALL wrf_error_fatal('No bathymetry data detected and shalwater_depth not greater than 0.0. Re-run WPS to get bathymetry data or set shalwater_depth > 0.0') + END IF + END IF + + IF (overwrite_water_depth) THEN + DO j = jts,jte + DO i = its,ite + IF((XLAND(i,j)-1.5).GE.0)THEN + water_depth(i,j) = shalwater_depth + ELSE + water_depth(i,j) = -2.0 + END IF + END DO + END DO + END IF + + END SUBROUTINE shalwater_init + END MODULE module_physics_init diff --git a/phys/module_sf_sfclayrev.F b/phys/module_sf_sfclayrev.F index 48642fa866..b8c83324ac 100644 --- a/phys/module_sf_sfclayrev.F +++ b/phys/module_sf_sfclayrev.F @@ -1107,25 +1107,11 @@ SUBROUTINE SFCLAYREV1D(J,UX,VX,T1D,QV1D,P1D,dz8w1d, & END SUBROUTINE SFCLAYREV1D !==================================================================== - SUBROUTINE sfclayrevinit(ims,ime,jms,jme, & - its,ite,jts,jte, & - bathymetry_flag, shalwater_z0, & - shalwater_depth, water_depth, & - xland,LakeModel,lake_depth,lakemask ) + SUBROUTINE sfclayrevinit INTEGER :: N REAL :: zolf - INTEGER, INTENT(IN) :: ims,ime,jms,jme,its,ite,jts,jte - INTEGER, INTENT(IN) :: shalwater_z0 - REAL, INTENT(IN) :: shalwater_depth - INTEGER, INTENT(IN) :: bathymetry_flag - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: water_depth - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: xland - INTEGER :: LakeModel - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: lake_depth - REAL, DIMENSION( ims:ime, jms:jme ) :: lakemask - DO N=0,1000 ! stable function tables zolf = float(n)*0.01 @@ -1138,73 +1124,9 @@ SUBROUTINE sfclayrevinit(ims,ime,jms,jme, & psih_unstab(n)=psih_unstable_full(zolf) ENDDO - IF ( shalwater_z0 .EQ. 1 ) THEN - CALL shalwater_init(ims,ime,jms,jme, & - its,ite,jts,jte, & - bathymetry_flag, shalwater_z0, & - shalwater_depth, water_depth, & - xland,LakeModel,lake_depth,lakemask ) - END IF END SUBROUTINE sfclayrevinit - SUBROUTINE shalwater_init(ims,ime,jms,jme, & - its,ite,jts,jte, & - bathymetry_flag, shalwater_z0, & - shalwater_depth, water_depth, & - xland,LakeModel,lake_depth,lakemask ) - - INTEGER, INTENT(IN) :: ims,ime,jms,jme,its,ite,jts,jte - INTEGER, INTENT(IN) :: shalwater_z0 - REAL, INTENT(IN) :: shalwater_depth - INTEGER, INTENT(IN) :: bathymetry_flag - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: water_depth - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: xland - INTEGER :: LakeModel - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: lake_depth - REAL, DIMENSION( ims:ime, jms:jme ) :: lakemask - - ! Local - LOGICAL :: overwrite_water_depth - - overwrite_water_depth = .False. - - IF ( bathymetry_flag .eq. 1 ) THEN - IF ( shalwater_depth .LE. 0.0 ) THEN - IF ( LakeModel .ge. 1 ) THEN - DO j = jts,jte - DO i = its,ite - IF ( lakemask(i,j) .EQ. 1 ) THEN - water_depth(i,j) = lake_depth(i,j) - END IF - END DO - END DO - END IF - ELSE - overwrite_water_depth = .True. - END IF - ELSE - IF ( shalwater_depth .GT. 0.0 ) THEN - overwrite_water_depth = .True. - ELSE - CALL wrf_error_fatal('No bathymetry data detected and shalwater_depth not greater than 0.0. Re-run WPS to get bathymetry data or set shalwater_depth > 0.0') - END IF - END IF - - IF (overwrite_water_depth) THEN - DO j = jts,jte - DO i = its,ite - IF((XLAND(i,j)-1.5).GE.0)THEN - water_depth(i,j) = shalwater_depth - ELSE - water_depth(i,j) = -2.0 - END IF - END DO - END DO - END IF - - END SUBROUTINE shalwater_init - function zolri(ri,z,z0) ! if (ri.lt.0.)then