!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
subroutine oda_get_radiance_ad(lobsSpaceData) 1,12
#if defined (doc)
!
!Purpose:
!Get the adjoint residual and store it radiance_ad structure
!
!author : Simon Pellerin, ARMA, January 2009
! Based on subroutine written by J. Halle
!
!revision : Sylvain Heilliette:
! Add IASI data (codtyp 186)
! : Alain Beaulne / Real Sarrazin
! Add GeoRad data (codtyp 185)
! : Yan Yang, ARQI, Feb 2010
! Changed "radiance_ad (indxtovs) % out"
! to "radiance_ad (indxtovs) % bt" for use of rttov9/rttov10
! : Stephen Macpherson Feb 2013
! Add ATMS data (codtyp 192)
! : S. Heilliette Feb 2013
! Add CrIS data (codtyp 193)
!
#endif
use tovs_lin_mod
use tovs_nl_mod
use obsSpaceData_mod
implicit none
type(struct_obs) :: lobsSpaceData
integer :: isens, indxchn, indxtovs
real(8) :: zres
integer idatyp
integer ichn
integer :: index_header, index_body
integer isrcheq
external isrcheq
external abort3d
if(NOBTOV.eq.0) return ! exit if there are no tovs data
! loop over all header indices of the 'TO' family
! Set the header list
! (& start at the beginning of the list)
call obs_set_current_header_list
(lobsSpaceData,'TO')
HEADER: do
index_header = obs_getHeaderIndex
(lobsSpaceData)
if (index_header < 0) exit HEADER
! . 1.1 Extract general information for this observation point
! . ------------------------------------------------------
! process only radiance data to be assimilated?
! (data type=[164,168,180,181,182,183,185,186])
idatyp = obs_headElem_i
(lobsSpaceData,OBS_ITY,index_header)
if ( .not. tvs_Is_idburp_tovs(idatyp) ) cycle HEADER ! Proceed to the next index
indxtovs = ltovsno(index_header)
if ( indxtovs .eq. 0 ) then
write(*,fmt=9203)
9203 format(' tovs_calc_jo_ad: error with indxtovs')
call abort3d
('tovs_calc_jo_ad ')
endif
radiance_ad (indxtovs) % bt(:) = 0.d0
! if (rttov_errorstatus(indxtovs) .lt. 20 ) then
isens = lsensor(indxtovs)
! loop over all body indices (still in the 'TO' family)
! Set the body list
! (& start at the beginning of the list)
call obs_set_current_body_list
(lobsSpaceData, index_header)
BODY: do
index_body = obs_getBodyIndex(lobsSpaceData)
if (index_body < 0) exit BODY
if ( obs_bodyElem_i
(lobsSpaceData,OBS_ASS,index_body).eq.1 ) then
ichn = nint(obs_bodyElem_r
(lobsSpaceData,OBS_PPP,index_body))
ichn = max(0,min(ichn,jpchmax+1))
ichn=ichn-chanoffset(isens)
indxchn = isrcheq (ichan(:,isens),nchan(isens),ichn)
if ( indxchn .eq. 0 ) then
write(*,fmt=9202)
9202 format(' tovs_calc_jo_ad: error with channel number')
call abort3d
('tovs_calc_jo_ad ')
endif
zres = -obs_bodyElem_r
(lobsSpaceData,OBS_WORK,index_body)
radiance_ad (indxtovs) % bt(indxchn) = zres
endif
enddo BODY
! endif
enddo HEADER
end subroutine oda_get_radiance_ad