Skip to content

Commit

Permalink
Updated Fengsha variables for UTHRES in geofiles
Browse files Browse the repository at this point in the history
  • Loading branch information
Patrick.C.Campbell@noaa.gov authored and Patrick.C.Campbell@noaa.gov committed Jun 30, 2020
1 parent ef2f28b commit ff75c94
Show file tree
Hide file tree
Showing 37 changed files with 270 additions and 45 deletions.
2 changes: 1 addition & 1 deletion parallel/scripts/run-nacc-fv3.ksh
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ export NODES=12
APPL=aqm.t12z
InMetDir=/gpfs/hps2/ptmp/$USER/NACC-Fengsha-Test
InGeoDir=$InMetDir
OutDir=/gpfs/hps2/ptmp/$USER/NACC-Fengsha-Test/output
OutDir=/gpfs/hps2/ptmp/$USER/NACC-Fengsha-Test/output_nofengsha
ProgDir=/gpfs/hps3/emc/naqfc/noscrub/Patrick.C.Campbell/NACC/parallel/src

if [ ! -s $InMetDir ]; then
Expand Down
27 changes: 14 additions & 13 deletions parallel/src/alloc_ctm.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -209,7 +209,7 @@ SUBROUTINE alloc_ctm
npxwrf41 = 0
ENDIF

nfld2dxyt = 33 + nwr + nsoil2d + npxwrf41
nfld2dxyt = 34 + nwr + nsoil2d + npxwrf41

ALLOCATE ( fld2dxyt ( nfld2dxyt ) )

Expand Down Expand Up @@ -250,26 +250,27 @@ SUBROUTINE alloc_ctm
c_sandf => fld2dxyt(31)
c_drag => fld2dxyt(32)
c_ssm => fld2dxyt(33)
c_uthr => fld2dxyt(34)

IF ( ifwr ) THEN
c_wr => fld2dxyt(33+nwr)
c_wr => fld2dxyt(34+nwr)
ENDIF

IF ( ifsoil ) THEN
c_soim1 => fld2dxyt(33+nwr+1)
c_soim2 => fld2dxyt(33+nwr+2)
c_soit1 => fld2dxyt(33+nwr+3)
c_soit2 => fld2dxyt(33+nwr+4)
c_sltyp => fld2dxyt(33+nwr+5)
c_soim1 => fld2dxyt(34+nwr+1)
c_soim2 => fld2dxyt(34+nwr+2)
c_soit1 => fld2dxyt(34+nwr+3)
c_soit2 => fld2dxyt(34+nwr+4)
c_sltyp => fld2dxyt(34+nwr+5)
ENDIF

IF ( ifpxwrf41 ) THEN
c_wsat_px => fld2dxyt(33+nwr+nsoil2d+1)
c_wfc_px => fld2dxyt(33+nwr+nsoil2d+2)
c_wwlt_px => fld2dxyt(33+nwr+nsoil2d+3)
c_csand_px => fld2dxyt(33+nwr+nsoil2d+4)
c_fmsand_px => fld2dxyt(33+nwr+nsoil2d+5)
c_clay_px => fld2dxyt(33+nwr+nsoil2d+6)
c_wsat_px => fld2dxyt(34+nwr+nsoil2d+1)
c_wfc_px => fld2dxyt(34+nwr+nsoil2d+2)
c_wwlt_px => fld2dxyt(34+nwr+nsoil2d+3)
c_csand_px => fld2dxyt(34+nwr+nsoil2d+4)
c_fmsand_px => fld2dxyt(34+nwr+nsoil2d+5)
c_clay_px => fld2dxyt(34+nwr+nsoil2d+6)
ENDIF

!-------------------------------------------------------------------------------
Expand Down
12 changes: 8 additions & 4 deletions parallel/src/alloc_met.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -206,22 +206,26 @@ SUBROUTINE alloc_met
ALLOCATE ( lai (ix, jy) )
ENDIF

IF ( ifclayf ) THEN ! leaf area index available
IF ( ifclayf ) THEN ! clay fraction available
ALLOCATE ( clayf (met_nx, met_ny) )
ENDIF

IF ( ifsandf ) THEN ! leaf area index available
IF ( ifsandf ) THEN ! sand fraction available
ALLOCATE ( sandf (met_nx, met_ny) )
ENDIF

IF ( ifdrag ) THEN ! leaf area index available
IF ( ifdrag ) THEN ! drag paritiion available
ALLOCATE ( drag (met_nx, met_ny) )
ENDIF

