*IDENT RFORC405
*/
*/ Modset to permit a second forcing calculation from the radiation.
*/
*/ This modset is compatible with version 4.5 of the UM.
*/ set reference values of well mixed greenhouse gases by adding 
*/ to the namelist RUNCNST in CNTLATM
*/ Control values are:
*/      co2_mmr_d=4.40000e-04 !! co2 reference
*/      N2OMMR_d= 4.331e-07 !! N2O (Control value)
*/      CH4MMR_d=4.376e-07 !! methane (control value)
*/      C11MMR_d=0.0 !! CFC11 
*/      C12MMR_d=0.0 !! CFC12
*/      c113mmr_d=0.0 !! cfc113
*/      hcfc22mmr_d=0.0 !! hcfc22
*/      hfc125mmr_d=0.0 !! hcfc125
*/      HFC134Ammr_d=0.0 !! hfc134A
*/ the following is the user stash master that goes with this mod:
*/H1| SUBMODEL_NUMBER=1
*/H2| SUBMODEL_NAME=ATMOS
*/H3| UM_VERSION=4.4
*/#
*/#|Model |Sectn | Item |Name                                |
*/#|Space |Point | Time | Grid |LevelT|LevelF|LevelL|PseudT|PseudF|PseudL|LevCom|
*/#| Option Codes         | Version Mask         |
*/#|DataT |DumpP | PC1  PC2  PC3  PC4  PC5  PC6  PC7  PC8  PC9  PCA |
*/#|Rotate| PPFC | USER | LBVC | BLEV | TLEV |RBLEVV| CFLL | CFFF |
*/#
*/#===============================================================================
*/#
*/1|    1 |    1 |  250 |UPWARD SW FLUX ON HALF-LEVELS       |
*/2|    0 |    0 |    3 |    1 |    2 |    1 |   19 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000100 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  201 |    0 |    9 |    0 |    0 |    0 | 8888 |  175 |
*/#
*/1|    1 |    1 |  251 |DOWNWARD SW FLUX ON HALF-LEVELS     |
*/2|    0 |    0 |    3 |    1 |    2 |    1 |   19 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000100 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  200 |    0 |    9 |    0 |    0 |    0 | 8888 |  175 |
*/#
*/1|    1 |    1 |  401 |NET DOWN SFC SW Force FLUX: SW TS   |
*/2|    1 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 |   0   -7    0    0  -99   30  -99  -99  -99  -99 |
*/5|    0 |  186 |    0 |  129 |    0 |    0 |    0 | 9999 |   34 |
*/#
*/1|    1 |    1 |  402 |NET DOWN SW Force FLUX:SOLID SRF    |
*/2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   30  -99  -99  -99  -99 |
*/5|    0 |  186 |    1 |  129 |    0 |    0 |    0 | 9999 |  130 |
*/#
*/1|    1 |    1 |  403 |NET DOWN SW RAD Force FLUX: OPEN SEA|
*/2|    1 |    0 |    3 |    3 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   30  -99  -99  -99  -99 |
*/5|    0 |  186 |    2 |  129 |    0 |    0 |    0 | 9999 |  129 |
*/#
*/1|    1 |    1 |  404 |NET DOWN SFC SW Force FLUX < 690NM  |
*/2|    1 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   30  -99  -99  -99  -99 |
*/5|    0 |  186 |    1 |  129 |    0 |    0 |    0 | 9999 |  129 |
*/#
*/##1|    1 |    1 |  405 |SNOW-FREE SURFACE Force ALBEDO (ANC)|
*/##2|    1 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/##3| 00000000000000000000 | 00000000000000000111 |
*/##4|    1 |    2 | -99  -99  -99  -99  -14   30  -99  -99  -99  -99 |
*/##5|    0 |  322 |    0 |  129 |    0 |    0 |    0 |    0 |    0 |
*/#
*/##1|    1 |    1 |  406 |DEEP SNOW SURFACE Force ALBEDO (ANC)|
*/##2|    1 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/##3| 00000000000000000000 | 00000000000000000111 |
*/##4|    1 |    2 | -99  -99  -99  -99  -14   30  -99  -99  -99  -99 |
*/##5|    0 |  328 |    0 |  129 |    0 |    0 |    0 |    0 |    0 |
*/#
*/1|    1 |    1 |  408 |OUTGOING SW RAD Force FLUX (TOA)    |
*/2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  201 |    0 |  133 |    0 |    0 |    0 | 8888 |  175 |
*/#
*/1|    1 |    1 |  409 |CLEAR-SKY(II) UP SW Force FLUX (TOA)|
*/2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  207 |    0 |  133 |    0 |    0 |    0 | 8888 |  177 |
*/#
*/1|    1 |    1 |  410 |CLEAR-SKY(II) DOWN SFC SW Force FLUX|
*/2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  208 |    0 |  129 |    0 |    0 |    0 |    0 |    0 |
*/#
*/1|    1 |    1 |  411 |CLEAR-SKY(II) UP SFC SW Force FLUX  |
*/2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  207 |    0 |  129 |    0 |    0 |    0 |    0 |    0 |
*/#
*/##1|    1 |    1 |  419 |TOTAL Force CLOUD AMOUNT IN SW RADN |
*/##2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/##3| 00000000000000000000 | 00000000000000000000 |
*/##4|    1 |    2 | -99  -99  -99  -99  -14   30  -99  -99  -99  -99 |
*/##5|    0 |   30 |    0 |  129 |    0 |    0 |    0 |    0 |    0 |
*/#
*/1|    1 |    1 |  432 |SW HEATING Force RATES: ALL TIMESTEP|
*/2|    0 |    0 |    3 |    1 |    1 |    1 |    2 |    0 |    0 |    0 |    1 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  251 |    0 |    9 |    0 |    0 |    0 |    0 |    0 |
*/#
*/1|    1 |    1 |  433 |CLEAR-SKY SW Force HEATING RATES    |
*/2|    0 |    0 |    3 |    1 |    1 |    1 |    2 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99  -99  -99  -99  -99  -99 |
*/5|    0 |  252 |    0 |    9 |    0 |    0 |    0 |    0 |    0 |
*/#
*/1|    1 |    1 |  435 |TOTAL DOWNWARD SURFACE SW Force FLUX|
*/2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  203 |    0 |  129 |    0 |    0 |    0 | 9999 |  129 |
*/#
*/1|    1 |    1 |  437 |NET DOWN SW Force FLUX AT THE TROP  |
*/2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  186 |    0 |  130 |    0 |    0 |    0 | 9999 |  129 |
*/#
*/1|    1 |    1 |  438 |UPWARD SW FLUX AT THE TROP.         |
*/2|    0 |    0 |    3 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  201 |    0 |  130 |    0 |    0 |    0 | 9999 |  129 |
*/#
*/1|    1 |    1 |  450 |UPWARD SW Force FLUX ON HALF-LEVELS |
*/2|    0 |    0 |    3 |    1 |    2 |    1 |   19 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000100 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  201 |    0 |    9 |    0 |    0 |    0 | 8888 |  175 |
*/#
*/1|    1 |    1 |  451 |DOWNWARD SW Force FLUX ON 1/2-LEVELS|
*/2|    0 |    0 |    3 |    1 |    2 |    1 |   19 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000100 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  200 |    0 |    9 |    0 |    0 |    0 | 8888 |  175 |
*/#
*/#
*/#===============================================================================
*/#
*/1|    1 |    2 |  250 |UPWARD LW FLUX ON HALF-LEVELS       |
*/2|    0 |    0 |    2 |    1 |    2 |    1 |   19 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000100 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  206 |    0 |    9 |    0 |    0 |    0 | 8888 |  176 |
*/#
*/1|    1 |    2 |  251 |DOWNWARD LW FLUX ON HALF-LEVELS     |
*/2|    0 |    0 |    2 |    1 |    2 |    1 |   19 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000100 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  205 |    0 |    9 |    0 |    0 |    0 | 8888 |  176 |
*/#
*/1|    1 |    2 |  401 |NET DOWN SURFACE LW RAD Force FLUX  |
*/2|    0 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 |   0   -7    0    0   -7   16  -99  -99  -99  -99 |
*/5|    0 |  187 |    0 |  129 |    0 |    0 |    0 | 9999 |   35 |
*/#
*/1|    1 |    2 |  402 |NET DOWN LW RAD Force FLUX:SOLID SFC|
*/2|    0 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  187 |    0 |  129 |    0 |    0 |    0 | 9999 |  132 |
*/#
*/1|    1 |    2 |  403 |NET DOWN LW RAD Force FLUX: OPEN SEA|
*/2|    1 |    0 |    2 |    3 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  187 |    0 |  129 |    0 |    0 |    0 | 9999 |  131 |
*/#
*/##1|    1 |    2 |  404 |TOTAL CLOUD Force AMOUNT IN LW RADN |
*/##2|    0 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/##3| 00000000000000000000 | 00000000000000000111 |
*/##4|    1 |    2 |  -6  -99  -99  -99  -14   15  -99  -99  -99  -99 |
*/##5|    0 |   30 |    0 |    0 |    0 |    0 |    0 | 8888 |  173 |
*/#
*/1|    1 |    2 |  405 |OUTGOING LW RAD Force FLUX (TOA)    |
*/2|    1 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  206 |    0 |  133 |    0 |    0 |    0 | 8888 |  176 |
*/#
*/1|    1 |    2 |  406 |CLEAR-SKY(II) UP LW Force FLUX (TOA)|
*/2|    0 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  210 |    1 |  133 |    0 |    0 |    0 | 8888 |  178 |
*/#
*/1|    1 |    2 |  407 |DOWNWARD LW RAD Force FLUX: SURFACE |
*/2|    0 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  205 |    0 |  129 |    0 |    0 |    0 | 9999 |  179 |
*/#
*/1|    1 |    2 |  408 |CLEAR-SKY(II) DOWN SFC LW Force FLUX|
*/2|    0 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  211 |    0 |  129 |    0 |    0 |    0 |    0 |    0 |
*/#
*/1|    1 |    2 |  432 |LW HEATING Force RATES              |
*/2|    0 |    0 |    2 |    1 |    1 |    1 |    2 |    0 |    0 |    0 |    1 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  253 |    0 |    9 |    0 |    0 |    0 |    0 |    0 |
*/#
*/1|    1 |    2 |  433 |CLEAR-SKY LW HEATING Force RATES    |
*/2|    0 |    0 |    2 |    1 |    1 |    1 |    2 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99  -99  -99  -99  -99  -99 |
*/5|    0 |  254 |    0 |    9 |    0 |    0 |    0 |    0 |    0 |
*/#
*/1|    1 |    2 |  437 |NET DOWN LW Force FLUX AT THE TROP. |
*/2|    0 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  187 |    0 |  130 |    0 |    0 |    0 | 9999 |  129 |
*/#
*/1|    1 |    2 |  438 |TOTL DOWN LW Force FLUX AT THE TROP.|
*/2|    0 |    0 |    2 |    1 |    5 |   -1 |   -1 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000111 |
*/4|    1 |    2 | -99  -99  -99  -99  -99   30  -99  -99  -99  -99 |
*/5|    0 |  205 |    0 |  130 |    0 |    0 |    0 | 9999 |  129 |
*/#
*/1|    1 |    2 |  450 |UPWARD LW Force FLUX ON HALF-LEVELS |
*/2|    0 |    0 |    2 |    1 |    2 |    1 |   19 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000100 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  206 |    0 |    9 |    0 |    0 |    0 | 8888 |  176 |
*/#
*/1|    1 |    2 |  451 |DOWN LW Force FLUX ON HALF-LEVELS   |
*/2|    0 |    0 |    2 |    1 |    2 |    1 |   19 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000100 |
*/4|    1 |    2 | -99  -99  -99  -99   -7   16  -99  -99  -99  -99 |
*/5|    0 |  205 |    0 |    9 |    0 |    0 |    0 | 8888 |  176 |
*/#
*/#===============================================================================
*/#
*/1|   -1 |   -1 |   -1 |END OF FILE MARK                    |
*/2|    0 |    0 |    0 |    0 |    0 |    0 |    0 |    0 |    0 |    0 |    0 |
*/3| 00000000000000000000 | 00000000000000000000 |
*/4|    0 |    0 | -99  -99  -99  -99  -30  -99  -99  -99  -99  -99 |
*/5|    0 |    0 |    0 |    0 |    0 |    0 |    0 |    0 |    0 |
*/#
*/
*/++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/ End of user stash master file.
*/ ---------------------------------------------------------------------
*/
*/ 1. Add a second diagnostic call to the 3A radiation scheme.
*/
*DECLARE RAD_CTL1
*/ define some variables which are then used to process diagnostics later on.
*B RAD_CTL1.74  
*/
*/!! variables for processing of diagnostics -- allows
!! array oprations to be used
      integer,parameter::no_lw_diags=13
      integer::lwsi(no_lw_diags)=(/401,402,403,405,406,407,
     &                    408,437,438,            !! 9 single lev flds
     &                    432,433,450,451/)     !! 4 full fields
!! diagnostics that may be produced by  the 2nd call to the lw radn
      integer::lwst_len(no_lw_diags) !! and the size of these diagnostics set latter
      integer,parameter::no_sw_diags=16
      integer::swsi(no_sw_diags)=(/401,402,403,404,408,409,
     &                    410,411,435,437,
     &                    438, !! 11 single level fields
     &                    432,433,439,450,451/) !! 5 full level fields
!! diagnostics that may be produced by the 2nd call to the SW radn.
      integer::swst_len(no_sw_diags) !! and the size of these diagnostics 
!! which are set latter
!! various misc variables.     
      integer::no_diags_2nd_call !! no of diags for the 2nd call.
      integer::iloop_2nd_call,size_data
      integer::start_data_1st,start_data_2nd
!! integer loop variable for various processing needed for the 2nd call.
      logical::call_2nd_sw,call_2nd_lw !! set true if want to call sw/lw
*I AAD1F304.90
!
      INTEGER
     &     IT1, IT2, IT3
!
!     OUTPUT FROM THE DIAGNOSTIC CALL TO THE RADIATION.
      REAL 
     &     SWOUT_2(P_FIELDDA, P_LEVELSDA+2)
     &   , LWOUT_2(P_FIELDDA, P_LEVELSDA+1)
*I ADB2F404.918
*CALL SSPDL3AD
*CALL LSPDL3AD
*I ADB2F404.921
*CALL SSPCM3AD
*CALL LSPCM3AD
*I ADB2F404.924
*CALL SOPT3AD
*CALL LOPT3AD
*I ADB2F404.927
*CALL SCOPT3AD
*CALL LCOPT3AD
*/
*I RAD_CTL1.164
*/
CL Setup diagnostic sizes -- makes processing for "forcing" easier.
!! LW diagnostic sizes. (see lwsi for details of what they are)
      lwst_len(1:9)=p_field !! single level fields
      lwst_len(10:13)=p_field*p_levels !! 4 full level fields
!! SW diagnostic sizes. (see swsi for details of what they are)
      swst_len(1:11)=p_field !! 11 single level fields
      swst_len(12:16)=p_field*p_levels !! 5 full level fields
!! we call the sw if any one of the SW diagnostics is set.
!! F90 construct to get no of .true. in sf(swsi,1)
!!  done by  sum of 1 where sf(swsi,1) is .true.
      no_diags_2nd_call=sum(merge(1,0,sf(swsi,1)))
      call_2nd_sw=(no_diags_2nd_call .ge. 1)	
!!============================================================
!! we call the LW if any of the LW diags is required
      no_diags_2nd_call=sum(merge(1,0,sf(lwsi,2)))
      call_2nd_lw=(no_diags_2nd_call .ge. 1)	
!!============================================================
!!
*/
*/ Extend the IF-test to see whether we need to diagnose the 
*/ tropopause.
*/
*D ADB2F404.936
     &     ( SF(237,2) .OR. SF(238,2) ) .OR.
     &     L_CLIMAT_AEROSOL_SW_D.OR.L_CLIMAT_AEROSOL_LW_D.OR.
     &     ( SF(437,1) .OR. SF(438,1) ) .OR.
     &     ( SF(437,2) .OR. SF(438,2) ) .or. 
     &     sf(299,1) ) THEN !! want trop ht as a diagnostic.
*/============================================================
*/ trindx to be output as a diagnostic.
*/============================================================
*B AWI1F402.33
	if (SF(299,1)) then !! want to diagnose trop ht.
	  STASHWORK(SI(299,1,im_index):SI(299,1,im_index)+P_FIELDDA-1)=
     &      float(TRINDX) !! using F90 array notation.
        endif
*/
*/ Remove the IF-test around the global cloud top.
*/
*D ADB2F404.939
*D ADB2F404.970
*/ avoiding clashes with the cloud diag mod....
*B ADB1F400.206
     &        STASHWORK(SI(250,1,im_index)+JS), SF(250,1),
     &        STASHWORK(SI(251,1,im_index)+JS), SF(251,1),
*/ Need to delete some lines and squeeze on .false. as we have
*/ ran out of continuation lines... Roll on JME's F90 mods.
*D ADB2F404.1006,ADB1F400.232
     &        NPDWD_CL_PROFILE, NETSW(FIRST_POINT),
     &  STASHWORK(SI(203,1,im_index)+JS), RADINCS(FIRST_POINT),.false.)
*I ADB1F401.824
!
!        The diagnostic call to the radiation code.
!
! test that wanted on this timestep.
!!
      if (call_2nd_sw) then
!
!
!           Set dimensions for diagnostic workspace.
            IF (SF(419, 1)) THEN
               NPDWD_CL_PROFILE=SEG_POINTS_TEMP(I)
            ELSE
               NPDWD_CL_PROFILE=1
            ENDIF
