!-------------------------------------- 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_storeHdx_radiances(lobsSpaceData) 1,13
#if defined (doc)
!
!
!Purpose:
!Store Hdx radiances in OBS_WORK
!
!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)
! : Sylvain Heilliette / Yves J. Rochon, July 2010
! Changed "radiance_tl (indxtovs) % out"
! to "radiance_tl (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_nl_mod
use tovs_lin_mod
use obsSpaceData_mod
implicit none
type(struct_obs) :: lobsSpaceData
integer :: isens, indxchn, indxtovs
integer j, i
integer jdata, idatyp
integer ichn
! integer kfailtot
integer :: index_header, index_body
integer isrcheq
external isrcheq
external abort3d
if(NOBTOV.eq.0) return ! exit if there are no tovs data
! 1. Computation of (hx - z)/sigma for tovs data only
! . ------------------------------------------------
!kfailtot = 0
! 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 HEADER
indxtovs = ltovsno(index_header)
if ( indxtovs .eq. 0 ) then
write(*,fmt=9203)
9203 format(' tovs_calc_jo_tl: error with indxtovs')
call abort3d('tovs_calc_jo_tl ')
endif
! 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_tl: error with channel number')
call abort3d('tovs_calc_jo_tl ')
endif
call obs_bodySet_r(lobsSpaceData,OBS_WORK,index_body, &
radiance_tl (indxtovs) % bt(indxchn))
if ( ldbgtov ) then
write(*,'(a,i4,2f8.2)') ' ichn,sim,obs= ', &
ichn, radiance_tl (indxtovs) % bt(indxchn), &
obs_bodyElem_r(lobsSpaceData,OBS_OMP,index_body)
endif
endif
enddo BODY
! else
! kfailtot = kfailtot + 1
! endif ! rttov_errorstatus
enddo HEADER
end subroutine oda_storeHdx_radiances