subroutine unfill_mass_grid2t(gout,nx,ny,gin) !$$$ subprogram documentation block ! . . . . ! subprogram: unfill_mass_grid2t opposite of fill_mass_grid2 ! prgmmr: parrish org: np22 date: 2004-06-22 ! ! abstract: This is almost the reverse of subroutine fill_mass_grid2t. ! The input field is an analyis increment on an unstaggered ! A grid. The result is added to the preexisting contents of gout. ! ! program history log: ! 2004-07-16 parrish ! 2013-10-25 todling - reposition ltosi and others to commvars ! 2014-03-12 Hu Code for GSI analysis on grid larger than background grid: ! Here input grid is larger than output grid. ! ! input argument list: ! gout - input A-grid (reorganized for distibution to local domains) ! gin - preexisting input values to be added to on C-grid ! nx,ny - input grid dimensions ! ! output argument list: ! gin - output result on C grid ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use kinds, only: r_single,i_kind use gridmod, only: itotsub,iglobal use general_commvars_mod, only: ltosi,ltosj use mod_wrfmass_to_a, only: wrfmass_a_to_h4 use gridmod, only: nlon, nlat implicit none integer(i_kind), intent(in ) :: nx,ny real(r_single) , intent(in ) :: gout(itotsub) real(r_single) , intent(inout) :: gin(nx,ny) real(r_single) ba(nlon,nlat) real(r_single) b(nx,ny) integer(i_kind) i,j do i=1,iglobal ba(ltosj(i),ltosi(i))=gout(i) end do if(nlon == nx .and. nlat == ny) then b=ba else call wrfmass_a_to_h4(ba,b) endif ! Mass grids--just copy do j=1,ny do i=1,nx gin(i,j)=b(i,j)+gin(i,j) end do end do end subroutine unfill_mass_grid2t subroutine unfill_mass_grid2u(gout,nx,ny,gin) !$$$ subprogram documentation block ! . . . . ! subprogram: unfill_mass_grid2u opposite of fill_mass_grid2u ! prgmmr: parrish org: np22 date: 2004-06-22 ! ! abstract: This is almost the reverse of subroutine fill_mass_grid2u. ! The input field is an analyis increment on an unstaggered ! A grid. This routine interpolates in the x direction to the ! C grid u points and adds result to the preexisting contents of gout. ! ! program history log: ! 2004-07-16 parrish ! 2013-10-25 todling - reposition ltosi and others to commvars ! 2014-03-12 Hu Code for GSI analysis on grid larger than background grid: ! Here input grid is larger than output grid. ! ! input argument list: ! gout - input A-grid (reorganized for distibution to local domains) ! gin - preexisting input values to be added to on C-grid ! nx,ny - input grid dimensions ! ! output argument list: ! gin - output result on C grid ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use kinds, only: r_single,i_kind use constants, only: half use gridmod, only: itotsub,iglobal use general_commvars_mod, only: ltosi,ltosj use mod_wrfmass_to_a, only: wrfmass_a_to_h4 use gridmod, only: nlon, nlat implicit none integer(i_kind), intent(in ) :: nx,ny real(r_single) , intent(in ) :: gout(itotsub) real(r_single) , intent(inout) :: gin(nx+1,ny) real(r_single) ba(nlon,nlat) real(r_single) b(nx,ny) integer(i_kind) i,i0,im,j do i=1,iglobal ba(ltosj(i),ltosi(i))=gout(i) end do if(nlon == nx .and. nlat == ny) then b=ba else call wrfmass_a_to_h4(ba,b) endif do j=1,ny do i=1,nx+1 im=max(1,i-1) i0=min(nx,i) gin(i,j)=gin(i,j)+half*(b(im,j)+b(i0,j)) end do end do end subroutine unfill_mass_grid2u subroutine unfill_mass_grid2v(gout,nx,ny,gin) !$$$ subprogram documentation block ! . . . . ! subprogram: unfill_mass_grid2v opposite of fill_mass_grid2v ! prgmmr: parrish org: np22 date: 2004-06-22 ! ! abstract: This is almost the reverse of subroutine fill_mass_grid2v. ! The input field is an analyis increment on an unstaggered ! A grid. This routine interpolates in y to the C grid v component ! and adds the result to the preexisting contents of gout. ! ! program history log: ! 2004-07-16 parrish ! 2013-10-25 todling - reposition ltosi and others to commvars ! 2014-03-12 Hu Code for GSI analysis on grid larger than background grid: ! Here input grid is larger than output grid. ! ! input argument list: ! gout - input A-grid (reorganized for distibution to local domains) ! gin - preexisting input values to be added to on C-grid ! nx,ny - input grid dimensions ! ! output argument list: ! gin - output result on C grid ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use kinds, only: r_single,i_kind use constants, only: half use gridmod, only: itotsub,iglobal use general_commvars_mod, only: ltosi,ltosj use mod_wrfmass_to_a, only: wrfmass_a_to_h4 use gridmod, only: nlon, nlat implicit none integer(i_kind), intent(in ) :: nx,ny real(r_single) , intent(in ) :: gout(itotsub) real(r_single) , intent(inout) :: gin(nx,ny+1) real(r_single) ba(nlon,nlat) real(r_single) b(nx,ny) integer(i_kind) i,j,j0,jm do i=1,iglobal ba(ltosj(i),ltosi(i))=gout(i) end do if(nlon == nx .and. nlat == ny) then b=ba else call wrfmass_a_to_h4(ba,b) endif do j=1,ny+1 jm=max(1,j-1) j0=min(ny,j) do i=1,nx gin(i,j)=gin(i,j)+half*(b(i,jm)+b(i,j0)) end do end do end subroutine unfill_mass_grid2v subroutine unfill_mass_grid2t_ldmk(gout,nx,ny,gin,landmask, & snow,seaice,deltaT,i_snowt_check) !$$$ subprogram documentation block ! . . . . ! subprogram: unfill_mass_grid2t opposite of fill_mass_grid2 ! prgmmr: parrish org: np22 date: 2004-06-22 ! ! abstract: This is the same as unfill_mass_grid2t, ! but only add analysis increment over land. ! ! program history log: ! 2004-07-16 parrish ! 2014-03-12 Hu Code for GSI analysis on grid larger than background grid: ! Here input grid is larger than output grid. ! 2014-04-04 todling - reposition ltosi and others to commvars ! 2015-01-15 Hu - apply the land/sea mask here for soil adjustment ! fields ! ! input argument list: ! gout - input A-grid (reorganized for distibution to local domains) ! gin - preexisting input values to be added to on C-grid ! nx,ny - input grid dimensions ! deltaT - delta T between atmosphere and tsk/tslb(1) ! i_snowT_check - input option for snow Temperature adjustment ! =0: input gin is not temperature ! =1: tsk make sure surface temperature onver snow is below 0C ! =2: input gin is soil mositure, don't adjust over seaice ! =3: soil temperature ! =4: soilt1 ! ! output argument list: ! gin - output result on C grid ! ! attributes: ! language: f90 ! machine: ibm RS/6000 SP ! !$$$ use kinds, only: r_single,i_kind,r_kind use gridmod, only: itotsub,iglobal use general_commvars_mod, only: ltosi,ltosj use mod_wrfmass_to_a, only: wrfmass_a_to_h4 use gridmod, only: nlon, nlat use rapidrefresh_cldsurf_mod, only: DTsTmax use constants, only: partialSnowThreshold implicit none integer(i_kind), intent(in ) :: nx,ny integer(i_kind), intent(in ) :: i_snowt_check real(r_single) , intent(in ) :: gout(itotsub) real(r_single) , intent(inout) :: gin(nx,ny) real(r_single) , intent(in) :: landmask(nx,ny) real(r_single) , intent(in) :: snow(nx,ny) real(r_single) , intent(in) :: seaice(nx,ny) real(r_single) , intent(in) :: deltaT(nx,ny) real(r_single) ba(nlon,nlat) real(r_single) b(nx,ny) integer(i_kind) i,j do i=1,iglobal ba(ltosj(i),ltosi(i))=gout(i) end do if(nlon == nx .and. nlat == ny) then b=ba else call wrfmass_a_to_h4(ba,b) endif ! only add analysis increment over land if(maxval(landmask) > 1.01_r_single .or. minval(landmask) < -0.01_r_single .or. & maxval(seaice) > 1.01_r_single .or. minval(seaice) < -0.01_r_single) then write(*,*) 'bad landmask or seaice, do not use landmask filter soil nudging field' else do j=1,ny do i=1,nx if(landmask(i,j) < 0.1_r_single) b(i,j)=0.0_r_single if(i_snowT_check==2 .and. seaice(i,j) > 0.5_r_single) b(i,j)=0.0_r_single ! don't change soil T (TSBL) under thick snow (> partialSnowThreshold=32 mm) if(i_snowT_check==3 .and. (snow(i,j) > partialSnowThreshold)) b(i,j)=0.0_r_single ! Limit application of soil temp nudging in fine grid as follows: ! - If cooling is indicated, apply locally only ! if deltaT = Tskin - T(k=1) > -20K. for TSK and SOILT1 ! if deltaT = TSLB(1) - T(k=1) > -20K. for TSLB ! Idea: If skin temp is already much colder than atmos temp, ! it's useless to cool off the soil any more ! As we also know, the repeated application will created ! unrealistic values. ! - Do similar for indicated soil warming, apply locally only: ! if deltaT = Tskin - T(k=1) < 20K. for TSK and SOILT1 ! if deltaT = TSLB(1) - T(k=1) < 20K. for TSLB ! if( (i_snowT_check==1 .or. i_snowT_check==3 .or. i_snowT_check==4) ) then if(deltaT(i,j) < -DTsTmax .and. b(i,j) < 0.0_r_single) & b(i,j)=0.0_r_single if(deltaT(i,j) > DTsTmax .and. b(i,j) > 0.0_r_single) & b(i,j)=0.0_r_single endif end do end do endif ! Mass grids--just copy do j=1,ny do i=1,nx gin(i,j)=b(i,j)+gin(i,j) end do end do end subroutine unfill_mass_grid2t_ldmk