Skip to content
Merged
Show file tree
Hide file tree
Changes from 2 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 28 additions & 5 deletions src/gsi/gsdcloudlib_pseudoq_mod.f90
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,8 @@ module gsdcloudlib_pseudoq_mod

contains

SUBROUTINE cloudCover_Surface_col(mype,nsig,&
SUBROUTINE cloudCover_Surface_col(mype,nsig, &
i_cloud_q_innovation,&
cld_bld_hgt,h_bk,zh, &
NVARCLD_P,ocld,Oelvtn,&
wthr_type,pcp_type_obs, &
Expand All @@ -57,6 +58,7 @@ SUBROUTINE cloudCover_Surface_col(mype,nsig,&
! input argument list:
! mype - processor ID
! nsig - no. of levels
! i_cloud_q_innovation - flag to control building/clearing/both
! cld_bld_hgt - Height below which cloud building is done
!
! h_bk - 3D background height (m)
Expand Down Expand Up @@ -96,6 +98,7 @@ SUBROUTINE cloudCover_Surface_col(mype,nsig,&

integer(i_kind),intent(in) :: mype
integer(i_kind),intent(in) :: nsig
integer(i_kind),intent(in) :: i_cloud_q_innovation
real(r_kind), intent(in) :: cld_bld_hgt
!
! surface observation
Expand Down Expand Up @@ -124,7 +127,7 @@ SUBROUTINE cloudCover_Surface_col(mype,nsig,&
INTEGER(i_kind) :: k
INTEGER(i_kind) :: ic
integer(i_kind) :: firstcloud,cl_base_broken_k,obused
integer(i_kind) :: kcld
integer(i_kind) :: kcld,kclr
real(r_single) :: underlim
REAL(r_kind) :: zdiff
REAL(r_kind) :: zlev_clr,cloud_dz,cl_base_ista,betav
Expand All @@ -133,13 +136,15 @@ SUBROUTINE cloudCover_Surface_col(mype,nsig,&
!====================================================================
! Begin
!
!write(6,*) 'cloudCover_Surface', mype, i_cloud_q_innovation
! set constant names consistent with original RUC code
!
vis2qc=-9999.0_r_single
zlev_clr = 3650._r_kind
firstcloud = 0
obused =0
kcld=-9
kclr=99
!
!*****************************************************************
! analysis of surface/METAR cloud observations
Expand All @@ -161,6 +166,15 @@ SUBROUTINE cloudCover_Surface_col(mype,nsig,&
endif
enddo

! cloud clearing obs
if(i_cloud_q_innovation==20 .or. i_cloud_q_innovation==22) then
do k=3,nsig,5
if (h_bk(k) < zlev_clr) then
cld_cover_obs(k)=0.0_r_single
endif
enddo
endif

! -- Now consider non-clear obs
! --------------------------
else
Expand Down Expand Up @@ -203,10 +217,12 @@ SUBROUTINE cloudCover_Surface_col(mype,nsig,&
if(k==8) underlim=95.0_r_kind ! 3000 feet
if(k>=9 .and. k<nsig-1) underlim=(h_bk(k+1)-h_bk(k))*0.8_r_kind
if (zdiff<underlim) then
!build cloud
if(i_cloud_q_innovation==20 .or. i_cloud_q_innovation==21) then
!double check logic for following if statement
if((cl_base_ista >= 1.0_r_kind .and. (firstcloud==0 .or. abs(zdiff)<cloud_dz)) .or. &
(cl_base_ista < 1.0_r_kind .and. (abs(zdiff)<cloud_dz)) ) then
!limit cloud building to below a specified height
!limit cloud building to below a specified height
if (h_bk(k) < cld_bld_hgt) then
if(ocld(ic) == 1 ) then
pcp_type_obs(k)=0
Expand All @@ -233,11 +249,18 @@ SUBROUTINE cloudCover_Surface_col(mype,nsig,&
kcld=k
firstcloud = firstcloud + 1
endif ! zdiff < cloud_dz
endif ! underlim
endif ! i_cloud_q_innovation=20or21
endif ! zdiff<underlim
endif ! firstcloud
enddo ! end K loop
endif ! end if ocld valid

! after cloud base is found, clear ~half way below
if(i_cloud_q_innovation==20 .or. i_cloud_q_innovation==22) then
kclr=kcld/2
if(kclr>= 3) cld_cover_obs(kclr)=0.0_r_single
endif

endif ! end if ocld valid
endif ! obused
enddo ! end IC loop
endif ! end if cloudy ob
Expand Down
2 changes: 1 addition & 1 deletion src/gsi/gsi_cldtotOper.F90
Original file line number Diff line number Diff line change
Expand Up @@ -107,7 +107,7 @@ subroutine setup_(self, lunin, mype, is, nobs, init_pass,last_pass)
diagsave = write_diag(jiter) .and. diag_conv

select case(i_cloud_q_innovation)
case(2)
case(20, 21, 22)
call setup(self%obsLL(:), self%odiagLL(:), &
lunin,mype,bwork,awork(:,iwork),nele,nobs,is,diagsave)

Expand Down
4 changes: 3 additions & 1 deletion src/gsi/gsimod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1201,7 +1201,9 @@ module gsimod
! i_cloud_q_innovation - integer to choose if and how cloud obs are used
! 0= no innovations
! 1= cloud total innovations
! 2= water vapor innovations
! 20= cloud build/clear derived water vapor innovations
! 21= cloud build derived water vapor innovations
! 22= cloud clear derived water vapor innovations
! 3= cloud total & water vapor innovations
! i_ens_mean - integer for setupcldtot behavior
! 0=single model run
Expand Down
4 changes: 3 additions & 1 deletion src/gsi/rapidrefresh_cldsurf_mod.f90
Original file line number Diff line number Diff line change
Expand Up @@ -156,7 +156,9 @@ module rapidrefresh_cldsurf_mod
! i_cloud_q_innovation - integer to choose if and how cloud obs are used
! 0= no innovations
! 1= cloud total innovations
! 2= water vapor innovations
! 20= cloud build/clear derived water vapor innovations
! 21= cloud build derived water vapor innovations
! 22= cloud clear derived water vapor innovations
! 3= cloud total & water vapor innovations
! i_ens_mean - integer for setupcldtot behavior
! 0=single model run
Expand Down
20 changes: 13 additions & 7 deletions src/gsi/setupcldtot.F90
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ subroutine setupcldtot(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_di
!! . . . .
! subprogram: setupcldtot compute rhs of oi for pseudo moisture observations from
! METAR and Satellite cloud observations
! prgmmr: Ladwag org: GSD date: 2019-06-01
! prgmmr: Ladwig org: GSD date: 2019-06-01
!
! abstract: For moisture observations, this routine
! a) reads obs assigned to given mpi task (geographic region),
Expand Down Expand Up @@ -273,7 +273,7 @@ subroutine setupcldtot(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_di
allocate(cdiagbuf(nobs*nsig),rdiagbuf(nreal,nobs*nsig))
rdiagbuf=zero
endif
if (i_cloud_q_innovation == 2 .or. i_cloud_q_innovation == 3) then
if (i_cloud_q_innovation .ge. 20 .or. i_cloud_q_innovation == 3) then
Comment thread
terraladwig marked this conversation as resolved.
Outdated
iip=0
allocate(cdiagbufp(nobs*nsig),rdiagbufp(nreal,nobs*nsig))
cdiagbufp="EMPTY"
Expand Down Expand Up @@ -461,7 +461,7 @@ subroutine setupcldtot(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_di
cycle
endif

call cloudCover_surface_col(mype,nsig,cld_bld_hgt,h_bk,z_bk, &
call cloudCover_surface_col(mype,nsig,i_cloud_q_innovation,cld_bld_hgt,h_bk,z_bk, &
nvarcld_p,ocld,oelvtn,wthr_type,pcp_type_obs,vis2qc,cld_cover_obs)


Expand Down Expand Up @@ -516,8 +516,8 @@ subroutine setupcldtot(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_di
muse(i)=.true.

!*******************************************************************************
if (i_cloud_q_innovation /= 2) then
write(*,*) "Warning - setupcldtot: this code version is only designed for i_cloud_q_innovation == 2"
if (i_cloud_q_innovation .lt. 20 .or. i_cloud_q_innovation .gt. 22 ) then
Comment thread
terraladwig marked this conversation as resolved.
Outdated
write(*,*) "Warning - setupcldtot: this code version is only designed for i_cloud_q_innovation == 20,21,22"
return
else

Expand Down Expand Up @@ -566,6 +566,8 @@ subroutine setupcldtot(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_di
ddiff=qv_ob-q_bk(k)
q_build0_count=q_build0_count+1
endif
! build error = 80%
error=one/(cloudqvis*8.E-01_r_kind)

elseif (qob > -0.000001_r_single) then

Expand All @@ -578,13 +580,16 @@ subroutine setupcldtot(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_di
ddiff=qv_ob-q_bk(k)
q_clear0_count=q_clear0_count+1
endif
! clear error = 30%
error=one/(cloudqvis*3.E-01_r_kind)
else
cycle
endif

q_obcount=q_obcount+1

error=one/(cloudqvis*3.E-01_r_kind)
! all obs errors = 30%
!error=one/(cloudqvis*3.E-01_r_kind)
ratio_errors=1.0_r_kind
val = error*ddiff

Expand Down Expand Up @@ -712,7 +717,8 @@ subroutine setupcldtot(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_di

!! Write information to diagnostic file
if(conv_diagsave)then
if (i_cloud_q_innovation == 2 .and. iip>0) then
if (i_cloud_q_innovation .ge. 20 .and. iip>0) then
Comment thread
terraladwig marked this conversation as resolved.
Outdated
! call dtime_show(myname,'diagsave:q',i_q_ob_type)
if(netcdf_diag) call nc_diag_write
if(binary_diag)then
write(7)' q',nchar,nreal,iip,mype,ioff0
Expand Down
4 changes: 2 additions & 2 deletions src/gsi/setuprhsall.f90
Original file line number Diff line number Diff line change
Expand Up @@ -539,11 +539,11 @@ subroutine setuprhsall(ndata,mype,init_pass,last_pass)
! luse_obsdiag, sorting could become a problem. Among them, cases of
! l_PBL_pseudo_SurfobsT, l_PBL_pseudo_SurfobsQ, and l_PBL_pseudo_SurfobsUV
! have been fixed since, but it might be better to keep it simple for
! those applications. The case of i_cloud_q_innovation==2 is new. It is
! those applications. The case of i_cloud_q_innovation is new. It is
! not sure why it won't work even in case of .not.luse_obsdiag.

if(.not.(l_PBL_pseudo_SurfobsT .or. l_PBL_pseudo_SurfobsQ .or. &
l_PBL_pseudo_SurfobsUV .or. (i_cloud_q_innovation==2)) ) then
l_PBL_pseudo_SurfobsUV .or. (i_cloud_q_innovation.ge.1)) ) then
Comment thread
terraladwig marked this conversation as resolved.
Outdated
call obsdiags_sort()
endif

Expand Down