Skip to content

Commit

Permalink
Allow FVCOM tools to Update Ice Surface Roughness Length (ufs-communi…
Browse files Browse the repository at this point in the history 
…ty#604)

* Update zorl for ice points in surface data file

* Change warm start ice roughness length variable name to zorli

* Change warm/cold start surface roughness var names in output nc file

* Include ice thickness processing

* Change ice roughness length from 1.0 to 1.1

* Zorli set to Fill_Value when ice is removed

Co-authored-by: JeffBeck-NOAA <55201531+JeffBeck-NOAA@users.noreply.github.com>
  • Loading branch information
@dmwright526 @JeffBeck-NOAA
dmwright526 and JeffBeck-NOAA authored Dec 15, 2021
1 parent 2a08859 commit f41d894
Show file tree
Hide file tree
Showing 2 changed files with 78 additions and 13 deletions.
61 changes: 54 additions & 7 deletions sorc/fvcom_tools.fd/module_nwp.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,8 @@ module module_nwp
integer :: i_sfcT !< Index of sst temp var.
integer :: i_iceT !< Index of ice temp var.
integer :: i_sfcTl !< Index of sfcTl
integer :: i_zorl !< Index of surface roughness
integer :: i_hice !< Index of ice thickness
character(len=20), allocatable :: varnames(:) !< Variable names.
character(len=20), allocatable :: latname !< Latitude name.
character(len=20), allocatable :: lonname !< Longitude name.
Expand All @@ -52,13 +54,17 @@ module module_nwp
real(r_kind), allocatable :: nwp_ice_c(:,:,:) !< cold start over water ice concentration 3d array
real(r_kind), allocatable :: nwp_sfct_c(:,:,:) !< cold start skin temperature 3d array
real(r_kind), allocatable :: nwp_icet_c(:,:,:) !< cold start ice skin temperature 3d array
real(r_kind), allocatable :: nwp_zorl_c(:,:,:) !< cold start surface roughness
real(r_kind), allocatable :: nwp_hice_c(:,:,:) !< cold start ice thickness

real(r_kind), allocatable :: nwp_mask_w(:,:) !< warm start land/water mask 3d array
real(r_kind), allocatable :: nwp_sst_w(:,:) !< warm start sst 3d array
real(r_kind), allocatable :: nwp_ice_w(:,:) !< warm start over water ice concentration 3d array
real(r_kind), allocatable :: nwp_sfct_w(:,:) !< warm start skin temperature 3d array
real(r_kind), allocatable :: nwp_icet_w(:,:) !< warm start ice skin temperature 3d array
real(r_kind), allocatable :: nwp_sfctl_w(:,:) !< warm start skin temperature 3d array
real(r_kind), allocatable :: nwp_zorl_w(:,:) !< warm start surface roughness
real(r_kind), allocatable :: nwp_hice_w(:,:) !< warm start ice thickness

end type nwp_type

Expand Down Expand Up @@ -99,19 +105,22 @@ subroutine initial_nwp(this,itype,wcstart)
! FVCOM grid
if (itype==' FVCOM') then
this%datatype = itype
this%numvar = 4
this%numvar = 5

this%i_mask = 1
this%i_sst = 2
this%i_ice = 3
this%i_iceT = 4
this%i_hice = 5
this%i_sfcT = 0
this%i_zorl = 0

allocate(this%varnames(this%numvar))
this%varnames(1) = 'glmask'
this%varnames(2) = 'tsfc'
this%varnames(3) = 'aice'
this%varnames(4) = 'tisfc'
this%varnames(5) = 'vice'

allocate(this%latname)
allocate(this%lonname)
Expand All @@ -131,14 +140,16 @@ subroutine initial_nwp(this,itype,wcstart)

else if (trim(itype)=='FV3LAM' .AND. wcstart=='warm') then
this%datatype = itype
this%numvar = 6
this%numvar = 8

this%i_mask = 1
this%i_sst = 2
this%i_ice = 3
this%i_iceT = 4
this%i_sfcT = 5
this%i_sfcTl= 6
this%i_zorl = 7
this%i_hice = 8

allocate(this%varnames(this%numvar))
this%varnames(1) = 'slmsk'
Expand All @@ -147,6 +158,8 @@ subroutine initial_nwp(this,itype,wcstart)
this%varnames(4) = 'tisfc'
this%varnames(5) = 'tsfc'
this%varnames(6) = 'tsfcl'
this%varnames(7) = 'zorli'
this%varnames(8) = 'hice'

allocate(this%latname)
allocate(this%lonname)
Expand All @@ -162,19 +175,23 @@ subroutine initial_nwp(this,itype,wcstart)

else if (trim(itype)=='FV3LAM' .AND. wcstart=='cold') then
this%datatype = itype
this%numvar = 4
this%numvar = 6

this%i_mask = 1
this%i_sst = 2
this%i_ice = 3
this%i_iceT = 4
this%i_zorl = 5
this%i_hice = 6
this%i_sfcT = 0

allocate(this%varnames(this%numvar))
this%varnames(1) = 'slmsk'
this%varnames(2) = 'tsea'
this%varnames(3) = 'fice'
this%varnames(4) = 'tisfc'
this%varnames(5) = 'zorl'
this%varnames(6) = 'hice'

allocate(this%latname)
allocate(this%lonname)
Expand Down Expand Up @@ -246,9 +263,11 @@ end subroutine list_initial_nwp
!! @param[inout] sfcT Skin Temperature
!! @param[inout] iceT Ice Skin Temperature
!! @param[inout] sfcTl Skin Temperature in restart file
!! @param[inout] zorl Surface roughness length
!! @param[inout] hice Ice thickness
!!
!! @author David Wright, University of Michigan and GLERL
subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT,sfcTl)
subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_get,mask,sst,ice,sfcT,iceT,sfcTl,zorl,hice)

