Skip to content

Commit

Permalink
Merge pull request #1 from terraladwig/sync_gsl_2021Jun_plusCLD
Browse files Browse the repository at this point in the history 
Sync additional var cloud capability
  • Loading branch information
Ming Hu committed Jun 24, 2021
2 parents 2139d25 + 6af4ef1 commit b8fbeba
Show file tree
Hide file tree
Showing 6 changed files with 50 additions and 17 deletions.
33 changes: 28 additions & 5 deletions src/gsi/gsdcloudlib_pseudoq_mod.f90
View file
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
View file
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
View file
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
View file
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
View file
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 >= 20 .or. i_cloud_q_innovation == 3) then
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 < 20 .or. i_cloud_q_innovation > 22 ) then
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 >= 20 .and. iip>0) then
! 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
View file
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>0)) ) then
call obsdiags_sort()
endif

Expand Down

0 comments on commit b8fbeba

Please sign in to comment.