!-------------------------------------- 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 tovs_rttov_AVHRR_for_IASI (nthreads,knpf_th,knpf,profilesdata_th,KULOUT,surfem1_avhrr,nch,iptobs_th ) 1,8
! appel séparé de RTTOV pour le calcul des radiances AVHRR
! (non assimilees mais necessaires au background check IASI)
use common_iasi
USE avhrr_var_mod
Use mod_tovs ,only :jpchus,jppf
Use rttov_types, only : &
rttov_coef ,&
profile_type ,&
transmission_Type ,&
radiance_type
implicit none
#include "rttov_setup.h"
integer ,intent(in) :: nthreads
integer ,intent(in) :: knpf
integer ,intent(in) :: knpf_th(nthreads)
integer ,intent (in) :: KULOUT
integer ,intent (in) :: nch
integer ,intent (in) :: iptobs_th(jppf,nthreads)
real (8) , intent (in) :: surfem1_avhrr(nch)
type (profile_type) ,intent (in) :: profilesdata_th(knpf,nthreads)
!*********************************************************************
integer ,parameter :: NSENSORS=1
INTEGER :: list_sensors (3,nsensors),setup_errorstatus(nsensors)
LOGICAL ,SAVE :: FIRST=.true.
integer :: ith,ich,i,j,jn
integer :: VERBOSITY_LEVEL
integer :: ncan(knpf)
integer :: nfrequencies_th(nthreads)
integer :: nchannels_th(nthreads)
integer :: nbtout_th(nthreads)
real*8, allocatable :: surfem1_th (:,:)
real*8, allocatable :: emissivity_th (:,:)
integer, allocatable :: lprofiles_th (:,:)
integer, allocatable :: channels_th (:,:)
logical, allocatable :: calcemis_th (:,:)
integer, allocatable :: polarisations_th(:,:)
integer :: ichan (NIR,nsensors)
integer :: alloc_status(20)
integer :: len_nchannels1,len_nfrequencies1,joff1,joff2,ioffset
type ( transmission_Type ) ,allocatable :: transmission_th(:)
type ( radiance_type ) ,allocatable :: radiancedata_d_th(:)
integer :: errorstatus_th(knpf,nthreads)
logical :: lcloud
integer :: knpf_tot,nchannels_max,nfrequencies_max
!***********************************************
IF (FIRST) THEN
VERBOSITY_LEVEL = 0
LIST_SENSORS(1,1)=10
LIST_SENSORS(2,1)=2
LIST_SENSORS(3,1)=5
DO ICH=1,NIR
ICHAN(ICH,1)=ICH
ENDDO
CALL RTTOV_SETUP (setup_errorstatus,KULOUT,VERBOSITY_LEVEL, &
NSENSORS,COEFF_AVHRR,LIST_SENSORS,ichan)
FIRST=.FALSE.
ENDIF
ncan(:)=NIR
do ith = 1, nthreads
call rttov_setupchan(knpf_th(ith),ncan,coeff_avhrr(1),nfrequencies_th(ith), &
& nchannels_th(ith),nbtout_th(ith))
enddo
nchannels_max=MAXVAL( nchannels_th(:) )
nfrequencies_max=MAXVAL( nfrequencies_th(:) )
allocate ( surfem1_th (nchannels_max,nthreads) ,stat=alloc_status(2))
allocate ( lprofiles_th (nfrequencies_max,nthreads) ,stat=alloc_status(3))
allocate ( emissivity_th (nchannels_max,nthreads) ,stat=alloc_status(4))
allocate ( channels_th (nfrequencies_max,nthreads) ,stat=alloc_status(5))
allocate ( polarisations_th(nchannels_max*3,nthreads) ,stat=alloc_status(6))
allocate ( calcemis_th (nchannels_max,nthreads) ,stat=alloc_status(7))
knpf_tot = 0
do ith = 1, nthreads
call rttov_setupchan(knpf_th(ith),ncan,coeff_avhrr(1),nfrequencies_th(ith), &
& nchannels_th(ith),nbtout_th(ith))
knpf_tot = knpf_tot + knpf_th(ith)
surfem1_th (:,ith) = 0.
do j = 1 , knpf_th(ith)
len_nchannels1 = nchannels_th(ith)/knpf_th(ith)
len_nfrequencies1 = nfrequencies_th(ith)/knpf_th(ith)
joff1=len_nchannels1*(j-1)
joff2=len_nfrequencies1*(j-1)
ioffset=len_nfrequencies1*(knpf_tot-knpf_th(ith))
calcemis_th(joff1+1:joff1+len_nchannels1 ,ith) = .false.
surfem1_th (joff2+1:joff2+len_nfrequencies1,ith) = &
& surfem1_avhrr(joff2+1+ioffset:joff2+len_nfrequencies1+ioffset)
enddo
call rttov_setupindex (ncan,knpf_th(ith),nfrequencies_th(ith),nchannels_th(ith),&
& nbtout_th(ith),coeff_avhrr(1),surfem1_th(:,ith),lprofiles_th (:,ith),&
& channels_th(:,ith),polarisations_th(:,ith),emissivity_th(:,ith))
enddo
deallocate ( surfem1_th ,stat=alloc_status(2))
allocate ( radiancedata_d_th(nthreads) ,stat=alloc_status(9) ) ! radiances full structure buffer used in rttov calls
allocate ( transmission_th (nthreads) ,stat=alloc_status(10)) ! transmission
do ith = 1, nthreads
! allocate transmittance structure
call tovs_allocate_transmission(transmission_th(ith),nchannels_th(ith),coeff_avhrr(1) % nlevels)
! allocate radiance structure
call tovs_allocate_radiance(radiancedata_d_th(ith),nchannels_th(ith),coeff_avhrr(1) % nlevels,nbtout_th(ith))
enddo
!$omp parallel
!$omp do private(ith)
do ith = 1, nthreads
CAll rttov_direct( &
errorstatus_th(:,ith), & ! out
nfrequencies_th(ith), & ! in
nchannels_th(ith), & ! in
nbtout_th(ith), & ! in
knpf_th(ith), & ! in
channels_th(:,ith), & ! in
polarisations_th(:,ith), & ! in
lprofiles_th(:,ith), & ! in
profilesdata_th(:,ith), & ! in
coeff_avhrr(1), & ! in
lcloud, & ! in
calcemis_th(:,ith), & ! in
emissivity_th(:,ith), & ! inout
transmission_th(ith), & ! inout
radiancedata_d_th(ith) ) ! inout
enddo
!$omp end do
!$omp end parallel
deallocate ( lprofiles_th ,stat=alloc_status(3))
deallocate ( channels_th ,stat=alloc_status(5))
deallocate ( polarisations_th ,stat=alloc_status(6))
deallocate ( calcemis_th ,stat=alloc_status(7))
do ith = 1, nthreads
do jn = 1, knpf_th(ith)
joff1=nbtout_th(ith)/knpf_th(ith)*(jn-1)
call insert_rad_avhrr(index=iptobs_th(jn,ith), &
tbclear = radiancedata_d_th(ith) % out_clear(joff1+1:joff1+nbtout_th(ith)/knpf_th(ith)), &
radclear = radiancedata_d_th(ith) % clear_out(joff1+1:joff1+nbtout_th(ith)/knpf_th(ith)) , &
radov = radiancedata_d_th(ith) % overcast(1:jplev,joff1+1:joff1+nbtout_th(ith)/knpf_th(ith)), &
transm = transmission_th(ith) % tau_layer(1:jplev,joff1+1:joff1+nbtout_th(ith)/knpf_th(ith)) , &
sfctau = transmission_th(ith) % tau_surf(joff1+1:joff1+nbtout_th(ith)/knpf_th(ith)), &
emiss= emissivity_th(joff1+1:joff1+nbtout_th(ith)/knpf_th(ith),ith), &
access_mode = 1 )
enddo
enddo
deallocate ( emissivity_th ,stat=alloc_status(4))
do ith = 1, nthreads
call tovs_deallocate_transmission(transmission_th(ith))
call tovs_deallocate_radiance(radiancedata_d_th(ith))
enddo
deallocate ( radiancedata_d_th ,stat=alloc_status(8) ) ! radiances full structure buffer used in rttov calls
deallocate ( transmission_th ,stat=alloc_status(9)) ! transmission
end subroutine tovs_rttov_AVHRR_for_IASI