class(fcst_nwp) :: this

Expand All @@ -260,7 +279,7 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g
integer, intent(inout) :: numlon, numlat, numtimes
! real(r_single), intent(inout) :: mask(:,:), sst(:,:), ice(:,:), sfcT(:,:)
real(r_kind), intent(inout) :: mask(:,:),sst(:,:),ice(:,:),sfcT(:,:) &
,iceT(:,:),sfcTl(:,:)
,iceT(:,:),sfcTl(:,:),zorl(:,:),hice(:,:)

! Open the file using module_ncio.f90 code, and find the number of
! lat/lon points
Expand All @@ -284,6 +303,8 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g
allocate(this%nwp_ice_c(this%xlon,this%xlat,this%xtime))
allocate(this%nwp_sfcT_c(this%xlon,this%xlat,this%xtime))
allocate(this%nwp_iceT_c(this%xlon,this%xlat,this%xtime))
allocate(this%nwp_zorl_c(this%xlon,this%xlat,this%xtime))
allocate(this%nwp_hice_c(this%xlon,this%xlat,this%xtime))

! Get variables from the data file, but only if the variable is
! defined for that data type.
Expand Down Expand Up @@ -319,14 +340,27 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g
call ncdata%get_var(this%varnames(this%i_iceT),this%xlon, &
this%xlat,this%xtime,this%nwp_iceT_c)
iceT = this%nwp_iceT_c(:,:,time_to_get)
end if
if (this%i_zorl .gt. 0) then
call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, &
this%xlat,this%xtime,this%nwp_zorl_c)
zorl = this%nwp_zorl_c(:,:,time_to_get)
end if
if (this%i_hice .gt. 0) then
call ncdata%get_var(this%varnames(this%i_hice),this%xlon, &
this%xlat,this%xtime,this%nwp_hice_c)
hice = this%nwp_hice_c(:,:,time_to_get)
end if

else if (wcstart == 'warm') then
allocate(this%nwp_mask_w(this%xlon,this%xlat))
allocate(this%nwp_sst_w(this%xlon,this%xlat))
allocate(this%nwp_ice_w(this%xlon,this%xlat))
allocate(this%nwp_sfcT_w(this%xlon,this%xlat))
allocate(this%nwp_iceT_w(this%xlon,this%xlat))
allocate(this%nwp_sfcTl_w(this%xlon,this%xlat))
allocate(this%nwp_zorl_w(this%xlon,this%xlat))
allocate(this%nwp_hice_w(this%xlon,this%xlat))
! Get variables from the data file, but only if the variable is
! defined for that data type.

Expand All @@ -336,8 +370,6 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g
write(*,*) 'xlon = ', this%xlon
write(*,*) 'xtime = ', this%xtime