IF ( ifssm ) THEN ! leaf area index available
IF ( ifssm ) THEN ! sediment supply map available
ALLOCATE ( ssm (met_nx, met_ny) )
ENDIF

IF ( ifuthr ) THEN ! threshold velocity available
ALLOCATE ( uthr (met_nx, met_ny) )
ENDIF

IF ( ifmol ) THEN ! Monin-Obukhov length available
ALLOCATE ( mol (ix, jy) )
ENDIF
Expand Down
1 change: 1 addition & 0 deletions parallel/src/alloc_x.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -168,6 +168,7 @@ SUBROUTINE alloc_x
ALLOCATE ( xsandf (ncols_x, nrows_x) )
ALLOCATE ( xdrag (ncols_x, nrows_x) )
ALLOCATE ( xssm (ncols_x, nrows_x) )
ALLOCATE ( xuthr (ncols_x, nrows_x) )
ALLOCATE ( xveg (ncols_x, nrows_x) )

ALLOCATE ( xwstar (ncols_x, nrows_x) )
Expand Down
7 changes: 4 additions & 3 deletions parallel/src/ctmproc.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -323,10 +323,11 @@ END SUBROUTINE collapx
c_snocov%fld(col,row) = xsnocov(c,r)
c_veg%fld(col,row) = xveg(c,r)
c_lai%fld(col,row) = xlai(c,r)
c_clayf%fld(col,row) = xclayf(c,r)
c_sandf%fld(col,row) = xsandf(c,r)
c_drag%fld(col,row) = xdrag(c,r)
c_clayf%fld(col,row) = xclayf(c,r)
c_sandf%fld(col,row) = xsandf(c,r)
c_drag%fld(col,row) = xdrag(c,r)
c_ssm%fld(col,row) = xssm(c,r)
c_uthr%fld(col,row) = xuthr(c,r)
c_seaice%fld(col,row) = xseaice(c,r)
c_snowh%fld(col,row) = xsnowh(c,r)

Expand Down
1 change: 1 addition & 0 deletions parallel/src/ctmvars_mod.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -141,6 +141,7 @@ MODULE ctmvars
TYPE(fld2ddata), POINTER :: c_sandf
TYPE(fld2ddata), POINTER :: c_drag
TYPE(fld2ddata), POINTER :: c_ssm
TYPE(fld2ddata), POINTER :: c_uthr
TYPE(fld2ddata), POINTER :: c_seaice
TYPE(fld2ddata), POINTER :: c_snowh
TYPE(fld2ddata), POINTER :: c_wr
Expand Down
1 change: 1 addition & 0 deletions parallel/src/dealloc_ctm.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -177,6 +177,7 @@ SUBROUTINE dealloc_ctm
NULLIFY ( c_sandf )
NULLIFY ( c_drag )
NULLIFY ( c_ssm )
NULLIFY ( c_uthr )

IF ( ASSOCIATED ( c_wr ) ) NULLIFY ( c_wr )
IF ( ASSOCIATED ( c_soim1 ) ) NULLIFY ( c_soim1 )
Expand Down
1 change: 1 addition & 0 deletions parallel/src/dealloc_met.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -155,6 +155,7 @@ SUBROUTINE dealloc_met
IF ( ALLOCATED ( sandf ) ) DEALLOCATE ( sandf )
IF ( ALLOCATED ( drag ) ) DEALLOCATE ( drag )
IF ( ALLOCATED ( ssm ) ) DEALLOCATE ( ssm )
IF ( ALLOCATED ( uthr ) ) DEALLOCATE ( uthr )
IF ( ALLOCATED ( mol ) ) DEALLOCATE ( mol )
IF ( ALLOCATED ( ra ) ) DEALLOCATE ( ra )
IF ( ALLOCATED ( rstom ) ) DEALLOCATE ( rstom )
Expand Down
1 change: 1 addition & 0 deletions parallel/src/dealloc_x.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -147,6 +147,7 @@ SUBROUTINE dealloc_x
DEALLOCATE ( xsandf )
DEALLOCATE ( xdrag )
DEALLOCATE ( xssm )
DEALLOCATE ( xuthr )
DEALLOCATE ( xveg )

DEALLOCATE ( xwstar )
Expand Down
11 changes: 11 additions & 0 deletions parallel/src/init_ctm.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -685,6 +685,17 @@ SUBROUTINE init_ctm
c_ssm%iend(1) = nx
c_ssm%iend(2) = ny

