78 '$Id: ODZeeman_AtmAbsorption.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $' 130 ChannelIndex , & ! Input
131 Predictor , & ! Input
136 INTEGER ,
INTENT(IN) :: channelindex
140 INTEGER :: n_user_layers
141 REAL(fp) :: od_path(0:predictor%n_layers)
142 REAL(fp) :: user_od_path(0:predictor%n_user_layers)
143 INTEGER :: odps2user_idx(2, 0:predictor%n_user_layers)
146 n_user_layers = predictor%n_User_Layers
163 IF ( pafv_associated(predictor%PAFV) )
THEN 165 predictor%PAFV%OD_Path = od_path
167 user_od_path(0) =
zero 170 predictor%Ref_Level_LnPressure, &
171 predictor%User_Level_LnPressure, &
176 predictor%User_Level_LnPressure,&
181 predictor%Ref_Level_LnPressure, &
182 predictor%User_Level_LnPressure, &
189 atmoptics%Optical_Depth = (user_od_path(1:n_user_layers) - &
190 user_od_path(0:n_user_layers-1)) / &
191 predictor%Secant_Zenith_Surface
248 ChannelIndex , & ! Input
249 Predictor , & ! Input
250 Predictor_TL, & ! Input
254 INTEGER ,
INTENT(IN) :: channelindex
259 INTEGER :: n_user_layers
260 REAL(fp) :: od_path_tl(0:predictor%n_layers)
261 REAL(fp) :: user_od_path_tl(0:predictor%n_user_layers)
264 n_user_layers = predictor%n_User_Layers
283 predictor%Ref_Level_LnPressure, &
284 predictor%User_Level_LnPressure, &
288 atmoptics_tl%Optical_Depth = (user_od_path_tl(1:n_user_layers) - &
289 user_od_path_tl(0:n_user_layers-1)) / &
290 predictor%Secant_Zenith_Surface
347 ChannelIndex , & ! Input
348 Predictor , & ! Input
349 AtmOptics_AD, & ! Input
353 INTEGER ,
INTENT(IN) :: channelindex
358 INTEGER :: n_user_layers, k
359 REAL(fp) :: od_path_ad(0:predictor%n_layers)
360 REAL(fp) :: user_od_path_ad(0:predictor%n_user_layers)
363 n_user_layers = predictor%n_User_Layers
369 user_od_path_ad(n_user_layers) =
zero 370 DO k = n_user_layers, 1, -1
371 user_od_path_ad(k) = user_od_path_ad(k) &
372 + atmoptics_ad%Optical_Depth(k)/predictor%Secant_Zenith_Surface
374 user_od_path_ad(k-1) = -atmoptics_ad%Optical_Depth(k)/predictor%Secant_Zenith_Surface
376 atmoptics_ad%Optical_Depth =
zero 380 predictor%Ref_Level_LnPressure, &
381 predictor%User_Level_LnPressure, &
386 user_od_path_ad(0) =
zero 454 INTEGER,
INTENT( IN ) :: ChannelIndex
455 TYPE(ODPS_type),
INTENT( IN ) :: TC
456 TYPE(ODPS_Predictor_type),
INTENT( INOUT ) :: Predictor
457 REAL(fp),
INTENT( OUT) :: OD_Path(0:)
460 REAL(fp),
DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD
462 REAL(fp) :: w1, w2, Doppler_shift
463 INTEGER :: i, j, j1, j2, js1, js2, k, inode, n_nodes, n_Layers, nc, np
466 np = tc%n_Predictors(1, channelindex)
475 doppler_shift = predictor%u
476 j = tc%Pos_Index(1, channelindex)
478 n_nodes = int(tc%C(j))
480 n_layers = predictor%n_Layers
482 IF(doppler_shift < tc%C(j))
THEN 487 ELSE IF(doppler_shift > tc%C(j+n_nodes-1))
THEN 496 IF(doppler_shift >= tc%C(j1) .AND. doppler_shift <= tc%C(j2))
THEN 497 w1 = (tc%C(j2) - doppler_shift)/(tc%C(j2) - tc%C(j1))
511 j1 = j + n_nodes + (inode-1)*nc
514 js1 = j1+(i-1)*n_layers-1
515 js2 = j2+(i-1)*n_layers-1
517 od1(k) = od1(k) + tc%C(js1+k)*predictor%X(k, i, 1)
518 od2(k) = od2(k) + tc%C(js2+k)*predictor%X(k, i, 1)
526 IF(channelindex == 2)
THEN 527 od(k) = w1*exp(od1(k)) + w2*exp(od2(k))
530 od(k) = w1*od1(k) + w2*od2(k)
534 od_path(k) = od_path(k-1) + od_tmp*predictor%Secant_Zenith(k)
538 IF ( pafv_associated(predictor%PAFV) )
THEN 539 predictor%PAFV%OD = od
540 predictor%PAFV%w1 = w1
541 predictor%PAFV%w2 = w2
542 predictor%PAFV%inode = inode
606 INTEGER,
INTENT( IN ) :: ChannelIndex
607 TYPE(ODPS_type),
INTENT( IN ) :: TC
608 TYPE(ODPS_Predictor_type),
INTENT( IN ) :: Predictor
609 TYPE(ODPS_Predictor_type),
INTENT( INOUT ) :: Predictor_TL
610 REAL(fp),
INTENT(OUT) :: OD_Path_TL(0:)
613 REAL(fp),
DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD1_TL, OD2_TL
616 INTEGER :: i, j, j1, j2, js1, js2, k, n_nodes, n_Layers, nc, np
619 np = tc%n_Predictors(1, channelindex)
628 j = tc%Pos_Index(1, channelindex)
629 n_nodes = int(tc%C(j))
630 n_layers = predictor%n_Layers
642 j1 = j + n_nodes + (predictor%PAFV%inode-1)*nc
645 js1 = j1+(i-1)*n_layers-1
646 js2 = j2+(i-1)*n_layers-1
648 od1(k) = od1(k) + tc%C(js1+k)*predictor%X(k, i, 1)
649 od2(k) = od2(k) + tc%C(js2+k)*predictor%X(k, i, 1)
650 od1_tl(k) = od1_tl(k) + tc%C(js1+k)*predictor_tl%X(k, i, 1)
651 od2_tl(k) = od2_tl(k) + tc%C(js2+k)*predictor_tl%X(k, i, 1)
659 IF(channelindex == 2)
THEN 662 od_tl = predictor%PAFV%w1*o1*od1_tl(k) + predictor%PAFV%w2*o2*od2_tl(k)
664 od_tl = predictor%PAFV%w1*od1_tl(k) + predictor%PAFV%w2*od2_tl(k)
665 IF(predictor%PAFV%OD(k) <
zero)od_tl =
zero 667 od_path_tl(k) = od_path_tl(k-1) + od_tl*predictor%Secant_Zenith(k)
729 INTEGER,
INTENT( IN ) :: ChannelIndex
730 TYPE(ODPS_type),
INTENT( IN ) :: TC
731 TYPE(ODPS_Predictor_type),
INTENT( IN ) :: Predictor
732 REAL(fp),
INTENT( INOUT ) :: OD_Path_AD(0:)
733 TYPE(ODPS_Predictor_type),
INTENT( INOUT ) :: Predictor_AD
736 REAL(fp),
DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD1_AD, OD2_AD
739 INTEGER :: i, j, j1, j2, js1, js2, k, n_nodes, n_Layers, nc, np
741 np = tc%n_Predictors(1, channelindex)
748 j = tc%Pos_Index(1, channelindex)
749 n_nodes = int(tc%C(j))
750 n_layers = predictor%n_Layers
756 j1 = j + n_nodes + (predictor%PAFV%inode-1)*nc
759 js1 = j1+(i-1)*n_layers-1
760 js2 = j2+(i-1)*n_layers-1
762 od1(k) = od1(k) + tc%C(js1+k)*predictor%X(k, i, 1)
763 od2(k) = od2(k) + tc%C(js2+k)*predictor%X(k, i, 1)
770 DO k = n_layers, 1, -1
771 od_ad = predictor%Secant_Zenith(k)*od_path_ad(k)
772 od_path_ad(k-1) = od_path_ad(k-1) + od_path_ad(k)
773 IF(channelindex == 2)
THEN 777 od1_ad(k) = predictor%PAFV%w1*o1*od_ad
778 od2_ad(k) = predictor%PAFV%w2*o2*od_ad
780 IF(predictor%PAFV%OD(k) <
zero)od_ad =
zero 781 od1_ad(k) = predictor%PAFV%w1*od_ad
782 od2_ad(k) = predictor%PAFV%w2*od_ad
787 js1 = j1+(i-1)*n_layers-1
788 js2 = j2+(i-1)*n_layers-1
789 DO k = n_layers, 1, -1
790 predictor_ad%X(k, i, 1) = predictor_ad%X(k, i, 1) + &
791 od1_ad(k)*tc%C(js1+k)
792 predictor_ad%X(k, i, 1) = predictor_ad%X(k, i, 1) + &
793 od2_ad(k)*tc%C(js2+k)
844 TYPE(ODPS_type),
INTENT( IN ) :: TC
845 TYPE(ODPS_Predictor_type),
INTENT( INOUT ) :: Predictor
846 REAL(fp),
INTENT( OUT) :: OD_Path(0:)
849 REAL(fp),
DIMENSION(Predictor%n_Layers) :: ODv, ODh
850 REAL(fp),
DIMENSION(0:Predictor%n_Layers) :: ODv_Path, ODh_Path
851 REAL(fp) :: tauv, tauh, tau
853 INTEGER :: i, j1, j2, k1, k2, k, m1, m2, n_Layers, np
856 np = tc%n_Predictors(1, 1)
864 n_layers = predictor%n_Layers
865 j1 = tc%Pos_Index(1, 1)
866 j2 = j1 + (np+1)*n_layers
869 odv = tc%C(j1:(j1+n_layers-1))
870 odh = tc%C(j2:(j2+n_layers-1))
878 odv(k) = odv(k) + tc%C(k1)*predictor%X(k, i, 1)
879 odh(k) = odh(k) + tc%C(k2)*predictor%X(k, i, 1)
892 odv_path(k) = odv_path(k-1) + odv(k)
893 tauv = exp(-odv_path(k))
895 odh_path(k) = odh_path(k-1) + odh(k)
896 tauh = exp(-odh_path(k))
898 tau = wv*tauv + wh*tauh
899 od_path(k) = -log(tau)
954 TYPE(ODPS_type),
INTENT( IN ) :: TC
955 TYPE(ODPS_Predictor_type),
INTENT( IN ) :: Predictor
956 TYPE(ODPS_Predictor_type),
INTENT( IN ) :: Predictor_TL
957 REAL(fp),
INTENT( OUT) :: OD_Path_TL(0:)
960 REAL(fp),
DIMENSION(Predictor%n_Layers) :: ODv, ODh, ODv_TL, ODh_TL
961 REAL(fp),
DIMENSION(0:Predictor%n_Layers) :: ODv_Path, ODh_Path, ODv_Path_Tl, ODh_Path_TL
962 REAL(fp) :: tauv, tauh, tau, tauv_TL, tauh_TL, tau_TL
964 INTEGER :: i, j1, j2, k1, k2, k, m1, m2, n_Layers, np
967 np = tc%n_Predictors(1, 1)
975 n_layers = predictor%n_Layers
976 j1 = tc%Pos_Index(1, 1)
977 j2 = j1 + (np+1)*n_layers
979 odv = tc%C(j1:(j1+n_layers-1))
980 odh = tc%C(j2:(j2+n_layers-1))
989 odv(k) = odv(k) + tc%C(k1)*predictor%X(k, i, 1)
990 odh(k) = odh(k) + tc%C(k2)*predictor%X(k, i, 1)
991 odv_tl(k) = odv_tl(k) + tc%C(k1)*predictor_tl%X(k, i, 1)
992 odh_tl(k) = odh_tl(k) + tc%C(k2)*predictor_tl%X(k, i, 1)
1003 odv_path_tl(0) =
zero 1004 odh_path_tl(0) =
zero 1006 IF(odv(k) <
zero)
THEN 1010 odv_path(k) = odv_path(k-1) + odv(k)
1011 tauv = exp(-odv_path(k))
1012 odv_path_tl(k) = odv_path_tl(k-1) + odv_tl(k)
1013 tauv_tl = -tauv*odv_path_tl(k)
1015 IF(odh(k) <
zero)
THEN 1019 odh_path(k) = odh_path(k-1) + odh(k)
1020 tauh = exp(-odh_path(k))
1021 odh_path_tl(k) = odh_path_tl(k-1) + odh_tl(k)
1022 tauh_tl = -tauh*odh_path_tl(k)
1024 tau = wv*tauv + wh*tauh
1025 tau_tl = wv*tauv_tl + wh*tauh_tl
1026 od_path_tl(k) = -(
one/tau)*tau_tl
1082 TYPE(ODPS_type),
INTENT( IN ) :: TC
1083 TYPE(ODPS_Predictor_type),
INTENT( IN ) :: Predictor
1084 REAL(fp),
INTENT( INOUT) :: OD_Path_AD(0:)
1085 TYPE(ODPS_Predictor_type),
INTENT( INOUT ) :: Predictor_AD
1088 REAL(fp),
DIMENSION(Predictor%n_Layers) :: ODv, ODh, ODv_AD, ODh_AD
1089 REAL(fp),
DIMENSION(0:Predictor%n_Layers) :: ODv_Path, ODh_Path, ODv_Path_AD, ODh_Path_AD
1090 REAL(fp) :: tauv, tauh, tau, tauv_AD, tauh_AD, tau_AD
1091 REAL(fp) :: Wv, Wh, OD_tmp
1092 INTEGER :: i, j1, j2, k1, k2, m1, m2, k, n_Layers, np
1094 np = tc%n_Predictors(1, 1)
1114 n_layers = predictor%n_Layers
1115 j1 = tc%Pos_Index(1, 1)
1116 j2 = j1 + (np+1)*n_layers
1118 odv = tc%C(j1:(j1+n_layers-1))
1119 odh = tc%C(j2:(j2+n_layers-1))
1126 odv(k) = odv(k) + tc%C(k1)*predictor%X(k, i, 1)
1127 odh(k) = odh(k) + tc%C(k2)*predictor%X(k, i, 1)
1141 odv_path(k) = odv_path(k-1) + od_tmp
1144 odh_path(k) = odh_path(k-1) + od_tmp
1151 DO k = n_layers, 1, -1
1152 tauv = exp(-odv_path(k))
1153 tauh = exp(-odh_path(k))
1154 tau = wv*tauv + wh*tauh
1156 tau_ad = tau_ad - (
one/tau)*od_path_ad(k)
1157 od_path_ad(k) =
zero 1158 tauv_ad = tauv_ad + wv*tau_ad
1159 tauh_ad = tauh_ad + wh*tau_ad
1162 odh_path_ad(k) = odh_path_ad(k) - tauh*tauh_ad
1164 odh_path_ad(k-1) = odh_path_ad(k-1) + odh_path_ad(k)
1165 odh_ad(k) = odh_ad(k) + odh_path_ad(k)
1166 odh_path_ad(k) =
zero 1169 odv_path_ad(k) = odv_path_ad(k) - tauv*tauv_ad
1171 odv_path_ad(k-1) = odv_path_ad(k-1) + odv_path_ad(k)
1172 odv_ad(k) = odv_ad(k) + odv_path_ad(k)
1173 odv_path_ad(k) =
zero 1182 DO k = n_layers, 1, -1
1185 predictor_ad%X(k, i, 1) = predictor_ad%X(k, i, 1) + tc%C(k1)*odv_ad(k)
1186 predictor_ad%X(k, i, 1) = predictor_ad%X(k, i, 1) + tc%C(k2)*odh_ad(k)
1266 REAL(fp) :: temperature(predictor%n_layers)
1267 REAL(fp) :: absorber(predictor%n_layers, tc%n_absorbers)
1269 REAL(fp) :: sensor_scan_radian, secant_sensor_zenith
1270 REAL(fp) :: be, cos_thetab, cos_phib, doppler_shift
1271 REAL(fp) :: cos2_scana, cos2_phib
1276 sensor_scan_radian = sensor_scan_radian , &
1277 secant_sensor_zenith = secant_sensor_zenith )
1279 predictor%Secant_Zenith_Surface = secant_sensor_zenith
1288 predictor%User_Level_LnPressure, &
1289 predictor%Ref_Level_LnPressure , &
1290 predictor%Secant_Zenith , &
1295 SELECT CASE ( tc%Group_Index )
1299 field_strength = be , &
1300 cos_thetab = cos_thetab , &
1301 doppler_shift = doppler_shift )
1307 predictor%Secant_Zenith, &
1313 field_strength = be , &
1314 cos_thetab = cos_thetab, &
1315 cos_phib = cos_phib )
1318 tc%Ref_Temperature , &
1321 predictor%Secant_Zenith, &
1324 cos2_scana = cos(sensor_scan_radian)**2
1325 cos2_phib = cos_phib**2
1326 predictor%w = (
one-cos2_scana)*cos2_phib + cos2_scana*(
one-cos2_phib)
1333 IF ( pafv_associated(predictor%PAFV) )
THEN 1339 predictor%Ref_Level_LnPressure , &
1340 predictor%User_Level_LnPressure, &
1341 predictor%PAFV%ODPS2User_Idx )
1414 REAL(fp) :: absorber_tl(predictor%n_layers, tc%n_absorbers)
1415 REAL(fp) :: temperature_tl(predictor%n_layers)
1416 REAL(fp) :: be, cos_thetab, doppler_shift
1427 SELECT CASE ( tc%Group_Index )
1431 field_strength = be , &
1432 cos_thetab = cos_thetab , &
1433 doppler_shift = doppler_shift )
1435 predictor%PAFV%Temperature, &
1444 field_strength = be , &
1445 cos_thetab = cos_thetab )
1447 predictor%PAFV%Temperature, &
1448 tc%Ref_Temperature , &
1529 REAL(fp) :: absorber_ad(predictor%n_layers, tc%n_absorbers)
1530 REAL(fp) :: temperature_ad(predictor%n_layers)
1531 REAL(fp) :: be, cos_thetab, doppler_shift
1534 temperature_ad =
zero 1538 SELECT CASE ( tc%Group_Index )
1542 field_strength = be , &
1543 cos_thetab = cos_thetab , &
1544 doppler_shift = doppler_shift )
1546 predictor%PAFV%Temperature, &
1555 field_strength = be , &
1556 cos_thetab = cos_thetab )
1558 predictor%PAFV%Temperature, &
1559 tc%Ref_Temperature , &
1590 INTEGER,
INTENT(IN) :: channelindex
1593 SELECT CASE ( tc%Group_Index )
1613 PURE FUNCTION is_odzeeman( TC )
RESULT( ODZeeman )
1625 INTEGER,
INTENT(IN) :: gindex
1626 INTEGER :: n_predictors
1628 SELECT CASE ( gindex )
1644 INTEGER :: n_components
1652 INTEGER :: n_absorbers
subroutine, public compute_predictors_zssmis_ad(Temperature, Be, CosBK, Predictor_AD, Temperature_AD)
integer, parameter, public failure
integer, parameter, public odps_gindex_zssmis
subroutine, public compute_predictors_zamsua_ad(Temperature, Ref_Temperature, Predictor_AD, Temperature_AD)
subroutine, public zeeman_compute_predictors(Zeeman, TC, Atm, GeoInfo, Predictor)
real(fp), parameter, public zero
integer, dimension(n_channels_amsua), parameter, public zamsua_channelmap
subroutine compute_odpath_zamsua_ad(TC, Predictor, OD_Path_AD, Predictor_AD)
subroutine, public zeeman_compute_predictors_ad(Zeeman, TC, Predictor, Predictor_AD, Atm_AD)
integer, parameter, public max_n_predictors_zamsua
character(*), parameter module_version_id
subroutine compute_odpath_zssmis_ad(ChannelIndex, TC, Predictor, OD_Path_AD, Predictor_AD)
integer, parameter, public fp
subroutine, public compute_predictors_zamsua_tl(Temperature, Ref_Temperature, Temperature_TL, Predictor_TL)
subroutine, public compute_predictors_zssmis(Temperature, Be, CosBK, Doppler_Shift, Secang, Predictor)
integer, parameter, public max_n_predictors_zssmis
integer, parameter, public n_zcomponents
integer, parameter, public h2o_id
integer, dimension(n_channels_ssmis), parameter, public zssmis_channelmap
pure logical function, public is_odzeeman(TC)
subroutine compute_odpath_zamsua(TC, Predictor, OD_Path)
logical function, public is_zeeman_channel(TC, ChannelIndex)
pure integer function, public get_numofzcomponents()
subroutine, public map_input_tl(TC, Atm_TL, Temperature_TL, Absorber_TL, PAFV)
subroutine, public zeeman_compute_atmabsorption_ad(TC, ChannelIndex, Predictor, AtmOptics_AD, Predictor_AD)
real(fp), parameter, public one
subroutine, public compute_predictors_zssmis_tl(Temperature, Be, CosBK, Temperature_TL, Predictor_TL)
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
subroutine, public zeeman_compute_atmabsorption_tl(TC, ChannelIndex, Predictor, Predictor_TL, AtmOptics_TL)
subroutine compute_odpath_zssmis(ChannelIndex, TC, Predictor, OD_Path)
subroutine, public interpolate_profile_f1_tl(interp_index, x, u, y_TL, y_int_TL)
pure integer function, public get_numofzpredictors(gIndex)
subroutine, public map_input_ad(TC, Temperature_AD, Absorber_AD, Atm_AD, PAFV)
subroutine, public compute_interp_index(x, u, interp_index)
integer, parameter, public n_zabsorbers
subroutine, public map_input(Atm, TC, GeoInfo, Temperature, Absorber, User_Level_LnPressure, Ref_Level_LnPressure, Secant_Zenith, H2O_idx, PAFV)
integer, parameter, public odps_gindex_zamsua
subroutine, public compute_predictors_zamsua(Temperature, Ref_Temperature, Be, CosBK, Secang, Predictor)
pure integer function, public get_numofzabsorbers()
subroutine, public interpolate_profile(interp_index, y, x, u, y_int)
subroutine, public zeeman_compute_predictors_tl(Zeeman, TC, Predictor, Atm_TL, Predictor_TL)
subroutine, public interpolate_profile_f1_ad(interp_index, x, u, y_int_AD, y_AD)
subroutine, public zeeman_compute_atmabsorption(TC, ChannelIndex, Predictor, AtmOptics)
integer, parameter, public success
elemental subroutine, public crtm_geometryinfo_getvalue(gInfo, Geometry, iFOV, Longitude, Latitude, Surface_Altitude, Sensor_Scan_Angle, Sensor_Zenith_Angle, Sensor_Azimuth_Angle, Source_Zenith_Angle, Source_Azimuth_Angle, Flux_Zenith_Angle, Year, Month, Day, Distance_Ratio, Sensor_Scan_Radian, Sensor_Zenith_Radian, Sensor_Azimuth_Radian, Secant_Sensor_Zenith, Cosine_Sensor_Zenith, Source_Zenith_Radian, Source_Azimuth_Radian, Secant_Source_Zenith, Flux_Zenith_Radian, Secant_Flux_Zenith, Trans_Zenith_Radian, Secant_Trans_Zenith, AU_ratio2)
subroutine compute_odpath_zssmis_tl(ChannelIndex, TC, Predictor, Predictor_TL, OD_Path_TL)
subroutine compute_odpath_zamsua_tl(TC, Predictor, Predictor_TL, OD_Path_TL)