if (this%i_mask .gt. 0) then
call ncdata%get_var(this%varnames(this%i_mask),this%xlon, &
this%xlat,this%nwp_mask_w)
Expand Down Expand Up @@ -368,6 +400,17 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g
this%xlat,this%nwp_sfcTl_w)
sfcTl = this%nwp_sfcTl_w(:,:)
end if
if (this%i_zorl .gt. 0) then
call ncdata%get_var(this%varnames(this%i_zorl),this%xlon, &
this%xlat,this%nwp_zorl_w)
zorl = this%nwp_zorl_w(:,:)
end if
if (this%i_hice .gt. 0) then
call ncdata%get_var(this%varnames(this%i_hice),this%xlon, &
this%xlat,this%nwp_hice_w)
hice = this%nwp_hice_w(:,:)
end if

else
write(*,*) 'Choose either "warm" or "cold" for file'
stop 'Error in wcstart. Check spelling or if variable was assigned'
Expand Down Expand Up @@ -407,12 +450,16 @@ subroutine finish_nwp(this,itype,wcstart)
deallocate(this%nwp_ice_c)
deallocate(this%nwp_sfcT_c)
deallocate(this%nwp_iceT_c)
deallocate(this%nwp_zorl_c)
deallocate(this%nwp_hice_c)
else if (wcstart == 'warm') then
deallocate(this%nwp_mask_w)
deallocate(this%nwp_sst_w)
deallocate(this%nwp_ice_w)
deallocate(this%nwp_sfcT_w)
deallocate(this%nwp_iceT_w)
deallocate(this%nwp_zorl_w)
deallocate(this%nwp_hice_w)
else
write(*,*) 'no deallocation'
end if
Expand Down
30 changes: 24 additions & 6 deletions sorc/fvcom_tools.fd/process_FVCOM.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,7 @@ program process_FVCOM
real :: truelat1, truelat2, stdlon, lat1, lon1, r_earth
real :: knowni, knownj, dx
real :: one, pi, deg2rad
real :: zero

character(len=180) :: fv3file
character(len=180) :: fvcomfile
Expand All @@ -76,9 +77,11 @@ program process_FVCOM
real(r_kind), allocatable :: fv3ice(:,:), fv3sst(:,:)
real(r_kind), allocatable :: fv3sfcT(:,:), fv3mask(:,:)
real(r_kind), allocatable :: fv3iceT(:,:), fv3sfcTl(:,:)
real(r_kind), allocatable :: fv3zorl(:,:), fv3hice(:,:)
real(r_kind), allocatable :: lbcice(:,:), lbcsst(:,:)
real(r_kind), allocatable :: lbcsfcT(:,:), lbcmask(:,:)
real(r_kind), allocatable :: lbciceT(:,:)
real(r_kind), allocatable :: lbciceT(:,:), lbczorl(:,:)
real(r_kind), allocatable :: lbchice(:,:)

! Declare namelists
! SETUP (general control namelist) :
Expand All @@ -97,6 +100,7 @@ program process_FVCOM
!
if(mype==0) then

zero = 0.0
! Get file names from command line arguements
num_args = command_argument_count()
allocate(args(num_args))
Expand Down Expand Up @@ -140,13 +144,16 @@ program process_FVCOM
allocate(fv3mask(nlon,nlat))
allocate(fv3iceT(nlon,nlat))
allocate(fv3sfcTl(nlon,nlat))
allocate(fv3zorl(nlon,nlat))
allocate(fv3hice(nlon,nlat))

allocate(lbcice(nlon,nlat))
allocate(lbcsfcT(nlon,nlat))
allocate(lbcsst(nlon,nlat))
allocate(lbcmask(nlon,nlat))
allocate(lbciceT(nlon,nlat))

allocate(lbczorl(nlon,nlat))
allocate(lbchice(nlon,nlat))
! Read fv3 sfc_data.nc before update

! fv3file='sfc_data.nc'
Expand All @@ -157,7 +164,7 @@ program process_FVCOM

call fcst%initial('FV3LAM',wcstart)
call fcst%list_initial
call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl)
call fcst%read_n(trim(fv3file),'FV3LAM',wcstart,fv3lon,fv3lat,fv3times,t1,fv3mask,fv3sst,fv3ice,fv3sfcT,fv3iceT,fv3sfcTl,fv3zorl,fv3hice)
call fcst%finish('FV3LAM',wcstart)