c_uthr%fld = fillreal
c_uthr%fldname = 'UTHR'
c_uthr%long_name = 'threshold velocity'
c_uthr%units = 'm s-1'
c_uthr%dimnames(1) = 'nx'
c_uthr%dimnames(2) = 'ny'
c_uthr%istart(1) = 1
c_uthr%istart(2) = 1
c_uthr%iend(1) = nx
c_uthr%iend(2) = ny

c_seaice%fld = fillreal
c_seaice%fldname = 'SEAICE'
c_seaice%long_name = 'sea ice'
Expand Down
1 change: 1 addition & 0 deletions parallel/src/init_met.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,6 +143,7 @@ SUBROUTINE init_met
IF ( ALLOCATED ( sandf ) ) sandf (:,:) = 0.0
IF ( ALLOCATED ( drag ) ) drag (:,:) = 0.0
IF ( ALLOCATED ( ssm ) ) ssm (:,:) = 0.0
IF ( ALLOCATED ( uthr ) ) uthr (:,:) = 0.0
IF ( ALLOCATED ( mol ) ) mol (:,:) = 0.0
IF ( ALLOCATED ( qfx ) ) qfx (:,:) = 0.0
IF ( ALLOCATED ( ra ) ) ra (:,:) = 0.0
Expand Down
1 change: 1 addition & 0 deletions parallel/src/init_x.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -116,6 +116,7 @@ SUBROUTINE init_x
xhfx (:,:) = fillreal ; xlai (:,:) = fillreal
xclayf (:,:) = fillreal ; xsandf (:,:) = fillreal
xdrag (:,:) = fillreal ; xssm (:,:) = fillreal
xuthr (:,:) = fillreal
xlatc (:,:) = fillreal ; xlatd (:,:) = fillreal
xlatu (:,:) = fillreal ; xlatv (:,:) = fillreal
xlh (:,:) = fillreal ; xlonc (:,:) = fillreal
Expand Down
2 changes: 2 additions & 0 deletions parallel/src/mcipparm_mod.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -247,6 +247,8 @@ MODULE mcipparm
LOGICAL :: ifdragwrfout ! drag partition in WRF history?
LOGICAL :: ifssm ! sediment supply map in input file?
LOGICAL :: ifssmwrfout ! sediment supply map in WRF history?
LOGICAL :: ifuthr ! threshold velocity in input file?
LOGICAL :: ifuthrwrfout ! threshold velocity in WRF history?
LOGICAL :: iflufrc ! fractional land use available?
LOGICAL :: ifluwrfout ! is fractional land use in WRF history?
LOGICAL :: iflu2wrfout ! is fractional land use 2 in WRF history?
Expand Down
4 changes: 4 additions & 0 deletions parallel/src/metvars2ctm.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -456,6 +456,10 @@ END SUBROUTINE layht
xssm(:,:) = ssm(sc:ec,sr:er)
ENDIF

IF ( ifuthr) THEN
xuthr(:,:) = uthr(sc:ec,sr:er)
ENDIF

IF ( ifveg ) THEN
xveg (:,:) = veg (sc:ec,sr:er)
ELSE
Expand Down
1 change: 1 addition & 0 deletions parallel/src/metvars_mod.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,7 @@ MODULE metvars
REAL, ALLOCATABLE :: sandf ( : , : )
REAL, ALLOCATABLE :: drag ( : , : )
REAL, ALLOCATABLE :: ssm ( : , : )
REAL, ALLOCATABLE :: uthr ( : , : )
REAL, ALLOCATABLE :: lai_mos ( : , : , : )
REAL, ALLOCATABLE :: lai_px ( : , : )
REAL, ALLOCATABLE :: landmask ( : , : )
Expand Down
45 changes: 45 additions & 0 deletions parallel/src/rdfv3.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1610,6 +1610,51 @@ END SUBROUTINE windrotation
ENDIF
ENDIF