!
!
            CALL R2_SWRAD(ICODE,
C arguments
C primary data inputs
!                       Mixing Ratios
*/Marker for Ozone SW changes
*ID RFSWO3
*DECLARE RAD_CTL1
*B ADB1F400.233
     &        D1(JQ(1)+JS),CO2_MMR_D,OZONE_1(FIRST_POINT,1),O2MMR_D,
     &        CO2_DIM1, CO2_DIM2, CO2_3D(FIRST_POINT_CO2,1),.false.,
!! currenly mod does not support 3D CO2 fields.
!             AC and BC added for conformity at lower levels
!                       Pressure Fields
     &        D1(JPSTAR+JS),AKH,BKH,A_LEVDEPC(JAK),A_LEVDEPC(JBK),
!                       Temperatures
     &        D1(JTHETA(1)+JS), L_GLOBAL_CLOUD_TOP, GLOBAL_CLOUD_TOP,
!                       Stratiform Cloud Fields
     &        L_CLOUD_WATER_PARTITION,
     &        AREA_CLOUD_FRACTION(FIRST_POINT,1),
     &        CLOUD_FRACTION(FIRST_POINT,1),
     &        D1(JQCL(1)+JS),D1(JQCF(1)+JS),
!                       Convective Cloud Fields
     &        D1(JCCA(1)+JS),D1(JCCLWP+JS),D1(JCCB+JS),D1(JCCT+JS),
     &        L_3D_CCA,
!                       Surface Fields
     &        SAL_VIS(FIRST_POINT_SAL,1),SAL_NIR(FIRST_POINT_SAL,1),
     &        LAND_AND_ICE_ALBEDO(FIRST_POINT,1),
     &        OPEN_SEA_ALBEDO(FIRST_POINT,1),
     &        D1(JICE_FRACTION+JS),D1(JLAND+JS),D1(JSNODEP+JS),
!                       Prognostic Snow Albedo flag
     &        L_SNOW_ALBEDO, SAL_DIM,
!                       Solar Fields
     &        COS_ZENITH_ANGLE(FIRST_POINT),
*/Marker for Solar SW changes
*ID RFSWSO
*DECLARE RAD_CTL1
*B ADB1F400.233
     &        DAY_FRACTION(FIRST_POINT),LIST(START_POINT),SCS,
!                       Aerosol Fields
     &        L_CLIMAT_AEROSOL_SW_D, BL_LEVELS,
     &        L_USE_SULPC_DIRECT_SW_D, L_USE_SULPC_INDIRECT_SW_D,
     &        SULP_DIM1,SULP_DIM2,ACCUM_SULPHATE(FIRST_POINT_SULPC, 1),
     &        AITKEN_SULPHATE(FIRST_POINT_SULPC, 1),
*/Marker for Volcanic SW change.
*ID RFSWV
*DECLARE RAD_CTL1
*B ADB1F400.233
     &        DISS_SULPHATE(FIRST_POINT_SULPC, 1),
*/Marker for Indirect aerosol SW changes
*ID RFSWCA
*DECLARE RAD_CTL1
*B ADB1F400.233
     &        L_USE_SOOT_DIRECT_D,SOOT_DIM1,SOOT_DIM2,
     &        FRESH_SOOT(FIRST_POINT_SOOT, 1),
     &        AGED_SOOT(FIRST_POINT_SOOT, 1),
!                       Level of tropopause
     &        TRINDX(FIRST_POINT)
C Size and control variables
!                       Spectrum
*CALL SSARG3AD
!                       Algorithmic options
*CALL SCARG3AD
     &        ,
     &        SECS_PER_STEPim(atmos_im),  
!                       General Diagnostics
     &        STASHWORK(JS+SI(408,1,im_index)), SF(408,1),
     &        STASHWORK(JS+SI(409,1,im_index)), SF(409,1),
     &        STASHWORK(JS+SI(404,1,im_index)), SF(404,1),
     &        STASHWORK(JS+SI(435,1,im_index)), SF(435,1),
     &        STASHWORK(SI(410,1,im_index)+JS), SF(410,1),
     &        STASHWORK(SI(411,1,im_index)+JS), SF(411,1),
     &        STASHWORK(SI(412,1,im_index)+JS), SF(412,1),
     &        STASHWORK(SI(413,1,im_index)+JS), SF(413,1),
     &        STASHWORK(SI(419,1,im_index)+JS), SF(419,1),
     &        STASHWORK(SI(433,1,im_index)+JS), SF(433,1),
     &        STASHWORK(SI(437,1,im_index)+JS), SF(437,1),  
*/Marker for cloud diagnostics SW changes
*ID RFSWCL
*DECLARE RAD_CTL1
*B ADB1F400.233
     &        STASHWORK(SI(438,1,im_index)+JS), SF(438,1),  
     &        STASHWORK(SI(450,1,im_index)+JS), SF(450,1),  
     &        STASHWORK(SI(451,1,im_index)+JS), SF(451,1),  
!                       Microphysical Flag
     &        LMICROPHY,
!                       Microphysical Diagnostics
     &        STASHWORK(JS+SI(425,1,im_index)), SF(425,1),
     &        STASHWORK(JS+SI(421,1,im_index)), SF(421,1),
     &        STASHWORK(JS+SI(426,1,im_index)), SF(426,1),
     &        STASHWORK(JS+SI(423,1,im_index)), SF(423,1),
     &        STASHWORK(JS+SI(424,1,im_index)), SF(424,1),
     &        STASHWORK(JS+SI(445,1,im_index)), SF(445,1),
     &        STASHWORK(JS+SI(446,1,im_index)), SF(446,1),
     &        STASHWORK(JS+SI(441,1,im_index)), SF(441,1),
     &        STASHWORK(JS+SI(442,1,im_index)), SF(442,1),
     &        STASHWORK(JS+SI(443,1,im_index)), SF(443,1),
     &        STASHWORK(JS+SI(444,1,im_index)), SF(444,1),
!                       Physical Dimensions  
     &        LIT_POINTS,SEG_POINTS_TEMP(I),P_LEVELS,CLOUD_LEVELS,
     &        Q_LEVELS,OZONE_LEVELS, P_FIELD, RAD_ARRAY_SIZE, 
     &        P_LEVELS, 1,N_CCA_LEV,NPDWD_CL_PROFILE,  
!
! Output data
!
     &        STASHWORK(SI(401,1,im_index)+JS),
     &        STASHWORK(SI(403,1,im_index)+JS), SWOUT_2,.TRUE.)
            IF (ICODE.NE.0) RETURN
!
   !        PASS THE CALCULATED FIELDS INTO THE DIAGNOSTIC ARRAYS.
            IF (SF(432,1)) THEN
               DO IT2=1, P_LEVELS
                  DO IT1=1, SEG_POINTS_TEMP(I)
                     IT3=IT1+(IT2-1)*P_FIELDDA-1
                     STASHWORK(SI(432,1,im_index)+JS+IT3)
     &                  =SWOUT_2(IT1, IT2+1)
                  ENDDO
               ENDDO
            ENDIF
!
            IF (SF(401,1)) THEN
               DO IT1=1, SEG_POINTS_TEMP(I)
                  IT3=IT1-1+JS
                  STASHWORK(SI(401,1,im_index)+IT3)
     &               =SWOUT_2(IT1, 1)
     &               +STASHWORK(SI(403,1,im_index)+IT3)
               ENDDO
            ENDIF
!
            IF (SF(402,1)) THEN
               DO IT1=1, SEG_POINTS_TEMP(I)
                  IT3=IT1-1+JS
                  STASHWORK(SI(402,1,im_index)+IT3)
     &               =SWOUT_2(IT1, 1)
               ENDDO
            ENDIF
         endif
!
!
*I ADB1F400.234
          if (call_2nd_sw) then !! we had some diagnostics.
!!
!! difference the diagnostics of the first call from the 2nd call.
            do iloop_2nd_call=1, size(swsi) !! loop over poss diags
              if (sf(swsi(iloop_2nd_call),1))  then !! want diagnostic??
                if (.not. sf(swsi(iloop_2nd_call)-200,1)) then
 !! got the 1st diag?
                  icode=1
                  write(cmessage,*)'RADCTL: SW Diagnostic ',
     &              swsi(iloop_2nd_call)-200,
     &              ' not present'
                  return
                endif
                  
                size_data=swst_len(iloop_2nd_call) !! set up size.
!! and compute the start values
                start_data_2nd=si(swsi(iloop_2nd_call),1,im_index)
                start_data_1st=si(swsi(iloop_2nd_call)-200,1,im_index)
!!
!!
!! then difference them -- F90 is nice isn't it?
!!
                stashwork(start_data_2nd:start_data_2nd+size_data-1)=
     &            stashwork(start_data_1st:start_data_1st+size_data-1)-
     &            stashwork(start_data_2nd:start_data_2nd+size_data-1)
              endif             !! end check for wanting diag
            enddo !! end loop over differencing diagnostics.

!
!
          endif !! end check for any diagnostic being required.
*/ avoid clashes with the cld diag mod.
*B ADB1F400.337
     &      STASHWORK(JS_LOCAL(I)+SI(250,2,im_index)), SF(250,2),
     &      STASHWORK(JS_LOCAL(I)+SI(251,2,im_index)), SF(251,2),
*I ADB1F400.355
     &   , .FALSE.
*I ADB1F401.828
!
!           Make a second diagnostic call to the LW.
!           at least one of the diagnostics is required this timestep.



            if (call_2nd_lw) then ! want to call 2nd lw
            CALL R2_LWRAD(ICODE,

C Input data
*/ Marker for ref_ozone LW change
*ID RFLWO3 
*DECLARE RAD_CTL1
*B ADB1F400.357 
     &        D1(JQ(1)+JS_LOCAL(I)),CO2_MMR_D,OZONE_1(FP_LOCAL(I),1),
     &        CO2_DIM1, CO2_DIM2, CO2_3D(FIRST_POINT_CO2,1),
!!     &        L_CO2_3D,
     &        .false.,
     &        N2OMMR_D, CH4MMR_D, C11MMR_D, C12MMR_D,
     &        C113MMR_D, HCFC22MMR_D, HFC125MMR_D, HFC134AMMR_D,
     &        D1(JTHETA(1)+JS_LOCAL(I)),
     &        D1(JP_EXNER(1)+JS_LOCAL(I)),TSTAR_RAD(FP_LOCAL(I)),
     &        D1(JPSTAR+JS_LOCAL(I)),AKH,BKH,
     &        A_LEVDEPC(JAK),A_LEVDEPC(JBK),
!                       Options for treating clouds
     &        L_GLOBAL_CLOUD_TOP, GLOBAL_CLOUD_TOP,
!                       Stratiform Cloud Fields
     &        L_CLOUD_WATER_PARTITION,
     &        AREA_CLOUD_FRACTION(FP_LOCAL(I),1),
     &        CLOUD_FRACTION(FP_LOCAL(I),1),
     &        D1(JQCL(1)+JS_LOCAL(I)),D1(JQCF(1)+JS_LOCAL(I)),
!                       Convective Cloud Fields
     &        D1(JCCA(1)+JS_LOCAL(I)),D1(JCCLWP+JS_LOCAL(I)),
     &        D1(JCCB+JS_LOCAL(I)),D1(JCCT+JS_LOCAL(I)),
     &        L_3D_CCA,
!                       Surface Fields
     &        D1(JLAND+JS_LOCAL(I)),
     &        D1(JICE_FRACTION+JS_LOCAL(I)),
     &        D1(JSNODEP+JS_LOCAL(I)),
!                       Aerosol Fields
     &        L_CLIMAT_AEROSOL_LW_D, BL_LEVELS,
     &        L_USE_SULPC_DIRECT_LW_D, L_USE_SULPC_INDIRECT_LW_D,
     &        SULP_DIM1,SULP_DIM2,
     &        ACCUM_SULPHATE(FIRST_POINT_SULPC, 1),
     &        AITKEN_SULPHATE(FIRST_POINT_SULPC, 1),
*/ Marker for volcanic LW change
*ID RFLWV
*DECLARE RAD_CTL1
*B ADB1F400.357 
     &        DISS_SULPHATE(FIRST_POINT_SULPC, 1),
     &        L_USE_SOOT_DIRECT_D,
     &        SOOT_DIM1,SOOT_DIM2,
     &        FRESH_SOOT(FIRST_POINT_SOOT, 1),
     &        AGED_SOOT(FIRST_POINT_SOOT, 1),
!                       Level of tropopause
     &        TRINDX(FP_LOCAL(I))
C Size and control variables
!                       Spectral data
*CALL LSARG3AD
!
!                       Algorithmic options
*CALL LCARG3AD
     &        ,
     &        SECS_PER_STEPim(atmos_im),
C Diagnostics out
     &        STASHWORK(JS_LOCAL(I)+SI(404,2,im_index)), SF(404,2),
     &        STASHWORK(JS_LOCAL(I)+SI(406,2,im_index)), SF(406,2),
     &        STASHWORK(JS_LOCAL(I)+SI(407,2,im_index)), SF(407,2),
     &        STASHWORK(JS_LOCAL(I)+SI(408,2,im_index)), SF(408,2),
     &        STASHWORK(JS_LOCAL(I)+SI(433,2,im_index)), SF(433,2),
     &        STASHWORK(JS_LOCAL(I)+SI(437,2,im_index)), SF(437,2),
*/ Marker for cloud diagnostic LW changes
*ID RFLWCL
*DECLARE RAD_CTL1
*B ADB1F400.357 
     &        STASHWORK(JS_LOCAL(I)+SI(438,2,im_index)), SF(438,2),
     &        STASHWORK(JS_LOCAL(I)+SI(450,2,im_index)), SF(450,2),
     &        STASHWORK(JS_LOCAL(I)+SI(451,2,im_index)), SF(451,2),
!                       Physical Dimensions
     &        SP_LOCAL(I),P_LEVELS,CLOUD_LEVELS,
     &        Q_LEVELS,OZONE_LEVELS,
     &        P_FIELD, RAD_ARRAY_SIZE, P_LEVELS, 1,N_CCA_LEV,
C Output data
     &        STASHWORK(SI(405,2,im_index)+JS_LOCAL(I)),
     &        STASHWORK(SI(403,2,im_index)+JS_LOCAL(I)),
     &        LWOUT_2, .TRUE.)
            IF (ICODE.NE.0) RETURN
!
!           PASS THE CALCULATED FIELDS INTO THE DIAGNOSTIC ARRAYS.
            IF (SF(432,2)) THEN
               DO IT2=1, P_LEVELS
                  DO IT1=1, SP_LOCAL(I)
                     IT3=IT1+(IT2-1)*P_FIELDDA-1
                     STASHWORK(SI(432,2,im_index)+JS_LOCAL(I)+IT3)
     &                  =LWOUT_2(IT1, IT2+1)
                  ENDDO
               ENDDO
            ENDIF
!
            IF (SF(401,2)) THEN
               DO IT1=1, SP_LOCAL(I)
                  IT3=JS_LOCAL(I)+IT1-1
                  STASHWORK(SI(401,2,im_index)+IT3)
     &               =LWOUT_2(IT1, 1)
     &               +STASHWORK(SI(403,2,im_index)+IT3)
               ENDDO
            ENDIF
!
            IF (SF(402,2)) THEN
               DO IT1=1, SP_LOCAL(I)
                  IT3=JS_LOCAL(I)+IT1-1
                  STASHWORK(SI(402,2,im_index)+IT3)
     &               =LWOUT_2(IT1, 1)
               ENDDO
            ENDIF
          endif                 !! end test for radn diagnostics

*/
*/ Process the data
*/
*I ADB1F400.358
          if (call_2nd_lw) then !! got any LW diags.

!! difference the diagnostics of the first call from the 2nd call.            
            do iloop_2nd_call=1, size(lwsi) !! loop over LW diags
              if (sf(lwsi(iloop_2nd_call),2))  then !! want this diag??
                if (.not. sf(lwsi(iloop_2nd_call)-200,2)) then 
!! got the 1st diag?
                  icode=1
                  write(cmessage,*)'RADCTL: LW Diagnostic ',
     &              lwsi(iloop_2nd_call)-200,
     &              ' not present'
                  return
                endif
                  
                size_data=lwst_len(iloop_2nd_call) !! set up size.
!! then setup the start indices in stashwork

                start_data_2nd=si(lwsi(iloop_2nd_call),2,im_index)
                start_data_1st=si(lwsi(iloop_2nd_call)-200,2,im_index)


!! then do the difference -- isn't F90 nice?

                stashwork(start_data_2nd:start_data_2nd+size_data-1)=
     &            stashwork(start_data_1st:start_data_1st+size_data-1)-
     &            stashwork(start_data_2nd:start_data_2nd+size_data-1)
              endif             !! end check for wanting diag
            enddo !! end loop over diagnostics.
            
          endif !! end if test on diagnostic call to LW

!
*/ ---------------------------------------------------------------------
*/
*/ 3. Make the reductions of fields used to advance the model only if
*/    the code is so used. Copies of SWOUT and LWOUT are used.
*/
*DECLARE SWRAD3A
*B SWRAD3A.54
     &   , UPWARD_FLUX, L_UPWARD_FLUX
     &   , DOWNWARD_FLUX, L_DOWNWARD_FLUX
*I SWRAD3A.75
     &   , L_DIAGNOSTIC_CALL
*I SWRAD3A.280
      LOGICAL
     &     L_DIAGNOSTIC_CALL
!              LOGICAL INDICATING A DIAGNOSTIC CALL
*B SWRAD3A.302
     &   , L_UPWARD_FLUX
!             DIAGNOSE UPWARD FLUX
     &   , L_DOWNWARD_FLUX
!             DIAGNOSE TOTAL DOWNWARD FLUX
*B SWRAD3A.321
     &   , UPWARD_FLUX(NPD_FIELD, NLEVS+1)
!             UPWARD FLUX
     &   , DOWNWARD_FLUX(NPD_FIELD, NLEVS+1)
!             TOTAL DOWNWARD FLUX
*B SWRAD3A.927
!
!     UPWARD FLUXES:
      IF (L_UPWARD_FLUX) THEN
         DO I=1, NLEVS+1
            CALL R2_ZERO_1D(N_PROFILE, UPWARD_FLUX(1, I))
            DO L=1, NLIT
               UPWARD_FLUX(LIST(L), I)=FLUX_UP(L, NLEVS+1-I)
            ENDDO
         ENDDO
      ENDIF
!
!     DOWNWARD FLUXES:
      IF (L_DOWNWARD_FLUX) THEN
         DO I=1, NLEVS+1
            CALL R2_ZERO_1D(N_PROFILE, DOWNWARD_FLUX(1, I))
            DO L=1, NLIT
               DOWNWARD_FLUX(LIST(L), I)=FLUX_NET(L, NLEVS+1-I)
     &            +FLUX_UP(L, NLEVS+1-I)
            ENDDO
         ENDDO
      ENDIF
*I SWRAD3A.937
      IF (.NOT.L_DIAGNOSTIC_CALL) THEN
*I SWRAD3A.941
      ELSE
         DO L=1, N_PROFILE
            SWOUT(L, I+1)=(SWOUT(L, I+1)-SWOUT(L, I))
     &         /(PTS*(DACON+PSTAR(L)*DBCON))
         ENDDO
      ENDIF
*I SWRAD3A.970
!     ONLY CARRY OUT THIS PROCESSING ON A NON-DIAGNOSTIC CALL.
      IF (.NOT.L_DIAGNOSTIC_CALL) THEN
*I SWRAD3A.975
      ENDIF
*/
*DECLARE LWRAD3A
*B LWRAD3A.44
     &   , UPWARD_FLUX, L_UPWARD_FLUX
     &   , DOWNWARD_FLUX, L_DOWNWARD_FLUX
*I LWRAD3A.58
     &   , L_DIAGNOSTIC_CALL
*I LWRAD3A.249
      LOGICAL
     &     L_DIAGNOSTIC_CALL
!              LOGICAL INDICATING A DIAGNOSTIC CALL
*B LWRAD3A.263
     &   , L_UPWARD_FLUX
!             DIAGNOSE UPWARD FLUX
     &   , L_DOWNWARD_FLUX
!             DIAGNOSE TOTAL DOWNWARD FLUX
*B LWRAD3A.276
     &   , UPWARD_FLUX(NPD_FIELD, NLEVS+1)
!             UPWARD FLUX
     &   , DOWNWARD_FLUX(NPD_FIELD, NLEVS+1)
!             TOTAL DOWNWARD FLUX
*B LWRAD3A.675
!
!     UPWARD FLUXES:
      IF (L_UPWARD_FLUX) THEN
         DO I=1, NLEVS+1
            DO L=1, N_PROFILE
               UPWARD_FLUX(L, I)=FLUX_UP(L, NLEVS+1-I)
            ENDDO
         ENDDO
      ENDIF
!
!     DOWNWARD FLUXES:
      IF (L_DOWNWARD_FLUX) THEN
         DO I=1, NLEVS+1
            DO L=1, N_PROFILE
               DOWNWARD_FLUX(L, I)=FLUX_NET(L, NLEVS+1-I)
     &            +FLUX_UP(L, NLEVS+1-I)
            ENDDO
         ENDDO
      ENDIF
*I LWRAD3A.683
      IF (.NOT.L_DIAGNOSTIC_CALL) THEN
*I LWRAD3A.687
      ELSE
         DO L=1, N_PROFILE
            LWOUT(L, I+1)=(FLUX_NET(L, NLEVS-I)
     &         -FLUX_NET(L, NLEVS+1-I))
     &         /(PTS*(DACON+PSTAR(L)*DBCON))
         ENDDO
      ENDIF
!
*/ ---------------------------------------------------------------------
*/
*/ 4. Adjust the input routines to accept second diagnostic copies of
*/    the controlling information.
*/
*DECLARE CNTLATM
*I ADB1F402.816
     &  ,L_CLIMAT_AEROSOL_SW_D      ! Use climatological aerosol
!                                   ! diagnostically in the SW
     &  ,L_CLIMAT_AEROSOL_LW_D      ! Use climatological aerosol
!                                   ! diagnostically in the SW
     &  ,L_USE_SULPC_INDIRECT_SW_D  ! Include the indirect effects 
!                                   ! of SO4 aersols in diagnostically
!                                   ! in the SW.
     &  ,L_USE_SULPC_INDIRECT_LW_D  ! Include the indirect effects 