Expand All @@ -176,7 +183,7 @@ program process_FVCOM
t2=indexFVCOMsel
write(*,*) 'time asked for =', trim(inputFVCOMselStr)
write(*,*) 'time index selected = ', t2
call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl)
call fcst%read_n(trim(fvcomfile),' FVCOM',wcstart,lbclon,lbclat,lbctimes,t2,lbcmask,lbcsst,lbcice,lbcsfcT,lbciceT,fv3sfcTl,lbczorl,lbchice)
call fcst%finish(' FVCOM',wcstart)

! Check that the dimensions match
Expand Down Expand Up @@ -207,19 +214,24 @@ program process_FVCOM
if (wcstart == 'warm') then
do j=1,nlat
do i=1,nlon
if (lbcmask(i,j) > 0. .and. lbcsst(i,j) .ge. -90.0) then
if (lbcmask(i,j) > 0. .and. lbcsst(i,j) .ge. -90.0) then !GL Points
!If ice fraction below 15%, set to 0
if (lbcice(i,j) < 0.15) then
lbcice(i,j) = 0.0
lbchice(i,j) = 0.0 !remove ice thickness
endif
fv3ice(i,j) = lbcice(i,j)
fv3hice(i,j) = lbchice(i,j)

!If ice in FVCOM, but not in FV3-LAM, change to ice
if (lbcice(i,j) > 0. .and. fv3mask(i,j) == 0.) then
fv3mask(i,j) = 2.
fv3zorl(i,j) = 1.1
endif
!If ice in FV3-LAM and not FVCOM, remove it from FV3-LAM
if (fv3mask(i,j) == 2. .and. lbcice(i,j) == 0.) then
fv3mask(i,j) = 0.
fv3zorl(i,j) = zero / zero !Use Fill_Value
endif
fv3sst(i,j) = lbcsst(i,j) + 273.15
fv3sfcT(i,j) = lbcsst(i,j) + 273.15
Expand All @@ -239,15 +251,19 @@ program process_FVCOM
!If ice fraction below 15%, set to 0
if (lbcice(i,j) < 0.15) then
lbcice(i,j) = 0.0
lbchice(i,j) = 0.0 !remove ice thickness
endif
fv3ice(i,j) = lbcice(i,j)
fv3hice(i,j) = lbchice(i,j)
!If ice in FVCOM, but not in FV3-LAM, change to ice
if (lbcice(i,j) > 0. .and. fv3mask(i,j) == 0.) then
fv3mask(i,j) = 2.
fv3zorl(i,j) = 1.1
endif
!If ice in FV3-LAM and not FVCOM, remove it from FV3-LAM
if (fv3mask(i,j) == 2. .and. lbcice(i,j) == 0.) then
fv3mask(i,j) = 0.
fv3zorl(i,j) = zero / zero !Use Fill_Value
endif
fv3sst(i,j) = lbcsst(i,j) + 273.15
fv3sfcT(i,j) = lbcsst(i,j) + 273.15
Expand All @@ -270,13 +286,15 @@ program process_FVCOM
call geo%replace_var("fice",NLON,NLAT,fv3ice)
call geo%replace_var("slmsk",NLON,NLAT,fv3mask)
call geo%replace_var("tisfc",NLON,NLAT,fv3iceT)

call geo%replace_var("hice",NLON,NLAT,fv3hice)
if (wcstart == 'cold') then
! Add_New_Var takes names of (Variable,Dim1,Dim2,Dim3,Long_Name,Units)
call geo%replace_var("zorl",NLON,NLAT,fv3zorl)
call geo%add_new_var('glmsk','xaxis_1','yaxis_1','Time','glmsk','none')
call geo%replace_var('glmsk',NLON,NLAT,lbcmask)
end if
if (wcstart == 'warm') then
call geo%replace_var("zorli",NLON,NLAT,fv3zorl)
call geo%replace_var("tsfc",NLON,NLAT,fv3sfcT)
call geo%replace_var("tsfcl",NLON,NLAT,fv3sfcTl)
call geo%add_new_var('glmsk','xaxis_1','yaxis_1','glmsk','none')
Expand Down

0 comments on commit f41d894

Please sign in to comment.