SUBROUTINE CH_VERTINTG2(CDBGTYP,pveta,pvtotal,pbtm,
1 qpeta,knflev,kfirst,knulout,kmod)
C
IMPLICIT NONE
C
C* Declaration of arguments
C
CHARACTER*(*) CDBGTYP
INTEGER knflev,knulout,kfirst,kmod
REAL*8 pveta(knflev),qpeta(knflev)
REAL*8 pvtotal
REAL*8 pbtm
C
*---------------------------------------------------------------------
#if defined (DOC)
*
***s/r CH_VERTINTG2 - Vertical integration model to overhead column value
* of model state profile 'pveta' or used for
* adjoint calculations.
*
* Alternative integration to CH_VERTING put in place
* for use with MIPAS OCDs (overhead column densities)
* following preference of Simon Chabrillat for
* consistency with the generation of the OCD values from
* MIPAS retrieved profiles.
*
*Author : Y. Rochon (based on CH_VERTING), Mach 2007
*Revision:
*
*
** Purpose: Vertical integration w.r.t. pressure to overhead column
* value of model state profile 'pveta' or used for adjoint calc..
*
* Applications:
*
* 1) KMOD=0; Forward/innovation model: Produce the integral PVTOTAL
* given the background state profile PVETA.
* 2) KMOD=1; Adjoint model: Create PVETA array given PVTOTAL.
*
*Arguments:
*
* Input pveta(nvlev) -- background values at eta levels when kmod=0
* pvtotal -- Column amount when kmod=1
* kmod -- Flag indicating purpose of call:
* 0: Use with forward model
* 1: Use with adjoint of forward model.
* knvlev -- # of vertical levels
* qpeta -- pressure at eta levels
* pbtm -- obs bottom -level pressure (in Pascal)
* kfirst -- Initialization flag.
* When jfirst=1, calc peta,pres, and vmid
* knulout -- Output unit index
* CDBGTYP -- 'HR' for high resolution (trial field) grid
* 'BG' for low resolution (rebm) grid
*
* Output pvtotal -- partial (or total column) value between
* pressure levels ptop and pbtm when kmod=0
* pveta(knvlev) -- Array for adjoint of forward model when kmod=1
*
* Local common block
*
*---------------------------------------------------------------------
#endif
C
C* Global variables
C
#include "pardim.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comgem.cdk"
#include "comcst.cdk"
#include "comphy.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comnumbr.cdk"
#include "cvcord.cdk"
#include "comstate.cdk"
#include "comvarqc.cdk"
#include "comlun.cdk"
#include "commvohr.cdk"
C
C* Declaration of local variables
C
INTEGER J,JK,ILMAX
REAL*8 zg(jpnflev),zet
C
C* Determine P boundaries of analysis layers.
C
if (pbtm.le.qpeta(1)) then
if (kmod.eq.0) then
pvtotal=0.0D0
else
pveta(:)=0.0D0
end if
return
end if
if (pbtm.gt.qpeta(knflev)*0.99) pbtm=qpeta(knflev)
C
C* Find the range of vertical levels over which to perform the integration
C and set innovation operator ZH over this range.
C
do jk=2,knflev
if (pbtm.le.qpeta(jk)) exit
end do
ilmax=jk
C
C Set up forward model and TLM operator
C
zg(:)=0.0
C
zet=0.5
if (ilmax.gt.2) then
zg(1)=(qpeta(2)-qpeta(1))*zet
if (ilmax.gt.3) then
zg(ilmax-1)=(qpeta(ilmax-1)-qpeta(ilmax-2))*zet
if (ilmax.gt.4) then
do jk=2,ilmax-2
zg(jk)=(qpeta(jk+1)-qpeta(jk-1))*zet
end do
end if
end if
end if
zet=(pbtm-qpeta(ilmax-1))/log(qpeta(ilmax-1)/qpeta(ilmax))
zg(ilmax)=zet*(0.5*log(qpeta(ilmax-1))-0.5*log(pbtm))
zg(ilmax-1)=zg(ilmax-1)+zet*(0.5*log(qpeta(ilmax-1))
& +0.5*log(pbtm)-log(qpeta(ilmax)))
C
if (kmod.eq.0) then
C
C* Forward model (innovation) calc.
C
pvtotal=0.0D0
pvtotal=dot_product(pveta(1:ilmax),zg(1:ilmax))
C
else
C
C* Adjoint of forward model calc.
C
pveta(:)=0.0D0
pveta(1:ilmax)=pvtotal*zg(1:ilmax)
C
end if
C
RETURN
END