!                                   ! of SO4 aersols in diagnostically
!                                   ! in the LW.
     &  ,L_USE_SULPC_DIRECT_SW_D    ! Include the direct effects 
!                                   ! of SO4 aersols in diagnostically
!                                   ! in the SW.
     &  ,L_USE_SULPC_DIRECT_LW_D    ! Include the direct effects 
!                                   ! of SO4 aersols in diagnostically
!                                   ! in the LW.
     &  ,L_USE_SOOT_DIRECT_D        ! Include the direct effects 
!                                   ! of soot aersols in diagnostically
*I ADB1F402.818
     & L_CLIMAT_AEROSOL_SW_D, L_CLIMAT_AEROSOL_LW_D,
     & L_USE_SULPC_INDIRECT_SW_D, L_USE_SULPC_INDIRECT_LW_D,
     & L_USE_SULPC_DIRECT_SW_D, L_USE_SULPC_DIRECT_LW_D,
     & L_USE_SOOT_DIRECT_D,
*I ADB1F402.819
     & L_CLIMAT_AEROSOL_SW_D, L_CLIMAT_AEROSOL_LW_D,
     & L_USE_SULPC_INDIRECT_SW_D, L_USE_SULPC_INDIRECT_LW_D,
     & L_USE_SULPC_DIRECT_SW_D, L_USE_SULPC_DIRECT_LW_D,
     & L_USE_SOOT_DIRECT_D,
*DECLARE READLSA1
*I ADB1F400.367
*CALL SOPT3AD
*CALL LOPT3AD
*CALL SCOPT3AD
*CALL LCOPT3AD
*CALL CTLNL3AD
!
      CHARACTER*6
     &     CNTL_SECONDARY
!             SECONDARY FILE OF SPECTRAL CONTROL
      CHARACTER*1
     &     GTJBID
!             FUNCTION TO GET JOBID
      INTEGER
     &     IDUM
!             DUMMY INTEGER FOR CALL TO FUNCTION
*B ADR1F305.147
     &   CO2_MMR_D, N2OMMR_D, CH4MMR_D, C11MMR_D, C12MMR_D, C113MMR_D, 
     &   HCFC22MMR_D, HFC125MMR_D, HFC134AMMR_D, O2MMR_D,
*B READLSA1.120
      CO2_MMR_D  = RMDI
      N2OMMR_D    = RMDI
      CH4MMR_D  = RMDI
      C11MMR_D  = RMDI
      C12MMR_D = RMDI
      C113MMR_D    = RMDI
      HCFC22MMR_D  = RMDI
      HFC125MMR_D  = RMDI
      HFC134AMMR_D = RMDI
      O2MMR_D  = RMDI
*I ADR1F305.206
!
!     If the diagnostic mixing ratios are not set make them equal to
!     those for the main call.
      IF (ABS(CO2_MMR_D/RMDI-1.0E+00).LT.1.0E-04) CO2_MMR_D=CO2_MMR
      IF (ABS(N2OMMR_D/RMDI-1.0E+00).LT.1.0E-04) N2OMMR_D=N2OMMR
      IF (ABS(CH4MMR_D/RMDI-1.0E+00).LT.1.0E-04) CH4MMR_D=CH4MMR
      IF (ABS(C11MMR_D/RMDI-1.0E+00).LT.1.0E-04) C11MMR_D=C11MMR
      IF (ABS(C12MMR_D/RMDI-1.0E+00).LT.1.0E-04) C12MMR_D=C12MMR
      IF (ABS(C113MMR_D/RMDI-1.0E+00).LT.1.0E-04) C113MMR_D=C113MMR
      IF (ABS(HCFC22MMR_D/RMDI-1.0E+00).LT.1.0E-04) 
     &   HCFC22MMR_D=HCFC22MMR
      IF (ABS(HFC125MMR_D/RMDI-1.0E+00).LT.1.0E-04) 
     &   HFC125MMR_D=HFC125MMR
      IF (ABS(HFC134AMMR_D/RMDI-1.0E+00).LT.1.0E-04) 
     &   HFC134AMMR_D=HFC134AMMR
      IF (ABS(O2MMR_D/RMDI-1.0E+00).LT.1.0E-04) O2MMR_D=O2MMR
*I ADB1F400.371
!
!     Open the file for diagnostic input.
      CNTL_SECONDARY(1:6)='ftn49'//GTJBID(IDUM)
      OPEN(UNIT=49, FILE=CNTL_SECONDARY(1:6))
      PRINT *, 'Diagnostic control read in.'
*I ADB1F400.376
!
!     Diagnostic controlling options. No IF-test is required here
!     as inclusion of the modset effectively means that it is true.
      READ(49, R2SWCLNLD)
!
*I ADB1F400.381
!
!     Diagnostic controlling options. No IF-test is required here
!     as inclusion of the modset effectively means that it is true.
      READ(49, R2LWCLNLD)
      CLOSE(49)
!
*DECLARE INITPHY1
*I ADB1F400.28
     &   , R2_SW_SPECIN_D, R2_LW_SPECIN_D
*I ADB1F400.29
*CALL SOPT3AD
*CALL LOPT3AD
*CALL SCOPT3AD
*CALL LCOPT3AD
*I ADB1F400.39
!
!     Read in the Diagnostic spectrum
      CALL R2_SW_SPECIN_D(ICODE, CMESSAGE
     &    , L_O2_SW_D
     &    , L_CLIMAT_AEROSOL_SW_D, L_USE_SULPC_DIRECT_SW_D
     &    , L_USE_SOOT_DIRECT_D)
*I ADB1F400.51
!
!     Read in the Diagnostic spectrum
      CALL R2_LW_SPECIN_D(ICODE, CMESSAGE
     &    , L_CH4_LW_D, L_N2O_LW_D, L_CFC11_LW_D, L_CFC12_LW_D
     &    , L_CFC113_LW_D, L_HCFC22_LW_D, L_HFC125_LW_D, L_HFC134A_LW_D
     &    , L_CLIMAT_AEROSOL_LW_D, L_USE_SULPC_DIRECT_LW_D
     &    , L_USE_SOOT_DIRECT_D)
*/
*/ Add diagnostic mixing ratios.
*/
*DECLARE RAD_COM
*B RAD_COM.31
      REAL O2MMR_D        ! Diagnostic O2 mmr
      REAL CO2_MMR_D      ! Diagnostic CO2 mmr
      REAL N2OMMR_D       ! Diagnostic N2O mmr
      REAL CH4MMR_D       ! Diagnostic CH4 mmr
      REAL C11MMR_D       ! Diagnostic CFC11 mmr
      REAL C12MMR_D       ! Diagnostic CFC12 mmr
      REAL C113MMR_D      ! Diagnostic CFC113 mmr
      REAL HCFC22MMR_D    ! Diagnostic HCFC22 mmr
      REAL HFC125MMR_D    ! Diagnostic HFC125 mmr
      REAL HFC134AMMR_D   ! Diagnostic HFC134A mmr
*B RAD_COM.38
     &  , O2MMR_D, CO2_MMR_D, N2OMMR_D, CH4MMR_D, C11MMR_D, C12MMR_D
     &  , C113MMR_D, HCFC22MMR_D, HFC125MMR_D, HFC134AMMR_D
*/
*/ Copies of R2_SW_SPECIN and R2_LW_SPECIN modified to access the
*/ diagnostic spectra.
*/
*DECK SPIN3AD
!+ Subroutine to read a shortwave spectral namelist.
!
! Purpose:
!   To read a shortwave namelist into a spectral array.
!
! Method:
!   The spectrum is read into the dynamically allocated array
!   and then reduced to a more manageable size.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!       4.1             14-05-96                Set lower limits
!                                               for reduced dimensions
!                                               to ensure that they
!                                               may never be 0.
!                                               (J. M. Edwards)
!       4.4             02-09-97                Aerosol flags passed
!                                               in to the code to
!                                               enable only those
!                                               required to be
!                                               selected. Spectral
!                                               data are now longer
!                                               compressed into a
!                                               single array.
!                                               Actual IOS code put
!                                               into CMESSAGE.
!                                               (J. M. Edwards)
!       4.5             18-05-98                Coding to allow
!                                               selection of gases
!                                               from the spectral
!                                               file.
!                                               (J. M. Edwards)
!
!       4.5        April 1998   Allow soot spectral data to be read.
!                                                     Luke Robinson.
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE R2_SW_SPECIN_D(IERR, CMESSAGE
     &   , L_O2
     &   , L_CLIMAT_AEROSOL, L_USE_SULPC_DIRECT
     &   , L_USE_SOOT_DIRECT
     &   )
!
!
      IMPLICIT NONE
!
!
*CALL MXSIZE3A
*CALL ERROR3A
*CALL STDIO3A
!
!
!     DUMMY ARGUMENTS
      LOGICAL   !, INTENT(IN)
     &     L_O2
!             ABSORPTION BY OXYGEN IS TO BE INCLUDED.
     &   , L_CLIMAT_AEROSOL
!             CLIMATOLOGICAL AEROSOLS ARE TO BE INCLUDED
     &   , L_USE_SULPC_DIRECT
!             THE DIRECT EFFECTS OF SULPHATE AEROSOLS ARE
!             TO BE INCLUDED
     &   , L_USE_SOOT_DIRECT
!             USE THE DIRECT RAD EFFECTS OF SOOT IN THE SW
!
      INTEGER   !, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      CHARACTER*80      !, INTENT(OUT)
     &     CMESSAGE
!
!
!
!     LOCAL VARIABLES.
!
!
!     RADIATIVE VARIABLES FOR REDUCING THE SPECTRUM
!
*CALL AERPRM3A
*CALL AERCMP3A
*CALL GASID3A
!
      CHARACTER
     &     SW_SPECTRAL_FILE*6
!             NAME OF FILE CONTAINING THE SPECTRAL DATA
      INTEGER
     &     IERR_GET_FILE
!             ERROR FLAG RETURNED BY GET_FILE (NOT NECESSARILY
!             CONSISTENT WITH THE FLAGS IN ERROR3A).
     &   , IOS
!             STATUS OF I/O
!
      LOGICAL
     &     L_RETAIN_ABSORB(NPD_SPECIES)
!             FLAG SET TO .TRUE. IF THE ABSORBER IS TO BE RETAINED
     &   , L_GAS_INCLUDED(NPD_GASES)
!             LOGICAL TO TEST FOR ACTUAL GASES INCLUDED
      INTEGER
     &     N_ABSORB_RETAIN
!             NUMBER OF ABSORBERS TO RETAIN
     &   , INDEX_ABSORB_RETAIN(NPD_SPECIES)
!             INDICES OF ABSORBERS TO BE RETAINED
     &   , COMPRESSED_INDEX(NPD_SPECIES)
!             MAPPING FROM OLD TO COMPRESSED INDICES OF ABSORBERS
     &   , N_AEROSOL_RETAIN
!             NUMBER OF AEROSOLS IN THE SPECTRAL FILE TO BE RETAINED
!             FOR THE RADIATIVE CALCULATION
     &   , INDEX_AEROSOL_RETAIN(NPD_AEROSOL_SPECIES)
!             INDEXING NUMBERS OF THE RETAINED AEROSOLS
     &   , N_AEROSOL_FOUND
!             NUMBER OF AEROSOLS FOR THE CURRENT GROUP OF PROCESSES
!             FOUND IN THE SPECTRAL FILE
!
!
!
!     DECLARE THE ELEMENTS OF THE INITIAL SPECTRUM FOR DYNAMIC
!     ALLOCATION AND SET UP AN APPROPRIATE NAMELIST.
!
*CALL SPDEC3A
*CALL SWSP3A
!
!
!     DECLARE THE REDUCED SW SPECTRAL FILE AND ITS HOLDING COMMON BLOCK.
!
*CALL SSPDL3AD
*CALL SSPCM3AD
!
!
!
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
!
      CHARACTER
     &     CH_IOS*5
!             CHARACTER STRING FOR IOS ERROR
      CHARACTER*1
     &     GTJBID
!             FUNCTION FOR JOBID
      INTEGER
     &     IDUM
!             DUMMY INTEGER FOR CALL TO FUNCTION
!
!
!     SUBROUTINES CALLED
      EXTERNAL
     &     R2_COMPRESS_SPECTRUM
!
!
!     EACH BLOCK IS INITIALIZED AS MISSING:
      DATA L_PRESENT/.FALSE., NPD_TYPE*.FALSE./
!
!     INITIALIZE THE RANGE OF VALIDITY OF THE PARAMETRIZATIONS OF
!     DROPLETS AND ICE CRYSTALS. OLD SPECTRAL FILES WILL NOT CONTAIN
!     SUCH DATA, SO THE LIMITS FOR DROPLETS ARE INITIALIZED TO THOSE
!     FORMERLY SET IN THE MICROPHYSICAL SCHEME (MRF/UMIST
!     PARAMETRIZATION) TO ENSURE THAT THE RESULTS ARE BIT-REPRODUCIBLE.
!     VALUES FOR ICE COVER THE RANGE OF EFFECTIVE RADII USED IN
!     GENERATING THE DATA FOR THE ORIGINAL PARAMETRIZATION OF ICE
!     CRYSTALS.
!     AT SOME FUTURE RELEASE IT MAY BE DESIRABLE TO REMOVE DEFAULT
!     SETTINGS.
      DATA DROP_PARM_MIN_DIM/NPD_DROP_TYPE*3.5E-07/
      DATA DROP_PARM_MAX_DIM/NPD_DROP_TYPE*3.7E-05/
      DATA ICE_PARM_MIN_DIM/NPD_ICE_TYPE*3.75E-07/
      DATA ICE_PARM_MAX_DIM/NPD_ICE_TYPE*8.0E-05/
!
!
!
!     READ THE SHORTWAVE SPECTRUM AS A NAMELIST.
      IDUM=0
      SW_SPECTRAL_FILE(1:6)='ftn57'//GTJBID(IDUM)
      OPEN(UNIT=57, FILE=SW_SPECTRAL_FILE, IOSTAT=IOS)
      PRINT *, 'Diagnostic Spectral File =', SW_SPECTRAL_FILE
      IF (IOS.NE.0) THEN
         IERR=I_ERR_IO
         WRITE(CH_IOS, '(I5)') IOS
         CMESSAGE='Error opening diagnostic shortwave spectral file.'
     &      //' IOSTAT='//CH_IOS
         RETURN
      ENDIF
      READ(57, R2SWSP)
      CLOSE(57)
!
!     TEST FOR MINIMAL REQUISITE INFORMATION.
      IF ( .NOT.(L_PRESENT(0).AND.
     &           L_PRESENT(2) ) ) THEN
         CMESSAGE='Shortwave spectrum is deficient.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!
!
!     SET REDUCED DIMENSIONS, EITHER FROM THE SIZES OF THE FIXED ARRAYS
!     OR FROM THE ARRAYS READ IN.
!
      NPD_TYPE_SD=NPD_TYPE
      NPD_BAND_SD=MAX(N_BAND, 1)
      NPD_SPECIES_SD=MAX(N_ABSORB, 1)
      NPD_ALBEDO_PARM_SD=NPD_ALBEDO_PARM
      NPD_SCALE_FNC_SD=NPD_SCALE_FNC
      NPD_SCALE_VARIABLE_SD=NPD_SCALE_VARIABLE
      NPD_SURFACE_SD=NPD_SURFACE
      NPD_CONTINUUM_SD=NPD_CONTINUUM
      NPD_CLOUD_PARAMETER_SD=NPD_CLOUD_PARAMETER
      NPD_THERMAL_COEFF_SD=1
!
!
!     SEARCH THE SPECTRUM TO FIND MAXIMUM DIMENSIONS.
!
      NPD_EXCLUDE_SD=1
      IF (L_PRESENT(14)) THEN
         DO I=1, N_BAND
            NPD_EXCLUDE_SD=MAX(NPD_EXCLUDE_SD, N_BAND_EXCLUDE(I))
         ENDDO
      ENDIF
!
!     Search the spectrum to find those gases to be retained.
!     Water vapour, carbon dioxide and ozone are included
!     if present, but a warning is printed if they are
!     not included.
      DO I=1, NPD_GASES
         L_GAS_INCLUDED(I)=.FALSE.
      ENDDO
      N_ABSORB_RETAIN=0
!
      DO I=1, N_ABSORB
!
         L_RETAIN_ABSORB(I)=.FALSE.
         COMPRESSED_INDEX(I)=0
!
         IF ( (TYPE_ABSORB(I).EQ.IP_H2O).OR.
     &        (TYPE_ABSORB(I).EQ.IP_CO2).OR.
     &        (TYPE_ABSORB(I).EQ.IP_O3).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_O2).AND.L_O2 ) ) THEN
            N_ABSORB_RETAIN=N_ABSORB_RETAIN+1
            INDEX_ABSORB_RETAIN(N_ABSORB_RETAIN)=I
            COMPRESSED_INDEX(I)=N_ABSORB_RETAIN
            L_RETAIN_ABSORB(I)=.TRUE.
            L_GAS_INCLUDED(TYPE_ABSORB(I))=.TRUE.
         ENDIF
!
      ENDDO
!
!
!     Print warning messages if those gases normally expected
!     are not present.
      IF (.NOT.L_GAS_INCLUDED(IP_H2O)) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** WARNING: Water vapour is not included in the '
     &      , 'secondary shortwave spectral file.'
      ENDIF
!
      IF (.NOT.L_GAS_INCLUDED(IP_CO2)) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** WARNING: Carbon dioxide is not included in the '
     &      , 'secondary shortwave spectral file.'
      ENDIF
!
      IF (.NOT.L_GAS_INCLUDED(IP_O3)) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** WARNING: Ozone is not included in the '
     &      , 'secondary shortwave spectral file.'
      ENDIF
!
      IF ((.NOT.L_GAS_INCLUDED(IP_O2)).AND.L_O2) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: Oxygen is not included in the shortwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     Set an appropriate reduced dimension.
      NPD_SPECIES_SD=MAX(N_ABSORB_RETAIN, 1)
!
!
      NPD_ESFT_TERM_SD=1
      IF (L_PRESENT(5)) THEN
         DO I=1, N_BAND
            DO J=1, N_BAND_ABSORB(I)
               IF (L_RETAIN_ABSORB(INDEX_ABSORB(J, I)))
     &            NPD_ESFT_TERM_SD=MAX(NPD_ESFT_TERM_SD
     &            , I_BAND_ESFT(I, INDEX_ABSORB(J, I)))
            ENDDO
         ENDDO
      ENDIF
!
      NPD_DROP_TYPE_SD=1
      IF (L_PRESENT(10)) THEN
         DO I=1, NPD_DROP_TYPE
            IF (L_DROP_TYPE(I)) THEN
               NPD_DROP_TYPE_SD=MAX(NPD_DROP_TYPE_SD, I)
            ENDIF
         ENDDO
      ENDIF
!
      NPD_ICE_TYPE_SD=1
      IF (L_PRESENT(12)) THEN
         DO I=1, NPD_ICE_TYPE
            IF (L_ICE_TYPE(I)) THEN
               NPD_ICE_TYPE_SD=MAX(NPD_ICE_TYPE_SD, I)
            ENDIF
         ENDDO
      ENDIF
!
!
!     Aerosols must be treated carefully to allow for various
!     different combinations without requiring the spectral file
!     to be too constrained. Only those required will be retained.
!
!     Basic initialization to safe values.
      NPD_HUMIDITIES_SD=1
      N_AEROSOL_RETAIN=0
!
!     Check the spectral file for climatological aerosols
      IF (L_CLIMAT_AEROSOL) THEN
!
         IF (L_PRESENT(11)) THEN
!
!           Search for the aerosols required for this scheme.
            N_AEROSOL_FOUND=0
            DO I=1, N_AEROSOL
!
               IF ( (TYPE_AEROSOL(I).EQ.IP_WATER_SOLUBLE).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_DUST_LIKE).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_OCEANIC).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_SOOT).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_SULPHURIC) ) THEN
                  N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1
                  INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I
                  N_AEROSOL_FOUND=N_AEROSOL_FOUND+1
               ENDIF

            ENDDO
