FV3 Bundle
ODZeeman_AtmAbsorption.f90
Go to the documentation of this file.
1 !
2 ! ODZeeman_AtmAbsorption
3 !
4 ! Module containing routines to compute the optical depth profile
5 ! due to gaseous absorption affected by Zeeman spilitting in
6 ! the Optical Depth Pressure Space (ODPS).
7 !
8 !
9 ! CREATION HISTORY:
10 ! Written by: Yong Han, 10-Nov-2009
11 ! yong.han@noaa.gov
12 !
13 
15 
16  ! -----------------
17  ! Environment setup
18  ! -----------------
19  ! Module use
20  USE type_kinds, ONLY: fp
22  USE crtm_parameters, ONLY: zero, one
28  pafv_associated
29  USE odps_define, ONLY: odps_type
40  n_zcomponents, &
41  n_zabsorbers, &
51 
52  ! Disable implicit typing
53  IMPLICIT NONE
54 
55  ! ------------
56  ! Visibilities
57  ! ------------
58  ! Everything private by default
59  PRIVATE
60  ! Public routines
67  PUBLIC :: is_zeeman_channel
68  PUBLIC :: is_odzeeman
69  PUBLIC :: get_numofzpredictors
70  PUBLIC :: get_numofzcomponents
71  PUBLIC :: get_numofzabsorbers
72 
73 
74  ! ----------
75  ! Parameters
76  ! ----------
77  CHARACTER(*), PARAMETER :: module_version_id = &
78  '$Id: ODZeeman_AtmAbsorption.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
79 
80 
81 CONTAINS
82 
83 
84 !------------------------------------------------------------------------------
85 !
86 ! NAME:
87 ! Zeeman_Compute_AtmAbsorption
88 !
89 ! PURPOSE:
90 ! Subroutine to compute slant path optical path for channels affected by
91 ! affected by Zeeman splitting
92 !
93 ! CALLING SEQUENCE:
94 !
95 ! SUBROUTINE Zeeman_Compute_AtmAbsorption(TC, &
96 ! ChannelIndex, &
97 ! Predictor, &
98 ! AtmOptics )
99 !
100 ! INPUT ARGUMENTS:
101 !
102 ! TC: ODPS structure holding coefficient data
103 ! UNITS: N/A
104 ! TYPE: ODPS_type
105 ! DIMENSION: Scalar
106 ! ATTRIBUTES: INTENT(IN)
107 !
108 ! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
109 ! UNITS: N/A
110 ! TYPE: INTEGER
111 ! DIMENSION: Scalar
112 ! ATTRIBUTES: INTENT(IN)
113 !
114 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
115 ! UNITS: N/A
116 ! TYPE: ODPS_Predictor_type
117 ! DIMENSION: Scalar
118 ! ATTRIBUTES: INTENT(IN)
119 !
120 ! OUTPUT ARGUMENTS:
121 ! AtmOptics: Structure containing computed optical depth
122 ! profile data.
123 ! UNITS: N/A
124 ! TYPE: CRTM_AtmOptics_type
125 ! DIMENSION: Scalar
126 ! ATTRIBUTES: INTENT(IN OUT)
127 !
128 !------------------------------------------------------------------------------
129  SUBROUTINE zeeman_compute_atmabsorption(TC , & ! Input
130  ChannelIndex , & ! Input
131  Predictor , & ! Input
132  AtmOptics) ! Output
134  ! Arguments
135  TYPE(odps_type) , INTENT(IN) :: tc
136  INTEGER , INTENT(IN) :: channelindex
137  TYPE(odps_predictor_type), INTENT(IN OUT) :: predictor
138  TYPE(crtm_atmoptics_type), INTENT(IN OUT) :: atmoptics
139  ! Local variables
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)
144  INTEGER :: idx
145 
146  n_user_layers = predictor%n_User_Layers
147 
148  IF(tc%Group_Index == odps_gindex_zssmis)THEN
149  idx = zssmis_channelmap(channelindex)
150  CALL compute_odpath_zssmis(idx, &
151  tc, &
152  predictor, &
153  od_path)
154  ELSE
155  CALL compute_odpath_zamsua(tc, &
156  predictor, &
157  od_path)
158  END IF
159 
160  ! Interpolate the path profile back on the user pressure grids,
161  ! Compute layer optical depths (vertical direction)
162 
163  IF ( pafv_associated(predictor%PAFV) ) THEN
164  ! save forwad variables
165  predictor%PAFV%OD_Path = od_path
166  ! If interpolation indexes are known
167  user_od_path(0) = zero
168  CALL interpolate_profile(predictor%PAFV%ODPS2User_Idx, &
169  od_path, &
170  predictor%Ref_Level_LnPressure, &
171  predictor%User_Level_LnPressure, &
172  user_od_path)
173  ELSE ! interpolation indexes are not known
174 
175  CALL compute_interp_index(predictor%Ref_Level_LnPressure, &
176  predictor%User_Level_LnPressure,&
177  odps2user_idx)
178 
179  CALL interpolate_profile(odps2user_idx, &
180  od_path, &
181  predictor%Ref_Level_LnPressure, &
182  predictor%User_Level_LnPressure, &
183  user_od_path)
184 
185  END IF
186 
187  ! Optical depth profile scaled to zenith. Note that the scaling
188  ! factor is the surface secant zenith angle.
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
192 
193  END SUBROUTINE zeeman_compute_atmabsorption
194 
195 !------------------------------------------------------------------------------
196 !
197 ! NAME:
198 ! Zeeman_Compute_AtmAbsorption_TL
199 !
200 ! PURPOSE:
201 ! Subroutine to compute TL slant path optical path for channels affected by
202 ! affected by Zeeman splitting
203 !
204 ! CALLING SEQUENCE:
205 !
206 ! CALL Zeeman_Compute_AtmAbsorption_TL(TC, &
207 ! ChannelIndex, &
208 ! Predictor, &
209 ! Predictor_TL, &
210 ! AtmOptics_TL )
211 !
212 ! INPUT ARGUMENTS:
213 !
214 ! TC: ODPS structure holding coefficient data
215 ! UNITS: N/A
216 ! TYPE: ODPS_type
217 ! DIMENSION: Scalar
218 ! ATTRIBUTES: INTENT(IN)
219 !
220 ! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
221 ! UNITS: N/A
222 ! TYPE: INTEGER
223 ! DIMENSION: Scalar
224 ! ATTRIBUTES: INTENT(IN)
225 !
226 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
227 ! UNITS: N/A
228 ! TYPE: ODPS_Predictor_type
229 ! DIMENSION: Scalar
230 ! ATTRIBUTES: INTENT(IN)
231 !
232 ! Predictor_TL: Predictor structure containing the TL predictors
233 ! UNITS: N/A
234 ! TYPE: ODPS_Predictor_type
235 ! DIMENSION: Scalar
236 ! ATTRIBUTES: INTENT(INOUT)
237 !
238 ! OUTPUT ARGUMENTS:
239 ! AtmOptics_TL: Structure containing computed TL optical depth
240 ! profile data.
241 ! UNITS: N/A
242 ! TYPE: CRTM_AtmOptics_type
243 ! DIMENSION: Scalar
244 ! ATTRIBUTES: INTENT(IN OUT)
245 !
246 !------------------------------------------------------------------------------
247  SUBROUTINE zeeman_compute_atmabsorption_tl(TC , & ! Input
248  ChannelIndex , & ! Input
249  Predictor , & ! Input
250  Predictor_TL, & ! Input
251  AtmOptics_TL) ! Output
252  ! Arguments
253  TYPE(odps_type) , INTENT(IN) :: tc
254  INTEGER , INTENT(IN) :: channelindex
255  TYPE(odps_predictor_type), INTENT(IN) :: predictor
256  TYPE(odps_predictor_type), INTENT(INOUT) :: predictor_tl
257  TYPE(crtm_atmoptics_type), INTENT(INOUT) :: atmoptics_tl
258  ! Local variables
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)
262  INTEGER :: idx
263 
264  n_user_layers = predictor%n_User_Layers
265 
266  IF(tc%Group_Index == odps_gindex_zssmis)THEN
267  idx = zssmis_channelmap(channelindex)
268  CALL compute_odpath_zssmis_tl(idx, &
269  tc, &
270  predictor, &
271  predictor_tl, &
272  od_path_tl )
273  ELSE
274  CALL compute_odpath_zamsua_tl(tc, &
275  predictor, &
276  predictor_tl, &
277  od_path_tl )
278  END IF
279 
280  ! Interpolate the path profile back on the user pressure grids,
281  ! Compute layer optical depths (vertical direction)
282  CALL interpolate_profile_f1_tl(predictor%PAFV%ODPS2User_Idx, &
283  predictor%Ref_Level_LnPressure, &
284  predictor%User_Level_LnPressure, &
285  od_path_tl, &
286  user_od_path_tl)
287 
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
291 
292  END SUBROUTINE zeeman_compute_atmabsorption_tl
293 
294 !------------------------------------------------------------------------------
295 !
296 ! NAME:
297 ! Zeeman_Compute_AtmAbsorption_AD
298 !
299 ! PURPOSE:
300 ! Subroutine to compute AD slant path optical path for channels affected by
301 ! affected by Zeeman splitting
302 !
303 ! CALLING SEQUENCE:
304 !
305 ! CALL Zeeman_Compute_AtmAbsorption_AD(TC, &
306 ! ChannelIndex, &
307 ! Predictor, &
308 ! AtmOptics_AD, &
309 ! Predictor_AD)
310 !
311 ! INPUT ARGUMENTS:
312 !
313 ! TC: ODPS structure holding coefficient data
314 ! UNITS: N/A
315 ! TYPE: ODPS_type
316 ! DIMENSION: Scalar
317 ! ATTRIBUTES: INTENT(IN)
318 !
319 ! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
320 ! UNITS: N/A
321 ! TYPE: INTEGER
322 ! DIMENSION: Scalar
323 ! ATTRIBUTES: INTENT(IN)
324 !
325 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
326 ! UNITS: N/A
327 ! TYPE: ODPS_Predictor_type
328 ! DIMENSION: Scalar
329 ! ATTRIBUTES: INTENT(IN)
330 !
331 ! OD_Path_AD: AD Slant path optical path profile (from space down)
332 ! UNITS: N/A
333 ! TYPE: REAL(fp)
334 ! DIMENSION: Rank-1 (0:n_Layers)
335 ! ATTRIBUTES: INTENT(INOUT)
336 !
337 ! OUTPUT ARGUMENTS:
338 ! AtmOptics_AD: Structure containing computed AD optical depth
339 ! profile data.
340 ! UNITS: N/A
341 ! TYPE: CRTM_AtmOptics_type
342 ! DIMENSION: Scalar
343 ! ATTRIBUTES: INTENT(IN OUT)
344 !
345 !------------------------------------------------------------------------------
346  SUBROUTINE zeeman_compute_atmabsorption_ad( TC , & ! Input
347  ChannelIndex , & ! Input
348  Predictor , & ! Input
349  AtmOptics_AD, & ! Input
350  Predictor_AD) ! Output
351  ! Arguments
352  TYPE(odps_type) , INTENT(IN) :: tc
353  INTEGER , INTENT(IN) :: channelindex
354  TYPE(odps_predictor_type), INTENT(IN) :: predictor
355  TYPE(crtm_atmoptics_type), INTENT(IN OUT) :: atmoptics_ad
356  TYPE(odps_predictor_type), INTENT(IN OUT) :: predictor_ad
357  ! Local variables
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)
361  INTEGER :: idx
362 
363  n_user_layers = predictor%n_User_Layers
364 
365  !------- Adjoint part ---------
366 
367  ! Interpolate the path profile back on the user pressure grids,
368  ! Compute layer optical depths (vertical direction)
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
373  ! combined with initilization
374  user_od_path_ad(k-1) = -atmoptics_ad%Optical_Depth(k)/predictor%Secant_Zenith_Surface
375  END DO
376  atmoptics_ad%Optical_Depth = zero
377 
378  od_path_ad = zero
379  CALL interpolate_profile_f1_ad(predictor%PAFV%ODPS2User_Idx, &
380  predictor%Ref_Level_LnPressure, &
381  predictor%User_Level_LnPressure, &
382  user_od_path_ad, &
383  od_path_ad )
384 
385 
386  user_od_path_ad(0) = zero
387 
388  IF(tc%Group_Index == odps_gindex_zssmis)THEN
389  idx = zssmis_channelmap(channelindex)
390  CALL compute_odpath_zssmis_ad(idx, &
391  tc, &
392  predictor, &
393  od_path_ad, &
394  predictor_ad )
395  ELSE
396  CALL compute_odpath_zamsua_ad(tc, &
397  predictor, &
398  od_path_ad, &
399  predictor_ad )
400  END IF
401 
402  END SUBROUTINE zeeman_compute_atmabsorption_ad
403 
404 !------------------------------------------------------------------------------
405 !
406 ! NAME:
407 ! Compute_ODPath_zssmis
408 !
409 ! PURPOSE:
410 ! Subroutine to compute slant path optical path for ZSSMIS
411 ! (a virtual sensor created for the SSMIS 4 Zeeman channels:
412 ! ch 19, 20, 21, 22)
413 !
414 ! CALLING SEQUENCE:
415 !
416 ! SUBROUTINE Compute_ODPath_zssmis(ChannelIndex, &
417 ! TC, &
418 ! Predictor, &
419 ! OD_Path )
420 !
421 ! INPUT ARGUMENTS:
422 !
423 ! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
424 ! UNITS: N/A
425 ! TYPE: INTEGER
426 ! DIMENSION: Scalar
427 ! ATTRIBUTES: INTENT(IN)
428 !
429 ! TC: ODPS structure holding coefficient data
430 ! UNITS: N/A
431 ! TYPE: ODPS_type
432 ! DIMENSION: Scalar
433 ! ATTRIBUTES: INTENT(IN)
434 !
435 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
436 ! UNITS: N/A
437 ! TYPE: ODPS_Predictor_type
438 ! DIMENSION: Scalar
439 ! ATTRIBUTES: INTENT(IN)
440 !
441 ! OUTPUT ARGUMENTS:
442 ! OD_Path: Slant path optical path profile (from space down)
443 ! UNITS: N/A
444 ! TYPE: REAL(fp)
445 ! DIMENSION: Rank-1 (0:n_Layers)
446 ! ATTRIBUTES: INTENT(OUT)
447 !
448 !------------------------------------------------------------------------------
449 
450  SUBROUTINE compute_odpath_zssmis(ChannelIndex, &
451  TC, &
452  Predictor, &
453  OD_Path )
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:)
458 
459  ! Local
460  REAL(fp), DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD
461  REAL(fp) :: OD_tmp
462  REAL(fp) :: w1, w2, Doppler_shift
463  INTEGER :: i, j, j1, j2, js1, js2, k, inode, n_nodes, n_Layers, nc, np
464 
465  od_path = zero
466  np = tc%n_Predictors(1, channelindex)
467 
468  ! Check if there is any absorption for the component&channel combination.
469  IF( np > 0 ) THEN
470 
471  !----------------------------------------------------------------------------------
472  ! (1) Find the nodes of the Doppler shift frequencies, which bracket the user
473  ! Doppler frequency; (2) compute weights for interpolation.
474  !----------------------------------------------------------------------------------
475  doppler_shift = predictor%u
476  j = tc%Pos_Index(1, channelindex)
477 
478  n_nodes = int(tc%C(j))
479 
480  n_layers = predictor%n_Layers
481  j = j + 1
482  IF(doppler_shift < tc%C(j))THEN
483  j1 = j
484  w1 = one
485  w2 = zero
486  inode = 1
487  ELSE IF(doppler_shift > tc%C(j+n_nodes-1))THEN
488  j1 = j+n_nodes-2
489  w1 = zero
490  w2 = one
491  inode = n_nodes-2
492  ELSE
493  DO i = 1, n_nodes-1
494  j1 = j + i - 1
495  j2 = j1 + 1
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))
498  w2 = one - w1
499  inode = i
500  EXIT
501  END IF
502  END DO
503  END IF
504 
505  !--------------------------------------------
506  ! Compute optical depths at the two nodes
507  !--------------------------------------------
508  od1 = zero
509  od2 = zero
510  nc = np * n_layers
511  j1 = j + n_nodes + (inode-1)*nc
512  j2 = j1 + nc
513  DO i = 1, np
514  js1 = j1+(i-1)*n_layers-1
515  js2 = j2+(i-1)*n_layers-1
516  DO k = 1, n_layers
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)
519  END DO
520  END DO
521  !-------------------------------------------------------
522  ! (1) Interpolate on the user requested Doppler frequency
523  ! (2) Compute the Slant path optical depth profile.
524  !-------------------------------------------------------
525  DO k = 1, n_layers
526  IF(channelindex == 2)THEN
527  od(k) = w1*exp(od1(k)) + w2*exp(od2(k))
528  od_tmp = od(k)
529  ELSE
530  od(k) = w1*od1(k) + w2*od2(k)
531  od_tmp = od(k)
532  IF(od(k) < zero)od_tmp = zero
533  END IF
534  od_path(k) = od_path(k-1) + od_tmp*predictor%Secant_Zenith(k)
535  END DO
536 
537  ! Save FW variables
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
543  END IF
544 
545  END IF
546 
547  END SUBROUTINE compute_odpath_zssmis
548 
549 !------------------------------------------------------------------------------
550 !
551 ! NAME:
552 ! Compute_ODPath_zssmis_TL
553 !
554 ! PURPOSE:
555 ! Subroutine to compute TL slant path optical path for ZSSMIS
556 ! (a virtual sensor created for the SSMIS 4 Zeeman channels:
557 ! ch 19, 20, 21, 22)
558 !
559 ! CALLING SEQUENCE:
560 !
561 ! CALL Compute_ODPath_zssmis_TL(ChannelIndex, &
562 ! TC, &
563 ! Predictor, &
564 ! Predictor_TL, &
565 ! OD_Path_TL )
566 !
567 ! INPUT ARGUMENTS:
568 !
569 ! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
570 ! UNITS: N/A
571 ! TYPE: INTEGER
572 ! DIMENSION: Scalar
573 ! ATTRIBUTES: INTENT(IN)
574 !
575 ! TC: ODPS structure holding coefficient data
576 ! UNITS: N/A
577 ! TYPE: ODPS_type
578 ! DIMENSION: Scalar
579 ! ATTRIBUTES: INTENT(IN)
580 !
581 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
582 ! UNITS: N/A
583 ! TYPE: ODPS_Predictor_type
584 ! DIMENSION: Scalar
585 ! ATTRIBUTES: INTENT(IN)
586 !
587 ! Predictor_TL: Predictor structure containing the TL predictors
588 ! UNITS: N/A
589 ! TYPE: ODPS_Predictor_type
590 ! DIMENSION: Scalar
591 ! ATTRIBUTES: INTENT(INOUT)
592 !
593 ! OUTPUT ARGUMENTS:
594 ! OD_Path_TL: TL Slant path optical path profile (from space down)
595 ! UNITS: N/A
596 ! TYPE: REAL(fp)
597 ! DIMENSION: Rank-1 (0:n_Layers)
598 ! ATTRIBUTES: INTENT(OUT)
599 !
600 !------------------------------------------------------------------------------
601  SUBROUTINE compute_odpath_zssmis_tl(ChannelIndex, &
602  TC, &
603  Predictor, &
604  Predictor_TL, &
605  OD_Path_TL )
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:)
611 
612  ! Local
613  REAL(fp), DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD1_TL, OD2_TL
614  REAL(fp) :: O1, O2
615  REAL(fp) :: OD_TL
616  INTEGER :: i, j, j1, j2, js1, js2, k, n_nodes, n_Layers, nc, np
617 
618  od_path_tl = zero
619  np = tc%n_Predictors(1, channelindex)
620 
621  ! Check if there is any absorption for the component&channel combination.
622  IF( np > 0 ) THEN
623 
624  !----------------------------------------------------------------------------------
625  ! (1) Find the nodes of the Doppler shift frequencies, which bracket the user
626  ! Doppler frequency; (2) compute weights for interpolation.
627  !----------------------------------------------------------------------------------
628  j = tc%Pos_Index(1, channelindex)
629  n_nodes = int(tc%C(j))
630  n_layers = predictor%n_Layers
631  j = j + 1
632 
633  !--------------------------------------------
634  ! Compute optical depths at the two nodes
635  !--------------------------------------------
636 
637  od1 = zero
638  od2 = zero
639  od1_tl = zero
640  od2_tl = zero
641  nc = np * n_layers
642  j1 = j + n_nodes + (predictor%PAFV%inode-1)*nc
643  j2 = j1 + nc
644  DO i = 1, np
645  js1 = j1+(i-1)*n_layers-1
646  js2 = j2+(i-1)*n_layers-1
647  DO k = 1, n_layers
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)
652  END DO
653  END DO
654  !-------------------------------------------------------
655  ! (1) Interpolate on the user requested Doppler frequency
656  ! (2) Compute the Slant path optical depth profile.
657  !-------------------------------------------------------
658  DO k = 1, n_layers
659  IF(channelindex == 2)THEN
660  o1 = exp(od1(k))
661  o2 = exp(od2(k))
662  od_tl = predictor%PAFV%w1*o1*od1_tl(k) + predictor%PAFV%w2*o2*od2_tl(k)
663  ELSE
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
666  END IF
667  od_path_tl(k) = od_path_tl(k-1) + od_tl*predictor%Secant_Zenith(k)
668  END DO
669  END IF
670  END SUBROUTINE compute_odpath_zssmis_tl
671 
672 !------------------------------------------------------------------------------
673 !
674 ! NAME:
675 ! Compute_ODPath_zssmis_AD
676 !
677 ! PURPOSE:
678 ! Subroutine to compute AD slant path optical path for ZSSMIS
679 ! (a virtual sensor created for the SSMIS 4 Zeeman channels:
680 ! ch 19, 20, 21, 22)
681 !
682 ! CALLING SEQUENCE:
683 !
684 ! CALL Compute_ODPath_zssmis_AD(ChannelIndex, &
685 ! TC, &
686 ! Predictor, &
687 ! OD_Path_AD, &
688 ! Predictor_AD)
689 !
690 ! INPUT ARGUMENTS:
691 !
692 ! ChannelIndex: Channel index (a sequential number for the channels in the structure TC)
693 ! UNITS: N/A
694 ! TYPE: INTEGER
695 ! DIMENSION: Scalar
696 ! ATTRIBUTES: INTENT(IN)
697 !
698 ! TC: ODPS structure holding coefficient data
699 ! UNITS: N/A
700 ! TYPE: ODPS_type
701 ! DIMENSION: Scalar
702 ! ATTRIBUTES: INTENT(IN)
703 !
704 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
705 ! UNITS: N/A
706 ! TYPE: ODPS_Predictor_type
707 ! DIMENSION: Scalar
708 ! ATTRIBUTES: INTENT(IN)
709 !
710 ! OD_Path_AD: AD Slant path optical path profile (from space down)
711 ! UNITS: N/A
712 ! TYPE: REAL(fp)
713 ! DIMENSION: Rank-1 (0:n_Layers)
714 ! ATTRIBUTES: INTENT(INOUT)
715 !
716 ! OUTPUT ARGUMENTS:
717 ! Predictor_AD: Predictor structure containing the AD predictors
718 ! UNITS: N/A
719 ! TYPE: ODPS_Predictor_type
720 ! DIMENSION: Scalar
721 ! ATTRIBUTES: INTENT(INOUT)
722 !
723 !------------------------------------------------------------------------------
724  SUBROUTINE compute_odpath_zssmis_ad(ChannelIndex, &
725  TC, &
726  Predictor, &
727  OD_Path_AD, &
728  Predictor_AD)
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
734 
735  ! Local
736  REAL(fp), DIMENSION(Predictor%n_Layers) :: OD1, OD2, OD1_AD, OD2_AD
737  REAL(fp) :: O1, O2
738  REAL(fp) :: OD_AD
739  INTEGER :: i, j, j1, j2, js1, js2, k, n_nodes, n_Layers, nc, np
740 
741  np = tc%n_Predictors(1, channelindex)
742 
743  !------------------------
744  ! Forward calculation
745  !------------------------
746  ! Check if there is any absorption for the component&channel combination.
747  IF( np > 0 ) THEN
748  j = tc%Pos_Index(1, channelindex)
749  n_nodes = int(tc%C(j))
750  n_layers = predictor%n_Layers
751  j = j + 1
752 
753  od1 = zero
754  od2 = zero
755  nc = np * n_layers
756  j1 = j + n_nodes + (predictor%PAFV%inode-1)*nc
757  j2 = j1 + nc
758  DO i = 1, np
759  js1 = j1+(i-1)*n_layers-1
760  js2 = j2+(i-1)*n_layers-1
761  DO k = 1, n_layers
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)
764  END DO
765  END DO
766 
767  !-------------------------------
768  ! AD calculation
769  !-------------------------------
770  DO k = n_layers, 1, -1
771  od_ad = predictor%Secant_Zenith(k)*od_path_ad(k) ! OD_AD does not cumulate
772  od_path_ad(k-1) = od_path_ad(k-1) + od_path_ad(k)
773  IF(channelindex == 2)THEN
774  o1 = exp(od1(k))
775  o2 = exp(od2(k))
776 
777  od1_ad(k) = predictor%PAFV%w1*o1*od_ad ! OD1_AD(k) and OD2_AD(k) do not cumulate
778  od2_ad(k) = predictor%PAFV%w2*o2*od_ad
779  ELSE
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
783  END IF
784  END DO
785 
786  DO i = 1, np
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)
794  END DO
795  END DO
796 
797  od_path_ad = zero
798 
799  END IF
800 
801  END SUBROUTINE compute_odpath_zssmis_ad
802 
803 !------------------------------------------------------------------------------
804 !
805 ! NAME:
806 ! Compute_ODPath_zamsua
807 !
808 ! PURPOSE:
809 ! Subroutine to compute slant path optical path for AMSUA channel 14
810 ! affected by Zeeman splitting.
811 !
812 ! CALLING SEQUENCE:
813 !
814 ! SUBROUTINE Compute_ODPath_zamsua(TC, &
815 ! Predictor, &
816 ! OD_Path )
817 !
818 ! INPUT ARGUMENTS:
819 !
820 ! TC: ODPS structure holding coefficient data
821 ! UNITS: N/A
822 ! TYPE: ODPS_type
823 ! DIMENSION: Scalar
824 ! ATTRIBUTES: INTENT(IN)
825 !
826 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
827 ! UNITS: N/A
828 ! TYPE: ODPS_Predictor_type
829 ! DIMENSION: Scalar
830 ! ATTRIBUTES: INTENT(IN)
831 !
832 ! OUTPUT ARGUMENTS:
833 ! OD_Path: Slant path optical path profile (from space down)
834 ! UNITS: N/A
835 ! TYPE: REAL(fp)
836 ! DIMENSION: Rank-1 (0:n_Layers)
837 ! ATTRIBUTES: INTENT(OUT)
838 !
839 !------------------------------------------------------------------------------
840 
841  SUBROUTINE compute_odpath_zamsua(TC, &
842  Predictor, &
843  OD_Path )
844  TYPE(ODPS_type), INTENT( IN ) :: TC
845  TYPE(ODPS_Predictor_type), INTENT( INOUT ) :: Predictor
846  REAL(fp), INTENT( OUT) :: OD_Path(0:)
847 
848  ! Local
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
852  REAL(fp) :: Wv, Wh
853  INTEGER :: i, j1, j2, k1, k2, k, m1, m2, n_Layers, np
854 
855  od_path = zero
856  np = tc%n_Predictors(1, 1)
857 
858  ! Check if there is any absorption for the component&channel combination.
859  IF( np > 0 ) THEN
860 
861  !----------------------------------------------------------------------------------
862  ! Compute optical depths at specified polarizations
863  !----------------------------------------------------------------------------------
864  n_layers = predictor%n_Layers
865  j1 = tc%Pos_Index(1, 1) ! starting index for vertical polarization
866  j2 = j1 + (np+1)*n_layers ! starting index for horizontal polarization
867 
868  ! offset coefficients
869  odv = tc%C(j1:(j1+n_layers-1))
870  odh = tc%C(j2:(j2+n_layers-1))
871  ! Predictor contributions
872  DO i = 1, np
873  m1 = j1+i*n_layers
874  m2 = j2+i*n_layers
875  DO k = 1, n_layers
876  k1 = m1+(k-1)
877  k2 = m2+(k-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)
880  END DO
881  END DO
882 
883  !------------------------------------------------------
884  ! Compute transmittances and then combine them
885  !------------------------------------------------------
886  wv = predictor%w
887  wh = one - wv
888  odv_path(0) = zero
889  odh_path(0) = zero
890  DO k = 1, n_layers
891  IF(odv(k) < zero)odv(k) = zero
892  odv_path(k) = odv_path(k-1) + odv(k)
893  tauv = exp(-odv_path(k))
894  IF(odh(k) < zero)odh(k) = zero
895  odh_path(k) = odh_path(k-1) + odh(k)
896  tauh = exp(-odh_path(k))
897 
898  tau = wv*tauv + wh*tauh
899  od_path(k) = -log(tau)
900  END DO
901 
902  END IF
903 
904  END SUBROUTINE compute_odpath_zamsua
905 
906 !------------------------------------------------------------------------------
907 !
908 ! NAME:
909 ! Compute_ODPath_zamsua_TL
910 !
911 ! PURPOSE:
912 ! Subroutine to compute TL slant path optical path for AMSUA channel 14
913 ! affected by Zeeman splitting.
914 !
915 ! CALLING SEQUENCE:
916 !
917 ! CALL Compute_ODPath_zamsua_TL(TC, &
918 ! Predictor, &
919 ! Predictor_TL, &
920 ! OD_Path_TL )
921 !
922 ! INPUT ARGUMENTS:
923 !
924 ! TC: ODPS structure holding coefficient data
925 ! UNITS: N/A
926 ! TYPE: ODPS_type
927 ! DIMENSION: Scalar
928 ! ATTRIBUTES: INTENT(IN)
929 !
930 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
931 ! UNITS: N/A
932 ! TYPE: ODPS_Predictor_type
933 ! DIMENSION: Scalar
934 ! ATTRIBUTES: INTENT(IN)
935 !
936 ! Predictor_TL: Predictor structure containing the TL predictors
937 ! UNITS: N/A
938 ! TYPE: ODPS_Predictor_type
939 ! DIMENSION: Scalar
940 ! ATTRIBUTES: INTENT(INOUT)
941 !
942 ! OUTPUT ARGUMENTS:
943 ! OD_Path_TL: TL Slant path optical path profile (from space down)
944 ! UNITS: N/A
945 ! TYPE: REAL(fp)
946 ! DIMENSION: Rank-1 (0:n_Layers)
947 ! ATTRIBUTES: INTENT(OUT)
948 !
949 !------------------------------------------------------------------------------
950  SUBROUTINE compute_odpath_zamsua_tl(TC, &
951  Predictor, &
952  Predictor_TL, &
953  OD_Path_TL )
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:)
958 
959  ! Local
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
963  REAL(fp) :: Wv, Wh
964  INTEGER :: i, j1, j2, k1, k2, k, m1, m2, n_Layers, np
965 
966  od_path_tl = zero
967  np = tc%n_Predictors(1, 1)
968 
969  ! Check if there is any absorption for the component&channel combination.
970  IF( np > 0 ) THEN
971 
972  !----------------------------------------------------------------------------------
973  ! Compute optical depths at specified polarizations
974  !----------------------------------------------------------------------------------
975  n_layers = predictor%n_Layers
976  j1 = tc%Pos_Index(1, 1) ! starting index for vertical polarization
977  j2 = j1 + (np+1)*n_layers ! starting index for horizontal polarization
978 
979  odv = tc%C(j1:(j1+n_layers-1))
980  odh = tc%C(j2:(j2+n_layers-1))
981  odv_tl = zero
982  odh_tl = zero
983  DO i = 1, np
984  m1 = j1+i*n_layers
985  m2 = j2+i*n_layers
986  DO k = 1, n_layers
987  k1 = m1+(k-1)
988  k2 = m2+(k-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)
993  END DO
994  END DO
995 
996  !------------------------------------------------------
997  ! Compute transmittances and then combine them
998  !------------------------------------------------------
999  wv = predictor%w
1000  wh = one - wv
1001  odv_path(0) = zero
1002  odh_path(0) = zero
1003  odv_path_tl(0) = zero
1004  odh_path_tl(0) = zero
1005  DO k = 1, n_layers
1006  IF(odv(k) < zero)THEN
1007  odv(k) = zero
1008  odv_tl(k) = zero
1009  END IF
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)
1014 
1015  IF(odh(k) < zero)THEN
1016  odh(k) = zero
1017  odh_tl(k) = zero
1018  END IF
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)
1023 
1024  tau = wv*tauv + wh*tauh
1025  tau_tl = wv*tauv_tl + wh*tauh_tl
1026  od_path_tl(k) = -(one/tau)*tau_tl
1027 
1028  END DO
1029 
1030  END IF
1031 
1032  END SUBROUTINE compute_odpath_zamsua_tl
1033 
1034 !------------------------------------------------------------------------------
1035 !
1036 ! NAME:
1037 ! Compute_ODPath_zamsua_AD
1038 !
1039 ! PURPOSE:
1040 ! Subroutine to compute AD slant path optical path for AMSUA channel 14
1041 ! affected by Zeeman splitting.
1042 !
1043 ! CALLING SEQUENCE:
1044 !
1045 ! CALL Compute_ODPath_zamsua_AD(TC, &
1046 ! Predictor, &
1047 ! OD_Path_AD, &
1048 ! Predictor_AD)
1049 !
1050 ! INPUT ARGUMENTS:
1051 !
1052 ! TC: ODPS structure holding coefficient data
1053 ! UNITS: N/A
1054 ! TYPE: ODPS_type
1055 ! DIMENSION: Scalar
1056 ! ATTRIBUTES: INTENT(IN)
1057 !
1058 ! Predictor: Predictor structure containing the predictors for estimating of optical depth
1059 ! UNITS: N/A
1060 ! TYPE: ODPS_Predictor_type
1061 ! DIMENSION: Scalar
1062 ! ATTRIBUTES: INTENT(IN)
1063 !
1064 ! OD_Path_AD: AD Slant path optical path profile (from space down)
1065 ! UNITS: N/A
1066 ! TYPE: REAL(fp)
1067 ! DIMENSION: Rank-1 (0:n_Layers)
1068 ! ATTRIBUTES: INTENT(INOUT)
1069 !
1070 ! OUTPUT ARGUMENTS:
1071 ! Predictor_AD: Predictor structure containing the AD predictors
1072 ! UNITS: N/A
1073 ! TYPE: ODPS_Predictor_type
1074 ! DIMENSION: Scalar
1075 ! ATTRIBUTES: INTENT(INOUT)
1076 !
1077 !------------------------------------------------------------------------------
1078  SUBROUTINE compute_odpath_zamsua_ad(TC, &
1079  Predictor, &
1080  OD_Path_AD, &
1081  Predictor_AD)
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
1086 
1087  ! Local
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
1093 
1094  np = tc%n_Predictors(1, 1)
1095 
1096  ! Check if there is any absorption for the component&channel combination.
1097  IF( np > 0 ) THEN
1098 
1099  odv_ad = zero
1100  odh_ad = zero
1101  odv_path_ad = zero
1102  odh_path_ad = zero
1103  tauv_ad = zero
1104  tauh_ad = zero
1105  tau_ad = zero
1106 
1107  ! ***************
1108  ! Forward part
1109  ! ***************
1110 
1111  !----------------------------------------------------------------------------------
1112  ! Compute optical depths at specified polarizations
1113  !----------------------------------------------------------------------------------
1114  n_layers = predictor%n_Layers
1115  j1 = tc%Pos_Index(1, 1) ! starting index for vertical polarization
1116  j2 = j1 + (np+1)*n_layers ! starting index for horizontal polarization
1117 
1118  odv = tc%C(j1:(j1+n_layers-1))
1119  odh = tc%C(j2:(j2+n_layers-1))
1120  DO i = 1, np
1121  m1 = j1+i*n_layers
1122  m2 = j2+i*n_layers
1123  DO k = 1, n_layers
1124  k1 = m1+(k-1)
1125  k2 = m2+(k-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)
1128  END DO
1129  END DO
1130 
1131  !------------------------------------------------------
1132  ! Compute transmittances and then combine them
1133  !------------------------------------------------------
1134  wv = predictor%w
1135  wh = one - wv
1136  odv_path(0) = zero
1137  odh_path(0) = zero
1138  DO k = 1, n_layers
1139  od_tmp = odv(k)
1140  IF(odv(k) < zero)od_tmp = zero
1141  odv_path(k) = odv_path(k-1) + od_tmp
1142  od_tmp = odh(k)
1143  IF(odh(k) < zero)od_tmp = zero
1144  odh_path(k) = odh_path(k-1) + od_tmp
1145  END DO
1146 
1147  ! ***************
1148  ! Adjoint part
1149  ! ***************
1150 
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
1155 
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
1160  tau_ad = zero
1161 
1162  odh_path_ad(k) = odh_path_ad(k) - tauh*tauh_ad
1163  tauh_ad = zero
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
1167  IF(odh(k) < zero)odh_ad(k) = zero
1168 
1169  odv_path_ad(k) = odv_path_ad(k) - tauv*tauv_ad
1170  tauv_ad = zero
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
1174  IF(odv(k) < zero)odv_ad(k) = zero
1175  END DO
1176 ! ODv_Path_AD(0) = ZERO
1177 ! ODh_Path_AD(0) = ZERO
1178 
1179  DO i = np, 1, -1
1180  m1 = j1+i*n_layers
1181  m2 = j2+i*n_layers
1182  DO k = n_layers, 1, -1
1183  k1 = m1+(k-1)
1184  k2 = m2+(k-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)
1187  END DO
1188  END DO
1189 ! OD1_AD(:) = ZERO
1190 ! OD2_AD(:) = ZERO
1191 
1192  END IF
1193 
1194  od_path_ad = zero
1195 
1196  END SUBROUTINE compute_odpath_zamsua_ad
1197 
1198 !--------------------------------------------------------------------------------
1199 !
1200 ! NAME:
1201 ! Zeeman_Compute_Predictors
1202 !
1203 ! PURPOSE:
1204 ! Subroutine to calculate the gas absorption model predictors. It first
1205 ! Interpolates the user temperature and absorber profiles on the
1206 ! internal pressure grids and then call the predictor computation
1207 ! routine to compute the predictors
1208 !
1209 ! CALLING SEQUENCE:
1210 ! CALL Zeeman_Compute_Predictors( Zeeman , & ! Input
1211 ! TC , & ! Input
1212 ! Atm , & ! Input
1213 ! GeoInfo , & ! Input
1214 ! Predictor ) ! Output
1215 !
1216 ! INPUT ARGUMENTS:
1217 ! Zeeman: Structure holding Zeeman-specific user inputs
1218 ! UNITS: N/A
1219 ! TYPE: Zeeman_Input_type
1220 ! DIMENSION: Scalar
1221 ! ATTRIBUTES: INTENT(IN)
1222 !
1223 ! TC: ODPS structure holding tau coefficients
1224 ! UNITS: N/A
1225 ! TYPE: ODPS_type
1226 ! DIMENSION: Scalar
1227 ! ATTRIBUTES: INTENT(IN)
1228 !
1229 ! Atm: CRTM Atmosphere structure containing the atmospheric
1230 ! state data.
1231 ! UNITS: N/A
1232 ! TYPE: CRTM_Atmosphere_type
1233 ! DIMENSION: Scalar
1234 ! ATTRIBUTES: INTENT(IN)
1235 !
1236 ! GeoInfo: CRTM_GeometryInfo structure containing the
1237 ! view geometry information.
1238 ! UNITS: N/A
1239 ! TYPE: CRTM_GeometryInfo_type
1240 ! DIMENSION: Scalar
1241 ! ATTRIBUTES: INTENT(IN)
1242 !
1243 ! OUTPUT ARGUMENTS:
1244 ! Predictor: Predictor structure containing the integrated absorber
1245 ! and predictor profiles.
1246 ! UNITS: N/A
1247 ! TYPE: ODPS_Predictor_type
1248 ! DIMENSION: Scalar
1249 ! ATTRIBUTES: INTENT(IN OUT)
1250 !
1251 !--------------------------------------------------------------------------------
1252 
1253  SUBROUTINE zeeman_compute_predictors( &
1254  Zeeman , &
1255  TC , &
1256  Atm , &
1257  GeoInfo , &
1258  Predictor )
1259  ! Arguments
1260  TYPE(zeeman_input_type) , INTENT(IN) :: zeeman
1261  TYPE(odps_type) , INTENT(IN) :: tc
1262  TYPE(crtm_atmosphere_type) , INTENT(IN) :: atm
1263  TYPE(crtm_geometryinfo_type), INTENT(IN) :: geoinfo
1264  TYPE(odps_predictor_type) , INTENT(IN OUT) :: predictor
1265  ! Local variables
1266  REAL(fp) :: temperature(predictor%n_layers)
1267  REAL(fp) :: absorber(predictor%n_layers, tc%n_absorbers)
1268  INTEGER :: h2o_idx
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
1272 
1273  ! Retrieve required geometry values
1275  geoinfo , & ! Input
1276  sensor_scan_radian = sensor_scan_radian , & ! Output
1277  secant_sensor_zenith = secant_sensor_zenith ) ! Output
1278  ! ...Store the surface secant zenith angle
1279  predictor%Secant_Zenith_Surface = secant_sensor_zenith
1280 
1281  ! Mapping data from user to internal fixed pressure layers/levels.
1282  CALL map_input( &
1283  atm , & ! Input
1284  tc , & ! Input
1285  geoinfo , & ! Input
1286  temperature , & ! Output
1287  absorber , & ! output
1288  predictor%User_Level_LnPressure, & ! Output, non variable
1289  predictor%Ref_Level_LnPressure , & ! Output, non variable
1290  predictor%Secant_Zenith , & ! Output, non variable
1291  h2o_idx , &
1292  predictor%PAFV ) ! structure holding FW parameters
1293 
1294  ! Compute predictor for specific instruments
1295  SELECT CASE ( tc%Group_Index )
1296  CASE ( odps_gindex_zssmis )
1297  CALL zeeman_input_getvalue( &
1298  zeeman , & ! Input
1299  field_strength = be , & ! Output
1300  cos_thetab = cos_thetab , & ! Output
1301  doppler_shift = doppler_shift ) ! Output
1303  temperature , &
1304  be , &
1305  cos_thetab , &
1306  doppler_shift , &
1307  predictor%Secant_Zenith, &
1308  predictor )
1309 
1310  CASE ( odps_gindex_zamsua )
1311  CALL zeeman_input_getvalue( &
1312  zeeman , & ! Input
1313  field_strength = be , & ! Output
1314  cos_thetab = cos_thetab, & ! Output
1315  cos_phib = cos_phib ) ! Output
1317  temperature , &
1318  tc%Ref_Temperature , &
1319  be , &
1320  cos_thetab , &
1321  predictor%Secant_Zenith, &
1322  predictor )
1323  ! Weights for combining transmittances at the two special polarizations
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)
1327 
1328  CASE DEFAULT
1329  ! This is a NOOP - does checking need to
1330  ! be done upon entry to this routine?
1331  END SELECT
1332 
1333  IF ( pafv_associated(predictor%PAFV) ) THEN
1334  ! Set and save the interpolation index array for absorption
1335  ! calculations. Since the indexes do not depend on channel but
1336  ! the absorption calculations do, put the index calculation here
1337  ! can improve efficency.
1338  CALL compute_interp_index( &
1339  predictor%Ref_Level_LnPressure , &
1340  predictor%User_Level_LnPressure, &
1341  predictor%PAFV%ODPS2User_Idx )
1342  END IF
1343 
1344  END SUBROUTINE zeeman_compute_predictors
1345 
1346 !--------------------------------------------------------------------------------
1347 !
1348 ! NAME:
1349 ! Zeeman_Compute_Predictors_TL
1350 !
1351 ! PURPOSE:
1352 ! Subroutine to calculate the TL gas absorption model predictors. It first
1353 ! Interpolates the user temperature and absorber profiles on the
1354 ! internal pressure grids and then call the predictor computation
1355 ! routine to compute the predictors
1356 !
1357 ! CALLING SEQUENCE:
1358 ! CALL Zeeman_Compute_Predictors_TL( Zeeman , & ! Input
1359 ! TC , & ! Input
1360 ! Predictor , & ! FWD Input
1361 ! Atm_TL , & ! TL Input
1362 ! Predictor_TL ) ! TL Output
1363 !
1364 ! INPUT ARGUMENTS:
1365 ! Zeeman: Structure holding Zeeman-specific user inputs
1366 ! UNITS: N/A
1367 ! TYPE: Zeeman_Input_type
1368 ! DIMENSION: Scalar
1369 ! ATTRIBUTES: INTENT(IN)
1370 !
1371 ! TC: ODPS structure holding tau coefficients
1372 ! UNITS: N/A
1373 ! TYPE: ODPS_type
1374 ! DIMENSION: Scalar
1375 ! ATTRIBUTES: INTENT(IN)
1376 !
1377 ! Predictor: Predictor structure containing the integrated absorber
1378 ! and predictor profiles.
1379 ! UNITS: N/A
1380 ! TYPE: ODPS_Predictor_type
1381 ! DIMENSION: Scalar
1382 ! ATTRIBUTES: INTENT(IN)
1383 !
1384 ! Atm_TL: CRTM Atmosphere structure containing the tangent-linear
1385 ! atmospheric state data.
1386 ! UNITS: N/A
1387 ! TYPE: CRTM_Atmosphere_type
1388 ! DIMENSION: Scalar
1389 ! ATTRIBUTES: INTENT(IN)
1390 !
1391 ! OUTPUT ARGUMENTS:
1392 ! Predictor_TL: Predictor structure containing the tangent-linear
1393 ! integrated absorber and predictor profiles.
1394 ! UNITS: N/A
1395 ! TYPE: ODPS_Predictor_type
1396 ! DIMENSION: Scalar
1397 ! ATTRIBUTES: INTENT(IN OUT)
1398 !
1399 !--------------------------------------------------------------------------------
1400 
1401  SUBROUTINE zeeman_compute_predictors_tl( &
1402  Zeeman , &
1403  TC , &
1404  Predictor , &
1405  Atm_TL , &
1406  Predictor_TL)
1407  ! Arguments
1408  TYPE(zeeman_input_type) , INTENT(IN) :: zeeman
1409  TYPE(odps_type) , INTENT(IN) :: tc
1410  TYPE(odps_predictor_type) , INTENT(IN) :: predictor
1411  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm_tl
1412  TYPE(odps_predictor_type) , INTENT(IN OUT) :: predictor_tl
1413  ! Local variables
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
1417 
1418  ! Mapping data from user to internal fixed pressure layers/levels.
1419  CALL map_input_tl( &
1420  tc , & ! Input
1421  atm_tl , & ! Input
1422  temperature_tl, & ! Output
1423  absorber_tl , & ! Output
1424  predictor%PAFV ) ! Input
1425 
1426  ! Compute predictor for specific instruments
1427  SELECT CASE ( tc%Group_Index )
1428  CASE ( odps_gindex_zssmis )
1429  CALL zeeman_input_getvalue( &
1430  zeeman , & ! Input
1431  field_strength = be , & ! Output
1432  cos_thetab = cos_thetab , & ! Output
1433  doppler_shift = doppler_shift ) ! Output
1435  predictor%PAFV%Temperature, &
1436  be , &
1437  cos_thetab , &
1438  temperature_tl , &
1439  predictor_tl )
1440 
1441  CASE ( odps_gindex_zamsua )
1442  CALL zeeman_input_getvalue( &
1443  zeeman , & ! Input
1444  field_strength = be , & ! Output
1445  cos_thetab = cos_thetab ) ! Output
1447  predictor%PAFV%Temperature, &
1448  tc%Ref_Temperature , &
1449  temperature_tl , &
1450  predictor_tl )
1451 
1452  CASE DEFAULT
1453  ! This is a NOOP - does checking need to
1454  ! be done upon entry to this routine?
1455  END SELECT
1456 
1457  END SUBROUTINE zeeman_compute_predictors_tl
1458 
1459 
1460 !--------------------------------------------------------------------------------
1461 !
1462 ! NAME:
1463 ! Zeeman_Compute_Predictors_AD
1464 !
1465 ! PURPOSE:
1466 ! Subroutine to calculate the AD gas absorption model predictors. It first
1467 ! Interpolates the user temperature and absorber profiles on the
1468 ! internal pressure grids and then call the predictor computation
1469 ! routine to compute the predictors
1470 !
1471 ! CALLING SEQUENCE:
1472 ! CALL Zeeman_Compute_Predictors_AD( Zeeman , & ! Input
1473 ! TC, , & ! Input
1474 ! Predictor, , & ! FWD Input
1475 ! Predictor_AD, & ! AD Input
1476 ! Atm_AD ) ! AD Output
1477 !
1478 ! INPUT ARGUMENTS:
1479 ! Zeeman: Structure holding Zeeman-specific user inputs
1480 ! UNITS: N/A
1481 ! TYPE: Zeeman_Input_type
1482 ! DIMENSION: Scalar
1483 ! ATTRIBUTES: INTENT(IN)
1484 !
1485 ! TC: ODPS structure holding tau coefficients
1486 ! UNITS: N/A
1487 ! TYPE: ODPS_type
1488 ! DIMENSION: Scalar
1489 ! ATTRIBUTES: INTENT(IN)
1490 !
1491 ! Predictor: Predictor structure containing the integrated absorber
1492 ! and predictor profiles.
1493 ! UNITS: N/A
1494 ! TYPE: ODPS_Predictor_type
1495 ! DIMENSION: Scalar
1496 ! ATTRIBUTES: INTENT(IN)
1497 !
1498 ! Predictor_AD: Predictor structure containing the adjoint integrated
1499 ! absorber and predictor profiles.
1500 ! UNITS: N/A
1501 ! TYPE: ODPS_Predictor_type
1502 ! DIMENSION: Scalar
1503 ! ATTRIBUTES: INTENT(IN)
1504 !
1505 ! OUTPUT ARGUMENTS:
1506 !
1507 ! Atm_AD: CRTM Atmosphere structure containing the adjoint
1508 ! atmospheric state data.
1509 ! UNITS: N/A
1510 ! TYPE: CRTM_Atmosphere_type
1511 ! DIMENSION: Scalar
1512 ! ATTRIBUTES: INTENT(IN OUT)
1513 !
1514 !--------------------------------------------------------------------------------
1515 
1516  SUBROUTINE zeeman_compute_predictors_ad( &
1517  Zeeman , &
1518  TC , &
1519  Predictor , &
1520  Predictor_AD, &
1521  Atm_AD )
1522  ! Arguments
1523  TYPE(zeeman_input_type) , INTENT(IN) :: zeeman
1524  TYPE(odps_type) , INTENT(IN) :: tc
1525  TYPE(odps_predictor_type) , INTENT(IN) :: predictor
1526  TYPE(odps_predictor_type) , INTENT(IN OUT) :: predictor_ad
1527  TYPE(crtm_atmosphere_type), INTENT(IN OUT) :: atm_ad
1528  ! Local variables
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
1532 
1533  ! Local adjoint variable initialization
1534  temperature_ad = zero
1535  absorber_ad = zero
1536 
1537  ! Compute predictor for specific instruments
1538  SELECT CASE ( tc%Group_Index )
1539  CASE ( odps_gindex_zssmis )
1540  CALL zeeman_input_getvalue( &
1541  zeeman , & ! Input
1542  field_strength = be , & ! Output
1543  cos_thetab = cos_thetab , & ! Output
1544  doppler_shift = doppler_shift ) ! Output
1546  predictor%PAFV%Temperature, &
1547  be , &
1548  cos_thetab , &
1549  predictor_ad , &
1550  temperature_ad )
1551 
1552  CASE ( odps_gindex_zamsua )
1553  CALL zeeman_input_getvalue( &
1554  zeeman , & ! Input
1555  field_strength = be , & ! Output
1556  cos_thetab = cos_thetab ) ! Output
1558  predictor%PAFV%Temperature, &
1559  tc%Ref_Temperature , &
1560  predictor_ad , &
1561  temperature_ad )
1562 
1563  CASE DEFAULT
1564  ! This is a NOOP - does checking need to
1565  ! be done upon entry to this routine?
1566  END SELECT
1567 
1568  ! Mapping data from user to internal fixed pressure layers/levels.
1569  CALL map_input_ad( &
1570  tc , & ! Input
1571  temperature_ad, & ! Input
1572  absorber_ad , & ! Input
1573  atm_ad , & ! output
1574  predictor%PAFV ) ! Input
1575 
1576  END SUBROUTINE zeeman_compute_predictors_ad
1577 
1578 
1579  !-------------------------------------------------
1580  ! Check if the given channel is a Zeeman channel
1581  ! Inputs:
1582  ! TC - Taucoeff structure
1583  ! ChannelIndex - the sensor's channel index
1584  ! Return
1585  ! .TRUE. - this is a Zeeman channel
1586  ! .FALSE. - not a Zeeman channel
1587  !-------------------------------------------------
1588  FUNCTION is_zeeman_channel(TC, ChannelIndex) RESULT( ZChannel )
1589  TYPE(odps_type), INTENT(IN) :: tc
1590  INTEGER, INTENT(IN) :: channelindex
1591  LOGICAL :: zchannel
1592 
1593  SELECT CASE ( tc%Group_Index )
1594  CASE ( odps_gindex_zssmis )
1595  zchannel = zssmis_channelmap(channelindex) > 0
1596  CASE ( odps_gindex_zamsua )
1597  zchannel = zamsua_channelmap(channelindex) > 0
1598  CASE DEFAULT
1599  zchannel = .false.
1600  END SELECT
1601 
1602  END FUNCTION is_zeeman_channel
1603 
1604 
1605  !---------------------------------------------------------
1606  ! Check if the given TC is associated with Zeeman algorithm
1607  ! Inputs:
1608  ! TC - Taucoeff structure
1609  ! Return
1610  ! .TRUE. - associated with the Zeeman algorithm
1611  ! .FALSE. - not associated with the Zeeman algorithm
1612  !-------------------------------------------------
1613  PURE FUNCTION is_odzeeman( TC ) RESULT( ODZeeman )
1614  TYPE(odps_type), INTENT(IN) :: tc
1615  LOGICAL :: odzeeman
1616  odzeeman = ( tc%Group_Index == odps_gindex_zssmis .OR. &
1617  tc%Group_Index == odps_gindex_zamsua )
1618  END FUNCTION is_odzeeman
1619 
1620 
1621  !----------------------------------------------------------
1622  ! Obtain number of predictors, given an ODPS group index
1623  !----------------------------------------------------------
1624  PURE FUNCTION get_numofzpredictors( gIndex ) RESULT( n_Predictors )
1625  INTEGER, INTENT(IN) :: gindex
1626  INTEGER :: n_predictors
1627 
1628  SELECT CASE ( gindex )
1629  CASE ( odps_gindex_zssmis )
1630  n_predictors = max_n_predictors_zssmis
1631  CASE ( odps_gindex_zamsua )
1632  n_predictors = max_n_predictors_zamsua
1633  CASE DEFAULT
1634  n_predictors = 0
1635  END SELECT
1636 
1637  END FUNCTION get_numofzpredictors
1638 
1639 
1640  !----------------------------------------------------------
1641  ! Obtain number of compoents
1642  !----------------------------------------------------------
1643  PURE FUNCTION get_numofzcomponents() RESULT( n_Components )
1644  INTEGER :: n_components
1645  n_components = n_zcomponents
1646  END FUNCTION get_numofzcomponents
1647 
1648 
1649  ! Obtain number of compoents
1650  !----------------------------------------------------------
1651  PURE FUNCTION get_numofzabsorbers() RESULT( n_Absorbers )
1652  INTEGER :: n_absorbers
1653  n_absorbers = n_zabsorbers
1654  END FUNCTION get_numofzabsorbers
1655 
1656 END MODULE odzeeman_atmabsorption
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
Definition: Type_Kinds.f90:124
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)
elemental subroutine, public zeeman_input_getvalue(Zeeman_Input, Field_Strength, Cos_ThetaB, Cos_PhiB, Doppler_Shift)
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)