541 lines
24 KiB
Fortran
541 lines
24 KiB
Fortran
|
subroutine RTTOV_fwd( nchannels , &
|
||
|
|
channelbegin , &
|
||
|
|
platformid , &
|
||
|
|
satid , &
|
||
|
|
insid , &
|
||
|
|
coefffile , &
|
||
|
|
scattcoef_file , &
|
||
|
|
emisfilepath , &
|
||
|
|
zeemancoef_file, &
|
||
|
|
spectype , &
|
||
|
|
nlevels , &
|
||
|
|
T , &
|
||
|
|
q , &
|
||
|
|
cloud , &
|
||
|
|
cfrac , &
|
||
|
|
CO2 , &
|
||
|
|
O3 , &
|
||
|
|
CH4 , &
|
||
|
|
N2O , &
|
||
|
|
CO , &
|
||
|
|
t2m , &
|
||
|
|
q2m , &
|
||
|
|
u10m , &
|
||
|
|
v10m , &
|
||
|
|
ts , &
|
||
|
|
psfc , &
|
||
|
|
dem , &
|
||
|
|
pressure , &
|
||
|
|
lat , &
|
||
|
|
lon , &
|
||
|
|
landseamask , &
|
||
|
|
year , &
|
||
|
|
month , &
|
||
|
|
zenith , &
|
||
|
|
azimuth , &
|
||
|
|
sunzang , &
|
||
|
|
sunazang , &
|
||
|
|
emiss_in , &
|
||
|
|
coefs , &
|
||
|
|
quality , &
|
||
|
|
bt)
|
||
|
|
|
||
|
|
!
|
||
|
|
Use rttov_const, Only : &
|
||
|
|
& errorstatus_success, &
|
||
|
|
& errorstatus_fatal, &
|
||
|
|
& platform_name, &
|
||
|
|
& inst_name, &
|
||
|
|
& sensor_id_mw, &
|
||
|
|
& sensor_id_po, &
|
||
|
|
& sensor_id_ir, &
|
||
|
|
& sensor_id_hi, &
|
||
|
|
& ir_scatt_dom, &
|
||
|
|
& surftype_sea
|
||
|
|
|
||
|
|
Use rttov_types, Only : &
|
||
|
|
& rttov_coefs, &
|
||
|
|
& rttov_options, &
|
||
|
|
& rttov_pccomp, &
|
||
|
|
& rttov_scatt_coef, &
|
||
|
|
& rttov_chanprof, &
|
||
|
|
& rttov_traj, &
|
||
|
|
& rttov_profile, &
|
||
|
|
& rttov_transmission, &
|
||
|
|
& rttov_radiance, &
|
||
|
|
& rttov_radiance2, &
|
||
|
|
& rttov_emissivity, &
|
||
|
|
& rttov_reflectance, &
|
||
|
|
& rttov_s2m, &
|
||
|
|
& rttov_skin, &
|
||
|
|
& rttov_geometry, &
|
||
|
|
& rttov_profile_cloud, &
|
||
|
|
& rttov_profile_scatt_aux
|
||
|
|
|
||
|
|
Use parkind1, Only : jpim, jprb, jplm
|
||
|
|
USE mod_rttov_emis_atlas, ONLY : &
|
||
|
|
rttov_emis_atlas_data, &
|
||
|
|
atlas_type_ir, atlas_type_mw
|
||
|
|
|
||
|
|
Use rttov_getoptions, Only : getoption
|
||
|
|
Use yomhook, Only : lhook, dr_hook
|
||
|
|
Use rttov_lun
|
||
|
|
Use rttov_unix_env, Only: rttov_exit
|
||
|
|
Use rttov_zutility
|
||
|
|
Use HDF5
|
||
|
|
Use netcdf
|
||
|
|
!OPEN MP
|
||
|
|
USE OMP_LIB
|
||
|
|
|
||
|
|
implicit none
|
||
|
|
!USE MPI
|
||
|
|
INCLUDE 'mpif.h'
|
||
|
|
|
||
|
|
!Implicit None
|
||
|
|
INCLUDE 'netcdf.inc'
|
||
|
|
|
||
|
|
#include "rttov_direct.interface"
|
||
|
|
#include "rttov_parallel_direct.interface"
|
||
|
|
|
||
|
|
#include "rttov_make_profile_inc.interface"
|
||
|
|
#include "rttov_scale_profile_inc.interface"
|
||
|
|
#include "rttov_make_radiance_inc.interface"
|
||
|
|
#include "rttov_scale_radiance_inc.interface"
|
||
|
|
#include "rttov_make_pccomp_inc.interface"
|
||
|
|
#include "rttov_scale_pccomp_inc.interface"
|
||
|
|
|
||
|
|
#include "rttov_init_coefs.interface"
|
||
|
|
#include "rttov_read_coefs.interface"
|
||
|
|
#include "rttov_dealloc_coefs.interface"
|
||
|
|
#include "rttov_alloc_rad.interface"
|
||
|
|
#include "rttov_init_rad.interface"
|
||
|
|
#include "rttov_alloc_prof.interface"
|
||
|
|
#include "rttov_init_transmission.interface"
|
||
|
|
#include "rttov_alloc_transmission.interface"
|
||
|
|
#include "rttov_alloc_pccomp.interface"
|
||
|
|
#include "rttov_add_prof.interface"
|
||
|
|
#include "rttov_copy_prof.interface"
|
||
|
|
#include "rttov_copy_rad.interface"
|
||
|
|
#include "rttov_alloc_traj.interface"
|
||
|
|
|
||
|
|
#include "rttov_errorreport.interface"
|
||
|
|
#include "rttov_read_scattcoeffs.interface"
|
||
|
|
#include "rttov_dealloc_scattcoeffs.interface"
|
||
|
|
#include "rttov_scatt_setupindex.interface"
|
||
|
|
#include "rttov_scatt.interface"
|
||
|
|
#include "rttov_scatt_ad.interface"
|
||
|
|
#include "rttov_alloc_scatt_prof.interface"
|
||
|
|
#include "rttov_setup_emis_atlas.interface"
|
||
|
|
#include "rttov_get_emis.interface"
|
||
|
|
#include "rttov_deallocate_emis_atlas.interface"
|
||
|
|
|
||
|
|
!--------------------------
|
||
|
|
Integer(Kind=jpim) :: iout=23 ! unit for output
|
||
|
|
Integer (Kind=jpim) :: nprof = 1 ! Number of profiles per call
|
||
|
|
Integer(Kind=jpim) :: nrttovid = 1 ! Number of sensor coeff files to read
|
||
|
|
|
||
|
|
! RTTOV_errorhandling interface
|
||
|
|
!====================
|
||
|
|
Integer(Kind=jpim) :: Err_Unit ! Logical error unit (<0 for default)
|
||
|
|
Integer(Kind=jpim) :: verbosity_level ! (<0 for default)
|
||
|
|
|
||
|
|
! RTTOV_setup interface
|
||
|
|
!====================
|
||
|
|
! Integer(Kind=jpim) :: setup_errorstatus ! setup return code
|
||
|
|
Integer(Kind=jpim), Allocatable :: instruments(:,:) ! platform id, sat id and sensor id
|
||
|
|
Type(rttov_options) :: opts ! Options structure
|
||
|
|
Type(rttov_coefs) :: coefs ! Coefficients structure
|
||
|
|
|
||
|
|
INTEGER(HID_T) :: space
|
||
|
|
|
||
|
|
! RTTOV interface
|
||
|
|
!====================
|
||
|
|
! Integer(Kind=jpim) :: rttov_errorstatus ! rttov error return code
|
||
|
|
Integer(Kind=jpim) :: nchannels, nchanprof,channelbegin, channelend,channelbin
|
||
|
|
Integer(Kind=jpim) :: nlevels, nlayers
|
||
|
|
Type(rttov_chanprof), Allocatable :: chanprof(:)
|
||
|
|
Type(rttov_profile), Allocatable :: profiles(:)
|
||
|
|
Logical(Kind=jplm), Allocatable :: calcemis(:)
|
||
|
|
TYPE(rttov_emis_atlas_data) :: emis_atlas
|
||
|
|
TYPE(rttov_emissivity), Allocatable :: emiss(:)
|
||
|
|
Type(rttov_transmission) :: transmission ! transmittances and layer optical depths
|
||
|
|
Type(rttov_radiance) :: radiance
|
||
|
|
TYPE(rttov_radiance2) :: radiance2
|
||
|
|
Real(Kind=4),dimension(nchannels) :: bt,emiss_out,emiss_in
|
||
|
|
Integer(kind=4),dimension(nchannels) :: quality
|
||
|
|
|
||
|
|
|
||
|
|
Integer(Kind=jpim) :: alloc_status(20)
|
||
|
|
Integer(Kind=jpim) :: errorstatus
|
||
|
|
Real(Kind=jprb), Allocatable :: emissivity(:)
|
||
|
|
Character (len=80) :: errMessage
|
||
|
|
Character (len=13) :: NameOfRoutine = 'RTTOV_fwd_clr'
|
||
|
|
character(len=400) :: coefffile
|
||
|
|
Character (len=400) :: emisfilepath
|
||
|
|
Character (len=400) :: zeemancoef_file
|
||
|
|
|
||
|
|
Integer(Kind=jpim), Parameter :: mxchn = 9000 ! max number of channels
|
||
|
|
Integer(Kind=jpim) :: input_chan(mxchn)
|
||
|
|
Real(Kind=jprb) :: input_ems(mxchn)
|
||
|
|
!==================for read satellite.HDF===================
|
||
|
|
Real(Kind=jprb) :: zenith
|
||
|
|
Real(Kind=jprb) :: azimuth
|
||
|
|
Real(Kind=jprb) :: sunzang
|
||
|
|
Real(Kind=jprb) :: sunazang
|
||
|
|
Real(Kind=jprb) :: lat
|
||
|
|
real(kind=jprb) :: lon
|
||
|
|
integer(kind=4) :: landseamask
|
||
|
|
integer(Kind=jpim) :: year
|
||
|
|
integer(Kind=jpim) :: month
|
||
|
|
integer(Kind=jpim) :: day
|
||
|
|
|
||
|
|
!=======================for read NWP=====================
|
||
|
|
real(kind=4),dimension(nlevels) :: pressure
|
||
|
|
real(kind=4),allocatable,dimension(:) :: pressureh
|
||
|
|
real(kind=4),dimension(nlevels) :: T,q,CO2,O3,N2O,CO,CH4,cfrac
|
||
|
|
real(kind=4),dimension(6,nlevels-1) :: cloud
|
||
|
|
real(kind=4) :: PSFC,ts,q2m,t2m,u10m,v10m,dem
|
||
|
|
|
||
|
|
!===========================================================
|
||
|
|
real(kind=jprb) :: ZeemanBe, ZeemanCosbk, ZeemanCosba
|
||
|
|
Integer(Kind=jpim) :: ivch, ich
|
||
|
|
Integer(Kind=jpim) :: asw ! allocate or deallocate switch
|
||
|
|
Real(Kind=jprb) :: ems_val
|
||
|
|
Integer(Kind=jpim), Allocatable :: nchan(:) ! number of channels per profile
|
||
|
|
logical(Kind=jplm) :: addrefrac
|
||
|
|
logical(Kind=jplm) :: addsolar
|
||
|
|
logical(Kind=jplm) :: addaerosl
|
||
|
|
logical(Kind=jplm) :: addclouds
|
||
|
|
logical(Kind=jplm) :: all_channels
|
||
|
|
INTEGER(KIND=jpim) :: atlas_type
|
||
|
|
logical(Kind=jplm) :: init= .True.
|
||
|
|
INTEGER(KIND=jpim) :: dosolar !0=no, 1=yes
|
||
|
|
INTEGER(KIND=jpim) :: nthreads
|
||
|
|
Logical(Kind=jplm) :: addinterp ! switch for the interpolator
|
||
|
|
Logical(kind=jplm) :: ismin(3,3)
|
||
|
|
! printing arrays
|
||
|
|
|
||
|
|
real(kind=4) :: filvalue(5)
|
||
|
|
Integer(Kind=jpim) :: j, jch, i, ii, jj, scanl, scanp,kk
|
||
|
|
|
||
|
|
Character (len=10) :: spectype
|
||
|
|
Character (len=14) :: strtime
|
||
|
|
|
||
|
|
|
||
|
|
Character (len=300) :: configfile,scattcoef_file
|
||
|
|
character :: strmonth*2
|
||
|
|
integer :: narg=0,platformid,satid,insid
|
||
|
|
integer :: nchan_array(2)
|
||
|
|
|
||
|
|
|
||
|
|
errorstatus = 0_jpim
|
||
|
|
alloc_status(:) = 0_jpim
|
||
|
|
filvalue(:) = -9999.0
|
||
|
|
|
||
|
|
allocate (instruments(3,1),stat= alloc_status(1))
|
||
|
|
Allocate (nchan(1))
|
||
|
|
|
||
|
|
|
||
|
|
instruments(1,1) = platformid
|
||
|
|
instruments(2,1) = satid
|
||
|
|
instruments(3,1) = insid
|
||
|
|
|
||
|
|
nlayers = nlevels-1
|
||
|
|
|
||
|
|
allocate(pressureh(nlayers))
|
||
|
|
pressureh(1:nlevels-1) = (pressure(2:nlevels) - pressure(:nlevels-1) ) / &
|
||
|
|
log(pressure(2:nlevels)/pressure(:nlevels-1))
|
||
|
|
|
||
|
|
|
||
|
|
!===============end of read NWP data=============================================================
|
||
|
|
dosolar=0
|
||
|
|
nthreads=1
|
||
|
|
if(zenith>=75)then
|
||
|
|
zenith = 74.5_jprb
|
||
|
|
endif
|
||
|
|
IF (dosolar == 1) THEN
|
||
|
|
opts % rt_ir % addsolar = .TRUE. ! Include solar radiation
|
||
|
|
ELSE
|
||
|
|
opts % rt_ir % addsolar = .FALSE. ! Do not include solar radiation
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
!opts % interpolation % interp_mode = 1
|
||
|
|
opts % interpolation % addinterp = .TRUE. ! Allow interpolation of input profile
|
||
|
|
opts % interpolation % interp_mode = 1 ! Set interpolation method
|
||
|
|
|
||
|
|
opts % rt_all % addrefrac = .TRUE. ! Include refraction in path calc
|
||
|
|
opts % rt_ir % addaerosl = .FALSE. ! Don't include aerosol effects
|
||
|
|
opts % rt_ir % addclouds = .TRUE. ! Include cloud effects
|
||
|
|
opts % rt_ir % ir_sea_emis_model = 2
|
||
|
|
opts % rt_ir % ir_scatt_model = 1 ! Scattering model for emission source term:
|
||
|
|
! 1 => DOM; 2 => Chou-scaling
|
||
|
|
opts % rt_ir % vis_scatt_model = 1 ! Scattering model for solar source term:
|
||
|
|
! 1 => DOM; 2 => single-scattering
|
||
|
|
opts % rt_ir % grid_box_avg_cloud = .TRUE.
|
||
|
|
opts % rt_ir % dom_nstreams = 4 ! Number of streams for Discrete Ordinates (DOM)
|
||
|
|
|
||
|
|
opts % rt_ir % ozone_data = .TRUE. ! Set the relevant flag to .TRUE.
|
||
|
|
opts % rt_ir % co2_data = .FALSE. ! when supplying a profile of the
|
||
|
|
opts % rt_ir % n2o_data = .FALSE. ! given trace gas (ensure the
|
||
|
|
opts % rt_ir % ch4_data = .FALSE. ! coef file supports the gas)
|
||
|
|
opts % rt_ir % co_data = .FALSE. !
|
||
|
|
opts % rt_ir % so2_data = .FALSE. !
|
||
|
|
opts % config % apply_reg_limits = .TRUE.
|
||
|
|
opts % config % do_checkinput = .TRUE.
|
||
|
|
opts % config % verbose = .TRUE. ! Enable printing of warnings
|
||
|
|
!======================mixed gas mixing ratio(ppmv)===================================
|
||
|
|
|
||
|
|
|
||
|
|
! channelbegin = 1_jpim
|
||
|
|
channelbin = nchannels
|
||
|
|
Allocate(chanprof(channelbin)) ! Note these array sizes nchan can vary per profile
|
||
|
|
DO jch = channelbegin, channelbegin+channelbin-1
|
||
|
|
chanprof(jch-channelbegin+1)%prof = 1_jpim
|
||
|
|
chanprof(jch-channelbegin+1)%chan = jch-channelbegin+1 !input_chan(jch)
|
||
|
|
input_chan(jch-channelbegin+1) = jch
|
||
|
|
End Do
|
||
|
|
|
||
|
|
! call rttov_read_coefs (errorstatus, coefs, opts, &
|
||
|
|
! channels = input_chan(1:channelbin), &
|
||
|
|
! channels_rec = input_chan(1:channelbin),&
|
||
|
|
! file_coef=trim(coefffile))
|
||
|
|
nchan(nprof) = coefs % coef % fmv_chn
|
||
|
|
! print*,'~~~~~~~~~~~~~~~~~~',coefs%coef%fmv_chn
|
||
|
|
! print*,'coeffile=',trim(coefffile)
|
||
|
|
|
||
|
|
! print*,'ff_chn',coefs%coef%ff_ori_chn
|
||
|
|
! print*,'ff_wavn',coefs%coef%ff_cwn
|
||
|
|
! call rttov_init_coefs (errorstatus, opts, coefs)
|
||
|
|
|
||
|
|
!============end of read coefficient========================
|
||
|
|
nchanprof = channelbin * nprof
|
||
|
|
|
||
|
|
|
||
|
|
Allocate(emissivity(channelbin))
|
||
|
|
Allocate(emiss (channelbin))
|
||
|
|
Allocate(calcemis (channelbin))
|
||
|
|
Allocate(profiles (nprof))
|
||
|
|
! atlas_type = atlas_type_ir
|
||
|
|
! print*,'month=',month,atlas_type
|
||
|
|
! if(landseamask/=3)then
|
||
|
|
! call rttov_setup_emis_atlas(errorstatus,opts,month,atlas_type,emis_atlas,coefs=coefs,path=emisfilepath)
|
||
|
|
! endif
|
||
|
|
! stop
|
||
|
|
! if(trim(spectype)=='AMSUA')then
|
||
|
|
! call rttov_atlas_setup(errorstatus,month,coefs%coef,path=emisfilepath,mw_atlas_ver=200)
|
||
|
|
! errorstatus = load_bfield_lut(zeemancoef_file)
|
||
|
|
! else
|
||
|
|
! call rttov_atlas_setup(errorstatus,month,coefs%coef,path=emisfilepath)
|
||
|
|
! endif
|
||
|
|
|
||
|
|
errorstatus=0_jpim
|
||
|
|
|
||
|
|
asw = 1 ! allocate
|
||
|
|
!profiles(1) % nlevels = nlevels
|
||
|
|
call rttov_alloc_prof( &
|
||
|
|
& errorstatus, &
|
||
|
|
& nprof, &
|
||
|
|
& profiles, &
|
||
|
|
& nlevels, &
|
||
|
|
& opts, &
|
||
|
|
& asw, &
|
||
|
|
& coefs, &
|
||
|
|
& init )
|
||
|
|
call rttov_alloc_transmission( &
|
||
|
|
& errorstatus, &
|
||
|
|
& transmission, &
|
||
|
|
& nlevels, &
|
||
|
|
& channelbin, &
|
||
|
|
& asw, &
|
||
|
|
& init)
|
||
|
|
call rttov_alloc_rad ( &
|
||
|
|
& errorstatus, &
|
||
|
|
& channelbin, &
|
||
|
|
& radiance, &
|
||
|
|
& nlevels, &
|
||
|
|
& asw, &
|
||
|
|
& radiance2, &
|
||
|
|
& init)
|
||
|
|
|
||
|
|
if(trim(spectype)=='AMSUA')then
|
||
|
|
call compute_bfield (lat, lon, zenith, azimuth, ZeemanBe, ZeemanCosbk, ZeemanCosba)
|
||
|
|
profiles(1) % Be = ZeemanBe
|
||
|
|
profiles(1) % cosbk = ZeemanCosbk
|
||
|
|
endif
|
||
|
|
profiles(1) % zenangle = zenith
|
||
|
|
profiles(1) % azangle = azimuth
|
||
|
|
profiles(1) % latitude = lat
|
||
|
|
profiles(1) % longitude = lon
|
||
|
|
profiles(1) % sunzenangle = sunzang
|
||
|
|
profiles(1) % sunazangle = sunazang
|
||
|
|
profiles(1) % elevation = dem
|
||
|
|
profiles(1) % mmr_cldaer = .TRUE.
|
||
|
|
! print*,'azangele', profiles(1) % azangle,'zenith=',profiles(1) % zenangle
|
||
|
|
! print*,'latitude',profiles(1) % latitude,'lon',profiles(1) % longitude
|
||
|
|
! print*,'sunze', profiles(1) % sunzenangle,'sunaz',profiles(1) % sunazangle
|
||
|
|
! print*,'spectype',spectype
|
||
|
|
|
||
|
|
if (landseamask == 1) then
|
||
|
|
profiles(1) % skin % surftype = 0 !0:land
|
||
|
|
profiles(1) % skin % watertype = 0
|
||
|
|
endif
|
||
|
|
if (landseamask == 2) then
|
||
|
|
profiles(1) % skin % surftype = 1
|
||
|
|
profiles(1) % skin % watertype = 0
|
||
|
|
endif
|
||
|
|
if (landseamask==3 .or. landseamask==0) then
|
||
|
|
profiles(1) % skin % surftype = 1
|
||
|
|
profiles(1) % skin % watertype = 1
|
||
|
|
endif
|
||
|
|
|
||
|
|
!====interpolate to the observation point of satellite======
|
||
|
|
! print*,'surftype=',profiles(1) % skin % surftype
|
||
|
|
|
||
|
|
profiles(1) % p(:) = pressure(:)
|
||
|
|
profiles(1) % t(:) = T(:)
|
||
|
|
!print*,'T',profiles(1) % t(:)
|
||
|
|
profiles(1) % q(:) = q(:)
|
||
|
|
!print*,'q',profiles(1) % q(:)
|
||
|
|
profiles(1) % s2m % t = t2m
|
||
|
|
!print*,'t2m',profiles(1) % s2m % t
|
||
|
|
profiles(1) % s2m % q = q2m
|
||
|
|
profiles(1) % s2m % p = psfc
|
||
|
|
!print*,'psfc',profiles(1) % s2m % p
|
||
|
|
profiles(1) % s2m % u = u10m
|
||
|
|
!print*,'u10m',profiles(1) % s2m % u
|
||
|
|
profiles(1) % s2m % v = v10m
|
||
|
|
!profiles(1) % s2m % wfetc = 1000.
|
||
|
|
profiles(1) % s2m % wfetc = 100000. !20210316
|
||
|
|
!print*,'v10m',profiles(1) % s2m % v
|
||
|
|
!-------------skin variables------------------------------
|
||
|
|
profiles(1) % skin % fastem = (/3.0, 5.0, 15.0, 0.1, 0.3/)
|
||
|
|
|
||
|
|
profiles(1) % skin % t = ts
|
||
|
|
!print*,'ts',profiles(1) % skin % t
|
||
|
|
profiles(1) % O3(:) = O3(:)
|
||
|
|
IF( opts % rt_ir % co2_data ) profiles(1) % CO2(:) = CO2(:) ! we do not have profiles
|
||
|
|
IF( opts % rt_ir % n2o_data ) profiles(1) % N2O(:) = N2O(:) ! for any other constituents
|
||
|
|
IF( opts % rt_ir % ch4_data ) profiles(1) % CH4(:) = CH4(:) !
|
||
|
|
IF( opts % rt_ir % co_data ) profiles(1) % CO(:) = CO (:)
|
||
|
|
! profiles(1) % ctp = -9999999
|
||
|
|
! profiles(1) % cfraction = 0.0
|
||
|
|
! profiles(1) % idg = 0.0
|
||
|
|
! profiles(1) % ish = 0.0
|
||
|
|
! print*,'O3', profiles(1) % O3(:)
|
||
|
|
profiles(1) % idg = 2
|
||
|
|
profiles(1) % clw_scheme = 1
|
||
|
|
profiles(1) % ice_scheme = 2
|
||
|
|
if( opts % rt_ir % addclouds ) then
|
||
|
|
profiles(1) %cloud(:,:) = cloud(:,:)
|
||
|
|
profiles(1) %cfrac(:) = cfrac(:)
|
||
|
|
endif
|
||
|
|
where (profiles(1) %cfrac(:)<0)
|
||
|
|
profiles(1) %cfrac(:) = 0.0_jprb
|
||
|
|
endwhere
|
||
|
|
where (profiles(1) %cfrac(:)>1)
|
||
|
|
profiles(1) %cfrac(:) = 1.0_jprb
|
||
|
|
endwhere
|
||
|
|
if( landseamask/=3 .and. landseamask/=2)then
|
||
|
|
if(minval(emiss_in)<0.001 ) then
|
||
|
|
bt(:) = -9999.9
|
||
|
|
quality(:) = -9999
|
||
|
|
else
|
||
|
|
emiss(:) % emis_in = emiss_in(:)
|
||
|
|
calcemis(:) = .False.
|
||
|
|
IF (nthreads <= 1) THEN
|
||
|
|
call rttov_direct( &
|
||
|
|
& errorstatus, &! out error flag
|
||
|
|
& chanprof, &! in channel and profile index structure
|
||
|
|
& opts, &! in options structure
|
||
|
|
& profiles, &! in profile array
|
||
|
|
& coefs, &
|
||
|
|
& transmission, &! inout computed transmittances
|
||
|
|
& radiance, &
|
||
|
|
& calcemis=calcemis, &
|
||
|
|
& emissivity=emiss &! inout input emissivities per channel
|
||
|
|
)
|
||
|
|
else
|
||
|
|
call rttov_parallel_direct( &
|
||
|
|
& errorstatus, &! out error flag
|
||
|
|
& chanprof, &! in channel and profile index structure
|
||
|
|
& opts, &! in options structure
|
||
|
|
& profiles, &! in profile array
|
||
|
|
& coefs, &
|
||
|
|
& transmission, &! inout computed transmittances
|
||
|
|
& radiance, &
|
||
|
|
& calcemis=calcemis, &
|
||
|
|
& emissivity=emiss, &! inout input emissivities per channel
|
||
|
|
& nthreads= nthreads &
|
||
|
|
)
|
||
|
|
endif
|
||
|
|
if(radiance % bt(1)<0)then
|
||
|
|
print*,' RTTOV EXIT : calculation error'
|
||
|
|
stop
|
||
|
|
endif
|
||
|
|
bt(:) = radiance%bt(:)
|
||
|
|
quality(:) = radiance%quality(:)
|
||
|
|
emiss_out(:) = emiss(:) % emis_out
|
||
|
|
! print*,'emiss_land=',emiss_out
|
||
|
|
endif
|
||
|
|
else
|
||
|
|
emiss(:) % emis_in = emiss_in(:)
|
||
|
|
calcemis(:) = .True.
|
||
|
|
! print*,'****', emiss_in(:), calcemis(1:5)
|
||
|
|
IF (nthreads <= 1) THEN
|
||
|
|
call rttov_direct( &
|
||
|
|
& errorstatus, &! out error flag
|
||
|
|
& chanprof, &! in channel and profile index structure
|
||
|
|
& opts, &! in options structure
|
||
|
|
& profiles, &! in profile array
|
||
|
|
& coefs, &
|
||
|
|
& transmission, &! inout computed transmittances
|
||
|
|
& radiance, &
|
||
|
|
& calcemis=calcemis, &
|
||
|
|
& emissivity=emiss &! inout input emissivities per channel
|
||
|
|
)
|
||
|
|
else
|
||
|
|
call rttov_parallel_direct( &
|
||
|
|
& errorstatus, &! out error flag
|
||
|
|
& chanprof, &! in channel and profile index structure
|
||
|
|
& opts, &! in options structure
|
||
|
|
& profiles, &! in profile array
|
||
|
|
& coefs, &
|
||
|
|
& transmission, &! inout computed transmittances
|
||
|
|
& radiance, &
|
||
|
|
& calcemis=calcemis, &
|
||
|
|
& emissivity=emiss, &! inout input emissivities per channel
|
||
|
|
& nthreads= nthreads &
|
||
|
|
)
|
||
|
|
endif
|
||
|
|
if(radiance % bt(1)<0)then
|
||
|
|
print*,' RTTOV EXIT : calculation error'
|
||
|
|
stop
|
||
|
|
endif
|
||
|
|
bt(:) = radiance%bt(:)
|
||
|
|
quality(:) = radiance%quality(:)
|
||
|
|
emiss_out(:) = emiss(:) % emis_out
|
||
|
|
! print*,'BT=',radiance%bt(:),radiance%quality(:),quality
|
||
|
|
! if(maxval(radiance%quality(:))>0)stop
|
||
|
|
endif
|
||
|
|
!print*,'bt=',radiance%bt(1:5)
|
||
|
|
! stop
|
||
|
|
asw = 0 ! deallocate radiance arrays
|
||
|
|
call rttov_alloc_rad (errorstatus,channelbin,radiance,nlevels,asw,radiance2)
|
||
|
|
asw = 0 ! deallocate profile arrays
|
||
|
|
call rttov_alloc_prof (errorstatus,nprof,profiles,nlevels,opts,asw)
|
||
|
|
asw = 0 ! deallocate profile arrays
|
||
|
|
call rttov_alloc_transmission (errorstatus,transmission,nlevels,channelbin,asw)
|
||
|
|
! call rttov_dealloc_coefs(errorstatus,coefs)
|
||
|
|
deallocate(emissivity)
|
||
|
|
deallocate(calcemis)
|
||
|
|
deallocate(profiles)
|
||
|
|
deallocate(emiss)
|
||
|
|
deallocate(chanprof)
|
||
|
|
deallocate(instruments)
|
||
|
|
deallocate(nchan)
|
||
|
|
deallocate(pressureh)
|
||
|
|
! if(landseamask/=3)then
|
||
|
|
! CALL rttov_deallocate_emis_atlas(emis_atlas)
|
||
|
|
! endif
|
||
|
|
End subroutine RTTOV_fwd
|