!
            IF (N_AEROSOL_FOUND.NE.5) THEN
!
               IERR=I_ERR_FATAL
               CMESSAGE='The SW Spectral file lacks some '
     &            //'climatological aerosols.'
               RETURN
!
            ENDIF

         ELSE
!
            IERR=I_ERR_FATAL
            CMESSAGE='SW Spectral file contains no aerosol data.'
            RETURN
!
         ENDIF
!
      ENDIF

!
!     Check the spectral file for sulphate aerosols. (These are
!     required only for the direct effect).
!
      IF (L_USE_SULPC_DIRECT) THEN
!
         IF (L_PRESENT(11)) THEN
!
!           Search for the aerosols required for this scheme.
            N_AEROSOL_FOUND=0
            DO I=1, N_AEROSOL
!
               IF ( (TYPE_AEROSOL(I).EQ.IP_ACCUM_SULPHATE).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_AITKEN_SULPHATE) ) THEN
                  N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1
                  INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I
                  N_AEROSOL_FOUND=N_AEROSOL_FOUND+1
               ENDIF

            ENDDO
!
            IF (N_AEROSOL_FOUND.NE.2) THEN
!
               IERR=I_ERR_FATAL
               CMESSAGE='The SW Spectral file lacks some '
     &            //'sulphate aerosols.'
               RETURN
!
            ENDIF

         ELSE
!
            IERR=I_ERR_FATAL
            CMESSAGE='SW Spectral file contains no aerosol data.'
            RETURN
!
         ENDIF
!
      ENDIF
!
!
!     Check the spectral file for soot aerosol modes. (Also only
!     required for the direct effect).
!
      IF (L_USE_SOOT_DIRECT) THEN
!
         IF (L_PRESENT(11)) THEN ! aerosol block present in spec file
!
!           Search for the aerosols required for this scheme.
            N_AEROSOL_FOUND=0
            DO I=1, N_AEROSOL
!
               IF ( (TYPE_AEROSOL(I).EQ.IP_FRESH_SOOT).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_AGED_SOOT) ) THEN
                  N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1
                  INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I
                  N_AEROSOL_FOUND=N_AEROSOL_FOUND+1
               ENDIF
!
            ENDDO
!
            IF (N_AEROSOL_FOUND.NE.2) THEN
!
               IERR=I_ERR_FATAL
               CMESSAGE='The SW Spectral file lacks some '
     &            //'soot aerosol.'
               RETURN
!
            ENDIF

         ELSE
!
            IERR=I_ERR_FATAL
            CMESSAGE='SW Spectral file contains no aerosol data.'
            RETURN
!
         ENDIF
!
      ENDIF
!
!
!
!     Set an appropriate reduced dimension.
      NPD_AEROSOL_SPECIES_SD=MAX(N_AEROSOL_RETAIN, 1)
!
!     Set the allowed number of humidities from the number of
!     retained aerosols.
!
      IF (L_PRESENT(11)) THEN
         DO I=1, N_AEROSOL_RETAIN
            IF (I_AEROSOL_PARAMETRIZATION(INDEX_AEROSOL_RETAIN(I)).EQ.
     &         IP_AEROSOL_PARAM_MOIST) THEN
               NPD_HUMIDITIES_SD=MAX(NPD_HUMIDITIES_SD
     &            , NHUMIDITY(INDEX_AEROSOL_RETAIN(I)))
            ENDIF
         ENDDO
      ENDIF
!
!
!
!
!     TRANSFER THE LARGE NAMELIST TO THE REDUCED SPECTRUM.
!
!
      CALL R2_COMPRESS_SPECTRUM(
!                       Spectral Array in Namelist
     &     L_PRESENT
     &   , N_BAND, WAVE_LENGTH_SHORT , WAVE_LENGTH_LONG
     &   , N_BAND_EXCLUDE, INDEX_EXCLUDE
     &   , SOLAR_FLUX_BAND, RAYLEIGH_COEFFICIENT
     &   , N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB
     &   , L_RETAIN_ABSORB, N_ABSORB_RETAIN, INDEX_ABSORB_RETAIN
     &   , COMPRESSED_INDEX, I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT
     &   , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &   , N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK
     &   , I_SPEC_SURFACE, L_SURFACE, SURFACE_ALBEDO
     &   , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &   , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &   , P_REF_CONTINUUM, T_REF_CONTINUUM
     &   , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST
     &   , DROP_PARM_MIN_DIM, DROP_PARM_MAX_DIM
     &   , L_ICE_TYPE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST
     &   , ICE_PARM_MIN_DIM, ICE_PARM_MAX_DIM
     &   , N_AEROSOL, TYPE_AEROSOL
     &   , N_AEROSOL_RETAIN, INDEX_AEROSOL_RETAIN
     &   , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION
     &   , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &   , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
!                       Reduced Spectral Array
*CALL SSARG3AD
     &   )
!
!
!
      RETURN
      END
!+ Subroutine to read a longwave spectral namelist.
!
! Purpose:
!   To read a longwave namelist into a spectral array.
!
! Method:
!   The spectrum is read into the dynamically allocated array
!   and then reduced to a more manageable size.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!       Version         Date                    Comment
!       4.0             27-07-95                Original Code
!                                               (J. M. Edwards)
!
!       4.4             02-09-97                Aerosol flags passed
!                                               in to the code to
!                                               enable only those
!                                               required to be
!                                               selected. Spectral
!                                               data are no longer
!                                               compressed into a
!                                               single array.
!                                               IOSTAT error code
!                                               returned as part of
!                                               CMESSAGE.
!                                               (J. M. Edwards)
!       4.5        April 1998   Allow soot spectral data to be read.
!                                                     Luke Robinson.
!       4.5             18-05-98                Coding to allow
!                                               selection of gases
!                                               from the spectral
!                                               file.
!                                               (J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE R2_LW_SPECIN_D(IERR, CMESSAGE
     &   , L_CH4, L_N2O, L_CFC11, L_CFC12
     &   , L_CFC113, L_HCFC22, L_HFC125, L_HFC134A
     &   , L_CLIMAT_AEROSOL, L_USE_SULPC_DIRECT
     &   , L_USE_SOOT_DIRECT
     &   )
!
!
      IMPLICIT NONE
!
!
*CALL MXSIZE3A
*CALL ERROR3A
*CALL STDIO3A
!
!
!     DUMMY ARGUMENTS
      LOGICAL   !, INTENT(IN)
     &     L_CH4
!             ABSORPTION BY METHANE IS INCLUDED
     &   , L_N2O
!             ABSORPTION BY NITROUS OXIDE IS INCLUDED
     &   , L_CFC11
!             ABSORPTION BY CFC11 IS INCLUDED
     &   , L_CFC12
!             ABSORPTION BY CFC12 IS INCLUDED
     &   , L_CFC113
!             ABSORPTION BY CFC113 IS INCLUDED
     &   , L_HCFC22
!             ABSORPTION BY HCFC22 IS INCLUDED
     &   , L_HFC125
!             ABSORPTION BY HFC125 IS INCLUDED
     &   , L_HFC134A
!             ABSORPTION BY HFC134A IS INCLUDED
     &   , L_CLIMAT_AEROSOL
!             CLIMATOLOGICAL AEROSOLS ARE TO BE INCLUDED
     &   , L_USE_SULPC_DIRECT
!             THE DIRECT EFFECTS OF SULPHATE AEROSOLS ARE
!             TO BE INCLUDED
     &   , L_USE_SOOT_DIRECT
!             USE THE DIRECT RAD EFFECTS OF SOOT IN THE LW
!
      INTEGER   !, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      CHARACTER*80      !, INTENT(OUT)
     &     CMESSAGE
!
!
!
!     LOCAL VARIABLES.
!
!
!     RADIATIVE VARIABLES FOR REDUCING THE SPECTRUM
!
*CALL AERPRM3A
*CALL AERCMP3A
*CALL GASID3A
!
      CHARACTER
     &     LW_SPECTRAL_FILE*6
!             NAME OF FILE CONTAINING THE SPECTRAL DATA
      INTEGER
     &     IERR_GET_FILE
!             ERROR FLAG RETURNED BY GET_FILE (NOT NECESSARILY
!             CONSISTENT WITH THE FLAGS IN ERROR3A).
     &   , IOS
!             STATUS OF I/O
!
      LOGICAL
     &     L_RETAIN_ABSORB(NPD_SPECIES)
!             FLAG SET TO .TRUE. IF THE ABSORBER IS TO BE RETAINED
     &   , L_GAS_INCLUDED(NPD_GASES)
!             LOGICAL TO TEST FOR ACTUAL GASES INCLUDED
      INTEGER
     &     N_ABSORB_RETAIN
!             NUMBER OF ABSORBERS TO RETAIN
     &   , INDEX_ABSORB_RETAIN(NPD_SPECIES)
!             INDICES OF ABSORBERS TO BE RETAINED
     &   , COMPRESSED_INDEX(NPD_SPECIES)
!             MAPPING FROM OLD TO NEW INDICES OF ABSORBERS
     &   , N_AEROSOL_RETAIN
!             NUMBER OF AEROSOLS IN THE SPECTRAL FILE TO BE RETAINED
!             FOR THE RADIATIVE CALCULATION
     &   , INDEX_AEROSOL_RETAIN(NPD_AEROSOL_SPECIES)
!             INDEXING NUMBERS OF THE RETAINED AEROSOLS
     &   , N_AEROSOL_FOUND
!             NUMBER OF AEROSOLS FOR THE CURRENT GROUP OF PROCESSES
!             FOUND IN THE SPECTRAL FILE
!
!
!     DECLARE THE ELEMENTS OF THE INITIAL SPECTRUM FOR DYNAMIC
!     ALLOCATION AND SET UP AN APPROPRIATE NAMELIST.
!
*CALL SPDEC3A
*CALL LWSP3A
!
!
!     DECLARE THE REDUCED SW SPECTRAL FILE AND ITS HOLDING COMMON BLOCK.
!
*CALL LSPDL3AD
*CALL LSPCM3AD
!
!
!
!
!
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
!
      CHARACTER
     &     CH_IOS*5
!             CHARACTER STRING FOR IOSTAT ERROR
      CHARACTER*1
     &     GTJBID
!             FUNCTION FOR JOBID
      INTEGER
     &     IDUM
!             DUMMY INTEGER FOR CALL TO FUNCTION
!
!     SUBROUTINES CALLED
      EXTERNAL
     &     R2_COMPRESS_SPECTRUM
!
!
!     EACH BLOCK IS INITIALIZED AS MISSING:
      DATA L_PRESENT/.FALSE., NPD_TYPE*.FALSE./
!
!     INITIALIZE THE RANGE OF VALIDITY OF THE PARAMETRIZATIONS OF
!     DROPLETS AND ICE CRYSTALS. OLD SPECTRAL FILES WILL NOT CONTAIN
!     SUCH DATA, SO THE LIMITS FOR DROPLETS ARE INITIALIZED TO THOSE
!     FORMERLY SET IN THE MICROPHYSICAL SCHEME (MRF/UMIST
!     PARAMETRIZATION) TO ENSURE THAT THE RESULTS ARE BIT-REPRODUCIBLE.
!     VALUES FOR ICE COVER THE RANGE OF EFFECTIVE RADII USED IN
!     GENERATING THE DATA FOR THE ORIGINAL PARAMETRIZATION OF ICE
!     CRYSTALS.
!     AT SOME FUTURE RELEASE IT MAY BE DESIRABLE TO REMOVE DEFAULT
!     SETTINGS.
      DATA DROP_PARM_MIN_DIM/NPD_DROP_TYPE*3.5E-07/
      DATA DROP_PARM_MAX_DIM/NPD_DROP_TYPE*3.7E-05/
      DATA ICE_PARM_MIN_DIM/NPD_ICE_TYPE*3.75E-07/
      DATA ICE_PARM_MAX_DIM/NPD_ICE_TYPE*8.0E-05/
!
!
!
!     READ THE LONGWAVE SPECTRUM AS A NAMELIST.
      IDUM=0
      LW_SPECTRAL_FILE(1:6)='ftn80'//GTJBID(IDUM)
      OPEN(UNIT=80, FILE=LW_SPECTRAL_FILE, IOSTAT=IOS)
      PRINT *, 'Diagnostic Spectral File =', LW_SPECTRAL_FILE
      IF (IOS.NE.0) THEN
         IERR=I_ERR_IO
         WRITE(CH_IOS, '(I5)') IOS
         CMESSAGE='Error opening diagnostic longwave spectral file.'
     &      //' IOSTAT='//CH_IOS
         RETURN
      ENDIF
      READ(80, R2LWSP)
      CLOSE(80)
!
!     TEST FOR MINIMAL REQUISITE INFORMATION.
      IF ( .NOT.(L_PRESENT(0).AND.
     &           L_PRESENT(6) ) ) THEN
         CMESSAGE='Longwave spectrum is deficient.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!
!
!     SET REDUCED DIMENSIONS, EITHER FROM THE SIZES OF THE FIXED ARRAYS
!     OR FROM THE ARRAYS READ IN.
!
      NPD_TYPE_LD=NPD_TYPE
      NPD_BAND_LD=MAX(N_BAND, 1)
      NPD_SPECIES_LD=MAX(N_ABSORB, 1)
      NPD_ALBEDO_PARM_LD=NPD_ALBEDO_PARM
      NPD_SCALE_FNC_LD=NPD_SCALE_FNC
      NPD_SCALE_VARIABLE_LD=NPD_SCALE_VARIABLE
      NPD_SURFACE_LD=NPD_SURFACE
      NPD_CONTINUUM_LD=NPD_CONTINUUM
      NPD_THERMAL_COEFF_LD=N_DEG_FIT+1
      NPD_CLOUD_PARAMETER_LD=NPD_CLOUD_PARAMETER
!
!
!     SEARCH THE SPECTRUM TO FIND MAXIMUM DIMENSIONS.
!
      NPD_EXCLUDE_LD=1
      IF (L_PRESENT(14)) THEN
         DO I=1, N_BAND
            NPD_EXCLUDE_LD=MAX(NPD_EXCLUDE_LD, N_BAND_EXCLUDE(I))
         ENDDO
      ENDIF
!
!     Search the spectrum to find those gases to be retained.
!     Water vapour, carbon dioxide and ozone are included by
!     default if present, but a warning is printed if they are
!     not included.
      DO I=1, NPD_GASES
         L_GAS_INCLUDED(I)=.FALSE.
      ENDDO
      N_ABSORB_RETAIN=0
!
      DO I=1, N_ABSORB
!
         L_RETAIN_ABSORB(I)=.FALSE.
         COMPRESSED_INDEX(I)=0
!
         IF ( (TYPE_ABSORB(I).EQ.IP_H2O).OR.
     &        (TYPE_ABSORB(I).EQ.IP_CO2).OR.
     &        (TYPE_ABSORB(I).EQ.IP_O3).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_CH4).AND.L_CH4 ).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_N2O).AND.L_N2O ).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_CFC11).AND.L_CFC11 ).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_CFC12).AND.L_CFC12 ).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_CFC113).AND.L_CFC113 ).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_HCFC22).AND.L_HCFC22 ).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_HFC125).AND.L_HFC125 ).OR.
     &        ( (TYPE_ABSORB(I).EQ.IP_HFC134A).AND.L_HFC134A ) ) THEN
            N_ABSORB_RETAIN=N_ABSORB_RETAIN+1
            INDEX_ABSORB_RETAIN(N_ABSORB_RETAIN)=I
            COMPRESSED_INDEX(I)=N_ABSORB_RETAIN
            L_RETAIN_ABSORB(I)=.TRUE.
            L_GAS_INCLUDED(TYPE_ABSORB(I))=.TRUE.
         ENDIF
!
      ENDDO
!
!
!     Print warning messages if those gases normally expected
!     are not present.
      IF (.NOT.L_GAS_INCLUDED(IP_H2O)) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** WARNING: Water vapour is not included in the '
     &      , 'longwave spectral file.'
      ENDIF
!
      IF (.NOT.L_GAS_INCLUDED(IP_CO2)) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** WARNING: Carbon dioxide is not included in the '
     &      , 'longwave spectral file.'
      ENDIF
!
      IF (.NOT.L_GAS_INCLUDED(IP_O3)) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** WARNING: Ozone is not included in the '
     &      , 'longwave spectral file.'
      ENDIF
!
      IF ((.NOT.L_GAS_INCLUDED(IP_CH4)).AND.L_CH4) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: Methane is not included in the longwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
      IF ((.NOT.L_GAS_INCLUDED(IP_N2O)).AND.L_N2O) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: Nitrous oxide is not included in the longwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
      IF ((.NOT.L_GAS_INCLUDED(IP_CFC11)).AND.L_CFC11) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: CFC11 is not included in the longwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
      IF ((.NOT.L_GAS_INCLUDED(IP_CFC12)).AND.L_CFC12) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: CFC12 is not included in the longwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF!
      IF ((.NOT.L_GAS_INCLUDED(IP_CFC113)).AND.L_CFC113) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: CFC113 is not included in the longwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
      IF ((.NOT.L_GAS_INCLUDED(IP_HCFC22)).AND.L_HCFC22) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: HCFC22 is not included in the longwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
      IF ((.NOT.L_GAS_INCLUDED(IP_HFC125)).AND.L_HFC125) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: HFC125 is not included in the longwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
      IF ((.NOT.L_GAS_INCLUDED(IP_HFC134A)).AND.L_HFC134A) THEN
         WRITE(IU_ERR, '(/A, /A)')
     &      '*** ERROR: HFC134A is not included in the longwave '
     &      , 'secondary spectral file, but was requested in the run.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     Set an appropriate reduced dimension.
      NPD_SPECIES_LD=MAX(N_ABSORB_RETAIN, 1)
!
!
      NPD_ESFT_TERM_LD=1
      IF (L_PRESENT(5)) THEN
         DO I=1, N_BAND
            DO J=1, N_BAND_ABSORB(I)
               IF (L_RETAIN_ABSORB(INDEX_ABSORB(J, I)))
     &            NPD_ESFT_TERM_LD=MAX(NPD_ESFT_TERM_LD
     &            , I_BAND_ESFT(I, INDEX_ABSORB(J, I)))
            ENDDO
         ENDDO
      ENDIF
!
      NPD_DROP_TYPE_LD=1
      IF (L_PRESENT(10)) THEN
         DO I=1, NPD_DROP_TYPE
            IF (L_DROP_TYPE(I)) THEN
               NPD_DROP_TYPE_LD=MAX(NPD_DROP_TYPE_LD, I)
            ENDIF
         ENDDO
      ENDIF
!
      NPD_ICE_TYPE_LD=1
      IF (L_PRESENT(12)) THEN
         DO I=1, NPD_ICE_TYPE
            IF (L_ICE_TYPE(I)) THEN
               NPD_ICE_TYPE_LD=MAX(NPD_ICE_TYPE_LD, I)
            ENDIF
         ENDDO
      ENDIF
!
!
!
!     Aerosols must be treated carefully to allow for various
!     different combinations without requiring the spectral file
!     to be too constrained. Only those required will be retained.
!
!     Basic initialization to safe values.
      NPD_HUMIDITIES_LD=1
      N_AEROSOL_RETAIN=0
!
!     Check the spectral file for climatological aerosols
      IF (L_CLIMAT_AEROSOL) THEN
!
         IF (L_PRESENT(11)) THEN
!
!           Search for the aerosols required for this scheme.
            N_AEROSOL_FOUND=0
            DO I=1, N_AEROSOL
!
               IF ( (TYPE_AEROSOL(I).EQ.IP_WATER_SOLUBLE).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_DUST_LIKE).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_OCEANIC).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_SOOT).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_SULPHURIC) ) THEN
                  N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1
                  INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I
                  N_AEROSOL_FOUND=N_AEROSOL_FOUND+1
               ENDIF

            ENDDO
!
            IF (N_AEROSOL_FOUND.NE.5) THEN
