module intjomod
!$$$ module documentation block
! . . . .
! module: intjo module for intjo
! prgmmr:
!
! abstract: module for H'R^{-1}H
!
! program history log:
! 2008-12-01 Todling - wrap in module
! 2009-08-13 lueken - update documentation
! 2015-09-03 guo - obsmod::obs_handle has been replaced with obsHeadBundle,
! defined by m_obsHeadBundle.
! 2016-08-29 J Guo - Separated calls to intozlay() and intozlev()
!
! subroutines included:
! sub intjo_
!
! variable definitions:
!
! attributes:
! language: f90
! machine:
!
!$$$ end documentation block
implicit none
PRIVATE
PUBLIC intjo
interface intjo; module procedure &
intjo_
end interface
contains
subroutine intjo_(yobs,rval,qpred,sval,sbias,ibin)
!$$$ subprogram documentation block
! . . . .
! subprogram: intjo calculate RHS for analysis equation
! prgmmr: derber org: np23 date: 2003-12-18
!
! abstract: calculate RHS for all variables (nonlinear qc version)
!
! A description of nonlinear qc follows:
!
! The observation penalty Jo is defined as
!
! Jo = - (sum over obs) 2*log(Po)
!
! where,
!
! Po = Wnotgross*exp(-.5*(Hn(x+xb) - yo)**2 ) + Wgross
! with
! Hn = the forward model (possibly non-linear) normalized by
! observation error
! x = the current estimate of the analysis increment
! xb = the background state
! yo = the observation normalized by observation error
!
! Note: The factor 2 in definition of Jo is present because the
! penalty Jo as used in this code is 2*(usual definition
! of penalty)
!
! Wgross = Pgross*cg
!
! Wnotgross = 1 - Wgross
!
! Pgross = probability of gross error for observation (assumed
! here to have uniform distribution over the possible
! range of values)
!
! cg = sqrt(2*pi)/2b
!
! b = possible range of variable for gross errors, normalized by
! observation error
!
! The values for the above parameters that Bill Collins used in the
! eta 3dvar are:
!
! cg = cg_term/b, where cg_term = sqrt(2*pi)/2
!
! b = 10. ! range for gross errors, normalized by obs error
!
! pg_q=.002 ! probability of gross error for specific humidity
! pg_pw=.002 ! probability of gross error for precipitable water
! pg_p=.002 ! probability of gross error for pressure
! pg_w=.005 ! probability of gross error for wind
! pg_t=.007 ! probability of gross error for temperature
! pg_rad=.002 ! probability of gross error for radiances
!
!
! Given the above Jo, the gradient of Jo is as follows:
!
! T
! gradx(Jo) = - (sum over observations) 2*H (Hn(x+xb)-yo)*(Po - Wgross)/Po
!
! where,
!
! H = tangent linear model of Hn about x+xb
!
!
! Note that if Pgross = 0.0, then Wnotgross=1.0 and Wgross=0.0. That is,
! the code runs as though nonlinear quality control were not present
! (which is indeed the case since the gross error probability is 0).
!
! As a result the same int* routines may be used for use with or without
! nonlinear quality control.
!
!
! program history log:
! 2003-12-18 derber
! 2004-07-23 derber - modify to include conventional sst
! 2004-07-28 treadon - add only to module use, add intent in/out
! 2004-10-06 parrish - add nonlinear qc option
! 2004-10-06 kleist - separate control vector for u,v, & convert int
! for wind components into int for st,vp
! 2004-11-30 treadon - add brightness temperatures to nonlinear
! quality control
! 2004-12-03 treadon - replace mpe_iallreduce (IBM extension) with
! standard mpi_allreduce
! 2005-01-20 okamoto - add u,v to intrad
! 2005-02-23 wu - changes related to normalized rh option
! 2005-04-11 treadon - rename intall_qc as intall
! 2005-05-18 yanqiu zhu - add 'use int*mod',and modify call interfaces for using these modules
! 2005-05-24 pondeca - take into consideration that npred=npredp=0
! for 2dvar only surface analysis option
! 2005-06-03 parrish - add horizontal derivatives
! 2005-07-10 kleist - add dynamic constraint term
! 2005-09-29 kleist - expand Jc term, include time derivatives vector
! 2005-11-21 kleist - separate tendencies from Jc term, add call to calctends adjoint
! 2005-12-01 cucurull - add code for GPS local bending angle, add use obsmod for ref_obs
! 2005-12-20 parrish - add arguments to call to intt to allow for option of using boundary
! layer forward tlm.
! 2006-02-03 derber - modify to increase reproducibility
! 2006-03-17 park - correct error in call to intt--rval,sval --> rvaluv,svaluv
! in order to correctly pass wind variables.
! 2006-04-06 kleist - include both Jc formulations
! 2006-07-26 parrish - correct inconsistency in computation of space and time derivatives of q
! currently, if derivatives computed, for q it is normalized q, but
! should be mixing ratio.
! 2006-07-26 parrish - add strong constraint initialization option
! 2007-03-19 tremolet - binning of observations
! 2007-04-13 tremolet - split jo from other components of intall
! 2007-06-04 derber - use quad precision to get reproducibility over number of processors
! 2008-11-27 todling - add tendencies for FOTO support and new interface to int's
! 2009-01-08 todling - remove reference to ozohead
! 2009-03-23 meunier - Add call to intlag (lagrangian observations)
! 2010-01-11 zhang,b - Bug fix: bias predictors need to be accumulated over nbins
! 2010-03-24 zhu - change the interfaces of intt,intrad,intpcp for generalizing control variable
! 2010-05-13 todling - harmonized interfaces to int* routines when it comes to state_vector (add only's)
! 2010-06-13 todling - add intco call
! 2010-10-15 pagowski - add intpm2_5 call
! 2010-10-20 hclin - added aod
! 2011-02-20 zhu - add intgust,intvis,intpblh calls
! 2013-05-20 zhu - add codes related to aircraft temperature bias correction
! 2014-06-18 carley/zhu - add lcbas and tcamt
! 2014-03-19 pondeca - add intwspd10m
! 2014-04-10 pondeca - add inttd2m,intmxtm,intmitm,intpmsl
! 2014-05-07 pondeca - add inthowv
! 2015-07-10 pondeca - add intcldch
! 2016-03-07 pondeca - add intuwnd10m,intvwnd10m
!
! input argument list:
! ibin
! yobs
! sval - solution on grid
! sbias
! rval
! qpred
!
! output argument list:
! rval - RHS on grid
! qpred
!
! remarks:
! 1) if strong initialization, then svalt, svalp, svaluv
! are all grid fields after strong initialization.
!
! 2) The two interfaces to the int-routines should be temporary.
! In the framework of the 4dvar-code, foto can be re-implemented as
! an approximate M and M' to the model matrices in 4dvar. Once that
! is done, the int-routines should no longer need the time derivatives.
! (Todling)
! 3) Notice that now (2010-05-13) int routines handle non-essential
! variables internally; also, when pointers non-existent, int routines
! simply return (Todling).
!
! attributes:
! language: f90
! machine: ibm RS/6000 SP
!
!$$$
use kinds, only: r_kind,i_kind,r_quad
use jfunc, only: nrclen,nsclen,npclen,ntclen
use bias_predictors, only: predictors
use intaodmod, only: intaod
use inttmod, only: intt
use intwmod, only: intw
use intpsmod, only: intps
use intpwmod, only: intpw
use intqmod, only: intq
use intradmod, only: intrad
use inttcpmod, only: inttcp
use intgpsmod, only: intgps
use intrwmod, only: intrw
use intdbzmod, only: intdbz
use intspdmod, only: intspd
use intsstmod, only: intsst
use intdwmod, only: intdw
use intpcpmod, only: intpcp
use intozmod, only: intozlay
use intozmod, only: intozlev
use intcomod, only: intco
use intpm2_5mod, only: intpm2_5
use intpm10mod, only: intpm10
use intlagmod, only: intlag
use intgustmod, only: intgust
use intvismod, only: intvis
use intpblhmod, only: intpblh
use intwspd10mmod, only: intwspd10m
use inttd2mmod, only: inttd2m
use intmxtmmod, only: intmxtm
use intmitmmod, only: intmitm
use intpmslmod, only: intpmsl
use inthowvmod, only: inthowv
use inttcamtmod, only: inttcamt
use intlcbasmod, only: intlcbas
use intcldchmod, only: intcldch
use intuwnd10mmod, only: intuwnd10m
use intvwnd10mmod, only: intvwnd10m
use intswcpmod, only: intswcp
use intlwcpmod, only: intlwcp
use gsi_bundlemod, only: gsi_bundle
use gsi_bundlemod, only: gsi_bundlegetpointer
use m_obsHeadBundle, only: obsHeadBundle
implicit none
! Declare passed variables
integer(i_kind) , intent(in) :: ibin
type(obsHeadBundle), intent(in) :: yobs
type(gsi_bundle), intent(in ) :: sval
type(predictors), intent(in ) :: sbias
type(gsi_bundle), intent(inout) :: rval
real(r_quad),dimension(max(1,nrclen)), intent(inout) :: qpred
! Declare local variables
!******************************************************************************
! RHS for conventional temperatures
if (ntclen>0) then
call intt(yobs%t,rval,sval,qpred(nsclen+npclen+1:nrclen),sbias%predt)
else
call intt(yobs%t,rval,sval)
end if
! RHS for precipitable water
call intpw(yobs%pw,rval,sval)
! RHS for conventional moisture
call intq(yobs%q,rval,sval)
! RHS for conventional winds
call intw(yobs%w,rval,sval)
! RHS for lidar winds
call intdw(yobs%dw,rval,sval)
! RHS for radar winds
call intrw(yobs%rw,rval,sval)
! RHS for radar reflectivity
call intdbz(yobs%dbz,rval,sval)
! RHS for wind speed observations
call intspd(yobs%spd,rval,sval)
! RHS for ozone observations
call intozlay(yobs%oz ,rval,sval)
call intozlev(yobs%o3l,rval,sval)
! RHS for carbon monoxide
call intco(yobs%colvk,rval,sval)
! RHS for pm2_5
call intpm2_5(yobs%pm2_5,rval,sval)
! RHS for pm10
call intpm10(yobs%pm10,rval,sval)
! RHS for surface pressure observations
call intps(yobs%ps,rval,sval)
! RHS for MSLP obs for TCs
call inttcp(yobs%tcp,rval,sval)
! RHS for conventional sst observations
call intsst(yobs%sst,rval,sval)
! RHS for GPS local observations
call intgps(yobs%gps,rval,sval)
! RHS for conventional lag observations
call intlag(yobs%lag,rval,sval,ibin)
! RHS calculation for radiances
call intrad(yobs%rad,rval,sval,qpred(1:nsclen),sbias%predr)
! RHS calculation for precipitation
call intpcp(yobs%pcp,rval,sval)
! RHS calculation for AOD
call intaod(yobs%aero,rval,sval)
! RHS for conventional gust observations
call intgust(yobs%gust,rval,sval)
! RHS for conventional vis observations
call intvis(yobs%vis,rval,sval)
! RHS for conventional pblh observations
call intpblh(yobs%pblh,rval,sval)
! RHS for conventional wspd10m observations
call intwspd10m(yobs%wspd10m,rval,sval)
! RHS for conventional td2m observations
call inttd2m(yobs%td2m,rval,sval)
! RHS for conventional mxtm observations
call intmxtm(yobs%mxtm,rval,sval)
! RHS for conventional mitm observations
call intmitm(yobs%mitm,rval,sval)
! RHS for conventional pmsl observations
call intpmsl(yobs%pmsl,rval,sval)
! RHS for conventional howv observations
call inthowv(yobs%howv,rval,sval)
! RHS for tcamt observations
call inttcamt(yobs%tcamt,rval,sval)
! RHS for lcbas observations
call intlcbas(yobs%lcbas,rval,sval)
! RHS for cldch observations
call intcldch(yobs%cldch,rval,sval)
! RHS for conventional uwnd10m observations
call intuwnd10m(yobs%uwnd10m,rval,sval)
! RHS for conventional vwnd10m observations
call intvwnd10m(yobs%vwnd10m,rval,sval)
! RHS for swcp observations
call intswcp(yobs%swcp,rval,sval)
! RHS for lwcp observations
call intlwcp(yobs%lwcp,rval,sval)
! Take care of background error for bias correction terms
return
end subroutine intjo_
end module intjomod