IF ( ifuthr ) THEN
IF ( ifuthrwrfout ) THEN ! uthr in FV3 history file
CALL get_var_2d_real_cdf (cdfid2, 'UTHRES', dum2d, it, rcode)
IF ( rcode == nf90_noerr ) THEN
call myinterp(dum2d,met_nx,met_ny,atmp,xindex,yindex,ncols_x,nrows_x,1)
uthr(1:ncols_x,1:nrows_x) = atmp(1:ncols_x,1:nrows_x)
! IF ( ABS(MAXVAL(ssm)) < smallnum ) THEN
! IF ( met_soil_lsm == 2 ) THEN ! NOAH LSM
! ssm(:,:) = 1.0e-6
! ENDIF
! ENDIF
WRITE (*,ifmt2) 'UTHR ',(uthr(lprt_metx,lprt_mety))
ELSE
WRITE (*,f9400) TRIM(pname), 'UTHR', TRIM(nf90_strerror(rcode))
CALL graceful_stop (pname)
ENDIF
ELSE ! uthr in GEOGRID file from WPS
flg = file_geo
rcode = nf90_open (flg, nf90_nowrite, cdfidg)
IF ( rcode /= nf90_noerr ) THEN
WRITE (*,f9900) TRIM(pname)
CALL graceful_stop (pname)
ENDIF
CALL get_var_2d_real_cdf (cdfidg, 'UTHRES', dum2d, 1, rcode)
IF ( rcode == nf90_noerr ) THEN
call myinterp(dum2d,met_nx,met_ny,atmp,xindex,yindex,ncols_x,nrows_x,1)
uthr(1:ncols_x,1:nrows_x) = atmp(1:ncols_x,1:nrows_x)
! SSM check over water, set as negative numbers for improved error checking
! WHERE ( (INT(landmask) == 0) ) ! FV3 water = 0 and CLAYF < 0.0
! ssm = -1.0
! END WHERE
WRITE (*,ifmt2) 'UTHR ', uthr(lprt_metx,lprt_mety)
ELSE
WRITE (*,f9400) TRIM(pname), 'UTHR', TRIM(nf90_strerror(rcode))
CALL graceful_stop (pname)
ENDIF
rcode = nf90_close (cdfidg)
IF ( rcode /= nf90_noerr ) THEN
WRITE (*,f9950) TRIM(pname)
CALL graceful_stop (pname)
ENDIF
ENDIF
ENDIF


IF ( iflai ) THEN
IF ( iflaiwrfout ) THEN ! leaf area index in FV3 history file
CALL get_var_2d_real_cdf (cdfid2, 'LAI', dum2d, it, rcode)
Expand Down
7 changes: 7 additions & 0 deletions parallel/src/setgriddefs.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -688,6 +688,13 @@ SUBROUTINE setgriddefs
ENDIF
WRITE (*,f6150) 'SSM', TRIM(yesno)

IF ( ifuthr ) THEN
yesno = ''
ELSE
yesno = 'NOT'
ENDIF
WRITE (*,f6150) 'UTHRES', TRIM(yesno)

IF ( iflufrc ) THEN
yesno = ''
ELSE
Expand Down
33 changes: 31 additions & 2 deletions parallel/src/setup_fv3.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -897,9 +897,38 @@ SUBROUTINE setup_fv3 (cdfid, cdfid2, ctmlays)
ENDIF
ENDIF

rcode2 = nf90_inq_varid (cdfid2, 'UTHRES', varid) !not in FV3GFSv16
IF ( rcode2 == nf90_noerr ) THEN
ifuthr = .TRUE. ! threshold velocity is in the file
ifuthrwrfout = .TRUE. ! threshold velocity is not in the file
ELSE
ifuthrwrfout = .FALSE. ! threshold velocity is not available in FV3 history
geofile = TRIM( file_geo )
INQUIRE ( FILE=geofile, EXIST=ifgeo )
IF ( .NOT. ifgeo ) THEN
WRITE (*,f9900) TRIM(pname)
ifuthr = .FALSE.
ELSE
flg = file_geo
rcode = nf90_open (flg, nf90_nowrite, cdfidg)



IF ( rcode /= nf90_noerr ) THEN
WRITE (*,f9600) TRIM(pname), TRIM(flg)
CALL graceful_stop (pname)
ENDIF
rcode = nf90_inq_varid (cdfidg, 'UTHRES', varid)
IF ( rcode == nf90_noerr ) THEN
ifuthr = .TRUE. ! threshold velocity is in the file
ELSE
ifuthr = .FALSE. ! threshold velocity is not in the file
ENDIF
rcode = nf90_close (cdfidg)
IF ( rcode /= nf90_noerr ) THEN
WRITE (*,f9700) TRIM(pname),TRIM(flg)
CALL graceful_stop (pname)
ENDIF
ENDIF
ENDIF