!
               IERR=I_ERR_FATAL
               CMESSAGE='The LW Spectral file lacks some '
     &            //'climatological aerosols.'
               RETURN
!
            ENDIF

         ELSE
!
            IERR=I_ERR_FATAL
            CMESSAGE='LW Spectral file contains no aerosol data.'
            RETURN
!
         ENDIF
!
      ENDIF

!
!     Check the spectral file for sulphate aerosols. (These are
!     required only for the direct effect).
!
      IF (L_USE_SULPC_DIRECT) THEN
!
         IF (L_PRESENT(11)) THEN
!
!           Search for the aerosols required for this scheme.
            N_AEROSOL_FOUND=0
            DO I=1, N_AEROSOL
!
               IF ( (TYPE_AEROSOL(I).EQ.IP_ACCUM_SULPHATE).OR.
     &              (TYPE_AEROSOL(I).EQ.IP_AITKEN_SULPHATE) ) THEN
                  N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1
                  INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I
                  N_AEROSOL_FOUND=N_AEROSOL_FOUND+1
               ENDIF

            ENDDO
!
            IF (N_AEROSOL_FOUND.NE.2) THEN
!
               IERR=I_ERR_FATAL
               CMESSAGE='The LW Spectral file lacks some '
     &            //'sulphate aerosols.'
               RETURN
!
            ENDIF

         ELSE
!
            IERR=I_ERR_FATAL
            CMESSAGE='LW Spectral file contains no aerosol data.'
            RETURN
!
         ENDIF
!
      ENDIF
!
!     Check the spectral file for soot aerosols.
      IF (L_USE_SOOT_DIRECT) THEN
         IF (L_PRESENT(11)) THEN
!           Search for the aerosols required for this scheme.
            N_AEROSOL_FOUND=0
            DO I=1, N_AEROSOL
               IF ((TYPE_AEROSOL(I).EQ.IP_FRESH_SOOT) .OR.
     &             (TYPE_AEROSOL(I).EQ.IP_AGED_SOOT)) THEN
                  N_AEROSOL_RETAIN=N_AEROSOL_RETAIN+1
                  INDEX_AEROSOL_RETAIN(N_AEROSOL_RETAIN)=I
                  N_AEROSOL_FOUND=N_AEROSOL_FOUND+1
               ENDIF
            ENDDO
!
            IF (N_AEROSOL_FOUND.NE.2) THEN
!
               IERR=I_ERR_FATAL
               CMESSAGE='The LW Spectral file lacks some '
     &            //'soot aerosol data.'
               RETURN
!
            ENDIF
!
         ELSE
!
!
            IERR=I_ERR_FATAL
            CMESSAGE='LW Spectral file contains no soot data.'
            RETURN
!
         ENDIF
!
      ENDIF
!
!
!     Set an appropriate reduced dimension.
      NPD_AEROSOL_SPECIES_LD=MAX(N_AEROSOL_RETAIN, 1)
!
!     Set the allowed number of humidities from the number of
!     retained aerosols.
!
      IF (L_PRESENT(11)) THEN
         DO I=1, N_AEROSOL_RETAIN
            IF (I_AEROSOL_PARAMETRIZATION(INDEX_AEROSOL_RETAIN(I)).EQ.
     &         IP_AEROSOL_PARAM_MOIST) THEN
               NPD_HUMIDITIES_LD=MAX(NPD_HUMIDITIES_LD
     &            , NHUMIDITY(INDEX_AEROSOL_RETAIN(I)))
            ENDIF
         ENDDO
      ENDIF
!
!
!
!
!     TRANSFER THE LARGE NAMELIST TO THE REDUCED SPECTRUM.
!
!
      CALL R2_COMPRESS_SPECTRUM(
!                       Spectral Array in Namelist
     &     L_PRESENT
     &   , N_BAND, WAVE_LENGTH_SHORT , WAVE_LENGTH_LONG
     &   , N_BAND_EXCLUDE, INDEX_EXCLUDE
     &   , SOLAR_FLUX_BAND, RAYLEIGH_COEFFICIENT
     &   , N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB
     &   , L_RETAIN_ABSORB, N_ABSORB_RETAIN, INDEX_ABSORB_RETAIN
     &   , COMPRESSED_INDEX, I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT
     &   , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &   , N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK
     &   , I_SPEC_SURFACE, L_SURFACE, SURFACE_ALBEDO
     &   , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &   , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &   , P_REF_CONTINUUM, T_REF_CONTINUUM
     &   , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST
     &   , DROP_PARM_MIN_DIM, DROP_PARM_MAX_DIM
     &   , L_ICE_TYPE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST
     &   , ICE_PARM_MIN_DIM, ICE_PARM_MAX_DIM
     &   , N_AEROSOL, TYPE_AEROSOL
     &   , N_AEROSOL_RETAIN, INDEX_AEROSOL_RETAIN
     &   , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION
     &   , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &   , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
!                       Reduced Spectral Array
*CALL LSARG3AD
     &   )
!
!
!
      RETURN
      END
*/
*/ Comdecks matching those in the main code.
*/
*COMDECK LCARG3AD
!     ------------------------------------------------------------------
!     ARGUMENT LIST OF CONTROLLING OPTIONS FOR THE LONGWAVE RADIATION.
!
     &   ,
*CALL LCAVR3AD
!
!     ------------------------------------------------------------------
*COMDECK LCAVR3AD
!     ------------------------------------------------------------------
!     VARIABLES FOR CONTROLLING OPTIONS FOR THE LONGWAVE RADIATION.
!     (NOTE: LOPT3AD AND LCAVR3AD MUST BE CONSISTENT)
!
     &     I_2STREAM_LW_D, L_IR_SOURCE_QUAD_LW_D, I_GAS_OVERLAP_LW_D
     &   , I_CLOUD_LW_D, I_CLOUD_REPRESENTATION_LW_D, I_SOLVER_LW_D
     &   , L_N2O_LW_D, L_CH4_LW_D, L_CFC11_LW_D, L_CFC12_LW_D 
     &   , L_CFC113_LW_D, L_HCFC22_LW_D, L_HFC125_LW_D, L_HFC134A_LW_D
     &   , I_ST_WATER_LW_D
     &   , I_CNV_WATER_LW_D, I_ST_ICE_LW_D, I_CNV_ICE_LW_D
     &   , L_MICROPHYSICS_LW_D, L_LOCAL_CNV_PARTITION_LW_D
!
!     ------------------------------------------------------------------
*COMDECK LCOPT3AD
!     ------------------------------------------------------------------
!     COMMON BLOCK CONTAINING OPTIONS FOR 3A-RADIATION CODE.
!     VERSION FOR LONGWAVE CALCULATIONS.
!
      COMMON/R2LWOPTD/
!                       Algorithmic Options
*CALL LCAVR3AD
!
!     ------------------------------------------------------------------
*COMDECK LSARG3AD
!     ------------------------------------------------------------------
!     ARGUMENT LIST OF LW SPECTRAL DATA.
!     (NOTE: LSPDC3AD, LSPCM3AD AND LSARG3AD MUST BE CONSISTENT)
!
     &   , NPD_TYPE_LD, NPD_BAND_LD, NPD_EXCLUDE_LD
     &   , NPD_SPECIES_LD, NPD_ESFT_TERM_LD, NPD_SCALE_FNC_LD
     &   , NPD_SCALE_VARIABLE_LD
     &   , NPD_THERMAL_COEFF_LD
     &   , NPD_SURFACE_LD, NPD_ALBEDO_PARM_LD
     &   , NPD_CONTINUUM_LD
     &   , NPD_DROP_TYPE_LD, NPD_ICE_TYPE_LD, NPD_CLOUD_PARAMETER_LD
     &   , NPD_AEROSOL_SPECIES_LD, NPD_HUMIDITIES_LD
     &   , L_PRESENT_LD
     &   , N_BAND_LD, WAVE_LENGTH_SHORT_LD, WAVE_LENGTH_LONG_LD
     &   , N_BAND_EXCLUDE_LD, INDEX_EXCLUDE_LD
     &   , SOLAR_FLUX_BAND_LD, RAYLEIGH_COEFFICIENT_LD
     &   , N_ABSORB_LD, N_BAND_ABSORB_LD, INDEX_ABSORB_LD
     &   , TYPE_ABSORB_LD
     &   , I_BAND_ESFT_LD, I_SCALE_ESFT_LD, I_SCALE_FNC_LD
     &   , K_ESFT_LD, W_ESFT_LD
     &   , SCALE_VECTOR_LD, P_REFERENCE_LD, T_REFERENCE_LD
     &   , N_DEG_FIT_LD, THERMAL_COEFFICIENT_LD, T_REF_PLANCK_LD
     &   , I_SPEC_SURFACE_LD, N_DIR_ALBEDO_FIT_LD, L_SURFACE_LD
     &   , SURFACE_ALBEDO_LD, DIRECT_ALBEDO_PARM_LD
     &   , EMISSIVITY_GROUND_LD
     &   , N_BAND_CONTINUUM_LD, INDEX_CONTINUUM_LD, INDEX_WATER_LD
     &   , I_SCALE_FNC_CONT_LD, K_CONTINUUM_LD
     &   , SCALE_CONTINUUM_LD, P_REF_CONTINUUM_LD, T_REF_CONTINUUM_LD
     &   , I_DROP_PARAMETRIZATION_LD, L_DROP_TYPE_LD
     &   , DROP_PARAMETER_LIST_LD
     &   , DROP_PARM_MIN_DIM_LD, DROP_PARM_MAX_DIM_LD
     &   , N_AEROSOL_LD, TYPE_AEROSOL_LD
     &   , I_AEROSOL_PARAMETRIZATION_LD
     &   , NHUMIDITY_LD, HUMIDITIES_LD, L_AEROSOL_SPECIES_LD
     &   , AEROSOL_ABSORPTION_LD, AEROSOL_SCATTERING_LD
     &   , AEROSOL_ASYMMETRY_LD
     &   , I_ICE_PARAMETRIZATION_LD, L_ICE_TYPE_LD
     &   , ICE_PARAMETER_LIST_LD
     &   , ICE_PARM_MIN_DIM_LD, ICE_PARM_MAX_DIM_LD
     &   , L_DOPPLER_PRESENT_LD, DOPPLER_CORRECTION_LD
!
!     ------------------------------------------------------------------
*COMDECK LSPDC3AD
!     ------------------------------------------------------------------
!     COMDECK FOR TWO-STREAM RADIATION CODE.
!
!     MODULE CONTAINING DECLARATIONS FOR REDUCED LW-SPECTRAL FILE.
!     (NOTE: LSPDC3AD, LSPCM3AD AND LSARG3AD MUST BE CONSISTENT)
!     ------------------------------------------------------------------
!
!
!     DIMENSIONS FOR THE REDUCED LW SPECTRAL FILE
!
      INTEGER
     &     NPD_TYPE_LD
!             NUMBER OF TYPES OF DATA IN LW SPECTRUM
     &   , NPD_BAND_LD
!             NUMBER OF SPECTRAL BANDS IN LW SPECTRUM
     &   , NPD_EXCLUDE_LD
!             NUMBER OF EXCLUDED BANDS IN LW SPECTRUM
     &   , NPD_SPECIES_LD
!             NUMBER OF GASEOUS SPECIES IN LW SPECTRUM
     &   , NPD_ESFT_TERM_LD
!             NUMBER OF ESFT TERMS IN LW SPECTRUM
     &   , NPD_SCALE_FNC_LD
!             NUMBER OF SCALING FUNCTIONS IN LW SPECTRUM
     &   , NPD_SCALE_VARIABLE_LD
!             NUMBER OF SCALING VARIABLES IN LW SPECTRUM
     &   , NPD_SURFACE_LD
!             NUMBER OF SURFACE TYPES IN LW SPECTRUM
     &   , NPD_ALBEDO_PARM_LD
!             NUMBER OF ALBEDO PARAMETERS IN LW SPECTRUM
     &   , NPD_CONTINUUM_LD
!             NUMBER OF CONTINUA IN LW SPECTRUM
     &   , NPD_DROP_TYPE_LD
!             NUMBER OF DROP TYPES IN LW SPECTRUM
     &   , NPD_ICE_TYPE_LD
!             NUMBER OF ICE CRYSTAL TYPES IN LW SPECTRUM
     &   , NPD_AEROSOL_SPECIES_LD
!             NUMBER OF AEROSOL SPECIES IN LW SPECTRUM
     &   , NPD_CLOUD_PARAMETER_LD
!             MAX NUMBER OF CLOUD PARAMETERS IN LW SPECTRUM
     &   , NPD_HUMIDITIES_LD
!             MAXIMUM NUMBER OF HUMIDITIES IN LW SPECTRUM
     &   , NPD_THERMAL_COEFF_LD
!             NUMBER OF THERMAL COEFFICIENTS IN LW SPECTRUM
!
!
!
!     GENERAL FIELDS:
!
      LOGICAL
     &     L_PRESENT_LD(0: NPD_TYPE_LD)
!             FLAG FOR TYPES OF DATA PRESENT
!
!
!
!     PROPERTIES OF THE SPECTRAL BANDS:
!
      INTEGER
     &     N_BAND_LD
!             NUMBER OF SPECTRAL BANDS
!
      REAL
     &     WAVE_LENGTH_SHORT_LD(NPD_BAND_LD)
!             SHORTER WAVELENGTH LIMITS
     &   , WAVE_LENGTH_LONG_LD(NPD_BAND_LD)
!             LONGER WAVELENGTH LIMITS
!
!
!
!     EXCLUSION OF SPECIFIC BANDS FROM PARTS OF THE SPECTRUM:
!
      INTEGER
     &     N_BAND_EXCLUDE_LD(NPD_BAND_LD)
!             NUMBER OF EXCLUDED BANDS WITHIN EACH SPECTRAL BAND
     &   , INDEX_EXCLUDE_LD(NPD_EXCLUDE_LD, NPD_BAND_LD)
!             INDICES OF EXCLUDED BANDS
!
!
!
!     FIELDS FOR THE SOLAR FLUX:
!
      REAL
     &     SOLAR_FLUX_BAND_LD(NPD_BAND_LD)
!             FRACTION OF THE INCIDENT SOLAR FLUX IN EACH BAND
!
!
!
!     FIELDS FOR RAYLEIGH SCATTERING:
!
      REAL
     &     RAYLEIGH_COEFFICIENT_LD(NPD_BAND_LD)
!             RAYLEIGH COEFFICIENTS
!
!
!
!     FIELDS FOR GASEOUS ABSORPTION:
!
      INTEGER
     &     N_ABSORB_LD
!             NUMBER OF ABSORBERS
     &   , N_BAND_ABSORB_LD(NPD_BAND_LD)
!             NUMBER OF ABSORBERS IN EACH BAND
     &   , INDEX_ABSORB_LD(NPD_SPECIES_LD, NPD_BAND_LD)
!             LIST OF ABSORBERS IN EACH BAND
     &   , TYPE_ABSORB_LD(NPD_SPECIES_LD)
!             TYPES OF EACH GAS IN THE SPECTRAL FILE
     &   , I_BAND_ESFT_LD(NPD_BAND_LD, NPD_SPECIES_LD)
!             NUMBER OF ESFT TERMS IN EACH BAND FOR EACH GAS
     &   , I_SCALE_ESFT_LD(NPD_BAND_LD, NPD_SPECIES_LD)
!             TYPE OF ESFT SCALING
     &   , I_SCALE_FNC_LD(NPD_BAND_LD, NPD_SPECIES_LD)
!             TYPE OF SCALING FUNCTION
!
      REAL
     &     K_ESFT_LD(NPD_ESFT_TERM_LD, NPD_BAND_LD, NPD_SPECIES_LD)
!             ESFT EXPONENTS
     &   , W_ESFT_LD(NPD_ESFT_TERM_LD, NPD_BAND_LD, NPD_SPECIES_LD)
!             ESFT WEIGHTS
     &   , SCALE_VECTOR_LD(NPD_SCALE_VARIABLE_LD, NPD_ESFT_TERM_LD
     &        , NPD_BAND_LD, NPD_SPECIES_LD)
!             SCALING PARAMETERS FOR EACH ABSORBER AND TERM
     &   , P_REFERENCE_LD(NPD_SPECIES_LD, NPD_BAND_LD)
!             REFERENCE PRESSURE FOR SCALING FUNCTION
     &   , T_REFERENCE_LD(NPD_SPECIES_LD, NPD_BAND_LD)
!             REFERENCE TEMPERATURE FOR SCALING FUNCTION
!
!
!
!     REPRESENTATION OF THE PLANCKIAN:
!
      INTEGER
     &     N_DEG_FIT_LD
!             DEGREE OF THERMAL POLYNOMIAL
!
      REAL
     &     THERMAL_COEFFICIENT_LD(0: NPD_THERMAL_COEFF_LD-1
     &   , NPD_BAND_LD)
!             COEFFICIENTS IN POLYNOMIAL FIT TO SOURCE FUNCTION
     &   , T_REF_PLANCK_LD
!             PLANCKIAN REFERENCE TEMPERATURE
!
!
!
!     SURFACE PROPERTIES:
!
      INTEGER
     &     I_SPEC_SURFACE_LD(NPD_SURFACE_LD)
!             METHOD OF SPECIFYING PROPERTIES OF SURFACE
     &   , N_DIR_ALBEDO_FIT_LD(NPD_SURFACE_LD)
!             NUMBER OF PARAMETERS FITTING THE DIRECT ALBEDO
!
      LOGICAL
     &     L_SURFACE_LD(NPD_SURFACE_LD)
!             SURFACE TYPES INCLUDED
!
      REAL
     &     SURFACE_ALBEDO_LD(NPD_BAND_LD, NPD_SURFACE_LD)
!             SURFACE ALBEDOS
     &   , DIRECT_ALBEDO_PARM_LD(0: NPD_ALBEDO_PARM_LD
     &      , NPD_BAND_LD, NPD_SURFACE_LD)
!             COEFFICIENTS FOR FITTING DIRECT ALBEDO
     &   , EMISSIVITY_GROUND_LD(NPD_BAND_LD, NPD_SURFACE_LD)
!             SURFACE EMISSIVITIES
!
!
!
!     FIELDS FOR CONTINUA:
!
      INTEGER
     &     N_BAND_CONTINUUM_LD(NPD_BAND_LD)
!             NUMBER OF CONTINUA IN EACH BAND
     &   , INDEX_CONTINUUM_LD(NPD_BAND_LD, NPD_CONTINUUM_LD)
!             LIST OF CONTINUA IN EACH BAND
     &   , INDEX_WATER_LD
!             INDEX OF WATER VAPOUR
     &   , I_SCALE_FNC_CONT_LD(NPD_BAND_LD, NPD_CONTINUUM_LD)
!             TYPE OF SCALING FUNCTION FOR CONTINUUM
!
      REAL
     &     K_CONTINUUM_LD(NPD_BAND_LD, NPD_CONTINUUM_LD)
!             GREY EXTINCTION COEFFICIENTS FOR CONTINUUM
     &   , SCALE_CONTINUUM_LD(NPD_SCALE_VARIABLE_LD
     &      , NPD_BAND_LD, NPD_CONTINUUM_LD)
!             SCALING PARAMETERS FOR CONTINUUM
     &   , P_REF_CONTINUUM_LD(NPD_CONTINUUM_LD, NPD_BAND_LD)
!             REFERENCE PRESSURE FOR SCALING OF CONTINUUM
     &   , T_REF_CONTINUUM_LD(NPD_CONTINUUM_LD, NPD_BAND_LD)
!             REFERENCE TEMPERATURE FOR SCALING OF CONTINUUM
!
!
!
!     FIELDS FOR WATER DROPLETS:
!
      INTEGER
     &     I_DROP_PARAMETRIZATION_LD(NPD_DROP_TYPE_LD)
!             PARAMETRIZATION TYPE OF DROPLETS
!
      LOGICAL
     &     L_DROP_TYPE_LD(NPD_DROP_TYPE_LD)
