diff --git a/sorc/fvcom_tools.fd/module_nwp.f90 b/sorc/fvcom_tools.fd/module_nwp.f90 index a4894b6c0..d0b7b2376 100644 --- a/sorc/fvcom_tools.fd/module_nwp.f90 +++ b/sorc/fvcom_tools.fd/module_nwp.f90 @@ -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. @@ -52,6 +54,8 @@ 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 @@ -59,6 +63,8 @@ module module_nwp 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 @@ -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) @@ -131,7 +140,7 @@ 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 @@ -139,6 +148,8 @@ subroutine initial_nwp(this,itype,wcstart) 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' @@ -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) @@ -162,12 +175,14 @@ 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)) @@ -175,6 +190,8 @@ subroutine initial_nwp(this,itype,wcstart) 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) @@ -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 @@ -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 @@ -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. @@ -319,7 +340,18 @@ 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)) @@ -327,6 +359,8 @@ subroutine read_nwp(this,filename,itype,wcstart,numlon,numlat,numtimes,time_to_g 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. @@ -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) @@ -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' @@ -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 diff --git a/sorc/fvcom_tools.fd/process_FVCOM.f90 b/sorc/fvcom_tools.fd/process_FVCOM.f90 index bbcffcec9..a9a017717 100755 --- a/sorc/fvcom_tools.fd/process_FVCOM.f90 +++ b/sorc/fvcom_tools.fd/process_FVCOM.f90 @@ -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 @@ -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) : @@ -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)) @@ -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' @@ -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) @@ -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 @@ -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 @@ -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 @@ -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')