rcode2 = nf90_inq_varid (cdfid2, 'LAI', varid) !not in FV3GFSv16
IF ( rcode2 == nf90_noerr ) THEN
Expand Down
5 changes: 3 additions & 2 deletions parallel/src/xvars_mod.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -197,8 +197,9 @@ MODULE xvars
REAL, ALLOCATABLE :: xlai ( : , : ) ! leaf area index [m2/m2]
REAL, ALLOCATABLE :: xclayf ( : , : ) ! soil clay fraction [decimal]
REAL, ALLOCATABLE :: xsandf ( : , : ) ! soil sand fraction [decimal]
REAL, ALLOCATABLE :: xdrag ( : , : ) ! drag partition [decimal]
REAL, ALLOCATABLE :: xssm ( : , : ) ! sediment supply map [decimal]
REAL, ALLOCATABLE :: xdrag ( : , : ) ! drag partition []
REAL, ALLOCATABLE :: xssm ( : , : ) ! sediment supply map []
REAL, ALLOCATABLE :: xuthr ( : , : ) ! threshold velocity [m/s]
REAL, ALLOCATABLE :: xveg ( : , : ) ! vegetation coverage [decimal]
REAL, ALLOCATABLE :: xsltyp ( : , : ) ! soil texture type [category]

Expand Down
27 changes: 14 additions & 13 deletions serial/src/alloc_ctm.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -209,7 +209,7 @@ SUBROUTINE alloc_ctm
npxwrf41 = 0
ENDIF

nfld2dxyt = 33 + nwr + nsoil2d + npxwrf41
nfld2dxyt = 34 + nwr + nsoil2d + npxwrf41

ALLOCATE ( fld2dxyt ( nfld2dxyt ) )

Expand Down Expand Up @@ -250,26 +250,27 @@ SUBROUTINE alloc_ctm
c_sandf => fld2dxyt(31)
c_drag => fld2dxyt(32)
c_ssm => fld2dxyt(33)
c_uthr => fld2dxyt(34)

IF ( ifwr ) THEN
c_wr => fld2dxyt(29+nwr)
c_wr => fld2dxyt(34+nwr)
ENDIF

IF ( ifsoil ) THEN
c_soim1 => fld2dxyt(29+nwr+1)
c_soim2 => fld2dxyt(29+nwr+2)
c_soit1 => fld2dxyt(29+nwr+3)
c_soit2 => fld2dxyt(29+nwr+4)
c_sltyp => fld2dxyt(29+nwr+5)
c_soim1 => fld2dxyt(34+nwr+1)
c_soim2 => fld2dxyt(34+nwr+2)
c_soit1 => fld2dxyt(34+nwr+3)
c_soit2 => fld2dxyt(34+nwr+4)
c_sltyp => fld2dxyt(34+nwr+5)
ENDIF

IF ( ifpxwrf41 ) THEN
c_wsat_px => fld2dxyt(29+nwr+nsoil2d+1)
c_wfc_px => fld2dxyt(29+nwr+nsoil2d+2)
c_wwlt_px => fld2dxyt(29+nwr+nsoil2d+3)
c_csand_px => fld2dxyt(29+nwr+nsoil2d+4)
c_fmsand_px => fld2dxyt(29+nwr+nsoil2d+5)
c_clay_px => fld2dxyt(29+nwr+nsoil2d+6)
c_wsat_px => fld2dxyt(34+nwr+nsoil2d+1)
c_wfc_px => fld2dxyt(34+nwr+nsoil2d+2)
c_wwlt_px => fld2dxyt(34+nwr+nsoil2d+3)
c_csand_px => fld2dxyt(34+nwr+nsoil2d+4)
c_fmsand_px => fld2dxyt(34+nwr+nsoil2d+5)
c_clay_px => fld2dxyt(34+nwr+nsoil2d+6)
ENDIF

!-------------------------------------------------------------------------------
Expand Down
4 changes: 4 additions & 0 deletions serial/src/alloc_met.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -210,6 +210,10 @@ SUBROUTINE alloc_met
ALLOCATE ( ssm (met_nx, met_ny) )
ENDIF

IF ( ifuthr ) THEN ! threshold velocity available
ALLOCATE ( uthr (met_nx, met_ny) )
ENDIF

IF ( ifmol ) THEN ! Monin-Obukhov length available
ALLOCATE ( mol (met_nx, met_ny) )
ENDIF
Expand Down
1 change: 1 addition & 0 deletions serial/src/alloc_x.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -168,6 +168,7 @@ SUBROUTINE alloc_x
ALLOCATE ( xsandf (ncols_x, nrows_x) )
ALLOCATE ( xdrag (ncols_x, nrows_x) )
ALLOCATE ( xssm (ncols_x, nrows_x) )
ALLOCATE ( xuthr (ncols_x, nrows_x) )
ALLOCATE ( xveg (ncols_x, nrows_x) )

ALLOCATE ( xwstar (ncols_x, nrows_x) )
Expand Down
Loading

0 comments on commit ff75c94

Please sign in to comment.