!             TYPES OF DROPLET PRESENT
!
      REAL
     &     DROP_PARAMETER_LIST_LD(NPD_CLOUD_PARAMETER_LD
     &        , NPD_BAND_LD, NPD_DROP_TYPE_LD)
!             PARAMETERS USED TO FIT OPTICAL PROPERTIES OF CLOUDS
     &   , DROP_PARM_MIN_DIM_LD(NPD_DROP_TYPE_LD)
!             MINIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
     &   , DROP_PARM_MAX_DIM_LD(NPD_DROP_TYPE_LD)
!             MAXIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
!
!
!
!     FIELDS FOR AEROSOLS:
!
      INTEGER
     &     N_AEROSOL_LD
!             NUMBER OF SPECIES OF AEROSOL
     &   , TYPE_AEROSOL_LD(NPD_AEROSOL_SPECIES_LD)
!             TYPES OF AEROSOLS
     &   , I_AEROSOL_PARAMETRIZATION_LD(NPD_AEROSOL_SPECIES_LD)
!             PARAMETRIZATION OF AEROSOLS
     &   , NHUMIDITY_LD(NPD_AEROSOL_SPECIES_LD)
!             NUMBERS OF HUMIDITIES
!
      LOGICAL
     &     L_AEROSOL_SPECIES_LD(NPD_AEROSOL_SPECIES_LD)
!             AEROSOL SPECIES INCLUDED
!
      REAL
     &     AEROSOL_ABSORPTION_LD(NPD_HUMIDITIES_LD
     &        , NPD_AEROSOL_SPECIES_LD, NPD_BAND_LD)
!             ABSORPTION BY AEROSOLS
     &   , AEROSOL_SCATTERING_LD(NPD_HUMIDITIES_LD
     &        , NPD_AEROSOL_SPECIES_LD, NPD_BAND_LD)
!             SCATTERING BY AEROSOLS
     &   , AEROSOL_ASYMMETRY_LD(NPD_HUMIDITIES_LD
     &        , NPD_AEROSOL_SPECIES_LD, NPD_BAND_LD)
!             ASYMMETRY OF AEROSOLS
     &   , HUMIDITIES_LD(NPD_HUMIDITIES_LD, NPD_AEROSOL_SPECIES_LD)
!             HUMIDITIES FOR COMPONENTS
!
!
!
!     FIELDS FOR ICE CRYSTALS:
!
      INTEGER
     &     I_ICE_PARAMETRIZATION_LD(NPD_ICE_TYPE_LD)
!             TYPES OF PARAMETRIZATION OF ICE CRYSTALS
!
      LOGICAL
     &     L_ICE_TYPE_LD(NPD_ICE_TYPE_LD)
!             TYPES OF ICE CRYSTAL PRESENT
!
      REAL
     &     ICE_PARAMETER_LIST_LD(NPD_CLOUD_PARAMETER_LD
     &        , NPD_BAND_LD, NPD_ICE_TYPE_LD)
!             PARAMETERS USED TO FIT SINGLE SCATTERING OF ICE CRYSTALS
     &   , ICE_PARM_MIN_DIM_LD(NPD_ICE_TYPE_LD)
!             MINIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
     &   , ICE_PARM_MAX_DIM_LD(NPD_ICE_TYPE_LD)
!             MAXIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
!
!
!
!     FIELDS FOR DOPPLER BROADENING:
!
      LOGICAL
     &     L_DOPPLER_PRESENT_LD(NPD_SPECIES_LD)
!             FLAG FOR DOPPLER BROADENING FOR EACH SPECIES
!
      REAL
     &     DOPPLER_CORRECTION_LD(NPD_SPECIES_LD)
!             OFFSET TO PRESSURE TO REPRESENT DOPPLER BROADENING
!
!
!
!    ------------------------------------------------------------------
*COMDECK LSPDL3AD
!     ------------------------------------------------------------------
!     COMDECK FOR TWO-STREAM RADIATION CODE.
!
!     MODULE CONTAINING DECLARATIONS FOR REDUCED LW-SPECTRAL FILE.
!     NOTE: LSPDC3AD, LSPCM3AD AND LSARG3AD MUST BE CONSISTENT.
!     NOTE: SINCE THE ARRAYS HERE WILL BE PASSED IN A COMMON BLOCK
!     THEIR SIZES MUST BE FIXED, EVEN THOUGH VARIABLE SIZES ARE USED
!     LOWER IN THE CODE. THEY ARE ACCORDINGLY DEFINED AS 1-DIMENSIONAL
!     ARRAYS WITH FIXED MAXIMUM SIZES AT THIS LEVEL.
!
!     ------------------------------------------------------------------
!
!
!     DIMENSIONS FOR THE REDUCED LW SPECTRAL FILE
!
      INTEGER
     &     NPD_TYPE_LD
!             NUMBER OF TYPES OF DATA IN LW SPECTRUM
     &   , NPD_BAND_LD
!             NUMBER OF SPECTRAL BANDS IN LW SPECTRUM
     &   , NPD_EXCLUDE_LD
!             NUMBER OF EXCLUDED BANDS IN LW SPECTRUM
     &   , NPD_SPECIES_LD
!             NUMBER OF GASEOUS SPECIES IN LW SPECTRUM
     &   , NPD_ESFT_TERM_LD
!             NUMBER OF ESFT TERMS IN LW SPECTRUM
     &   , NPD_SCALE_FNC_LD
!             NUMBER OF SCALING FUNCTIONS IN LW SPECTRUM
     &   , NPD_SCALE_VARIABLE_LD
!             NUMBER OF SCALING VARIABLES IN LW SPECTRUM
     &   , NPD_SURFACE_LD
!             NUMBER OF SURFACE TYPES IN LW SPECTRUM
     &   , NPD_ALBEDO_PARM_LD
!             NUMBER OF ALBEDO PARAMETERS IN LW SPECTRUM
     &   , NPD_CONTINUUM_LD
!             NUMBER OF CONTINUA IN LW SPECTRUM
     &   , NPD_DROP_TYPE_LD
!             NUMBER OF DROP TYPES IN LW SPECTRUM
     &   , NPD_ICE_TYPE_LD
!             NUMBER OF ICE CRYSTAL TYPES IN LW SPECTRUM
     &   , NPD_AEROSOL_SPECIES_LD
!             NUMBER OF AEROSOL SPECIES IN LW SPECTRUM
     &   , NPD_CLOUD_PARAMETER_LD
!             MAX NUMBER OF CLOUD PARAMETERS IN LW SPECTRUM
     &   , NPD_HUMIDITIES_LD
!             MAXIMUM NUMBER OF HUMIDITIES IN LW SPECTRUM
     &   , NPD_THERMAL_COEFF_LD
!             NUMBER OF THERMAL COEFFICIENTS IN LW SPECTRUM
!
!
!
!     GENERAL FIELDS:
!
      LOGICAL
     &     L_PRESENT_LD(0: NPD_TYPE)
!             FLAG FOR TYPES OF DATA PRESENT
!
!
!
!     PROPERTIES OF THE SPECTRAL BANDS:
!
      INTEGER
     &     N_BAND_LD
!             NUMBER OF SPECTRAL BANDS
!
      REAL
     &     WAVE_LENGTH_SHORT_LD(NPD_BAND)
!             SHORTER WAVELENGTH LIMITS
     &   , WAVE_LENGTH_LONG_LD(NPD_BAND)
!             LONGER WAVELENGTH LIMITS
!
!
!
!     EXCLUSION OF SPECIFIC BANDS FROM PARTS OF THE SPECTRUM:
!
      INTEGER
     &     N_BAND_EXCLUDE_LD(NPD_BAND)
!             NUMBER OF EXCLUDED BANDS WITHIN EACH SPECTRAL BAND
     &   , INDEX_EXCLUDE_LD(NPD_EXCLUDE, NPD_BAND)
!             INDICES OF EXCLUDED BANDS
!
!
!
!     FIELDS FOR THE SOLAR FLUX:
!
      REAL
     &     SOLAR_FLUX_BAND_LD(NPD_BAND)
!             FRACTION OF THE INCIDENT SOLAR FLUX IN EACH BAND
!
!
!
!     FIELDS FOR RAYLEIGH SCATTERING:
!
      REAL
     &     RAYLEIGH_COEFFICIENT_LD(NPD_BAND)
!             RAYLEIGH COEFFICIENTS
!
!
!
!     FIELDS FOR GASEOUS ABSORPTION:
!
      INTEGER
     &     N_ABSORB_LD
!             NUMBER OF ABSORBERS
     &   , N_BAND_ABSORB_LD(NPD_BAND)
!             NUMBER OF ABSORBERS IN EACH BAND
     &   , INDEX_ABSORB_LD(NPD_SPECIES, NPD_BAND)
!             LIST OF ABSORBERS IN EACH BAND
     &   , TYPE_ABSORB_LD(NPD_SPECIES)
!             TYPES OF EACH GAS IN THE SPECTRAL FILE
     &   , I_BAND_ESFT_LD(NPD_BAND, NPD_SPECIES)
!             NUMBER OF ESFT TERMS IN EACH BAND FOR EACH GAS
     &   , I_SCALE_ESFT_LD(NPD_BAND, NPD_SPECIES)
!             TYPE OF ESFT SCALING
     &   , I_SCALE_FNC_LD(NPD_BAND, NPD_SPECIES)
