FV3 Bundle
ODPS_Predictor.f90
Go to the documentation of this file.
1 !
2 ! ODPS_Predictor
3 !
4 ! Module containing routines to compute the optical depth predictors for
5 ! the Optical Depth in Pressure Space (ODPS) algorithm.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Yong Han, 29-Aug-2006
10 ! yong.han@noaa.gov
11 !
12 ! Modified by: Tong Zhu, 18-Nov-2008
13 ! tong.zhu@noaa.gov
14 !
15 
16 MODULE odps_predictor
17 
18  ! ------------------
19  ! Environment set up
20  ! ------------------
21  ! Module use
22  USE type_kinds , ONLY: fp
23  USE crtm_parameters , ONLY: minimum_absorber_amount, &
24  reciprocal_gravity
25  USE crtm_atmosphere_define , ONLY: crtm_atmosphere_type
26  USE crtm_geometryinfo_define, ONLY: crtm_geometryinfo_type, &
27  crtm_geometryinfo_getvalue
28  USE odps_predictor_define , ONLY: odps_predictor_type, &
29  pafv_type , &
30  pafv_associated , &
31  max_optran_order
32  USE odps_coordinatemapping , ONLY: map_input , &
33  map_input_tl , &
34  map_input_ad , &
35  compute_interp_index
36  USE odps_define , ONLY: odps_type
37  ! Disable implicit typing
38  IMPLICIT NONE
39 
40 
41  ! ------------
42  ! Visibilities
43  ! ------------
44  ! Everything private by default
45  PRIVATE
46  ! Datatypes
47  PUBLIC :: ivar_type
48  ! Procedures
49  PUBLIC :: odps_assemble_predictors
50  PUBLIC :: odps_assemble_predictors_tl
51  PUBLIC :: odps_assemble_predictors_ad
52  PUBLIC :: odps_compute_predictor
53  PUBLIC :: odps_compute_predictor_tl
54  PUBLIC :: odps_compute_predictor_ad
55  PUBLIC :: odps_compute_predictor_odas
56  PUBLIC :: odps_compute_predictor_odas_tl
57  PUBLIC :: odps_compute_predictor_odas_ad
58  PUBLIC :: odps_get_max_n_predictors
59  PUBLIC :: odps_get_n_components
60  PUBLIC :: odps_get_n_absorbers
61  PUBLIC :: odps_get_component_id
62  PUBLIC :: odps_get_absorber_id
63  PUBLIC :: odps_get_ozone_component_id
64  PUBLIC :: odps_get_savefwvflag
65  ! Parameters
66  PUBLIC :: tot_comid
67  PUBLIC :: wlo_comid
68  PUBLIC :: wet_comid
69  PUBLIC :: co2_comid
70  PUBLIC :: group_1
71  PUBLIC :: group_2
72  PUBLIC :: group_3
73  PUBLIC :: allow_optran
74 
75 
76  ! -----------------
77  ! Module parameters
78  ! -----------------
79  CHARACTER(*), PRIVATE, PARAMETER :: module_version_id = &
80  '$Id: $'
81 
82  ! Dimensions of each predictor group.
83  INTEGER, PARAMETER :: n_g = 3
84  INTEGER, PARAMETER :: n_components_g(n_g) = (/8, 5, 2/)
85  INTEGER, PARAMETER :: n_absorbers_g(n_g) = (/6, 3, 1/)
86  INTEGER, PARAMETER :: max_n_predictors_g(n_g) = (/18, 15, 14/)
87  ! Group index (note, group indexes 4 - 6 are reserved for Zeeman sub-algorithms
88  INTEGER, PARAMETER :: group_1 = 1
89  INTEGER, PARAMETER :: group_2 = 2
90  INTEGER, PARAMETER :: group_3 = 3
91 
92  ! Number of predictors for each component
93  INTEGER, PARAMETER :: n_predictors_g1(8) = (/ &
94  7, & ! dry gas
95  18, & ! water vapor line only, no continua
96  7, & ! water vapor continua only, no line absorption
97 ! 13, & ! ozone
98  11, & ! ozone
99  11, & ! CO2
100  14, & ! N2O
101  10, & ! CO
102  11 /) ! CH4
103 
104  INTEGER, PARAMETER :: n_predictors_g2(5) = (/ &
105  7, & ! dry gas
106  15, & ! water vapor line only, no continua
107  7, & ! water vapor continua only, no line absorption
108 ! 13, & ! ozone
109  11, & ! ozone
110  10 /) ! CO2
111 
112  INTEGER, PARAMETER :: n_predictors_g3(2) = (/ &
113  7, & ! dry gas
114  14 /) ! water vapor line and continua
115 
116 
117  ! Component IDs
118  INTEGER, PARAMETER :: tot_comid = 10 ! total tau
119  INTEGER, PARAMETER :: dry_comid_g1 = 7 ! dry gas for Group-1 sensors
120  INTEGER, PARAMETER :: dry_comid_g2 = 20 ! dry gas, for Gorup-2 sensors
121  INTEGER, PARAMETER :: wlo_comid = 101 ! water vapor line only, no continua
122  INTEGER, PARAMETER :: wco_comid = 15 ! water vapor continua only, no line absorption
123  INTEGER, PARAMETER :: ozo_comid = 114 ! ozone
124  INTEGER, PARAMETER :: co2_comid = 121 ! CO2
125  INTEGER, PARAMETER :: n2o_comid = 120 ! N2O
126  INTEGER, PARAMETER :: co_comid = 119 ! CO
127  INTEGER, PARAMETER :: ch4_comid = 118 ! CH4
128 
129  ! Microwave sensors
130  INTEGER, PARAMETER :: edry_comid = 113 ! Effective dry
131  INTEGER, PARAMETER :: wet_comid = 12 ! water vapor line & no continua
132 
133  ! IR sensor Component indexes (sequence index in an array)
134  INTEGER, PARAMETER :: comp_dry_ir = 1
135  INTEGER, PARAMETER :: comp_wlo_ir = 2
136  INTEGER, PARAMETER :: comp_wco_ir = 3
137  INTEGER, PARAMETER :: comp_ozo_ir = 4
138  INTEGER, PARAMETER :: comp_co2_ir = 5
139  INTEGER, PARAMETER :: comp_n2o_ir = 6
140  INTEGER, PARAMETER :: comp_co_ir = 7
141  INTEGER, PARAMETER :: comp_ch4_ir = 8
142 
143  ! MW sensor Component indexes
144  INTEGER, PARAMETER :: comp_dry_mw = 1
145  INTEGER, PARAMETER :: comp_wet_mw = 2
146 
147  ! Component index to component ID mapping
148  INTEGER, PARAMETER :: component_id_map_g1(8) = (/ &
149  dry_comid_g1, &
150  wlo_comid, &
151  wco_comid, &
152  ozo_comid, &
153  co2_comid, &
154  n2o_comid, &
155  co_comid , &
156  ch4_comid /)
157 
158  INTEGER, PARAMETER :: component_id_map_g2(5) = (/ &
159  dry_comid_g2, &
160  wlo_comid, &
161  wco_comid, &
162  ozo_comid, &
163  co2_comid /)
164 
165  INTEGER, PARAMETER :: component_id_map_g3(2) = (/ &
166  edry_comid, &
167  wet_comid /)
168 
169  ! Absorber IDs (HITRAN)
170  INTEGER, PARAMETER :: h2o_id = 1
171  INTEGER, PARAMETER :: co2_id = 2
172  INTEGER, PARAMETER :: o3_id = 3
173  INTEGER, PARAMETER :: n2o_id = 4
174  INTEGER, PARAMETER :: co_id = 5
175  INTEGER, PARAMETER :: ch4_id = 6
176 
177  ! Absorber (Molecule) indexes for accessing absorber profile array
178  INTEGER, PARAMETER :: abs_h2o_ir = 1
179  INTEGER, PARAMETER :: abs_o3_ir = 2
180  INTEGER, PARAMETER :: abs_co2_ir = 3
181  INTEGER, PARAMETER :: abs_n2o_ir = 4
182  INTEGER, PARAMETER :: abs_co_ir = 5
183  INTEGER, PARAMETER :: abs_ch4_ir = 6
184 
185  INTEGER, PARAMETER :: abs_h2o_mw = 1
186 
187  ! Absorber index to absorber ID mapping
188  INTEGER, PARAMETER :: absorber_id_map_g1(6) = (/ &
189  h2o_id, &
190  o3_id, &
191  co2_id, &
192  n2o_id, &
193  co_id, &
194  ch4_id /)
195 
196  INTEGER, PARAMETER :: absorber_id_map_g2(3) = (/ &
197  h2o_id, &
198  o3_id, &
199  co2_id /)
200 
201  INTEGER, PARAMETER :: absorber_id_map_g3(1) = (/ &
202  h2o_id /)
203  ! Literal constants
204  REAL(fp), PARAMETER :: zero = 0.0_fp
205  REAL(fp), PARAMETER :: one = 1.0_fp
206  REAL(fp), PARAMETER :: two = 2.0_fp
207  REAL(fp), PARAMETER :: three = 3.0_fp
208  REAL(fp), PARAMETER :: four = 4.0_fp
209  REAL(fp), PARAMETER :: ten = 10.0_fp
210  REAL(fp), PARAMETER :: point_25 = 0.25_fp
211  REAL(fp), PARAMETER :: point_5 = 0.5_fp
212  REAL(fp), PARAMETER :: point_75 = 0.75_fp
213  REAL(fp), PARAMETER :: one_point_5 = 1.5_fp
214  REAL(fp), PARAMETER :: one_point_25 = 1.25_fp
215  REAL(fp), PARAMETER :: one_point_75 = 1.75_fp
216 
217 
218  LOGICAL, PARAMETER :: allow_optran = .true.
219 
220 
221  ! ------------------------------------------
222  ! Structure definition to hold forward model
223  ! variables across FWD, TL, and AD calls
224  ! ------------------------------------------
225  TYPE :: ivar_type
226  PRIVATE
227  INTEGER :: dummy
228  END TYPE ivar_type
229 
230 CONTAINS
231 
232 
233 !################################################################################
234 !################################################################################
235 !## ##
236 !## ## PUBLIC MODULE ROUTINES ## ##
237 !## ##
238 !################################################################################
239 !################################################################################
240 
241 !--------------------------------------------------------------------------------
242 !
243 ! NAME:
244 ! ODPS_Assemble_Predictors
245 !
246 ! PURPOSE:
247 ! Subroutine to assemble all the gas absorption model predictors
248 ! for the ODPS algorithm.
249 !
250 ! CALLING SEQUENCE:
251 ! CALL ODPS_Assemble_Predictors( &
252 ! TC , & ! Input
253 ! Atm , & ! Input
254 ! GeoInfo , & ! Input
255 ! Predictor ) ! Output
256 !
257 ! INPUT ARGUMENTS:
258 ! TC: ODPS structure holding tau coefficients
259 ! UNITS: N/A
260 ! TYPE: ODPS_type
261 ! DIMENSION: Scalar
262 ! ATTRIBUTES: INTENT(IN)
263 !
264 ! Atm : CRTM Atmosphere structure containing the atmospheric
265 ! state data.
266 ! UNITS: N/A
267 ! TYPE: CRTM_Atmosphere_type
268 ! DIMENSION: Scalar
269 ! ATTRIBUTES: INTENT(IN)
270 !
271 ! GeoInfo : CRTM_GeometryInfo structure containing the
272 ! view geometry information.
273 ! UNITS: N/A
274 ! TYPE: CRTM_GeometryInfo_type
275 ! DIMENSION: Scalar
276 ! ATTRIBUTES: INTENT(IN)
277 !
278 ! OUTPUT ARGUMENTS:
279 ! Predictor: Predictor structure containing the integrated absorber
280 ! and predictor profiles.
281 ! UNITS: N/A
282 ! TYPE: ODPS_Predictor_type
283 ! DIMENSION: Scalar
284 ! ATTRIBUTES: INTENT(IN OUT)
285 !
286 !--------------------------------------------------------------------------------
287 
288  SUBROUTINE odps_assemble_predictors( &
289  TC , &
290  Atm , &
291  GeoInfo , &
292  Predictor )
293  ! Arguments
294  TYPE(odps_type) , INTENT(IN) :: tc
295  TYPE(crtm_atmosphere_type) , INTENT(IN) :: atm
296  TYPE(crtm_geometryinfo_type), INTENT(IN) :: geoinfo
297  TYPE(odps_predictor_type) , INTENT(IN OUT) :: predictor
298  ! Local variables
299  REAL(fp) :: temperature(predictor%n_layers)
300  REAL(fp) :: absorber(predictor%n_layers, tc%n_absorbers)
301  INTEGER :: h2o_idx
302  REAL(fp) :: secant_sensor_zenith
303 
304 
305  ! Map data from user to internal fixed pressure layers/levels
306  CALL map_input( &
307  atm , &
308  tc , &
309  geoinfo , &
310  temperature , &
311  absorber , &
312  predictor%User_Level_LnPressure, &
313  predictor%Ref_Level_LnPressure , &
314  predictor%Secant_Zenith , &
315  h2o_idx , &
316  predictor%PAFV)
317 
318 
319  ! ...Store the surface secant zenith angle
320  CALL crtm_geometryinfo_getvalue( geoinfo, secant_trans_zenith = secant_sensor_zenith )
321  predictor%Secant_Zenith_Surface = secant_sensor_zenith
322 
323 
324  ! Compute predictor
325  CALL odps_compute_predictor( &
326  tc%Group_index , &
327  temperature , &
328  absorber , &
329  tc%Ref_Level_Pressure , &
330  tc%Ref_Temperature , &
331  tc%Ref_Absorber , &
332  predictor%Secant_Zenith, &
333  predictor )
334  ! ...Optional ODAS for water vapour lines
335  IF( allow_optran .AND. tc%n_OCoeffs > 0 )THEN
336  CALL odps_compute_predictor_odas( &
337  temperature , &
338  absorber(:,h2o_idx) , &
339  tc%Ref_Level_Pressure , &
340  tc%Ref_Pressure , &
341  predictor%Secant_Zenith, &
342  tc%Alpha , &
343  tc%Alpha_C1 , &
344  tc%Alpha_C2 , &
345  predictor )
346  END IF
347  ! ...Save the interpolation indices
348  IF ( pafv_associated(predictor%PAFV) ) THEN
349  CALL compute_interp_index( &
350  predictor%Ref_Level_LnPressure , &
351  predictor%User_Level_LnPressure, &
352  predictor%PAFV%ODPS2User_Idx)
353  END IF
354 
355  END SUBROUTINE odps_assemble_predictors
356 
357 !--------------------------------------------------------------------------------
358 !
359 ! NAME:
360 ! ODPS_Assemble_Predictors_TL
361 !
362 ! PURPOSE:
363 ! Subroutine to assemble all the tangent-linear gas absorption model
364 ! predictors.
365 ! It first interpolates the user temperature and absorber profiles on the
366 ! internal pressure grids and then calls the predictor computation routine
367 ! to compute the predictors
368 !
369 ! CALLING SEQUENCE:
370 ! CALL ODPS_Assemble_Predictors_TL( &
371 ! TC , &
372 ! Predictor , &
373 ! Atm_TL , &
374 ! Predictor_TL )
375 !
376 ! INPUT ARGUMENTS:
377 ! TC: ODPS structure holding tau coefficients
378 ! UNITS: N/A
379 ! TYPE: ODPS_type
380 ! DIMENSION: Scalar
381 ! ATTRIBUTES: INTENT(IN)
382 !
383 ! Atm_TL : CRTM Atmosphere structure containing the atmospheric
384 ! state data.
385 ! UNITS: N/A
386 ! TYPE: CRTM_Atmosphere_type
387 ! DIMENSION: Scalar
388 ! ATTRIBUTES: INTENT(IN)
389 !
390 ! Predictor: Predictor structure containing the integrated absorber
391 ! and predictor profiles.
392 ! UNITS: N/A
393 ! TYPE: ODPS_Predictor_type
394 ! DIMENSION: Scalar
395 ! ATTRIBUTES: INTENT(IN)
396 !
397 ! OUTPUT ARGUMENTS:
398 ! Predictor_TL: Predictor structure containing the integrated absorber
399 ! and predictor profiles.
400 ! UNITS: N/A
401 ! TYPE: ODPS_Predictor_type
402 ! DIMENSION: Scalar
403 ! ATTRIBUTES: INTENT(IN OUT)
404 !
405 !--------------------------------------------------------------------------------
406 
407  SUBROUTINE odps_assemble_predictors_tl( &
408  TC , & ! Input
409  Predictor , & ! Input
410  Atm_TL , & ! Input
411  Predictor_TL ) ! Output
412  ! Arguments
413  TYPE(odps_type) , INTENT(IN) :: tc
414  TYPE(odps_predictor_type) , INTENT(IN) :: predictor
415  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm_tl
416  TYPE(odps_predictor_type) , INTENT(IN OUT) :: predictor_tl
417  ! Local variables
418  REAL(fp) :: absorber_tl(predictor%n_layers, tc%n_absorbers)
419  REAL(fp) :: temperature_tl(predictor%n_layers)
420 
421 
422  ! Map data from user to internal fixed pressure layers/levels
423  CALL map_input_tl( &
424  tc , &
425  atm_tl , &
426  temperature_tl, &
427  absorber_tl , &
428  predictor%PAFV )
429 
430 
431  ! Compute predictor
432  CALL odps_compute_predictor_tl( &
433  tc%Group_index , &
434  predictor%PAFV%Temperature, &
435  predictor%PAFV%Absorber , &
436  tc%Ref_Temperature , &
437  tc%Ref_Absorber , &
438  predictor%Secant_Zenith , &
439  predictor , &
440  temperature_tl , &
441  absorber_tl , &
442  predictor_tl )
443  ! ...Optional ODAS for water vapour lines
444  IF ( allow_optran .AND. tc%n_OCoeffs > 0 ) THEN
445  CALL odps_compute_predictor_odas_tl( &
446  predictor%PAFV%Temperature , &
447  predictor%PAFV%Absorber(:,predictor%PAFV%H2O_idx), &
448  tc%Ref_Pressure , &
449  predictor%Secant_Zenith , &
450  tc%Alpha , &
451  tc%Alpha_C2 , &
452  predictor , &
453  temperature_tl , &
454  absorber_tl(:,predictor%PAFV%H2O_idx) , &
455  predictor_tl )
456  END IF
457 
458  END SUBROUTINE odps_assemble_predictors_tl
459 
460 
461 !--------------------------------------------------------------------------------
462 !
463 ! NAME:
464 ! ODPS_Assemble_Predictors_AD
465 !
466 ! PURPOSE:
467 ! Subroutine to assemble the adjoint of the gas absorption model
468 ! predictors.
469 ! It first calss the adjoint of the predictor computation routine and
470 ! then performs the adjoint interpolation of the user temperature and
471 ! absorber profiles on the internal pressure grid.
472 !
473 ! CALLING SEQUENCE:
474 ! CALL ODPS_Assemble_Predictors_AD( &
475 ! TC , &
476 ! Predictor , &
477 ! Predictor_AD, &
478 ! Atm_AD )
479 !
480 ! INPUT ARGUMENTS:
481 ! TC: ODPS structure holding tau coefficients
482 ! UNITS: N/A
483 ! TYPE: ODPS_type
484 ! DIMENSION: Scalar
485 ! ATTRIBUTES: INTENT(IN)
486 !
487 ! Predictor: Predictor structure containing the integrated absorber
488 ! and predictor profiles.
489 ! UNITS: N/A
490 ! TYPE: ODPS_Predictor_type
491 ! DIMENSION: Scalar
492 ! ATTRIBUTES: INTENT(IN)
493 !
494 ! Predictor_AD: Predictor structure containing the integrated absorber
495 ! and predictor profiles.
496 ! UNITS: N/A
497 ! TYPE: ODPS_Predictor_type
498 ! DIMENSION: Scalar
499 ! ATTRIBUTES: INTENT(IN)
500 !
501 ! OUTPUT ARGUMENTS:
502 !
503 ! Atm_AD : CRTM Atmosphere structure containing the atmospheric
504 ! state data.
505 ! UNITS: N/A
506 ! TYPE: CRTM_Atmosphere_type
507 ! DIMENSION: Scalar
508 ! ATTRIBUTES: INTENT(IN OUT)
509 !
510 !--------------------------------------------------------------------------------
511 
512  SUBROUTINE odps_assemble_predictors_ad( &
513  TC , &
514  Predictor , &
515  Predictor_AD, &
516  Atm_AD )
517  ! Arguments
518  TYPE(odps_type) , INTENT(IN) :: tc
519  TYPE(odps_predictor_type) , INTENT(IN) :: predictor
520  TYPE(odps_predictor_type) , INTENT(IN OUT) :: predictor_ad
521  TYPE(crtm_atmosphere_type), INTENT(IN OUT) :: atm_ad
522  ! Local variables
523  REAL(fp) :: absorber_ad(predictor%n_layers, tc%n_absorbers)
524  REAL(fp) :: temperature_ad(predictor%n_layers)
525 
526  ! Initialise local adjoint variables
527  temperature_ad = zero
528  absorber_ad = zero
529 
530 
531  ! Compute predictor
532  ! ...Optional ODAS for water vapour lines
533  IF ( allow_optran .AND. tc%n_OCoeffs > 0 ) THEN
534  CALL odps_compute_predictor_odas_ad( &
535  predictor%PAFV%Temperature , &
536  predictor%PAFV%Absorber(:,predictor%PAFV%H2O_idx), &
537  tc%Ref_Pressure , &
538  predictor%Secant_Zenith , &
539  tc%Alpha , &
540  tc%Alpha_C2 , &
541  predictor , &
542  predictor_ad , &
543  temperature_ad , &
544  absorber_ad(:,predictor%PAFV%H2O_idx) )
545  END IF
546  ! ...The main ODPS predictor
547  CALL odps_compute_predictor_ad( &
548  tc%Group_index , &
549  predictor%PAFV%Temperature, &
550  predictor%PAFV%Absorber , &
551  tc%Ref_Temperature , &
552  tc%Ref_Absorber , &
553  predictor%Secant_Zenith , &
554  predictor , &
555  predictor_ad , &
556  temperature_ad , &
557  absorber_ad )
558 
559 
560  ! Map data from user to internal fixed pressure layers/levels
561  CALL map_input_ad( &
562  tc , &
563  temperature_ad, &
564  absorber_ad , &
565  atm_ad , &
566  predictor%PAFV )
567 
568  END SUBROUTINE odps_assemble_predictors_ad
569 
570 
571 !------------------------------------------------------------------------------
572 !
573 ! NAME:
574 ! ODPS_Compute_Predictor
575 !
576 ! PURPOSE:
577 ! Subroutine to predictors
578 !
579 ! CALLING SEQUENCE:
580 ! CALL ODPS_Compute_Predictor( &
581 ! Group_ID, & ! Input
582 ! Temperature, & ! Input
583 ! Absorber, & ! Input
584 ! Ref_Level_Pressure, & ! Input
585 ! Ref_Temperature, & ! Input
586 ! Ref_Absorber, & ! Input
587 ! secang, & ! Input
588 ! Predictor ) ! Output
589 !
590 ! INPUT ARGUMENTS:
591 ! Group_ID : The ID of predictor group
592 ! UNITS: N?A
593 ! TYPE: INTEGER
594 ! DIMENSION: scalar
595 ! ATTRIBUTES: INTENT(IN)
596 !
597 ! Temperature: Temperature profile
598 ! UNITS: K
599 ! TYPE: REAL(fp)
600 ! DIMENSION: Rank-1(n_Layers) array
601 ! ATTRIBUTES: INTENT(IN)
602 !
603 ! Absorber : Absorber profiles
604 ! UNITS: vary
605 ! TYPE: REAL(fp)
606 ! DIMENSION: Rank-2(n_Layers x n_Absorbers) array
607 ! ATTRIBUTES: INTENT(IN)
608 !
609 ! Ref_Level_Pressure : Reference level pressure profile
610 ! UNITS: hPa
611 ! TYPE: REAL(fp)
612 ! DIMENSION: Rank-1(0:n_Layers) array
613 ! ATTRIBUTES: INTENT(IN)
614 !
615 ! Ref_Temperature : Reference layer temperature profile
616 ! UNITS: K
617 ! TYPE: REAL(fp)
618 ! DIMENSION: Rank-1(n_Layers) array
619 ! ATTRIBUTES: INTENT(IN)
620 !
621 ! Ref_Absorber : Reference absorber profiles
622 ! UNITS: vary
623 ! TYPE: REAL(fp)
624 ! DIMENSION: Rank-2(n_Layers x n_Absorbers) array
625 ! ATTRIBUTES: INTENT(IN)
626 !
627 ! secang : Secont sensor zenith angle profile
628 ! UNITS: N/A
629 ! TYPE: REAL(fp)
630 ! DIMENSION: Rank-1(n_Layers) array
631 ! ATTRIBUTES: INTENT(IN)
632 !
633 ! OUTPUT ARGUMENTS:
634 ! Predictor: Predictor structure containing the integrated absorber
635 ! and predictor profiles.
636 ! UNITS: N/A
637 ! TYPE: ODPS_Predictor_type
638 ! DIMENSION: Scalar
639 ! ATTRIBUTES: INTENT(IN OUT)
640 !
641 !------------------------------------------------------------------------------
642 
643  SUBROUTINE odps_compute_predictor( &
644  Group_ID, &
645  Temperature, &
646  Absorber, &
647  Ref_Level_Pressure, &
648  Ref_Temperature, &
649  Ref_Absorber, &
650  secang, &
651  Predictor )
652 
653  INTEGER, INTENT(IN) :: group_id
654  REAL(fp), INTENT(IN) :: temperature(:)
655  REAL(fp), INTENT(IN) :: absorber(:, :)
656  REAL(fp), INTENT(IN) :: ref_level_pressure(0:)
657  REAL(fp), INTENT(IN) :: ref_temperature(:)
658  REAL(fp), INTENT(IN) :: ref_absorber(:, :)
659  REAL(fp), INTENT(IN) :: secang(:)
660  TYPE(odps_predictor_type), INTENT(IN OUT) :: predictor
661 
662  ! ---------------
663  ! Local variables
664  ! ---------------
665  CHARACTER(*), PARAMETER :: routine_name = 'ODPS_Compute_Predictor'
666  INTEGER :: n_layers
667  INTEGER :: k ! n_Layers, n_Levels
668  INTEGER :: j ! n_absorbers
669  REAL(fp) :: pdp
670  REAL(fp) :: tzp_ref
671  REAL(fp) :: tzp_sum
672  REAL(fp) :: tzp(size(absorber, dim=1))
673  REAL(fp) :: tz_ref
674  REAL(fp) :: tz_sum
675  REAL(fp) :: tz(size(absorber, dim=1))
676  REAL(fp) :: gaz_ref(size(absorber, dim=2))
677  REAL(fp) :: gaz_sum(size(absorber, dim=2))
678  REAL(fp) :: gaz(size(absorber, dim=1), size(absorber, dim=2))
679  REAL(fp) :: gazp_ref(size(absorber, dim=2))
680  REAL(fp) :: gazp_sum(size(absorber, dim=2))
681  REAL(fp) :: gazp(size(absorber, dim=1), size(absorber, dim=2))
682  REAL(fp) :: gatzp_ref(size(absorber, dim=2))
683  REAL(fp) :: gatzp_sum (size(absorber, dim=2))
684  REAL(fp) :: gatzp(size(absorber, dim=1), size(absorber, dim=2))
685 
686  n_layers = predictor%n_Layers
687 
688  predictor%Secant_Zenith = secang
689 
690  !------------------------------------
691  ! Compute integrated variables
692  !------------------------------------
693 
694  tzp_ref = zero
695  tzp_sum = zero
696  tz_ref = zero
697  tz_sum = zero
698  gaz_ref = zero
699  gaz_sum = zero
700  gazp_ref = zero
701  gazp_sum = zero
702  gatzp_ref = zero
703  gatzp_sum = zero
704 
705  layer_loop : DO k = 1, n_layers
706 
707  ! weight for integrated variables
708  if(k == 1)then
709  pdp = ref_level_pressure(0) * &
710  ( ref_level_pressure(1) - ref_level_pressure(0) )
711 
712  else
713  pdp = ref_level_pressure(k) * &
714  ( ref_level_pressure(k) - ref_level_pressure(k-1) )
715 
716  endif
717 
718  ! Temperature
719  tz_ref = tz_ref + ref_temperature(k)
720  tz_sum = tz_sum + temperature(k)
721  tz(k) = tz_sum / tz_ref
722  tzp_ref = tzp_ref + pdp * ref_temperature(k)
723  tzp_sum = tzp_sum + pdp*temperature(k)
724  tzp(k) = tzp_sum/tzp_ref
725 
726  ! absorbers
727  DO j = 1, n_absorbers_g(group_id)
728  gaz_ref(j) = gaz_ref(j) + ref_absorber(k, j)
729  gaz_sum(j) = gaz_sum(j) + absorber(k, j)
730  gaz(k, j) = gaz_sum(j) / gaz_ref(j)
731  gazp_ref(j) = gazp_ref(j) + pdp*ref_absorber(k, j)
732  gazp_sum(j) = gazp_sum(j) + pdp*absorber(k, j)
733  gazp(k, j) = gazp_sum(j) / gazp_ref(j)
734  gatzp_ref(j) = gatzp_ref(j) + pdp*ref_absorber(k, j)*ref_temperature(k)
735  gatzp_sum(j) = gatzp_sum(j) + pdp*absorber(k, j)*temperature(k)
736  gatzp(k, j) = gatzp_sum(j) / gatzp_ref(j)
737  END DO
738 
739  ! save FW variables for TL and AD routines
740  IF ( pafv_associated(predictor%PAFV) ) THEN
741  predictor%PAFV%PDP(k) = pdp
742  predictor%PAFV%Tz_ref(k) = tz_ref
743  predictor%PAFV%Tz(k) = tz(k)
744  predictor%PAFV%Tzp_ref(k) = tzp_ref
745  predictor%PAFV%Tzp(k) = tzp(k)
746  predictor%PAFV%GAz_ref(k, :) = gaz_ref
747  predictor%PAFV%GAz_sum(k, :) = gaz_sum
748  predictor%PAFV%GAz(k, :) = gaz(k, :)
749  predictor%PAFV%GAzp_ref(k, :) = gazp_ref
750  predictor%PAFV%GAzp_sum(k, :) = gazp_sum
751  predictor%PAFV%GAzp(k, :) = gazp(k, :)
752  predictor%PAFV%GATzp_ref(k, :) = gatzp_ref
753  predictor%PAFV%GATzp_sum(k, :) = gatzp_sum
754  predictor%PAFV%GATzp(k, :) = gatzp(k, :)
755  END IF
756 
757  END DO layer_loop
758 
759  !----------------------------------------------------------------
760  ! Call the group specific routine for remaining computation; all
761  ! variables defined above are passed to the called routine
762  !----------------------------------------------------------------
763 
764  SELECT CASE( group_id )
765  CASE( group_1, group_2 )
766  CALL odps_compute_predictor_ir()
767  CASE( group_3 )
768  CALL odps_compute_predictor_mw()
769  END SELECT
770 
771 CONTAINS
772 
773  SUBROUTINE odps_compute_predictor_ir()
774 
775  ! ---------------
776  ! Local variables
777  ! ---------------
778  INTEGER :: k ! n_Layers, n_Levels
779  REAL(fp) :: DT
780  REAL(fp) :: T
781  REAL(fp) :: T2
782  REAL(fp) :: DT2
783  REAL(fp) :: H2O
784  REAL(fp) :: H2O_A
785  REAL(fp) :: H2O_R
786  REAL(fp) :: H2O_S
787  REAL(fp) :: H2O_R4
788  REAL(fp) :: H2OdH2OTzp
789  REAL(fp) :: CO2
790  REAL(fp) :: O3
791  REAL(fp) :: O3_A
792  REAL(fp) :: O3_R
793  REAL(fp) :: CO
794  REAL(fp) :: CO_A
795  REAL(fp) :: CO_R
796  REAL(fp) :: CO_S
797  REAL(fp) :: CO_ACOdCOzp
798  REAL(fp) :: N2O
799  REAL(fp) :: N2O_A
800  REAL(fp) :: N2O_R
801  REAL(fp) :: N2O_S
802  REAL(fp) :: CH4
803  REAL(fp) :: CH4_A
804  REAL(fp) :: CH4_R
805  REAL(fp) :: CH4_ACH4zp
806 
807  layer_loop : DO k = 1, n_layers
808 
809  !------------------------------------------
810  ! Relative Temperature
811  !------------------------------------------
812  dt = temperature(k) - ref_temperature(k)
813  t = temperature(k) / ref_temperature(k)
814 
815  !-------------------------------------------
816  ! Abosrber amount scalled by the reference
817  !-------------------------------------------
818  h2o = absorber(k,abs_h2o_ir)/ref_absorber(k, abs_h2o_ir)
819  o3 = absorber(k,abs_o3_ir)/ref_absorber(k,abs_o3_ir)
820  co2 = absorber(k,abs_co2_ir)/ref_absorber(k,abs_co2_ir)
821 
822  ! Combinations of variables common to all predictor groups
823  t2 = t*t
824  dt2 = dt*abs( dt )
825 
826  h2o_a = secang(k)*h2o
827  h2o_r = sqrt( h2o_a )
828  h2o_s = h2o_a*h2o_a
829  h2o_r4 = sqrt( h2o_r )
830  h2odh2otzp = h2o/gatzp(k, abs_h2o_ir)
831 
832  o3_a = secang(k)*o3
833  o3_r = sqrt( o3_a )
834 
835  IF( group_id == group_1 )THEN
836  co = absorber(k,abs_co_ir)/ref_absorber(k, abs_co_ir)
837  n2o = absorber(k,abs_n2o_ir)/ref_absorber(k,abs_n2o_ir)
838  ch4 = absorber(k,abs_ch4_ir)/ref_absorber(k,abs_ch4_ir)
839 
840  n2o_a = secang(k)*n2o
841  n2o_r = sqrt( n2o_a )
842  n2o_s = n2o_a*n2o_a
843 
844  co_a = secang(k)*co
845  co_r = sqrt( co_a )
846  co_s = co_a*co_a
847  co_acodcozp = co_a*co/gazp(k, abs_co_ir)
848 
849  ch4_a = secang(k)*ch4
850  ch4_r = sqrt(ch4_a)
851  ch4_ach4zp = secang(k)*gazp(k, abs_ch4_ir)
852 
853  ! set number of predictors
854  predictor%n_CP = n_predictors_g1
855  ELSE
856  predictor%n_CP = n_predictors_g2
857  END IF
858 
859  !#-------------------------------------------------------------------#
860  !# -- Predictors -- #
861  !#-------------------------------------------------------------------#
862 
863  ! ----------------------
864  ! Fixed (Dry) predictors
865  ! ----------------------
866  predictor%X(k, 1, comp_dry_ir) = secang(k)
867  predictor%X(k, 2, comp_dry_ir) = secang(k) * t
868  predictor%X(k, 3, comp_dry_ir) = secang(k) * t2
869  predictor%X(k, 4, comp_dry_ir) = t
870  predictor%X(k, 5, comp_dry_ir) = secang(k) * secang(k)
871  predictor%X(k, 6, comp_dry_ir) = t2
872  predictor%X(k, 7, comp_dry_ir) = tz(k)
873 
874  ! --------------------------
875  ! Water vapor continuum predictors
876  ! --------------------------
877  predictor%X(k, 1, comp_wco_ir) = h2o_a/t
878  predictor%X(k, 2, comp_wco_ir) = h2o_a/t * h2o
879  predictor%X(k, 3, comp_wco_ir) = h2o_a/t2 * h2o/t2
880  predictor%X(k, 4, comp_wco_ir) = h2o_a/t2
881  predictor%X(k, 5, comp_wco_ir) = h2o_a/t2 * h2o
882  predictor%X(k, 6, comp_wco_ir) = h2o_a/t2**2
883  predictor%X(k, 7, comp_wco_ir) = h2o_a
884 
885  ! -----------------------
886  ! Ozone predictors
887  ! -----------------------
888  predictor%X(k, 1, comp_ozo_ir) = o3_a
889  predictor%X(k, 2, comp_ozo_ir) = o3_a*dt
890  predictor%X(k, 3, comp_ozo_ir) = o3_a*o3*gazp(k,abs_o3_ir)
891  predictor%X(k, 4, comp_ozo_ir) = o3_a*o3_a
892  predictor%X(k, 5, comp_ozo_ir) = o3_a*gazp(k,abs_o3_ir)
893  predictor%X(k, 6, comp_ozo_ir) = o3_a*sqrt(secang(k)*gazp(k,abs_o3_ir))
894  predictor%X(k, 7, comp_ozo_ir) = o3_r*dt !T*T*T
895  predictor%X(k, 8, comp_ozo_ir) = o3_r
896  predictor%X(k, 9, comp_ozo_ir) = o3_r*o3/gazp(k,abs_o3_ir)
897  predictor%X(k,10, comp_ozo_ir) = secang(k)*gazp(k,abs_o3_ir)
898  predictor%X(k,11, comp_ozo_ir) = (secang(k)*gazp(k,abs_o3_ir))**2
899 
900 ! Predictor%X(k, 12, COMP_OZO_IR) = H2O_A
901 ! Predictor%X(k, 13, COMP_OZO_IR) = SECANG(k)*GAzp(k,ABS_H2O_IR)
902 
903  ! -----------------------
904  ! Carbon dioxide predictors
905  ! -----------------------
906  predictor%X(k, 1, comp_co2_ir) = secang(k) * t
907  predictor%X(k, 2, comp_co2_ir) = secang(k) * t2
908  predictor%X(k, 3, comp_co2_ir) = t
909  predictor%X(k, 4, comp_co2_ir) = t2
910  predictor%X(k, 5, comp_co2_ir) = secang(k)
911  predictor%X(k, 6, comp_co2_ir) = secang(k)*co2
912  predictor%X(k, 7, comp_co2_ir) = secang(k) * tzp(k)
913  predictor%X(k, 8, comp_co2_ir) = (secang(k) * gazp(k, abs_co2_ir))**2
914  predictor%X(k, 9, comp_co2_ir) = tzp(k)**3
915  predictor%X(k, 10, comp_co2_ir) = secang(k) * tzp(k) * sqrt(t)
916 
917  ! --------------------------
918  ! Water-line predictors
919  ! --------------------------
920  predictor%X(k, 1, comp_wlo_ir) = h2o_a
921  predictor%X(k, 2, comp_wlo_ir) = h2o_a*dt
922  predictor%X(k, 3, comp_wlo_ir) = h2o_s
923  predictor%X(k, 4, comp_wlo_ir) = h2o_a*dt2
924  predictor%X(k, 5, comp_wlo_ir) = h2o_r4
925  predictor%X(k, 6, comp_wlo_ir) = h2o_s*h2o_a
926  predictor%X(k, 7, comp_wlo_ir) = h2o_r
927  predictor%X(k, 8, comp_wlo_ir) = h2o_r*dt
928  predictor%X(k, 9, comp_wlo_ir) = h2o_s*h2o_s
929  predictor%X(k,10, comp_wlo_ir) = h2odh2otzp
930  predictor%X(k,11, comp_wlo_ir) = h2o_r*h2odh2otzp
931  predictor%X(k,12, comp_wlo_ir) = (secang(k)*gazp(k,abs_h2o_ir))**2
932  predictor%X(k,13, comp_wlo_ir) = secang(k)*gazp(k,abs_h2o_ir)
933  predictor%X(k,14, comp_wlo_ir) = secang(k)
934  predictor%X(k,15, comp_wlo_ir) = secang(k) * co2
935 
936  ! Addtional predictors for group 1
937  if_group1: IF( group_id == group_1 )THEN
938 
939  predictor%X(k, 11, comp_co2_ir) = co_a
940 
941  predictor%X(k, 16, comp_wlo_ir) = ch4_a
942  predictor%X(k, 17, comp_wlo_ir) = ch4_a*ch4_a*dt
943  predictor%X(k, 18, comp_wlo_ir) = co_a
944 
945  ! -----------------------
946  ! Carbon monoxide
947  ! -----------------------
948  predictor%X(k, 1, comp_co_ir) = co_a
949  predictor%X(k, 2, comp_co_ir) = co_a*dt
950  predictor%X(k, 3, comp_co_ir) = sqrt( co_r )
951  predictor%X(k, 4, comp_co_ir) = co_r*dt
952  predictor%X(k, 5, comp_co_ir) = co_s
953  predictor%X(k, 6, comp_co_ir) = co_r
954  predictor%X(k, 7, comp_co_ir) = co_a*dt2
955  predictor%X(k, 8, comp_co_ir) = co_acodcozp
956  predictor%X(k, 9, comp_co_ir) = co_acodcozp/co_r
957  predictor%X(k, 10, comp_co_ir) = co_acodcozp * sqrt( gazp(k, abs_co_ir) )
958 
959  ! -----------------------
960  ! Methane predictors
961  ! -----------------------
962  predictor%X(k, 1, comp_ch4_ir) = ch4_a*dt
963  predictor%X(k, 2, comp_ch4_ir) = ch4_r
964  predictor%X(k, 3, comp_ch4_ir) = ch4_a*ch4_a
965  predictor%X(k, 4, comp_ch4_ir) = ch4_a
966  predictor%X(k, 5, comp_ch4_ir) = ch4*dt
967  predictor%X(k, 6, comp_ch4_ir) = ch4_ach4zp
968  predictor%X(k, 7, comp_ch4_ir) = ch4_ach4zp**2
969  predictor%X(k, 8, comp_ch4_ir) = sqrt(ch4_r)
970  predictor%X(k, 9, comp_ch4_ir) = gatzp(k, abs_ch4_ir)
971  predictor%X(k, 10, comp_ch4_ir) = secang(k)*gatzp(k, abs_ch4_ir)
972  predictor%X(k, 11, comp_ch4_ir) = ch4_r * ch4/gazp(k, abs_ch4_ir)
973 
974  ! -----------------------
975  ! N2O predictors
976  ! -----------------------
977  predictor%X(k, 1, comp_n2o_ir) = n2o_a*dt
978  predictor%X(k, 2, comp_n2o_ir) = n2o_r
979  predictor%X(k, 3, comp_n2o_ir) = n2o*dt
980  predictor%X(k, 4, comp_n2o_ir) = n2o_a**point_25
981  predictor%X(k, 5, comp_n2o_ir) = n2o_a
982  predictor%X(k, 6, comp_n2o_ir) = secang(k) * gazp(k, abs_n2o_ir)
983  predictor%X(k, 7, comp_n2o_ir) = secang(k) * gatzp(k, abs_n2o_ir)
984  predictor%X(k, 8, comp_n2o_ir) = n2o_s
985  predictor%X(k, 9, comp_n2o_ir) = gatzp(k, abs_n2o_ir)
986  predictor%X(k,10, comp_n2o_ir) = n2o_r*n2o / gazp(k, abs_n2o_ir)
987 
988  predictor%X(k,11, comp_n2o_ir) = ch4_a
989  predictor%X(k,12, comp_n2o_ir) = ch4_a*gazp(k, abs_ch4_ir)
990  predictor%X(k,13, comp_n2o_ir) = co_a
991  predictor%X(k,14, comp_n2o_ir) = co_a*secang(k)*gazp(k, abs_co_ir)
992 
993  END IF if_group1
994 
995  END DO layer_loop
996 
997  END SUBROUTINE odps_compute_predictor_ir
998 
999  SUBROUTINE odps_compute_predictor_mw()
1000 
1001  ! ---------------
1002  ! Local variables
1003  ! ---------------
1004  INTEGER :: k ! n_Layers, n_Levels
1005  REAL(fp) :: DT
1006  REAL(fp) :: T
1007  REAL(fp) :: T2
1008  REAL(fp) :: DT2
1009  REAL(fp) :: H2O
1010  REAL(fp) :: H2O_A
1011  REAL(fp) :: H2O_R
1012  REAL(fp) :: H2O_S
1013  REAL(fp) :: H2O_R4
1014  REAL(fp) :: H2OdH2OTzp
1015 
1016  layer_loop : DO k = 1, n_layers
1017 
1018  !------------------------------------------
1019  ! Relative Temperature
1020  !------------------------------------------
1021  dt = temperature(k) - ref_temperature(k)
1022  t = temperature(k) / ref_temperature(k)
1023 
1024  !-------------------------------------------
1025  ! Abosrber amount scalled by the reference
1026  !-------------------------------------------
1027  h2o = absorber(k,abs_h2o_mw)/ref_absorber(k, abs_h2o_mw)
1028 
1029  ! Combinations of variables common to all predictor groups
1030  t2 = t*t
1031  dt2 = dt*abs( dt )
1032 
1033  h2o_a = secang(k)*h2o
1034  h2o_r = sqrt( h2o_a )
1035  h2o_s = h2o_a*h2o_a
1036  h2o_r4 = sqrt( h2o_r )
1037  h2odh2otzp = h2o/gatzp(k, abs_h2o_mw)
1038 
1039  !#-------------------------------------------------------------------#
1040  !# -- Predictors -- #
1041  !#-------------------------------------------------------------------#
1042 
1043  ! set number of predictors
1044  predictor%n_CP = n_predictors_g3
1045 
1046  ! ----------------------
1047  ! Fixed (Dry) predictors
1048  ! ----------------------
1049  predictor%X(k, 1, comp_dry_mw) = secang(k)
1050  predictor%X(k, 2, comp_dry_mw) = secang(k) * t
1051  predictor%X(k, 3, comp_dry_mw) = secang(k) * t2
1052  predictor%X(k, 4, comp_dry_mw) = t
1053  predictor%X(k, 5, comp_dry_mw) = secang(k) * secang(k)
1054  predictor%X(k, 6, comp_dry_mw) = t2
1055  predictor%X(k, 7, comp_dry_mw) = tz(k)
1056 
1057  ! --------------------------------
1058  ! Water vapor (line and continuum)
1059  ! --------------------------------
1060  predictor%X(k, 1, comp_wet_mw) = h2o_a/t
1061  predictor%X(k, 2, comp_wet_mw) = h2o_a/t * h2o
1062  predictor%X(k, 3, comp_wet_mw) = h2o_a/t2 * h2o/t2
1063  predictor%X(k, 4, comp_wet_mw) = h2o_a/t2
1064  predictor%X(k, 5, comp_wet_mw) = h2o_a/t2 * h2o
1065  predictor%X(k, 6, comp_wet_mw) = h2o_a/t2**2
1066  predictor%X(k, 7, comp_wet_mw) = h2o_a
1067  predictor%X(k, 8, comp_wet_mw) = h2o_a*dt
1068  predictor%X(k, 9, comp_wet_mw) = (secang(k)*gazp(k,abs_h2o_mw))**2
1069  predictor%X(k, 10,comp_wet_mw) = secang(k)*gazp(k,abs_h2o_mw)
1070  predictor%X(k, 11,comp_wet_mw) = secang(k)
1071  predictor%X(k, 12,comp_wet_mw) = h2o_s*h2o_a
1072  predictor%X(k, 13,comp_wet_mw) = h2o_s*h2o_s
1073  predictor%X(k, 14,comp_wet_mw) = h2odh2otzp
1074 
1075  END DO layer_loop
1076 
1077  END SUBROUTINE odps_compute_predictor_mw
1078 
1079  END SUBROUTINE odps_compute_predictor
1080 
1081 !============================== TL
1082 !------------------------------------------------------------------------------
1083 !
1084 ! NAME:
1085 ! ODPS_Compute_Predictor_TL
1086 !
1087 ! PURPOSE:
1088 ! Subroutine to predictors
1089 !
1090 ! CALLING SEQUENCE:
1091 ! CALL ODPS_Compute_Predictor_TL( &
1092 ! Group_ID, & ! Input
1093 ! Temperature, & ! Input
1094 ! Absorber, & ! Input
1095 ! Ref_Temperature, & ! Input
1096 ! Ref_Absorber, & ! Input
1097 ! secang, & ! Input
1098 ! Predictor & ! Input
1099 ! Temperature_TL, & ! Input
1100 ! Absorber_TL, & ! Input
1101 ! Predictor_TL ) ! Output
1102 !
1103 ! INPUT ARGUMENTS:
1104 ! Group_ID : The ID of predictor group
1105 ! UNITS: N?A
1106 ! TYPE: INTEGER
1107 ! DIMENSION: scalar
1108 ! ATTRIBUTES: INTENT(IN)
1109 !
1110 ! Temperature: Temperature profile
1111 ! UNITS: K
1112 ! TYPE: REAL(fp)
1113 ! DIMENSION: Rank-1(n_Layers) array
1114 ! ATTRIBUTES: INTENT(IN)
1115 !
1116 ! Absorber : Absorber profiles
1117 ! UNITS: vary
1118 ! TYPE: REAL(fp)
1119 ! DIMENSION: Rank-2(n_Layers x n_Absorbers) array
1120 ! ATTRIBUTES: INTENT(IN)
1121 !
1122 ! Ref_Temperature : Reference layer temperature profile
1123 ! UNITS: K
1124 ! TYPE: REAL(fp)
1125 ! DIMENSION: Rank-1(n_Layers) array
1126 ! ATTRIBUTES: INTENT(IN)
1127 !
1128 ! Ref_Absorber : Reference absorber profiles
1129 ! UNITS: vary
1130 ! TYPE: REAL(fp)
1131 ! DIMENSION: Rank-2(n_Layers x n_Absorbers) array
1132 ! ATTRIBUTES: INTENT(IN)
1133 !
1134 ! secang : Secont sensor zenith angle profile
1135 ! UNITS: N/A
1136 ! TYPE: REAL(fp)
1137 ! DIMENSION: Rank-1(n_Layers) array
1138 ! ATTRIBUTES: INTENT(IN)
1139 !
1140 ! Predictor: Predictor structure containing the integrated absorber
1141 ! and predictor profiles.
1142 ! UNITS: N/A
1143 ! TYPE: ODPS_Predictor_type
1144 ! DIMENSION: Scalar
1145 ! ATTRIBUTES: INTENT(IN)
1146 !
1147 ! Temperature_TL: Temperature_TL profile
1148 ! UNITS: K
1149 ! TYPE: REAL(fp)
1150 ! DIMENSION: Rank-1(n_Layers) array
1151 ! ATTRIBUTES: INTENT(IN)
1152 !
1153 ! Absorber_TL: Absorber_TL profiles
1154 ! UNITS: vary
1155 ! TYPE: REAL(fp)
1156 ! DIMENSION: Rank-2(n_Layers x n_Absorbers) array
1157 ! ATTRIBUTES: INTENT(IN)
1158 !
1159 ! OUTPUT ARGUMENTS:
1160 !
1161 ! Predictor_TL: Predictor_TL structure containing the integrated absorber_TL
1162 ! and predictor_TL profiles.
1163 ! UNITS: N/A
1164 ! TYPE: ODPS_Predictor_type
1165 ! DIMENSION: Scalar
1166 ! ATTRIBUTES: INTENT(IN OUT)
1167 !
1168 !------------------------------------------------------------------------------
1169 
1170  SUBROUTINE odps_compute_predictor_tl( &
1171  Group_ID, &
1172  Temperature, &
1173  Absorber, &
1174  Ref_Temperature, &
1175  Ref_Absorber, &
1176  secang, &
1177  Predictor, &
1178  Temperature_TL, &
1179  Absorber_TL, &
1180  Predictor_TL )
1181 
1182  INTEGER, INTENT(IN) :: group_id
1183  REAL(fp), INTENT(IN) :: temperature(:)
1184  REAL(fp), INTENT(IN) :: absorber(:, :)
1185  REAL(fp), INTENT(IN) :: ref_temperature(:)
1186  REAL(fp), INTENT(IN) :: ref_absorber(:, :)
1187  REAL(fp), INTENT(IN) :: secang(:)
1188  REAL(fp), INTENT(IN) :: temperature_tl(:)
1189  REAL(fp), INTENT(IN) :: absorber_tl(:, :)
1190  TYPE(odps_predictor_type), TARGET, INTENT(IN) :: predictor
1191  TYPE(odps_predictor_type), INTENT(IN OUT) :: predictor_tl
1192 
1193  ! ---------------
1194  ! Local variables
1195  ! ---------------
1196  CHARACTER(*), PARAMETER :: routine_name = 'ODPS_Compute_Predictor_TL'
1197  INTEGER :: n_layers
1198  INTEGER :: k ! n_Layers, n_Levels
1199  INTEGER :: j ! n_absorbers
1200  REAL(fp) :: tzp_sum_tl
1201  REAL(fp) :: tzp_tl(size(absorber, dim=1))
1202  REAL(fp) :: tz_sum_tl
1203  REAL(fp) :: tz_tl(size(absorber, dim=1))
1204  REAL(fp) :: gaz_sum_tl(size(absorber, dim=2))
1205  REAL(fp) :: gaz_tl(size(absorber, dim=1), size(absorber, dim=2))
1206  REAL(fp) :: gazp_sum_tl(size(absorber, dim=2))
1207  REAL(fp) :: gazp_tl(size(absorber, dim=1), size(absorber, dim=2))
1208  REAL(fp) :: gatzp_sum_tl(size(absorber, dim=2))
1209  REAL(fp) :: gatzp_tl(size(absorber, dim=1), size(absorber, dim=2))
1210  TYPE(pafv_type), POINTER :: pafv => null()
1211 
1212  ! use short name
1213  pafv => predictor%PAFV
1214 
1215  n_layers = predictor%n_Layers
1216 
1217  predictor_tl%Secant_Zenith = secang
1218 
1219  !------------------------------------
1220  ! Compute integrated variables
1221  !------------------------------------
1222 
1223  tzp_sum_tl = zero
1224  tz_sum_tl = zero
1225  gaz_sum_tl = zero
1226  gazp_sum_tl = zero
1227  gatzp_sum_tl = zero
1228 
1229  layer_loop : DO k = 1, n_layers
1230 
1231  ! Temperature
1232  tz_sum_tl = tz_sum_tl + temperature_tl(k)
1233  tz_tl(k) = tz_sum_tl / pafv%Tz_ref(k)
1234  tzp_sum_tl = tzp_sum_tl + pafv%PDP(k)*temperature_tl(k)
1235  tzp_tl(k) = tzp_sum_tl/pafv%Tzp_ref(k)
1236 
1237  ! absorbers
1238  DO j = 1, n_absorbers_g(group_id)
1239  gaz_sum_tl(j) = gaz_sum_tl(j) + absorber_tl(k, j)
1240  gaz_tl(k, j) = gaz_sum_tl(j) / pafv%GAz_ref(k,j)
1241  gazp_sum_tl(j) = gazp_sum_tl(j) + pafv%PDP(k)*absorber_tl(k, j)
1242  gazp_tl(k, j) = gazp_sum_tl(j) / pafv%GAzp_ref(k,j)
1243  gatzp_sum_tl(j) = gatzp_sum_tl(j) + pafv%PDP(k)*absorber_tl(k, j)*temperature(k) + &
1244  pafv%PDP(k)*absorber(k, j)*temperature_tl(k)
1245  gatzp_tl(k, j) = gatzp_sum_tl(j) / pafv%GATzp_ref(k,j)
1246  END DO
1247 
1248  END DO layer_loop
1249 
1250  !----------------------------------------------------------------
1251  ! Call the group specific routine for remaining computation; all
1252  ! variables defined above are passed to the called routine
1253  !----------------------------------------------------------------
1254 
1255  SELECT CASE( group_id )
1256  CASE( group_1, group_2 )
1257  CALL odps_compute_predictor_ir_tl()
1258  CASE( group_3 )
1259  CALL odps_compute_predictor_mw_tl()
1260  END SELECT
1261 
1262  NULLIFY(pafv)
1263 
1264 CONTAINS
1265 
1266  SUBROUTINE odps_compute_predictor_ir_tl()
1267 
1268  ! ---------------
1269  ! Local variables
1270  ! ---------------
1271  INTEGER :: k ! n_Layers, n_Levels
1272  REAL(fp) :: DT, DT_TL
1273  REAL(fp) :: T, T_TL
1274  REAL(fp) :: T2, T2_TL
1275  REAL(fp) :: DT2, DT2_TL
1276  REAL(fp) :: H2O, H2O_TL
1277  REAL(fp) :: H2O_A, H2O_A_TL
1278  REAL(fp) :: H2O_R, H2O_R_TL
1279  REAL(fp) :: H2O_S, H2O_S_TL
1280  REAL(fp) :: H2O_R4, H2O_R4_TL
1281  REAL(fp) :: H2OdH2OTzp, H2OdH2OTzp_TL
1282  REAL(fp) :: CO2, CO2_TL
1283  REAL(fp) :: O3, O3_TL
1284  REAL(fp) :: O3_A, O3_A_TL
1285  REAL(fp) :: O3_R, O3_R_TL
1286  REAL(fp) :: CO, CO_TL
1287  REAL(fp) :: CO_A, CO_A_TL
1288  REAL(fp) :: CO_R, CO_R_TL
1289  REAL(fp) :: CO_S, CO_S_TL
1290  REAL(fp) :: CO_ACOdCOzp, CO_ACOdCOzp_TL
1291  REAL(fp) :: N2O, N2O_TL
1292  REAL(fp) :: N2O_A, N2O_A_TL
1293  REAL(fp) :: N2O_R, N2O_R_TL
1294  REAL(fp) :: N2O_S, N2O_S_TL
1295  REAL(fp) :: CH4, CH4_TL
1296  REAL(fp) :: CH4_A, CH4_A_TL
1297  REAL(fp) :: CH4_R, CH4_R_TL
1298  REAL(fp) :: CH4_ACH4zp, CH4_ACH4zp_TL
1299 
1300  layer_loop : DO k = 1, n_layers
1301 
1302  !------------------------------------------
1303  ! Relative Temperature
1304  !------------------------------------------
1305  dt = temperature(k) - ref_temperature(k)
1306  t = temperature(k) / ref_temperature(k)
1307  dt_tl = temperature_tl(k)
1308  t_tl = temperature_tl(k) / ref_temperature(k)
1309 
1310  !-------------------------------------------
1311  ! Abosrber amount scalled by the reference
1312  !-------------------------------------------
1313  h2o = absorber(k,abs_h2o_ir)/ref_absorber(k, abs_h2o_ir)
1314  o3 = absorber(k,abs_o3_ir)/ref_absorber(k,abs_o3_ir)
1315  co2 = absorber(k,abs_co2_ir)/ref_absorber(k,abs_co2_ir)
1316 
1317  h2o_tl = absorber_tl(k,abs_h2o_ir)/ref_absorber(k, abs_h2o_ir)
1318  o3_tl = absorber_tl(k,abs_o3_ir)/ref_absorber(k,abs_o3_ir)
1319  co2_tl = absorber_tl(k,abs_co2_ir)/ref_absorber(k,abs_co2_ir)
1320 
1321  ! Combinations of variables common to all predictor groups
1322  t2 = t*t
1323  dt2 = dt*abs( dt )
1324 
1325  t2_tl = two*t*t_tl
1326  IF( dt > zero) THEN
1327  dt2_tl = two*dt*dt_tl
1328  ELSE
1329  dt2_tl = - two*dt*dt_tl
1330  ENDIF
1331 
1332  h2o_a = secang(k)*h2o
1333  h2o_r = sqrt( h2o_a )
1334  h2o_s = h2o_a*h2o_a
1335  h2o_r4 = sqrt( h2o_r )
1336  h2odh2otzp = h2o/pafv%GATzp(k, abs_h2o_ir)
1337 
1338  h2o_a_tl = secang(k)*h2o_tl
1339  h2o_r_tl = (point_5 / sqrt(h2o_a)) * h2o_a_tl
1340  h2o_s_tl = two * h2o_a * h2o_a_tl
1341  h2o_r4_tl = (point_5 / sqrt(h2o_r)) * h2o_r_tl
1342  h2odh2otzp_tl = h2o_tl/pafv%GATzp(k, abs_h2o_ir) - &
1343  h2o * gatzp_tl(k, abs_h2o_ir)/pafv%GATzp(k, abs_h2o_ir)**2
1344 
1345  o3_a = secang(k)*o3
1346  o3_r = sqrt( o3_a )
1347 
1348  o3_a_tl = secang(k)*o3_tl
1349  o3_r_tl = (point_5 / sqrt(o3_a)) * o3_a_tl
1350 
1351  IF( group_id == group_1 )THEN
1352  co = absorber(k,abs_co_ir)/ref_absorber(k, abs_co_ir)
1353  n2o = absorber(k,abs_n2o_ir)/ref_absorber(k,abs_n2o_ir)
1354  ch4 = absorber(k,abs_ch4_ir)/ref_absorber(k,abs_ch4_ir)
1355 
1356  co_tl = absorber_tl(k,abs_co_ir)/ref_absorber(k, abs_co_ir)
1357  n2o_tl = absorber_tl(k,abs_n2o_ir)/ref_absorber(k,abs_n2o_ir)
1358  ch4_tl = absorber_tl(k,abs_ch4_ir)/ref_absorber(k,abs_ch4_ir)
1359 
1360  n2o_a = secang(k)*n2o
1361  n2o_r = sqrt( n2o_a )
1362  n2o_s = n2o_a*n2o_a
1363 
1364  n2o_a_tl = secang(k) * n2o_tl
1365  n2o_r_tl = (point_5 / sqrt(n2o_a)) * n2o_a_tl
1366  n2o_s_tl = two * n2o_a * n2o_a_tl
1367 
1368  co_a = secang(k)*co
1369  co_r = sqrt( co_a )
1370  co_s = co_a*co_a
1371  co_acodcozp = co_a*co/pafv%GAzp(k, abs_co_ir)
1372 
1373  co_a_tl = secang(k)*co_tl
1374  co_r_tl = (point_5 / sqrt(co_a)) * co_a_tl
1375  co_s_tl = two * co_a * co_a_tl
1376  co_acodcozp_tl = co_a_tl*co/pafv%GAzp(k, abs_co_ir) + co_a*co_tl/pafv%GAzp(k, abs_co_ir) &
1377  - co_a*co*gazp_tl(k, abs_co_ir)/pafv%GAzp(k, abs_co_ir)**2
1378 
1379  ch4_a = secang(k)*ch4
1380  ch4_r = sqrt(ch4_a)
1381  ch4_ach4zp = secang(k)*pafv%GAzp(k, abs_ch4_ir)
1382 
1383  ch4_a_tl = secang(k)*ch4_tl
1384  ch4_r_tl = (point_5 / sqrt(ch4_a)) * ch4_a_tl
1385  ch4_ach4zp_tl = secang(k)*gazp_tl(k, abs_ch4_ir)
1386 
1387  ! set number of predictors
1388  predictor_tl%n_CP = n_predictors_g1
1389  ELSE
1390  predictor_tl%n_CP = n_predictors_g2
1391  END IF
1392 
1393  !#-------------------------------------------------------------------#
1394  !# -- Predictors -- #
1395  !#-------------------------------------------------------------------#
1396 
1397  ! ----------------------
1398  ! Fixed (Dry) predictors
1399  ! ----------------------
1400  predictor_tl%X(k, 1, comp_dry_ir) = zero
1401  predictor_tl%X(k, 2, comp_dry_ir) = secang(k) * t_tl
1402  predictor_tl%X(k, 3, comp_dry_ir) = secang(k) * t2_tl
1403  predictor_tl%X(k, 4, comp_dry_ir) = t_tl
1404  predictor_tl%X(k, 5, comp_dry_ir) = zero
1405  predictor_tl%X(k, 6, comp_dry_ir) = t2_tl
1406  predictor_tl%X(k, 7, comp_dry_ir) = tz_tl(k)
1407 
1408  ! --------------------------
1409  ! Water vapor continuum predictors
1410  ! --------------------------
1411  predictor_tl%X(k, 1, comp_wco_ir) = h2o_a_tl/t - h2o_a * t_tl/t**2
1412  predictor_tl%X(k, 2, comp_wco_ir) = h2o_a_tl*h2o/t + h2o_a*h2o_tl/t - h2o_a*h2o*t_tl/t**2
1413  predictor_tl%X(k, 3, comp_wco_ir) = h2o_a_tl*h2o/t2**2 + h2o_a*h2o_tl/t2**2 - &
1414  two*h2o_a*h2o*t2_tl/t2**3
1415  predictor_tl%X(k, 4, comp_wco_ir) = h2o_a_tl/t2 - h2o_a * t2_tl/t2**2
1416  predictor_tl%X(k, 5, comp_wco_ir) = h2o_a_tl*h2o/t2 + h2o_a*h2o_tl/t2 - h2o_a*h2o*t2_tl/t2**2
1417  predictor_tl%X(k, 6, comp_wco_ir) = h2o_a_tl/t2**2 - two*h2o_a*t2_tl/t2**3
1418  predictor_tl%X(k, 7, comp_wco_ir) = h2o_a_tl
1419 
1420  ! -----------------------
1421  ! Ozone predictors
1422  ! -----------------------
1423  predictor_tl%X(k, 1, comp_ozo_ir) = o3_a_tl
1424  predictor_tl%X(k, 2, comp_ozo_ir) = o3_a_tl*dt + o3_a*dt_tl
1425  predictor_tl%X(k, 3, comp_ozo_ir) = o3_a_tl*o3*pafv%GAzp(k,abs_o3_ir) + o3_a*o3_tl*pafv%GAzp(k,abs_o3_ir) &
1426  + o3_a*o3*gazp_tl(k,abs_o3_ir)
1427  predictor_tl%X(k, 4, comp_ozo_ir) = two*o3_a*o3_a_tl
1428  predictor_tl%X(k, 5, comp_ozo_ir) = o3_a_tl*pafv%GAzp(k,abs_o3_ir) + o3_a*gazp_tl(k,abs_o3_ir)
1429  predictor_tl%X(k, 6, comp_ozo_ir) = o3_a_tl*sqrt(secang(k)*pafv%GAzp(k,abs_o3_ir)) + &
1430  point_5*o3_a*sqrt(secang(k)/pafv%GAzp(k,abs_o3_ir))* &
1431  gazp_tl(k,abs_o3_ir)
1432  predictor_tl%X(k, 7, comp_ozo_ir) = o3_r_tl*dt + o3_r*dt_tl !T*T*T
1433  predictor_tl%X(k, 8, comp_ozo_ir) = o3_r_tl
1434  predictor_tl%X(k, 9, comp_ozo_ir) = o3_r_tl*o3/pafv%GAzp(k,abs_o3_ir) + o3_r*o3_tl/pafv%GAzp(k,abs_o3_ir) &
1435  - o3_r*o3*gazp_tl(k,abs_o3_ir)/pafv%GAzp(k,abs_o3_ir)**2
1436  predictor_tl%X(k,10, comp_ozo_ir) = secang(k)*gazp_tl(k,abs_o3_ir)
1437  predictor_tl%X(k,11, comp_ozo_ir) = two*secang(k)**2 * pafv%GAzp(k,abs_o3_ir)*gazp_tl(k,abs_o3_ir)
1438 ! Predictor_TL%X(k, 12, COMP_OZO_IR) = H2O_A_TL
1439 ! Predictor_TL%X(k, 13, COMP_OZO_IR) = SECANG(k)*GAzp_TL(k,ABS_H2O_IR)
1440 
1441  ! -----------------------
1442  ! Carbon dioxide predictors
1443  ! -----------------------
1444  predictor_tl%X(k, 1, comp_co2_ir) = secang(k) * t_tl
1445  predictor_tl%X(k, 2, comp_co2_ir) = secang(k) * t2_tl
1446  predictor_tl%X(k, 3, comp_co2_ir) = t_tl
1447  predictor_tl%X(k, 4, comp_co2_ir) = t2_tl
1448  predictor_tl%X(k, 5, comp_co2_ir) = zero
1449  predictor_tl%X(k, 6, comp_co2_ir) = secang(k)*co2_tl
1450  predictor_tl%X(k, 7, comp_co2_ir) = secang(k)*tzp_tl(k)
1451  predictor_tl%X(k, 8, comp_co2_ir) = two*secang(k)**2 * pafv%GAzp(k, abs_co2_ir)* gazp_tl(k, abs_co2_ir)
1452  predictor_tl%X(k, 9, comp_co2_ir) = three*pafv%Tzp(k)**2*tzp_tl(k)
1453  predictor_tl%X(k, 10, comp_co2_ir) = secang(k)*( sqrt(t)*tzp_tl(k) + (point_5*pafv%Tzp(k)/sqrt(t))*t_tl )
1454 
1455  ! --------------------------
1456  ! Water-line predictors
1457  ! --------------------------
1458  predictor_tl%X(k, 1, comp_wlo_ir) = h2o_a_tl
1459  predictor_tl%X(k, 2, comp_wlo_ir) = h2o_a_tl*dt + h2o_a*dt_tl
1460  predictor_tl%X(k, 3, comp_wlo_ir) = h2o_s_tl
1461  predictor_tl%X(k, 4, comp_wlo_ir) = h2o_a_tl*dt2 + h2o_a*dt2_tl
1462  predictor_tl%X(k, 5, comp_wlo_ir) = h2o_r4_tl
1463  predictor_tl%X(k, 6, comp_wlo_ir) = h2o_s_tl*h2o_a + h2o_s*h2o_a_tl
1464  predictor_tl%X(k, 7, comp_wlo_ir) = h2o_r_tl
1465  predictor_tl%X(k, 8, comp_wlo_ir) = h2o_r_tl*dt + h2o_r*dt_tl
1466  predictor_tl%X(k, 9, comp_wlo_ir) = two*h2o_s*h2o_s_tl
1467  predictor_tl%X(k,10, comp_wlo_ir) = h2odh2otzp_tl
1468  predictor_tl%X(k,11, comp_wlo_ir) = h2o_r_tl*h2odh2otzp + h2o_r*h2odh2otzp_tl
1469  predictor_tl%X(k,12, comp_wlo_ir) = two*secang(k)**2 * pafv%GAzp(k,abs_h2o_ir)*gazp_tl(k,abs_h2o_ir)
1470  predictor_tl%X(k,13, comp_wlo_ir) = secang(k)*gazp_tl(k,abs_h2o_ir)
1471  predictor_tl%X(k,14, comp_wlo_ir) = zero
1472  predictor_tl%X(k,15, comp_wlo_ir) = secang(k)*co2_tl
1473 
1474  ! Addtional predictors for group 1
1475  if_group1: IF( group_id == group_1 )THEN
1476 
1477  predictor_tl%X(k, 11, comp_co2_ir) = co_a_tl
1478 
1479  predictor_tl%X(k, 16, comp_wlo_ir) = ch4_a_tl
1480  predictor_tl%X(k, 17, comp_wlo_ir) = two*ch4_a*ch4_a_tl*dt + ch4_a*ch4_a*dt_tl
1481  predictor_tl%X(k, 18, comp_wlo_ir) = co_a_tl
1482 
1483  ! -----------------------
1484  ! Carbon monoxide
1485  ! -----------------------
1486  predictor_tl%X(k, 1, comp_co_ir) = co_a_tl
1487  predictor_tl%X(k, 2, comp_co_ir) = co_a_tl*dt + co_a*dt_tl
1488  predictor_tl%X(k, 3, comp_co_ir) = (point_5/sqrt(co_r))*co_r_tl
1489  predictor_tl%X(k, 4, comp_co_ir) = co_r_tl*dt + co_r*dt_tl
1490  predictor_tl%X(k, 5, comp_co_ir) = co_s_tl
1491  predictor_tl%X(k, 6, comp_co_ir) = co_r_tl
1492  predictor_tl%X(k, 7, comp_co_ir) = co_a_tl*dt2 + co_a*dt2_tl
1493  predictor_tl%X(k, 8, comp_co_ir) = co_acodcozp_tl
1494  predictor_tl%X(k, 9, comp_co_ir) = co_acodcozp_tl/co_r - co_acodcozp*co_r_tl/co_r**2
1495  predictor_tl%X(k, 10, comp_co_ir) = co_acodcozp_tl * sqrt( pafv%GAzp(k, abs_co_ir) ) + &
1496  (point_5*co_acodcozp/sqrt(pafv%GAzp(k, abs_co_ir))) * &
1497  gazp_tl(k, abs_co_ir)
1498 
1499  ! -----------------------
1500  ! Methane predictors
1501  ! -----------------------
1502  predictor_tl%X(k, 1, comp_ch4_ir) = ch4_a_tl*dt + ch4_a*dt_tl
1503  predictor_tl%X(k, 2, comp_ch4_ir) = ch4_r_tl
1504  predictor_tl%X(k, 3, comp_ch4_ir) = two*ch4_a*ch4_a_tl
1505  predictor_tl%X(k, 4, comp_ch4_ir) = ch4_a_tl
1506  predictor_tl%X(k, 5, comp_ch4_ir) = ch4_tl*dt + ch4*dt_tl
1507  predictor_tl%X(k, 6, comp_ch4_ir) = ch4_ach4zp_tl
1508  predictor_tl%X(k, 7, comp_ch4_ir) = two*ch4_ach4zp*ch4_ach4zp_tl
1509  predictor_tl%X(k, 8, comp_ch4_ir) = (point_5/sqrt(ch4_r))*ch4_r_tl
1510  predictor_tl%X(k, 9, comp_ch4_ir) = gatzp_tl(k, abs_ch4_ir)
1511  predictor_tl%X(k, 10, comp_ch4_ir) = secang(k)*gatzp_tl(k, abs_ch4_ir)
1512  predictor_tl%X(k, 11, comp_ch4_ir) = ch4_r_tl*ch4/pafv%GAzp(k, abs_ch4_ir) + &
1513  ch4_r*ch4_tl/pafv%GAzp(k, abs_ch4_ir) - &
1514  ch4_r*ch4*gazp_tl(k, abs_ch4_ir)/pafv%GAzp(k, abs_ch4_ir)**2
1515  ! -----------------------
1516  ! N2O predictors
1517  ! -----------------------
1518  predictor_tl%X(k, 1, comp_n2o_ir) = n2o_a_tl*dt + n2o_a*dt_tl
1519  predictor_tl%X(k, 2, comp_n2o_ir) = n2o_r_tl
1520  predictor_tl%X(k, 3, comp_n2o_ir) = n2o_tl*dt + n2o*dt_tl
1521  predictor_tl%X(k, 4, comp_n2o_ir) = point_25*n2o_a**(-point_75) * n2o_a_tl
1522  predictor_tl%X(k, 5, comp_n2o_ir) = n2o_a_tl
1523  predictor_tl%X(k, 6, comp_n2o_ir) = secang(k) * gazp_tl(k, abs_n2o_ir)
1524  predictor_tl%X(k, 7, comp_n2o_ir) = secang(k) * gatzp_tl(k, abs_n2o_ir)
1525  predictor_tl%X(k, 8, comp_n2o_ir) = n2o_s_tl
1526  predictor_tl%X(k, 9, comp_n2o_ir) = gatzp_tl(k, abs_n2o_ir)
1527  predictor_tl%X(k,10, comp_n2o_ir) = n2o_r_tl*n2o / pafv%GAzp(k, abs_n2o_ir) + &
1528  n2o_r*n2o_tl / pafv%GAzp(k, abs_n2o_ir) - &
1529  n2o_r*n2o*gazp_tl(k, abs_n2o_ir)/pafv%GAzp(k, abs_n2o_ir)**2
1530  predictor_tl%X(k,11, comp_n2o_ir) = ch4_a_tl
1531  predictor_tl%X(k,12, comp_n2o_ir) = ch4_a_tl*pafv%GAzp(k, abs_ch4_ir) + ch4_a*gazp_tl(k, abs_ch4_ir)
1532  predictor_tl%X(k,13, comp_n2o_ir) = co_a_tl
1533  predictor_tl%X(k,14, comp_n2o_ir) = co_a_tl*secang(k)*pafv%GAzp(k, abs_co_ir) + &
1534  co_a*secang(k)*gazp_tl(k, abs_co_ir)
1535 
1536  END IF if_group1
1537 
1538  END DO layer_loop
1539 
1540  END SUBROUTINE odps_compute_predictor_ir_tl
1541 
1542  SUBROUTINE odps_compute_predictor_mw_tl()
1543 
1544  ! ---------------
1545  ! Local variables
1546  ! ---------------
1547  INTEGER :: k ! n_Layers, n_Levels
1548  REAL(fp) :: DT, DT_TL
1549  REAL(fp) :: T, T_TL
1550  REAL(fp) :: T2, T2_TL
1551  REAL(fp) :: DT2, DT2_TL
1552  REAL(fp) :: H2O, H2O_TL
1553  REAL(fp) :: H2O_A, H2O_A_TL
1554  REAL(fp) :: H2O_R, H2O_R_TL
1555  REAL(fp) :: H2O_S, H2O_S_TL
1556  REAL(fp) :: H2O_R4, H2O_R4_TL
1557  REAL(fp) :: H2OdH2OTzp, H2OdH2OTzp_TL
1558 
1559  layer_loop : DO k = 1, n_layers
1560 
1561  !------------------------------------------
1562  ! Relative Temperature
1563  !------------------------------------------
1564  dt = temperature(k) - ref_temperature(k)
1565  t = temperature(k) / ref_temperature(k)
1566 
1567  dt_tl = temperature_tl(k)
1568  t_tl = temperature_tl(k) / ref_temperature(k)
1569 
1570  !-------------------------------------------
1571  ! Abosrber amount scalled by the reference
1572  !-------------------------------------------
1573  h2o = absorber(k,abs_h2o_mw)/ref_absorber(k, abs_h2o_mw)
1574  h2o_tl = absorber_tl(k,abs_h2o_mw)/ref_absorber(k, abs_h2o_mw)
1575 
1576  ! Combinations of variables common to all predictor groups
1577  t2 = t*t
1578  dt2 = dt*abs( dt )
1579 
1580  t2_tl = two*t*t_tl
1581  IF( dt > zero) THEN
1582  dt2_tl = two*dt*dt_tl
1583  ELSE
1584  dt2_tl = - two*dt*dt_tl
1585  ENDIF
1586 
1587  h2o_a = secang(k)*h2o
1588  h2o_r = sqrt( h2o_a )
1589  h2o_s = h2o_a*h2o_a
1590  h2o_r4 = sqrt( h2o_r )
1591  h2odh2otzp = h2o/pafv%GATzp(k, abs_h2o_mw)
1592 
1593  h2o_a_tl = secang(k)*h2o_tl
1594  h2o_r_tl = (point_5 / sqrt(h2o_a)) * h2o_a_tl
1595  h2o_s_tl = two * h2o_a * h2o_a_tl
1596  h2o_r4_tl = (point_5 / sqrt(h2o_r)) * h2o_r_tl
1597  h2odh2otzp_tl = h2o_tl/pafv%GATzp(k, abs_h2o_mw) - &
1598  h2o * gatzp_tl(k, abs_h2o_ir)/pafv%GATzp(k, abs_h2o_mw)**2
1599 
1600  !#-------------------------------------------------------------------#
1601  !# -- Predictors -- #
1602  !#-------------------------------------------------------------------#
1603 
1604  ! set number of predictors
1605  predictor_tl%n_CP = n_predictors_g3
1606 
1607  ! ----------------------
1608  ! Fixed (Dry) predictors
1609  ! ----------------------
1610  predictor_tl%X(k, 1, comp_dry_mw) = zero
1611  predictor_tl%X(k, 2, comp_dry_mw) = secang(k) * t_tl
1612  predictor_tl%X(k, 3, comp_dry_mw) = secang(k) * t2_tl
1613  predictor_tl%X(k, 4, comp_dry_mw) = t_tl
1614  predictor_tl%X(k, 5, comp_dry_mw) = zero
1615  predictor_tl%X(k, 6, comp_dry_mw) = t2_tl
1616  predictor_tl%X(k, 7, comp_dry_mw) = tz_tl(k)
1617  predictor_tl%X(:, 8:, comp_dry_mw) = zero
1618  ! --------------------------------
1619  ! Water vapor (line and continuum)
1620  ! --------------------------------
1621  predictor_tl%X(k, 1, comp_wet_mw) = h2o_a_tl/t - h2o_a*t_tl/t**2
1622  predictor_tl%X(k, 2, comp_wet_mw) = h2o_a_tl*h2o/t + h2o_a*h2o_tl/t - h2o_a*h2o*t_tl/t**2
1623  predictor_tl%X(k, 3, comp_wet_mw) = h2o_a_tl*h2o/t2**2 + h2o_a*h2o_tl/t2**2 - &
1624  two*h2o_a*h2o*t2_tl/t2**3
1625  predictor_tl%X(k, 4, comp_wet_mw) = h2o_a_tl/t2 - h2o_a * t2_tl/t2**2
1626  predictor_tl%X(k, 5, comp_wet_mw) = h2o_a_tl*h2o/t2 + h2o_a*h2o_tl/t2 - h2o_a*h2o*t2_tl/t2**2
1627  predictor_tl%X(k, 6, comp_wet_mw) = h2o_a_tl/t2**2 - two*h2o_a*t2_tl/t2**3
1628  predictor_tl%X(k, 7, comp_wet_mw) = h2o_a_tl
1629  predictor_tl%X(k, 8, comp_wet_mw) = h2o_a_tl*dt + h2o_a*dt_tl
1630  predictor_tl%X(k, 9, comp_wet_mw) = two*secang(k)**2 * pafv%GAzp(k,abs_h2o_mw)*gazp_tl(k,abs_h2o_mw)
1631  predictor_tl%X(k, 10,comp_wet_mw) = secang(k)*gazp_tl(k,abs_h2o_mw)
1632  predictor_tl%X(k, 11,comp_wet_mw) = zero
1633  predictor_tl%X(k, 12,comp_wet_mw) = h2o_s_tl*h2o_a + h2o_s*h2o_a_tl
1634  predictor_tl%X(k, 13,comp_wet_mw) = two*h2o_s*h2o_s_tl
1635  predictor_tl%X(k, 14,comp_wet_mw) = h2odh2otzp_tl
1636 
1637  END DO layer_loop
1638 
1639  END SUBROUTINE odps_compute_predictor_mw_tl
1640 
1641  END SUBROUTINE odps_compute_predictor_tl
1642 
1643 !============================== END OF TL
1644 
1645 !============================== AD
1646 
1647 !------------------------------------------------------------------------------
1648 !
1649 ! NAME:
1650 ! ODPS_Compute_Predictor_AD
1651 !
1652 ! PURPOSE:
1653 ! Subroutine to predictors
1654 !
1655 ! CALLING SEQUENCE:
1656 ! CALL ODPS_Compute_Predictor_AD( &
1657 ! Group_ID, & ! Input
1658 ! Temperature, & ! Input
1659 ! Absorber, & ! Input
1660 ! Ref_Temperature, & ! Input
1661 ! Ref_Absorber, & ! Input
1662 ! secang, & ! Input
1663 ! Predictor, & ! Input
1664 ! Predictor_AD, & ! Input
1665 ! Temperature_AD & ! Output
1666 ! Absorber_AD ) ! Output
1667 !
1668 ! INPUT ARGUMENTS:
1669 ! Group_ID : The ID of predictor group
1670 ! UNITS: N?A
1671 ! TYPE: INTEGER
1672 ! DIMENSION: scalar
1673 ! ATTRIBUTES: INTENT(IN)
1674 !
1675 ! Temperature: Temperature profile
1676 ! UNITS: K
1677 ! TYPE: REAL(fp)
1678 ! DIMENSION: Rank-1(n_Layers) array
1679 ! ATTRIBUTES: INTENT(IN)
1680 !
1681 ! Absorber : Absorber profiles
1682 ! UNITS: vary
1683 ! TYPE: REAL(fp)
1684 ! DIMENSION: Rank-2(n_Layers x n_Absorbers) array
1685 ! ATTRIBUTES: INTENT(IN)
1686 !
1687 ! Ref_Temperature : Reference layer temperature profile
1688 ! UNITS: K
1689 ! TYPE: REAL(fp)
1690 ! DIMENSION: Rank-1(n_Layers) array
1691 ! ATTRIBUTES: INTENT(IN)
1692 !
1693 ! Ref_Absorber : Reference absorber profiles
1694 ! UNITS: vary
1695 ! TYPE: REAL(fp)
1696 ! DIMENSION: Rank-2(n_Layers x n_Absorbers) array
1697 ! ATTRIBUTES: INTENT(IN)
1698 !
1699 ! secang : Secont sensor zenith angle profile
1700 ! UNITS: N/A
1701 ! TYPE: REAL(fp)
1702 ! DIMENSION: Rank-1(n_Layers) array
1703 ! ATTRIBUTES: INTENT(IN)
1704 !
1705 ! Predictor: Predictor structure containing the integrated absorber
1706 ! and predictor profiles.
1707 ! UNITS: N/A
1708 ! TYPE: ODPS_Predictor_type
1709 ! DIMENSION: Scalar
1710 ! ATTRIBUTES: INTENT(IN)
1711 !
1712 ! Predictor_AD: Predictor_AD structure containing the integrated absorber_AD
1713 ! and predictor_AD profiles.
1714 ! UNITS: N/A
1715 ! TYPE: ODPS_Predictor_type
1716 ! DIMENSION: Scalar
1717 ! ATTRIBUTES: INTENT(IN)
1718 !
1719 ! OUTPUT ARGUMENTS:
1720 !
1721 ! Temperature_AD: Temperature_AD profile
1722 ! UNITS: K
1723 ! TYPE: REAL(fp)
1724 ! DIMENSION: Rank-1(n_Layers) array
1725 ! ATTRIBUTES: INTENT(IN OUT)
1726 !
1727 ! Absorber_AD: Absorber_AD profiles
1728 ! UNITS: vary
1729 ! TYPE: REAL(fp)
1730 ! DIMENSION: Rank-2(n_Layers x n_Absorbers) array
1731 ! ATTRIBUTES: INTENT(IN OUT)
1732 !
1733 !------------------------------------------------------------------------------
1734 
1735  SUBROUTINE odps_compute_predictor_ad( &
1736  Group_ID, &
1737  Temperature, &
1738  Absorber, &
1739  Ref_Temperature, &
1740  Ref_Absorber, &
1741  secang, &
1742  Predictor, &
1743  Predictor_AD, &
1744  Temperature_AD, &
1745  Absorber_AD )
1746 
1747  INTEGER, INTENT(IN) :: group_id
1748  REAL(fp), INTENT(IN) :: temperature(:)
1749  REAL(fp), INTENT(IN) :: absorber(:, :)
1750  REAL(fp), INTENT(IN) :: ref_temperature(:)
1751  REAL(fp), INTENT(IN) :: ref_absorber(:, :)
1752  REAL(fp), INTENT(IN) :: secang(:)
1753  TYPE(odps_predictor_type), TARGET, INTENT(IN) :: predictor
1754  TYPE(odps_predictor_type), INTENT(IN OUT) :: predictor_ad
1755  REAL(fp), INTENT(IN OUT) :: temperature_ad(:)
1756  REAL(fp), INTENT(IN OUT) :: absorber_ad(:, :)
1757 
1758  ! ---------------
1759  ! Local variables
1760  ! ---------------
1761  CHARACTER(*), PARAMETER :: routine_name = 'ODPS_Compute_Predictor_AD'
1762  INTEGER :: n_layers
1763  INTEGER :: k ! n_Layers, n_Levels
1764  INTEGER :: j ! n_absorbers
1765  REAL(fp) :: tzp_sum_ad
1766  REAL(fp) :: tzp_ad(size(absorber, dim=1))
1767  REAL(fp) :: tz_sum_ad
1768  REAL(fp) :: tz_ad(size(absorber, dim=1))
1769  REAL(fp) :: gaz_sum_ad(size(absorber, dim=2))
1770  REAL(fp) :: gaz_ad(size(absorber, dim=1), size(absorber, dim=2))
1771  REAL(fp) :: gazp_sum_ad(size(absorber, dim=2))
1772  REAL(fp) :: gazp_ad(size(absorber, dim=1), size(absorber, dim=2))
1773  REAL(fp) :: gatzp_sum_ad(size(absorber, dim=2))
1774  REAL(fp) :: gatzp_ad(size(absorber, dim=1), size(absorber, dim=2))
1775  TYPE(pafv_type), POINTER :: pafv => null()
1776 
1777  ! use short name
1778  pafv => predictor%PAFV
1779 
1780  n_layers = predictor%n_Layers
1781 
1782 
1783  !------------------------------------
1784  ! Compute integrated variables
1785  !------------------------------------
1786 
1787  tzp_sum_ad = zero
1788  tz_sum_ad = zero
1789  gaz_sum_ad = zero
1790  gazp_sum_ad = zero
1791  gatzp_sum_ad = zero
1792 
1793  gatzp_ad = zero
1794  gazp_ad = zero
1795  gaz_ad = zero
1796  tzp_ad = zero
1797  tz_ad = zero
1798 
1799  !----------------------------------------------------------------
1800  ! Call the group specific routine for remaining computation; all
1801  ! variables defined above are passed to the called routine
1802  !----------------------------------------------------------------
1803 
1804  SELECT CASE( group_id )
1805  CASE( group_1, group_2 )
1806  CALL odps_compute_predictor_ir_ad()
1807  CASE( group_3 )
1808  CALL odps_compute_predictor_mw_ad()
1809  END SELECT
1810 
1811  adjoint_layer_loop : DO k = n_layers, 1, -1
1812 
1813  ! absorbers
1814  DO j = n_absorbers_g(group_id), 1, -1
1815 
1816  gatzp_sum_ad(j) = gatzp_sum_ad(j) + gatzp_ad(k, j)/pafv%GATzp_ref(k,j)
1817  gazp_sum_ad(j) = gazp_sum_ad(j) + gazp_ad(k, j)/pafv%GAzp_ref(k,j)
1818  gaz_sum_ad(j) = gaz_sum_ad(j) + gaz_ad(k, j)/pafv%GAz_ref(k,j)
1819  temperature_ad(k) = temperature_ad(k) + gatzp_sum_ad(j)*pafv%PDP(k)*absorber(k, j)
1820  absorber_ad(k, j) = absorber_ad(k, j) + gaz_sum_ad(j) + gazp_sum_ad(j)*pafv%PDP(k) &
1821  + gatzp_sum_ad(j)*pafv%PDP(k)*temperature(k)
1822  gatzp_ad(k, j) = zero
1823  gazp_ad(k, j) = zero
1824  gaz_ad(k, j) = zero
1825 
1826  END DO
1827 
1828  ! Temperature
1829  tzp_sum_ad = tzp_sum_ad + tzp_ad(k)/pafv%Tzp_ref(k)
1830  tz_sum_ad = tz_sum_ad + tz_ad(k)/pafv%Tz_ref(k)
1831  temperature_ad(k) = temperature_ad(k) + tz_sum_ad + pafv%PDP(k)*tzp_sum_ad
1832  tzp_ad(k) = zero
1833  tz_ad(k) = zero
1834 
1835  END DO adjoint_layer_loop
1836 
1837  NULLIFY(pafv)
1838 
1839 CONTAINS
1840 
1841  SUBROUTINE odps_compute_predictor_ir_ad()
1842 
1843  ! ---------------
1844  ! Local variables
1845  ! ---------------
1846  INTEGER :: k ! n_Layers, n_Levels
1847  REAL(fp) :: DT, DT_AD
1848  REAL(fp) :: T, T_AD
1849  REAL(fp) :: T2, T2_AD
1850  REAL(fp) :: DT2, DT2_AD
1851  REAL(fp) :: H2O, H2O_AD
1852  REAL(fp) :: H2O_A, H2O_A_AD
1853  REAL(fp) :: H2O_R, H2O_R_AD
1854  REAL(fp) :: H2O_S, H2O_S_AD
1855  REAL(fp) :: H2O_R4, H2O_R4_AD
1856  REAL(fp) :: H2OdH2OTzp, H2OdH2OTzp_AD
1857  REAL(fp) :: CO2, CO2_AD
1858  REAL(fp) :: O3, O3_AD
1859  REAL(fp) :: O3_A, O3_A_AD
1860  REAL(fp) :: O3_R, O3_R_AD
1861  REAL(fp) :: CO, CO_AD
1862  REAL(fp) :: CO_A, CO_A_AD
1863  REAL(fp) :: CO_R, CO_R_AD
1864  REAL(fp) :: CO_S, CO_S_AD
1865  REAL(fp) :: CO_ACOdCOzp, CO_ACOdCOzp_AD
1866  REAL(fp) :: N2O, N2O_AD
1867  REAL(fp) :: N2O_A, N2O_A_AD
1868  REAL(fp) :: N2O_R, N2O_R_AD
1869  REAL(fp) :: N2O_S, N2O_S_AD
1870  REAL(fp) :: CH4, CH4_AD
1871  REAL(fp) :: CH4_A, CH4_A_AD
1872  REAL(fp) :: CH4_R, CH4_R_AD
1873  REAL(fp) :: CH4_ACH4zp, CH4_ACH4zp_AD
1874 
1875  dt_ad = zero
1876  t_ad = zero
1877  t2_ad = zero
1878  dt2_ad = zero
1879  h2o_ad = zero
1880  h2o_a_ad = zero
1881  h2o_r_ad = zero
1882  h2o_s_ad = zero
1883  h2o_r4_ad = zero
1884  h2odh2otzp_ad = zero
1885  co2_ad = zero
1886  o3_ad = zero
1887  o3_a_ad = zero
1888  o3_r_ad = zero
1889  co_ad = zero
1890  co_a_ad = zero
1891  co_r_ad = zero
1892  co_s_ad = zero
1893  co_acodcozp_ad = zero
1894  n2o_ad = zero
1895  n2o_a_ad = zero
1896  n2o_r_ad = zero
1897  n2o_s_ad = zero
1898  ch4_ad = zero
1899  ch4_a_ad = zero
1900  ch4_r_ad = zero
1901  ch4_ach4zp_ad = zero
1902 
1903  layer_loop : DO k = n_layers, 1, -1
1904 
1905  !------------------------------------------
1906  ! Relative Temperature
1907  !------------------------------------------
1908  dt = temperature(k) - ref_temperature(k)
1909  t = temperature(k) / ref_temperature(k)
1910 
1911  !-------------------------------------------
1912  ! Abosrber amount scalled by the reference
1913  !-------------------------------------------
1914  h2o = absorber(k,abs_h2o_ir)/ref_absorber(k, abs_h2o_ir)
1915  o3 = absorber(k,abs_o3_ir)/ref_absorber(k,abs_o3_ir)
1916  co2 = absorber(k,abs_co2_ir)/ref_absorber(k,abs_co2_ir)
1917 
1918  ! Combinations of variables common to all predictor groups
1919  t2 = t*t
1920  dt2 = dt*abs( dt )
1921 
1922  h2o_a = secang(k)*h2o
1923  h2o_r = sqrt( h2o_a )
1924  h2o_s = h2o_a*h2o_a
1925  h2o_r4 = sqrt( h2o_r )
1926  h2odh2otzp = h2o/pafv%GATzp(k, abs_h2o_ir)
1927 
1928  o3_a = secang(k)*o3
1929  o3_r = sqrt( o3_a )
1930 
1931  IF( group_id == group_1 )THEN
1932  co = absorber(k,abs_co_ir)/ref_absorber(k, abs_co_ir)
1933  n2o = absorber(k,abs_n2o_ir)/ref_absorber(k,abs_n2o_ir)
1934  ch4 = absorber(k,abs_ch4_ir)/ref_absorber(k,abs_ch4_ir)
1935 
1936  n2o_a = secang(k)*n2o
1937  n2o_r = sqrt( n2o_a )
1938  n2o_s = n2o_a*n2o_a
1939 
1940  co_a = secang(k)*co
1941  co_r = sqrt( co_a )
1942  co_s = co_a*co_a
1943  co_acodcozp = co_a*co/pafv%GAzp(k, abs_co_ir)
1944 
1945  ch4_a = secang(k)*ch4
1946  ch4_r = sqrt(ch4_a)
1947  ch4_ach4zp = secang(k)*pafv%GAzp(k, abs_ch4_ir)
1948 
1949  END IF
1950 
1951  !#-------------------------------------------------------------------#
1952  !# -- Predictors -- #
1953  !#-------------------------------------------------------------------#
1954 
1955  ! ----------------------
1956  ! Fixed (Dry) predictors
1957  ! ----------------------
1958  t_ad = t_ad &
1959  + predictor_ad%X(k, 2, comp_dry_ir) * secang(k) &
1960  + predictor_ad%X(k, 4, comp_dry_ir)
1961  t2_ad = t2_ad &
1962  + predictor_ad%X(k, 3, comp_dry_ir) * secang(k) &
1963  + predictor_ad%X(k, 6, comp_dry_ir)
1964  tz_ad(k) = tz_ad(k) + predictor_ad%X(k, 7, comp_dry_ir)
1965 
1966  predictor_ad%X(k, 1, comp_dry_ir) = zero
1967  predictor_ad%X(k, 2, comp_dry_ir) = zero
1968  predictor_ad%X(k, 3, comp_dry_ir) = zero
1969  predictor_ad%X(k, 4, comp_dry_ir) = zero
1970  predictor_ad%X(k, 5, comp_dry_ir) = zero
1971  predictor_ad%X(k, 6, comp_dry_ir) = zero
1972  predictor_ad%X(k, 7, comp_dry_ir) = zero
1973 
1974  ! --------------------------
1975  ! Water vapor continuum predictors
1976  ! --------------------------
1977  h2o_a_ad = h2o_a_ad &
1978  + predictor_ad%X(k, 1, comp_wco_ir)/t &
1979  + predictor_ad%X(k, 2, comp_wco_ir)*h2o/t &
1980  + predictor_ad%X(k, 3, comp_wco_ir)*h2o/t2**2 &
1981  + predictor_ad%X(k, 4, comp_wco_ir)/t2 &
1982  + predictor_ad%X(k, 5, comp_wco_ir)*h2o/t2 &
1983  + predictor_ad%X(k, 6, comp_wco_ir)/t2**2 &
1984  + predictor_ad%X(k, 7, comp_wco_ir)
1985  t_ad = t_ad &
1986  - predictor_ad%X(k, 1, comp_wco_ir)*h2o_a/t**2 &
1987  - predictor_ad%X(k, 2, comp_wco_ir)*h2o_a*h2o/t**2
1988  h2o_ad = h2o_ad &
1989  + predictor_ad%X(k, 2, comp_wco_ir)*h2o_a/t &
1990  + predictor_ad%X(k, 3, comp_wco_ir)*h2o_a/t2**2 &
1991  + predictor_ad%X(k, 5, comp_wco_ir)*h2o_a/t2
1992  t2_ad = t2_ad &
1993  - predictor_ad%X(k, 3, comp_wco_ir)*two*h2o_a*h2o/t2**3 &
1994  - predictor_ad%X(k, 4, comp_wco_ir)*h2o_a/t2**2 &
1995  - predictor_ad%X(k, 5, comp_wco_ir)*h2o_a*h2o/t2**2 &
1996  - predictor_ad%X(k, 6, comp_wco_ir)*two*h2o_a/t2**3
1997 
1998  predictor_ad%X(k, 1, comp_wco_ir) = zero
1999  predictor_ad%X(k, 2, comp_wco_ir) = zero
2000  predictor_ad%X(k, 3, comp_wco_ir) = zero
2001  predictor_ad%X(k, 4, comp_wco_ir) = zero
2002  predictor_ad%X(k, 5, comp_wco_ir) = zero
2003  predictor_ad%X(k, 6, comp_wco_ir) = zero
2004  predictor_ad%X(k, 7, comp_wco_ir) = zero
2005 
2006  ! -----------------------
2007  ! Ozone predictors
2008  ! -----------------------
2009 
2010  o3_a_ad = o3_a_ad &
2011  + predictor_ad%X(k, 1, comp_ozo_ir) &
2012  + predictor_ad%X(k, 2, comp_ozo_ir)*dt &
2013  + predictor_ad%X(k, 3, comp_ozo_ir)*o3*pafv%GAzp(k,abs_o3_ir) &
2014  + predictor_ad%X(k, 4, comp_ozo_ir)*two*o3_a &
2015  + predictor_ad%X(k, 5, comp_ozo_ir)*pafv%GAzp(k,abs_o3_ir) &
2016  + predictor_ad%X(k, 6, comp_ozo_ir)*sqrt(secang(k)*pafv%GAzp(k,abs_o3_ir))
2017 
2018  dt_ad = dt_ad &
2019  + predictor_ad%X(k, 2, comp_ozo_ir)*o3_a &
2020  + predictor_ad%X(k, 7, comp_ozo_ir)*o3_r
2021 
2022  o3_ad = o3_ad &
2023  + predictor_ad%X(k, 3, comp_ozo_ir)*o3_a*pafv%GAzp(k,abs_o3_ir) &
2024  + predictor_ad%X(k, 9, comp_ozo_ir)*o3_r/pafv%GAzp(k,abs_o3_ir)
2025 
2026  gazp_ad(k,abs_o3_ir) = gazp_ad(k,abs_o3_ir) &
2027  + predictor_ad%X(k, 3, comp_ozo_ir)*o3_a*o3 &
2028  + predictor_ad%X(k, 5, comp_ozo_ir)*o3_a &
2029  + predictor_ad%X(k, 6, comp_ozo_ir)*point_5*o3_a*sqrt(secang(k)/pafv%GAzp(k,abs_o3_ir)) &
2030  - predictor_ad%X(k, 9, comp_ozo_ir)*o3_r*o3/pafv%GAzp(k,abs_o3_ir)**2 &
2031  + predictor_ad%X(k,10, comp_ozo_ir)*secang(k) &
2032  + predictor_ad%X(k,11, comp_ozo_ir)*two*secang(k)**2*pafv%GAzp(k,abs_o3_ir)
2033 
2034  o3_r_ad = o3_r_ad &
2035  + predictor_ad%X(k, 7, comp_ozo_ir)*dt &
2036  + predictor_ad%X(k, 8, comp_ozo_ir) &
2037  + predictor_ad%X(k, 9, comp_ozo_ir)*o3/pafv%GAzp(k,abs_o3_ir)
2038 
2039 ! H2O_A_AD= H2O_A_AD + Predictor_AD%X(k, 12, COMP_OZO_IR)
2040 
2041 ! GAzp_AD(k,ABS_H2O_IR) = GAzp_AD(k,ABS_H2O_IR) &
2042 ! + Predictor_AD%X(k, 13, COMP_OZO_IR)*SECANG(k)
2043 
2044  predictor_ad%X(k, 1, comp_ozo_ir) = zero
2045  predictor_ad%X(k, 2, comp_ozo_ir) = zero
2046  predictor_ad%X(k, 3, comp_ozo_ir) = zero
2047  predictor_ad%X(k, 4, comp_ozo_ir) = zero
2048  predictor_ad%X(k, 5, comp_ozo_ir) = zero
2049  predictor_ad%X(k, 6, comp_ozo_ir) = zero
2050  predictor_ad%X(k, 7, comp_ozo_ir) = zero
2051  predictor_ad%X(k, 8, comp_ozo_ir) = zero
2052  predictor_ad%X(k, 9, comp_ozo_ir) = zero
2053  predictor_ad%X(k,10, comp_ozo_ir) = zero
2054  predictor_ad%X(k,11, comp_ozo_ir) = zero
2055 
2056  predictor_ad%X(k,12, comp_ozo_ir) = zero
2057  predictor_ad%X(k,13, comp_ozo_ir) = zero
2058 
2059  ! -----------------------
2060  ! Carbon dioxide predictors
2061  ! -----------------------
2062  t_ad = t_ad &
2063  + predictor_ad%X(k, 1, comp_co2_ir)*secang(k) &
2064  + predictor_ad%X(k, 3, comp_co2_ir) &
2065  + predictor_ad%X(k, 10, comp_co2_ir)*secang(k)*(point_5*pafv%Tzp(k)/sqrt(t))
2066 
2067  t2_ad = t2_ad &
2068  + predictor_ad%X(k, 2, comp_co2_ir)*secang(k) &
2069  + predictor_ad%X(k, 4, comp_co2_ir)
2070 
2071  co2_ad = co2_ad + predictor_ad%X(k, 6, comp_co2_ir)*secang(k)
2072 
2073  tzp_ad(k) = tzp_ad(k) &
2074  + predictor_ad%X(k, 7, comp_co2_ir)*secang(k) &
2075  + predictor_ad%X(k, 9, comp_co2_ir)*three*pafv%Tzp(k)**2 &
2076  + predictor_ad%X(k, 10, comp_co2_ir)*secang(k)*sqrt(t)
2077 
2078  gazp_ad(k, abs_co2_ir) = gazp_ad(k, abs_co2_ir) &
2079  + predictor_ad%X(k, 8, comp_co2_ir)*two*secang(k)**2*pafv%GAzp(k, abs_co2_ir)
2080 
2081 
2082  predictor_ad%X(k, 1, comp_co2_ir) = zero
2083  predictor_ad%X(k, 2, comp_co2_ir) = zero
2084  predictor_ad%X(k, 3, comp_co2_ir) = zero
2085  predictor_ad%X(k, 4, comp_co2_ir) = zero
2086  predictor_ad%X(k, 5, comp_co2_ir) = zero
2087  predictor_ad%X(k, 6, comp_co2_ir) = zero
2088  predictor_ad%X(k, 7, comp_co2_ir) = zero
2089  predictor_ad%X(k, 8, comp_co2_ir) = zero
2090  predictor_ad%X(k, 9, comp_co2_ir) = zero
2091  predictor_ad%X(k,10, comp_co2_ir) = zero
2092 
2093  ! --------------------------
2094  ! Water-line predictors
2095  ! --------------------------
2096 
2097  h2o_a_ad = h2o_a_ad &
2098  + predictor_ad%X(k, 1, comp_wlo_ir) &
2099  + predictor_ad%X(k, 2, comp_wlo_ir)*dt &
2100  + predictor_ad%X(k, 4, comp_wlo_ir)*dt2 &
2101  + predictor_ad%X(k, 6, comp_wlo_ir)*h2o_s
2102 
2103  dt_ad = dt_ad &
2104  + predictor_ad%X(k, 2, comp_wlo_ir)*h2o_a &
2105  + predictor_ad%X(k, 8, comp_wlo_ir)*h2o_r
2106 
2107  h2o_s_ad = h2o_s_ad &
2108  + predictor_ad%X(k, 3, comp_wlo_ir) &
2109  + predictor_ad%X(k, 6, comp_wlo_ir)*h2o_a &
2110  + predictor_ad%X(k, 9, comp_wlo_ir)*two*h2o_s
2111 
2112  dt2_ad = dt2_ad + predictor_ad%X(k, 4, comp_wlo_ir)*h2o_a
2113 
2114  h2o_r4_ad= h2o_r4_ad + predictor_ad%X(k, 5, comp_wlo_ir)
2115 
2116  h2o_r_ad = h2o_r_ad &
2117  + predictor_ad%X(k, 7, comp_wlo_ir) &
2118  + predictor_ad%X(k, 8, comp_wlo_ir)*dt &
2119  + predictor_ad%X(k,11, comp_wlo_ir)*h2odh2otzp
2120 
2121  h2odh2otzp_ad = h2odh2otzp_ad &
2122  + predictor_ad%X(k,10, comp_wlo_ir) &
2123  + predictor_ad%X(k,11, comp_wlo_ir)*h2o_r
2124 
2125  gazp_ad(k,abs_h2o_ir) = gazp_ad(k,abs_h2o_ir) &
2126  + predictor_ad%X(k,12, comp_wlo_ir)*two*secang(k)**2*pafv%GAzp(k,abs_h2o_ir) &
2127  + predictor_ad%X(k,13, comp_wlo_ir)*secang(k)
2128 
2129  co2_ad = co2_ad + predictor_ad%X(k,15, comp_wlo_ir)*secang(k)
2130 
2131  predictor_ad%X(k, 1, comp_wlo_ir) = zero
2132  predictor_ad%X(k, 2, comp_wlo_ir) = zero
2133  predictor_ad%X(k, 3, comp_wlo_ir) = zero
2134  predictor_ad%X(k, 4, comp_wlo_ir) = zero
2135  predictor_ad%X(k, 5, comp_wlo_ir) = zero
2136  predictor_ad%X(k, 6, comp_wlo_ir) = zero
2137  predictor_ad%X(k, 7, comp_wlo_ir) = zero
2138  predictor_ad%X(k, 8, comp_wlo_ir) = zero
2139  predictor_ad%X(k, 9, comp_wlo_ir) = zero
2140  predictor_ad%X(k,10, comp_wlo_ir) = zero
2141  predictor_ad%X(k,11, comp_wlo_ir) = zero
2142  predictor_ad%X(k,12, comp_wlo_ir) = zero
2143  predictor_ad%X(k,13, comp_wlo_ir) = zero
2144  predictor_ad%X(k,14, comp_wlo_ir) = zero
2145  predictor_ad%X(k,15, comp_wlo_ir) = zero
2146 
2147  ! Addtional predictors for group 1
2148  if_group1: IF( group_id == group_1 )THEN
2149 
2150  co_a_ad = co_a_ad + predictor_ad%X(k, 18, comp_wlo_ir) &
2151  + predictor_ad%X(k, 11, comp_co2_ir)
2152  ch4_a_ad = ch4_a_ad &
2153  + predictor_ad%X(k, 16, comp_wlo_ir) &
2154  + predictor_ad%X(k, 17, comp_wlo_ir)*two*ch4_a*dt
2155  dt_ad = dt_ad + predictor_ad%X(k, 17, comp_wlo_ir)*ch4_a*ch4_a
2156 
2157  predictor_ad%X(k, 16, comp_wlo_ir) = zero
2158  predictor_ad%X(k, 17, comp_wlo_ir) = zero
2159  predictor_ad%X(k, 18, comp_wlo_ir) = zero
2160  predictor_ad%X(k, 11, comp_co2_ir) = zero
2161 
2162  ! -----------------------
2163  ! Carbon monoxide
2164  ! -----------------------
2165 
2166  co_a_ad = co_a_ad &
2167  + predictor_ad%X(k, 1, comp_co_ir) &
2168  + predictor_ad%X(k, 2, comp_co_ir)*dt &
2169  + predictor_ad%X(k, 7, comp_co_ir)*dt2
2170 
2171  dt_ad = dt_ad &
2172  + predictor_ad%X(k, 2, comp_co_ir)*co_a &
2173  + predictor_ad%X(k, 4, comp_co_ir)*co_r
2174 
2175  co_r_ad = co_r_ad &
2176  + predictor_ad%X(k, 3, comp_co_ir)*point_5/sqrt(co_r) &
2177  + predictor_ad%X(k, 4, comp_co_ir)*dt &
2178  + predictor_ad%X(k, 6, comp_co_ir) &
2179  - predictor_ad%X(k, 9, comp_co_ir)*co_acodcozp/co_r**2
2180 
2181  co_s_ad = co_s_ad + predictor_ad%X(k, 5, comp_co_ir)
2182 
2183  dt2_ad = dt2_ad + predictor_ad%X(k, 7, comp_co_ir)*co_a
2184 
2185  co_acodcozp_ad = co_acodcozp_ad &
2186  + predictor_ad%X(k, 8, comp_co_ir) &
2187  + predictor_ad%X(k, 9, comp_co_ir)/co_r &
2188  + predictor_ad%X(k,10, comp_co_ir)*sqrt(pafv%GAzp(k, abs_co_ir))
2189 
2190  gazp_ad(k, abs_co_ir) = gazp_ad(k, abs_co_ir) &
2191  + predictor_ad%X(k, 10, comp_co_ir)* &
2192  point_5*co_acodcozp/sqrt(pafv%GAzp(k, abs_co_ir))
2193 
2194  predictor_ad%X(k, 1, comp_co_ir) = zero
2195  predictor_ad%X(k, 2, comp_co_ir) = zero
2196  predictor_ad%X(k, 3, comp_co_ir) = zero
2197  predictor_ad%X(k, 4, comp_co_ir) = zero
2198  predictor_ad%X(k, 5, comp_co_ir) = zero
2199  predictor_ad%X(k, 6, comp_co_ir) = zero
2200  predictor_ad%X(k, 7, comp_co_ir) = zero
2201  predictor_ad%X(k, 8, comp_co_ir) = zero
2202  predictor_ad%X(k, 9, comp_co_ir) = zero
2203  predictor_ad%X(k, 10, comp_co_ir) = zero
2204 
2205  ! -----------------------
2206  ! Methane predictors
2207  ! -----------------------
2208 
2209  ch4_a_ad = ch4_a_ad &
2210  + predictor_ad%X(k, 1, comp_ch4_ir)*dt &
2211  + predictor_ad%X(k, 3, comp_ch4_ir)*two*ch4_a &
2212  + predictor_ad%X(k, 4, comp_ch4_ir)
2213 
2214  dt_ad = dt_ad &
2215  + predictor_ad%X(k, 1, comp_ch4_ir)*ch4_a &
2216  + predictor_ad%X(k, 5, comp_ch4_ir)*ch4
2217 
2218  ch4_r_ad = ch4_r_ad &
2219  + predictor_ad%X(k, 2, comp_ch4_ir) &
2220  + predictor_ad%X(k, 8, comp_ch4_ir)*point_5/sqrt(ch4_r) &
2221  + predictor_ad%X(k, 11, comp_ch4_ir)*ch4/pafv%GAzp(k, abs_ch4_ir)
2222 
2223  ch4_ad = ch4_ad &
2224  + predictor_ad%X(k, 5, comp_ch4_ir)*dt &
2225  + predictor_ad%X(k, 11, comp_ch4_ir)*ch4_r/pafv%GAzp(k, abs_ch4_ir)
2226 
2227  ch4_ach4zp_ad = ch4_ach4zp_ad &
2228  + predictor_ad%X(k, 6, comp_ch4_ir) &
2229  + predictor_ad%X(k, 7, comp_ch4_ir)*two*ch4_ach4zp
2230 
2231  gatzp_ad(k, abs_ch4_ir) = gatzp_ad(k, abs_ch4_ir) &
2232  + predictor_ad%X(k, 9, comp_ch4_ir) &
2233  + predictor_ad%X(k,10, comp_ch4_ir)*secang(k)
2234 
2235  gazp_ad(k, abs_ch4_ir) = gazp_ad(k, abs_ch4_ir) &
2236  - predictor_ad%X(k, 11, comp_ch4_ir)* &
2237  ch4_r*ch4/pafv%GAzp(k, abs_ch4_ir)**2
2238 
2239  predictor_ad%X(k, 1, comp_ch4_ir) = zero
2240  predictor_ad%X(k, 2, comp_ch4_ir) = zero
2241  predictor_ad%X(k, 3, comp_ch4_ir) = zero
2242  predictor_ad%X(k, 4, comp_ch4_ir) = zero
2243  predictor_ad%X(k, 5, comp_ch4_ir) = zero
2244  predictor_ad%X(k, 6, comp_ch4_ir) = zero
2245  predictor_ad%X(k, 7, comp_ch4_ir) = zero
2246  predictor_ad%X(k, 8, comp_ch4_ir) = zero
2247  predictor_ad%X(k, 9, comp_ch4_ir) = zero
2248  predictor_ad%X(k, 10, comp_ch4_ir) = zero
2249  predictor_ad%X(k, 11, comp_ch4_ir) = zero
2250 
2251  ! -----------------------
2252  ! N2O predictors
2253  ! -----------------------
2254 
2255  n2o_a_ad = n2o_a_ad &
2256  + predictor_ad%X(k, 1, comp_n2o_ir)*dt &
2257  + predictor_ad%X(k, 4, comp_n2o_ir)*point_25*n2o_a**(-point_75) &
2258  + predictor_ad%X(k, 5, comp_n2o_ir)
2259 
2260  dt_ad = dt_ad &
2261  + predictor_ad%X(k, 1, comp_n2o_ir)*n2o_a &
2262  + predictor_ad%X(k, 3, comp_n2o_ir)*n2o
2263 
2264  n2o_r_ad = n2o_r_ad &
2265  + predictor_ad%X(k, 2, comp_n2o_ir) &
2266  + predictor_ad%X(k,10, comp_n2o_ir)*n2o/pafv%GAzp(k, abs_n2o_ir)
2267 
2268  n2o_ad = n2o_ad &
2269  + predictor_ad%X(k, 3, comp_n2o_ir)*dt &
2270  + predictor_ad%X(k,10, comp_n2o_ir)*n2o_r/pafv%GAzp(k, abs_n2o_ir)
2271 
2272  gazp_ad(k, abs_n2o_ir) = gazp_ad(k, abs_n2o_ir) &
2273  + predictor_ad%X(k, 6, comp_n2o_ir)*secang(k) &
2274  - predictor_ad%X(k,10, comp_n2o_ir)*n2o_r*n2o/pafv%GAzp(k, abs_n2o_ir)**2
2275 
2276  gatzp_ad(k, abs_n2o_ir) = gatzp_ad(k, abs_n2o_ir) &
2277  + predictor_ad%X(k, 7, comp_n2o_ir)*secang(k) &
2278  + predictor_ad%X(k, 9, comp_n2o_ir)
2279 
2280  n2o_s_ad = n2o_s_ad + predictor_ad%X(k, 8, comp_n2o_ir)
2281 
2282  ch4_a_ad = ch4_a_ad &
2283  + predictor_ad%X(k,11, comp_n2o_ir) &
2284  + predictor_ad%X(k,12, comp_n2o_ir)*pafv%GAzp(k, abs_ch4_ir)
2285 
2286  gazp_ad(k, abs_ch4_ir) = gazp_ad(k, abs_ch4_ir) &
2287  + predictor_ad%X(k,12, comp_n2o_ir)*ch4_a
2288 
2289  co_a_ad = co_a_ad &
2290  + predictor_ad%X(k,13, comp_n2o_ir) &
2291  + predictor_ad%X(k,14, comp_n2o_ir)*secang(k)*pafv%GAzp(k, abs_co_ir)
2292 
2293  gazp_ad(k, abs_co_ir) = gazp_ad(k, abs_co_ir) &
2294  + predictor_ad%X(k,14, comp_n2o_ir)*co_a*secang(k)
2295 
2296  predictor_ad%X(k, 1, comp_n2o_ir) = zero
2297  predictor_ad%X(k, 2, comp_n2o_ir) = zero
2298  predictor_ad%X(k, 3, comp_n2o_ir) = zero
2299  predictor_ad%X(k, 4, comp_n2o_ir) = zero
2300  predictor_ad%X(k, 5, comp_n2o_ir) = zero
2301  predictor_ad%X(k, 6, comp_n2o_ir) = zero
2302  predictor_ad%X(k, 7, comp_n2o_ir) = zero
2303  predictor_ad%X(k, 8, comp_n2o_ir) = zero
2304  predictor_ad%X(k, 9, comp_n2o_ir) = zero
2305  predictor_ad%X(k,10, comp_n2o_ir) = zero
2306 
2307  predictor_ad%X(k,11, comp_n2o_ir) = zero
2308  predictor_ad%X(k,12, comp_n2o_ir) = zero
2309  predictor_ad%X(k,13, comp_n2o_ir) = zero
2310  predictor_ad%X(k,14, comp_n2o_ir) = zero
2311 
2312  END IF if_group1
2313 
2314  IF( group_id == group_1 )THEN
2315 
2316  gazp_ad(k, abs_ch4_ir) = gazp_ad(k, abs_ch4_ir) + secang(k)*ch4_ach4zp_ad
2317  ch4_a_ad = ch4_a_ad + (point_5/sqrt(ch4_a)) * ch4_r_ad
2318  ch4_ad = ch4_ad + secang(k)*ch4_a_ad
2319  ch4_ach4zp_ad = zero
2320  ch4_r_ad = zero
2321  ch4_a_ad = zero
2322 
2323  gazp_ad(k, abs_co_ir) = gazp_ad(k, abs_co_ir) &
2324  - co_acodcozp_ad*co_a*co/pafv%GAzp(k, abs_co_ir)**2
2325  co_a_ad = co_a_ad + co_acodcozp_ad*co/pafv%GAzp(k, abs_co_ir) &
2326  + co_s_ad*two * co_a &
2327  + co_r_ad*point_5/sqrt(co_a)
2328  co_ad = co_ad + co_acodcozp_ad*co_a/pafv%GAzp(k, abs_co_ir) &
2329  + co_a_ad*secang(k)
2330  co_acodcozp_ad = zero
2331  co_s_ad = zero
2332  co_r_ad = zero
2333  co_a_ad = zero
2334 
2335  n2o_a_ad = n2o_a_ad + n2o_r_ad * point_5 / sqrt(n2o_a) &
2336  + n2o_s_ad * two * n2o_a
2337  n2o_ad = n2o_ad + n2o_a_ad * secang(k)
2338  n2o_a_ad = zero
2339  n2o_r_ad = zero
2340  n2o_s_ad = zero
2341 
2342  absorber_ad(k,abs_ch4_ir) = absorber_ad(k,abs_ch4_ir) &
2343  + ch4_ad/ref_absorber(k,abs_ch4_ir)
2344  absorber_ad(k,abs_n2o_ir) = absorber_ad(k,abs_n2o_ir) &
2345  + n2o_ad/ref_absorber(k,abs_n2o_ir)
2346  absorber_ad(k,abs_co_ir) = absorber_ad(k,abs_co_ir) &
2347  + co_ad/ref_absorber(k, abs_co_ir)
2348  co_ad = zero
2349  n2o_ad = zero
2350  ch4_ad = zero
2351 
2352  END IF
2353 
2354  ! Combinations of variables common to all predictor groups
2355 
2356  o3_a_ad = o3_a_ad + o3_r_ad * point_5 / sqrt(o3_a)
2357  o3_ad = o3_ad + o3_a_ad * secang(k)
2358  o3_a_ad = zero
2359  o3_r_ad = zero
2360 
2361  gatzp_ad(k, abs_h2o_ir) = gatzp_ad(k, abs_h2o_ir) &
2362  - h2odh2otzp_ad*h2o/pafv%GATzp(k, abs_h2o_ir)**2
2363  h2o_r_ad = h2o_r_ad + h2o_r4_ad * point_5 / sqrt(h2o_r)
2364  h2o_a_ad = h2o_a_ad + h2o_s_ad * two * h2o_a &
2365  + h2o_r_ad * point_5 / sqrt(h2o_a)
2366  h2o_ad = h2o_ad + h2o_a_ad * secang(k) &
2367  + h2odh2otzp_ad / pafv%GATzp(k, abs_h2o_ir)
2368 
2369  h2o_a_ad = zero
2370  h2o_r_ad = zero
2371  h2o_s_ad = zero
2372  h2o_r4_ad = zero
2373  h2odh2otzp_ad = zero
2374 
2375  IF( dt > zero) THEN
2376  dt_ad = dt_ad + dt2_ad*two*dt
2377  ELSE
2378  dt_ad = dt_ad - dt2_ad*two*dt
2379  ENDIF
2380  t_ad = t_ad + t2_ad*two*t
2381  t2_ad = zero
2382  dt2_ad = zero
2383 
2384  !-------------------------------------------
2385  ! Abosrber amount scalled by the reference
2386  !-------------------------------------------
2387  absorber_ad(k,abs_co2_ir) = absorber_ad(k,abs_co2_ir) &
2388  + co2_ad / ref_absorber(k,abs_co2_ir)
2389  absorber_ad(k,abs_o3_ir) = absorber_ad(k,abs_o3_ir) &
2390  + o3_ad / ref_absorber(k,abs_o3_ir)
2391  absorber_ad(k,abs_h2o_ir) = absorber_ad(k,abs_h2o_ir) &
2392  + h2o_ad / ref_absorber(k, abs_h2o_ir)
2393  h2o_ad = zero
2394  o3_ad = zero
2395  co2_ad = zero
2396 
2397  !------------------------------------------
2398  ! Relative Temperature
2399  !------------------------------------------
2400  temperature_ad(k) = temperature_ad(k) + t_ad/ref_temperature(k) &
2401  + dt_ad
2402  dt_ad = zero
2403  t_ad = zero
2404 
2405  END DO layer_loop
2406 
2407  END SUBROUTINE odps_compute_predictor_ir_ad
2408 
2409  SUBROUTINE odps_compute_predictor_mw_ad()
2410 
2411  ! ---------------
2412  ! Local variables
2413  ! ---------------
2414  INTEGER :: k ! n_Layers, n_Levels
2415  REAL(fp) :: DT, DT_AD
2416  REAL(fp) :: T, T_AD
2417  REAL(fp) :: T2, T2_AD
2418  REAL(fp) :: DT2, DT2_AD
2419  REAL(fp) :: H2O, H2O_AD
2420  REAL(fp) :: H2O_A, H2O_A_AD
2421  REAL(fp) :: H2O_R, H2O_R_AD
2422  REAL(fp) :: H2O_S, H2O_S_AD
2423  REAL(fp) :: H2O_R4, H2O_R4_AD
2424  REAL(fp) :: H2OdH2OTzp, H2OdH2OTzp_AD
2425 
2426  dt_ad = zero
2427  t_ad = zero
2428  t2_ad = zero
2429  dt2_ad = zero
2430  h2o_ad = zero
2431  h2o_a_ad = zero
2432  h2o_r_ad = zero
2433  h2o_s_ad = zero
2434  h2o_r4_ad = zero
2435  h2odh2otzp_ad = zero
2436 
2437  layer_loop : DO k = n_layers, 1, -1
2438 
2439  !------------------------------------------
2440  ! Relative Temperature
2441  !------------------------------------------
2442  dt = temperature(k) - ref_temperature(k)
2443  t = temperature(k) / ref_temperature(k)
2444 
2445  !-------------------------------------------
2446  ! Abosrber amount scalled by the reference
2447  !-------------------------------------------
2448  h2o = absorber(k,abs_h2o_mw)/ref_absorber(k, abs_h2o_mw)
2449 
2450  ! Combinations of variables common to all predictor groups
2451  t2 = t*t
2452  dt2 = dt*abs( dt )
2453 
2454  h2o_a = secang(k)*h2o
2455  h2o_r = sqrt( h2o_a )
2456  h2o_s = h2o_a*h2o_a
2457  h2o_r4 = sqrt( h2o_r )
2458  h2odh2otzp = h2o/pafv%GATzp(k, abs_h2o_mw)
2459 
2460  !#-------------------------------------------------------------------#
2461  !# -- Predictors -- #
2462  !#-------------------------------------------------------------------#
2463 
2464  ! set number of predictors
2465  predictor_ad%n_CP = n_predictors_g3
2466 
2467  ! ----------------------
2468  ! Fixed (Dry) predictors
2469  ! ----------------------
2470 
2471  t_ad = t_ad &
2472  + predictor_ad%X(k, 2, comp_dry_mw)*secang(k) &
2473  + predictor_ad%X(k, 4, comp_dry_mw)
2474 
2475  t2_ad = t2_ad &
2476  + predictor_ad%X(k, 3, comp_dry_mw)*secang(k) &
2477  + predictor_ad%X(k, 6, comp_dry_mw)
2478 
2479  tz_ad(k) = tz_ad(k) + predictor_ad%X(k, 7, comp_dry_mw)
2480 
2481  predictor_ad%X(k, 1, comp_dry_mw) = zero
2482  predictor_ad%X(k, 2, comp_dry_mw) = zero
2483  predictor_ad%X(k, 3, comp_dry_mw) = zero
2484  predictor_ad%X(k, 4, comp_dry_mw) = zero
2485  predictor_ad%X(k, 5, comp_dry_mw) = zero
2486  predictor_ad%X(k, 6, comp_dry_mw) = zero
2487  predictor_ad%X(k, 7, comp_dry_mw) = zero
2488 
2489  ! --------------------------------
2490  ! Water vapor (line and continuum)
2491  ! --------------------------------
2492 
2493  h2o_a_ad = h2o_a_ad &
2494  + predictor_ad%X(k, 1, comp_wet_mw)/t &
2495  + predictor_ad%X(k, 2, comp_wet_mw)*h2o/t &
2496  + predictor_ad%X(k, 3, comp_wet_mw)*h2o/t2**2 &
2497  + predictor_ad%X(k, 4, comp_wet_mw)/t2 &
2498  + predictor_ad%X(k, 5, comp_wet_mw)*h2o/t2 &
2499  + predictor_ad%X(k, 6, comp_wet_mw)/t2**2 &
2500  + predictor_ad%X(k, 7, comp_wet_mw) &
2501  + predictor_ad%X(k, 8, comp_wet_mw)*dt &
2502  + predictor_ad%X(k,12, comp_wet_mw)*h2o_s
2503 
2504  t_ad = t_ad &
2505  - predictor_ad%X(k, 1, comp_wet_mw)*h2o_a/t**2 &
2506  - predictor_ad%X(k, 2, comp_wet_mw)*h2o_a*h2o/t**2
2507 
2508  h2o_ad = h2o_ad &
2509  + predictor_ad%X(k, 2, comp_wet_mw)*h2o_a/t &
2510  + predictor_ad%X(k, 3, comp_wet_mw)*h2o_a/t2**2 &
2511  + predictor_ad%X(k, 5, comp_wet_mw)*h2o_a/t2
2512 
2513  t2_ad = t2_ad &
2514  - predictor_ad%X(k, 3, comp_wet_mw)*two*h2o_a*h2o/t2**3 &
2515  - predictor_ad%X(k, 4, comp_wet_mw)*h2o_a/t2**2 &
2516  - predictor_ad%X(k, 5, comp_wet_mw)*h2o_a*h2o/t2**2 &
2517  - predictor_ad%X(k, 6, comp_wet_mw)*two*h2o_a/t2**3
2518 
2519  dt_ad = dt_ad + predictor_ad%X(k, 8, comp_wet_mw)*h2o_a
2520 
2521  gazp_ad(k,abs_h2o_mw) = gazp_ad(k,abs_h2o_mw) &
2522  + predictor_ad%X(k, 9, comp_wet_mw)*two*secang(k)**2*pafv%GAzp(k,abs_h2o_mw) &
2523  + predictor_ad%X(k, 10,comp_wet_mw)*secang(k)
2524 
2525  h2o_s_ad = h2o_s_ad &
2526  + predictor_ad%X(k, 12,comp_wet_mw)*h2o_a &
2527  + predictor_ad%X(k, 13,comp_wet_mw)*two*h2o_s
2528 
2529  h2odh2otzp_ad = h2odh2otzp_ad + predictor_ad%X(k, 14,comp_wet_mw)
2530 
2531  predictor_ad%X(k, 1, comp_wet_mw) = zero
2532  predictor_ad%X(k, 2, comp_wet_mw) = zero
2533  predictor_ad%X(k, 3, comp_wet_mw) = zero
2534  predictor_ad%X(k, 4, comp_wet_mw) = zero
2535  predictor_ad%X(k, 5, comp_wet_mw) = zero
2536  predictor_ad%X(k, 6, comp_wet_mw) = zero
2537  predictor_ad%X(k, 7, comp_wet_mw) = zero
2538  predictor_ad%X(k, 8, comp_wet_mw) = zero
2539  predictor_ad%X(k, 9, comp_wet_mw) = zero
2540  predictor_ad%X(k, 10,comp_wet_mw) = zero
2541  predictor_ad%X(k, 11,comp_wet_mw) = zero
2542  predictor_ad%X(k, 12,comp_wet_mw) = zero
2543  predictor_ad%X(k, 13,comp_wet_mw) = zero
2544  predictor_ad%X(k, 14,comp_wet_mw) = zero
2545 
2546  !-------------------------------------------
2547  ! Abosrber amount scalled by the reference
2548  !-------------------------------------------
2549 
2550  ! Combinations of variables common to all predictor groups
2551 
2552  gatzp_ad(k, abs_h2o_mw) = gatzp_ad(k, abs_h2o_mw) &
2553  - h2odh2otzp_ad*h2o/pafv%GATzp(k, abs_h2o_mw)**2
2554  h2o_r_ad = h2o_r_ad + h2o_r4_ad * point_5 / sqrt(h2o_r)
2555  h2o_a_ad = h2o_a_ad + h2o_s_ad * two * h2o_a &
2556  + h2o_r_ad * point_5 / sqrt(h2o_a)
2557  h2o_ad = h2o_ad + h2o_a_ad * secang(k) &
2558  + h2odh2otzp_ad / pafv%GATzp(k, abs_h2o_mw)
2559  h2o_a_ad = zero
2560  h2o_r_ad = zero
2561  h2o_s_ad = zero
2562  h2o_r4_ad = zero
2563  h2odh2otzp_ad = zero
2564 
2565  IF( dt > zero) THEN
2566  dt_ad = dt_ad + dt2_ad*two*dt
2567  ELSE
2568  dt_ad = dt_ad - dt2_ad*two*dt
2569  ENDIF
2570  t_ad = t_ad + t2_ad*two*t
2571  t2_ad = zero
2572  dt2_ad = zero
2573 
2574  absorber_ad(k,abs_h2o_mw) = absorber_ad(k,abs_h2o_mw) &
2575  + h2o_ad / ref_absorber(k, abs_h2o_mw)
2576  h2o_ad = zero
2577 
2578  !------------------------------------------
2579  ! Relative Temperature
2580  !------------------------------------------
2581  temperature_ad(k) = temperature_ad(k) + t_ad/ref_temperature(k) &
2582  + dt_ad
2583  dt_ad = zero
2584  t_ad = zero
2585 
2586  END DO layer_loop
2587 
2588  END SUBROUTINE odps_compute_predictor_mw_ad
2589 
2590  END SUBROUTINE odps_compute_predictor_ad
2591 
2592 !============================== END OF AD
2593 
2594 !------------------------------------------------------------------------------
2595 !
2596 ! NAME:
2597 ! ODPS_Compute_Predictor_ODAS
2598 !
2599 ! PURPOSE:
2600 ! Subroutine to compute ODAS predictors for water vapor line
2601 ! absorption.
2602 !
2603 ! CALLING SEQUENCE:
2604 ! CALL ODPS_Compute_Predictor_ODAS( &
2605 ! Temperature, & ! Input
2606 ! vapor, & ! Inpt
2607 ! Level_Pressure, & ! Input
2608 ! Pressure, & ! Input
2609 ! secant_angle, & ! Input
2610 ! Alpha, & ! Input
2611 ! Alpha_C1, & ! Input
2612 ! Alpha_C2, & ! Input
2613 ! Predictor) ! In/Output
2614 !
2615 ! INPUT ARGUMENTS:
2616 !
2617 ! Temperature: Temperature profile
2618 ! UNITS: K
2619 ! TYPE: REAL(fp)
2620 ! DIMENSION: Rank-1(n_Layers) array
2621 ! ATTRIBUTES: INTENT(IN)
2622 !
2623 ! Vapor : Water vapor mixing ratio profile
2624 ! UNITS: g/kg
2625 ! TYPE: REAL(fp)
2626 ! DIMENSION: Rank-1(n_Layers) array
2627 ! ATTRIBUTES: INTENT(IN)
2628 !
2629 ! Level_Pressure : level pressure profile
2630 ! UNITS: hPa
2631 ! TYPE: REAL(fp)
2632 ! DIMENSION: Rank-1(0:n_Layers) array
2633 ! ATTRIBUTES: INTENT(IN)
2634 !
2635 ! Pressure : Layer pressure profile
2636 ! UNITS: hPa
2637 ! TYPE: REAL(fp)
2638 ! DIMENSION: Rank-1(n_Layers) array
2639 ! ATTRIBUTES: INTENT(IN)
2640 !
2641 ! secang_angle : Secant sensor zenith angle profile
2642 ! UNITS: N/A
2643 ! TYPE: REAL(fp)
2644 ! DIMENSION: Rank-1(n_Layers) array
2645 ! ATTRIBUTES: INTENT(IN)
2646 !
2647 ! Alpha, Alpha_C1, Alpha_C2 : Coefficients for converting water vapor integrated amount
2648 ! to ODAS water vapor regression space
2649 ! UNITS: N/A
2650 ! TYPE: REAL(fp)
2651 ! DIMENSION: Scalar
2652 ! ATTRIBUTES: INTENT(IN)
2653 ! IN/OUTPUT ARGUMENTS:
2654 ! Predictor: Predictor structure containing the integrated absorber
2655 ! and predictor profiles.
2656 ! UNITS: N/A
2657 ! TYPE: ODPS_Predictor_type
2658 ! DIMENSION: Scalar
2659 ! ATTRIBUTES: INTENT(IN OUT)
2660 !
2661 !------------------------------------------------------------------------------
2662 
2663  SUBROUTINE odps_compute_predictor_odas(&
2664  Temperature, &
2665  Vapor, &
2666  Level_Pressure, &
2667  Pressure, &
2668  secant_angle, &
2669  Alpha, &
2670  Alpha_C1, &
2671  Alpha_C2, &
2672  Predictor)
2673  REAL(fp), INTENT(IN) :: temperature(:)
2674  REAL(fp), INTENT(IN) :: vapor(:)
2675  REAL(fp), INTENT(IN) :: level_pressure(0:)
2676  REAL(fp), INTENT(IN) :: pressure(:)
2677  REAL(fp), INTENT(IN) :: secant_angle(:)
2678  REAL(fp), INTENT(IN) :: alpha
2679  REAL(fp), INTENT(IN) :: alpha_c1
2680  REAL(fp), INTENT(IN) :: alpha_c2
2681  TYPE(odps_predictor_type), INTENT(IN OUT) :: predictor
2682 
2683  !Local
2684  REAL(fp), DIMENSION(0:Predictor%n_Layers) :: xl_t, xl_p
2685  REAL(fp) :: t2, p2, s_t, s_p, inverse, dpong, d_absorber
2686  REAL(fp) :: int_vapor_prev, int_vapor, avea, ap1
2687  INTEGER :: i, k
2688 
2689  ! Regular predictors
2690  DO k = 1, predictor%n_Layers
2691  t2 = temperature(k)*temperature(k)
2692  p2 = pressure(k)*pressure(k)
2693  predictor%OX(k, 1) = temperature(k)
2694  predictor%OX(k, 2) = pressure(k)
2695  predictor%OX(k, 3) = t2
2696  predictor%OX(k, 4) = p2
2697  predictor%OX(k, 5) = temperature(k) * pressure(k)
2698  predictor%OX(k, 6) = t2 * pressure(k)
2699  predictor%OX(k, 7) = temperature(k) * p2
2700  predictor%OX(k, 8) = t2 * p2
2701  predictor%OX(k, 9) = pressure(k)**point_25
2702  predictor%OX(k, 10) = vapor(k)
2703  predictor%OX(k, 11) = vapor(k)/t2
2704  predictor%OX(k, 14) = secant_angle(k)
2705  END DO
2706 
2707  ! Integrated predictors
2708  int_vapor_prev = zero
2709  s_t = zero
2710  s_p = zero
2711  xl_t(0) = zero
2712  xl_p(0) = zero
2713 
2714  DO k = 1, predictor%n_Layers
2715 
2716  dpong = reciprocal_gravity * (level_pressure(k) - level_pressure(k-1))
2717  d_absorber = dpong*vapor(k)*secant_angle(k)
2718  int_vapor = int_vapor_prev + d_absorber
2719  avea = point_5 * (int_vapor_prev + int_vapor)
2720 
2721  predictor%dA(k) = d_absorber
2722 
2723  s_t = s_t + ( temperature( k ) * d_absorber ) ! T*
2724  s_p = s_p + ( pressure( k ) * d_absorber ) ! P*
2725 
2726  IF ( int_vapor > minimum_absorber_amount ) THEN
2727  inverse = one / int_vapor
2728  ELSE
2729  inverse = zero
2730  END IF
2731 
2732  xl_t(k) = point_5 * s_t * inverse
2733  xl_p(k) = point_5 * s_p * inverse
2734 
2735  predictor%OX(k, 12) = xl_t(k) + xl_t(k-1)
2736  predictor%OX(k, 13) = xl_p(k) + xl_p(k-1)
2737 
2738  ap1 = log((avea - alpha_c2) / alpha_c1) / &
2739  ! ----------------------------------------------
2740  alpha
2741 
2742  predictor%Ap(k, 1) = ap1
2743  DO i = 2, max_optran_order
2744  predictor%Ap(k, i) = predictor%Ap(k, i-1) * ap1
2745  END DO
2746 
2747  int_vapor_prev = int_vapor
2748 
2749  ! Save variables for TL and AD routines
2750  IF(predictor%PAFV%OPTRAN)THEN
2751  predictor%PAFV%dPonG(k) = dpong
2752  predictor%PAFV%d_Absorber(k) = d_absorber
2753  predictor%PAFV%Int_vapor(k) = int_vapor
2754  predictor%PAFV%AveA(k) = avea
2755  predictor%PAFV%Inverse(k) = inverse
2756  predictor%PAFV%s_t(k) = s_t
2757  predictor%PAFV%s_p(k) = s_p
2758  predictor%PAFV%Ap1(k) = ap1
2759  END IF
2760 
2761  END DO
2762 
2763  END SUBROUTINE odps_compute_predictor_odas
2764 
2765 !------------------------------------------------------------------------------
2766 !
2767 ! NAME:
2768 ! ODPS_Compute_Predictor_ODAS_TL
2769 !
2770 ! PURPOSE:
2771 ! Subroutine to compute TL ODAS predictors for water vapor line
2772 ! absorption.
2773 !
2774 ! CALLING SEQUENCE:
2775 ! CALL ODPS_Compute_Predictor_ODAS_TL( &
2776 ! Temperature, & ! Input
2777 ! vapor, & ! Inpt
2778 ! Pressure, & ! Input
2779 ! secant_angle, & ! Input
2780 ! Alpha, & ! Input
2781 ! Alpha_C2, & ! Input
2782 ! Predictor, & ! Input
2783 ! Temperature_TL, & ! Input
2784 ! Vapor_TL, & ! Input
2785 ! Predictor_TL) ! Output
2786 !
2787 ! INPUT ARGUMENTS:
2788 !
2789 ! Temperature: Temperature profile
2790 ! UNITS: K
2791 ! TYPE: REAL(fp)
2792 ! DIMENSION: Rank-1(n_Layers) array
2793 ! ATTRIBUTES: INTENT(IN)
2794 !
2795 ! Vapor : Water vapor mixing ratio profile
2796 ! UNITS: g/kg
2797 ! TYPE: REAL(fp)
2798 ! DIMENSION: Rank-1(n_Layers) array
2799 ! ATTRIBUTES: INTENT(IN)
2800 !
2801 ! Pressure : Layer pressure profile
2802 ! UNITS: hPa
2803 ! TYPE: REAL(fp)
2804 ! DIMENSION: Rank-1(n_Layers) array
2805 ! ATTRIBUTES: INTENT(IN)
2806 !
2807 ! secang_angle : Secant sensor zenith angle profile
2808 ! UNITS: N/A
2809 ! TYPE: REAL(fp)
2810 ! DIMENSION: Rank-1(n_Layers) array
2811 ! ATTRIBUTES: INTENT(IN)
2812 !
2813 ! Alpha, Alpha_C2 : Coefficients for converting water vapor integrated amount
2814 ! to ODAS water vapor regression space
2815 ! UNITS: N/A
2816 ! TYPE: REAL(fp)
2817 ! DIMENSION: Scalar
2818 ! ATTRIBUTES: INTENT(IN)
2819 !
2820 ! Predictor: Predictor structure containing the integrated absorber
2821 ! and predictor profiles.
2822 ! UNITS: N/A
2823 ! TYPE: ODPS_Predictor_type
2824 ! DIMENSION: Scalar
2825 ! ATTRIBUTES: INTENT(IN)
2826 !
2827 ! Temperature_TL: TL Temperature profile
2828 ! UNITS: K
2829 ! TYPE: REAL(fp)
2830 ! DIMENSION: Rank-1(n_Layers) array
2831 ! ATTRIBUTES: INTENT(IN)
2832 !
2833 ! Vapor_TL : TL water vapor mixing ratio profile
2834 ! UNITS: g/kg
2835 ! TYPE: REAL(fp)
2836 ! DIMENSION: Rank-1(n_Layers) array
2837 ! ATTRIBUTES: INTENT(IN)
2838 !
2839 ! IN/OUTPUT ARGUMENTS:
2840 ! Predictor_TL: TL Predictor structure containing the integrated absorber
2841 ! and predictor profiles.
2842 ! UNITS: N/A
2843 ! TYPE: ODPS_Predictor_type
2844 ! DIMENSION: Scalar
2845 ! ATTRIBUTES: INTENT(IN OUT)
2846 !
2847 !------------------------------------------------------------------------------
2848 
2849  SUBROUTINE odps_compute_predictor_odas_tl( &
2850  Temperature, &
2851  Vapor, &
2852  Pressure, &
2853  secant_angle, &
2854  Alpha, &
2855  Alpha_C2, &
2856  Predictor, &
2857  Temperature_TL, &
2858  Vapor_TL, &
2859  Predictor_TL)
2860 
2861  REAL(fp), INTENT(IN) :: temperature(:)
2862  REAL(fp), INTENT(IN) :: vapor(:)
2863  REAL(fp), INTENT(IN) :: pressure(:)
2864  REAL(fp), INTENT(IN) :: secant_angle(:)
2865  REAL(fp), INTENT(IN) :: alpha
2866  REAL(fp), INTENT(IN) :: alpha_c2
2867  TYPE(odps_predictor_type), TARGET, INTENT(IN) :: predictor
2868  REAL(fp), INTENT(IN) :: temperature_tl(:)
2869  REAL(fp), INTENT(IN) :: vapor_tl(:)
2870  TYPE(odps_predictor_type), INTENT(IN OUT) :: predictor_tl
2871 
2872  !Local
2873  REAL(fp), DIMENSION(0:Predictor%n_Layers) :: xl_t_tl, xl_p_tl
2874  REAL(fp) :: t2, p2, &
2875  t2_tl, s_t_tl, s_p_tl, inverse_tl, d_absorber_tl
2876  REAL(fp) :: int_vapor_prev_tl, int_vapor_tl, avea_tl, ap1_tl
2877  INTEGER :: i, k
2878  TYPE(pafv_type), POINTER :: pafv => null()
2879 
2880  ! short name
2881  pafv => predictor%PAFV
2882 
2883  ! Regular predictors
2884  DO k = 1, predictor%n_Layers
2885  t2 = temperature(k)*temperature(k)
2886  p2 = pressure(k)*pressure(k)
2887  t2_tl = two*temperature(k)*temperature_tl(k)
2888  predictor_tl%OX(k, 1) = temperature_tl(k)
2889  predictor_tl%OX(k, 2) = zero
2890  predictor_tl%OX(k, 3) = t2_tl
2891  predictor_tl%OX(k, 4) = zero
2892  predictor_tl%OX(k, 5) = temperature_tl(k) * pressure(k)
2893  predictor_tl%OX(k, 6) = t2_tl * pressure(k)
2894  predictor_tl%OX(k, 7) = temperature_tl(k) * p2
2895  predictor_tl%OX(k, 8) = t2_tl * p2
2896  predictor_tl%OX(k, 9) = zero
2897  predictor_tl%OX(k, 10) = vapor_tl(k)
2898  predictor_tl%OX(k, 11) = vapor_tl(k)/t2 - (vapor(k)/t2**2)*t2_tl
2899  predictor_tl%OX(k, 14) = zero
2900  END DO
2901 
2902  ! Integrated predictors
2903 
2904  int_vapor_prev_tl = zero
2905  s_t_tl = zero
2906  s_p_tl = zero
2907  xl_t_tl(0) = zero
2908  xl_p_tl(0) = zero
2909 
2910  DO k = 1, predictor%n_Layers
2911 
2912  d_absorber_tl = pafv%dPonG(k)*vapor_tl(k)*secant_angle(k)
2913 
2914  int_vapor_tl = int_vapor_prev_tl + d_absorber_tl
2915  avea_tl = point_5 * (int_vapor_prev_tl + int_vapor_tl)
2916 
2917  predictor_tl%dA(k) = d_absorber_tl
2918 
2919  s_t_tl = s_t_tl + ( temperature_tl( k )*pafv%d_Absorber(k) + temperature( k )*d_absorber_tl)
2920  s_p_tl = s_p_tl + ( pressure( k )*d_absorber_tl )
2921 
2922  IF ( pafv%Int_vapor(k) > minimum_absorber_amount ) THEN
2923  inverse_tl = -(one/pafv%Int_vapor(k)**2)*int_vapor_tl
2924  ELSE
2925  inverse_tl = zero
2926  END IF
2927 
2928  xl_t_tl(k) = point_5 * (s_t_tl*pafv%Inverse(k) + pafv%s_t(k)*inverse_tl)
2929  xl_p_tl(k) = point_5 * (s_p_tl*pafv%Inverse(k) + pafv%s_p(k)*inverse_tl)
2930 
2931  predictor_tl%OX(k, 12) = xl_t_tl(k) + xl_t_tl(k-1)
2932  predictor_tl%OX(k, 13) = xl_p_tl(k) + xl_p_tl(k-1)
2933 
2934  ap1_tl = avea_tl / &
2935  ! -----------------------------------
2936  ( alpha * (pafv%aveA(k) - alpha_c2 ) )
2937 
2938  predictor_tl%Ap(k, 1) = ap1_tl
2939 
2940  DO i = 2, max_optran_order
2941  predictor_tl%Ap(k, i) = predictor_tl%Ap(k, i-1)*pafv%Ap1(k) + predictor%Ap(k, i-1)*ap1_tl
2942  END DO
2943 
2944  int_vapor_prev_tl = int_vapor_tl
2945 
2946  END DO
2947 
2948  END SUBROUTINE odps_compute_predictor_odas_tl
2949 
2950 !------------------------------------------------------------------------------
2951 !
2952 ! NAME:
2953 ! ODPS_Compute_Predictor_ODAS_AD
2954 !
2955 ! PURPOSE:
2956 ! Subroutine to compute AD ODAS predictors for water vapor line
2957 ! absorption.
2958 !
2959 ! CALLING SEQUENCE:
2960 ! CALL ODPS_Compute_Predictor_ODAS_AD( &
2961 ! Temperature, & ! Input
2962 ! vapor, & ! Inpt
2963 ! Pressure, & ! Input
2964 ! secant_angle, & ! Input
2965 ! Alpha, & ! Input
2966 ! Alpha_C2, & ! Input
2967 ! Predictor, & ! Input
2968 ! Predictor_AD, & ! Input
2969 ! Temperature_AD, & ! Input
2970 ! Vapor_AD) ! Input
2971 !
2972 ! INPUT ARGUMENTS:
2973 !
2974 ! Temperature: Temperature profile
2975 ! UNITS: K
2976 ! TYPE: REAL(fp)
2977 ! DIMENSION: Rank-1(n_Layers) array
2978 ! ATTRIBUTES: INTENT(IN)
2979 !
2980 ! Vapor : Water vapor mixing ratio profile
2981 ! UNITS: g/kg
2982 ! TYPE: REAL(fp)
2983 ! DIMENSION: Rank-1(n_Layers) array
2984 ! ATTRIBUTES: INTENT(IN)
2985 !
2986 ! Pressure : Layer pressure profile
2987 ! UNITS: hPa
2988 ! TYPE: REAL(fp)
2989 ! DIMENSION: Rank-1(n_Layers) array
2990 ! ATTRIBUTES: INTENT(IN)
2991 !
2992 ! secang_angle : Secant sensor zenith angle profile
2993 ! UNITS: N/A
2994 ! TYPE: REAL(fp)
2995 ! DIMENSION: Rank-1(n_Layers) array
2996 ! ATTRIBUTES: INTENT(IN)
2997 !
2998 ! Alpha, Alpha_C2 : Coefficients for converting water vapor integrated amount
2999 ! to ODAS water vapor regression space
3000 ! UNITS: N/A
3001 ! TYPE: REAL(fp)
3002 ! DIMENSION: Scalar
3003 ! ATTRIBUTES: INTENT(IN)
3004 !
3005 ! Predictor: Predictor structure containing the integrated absorber
3006 ! and predictor profiles.
3007 ! UNITS: N/A
3008 ! TYPE: ODPS_Predictor_type
3009 ! DIMENSION: Scalar
3010 ! ATTRIBUTES: INTENT(IN)
3011 !
3012 ! Predictor_aD: AD Predictor structure containing the integrated absorber
3013 ! and predictor profiles.
3014 ! UNITS: N/A
3015 ! TYPE: ODPS_Predictor_type
3016 ! DIMENSION: Scalar
3017 ! ATTRIBUTES: INTENT(IN)
3018 !
3019 ! IN/OUTPUT ARGUMENTS:
3020 ! Temperature_AD: AD Temperature profile
3021 ! UNITS: K
3022 ! TYPE: REAL(fp)
3023 ! DIMENSION: Rank-1(n_Layers) array
3024 ! ATTRIBUTES: INTENT(INoUT)
3025 !
3026 ! Vapor_AD : AD water vapor mixing ratio profile
3027 ! UNITS: g/kg
3028 ! TYPE: REAL(fp)
3029 ! DIMENSION: Rank-1(n_Layers) array
3030 ! ATTRIBUTES: INTENT(INOUT)
3031 !
3032 !------------------------------------------------------------------------------
3033 
3034  SUBROUTINE odps_compute_predictor_odas_ad( &
3035  Temperature, &
3036  Vapor, &
3037  Pressure, &
3038  secant_angle, &
3039  Alpha, &
3040  Alpha_C2, &
3041  Predictor, &
3042  Predictor_AD, &
3043  Temperature_AD, &
3044  Vapor_AD)
3045 
3046  REAL(fp), INTENT(IN) :: temperature(:)
3047  REAL(fp), INTENT(IN) :: vapor(:)
3048  REAL(fp), INTENT(IN) :: pressure(:)
3049  REAL(fp), INTENT(IN) :: secant_angle(:)
3050  REAL(fp), INTENT(IN) :: alpha
3051  REAL(fp), INTENT(IN) :: alpha_c2
3052  TYPE(odps_predictor_type), TARGET, INTENT(IN) :: predictor
3053  TYPE(odps_predictor_type), INTENT(IN OUT) :: predictor_ad
3054  REAL(fp), INTENT(IN OUT) :: temperature_ad(:)
3055  REAL(fp), INTENT(IN OUT) :: vapor_ad(:)
3056 
3057  !Local
3058  REAL(fp), DIMENSION(0:Predictor%n_Layers) :: xl_t_ad, xl_p_ad
3059  REAL(fp) :: t2, p2
3060  REAL(fp) :: t2_ad, s_t_ad, s_p_ad, inverse_ad, d_absorber_ad
3061  REAL(fp) :: int_vapor_prev_ad, int_vapor_ad, avea_ad, ap1_ad
3062  INTEGER :: i, k
3063  TYPE(pafv_type), POINTER :: pafv => null()
3064 
3065  ! short name
3066  pafv => predictor%PAFV
3067 
3068  ! Integrated predictors
3069 
3070  ! --- AD part
3071  int_vapor_prev_ad = zero
3072  int_vapor_ad = zero
3073  ap1_ad = zero
3074  avea_ad = zero
3075  xl_t_ad(predictor%n_Layers) = zero
3076  xl_p_ad(predictor%n_Layers) = zero
3077  s_t_ad = zero
3078  s_p_ad = zero
3079  inverse_ad = zero
3080  d_absorber_ad = zero
3081  DO k = predictor%n_Layers, 1, -1
3082 
3083  int_vapor_ad = int_vapor_ad + int_vapor_prev_ad
3084  int_vapor_prev_ad = zero
3085 
3086  DO i = max_optran_order, 2, -1
3087  ap1_ad = ap1_ad + predictor%Ap(k, i-1)*predictor_ad%Ap(k, i)
3088  predictor_ad%Ap(k, i-1) = predictor_ad%Ap(k, i-1) + pafv%Ap1(k)*predictor_ad%Ap(k, i)
3089  predictor_ad%Ap(k, i) = zero
3090  END DO
3091 
3092  ap1_ad = ap1_ad + predictor_ad%Ap(k, 1)
3093  predictor_ad%Ap(k, 1) = zero
3094 
3095  avea_ad = avea_ad + &
3096  ap1_ad / &
3097  ! -----------------------------------
3098  ( alpha * (pafv%aveA(k) - alpha_c2 ) )
3099  ap1_ad = zero
3100 
3101  xl_t_ad(k) = xl_t_ad(k) + predictor_ad%OX(k, 12)
3102  xl_t_ad(k-1) = predictor_ad%OX(k, 12) ! combine with initialization for xL_t_AD(k-1)
3103  predictor_ad%OX(k, 12) = zero
3104  xl_p_ad(k) = xl_p_ad(k) + predictor_ad%OX(k, 13)
3105  xl_p_ad(k-1) = predictor_ad%OX(k, 13) ! combine with initialization for xL_p_AD(k-1)
3106  predictor_ad%OX(k, 13) = zero
3107 
3108  s_p_ad = s_p_ad + point_5*pafv%Inverse(k)*xl_p_ad(k)
3109  inverse_ad = inverse_ad + point_5*pafv%s_p(k)*xl_p_ad(k)
3110  s_t_ad = s_t_ad + point_5*pafv%Inverse(k)*xl_t_ad(k)
3111  inverse_ad = inverse_ad + point_5*pafv%s_t(k)*xl_t_ad(k)
3112  xl_t_ad(k) = zero
3113  xl_p_ad(k) = zero
3114 
3115  IF ( pafv%Int_vapor(k) > minimum_absorber_amount ) THEN
3116  int_vapor_ad = int_vapor_ad -(one/pafv%Int_vapor(k)**2)*inverse_ad
3117  inverse_ad = zero
3118  ELSE
3119  inverse_ad = zero
3120  END IF
3121 
3122  d_absorber_ad = d_absorber_ad + pressure( k )*s_p_ad &
3123  + temperature( k )*s_t_ad
3124  temperature_ad( k ) = temperature_ad( k ) + pafv%d_Absorber(k)*s_t_ad
3125 
3126  d_absorber_ad = d_absorber_ad + predictor_ad%dA(k)
3127  predictor_ad%dA(k) = zero
3128 
3129  int_vapor_prev_ad = int_vapor_prev_ad + point_5 * avea_ad
3130  int_vapor_ad = int_vapor_ad + point_5 * avea_ad
3131  avea_ad = zero
3132 
3133  int_vapor_prev_ad = int_vapor_prev_ad + int_vapor_ad
3134  d_absorber_ad = d_absorber_ad + int_vapor_ad
3135  int_vapor_ad = zero
3136 
3137  vapor_ad(k) = vapor_ad(k) + pafv%dPonG(k)*d_absorber_ad*secant_angle(k)
3138  d_absorber_ad = zero
3139 
3140  END DO
3141 
3142 
3143  ! AD Regular predictors
3144  DO k = predictor%n_Layers, 1, -1
3145  t2 = temperature(k)*temperature(k)
3146  p2 = pressure(k)*pressure(k)
3147 
3148  temperature_ad(k) = temperature_ad(k) &
3149  + predictor_ad%OX(k, 1) &
3150  + pressure(k)* predictor_ad%OX(k, 5) &
3151  + p2* predictor_ad%OX(k, 7)
3152  t2_ad = predictor_ad%OX(k, 3) &
3153  + pressure(k)* predictor_ad%OX(k, 6) &
3154  + p2* predictor_ad%OX(k, 8) &
3155  - (vapor(k)/t2**2)* predictor_ad%OX(k, 11)
3156 
3157  vapor_ad(k) = vapor_ad(k) &
3158  + predictor_ad%OX(k, 10) &
3159  + predictor_ad%OX(k, 11)/t2
3160 
3161  predictor_ad%OX(k, 1:11) = zero
3162  predictor_ad%OX(k, 14) = zero
3163 
3164  temperature_ad(k) = temperature_ad(k) + two*temperature(k)*t2_ad
3165 
3166  END DO
3167 
3168  END SUBROUTINE odps_compute_predictor_odas_ad
3169 
3170 
3171  PURE FUNCTION odps_get_max_n_predictors( Group_Index ) RESULT( max_n_Predictors )
3172  INTEGER, INTENT( IN ) :: group_index
3173  INTEGER :: max_n_predictors
3174  max_n_predictors = max_n_predictors_g( group_index )
3175  END FUNCTION odps_get_max_n_predictors
3176 
3177 
3178  PURE FUNCTION odps_get_n_components( Group_Index ) RESULT( n_Components )
3179  INTEGER, INTENT( IN ) :: group_index
3180  INTEGER :: n_components
3181  n_components = n_components_g( group_index )
3182  END FUNCTION odps_get_n_components
3183 
3184 
3185  PURE FUNCTION odps_get_n_absorbers( Group_Index ) RESULT( n_Absorbers )
3186  INTEGER, INTENT( IN ) :: group_index
3187  INTEGER :: n_absorbers
3188  n_absorbers = n_absorbers_g( group_index )
3189  END FUNCTION odps_get_n_absorbers
3190 
3191 
3192  PURE FUNCTION odps_get_component_id(Component_Index, Group_Index) RESULT( Component_ID )
3193  INTEGER, INTENT( IN ) :: component_index
3194  INTEGER, INTENT( IN ) :: group_index
3195  INTEGER :: component_id
3196  SELECT CASE( group_index )
3197  CASE( group_1 )
3198  component_id = component_id_map_g1(component_index)
3199  CASE( group_2 )
3200  component_id = component_id_map_g2(component_index)
3201  CASE( group_3 )
3202  component_id = component_id_map_g3(component_index)
3203  END SELECT
3204  END FUNCTION odps_get_component_id
3205 
3206 
3207  PURE FUNCTION odps_get_absorber_id(Absorber_Index, Group_Index) RESULT( Absorber_ID )
3208  INTEGER, INTENT( IN ) :: absorber_index
3209  INTEGER, INTENT( IN ) :: group_index
3210  INTEGER :: absorber_id
3211  SELECT CASE( group_index )
3212  CASE( group_1 )
3213  absorber_id = absorber_id_map_g1(absorber_index)
3214  CASE( group_2 )
3215  absorber_id = absorber_id_map_g2(absorber_index)
3216  CASE( group_3 )
3217  absorber_id = absorber_id_map_g3(absorber_index)
3218  END SELECT
3219  END FUNCTION odps_get_absorber_id
3220 
3221 
3222  PURE FUNCTION odps_get_ozone_component_id(Group_Index) RESULT( Ozone_Component_ID )
3223  INTEGER, INTENT(IN) :: group_index
3224  INTEGER :: ozone_component_id
3225  IF( group_index == group_1 .OR. group_index == group_1)THEN
3226  ozone_component_id = ozo_comid
3227  ELSE
3228  ozone_component_id = -1
3229  END IF
3230  END FUNCTION odps_get_ozone_component_id
3231 
3232 
3233  ! This function gets a flag (true or false) indicating the
3234  ! need for saveing the FWD variables
3235  PURE FUNCTION odps_get_savefwvflag() RESULT(Flag)
3236  LOGICAL :: flag
3237  flag = .true.
3238  END FUNCTION odps_get_savefwvflag
3239 
3240 END MODULE odps_predictor
odps_predictor::wet_comid
integer, parameter, public wet_comid
Definition: ODPS_Predictor.f90:131
odps_predictor::one_point_25
real(fp), parameter one_point_25
Definition: ODPS_Predictor.f90:214
odps_predictor::wlo_comid
integer, parameter, public wlo_comid
Definition: ODPS_Predictor.f90:121
odps_predictor::co2_id
integer, parameter co2_id
Definition: ODPS_Predictor.f90:171
odps_predictor::n_predictors_g2
integer, dimension(5), parameter n_predictors_g2
Definition: ODPS_Predictor.f90:104
odps_predictor::ten
real(fp), parameter ten
Definition: ODPS_Predictor.f90:209
odps_predictor::ch4_comid
integer, parameter ch4_comid
Definition: ODPS_Predictor.f90:127
odps_predictor::odps_compute_predictor_odas_tl
subroutine, public odps_compute_predictor_odas_tl(Temperature, Vapor, Pressure, secant_angle, Alpha, Alpha_C2, Predictor, Temperature_TL, Vapor_TL, Predictor_TL)
Definition: ODPS_Predictor.f90:2860
odps_compute_predictor_ir_tl
subroutine odps_compute_predictor_ir_tl()
Definition: ODPS_Predictor.f90:1267
odps_predictor::odps_get_n_components
pure integer function, public odps_get_n_components(Group_Index)
Definition: ODPS_Predictor.f90:3179
odps_predictor::n_absorbers_g
integer, dimension(n_g), parameter n_absorbers_g
Definition: ODPS_Predictor.f90:85
odps_predictor::wco_comid
integer, parameter wco_comid
Definition: ODPS_Predictor.f90:122
odps_predictor::max_n_predictors_g
integer, dimension(n_g), parameter max_n_predictors_g
Definition: ODPS_Predictor.f90:86
type_kinds::fp
integer, parameter, public fp
Definition: Type_Kinds.f90:124
odps_predictor_define::odps_predictor_type
Definition: ODPS_Predictor_Define.f90:106
odps_predictor::odps_get_n_absorbers
pure integer function, public odps_get_n_absorbers(Group_Index)
Definition: ODPS_Predictor.f90:3186
odps_predictor::point_75
real(fp), parameter point_75
Definition: ODPS_Predictor.f90:212
odps_predictor::component_id_map_g1
integer, dimension(8), parameter component_id_map_g1
Definition: ODPS_Predictor.f90:148
odps_predictor::comp_wco_ir
integer, parameter comp_wco_ir
Definition: ODPS_Predictor.f90:136
odps_predictor::abs_h2o_mw
integer, parameter abs_h2o_mw
Definition: ODPS_Predictor.f90:185
odps_predictor::co2_comid
integer, parameter, public co2_comid
Definition: ODPS_Predictor.f90:124
odps_predictor::co_id
integer, parameter co_id
Definition: ODPS_Predictor.f90:174
odps_predictor::n_components_g
integer, dimension(n_g), parameter n_components_g
Definition: ODPS_Predictor.f90:84
odps_predictor::abs_o3_ir
integer, parameter abs_o3_ir
Definition: ODPS_Predictor.f90:179
crtm_parameters
Definition: CRTM_Parameters.f90:12
odps_predictor::group_2
integer, parameter, public group_2
Definition: ODPS_Predictor.f90:89
odps_predictor::odps_assemble_predictors_ad
subroutine, public odps_assemble_predictors_ad(TC, Predictor, Predictor_AD, Atm_AD)
Definition: ODPS_Predictor.f90:517
odps_predictor::odps_get_component_id
pure integer function, public odps_get_component_id(Component_Index, Group_Index)
Definition: ODPS_Predictor.f90:3193
odps_predictor::odps_assemble_predictors_tl
subroutine, public odps_assemble_predictors_tl(TC, Predictor, Atm_TL, Predictor_TL)
Definition: ODPS_Predictor.f90:412
odps_predictor::n_g
integer, parameter n_g
Definition: ODPS_Predictor.f90:83
crtm_geometryinfo_define::crtm_geometryinfo_type
Definition: CRTM_GeometryInfo_Define.f90:104
odps_predictor::odps_compute_predictor_odas
subroutine, public odps_compute_predictor_odas(Temperature, Vapor, Level_Pressure, Pressure, secant_angle, Alpha, Alpha_C1, Alpha_C2, Predictor)
Definition: ODPS_Predictor.f90:2673
odps_predictor::absorber_id_map_g2
integer, dimension(3), parameter absorber_id_map_g2
Definition: ODPS_Predictor.f90:196
odps_predictor::three
real(fp), parameter three
Definition: ODPS_Predictor.f90:207
odps_predictor
Definition: ODPS_Predictor.f90:16
odps_compute_predictor_ir_ad
subroutine odps_compute_predictor_ir_ad()
Definition: ODPS_Predictor.f90:1842
odps_predictor::n_predictors_g1
integer, dimension(8), parameter n_predictors_g1
Definition: ODPS_Predictor.f90:93
odps_predictor::comp_ch4_ir
integer, parameter comp_ch4_ir
Definition: ODPS_Predictor.f90:141
odps_predictor::absorber_id_map_g3
integer, dimension(1), parameter absorber_id_map_g3
Definition: ODPS_Predictor.f90:201
odps_predictor::n2o_id
integer, parameter n2o_id
Definition: ODPS_Predictor.f90:173
crtm_parameters::minimum_absorber_amount
real(fp), parameter, public minimum_absorber_amount
Definition: CRTM_Parameters.f90:137
odps_predictor::abs_ch4_ir
integer, parameter abs_ch4_ir
Definition: ODPS_Predictor.f90:183
odps_coordinatemapping::map_input_tl
subroutine, public map_input_tl(TC, Atm_TL, Temperature_TL, Absorber_TL, PAFV)
Definition: ODPS_CoordinateMapping.f90:379
odps_predictor::co_comid
integer, parameter co_comid
Definition: ODPS_Predictor.f90:126
odps_predictor::n2o_comid
integer, parameter n2o_comid
Definition: ODPS_Predictor.f90:125
odps_predictor::h2o_id
integer, parameter h2o_id
Definition: ODPS_Predictor.f90:170
odps_predictor::absorber_id_map_g1
integer, dimension(6), parameter absorber_id_map_g1
Definition: ODPS_Predictor.f90:188
odps_predictor::comp_co2_ir
integer, parameter comp_co2_ir
Definition: ODPS_Predictor.f90:138
odps_predictor::tot_comid
integer, parameter, public tot_comid
Definition: ODPS_Predictor.f90:118
odps_predictor::comp_dry_mw
integer, parameter comp_dry_mw
Definition: ODPS_Predictor.f90:144
odps_predictor_define
Definition: ODPS_Predictor_Define.f90:15
odps_predictor::odps_compute_predictor
subroutine, public odps_compute_predictor(Group_ID, Temperature, Absorber, Ref_Level_Pressure, Ref_Temperature, Ref_Absorber, secang, Predictor)
Definition: ODPS_Predictor.f90:652
odps_predictor::o3_id
integer, parameter o3_id
Definition: ODPS_Predictor.f90:172
odps_predictor::ch4_id
integer, parameter ch4_id
Definition: ODPS_Predictor.f90:175
odps_compute_predictor_mw
subroutine odps_compute_predictor_mw()
Definition: ODPS_Predictor.f90:1000
odps_predictor::point_25
real(fp), parameter point_25
Definition: ODPS_Predictor.f90:210
odps_predictor::ozo_comid
integer, parameter ozo_comid
Definition: ODPS_Predictor.f90:123
odps_predictor::module_version_id
character(*), parameter, private module_version_id
Definition: ODPS_Predictor.f90:79
odps_predictor::two
real(fp), parameter two
Definition: ODPS_Predictor.f90:206
odps_predictor::allow_optran
logical, parameter, public allow_optran
Definition: ODPS_Predictor.f90:218
odps_predictor::odps_compute_predictor_odas_ad
subroutine, public odps_compute_predictor_odas_ad(Temperature, Vapor, Pressure, secant_angle, Alpha, Alpha_C2, Predictor, Predictor_AD, Temperature_AD, Vapor_AD)
Definition: ODPS_Predictor.f90:3045
odps_coordinatemapping::map_input_ad
subroutine, public map_input_ad(TC, Temperature_AD, Absorber_AD, Atm_AD, PAFV)
Definition: ODPS_CoordinateMapping.f90:487
odps_predictor::component_id_map_g3
integer, dimension(2), parameter component_id_map_g3
Definition: ODPS_Predictor.f90:165
odps_coordinatemapping::compute_interp_index
subroutine, public compute_interp_index(x, u, interp_index)
Definition: ODPS_CoordinateMapping.f90:966
odps_predictor::odps_get_ozone_component_id
pure integer function, public odps_get_ozone_component_id(Group_Index)
Definition: ODPS_Predictor.f90:3223
odps_coordinatemapping
Definition: ODPS_CoordinateMapping.f90:12
odps_predictor::one_point_5
real(fp), parameter one_point_5
Definition: ODPS_Predictor.f90:213
odps_define::odps_type
Definition: ODPS_Define.f90:112
odps_predictor::abs_co_ir
integer, parameter abs_co_ir
Definition: ODPS_Predictor.f90:182
odps_predictor::four
real(fp), parameter four
Definition: ODPS_Predictor.f90:208
odps_predictor::odps_get_max_n_predictors
pure integer function, public odps_get_max_n_predictors(Group_Index)
Definition: ODPS_Predictor.f90:3172
odps_coordinatemapping::map_input
subroutine, public map_input(Atm, TC, GeoInfo, Temperature, Absorber, User_Level_LnPressure, Ref_Level_LnPressure, Secant_Zenith, H2O_idx, PAFV)
Definition: ODPS_CoordinateMapping.f90:163
odps_predictor::zero
real(fp), parameter zero
Definition: ODPS_Predictor.f90:204
odps_predictor::comp_dry_ir
integer, parameter comp_dry_ir
Definition: ODPS_Predictor.f90:134
size
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************subroutine READ_RECORD_CORE_(unit, field, nwords, data, start, axsiz) integer, intent(in) ::unit type(fieldtype), intent(in) ::field integer, intent(in) ::nwords MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in) ::start(:), axsiz(:) integer(SHORT_KIND) ::i2vals(nwords)!rab used in conjunction with transfer intrinsic to determine size of a variable integer(KIND=1) ::one_byte(8) integer ::word_sz!#ifdef __sgi integer(INT_KIND) ::ivals(nwords) real(FLOAT_KIND) ::rvals(nwords)!#else! integer ::ivals(nwords)! real ::rvals(nwords)!#endif real(DOUBLE_KIND) ::r8vals(nwords) pointer(ptr1, i2vals) pointer(ptr2, ivals) pointer(ptr3, rvals) pointer(ptr4, r8vals) if(mpp_io_stack_size< nwords) call mpp_io_set_stack_size(nwords) call mpp_error(FATAL, 'MPP_READ currently requires use_netCDF option') end subroutine READ_RECORD_CORE_ subroutine READ_RECORD_(unit, field, nwords, data, time_level, domain, position, tile_count, start_in, axsiz_in)!routine that is finally called by all mpp_read routines to perform the read!a non-netCDF record contains:! field ID! a set of 4 coordinates(is:ie, js:je) giving the data subdomain! a timelevel and a timestamp(=NULLTIME if field is static)! 3D real data(stored as 1D)!if you are using direct access I/O, the RECL argument to OPEN must be large enough for the above!in a global direct access file, record position on PE is given by %record.!Treatment of timestamp:! We assume that static fields have been passed without a timestamp.! Here that is converted into a timestamp of NULLTIME.! For non-netCDF fields, field is treated no differently, but is written! with a timestamp of NULLTIME. There is no check in the code to prevent! the user from repeatedly writing a static field. integer, intent(in) ::unit, nwords type(fieldtype), intent(in) ::field MPP_TYPE_, intent(inout) ::data(nwords) integer, intent(in), optional ::time_level type(domain2D), intent(in), optional ::domain integer, intent(in), optional ::position, tile_count integer, intent(in), optional ::start_in(:), axsiz_in(:) integer, dimension(size(field%axes(:))) ::start, axsiz integer ::tlevel !, subdomain(4) integer ::i, error, is, ie, js, je, isg, ieg, jsg, jeg type(domain2d), pointer ::io_domain=> tlevel if(PRESENT(start_in) .AND. PRESENT(axsiz_in)) then if(size(start(! the data domain and compute domain must refer to the subdomain being passed ! In this ! since that attempts to gather all data on PE size(field%axes(:)) axsiz(i)
odps_predictor::edry_comid
integer, parameter edry_comid
Definition: ODPS_Predictor.f90:130
odps_compute_predictor_mw_ad
subroutine odps_compute_predictor_mw_ad()
Definition: ODPS_Predictor.f90:2410
odps_predictor::ivar_type
Definition: ODPS_Predictor.f90:225
type_kinds
Definition: Type_Kinds.f90:12
odps_predictor::odps_get_absorber_id
pure integer function, public odps_get_absorber_id(Absorber_Index, Group_Index)
Definition: ODPS_Predictor.f90:3208
odps_predictor::comp_n2o_ir
integer, parameter comp_n2o_ir
Definition: ODPS_Predictor.f90:139
odps_predictor::n_predictors_g3
integer, dimension(2), parameter n_predictors_g3
Definition: ODPS_Predictor.f90:112
odps_predictor::dry_comid_g2
integer, parameter dry_comid_g2
Definition: ODPS_Predictor.f90:120
odps_predictor::comp_ozo_ir
integer, parameter comp_ozo_ir
Definition: ODPS_Predictor.f90:137
crtm_parameters::reciprocal_gravity
real(fp), parameter, public reciprocal_gravity
Definition: CRTM_Parameters.f90:161
odps_predictor::group_1
integer, parameter, public group_1
Definition: ODPS_Predictor.f90:88
odps_predictor::odps_compute_predictor_tl
subroutine, public odps_compute_predictor_tl(Group_ID, Temperature, Absorber, Ref_Temperature, Ref_Absorber, secang, Predictor, Temperature_TL, Absorber_TL, Predictor_TL)
Definition: ODPS_Predictor.f90:1181
odps_predictor::odps_assemble_predictors
subroutine, public odps_assemble_predictors(TC, Atm, GeoInfo, Predictor)
Definition: ODPS_Predictor.f90:293
odps_predictor::odps_get_savefwvflag
pure logical function, public odps_get_savefwvflag()
Definition: ODPS_Predictor.f90:3236
odps_predictor::group_3
integer, parameter, public group_3
Definition: ODPS_Predictor.f90:90
odps_predictor::one_point_75
real(fp), parameter one_point_75
Definition: ODPS_Predictor.f90:215
crtm_atmosphere_define::crtm_atmosphere_type
Definition: CRTM_Atmosphere_Define.f90:361
odps_predictor::point_5
real(fp), parameter point_5
Definition: ODPS_Predictor.f90:211
crtm_atmosphere_define
Definition: CRTM_Atmosphere_Define.f90:13
odps_predictor::abs_n2o_ir
integer, parameter abs_n2o_ir
Definition: ODPS_Predictor.f90:181
crtm_geometryinfo_define
Definition: CRTM_GeometryInfo_Define.f90:13
odps_predictor::comp_wet_mw
integer, parameter comp_wet_mw
Definition: ODPS_Predictor.f90:145
odps_predictor::dry_comid_g1
integer, parameter dry_comid_g1
Definition: ODPS_Predictor.f90:119
odps_predictor::odps_compute_predictor_ad
subroutine, public odps_compute_predictor_ad(Group_ID, Temperature, Absorber, Ref_Temperature, Ref_Absorber, secang, Predictor, Predictor_AD, Temperature_AD, Absorber_AD)
Definition: ODPS_Predictor.f90:1746
odps_compute_predictor_mw_tl
subroutine odps_compute_predictor_mw_tl()
Definition: ODPS_Predictor.f90:1543
odps_compute_predictor_ir
subroutine odps_compute_predictor_ir()
Definition: ODPS_Predictor.f90:774
odps_predictor::component_id_map_g2
integer, dimension(5), parameter component_id_map_g2
Definition: ODPS_Predictor.f90:158
odps_predictor::comp_wlo_ir
integer, parameter comp_wlo_ir
Definition: ODPS_Predictor.f90:135
odps_predictor::comp_co_ir
integer, parameter comp_co_ir
Definition: ODPS_Predictor.f90:140
odps_predictor::abs_h2o_ir
integer, parameter abs_h2o_ir
Definition: ODPS_Predictor.f90:178
odps_define
Definition: ODPS_Define.f90:13
odps_predictor::one
real(fp), parameter one
Definition: ODPS_Predictor.f90:205
crtm_geometryinfo_define::crtm_geometryinfo_getvalue
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)
Definition: CRTM_GeometryInfo_Define.f90:421
odps_predictor::abs_co2_ir
integer, parameter abs_co2_ir
Definition: ODPS_Predictor.f90:180
odps_predictor_define::max_optran_order
integer, parameter, public max_optran_order
Definition: ODPS_Predictor_Define.f90:97