!             TYPE OF SCALING FUNCTION
!
      REAL
     &     K_ESFT_LD(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             ESFT EXPONENTS
     &   , W_ESFT_LD(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             ESFT WEIGHTS
     &   , SCALE_VECTOR_LD(NPD_SCALE_VARIABLE, NPD_ESFT_TERM
     &        , NPD_BAND, NPD_SPECIES)
!             SCALING PARAMETERS FOR EACH ABSORBER AND TERM
     &   , P_REFERENCE_LD(NPD_SPECIES, NPD_BAND)
!             REFERENCE PRESSURE FOR SCALING FUNCTION
     &   , T_REFERENCE_LD(NPD_SPECIES, NPD_BAND)
!             REFERENCE TEMPERATURE FOR SCALING FUNCTION
!
!
!
!     REPRESENTATION OF THE PLANCKIAN:
!
      INTEGER
     &     N_DEG_FIT_LD
!             DEGREE OF THERMAL POLYNOMIAL
!
      REAL
     &     THERMAL_COEFFICIENT_LD(0: NPD_THERMAL_COEFF-1
     &        , NPD_BAND)
!             COEFFICIENTS IN POLYNOMIAL FIT TO SOURCE FUNCTION
     &   , T_REF_PLANCK_LD
!             PLANCKIAN REFERENCE TEMPERATURE
!
!
!
!     SURFACE PROPERTIES:
!
      INTEGER
     &     I_SPEC_SURFACE_LD(NPD_SURFACE)
!             METHOD OF SPECIFYING PROPERTIES OF SURFACE
     &   , N_DIR_ALBEDO_FIT_LD(NPD_SURFACE)
!             NUMBER OF PARAMETERS FITTING THE DIRECT ALBEDO
!
      LOGICAL
     &     L_SURFACE_LD(NPD_SURFACE)
!             SURFACE TYPES INCLUDED
!
      REAL
     &     SURFACE_ALBEDO_LD(NPD_BAND, NPD_SURFACE)
!             SURFACE ALBEDOS
     &   , DIRECT_ALBEDO_PARM_LD(0: NPD_ALBEDO_PARM
     &      , NPD_BAND, NPD_SURFACE)
!             COEFFICIENTS FOR FITTING DIRECT ALBEDO
     &   , EMISSIVITY_GROUND_LD(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
!
!
!
!     FIELDS FOR CONTINUA:
!
      INTEGER
     &     N_BAND_CONTINUUM_LD(NPD_BAND)
!             NUMBER OF CONTINUA IN EACH BAND
     &   , INDEX_CONTINUUM_LD(NPD_BAND, NPD_CONTINUUM)
!             LIST OF CONTINUA IN EACH BAND
     &   , INDEX_WATER_LD
!             INDEX OF WATER VAPOUR
     &   , I_SCALE_FNC_CONT_LD(NPD_BAND, NPD_CONTINUUM)
!             TYPE OF SCALING FUNCTION FOR CONTINUUM
!
      REAL
     &     K_CONTINUUM_LD(NPD_BAND, NPD_CONTINUUM)
!             GREY EXTINCTION COEFFICIENTS FOR CONTINUUM
     &   , SCALE_CONTINUUM_LD(NPD_SCALE_VARIABLE
     &      , NPD_BAND, NPD_CONTINUUM)
!             SCALING PARAMETERS FOR CONTINUUM
     &   , P_REF_CONTINUUM_LD(NPD_CONTINUUM, NPD_BAND)
!             REFERENCE PRESSURE FOR SCALING OF CONTINUUM
     &   , T_REF_CONTINUUM_LD(NPD_CONTINUUM, NPD_BAND)
!             REFERENCE TEMPERATURE FOR SCALING OF CONTINUUM
!
!
!
!     FIELDS FOR WATER DROPLETS:
!
      INTEGER
     &     I_DROP_PARAMETRIZATION_LD(NPD_DROP_TYPE)
!             PARAMETRIZATION TYPE OF DROPLETS
!
      LOGICAL
     &     L_DROP_TYPE_LD(NPD_DROP_TYPE)
!             TYPES OF DROPLET PRESENT
!
      REAL
     &     DROP_PARAMETER_LIST_LD(NPD_CLOUD_PARAMETER
     &        , NPD_BAND, NPD_DROP_TYPE)
!             PARAMETERS USED TO FIT OPTICAL PROPERTIES OF CLOUDS
     &   , DROP_PARM_MIN_DIM_LD(NPD_DROP_TYPE)
!             MINIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
     &   , DROP_PARM_MAX_DIM_LD(NPD_DROP_TYPE)
!             MAXIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
!
!
!
!     FIELDS FOR AEROSOLS:
!
      INTEGER
     &     N_AEROSOL_LD
!             NUMBER OF SPECIES OF AEROSOL
     &   , TYPE_AEROSOL_LD(NPD_AEROSOL_SPECIES)
!             TYPES OF AEROSOLS
     &   , I_AEROSOL_PARAMETRIZATION_LD(NPD_AEROSOL_SPECIES)
!             PARAMETRIZATION OF AEROSOLS
     &   , NHUMIDITY_LD(NPD_AEROSOL_SPECIES)
!             NUMBERS OF HUMIDITIES
!
      LOGICAL
     &     L_AEROSOL_SPECIES_LD(NPD_AEROSOL_SPECIES)
!             AEROSOL SPECIES INCLUDED
!
      REAL
     &     AEROSOL_ABSORPTION_LD(NPD_HUMIDITIES
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             ABSORPTION BY AEROSOLS
     &   , AEROSOL_SCATTERING_LD(NPD_HUMIDITIES
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             SCATTERING BY AEROSOLS
     &   , AEROSOL_ASYMMETRY_LD(NPD_HUMIDITIES
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             ASYMMETRY OF AEROSOLS
     &   , HUMIDITIES_LD(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)
!             HUMIDITIES FOR COMPONENTS
!
!
!
!     FIELDS FOR ICE CRYSTALS:
!
      INTEGER
     &     I_ICE_PARAMETRIZATION_LD(NPD_ICE_TYPE)
!             TYPES OF PARAMETRIZATION OF ICE CRYSTALS
!
      LOGICAL
     &     L_ICE_TYPE_LD(NPD_ICE_TYPE)
!             TYPES OF ICE CRYSTAL PRESENT
!
      REAL
     &     ICE_PARAMETER_LIST_LD(NPD_CLOUD_PARAMETER
     &        , NPD_BAND, NPD_ICE_TYPE)
!             PARAMETERS USED TO FIT SINGLE SCATTERING OF ICE CRYSTALS
     &   , ICE_PARM_MIN_DIM_LD(NPD_ICE_TYPE)
!             MINIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
     &   , ICE_PARM_MAX_DIM_LD(NPD_ICE_TYPE)
!             MAXIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
!
!
!
!     FIELDS FOR DOPPLER BROADENING:
!
      LOGICAL
     &     L_DOPPLER_PRESENT_LD(NPD_SPECIES)
!             FLAG FOR DOPPLER BROADENING FOR EACH SPECIES
!
      REAL
     &     DOPPLER_CORRECTION_LD(NPD_SPECIES)
!             OFFSET TO PRESSURE TO REPRESENT DOPPLER BROADENING
!
!
!
!    ------------------------------------------------------------------
*COMDECK SCARG3AD
!     ------------------------------------------------------------------
!     ARGUMENT LIST OF CONTROLLING OPTIONS FOR SHORTWAVE RADIATION.
!
     &,
*CALL SCAVR3AD
!
!     ------------------------------------------------------------------
*COMDECK SCOPT3AD
!     ------------------------------------------------------------------
!     COMMON BLOCK CONTAINING OPTIONS FOR 3A-RADIATION CODE.
!     VERSION FOR SHORTWAVE CALCULATIONS.
!
      COMMON/R2SWOPTC/
*CALL SCAVR3AD
!
!     ------------------------------------------------------------------
*COMDECK SCAVR3AD
!     ------------------------------------------------------------------
!     VARIABLES FOR CONTROLLING OPTIONS FOR SHORTWAVE RADIATION.
!
!                       Algorithmic Options
     &     I_2STREAM_SW_D, I_GAS_OVERLAP_SW_D, I_CLOUD_SW_D  
     &   , I_CLOUD_REPRESENTATION_SW_D, I_SOLVER_SW_D
     &   , L_O2_SW_D, I_ST_WATER_SW_D
     &   , I_CNV_WATER_SW_D, I_ST_ICE_SW_D, I_CNV_ICE_SW_D
     &   , L_LOCAL_CNV_PARTITION_SW_D
!
!     ------------------------------------------------------------------
*COMDECK SSARG3AD
!     ------------------------------------------------------------------
!     ARGUMENT LIST FOR THE REDUCED SW SPECTRAL FILE.
!     (NOTE: SSPDC3AD, SSPCM3AD AND SSARG3AD MUST BE CONSISTENT)
!
     &   , NPD_TYPE_SD, NPD_BAND_SD, NPD_EXCLUDE_SD
     &   , NPD_SPECIES_SD, NPD_ESFT_TERM_SD, NPD_SCALE_FNC_SD
     &   , NPD_SCALE_VARIABLE_SD, NPD_THERMAL_COEFF_SD
     &   , NPD_SURFACE_SD, NPD_ALBEDO_PARM_SD, NPD_CONTINUUM_SD
     &   , NPD_DROP_TYPE_SD, NPD_ICE_TYPE_SD, NPD_CLOUD_PARAMETER_SD
     &   , NPD_AEROSOL_SPECIES_SD, NPD_HUMIDITIES_SD
     &   , L_PRESENT_SD, N_BAND_SD, WAVE_LENGTH_SHORT_SD
     &   , WAVE_LENGTH_LONG_SD, N_BAND_EXCLUDE_SD, INDEX_EXCLUDE_SD
     &   , SOLAR_FLUX_BAND_SD, RAYLEIGH_COEFFICIENT_SD
     &   , N_ABSORB_SD, N_BAND_ABSORB_SD, INDEX_ABSORB_SD
     &   , TYPE_ABSORB_SD, I_BAND_ESFT_SD, I_SCALE_ESFT_SD
     &   , I_SCALE_FNC_SD, K_ESFT_SD, W_ESFT_SD
     &   , SCALE_VECTOR_SD, P_REFERENCE_SD, T_REFERENCE_SD
     &   , N_DEG_FIT_SD, THERMAL_COEFFICIENT_SD, T_REF_PLANCK_SD
     &   , I_SPEC_SURFACE_SD, N_DIR_ALBEDO_FIT_SD, L_SURFACE_SD
     &   , SURFACE_ALBEDO_SD, DIRECT_ALBEDO_PARM_SD
     &   , EMISSIVITY_GROUND_SD, N_BAND_CONTINUUM_SD, INDEX_CONTINUUM_SD
     &   , INDEX_WATER_SD, I_SCALE_FNC_CONT_SD, K_CONTINUUM_SD
     &   , SCALE_CONTINUUM_SD, P_REF_CONTINUUM_SD, T_REF_CONTINUUM_SD
     &   , I_DROP_PARAMETRIZATION_SD, L_DROP_TYPE_SD
     &   , DROP_PARAMETER_LIST_SD 
     &   , DROP_PARM_MIN_DIM_SD, DROP_PARM_MAX_DIM_SD
     &   , N_AEROSOL_SD, TYPE_AEROSOL_SD, I_AEROSOL_PARAMETRIZATION_SD
     &   , NHUMIDITY_SD, HUMIDITIES_SD, L_AEROSOL_SPECIES_SD
     &   , AEROSOL_ABSORPTION_SD, AEROSOL_SCATTERING_SD
     &   , AEROSOL_ASYMMETRY_SD
     &   , I_ICE_PARAMETRIZATION_SD, L_ICE_TYPE_SD 
     &   , ICE_PARAMETER_LIST_SD
     &   , ICE_PARM_MIN_DIM_SD, ICE_PARM_MAX_DIM_SD
     &   , L_DOPPLER_PRESENT_SD, DOPPLER_CORRECTION_SD
!
!     ------------------------------------------------------------------
*COMDECK SSPDC3AD
!     ------------------------------------------------------------------
!     COMDECK FOR TWO-STREAM RADIATION CODE.
!
!     MODULE CONTAINING DECLARATIONS FOR REDUCED SW-SPECTRAL FILE.
!     (NOTE: SSPDC3AD, SSPCM3AD AND SSARG3AD MUST BE CONSISTENT)
!     ------------------------------------------------------------------
!
!
!     DIMENSIONS FOR THE SPECTRUM
!
      INTEGER
     &     NPD_TYPE_SD
!             NUMBER OF TYPES OF DATA IN SW SPECTRUM
     &   , NPD_BAND_SD
!             NUMBER OF SPECTRAL BANDS IN SW SPECTRUM
     &   , NPD_EXCLUDE_SD
!             NUMBER OF EXCLUDED BANDS IN SW SPECTRUM
     &   , NPD_SPECIES_SD
!             NUMBER OF GASEOUS SPECIES IN SW SPECTRUM
     &   , NPD_ESFT_TERM_SD
!             NUMBER OF ESFT TERMS IN SW SPECTRUM
     &   , NPD_SCALE_FNC_SD
!             NUMBER OF SCALING FUNCTIONS IN SW SPECTRUM
     &   , NPD_SCALE_VARIABLE_SD
!             NUMBER OF SCALING VARIABLES IN SW SPECTRUM
     &   , NPD_SURFACE_SD
!             NUMBER OF SURFACE TYPES IN SW SPECTRUM
     &   , NPD_ALBEDO_PARM_SD
!             NUMBER OF ALBEDO PARAMETERS IN SW SPECTRUM
     &   , NPD_CONTINUUM_SD
!             NUMBER OF CONTINUA IN SW SPECTRUM
     &   , NPD_DROP_TYPE_SD
!             NUMBER OF DROP TYPES IN SW SPECTRUM
     &   , NPD_ICE_TYPE_SD
!             NUMBER OF ICE CRYSTAL TYPES IN SW SPECTRUM
     &   , NPD_AEROSOL_SPECIES_SD
!             NUMBER OF AEROSOL SPECIES IN SW SPECTRUM
     &   , NPD_CLOUD_PARAMETER_SD
!             MAX NUMBER OF CLOUD PARAMETERS IN SW SPECTRUM
     &   , NPD_HUMIDITIES_SD
!             MAXIMUM NUMBER OF HUMIDITIES IN SW SPECTRUM
     &   , NPD_THERMAL_COEFF_SD
!             NUMBER OF THERMAL COEFFICIENTS IN SW SPECTRUM
!
!
!
!     GENERAL FIELDS:
!
      LOGICAL
     &     L_PRESENT_SD(0: NPD_TYPE_SD)
!             FLAG FOR TYPES OF DATA PRESENT
!
!
!
!     PROPERTIES OF THE SPECTRAL BANDS:
!
      INTEGER
     &     N_BAND_SD
!             NUMBER OF SPECTRAL BANDS
!
      REAL
     &     WAVE_LENGTH_SHORT_SD(NPD_BAND_SD)
!             SHORTER WAVELENGTH LIMITS
     &   , WAVE_LENGTH_LONG_SD(NPD_BAND_SD)
!             LONGER WAVELENGTH LIMITS
!
!
!
!     EXCLUSION OF SPECIFIC BANDS FROM PARTS OF THE SPECTRUM:
!
      INTEGER
     &     N_BAND_EXCLUDE_SD(NPD_BAND_SD)
!             NUMBER OF EXCLUDED BANDS WITHIN EACH SPECTRAL BAND
     &   , INDEX_EXCLUDE_SD(NPD_EXCLUDE_SD, NPD_BAND_SD)
!             INDICES OF EXCLUDED BANDS
!
!
!
!     FIELDS FOR THE SOLAR FLUX:
!
      REAL
     &     SOLAR_FLUX_BAND_SD(NPD_BAND_SD)
!             FRACTION OF THE INCIDENT SOLAR FLUX IN EACH BAND
!
!
!
!     FIELDS FOR RAYLEIGH SCATTERING:
!
      REAL
     &     RAYLEIGH_COEFFICIENT_SD(NPD_BAND_SD)
!             RAYLEIGH COEFFICIENTS
!
!
!
!     FIELDS FOR GASEOUS ABSORPTION:
!
      INTEGER
     &     N_ABSORB_SD
!             NUMBER OF ABSORBERS
     &   , N_BAND_ABSORB_SD(NPD_BAND_SD)
!             NUMBER OF ABSORBERS IN EACH BAND
     &   , INDEX_ABSORB_SD(NPD_SPECIES_SD, NPD_BAND_SD)
!             LIST OF ABSORBERS IN EACH BAND
     &   , TYPE_ABSORB_SD(NPD_SPECIES_SD)
!             TYPES OF EACH GAS IN THE SPECTRAL FILE
     &   , I_BAND_ESFT_SD(NPD_BAND_SD, NPD_SPECIES_SD)
!             NUMBER OF ESFT TERMS IN EACH BAND FOR EACH GAS
     &   , I_SCALE_ESFT_SD(NPD_BAND_SD, NPD_SPECIES_SD)
!             TYPE OF ESFT SCALING
     &   , I_SCALE_FNC_SD(NPD_BAND_SD, NPD_SPECIES_SD)
!             TYPE OF SCALING FUNCTION
!
      REAL
     &     K_ESFT_SD(NPD_ESFT_TERM_SD, NPD_BAND_SD, NPD_SPECIES_SD)
!             ESFT EXPONENTS
     &   , W_ESFT_SD(NPD_ESFT_TERM_SD, NPD_BAND_SD, NPD_SPECIES_SD)
!             ESFT WEIGHTS
     &   , SCALE_VECTOR_SD(NPD_SCALE_VARIABLE_SD, NPD_ESFT_TERM_SD
     &        , NPD_BAND_SD, NPD_SPECIES_SD)
!             SCALING PARAMETERS FOR EACH ABSORBER AND TERM
     &   , P_REFERENCE_SD(NPD_SPECIES_SD, NPD_BAND_SD)
!             REFERENCE PRESSURE FOR SCALING FUNCTION
     &   , T_REFERENCE_SD(NPD_SPECIES_SD, NPD_BAND_SD)
!             REFERENCE TEMPERATURE FOR SCALING FUNCTION
!
!
!
!     REPRESENTATION OF THE PLANCKIAN:
!
      INTEGER
     &     N_DEG_FIT_SD
!             DEGREE OF THERMAL POLYNOMIAL
!
      REAL
     &     THERMAL_COEFFICIENT_SD(0: NPD_THERMAL_COEFF_SD-1
     &   , NPD_BAND_SD)
!             COEFFICIENTS IN POLYNOMIAL FIT TO SOURCE FUNCTION
     &   , T_REF_PLANCK_SD
!             PLANCKIAN REFERENCE TEMPERATURE
!
!
!
!     SURFACE PROPERTIES:
!
      INTEGER
     &     I_SPEC_SURFACE_SD(NPD_SURFACE_SD)
!             METHOD OF SPECIFYING PROPERTIES OF SURFACE
     &   , N_DIR_ALBEDO_FIT_SD(NPD_SURFACE_SD)
!             NUMBER OF PARAMETERS FITTING THE DIRECT ALBEDO
!
      LOGICAL
     &     L_SURFACE_SD(NPD_SURFACE_SD)
!             SURFACE TYPES INCLUDED
!
      REAL
     &     SURFACE_ALBEDO_SD(NPD_BAND_SD, NPD_SURFACE_SD)
!             SURFACE ALBEDOS
     &   , DIRECT_ALBEDO_PARM_SD(0: NPD_ALBEDO_PARM_SD
     &      , NPD_BAND_SD, NPD_SURFACE_SD)
!             COEFFICIENTS FOR FITTING DIRECT ALBEDO
     &   , EMISSIVITY_GROUND_SD(NPD_BAND_SD, NPD_SURFACE_SD)
!             SURFACE EMISSIVITIES
!
!
!
!     FIELDS FOR CONTINUA:
!
      INTEGER
     &     N_BAND_CONTINUUM_SD(NPD_BAND_SD)
!             NUMBER OF CONTINUA IN EACH BAND
     &   , INDEX_CONTINUUM_SD(NPD_BAND_SD, NPD_CONTINUUM_SD)
!             LIST OF CONTINUA IN EACH BAND
     &   , INDEX_WATER_SD
!             INDEX OF WATER VAPOUR
     &   , I_SCALE_FNC_CONT_SD(NPD_BAND_SD, NPD_CONTINUUM_SD)
!             TYPE OF SCALING FUNCTION FOR CONTINUUM
!
      REAL
     &     K_CONTINUUM_SD(NPD_BAND_SD, NPD_CONTINUUM_SD)
!             GREY EXTINCTION COEFFICIENTS FOR CONTINUUM
     &   , SCALE_CONTINUUM_SD(NPD_SCALE_VARIABLE_SD
     &      , NPD_BAND_SD, NPD_CONTINUUM_SD)
!             SCALING PARAMETERS FOR CONTINUUM
     &   , P_REF_CONTINUUM_SD(NPD_CONTINUUM_SD, NPD_BAND_SD)
!             REFERENCE PRESSURE FOR SCALING OF CONTINUUM
     &   , T_REF_CONTINUUM_SD(NPD_CONTINUUM_SD, NPD_BAND_SD)
!             REFERENCE TEMPERATURE FOR SCALING OF CONTINUUM
!
!
!
!     FIELDS FOR WATER DROPLETS:
!
      INTEGER
     &     I_DROP_PARAMETRIZATION_SD(NPD_DROP_TYPE_SD)
!             PARAMETRIZATION TYPE OF DROPLETS
!
      LOGICAL
     &     L_DROP_TYPE_SD(NPD_DROP_TYPE_SD)
!             TYPES OF DROPLET PRESENT
!
      REAL
     &     DROP_PARAMETER_LIST_SD(NPD_CLOUD_PARAMETER_SD
     &        , NPD_BAND_SD, NPD_DROP_TYPE_SD)
!             PARAMETERS USED TO FIT OPTICAL PROPERTIES OF CLOUDS
     &   , DROP_PARM_MIN_DIM_SD(NPD_DROP_TYPE_SD)
!             MINIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
     &   , DROP_PARM_MAX_DIM_SD(NPD_DROP_TYPE_SD)
!             MAXIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
!
!
!
!     FIELDS FOR AEROSOLS:
!
      INTEGER
     &     N_AEROSOL_SD
!             NUMBER OF SPECIES OF AEROSOL
     &   , TYPE_AEROSOL_SD(NPD_AEROSOL_SPECIES_SD)
!             TYPES OF AEROSOLS
     &   , I_AEROSOL_PARAMETRIZATION_SD(NPD_AEROSOL_SPECIES_SD)
!             PARAMETRIZATION OF AEROSOLS
     &   , NHUMIDITY_SD(NPD_AEROSOL_SPECIES_SD)
!             NUMBERS OF HUMIDITIES
!
      LOGICAL
     &     L_AEROSOL_SPECIES_SD(NPD_AEROSOL_SPECIES_SD)
!             AEROSOL SPECIES INCLUDED
!
      REAL
     &     AEROSOL_ABSORPTION_SD(NPD_HUMIDITIES_SD
     &        , NPD_AEROSOL_SPECIES_SD, NPD_BAND_SD)
!             ABSORPTION BY AEROSOLS
     &   , AEROSOL_SCATTERING_SD(NPD_HUMIDITIES_SD
     &        , NPD_AEROSOL_SPECIES_SD, NPD_BAND_SD)
!             SCATTERING BY AEROSOLS
     &   , AEROSOL_ASYMMETRY_SD(NPD_HUMIDITIES_SD
     &        , NPD_AEROSOL_SPECIES_SD, NPD_BAND_SD)
!             ASYMMETRY OF AEROSOLS
     &   , HUMIDITIES_SD(NPD_HUMIDITIES_SD, NPD_AEROSOL_SPECIES_SD)
!             HUMIDITIES FOR COMPONENTS
!
!
!
!     FIELDS FOR ICE CRYSTALS:
!
      INTEGER
     &     I_ICE_PARAMETRIZATION_SD(NPD_ICE_TYPE_SD)
!             TYPES OF PARAMETRIZATION OF ICE CRYSTALS
!
      LOGICAL
     &     L_ICE_TYPE_SD(NPD_ICE_TYPE_SD)
!             TYPES OF ICE CRYSTAL PRESENT
!
      REAL
     &     ICE_PARAMETER_LIST_SD(NPD_CLOUD_PARAMETER_SD
     &        , NPD_BAND_SD, NPD_ICE_TYPE_SD)
!             PARAMETERS USED TO FIT SINGLE SCATTERING OF ICE CRYSTALS
     &   , ICE_PARM_MIN_DIM_SD(NPD_ICE_TYPE_SD)
!             MINIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
     &   , ICE_PARM_MAX_DIM_SD(NPD_ICE_TYPE_SD)
!             MAXIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
!
!
!
!     FIELDS FOR DOPPLER BROADENING:
!
      LOGICAL
     &     L_DOPPLER_PRESENT_SD(NPD_SPECIES_SD)
!             FLAG FOR DOPPLER BROADENING FOR EACH SPECIES
!
      REAL
     &     DOPPLER_CORRECTION_SD(NPD_SPECIES_SD)
!             OFFSET TO PRESSURE TO REPRESENT DOPPLER BROADENING
!
!
!
!    ------------------------------------------------------------------
*COMDECK SSPDL3AD
!     ------------------------------------------------------------------
!     COMDECK FOR TWO-STREAM RADIATION CODE.
!
!     MODULE CONTAINING DECLARATIONS FOR REDUCED SW-SPECTRAL FILE.
!     NOTE: SSPDC3AD, SSPCM3AD AND SSARG3AD MUST BE CONSISTENT
!     NOTE: SINCE THE ARRAYS HERE WILL BE PASSED IN A COMMON BLOCK
!     THEIR SIZES MUST BE FIXED, EVEN THOUGH VARIABLE SIZES ARE USED
!     LOWER IN THE CODE. THEY ARE ACCORDINGLY DEFINED AS 1-DIMENSIONAL
!     ARRAYS WITH FIXED MAXIMUM SIZES AT THIS LEVEL.
!
!     ------------------------------------------------------------------
!
!
!     DIMENSIONS FOR THE SPECTRUM
!
      INTEGER
     &     NPD_TYPE_SD
!             NUMBER OF TYPES OF DATA IN SW SPECTRUM
     &   , NPD_BAND_SD
!             NUMBER OF SPECTRAL BANDS IN SW SPECTRUM
     &   , NPD_EXCLUDE_SD
!             NUMBER OF EXCLUDED BANDS IN SW SPECTRUM
     &   , NPD_SPECIES_SD
!             NUMBER OF GASEOUS SPECIES IN SW SPECTRUM
     &   , NPD_ESFT_TERM_SD
!             NUMBER OF ESFT TERMS IN SW SPECTRUM
     &   , NPD_SCALE_FNC_SD
!             NUMBER OF SCALING FUNCTIONS IN SW SPECTRUM
     &   , NPD_SCALE_VARIABLE_SD
!             NUMBER OF SCALING VARIABLES IN SW SPECTRUM
     &   , NPD_SURFACE_SD
!             NUMBER OF SURFACE TYPES IN SW SPECTRUM
     &   , NPD_ALBEDO_PARM_SD
!             NUMBER OF ALBEDO PARAMETERS IN SW SPECTRUM
     &   , NPD_CONTINUUM_SD
!             NUMBER OF CONTINUA IN SW SPECTRUM
     &   , NPD_DROP_TYPE_SD
!             NUMBER OF DROP TYPES IN SW SPECTRUM
     &   , NPD_ICE_TYPE_SD
!             NUMBER OF ICE CRYSTAL TYPES IN SW SPECTRUM
     &   , NPD_AEROSOL_SPECIES_SD
!             NUMBER OF AEROSOL SPECIES IN SW SPECTRUM
     &   , NPD_CLOUD_PARAMETER_SD
!             MAX NUMBER OF CLOUD PARAMETERS IN SW SPECTRUM
     &   , NPD_HUMIDITIES_SD
!             MAXIMUM NUMBER OF HUMIDITIES IN SW SPECTRUM
     &   , NPD_THERMAL_COEFF_SD
!             NUMBER OF THERMAL COEFFICIENTS IN SW SPECTRUM
!
!
!
!     GENERAL FIELDS:
!
      LOGICAL
     &     L_PRESENT_SD(0: NPD_TYPE)
!             FLAG FOR TYPES OF DATA PRESENT
!
!
!
!     PROPERTIES OF THE SPECTRAL BANDS:
!
      INTEGER
     &     N_BAND_SD
!             NUMBER OF SPECTRAL BANDS
!
      REAL
     &     WAVE_LENGTH_SHORT_SD(NPD_BAND)
!             SHORTER WAVELENGTH LIMITS
     &   , WAVE_LENGTH_LONG_SD(NPD_BAND)
!             LONGER WAVELENGTH LIMITS
!
!
!
!     EXCLUSION OF SPECIFIC BANDS FROM PARTS OF THE SPECTRUM:
!
      INTEGER
     &     N_BAND_EXCLUDE_SD(NPD_BAND)
!             NUMBER OF EXCLUDED BANDS WITHIN EACH SPECTRAL BAND
     &   , INDEX_EXCLUDE_SD(NPD_EXCLUDE, NPD_BAND)
!             INDICES OF EXCLUDED BANDS
!
!
!
!     FIELDS FOR THE SOLAR FLUX:
!
      REAL
     &     SOLAR_FLUX_BAND_SD(NPD_BAND)
!             FRACTION OF THE INCIDENT SOLAR FLUX IN EACH BAND
!
!
!
!     FIELDS FOR RAYLEIGH SCATTERING:
!
      REAL
     &     RAYLEIGH_COEFFICIENT_SD(NPD_BAND)
!             RAYLEIGH COEFFICIENTS
!
!
!
!     FIELDS FOR GASEOUS ABSORPTION:
!
      INTEGER
     &     N_ABSORB_SD
!             NUMBER OF ABSORBERS
     &   , N_BAND_ABSORB_SD(NPD_BAND)
!             NUMBER OF ABSORBERS IN EACH BAND
     &   , INDEX_ABSORB_SD(NPD_SPECIES, NPD_BAND)
!             LIST OF ABSORBERS IN EACH BAND
     &   , TYPE_ABSORB_SD(NPD_SPECIES)
!             TYPES OF EACH GAS IN THE SPECTRAL FILE
     &   , I_BAND_ESFT_SD(NPD_BAND, NPD_SPECIES)
!             NUMBER OF ESFT TERMS IN EACH BAND FOR EACH GAS
     &   , I_SCALE_ESFT_SD(NPD_BAND, NPD_SPECIES)
!             TYPE OF ESFT SCALING
     &   , I_SCALE_FNC_SD(NPD_BAND, NPD_SPECIES)
!             TYPE OF SCALING FUNCTION
!
      REAL
     &     K_ESFT_SD(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             ESFT EXPONENTS
     &   , W_ESFT_SD(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             ESFT WEIGHTS
     &   , SCALE_VECTOR_SD(NPD_SCALE_VARIABLE, NPD_ESFT_TERM
     &        , NPD_BAND, NPD_SPECIES)
!             SCALING PARAMETERS FOR EACH ABSORBER AND TERM
     &   , P_REFERENCE_SD(NPD_SPECIES, NPD_BAND)
!             REFERENCE PRESSURE FOR SCALING FUNCTION
     &   , T_REFERENCE_SD(NPD_SPECIES, NPD_BAND)
!             REFERENCE TEMPERATURE FOR SCALING FUNCTION
!
!
!
!     REPRESENTATION OF THE PLANCKIAN:
!
      INTEGER
     &     N_DEG_FIT_SD
!             DEGREE OF THERMAL POLYNOMIAL
!
      REAL
     &     THERMAL_COEFFICIENT_SD(0: NPD_THERMAL_COEFF-1
     &        , NPD_BAND)
!             COEFFICIENTS IN POLYNOMIAL FIT TO SOURCE FUNCTION
     &   , T_REF_PLANCK_SD
!             PLANCKIAN REFERENCE TEMPERATURE
!
!
!
!     SURFACE PROPERTIES:
!
      INTEGER
     &     I_SPEC_SURFACE_SD(NPD_SURFACE)
!             METHOD OF SPECIFYING PROPERTIES OF SURFACE
     &   , N_DIR_ALBEDO_FIT_SD(NPD_SURFACE)
!             NUMBER OF PARAMETERS FITTING THE DIRECT ALBEDO
!
      LOGICAL
     &     L_SURFACE_SD(NPD_SURFACE)
!             SURFACE TYPES INCLUDED
!
      REAL
     &     SURFACE_ALBEDO_SD(NPD_BAND, NPD_SURFACE)
!             SURFACE ALBEDOS
     &   , DIRECT_ALBEDO_PARM_SD(0: NPD_ALBEDO_PARM
     &      , NPD_BAND, NPD_SURFACE)
!             COEFFICIENTS FOR FITTING DIRECT ALBEDO
     &   , EMISSIVITY_GROUND_SD(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
!
!
!
!     FIELDS FOR CONTINUA:
!
      INTEGER
     &     N_BAND_CONTINUUM_SD(NPD_BAND)
!             NUMBER OF CONTINUA IN EACH BAND
     &   , INDEX_CONTINUUM_SD(NPD_BAND, NPD_CONTINUUM)
!             LIST OF CONTINUA IN EACH BAND
     &   , INDEX_WATER_SD
!             INDEX OF WATER VAPOUR
     &   , I_SCALE_FNC_CONT_SD(NPD_BAND, NPD_CONTINUUM)
!             TYPE OF SCALING FUNCTION FOR CONTINUUM
!
      REAL
     &     K_CONTINUUM_SD(NPD_BAND, NPD_CONTINUUM)
!             GREY EXTINCTION COEFFICIENTS FOR CONTINUUM
     &   , SCALE_CONTINUUM_SD(NPD_SCALE_VARIABLE
     &      , NPD_BAND, NPD_CONTINUUM)
!             SCALING PARAMETERS FOR CONTINUUM
     &   , P_REF_CONTINUUM_SD(NPD_CONTINUUM, NPD_BAND)
!             REFERENCE PRESSURE FOR SCALING OF CONTINUUM
     &   , T_REF_CONTINUUM_SD(NPD_CONTINUUM, NPD_BAND)
!             REFERENCE TEMPERATURE FOR SCALING OF CONTINUUM
!
!
!
!     FIELDS FOR WATER DROPLETS:
!
      INTEGER
     &     I_DROP_PARAMETRIZATION_SD(NPD_DROP_TYPE)
!             PARAMETRIZATION TYPE OF DROPLETS
!
      LOGICAL
     &     L_DROP_TYPE_SD(NPD_DROP_TYPE)
!             TYPES OF DROPLET PRESENT
!
      REAL
     &     DROP_PARAMETER_LIST_SD(NPD_CLOUD_PARAMETER
     &        , NPD_BAND, NPD_DROP_TYPE)
!             PARAMETERS USED TO FIT OPTICAL PROPERTIES OF CLOUDS
     &   , DROP_PARM_MIN_DIM_SD(NPD_DROP_TYPE)
!             MINIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
     &   , DROP_PARM_MAX_DIM_SD(NPD_DROP_TYPE)
!             MAXIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
!
!
!
!     FIELDS FOR AEROSOLS:
!
      INTEGER
     &     N_AEROSOL_SD
!             NUMBER OF SPECIES OF AEROSOL
     &   , TYPE_AEROSOL_SD(NPD_AEROSOL_SPECIES)
!             TYPES OF AEROSOLS
     &   , I_AEROSOL_PARAMETRIZATION_SD(NPD_AEROSOL_SPECIES)
!             PARAMETRIZATION OF AEROSOLS
     &   , NHUMIDITY_SD(NPD_AEROSOL_SPECIES)
!             NUMBERS OF HUMIDITIES
!
      LOGICAL
     &     L_AEROSOL_SPECIES_SD(NPD_AEROSOL_SPECIES)
!             AEROSOL SPECIES INCLUDED
!
      REAL
     &     AEROSOL_ABSORPTION_SD(NPD_HUMIDITIES
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             ABSORPTION BY AEROSOLS
     &   , AEROSOL_SCATTERING_SD(NPD_HUMIDITIES
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             SCATTERING BY AEROSOLS
     &   , AEROSOL_ASYMMETRY_SD(NPD_HUMIDITIES
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             ASYMMETRY OF AEROSOLS
     &   , HUMIDITIES_SD(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)
!             HUMIDITIES FOR COMPONENTS
!
!
!
!     FIELDS FOR ICE CRYSTALS:
!
      INTEGER
     &     I_ICE_PARAMETRIZATION_SD(NPD_ICE_TYPE)
!             TYPES OF PARAMETRIZATION OF ICE CRYSTALS
!
      LOGICAL
     &     L_ICE_TYPE_SD(NPD_ICE_TYPE)
!             TYPES OF ICE CRYSTAL PRESENT
!
      REAL
     &     ICE_PARAMETER_LIST_SD(NPD_CLOUD_PARAMETER
     &        , NPD_BAND, NPD_ICE_TYPE)
!             PARAMETERS USED TO FIT SINGLE SCATTERING OF ICE CRYSTALS
     &   , ICE_PARM_MIN_DIM_SD(NPD_ICE_TYPE)
!             MINIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
     &   , ICE_PARM_MAX_DIM_SD(NPD_ICE_TYPE)
!             MAXIMUM DIMENSION PERMISSIBLE IN THE PARAMETRIZATION
!
!
!
!     FIELDS FOR DOPPLER BROADENING:
!
      LOGICAL
     &     L_DOPPLER_PRESENT_SD(NPD_SPECIES)
!             FLAG FOR DOPPLER BROADENING FOR EACH SPECIES
!
      REAL
     &     DOPPLER_CORRECTION_SD(NPD_SPECIES)
!             OFFSET TO PRESSURE TO REPRESENT DOPPLER BROADENING
!
!
!
!    ------------------------------------------------------------------
*COMDECK SOPT3AD
!-----------------------------------------------------------------------
!      
!     OPTIONS FOR DIAGNOSTIC USE.
      INTEGER
     &     I_2STREAM_SW_D
     &   , I_GAS_OVERLAP_SW_D
     &   , I_CLOUD_SW_D
     &   , I_CLOUD_REPRESENTATION_SW_D
     &   , I_SOLVER_SW_D
      LOGICAL
     &     L_O2_SW_D
     &   , L_LOCAL_CNV_PARTITION_SW_D
      INTEGER
     &     I_ST_WATER_SW_D
     &   , I_CNV_WATER_SW_D
     &   , I_ST_ICE_SW_D
     &   , I_CNV_ICE_SW_D
!
!-----------------------------------------------------------------------
*COMDECK LOPT3AD
!-----------------------------------------------------------------------
!      
!     OPTIONS FOR DIAGNOSTIC USE.
      INTEGER
     &     I_2STREAM_LW_D
     &   , I_GAS_OVERLAP_LW_D
     &   , I_CLOUD_LW_D
     &   , I_CLOUD_REPRESENTATION_LW_D
     &   , I_SOLVER_LW_D
      LOGICAL
     &     L_CH4_LW_D
     &   , L_N2O_LW_D
     &   , L_CFC11_LW_D
     &   , L_CFC12_LW_D
     &   , L_CFC113_LW_D
     &   , L_HCFC22_LW_D
     &   , L_HFC125_LW_D
     &   , L_HFC134A_LW_D
     &   , L_IR_SOURCE_QUAD_LW_D
     &   , L_MICROPHYSICS_LW_D
     &   , L_LOCAL_CNV_PARTITION_LW_D
      INTEGER
     &     I_ST_WATER_LW_D
     &   , I_CNV_WATER_LW_D
     &   , I_ST_ICE_LW_D
     &   , I_CNV_ICE_LW_D
!
!-----------------------------------------------------------------------
*COMDECK CTLNL3AD
!-----------------------------------------------------------------------
      NAMELIST/R2SWCLNLD/
     &     I_2STREAM_SW_D, I_GAS_OVERLAP_SW_D
     &   , I_CLOUD_SW_D, I_CLOUD_REPRESENTATION_SW_D
     &   , I_SOLVER_SW_D
     &   , L_O2_SW_D
     &   , I_ST_WATER_SW_D, I_CNV_WATER_SW_D
     &   , I_ST_ICE_SW_D, I_CNV_ICE_SW_D
     &   , L_LOCAL_CNV_PARTITION_SW_D
      NAMELIST/R2LWCLNLD/
     &     I_2STREAM_LW_D, L_IR_SOURCE_QUAD_LW_D, I_GAS_OVERLAP_LW_D
     &   , I_CLOUD_LW_D, I_CLOUD_REPRESENTATION_LW_D
     &   , I_SOLVER_LW_D
     &   , L_N2O_LW_D, L_CH4_LW_D, L_CFC11_LW_D, L_CFC12_LW_D
     &   , L_CFC113_LW_D, L_HCFC22_LW_D, L_HFC125_LW_D, L_HFC134A_LW_D
     &   , I_ST_WATER_LW_D, I_CNV_WATER_LW_D
     &   , I_ST_ICE_LW_D, I_CNV_ICE_LW_D
     &   , L_MICROPHYSICS_LW_D, L_LOCAL_CNV_PARTITION_LW_D
*COMDECK SSPCM3AD
!     ------------------------------------------------------------------
!     MODULE DECLARING COMMON BLOCK CONTAINING THE REDUCED SW SPECTRAL
!     FILE.
!     (NOTE: SSPDC3AD, SSPCM3AD AND SSARG3AD MUST BE CONSISTENT)
!
!
      COMMON/R2SWSPCMD/
!
!     DIMENSIONS OF ARRAYS:
     &     NPD_TYPE_SD, NPD_BAND_SD, NPD_EXCLUDE_SD
     &   , NPD_SPECIES_SD, NPD_ESFT_TERM_SD, NPD_SCALE_FNC_SD
     &   , NPD_SCALE_VARIABLE_SD
     &   , NPD_THERMAL_COEFF_SD
     &   , NPD_SURFACE_SD, NPD_ALBEDO_PARM_SD
     &   , NPD_CONTINUUM_SD
     &   , NPD_DROP_TYPE_SD, NPD_ICE_TYPE_SD, NPD_CLOUD_PARAMETER_SD
     &   , NPD_AEROSOL_SPECIES_SD, NPD_HUMIDITIES_SD
!
!     GENERAL ARRAYS:
     &   , L_PRESENT_SD
!
!     PROPERTIES OF BANDS:
     &   , N_BAND_SD, WAVE_LENGTH_SHORT_SD, WAVE_LENGTH_LONG_SD
!
!     EXCLUSIONS FROM BANDS:
     &   , N_BAND_EXCLUDE_SD, INDEX_EXCLUDE_SD
!
!     SOLAR FIELDS:
     &   , SOLAR_FLUX_BAND_SD, RAYLEIGH_COEFFICIENT_SD
!
!     GASEOUS ABSORPTION:
     &   , N_ABSORB_SD, N_BAND_ABSORB_SD, INDEX_ABSORB_SD
     &   , TYPE_ABSORB_SD
     &   , I_BAND_ESFT_SD, I_SCALE_ESFT_SD, I_SCALE_FNC_SD
     &   , K_ESFT_SD, W_ESFT_SD
     &   , SCALE_VECTOR_SD, P_REFERENCE_SD, T_REFERENCE_SD
!
!     THERMAL SOURCE FUNCTION:
     &   , N_DEG_FIT_SD, THERMAL_COEFFICIENT_SD, T_REF_PLANCK_SD
!
!     SURFACE PROPERTIES:
     &   , I_SPEC_SURFACE_SD, N_DIR_ALBEDO_FIT_SD, L_SURFACE_SD
     &   , SURFACE_ALBEDO_SD, DIRECT_ALBEDO_PARM_SD
     &   , EMISSIVITY_GROUND_SD
!
!     CONTINUA:
     &   , N_BAND_CONTINUUM_SD, INDEX_CONTINUUM_SD, INDEX_WATER_SD
     &   , I_SCALE_FNC_CONT_SD, K_CONTINUUM_SD
     &   , SCALE_CONTINUUM_SD, P_REF_CONTINUUM_SD, T_REF_CONTINUUM_SD
!
!     WATER DROPLETS:
     &   , I_DROP_PARAMETRIZATION_SD, L_DROP_TYPE_SD
     &   , DROP_PARAMETER_LIST_SD
     &   , DROP_PARM_MIN_DIM_SD, DROP_PARM_MAX_DIM_SD
!
!     AEROSOLS:
     &   , N_AEROSOL_SD, TYPE_AEROSOL_SD, I_AEROSOL_PARAMETRIZATION_SD
     &   , NHUMIDITY_SD, HUMIDITIES_SD, L_AEROSOL_SPECIES_SD
     &   , AEROSOL_ABSORPTION_SD, AEROSOL_SCATTERING_SD
     &   , AEROSOL_ASYMMETRY_SD
!
!     ICE CRYSTALS:
     &   , I_ICE_PARAMETRIZATION_SD, L_ICE_TYPE_SD
     &   , ICE_PARAMETER_LIST_SD
     &   , ICE_PARM_MIN_DIM_SD, ICE_PARM_MAX_DIM_SD
!
!     DOPPLER BROADENING:
     &   , L_DOPPLER_PRESENT_SD, DOPPLER_CORRECTION_SD
!
!     ------------------------------------------------------------------
*COMDECK LSPCM3AD
!     ------------------------------------------------------------------
!     MODULE DECLARING COMMON BLOCK CONTAINING THE REDUCED LW SPECTRAL
!     FILE.
!     (NOTE: LSPDC3AD, LSPCM3AD AND LSARG3AD MUST BE CONSISTENT)
!
!
      COMMON/R2LWSPCMD/
!
!     DIMENSIONS OF ARRAYS:
     &     NPD_TYPE_LD, NPD_BAND_LD, NPD_EXCLUDE_LD
     &   , NPD_SPECIES_LD, NPD_ESFT_TERM_LD, NPD_SCALE_FNC_LD
     &   , NPD_SCALE_VARIABLE_LD
     &   , NPD_THERMAL_COEFF_LD
     &   , NPD_SURFACE_LD, NPD_ALBEDO_PARM_LD
     &   , NPD_CONTINUUM_LD
     &   , NPD_DROP_TYPE_LD, NPD_ICE_TYPE_LD, NPD_CLOUD_PARAMETER_LD
     &   , NPD_AEROSOL_SPECIES_LD, NPD_HUMIDITIES_LD
!
!     GENERAL ARRAYS:
     &   , L_PRESENT_LD
!
!     PROPERTIES OF BANDS:
     &   , N_BAND_LD, WAVE_LENGTH_SHORT_LD, WAVE_LENGTH_LONG_LD
!
!     EXCLUSIONS FROM BANDS:
     &   , N_BAND_EXCLUDE_LD, INDEX_EXCLUDE_LD
!
!     SOLAR FIELDS:
     &   , SOLAR_FLUX_BAND_LD, RAYLEIGH_COEFFICIENT_LD
!
!     GASEOUS ABSORPTION:
     &   , N_ABSORB_LD, N_BAND_ABSORB_LD, INDEX_ABSORB_LD
     &   , TYPE_ABSORB_LD
     &   , I_BAND_ESFT_LD, I_SCALE_ESFT_LD, I_SCALE_FNC_LD
     &   , K_ESFT_LD, W_ESFT_LD
     &   , SCALE_VECTOR_LD, P_REFERENCE_LD, T_REFERENCE_LD
!
!     THERMAL SOURCE FUNCTION:
     &   , N_DEG_FIT_LD, THERMAL_COEFFICIENT_LD, T_REF_PLANCK_LD
!
!     SURFACE PROPERTIES:
     &   , I_SPEC_SURFACE_LD, N_DIR_ALBEDO_FIT_LD, L_SURFACE_LD
     &   , SURFACE_ALBEDO_LD, DIRECT_ALBEDO_PARM_LD
     &   , EMISSIVITY_GROUND_LD
!
!     CONTINUA:
     &   , N_BAND_CONTINUUM_LD, INDEX_CONTINUUM_LD, INDEX_WATER_LD
     &   , I_SCALE_FNC_CONT_LD, K_CONTINUUM_LD
     &   , SCALE_CONTINUUM_LD, P_REF_CONTINUUM_LD, T_REF_CONTINUUM_LD
!
!     WATER DROPLETS:
     &   , I_DROP_PARAMETRIZATION_LD, L_DROP_TYPE_LD
     &   , DROP_PARAMETER_LIST_LD
     &   , DROP_PARM_MIN_DIM_LD, DROP_PARM_MAX_DIM_LD
!
!     AEROSOLS:
     &   , N_AEROSOL_LD, TYPE_AEROSOL_LD, I_AEROSOL_PARAMETRIZATION_LD
     &   , NHUMIDITY_LD, HUMIDITIES_LD, L_AEROSOL_SPECIES_LD
     &   , AEROSOL_ABSORPTION_LD, AEROSOL_SCATTERING_LD
     &   , AEROSOL_ASYMMETRY_LD
!
!     ICE CRYSTALS:
     &   , I_ICE_PARAMETRIZATION_LD, L_ICE_TYPE_LD
     &   , ICE_PARAMETER_LIST_LD
     &   , ICE_PARM_MIN_DIM_LD, ICE_PARM_MAX_DIM_LD
!
!     DOPPLER BROADENING:
     &   , L_DOPPLER_PRESENT_LD, DOPPLER_CORRECTION_LD
!
!     ------------------------------------------------------------------
!-----------------------------------------------------------------------
*DECK GTJBID3A
!+    ------------------------------------------------------------------
!     Function to get JOBID.
!-    ------------------------------------------------------------------
      FUNCTION GTJBID(IDUM)
!
!
!
      IMPLICIT NONE
!
!
      CHARACTER*1 !, INTENT(OUT)
     &     GTJBID
!             RETURNED STRING
      INTEGER
     &     IDUM
!             DUMMY ARGUMENT
!
!     LOCAL VARIABLES
      CHARACTER*1 JOBID
      CHARACTER*5 VAR
      INTEGER IERR, I_LEN
      INTEGER GETENV
!
      VAR(1:5)='JOBID'
      CALL PXFGETENV(VAR, 0, JOBID, I_LEN, IERR)
      IF ( (IERR.NE.0).OR.(I_LEN.NE.1) ) THEN
         PRINT *, 'ERROR GETTING JOBID'
         CALL ABORT
      ENDIF
      GTJBID=JOBID
!
!
!
      RETURN
      END




