C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.12371 
C                                                                                  RAD_ALL.12372 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.12373 
C restrictions as set forth in the contract.                                       RAD_ALL.12374 
C                                                                                  RAD_ALL.12375 
C                Meteorological Office                                             RAD_ALL.12376 
C                London Road                                                       RAD_ALL.12377 
C                BRACKNELL                                                         RAD_ALL.12378 
C                Berkshire UK                                                      RAD_ALL.12379 
C                RG12 2SZ                                                          RAD_ALL.12380 
C                                                                                  RAD_ALL.12381 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.12382 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.12383 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.12384 
C Modelling at the above address.                                                  RAD_ALL.12385 
C ******************************COPYRIGHT******************************            RAD_ALL.12386 
C                                                                                  RAD_ALL.12387 
!+ Subroutine to calculate optical properties of ice clouds.                       RAD_ALL.12388 
!                                                                                  RAD_ALL.12389 
! Method:                                                                          RAD_ALL.12390 
!       If the optical properties come from an observational                       RAD_ALL.12391 
!       distribution a separte subroutine is called. Otherwise                     RAD_ALL.12392 
!       appropriate mean quantities in the layer are calculated                    RAD_ALL.12393 
!       as the parametrization requires and these values are                       RAD_ALL.12394 
!       substituted into the parametrization to give the optical                   RAD_ALL.12395 
!       properties.                                                                RAD_ALL.12396 
!                                                                                  RAD_ALL.12397 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.12398 
!                                                                                  RAD_ALL.12399 
! History:                                                                         RAD_ALL.12400 
!       Version         Date                    Comment                            RAD_ALL.12401 
!       4.0             27-07-95                Original Code                      RAD_ALL.12402 
!                                               (J. M. Edwards)                    RAD_ALL.12403 
!       4.4             30-09-96                Old scheme for                     RAD_ALL.12404 
!                                               Cirrus removed.                    RAD_ALL.12405 
!                                               New scheme based on                RAD_ALL.12406 
!                                               anomalous diffraction              RAD_ALL.12407 
!                                               theory introduced.                 RAD_ALL.12408 
!                                               Effective radius is                RAD_ALL.12409 
!                                               relabelled as the                  RAD_ALL.12410 
!                                               characteristic                     RAD_ALL.12411 
!                                               dimension for more                 RAD_ALL.12412 
!                                               general formulations.              RAD_ALL.12413 
!                                               (J. M. Edwards)                    RAD_ALL.12414 
!                                                                                  RAD_ALL.12415 
! Description of Code:                                                             RAD_ALL.12416 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.12417 
!                                                                                  RAD_ALL.12418 
!- ---------------------------------------------------------------------           RAD_ALL.12419 
      SUBROUTINE OPT_PROP_ICE_CLOUD(IERR                                           RAD_ALL.12420 
     &   , N_PROFILE, N_LAYER, N_CLOUD_TOP                                         RAD_ALL.12421 
     &   , N_CLOUD_PROFILE, I_CLOUD_PROFILE                                        RAD_ALL.12422 
     &   , L_RESCALE, L_LAYER, L_CLOUD_LAYER                                       RAD_ALL.12423 
     &   , I_PARAMETRIZATION_ICE, ICE_CLOUD_PARAMETER                              RAD_ALL.12424 
     &   , ICE_MASS_FRAC, DIM_CHAR_ICE                                             RAD_ALL.12425 
     &   , T, DENSITY                                                              RAD_ALL.12426 
     &   , K_EXT_TOT_CLOUD, K_EXT_SCAT_CLOUD                                       RAD_ALL.12427 
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                                  RAD_ALL.12428 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.12429 
     &   , NPD_CLOUD_PARAMETER                                                     RAD_ALL.12430 
     &   )                                                                         RAD_ALL.12431 
!                                                                                  RAD_ALL.12432 
!                                                                                  RAD_ALL.12433 
      IMPLICIT NONE                                                                RAD_ALL.12434 
!                                                                                  RAD_ALL.12435 
!                                                                                  RAD_ALL.12436 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.12437 
     &     NPD_PROFILE                                                             RAD_ALL.12438 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.12439 
     &   , NPD_LAYER                                                               RAD_ALL.12440 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.12441 
     &   , NPD_CLOUD_PARAMETER                                                     RAD_ALL.12442 
!             MAXIMUM NUMBER OF CLOUD PARAMETERS                                   RAD_ALL.12443 
!                                                                                  RAD_ALL.12444 
!     INCLUDE COMDECKS                                                             RAD_ALL.12445 
!     ------------------------------------------------------------------           STDIO3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       STDIO3A.3     
!                                                                                  STDIO3A.4     
!     MODULE TO SET UNIT NUMBERS FOR STANDARD I/O.                                 STDIO3A.5     
!                                                                                  STDIO3A.6     
      INTEGER                                                                      STDIO3A.7     
     &     IU_STDIN                                                                STDIO3A.8     
!             UNIT NUMBER FOR STANDARD INPUT                                       STDIO3A.9     
     &   , IU_STDOUT                                                               STDIO3A.10    
!             UNIT NUMBER FOR STANDARD OUTPUT                                      STDIO3A.11    
     *   , IU_ERR                                                                  STDIO3A.12    
!             UNIT NUMBER FOR ERROR MESSAGES                                       STDIO3A.13    
!                                                                                  STDIO3A.14    
      PARAMETER(                                                                   STDIO3A.15    
     &     IU_STDIN=5                                                              STDIO3A.16    
     &   , IU_STDOUT=6                                                             STDIO3A.17    
     *   , IU_ERR=6                                                                STDIO3A.18    
     &   )                                                                         STDIO3A.19    
!                                                                                  STDIO3A.20    
!     ------------------------------------------------------------------           STDIO3A.21    
!     ------------------------------------------------------------------           ICLPRM3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       ICLPRM3A.3     
!                                                                                  ICLPRM3A.4     
!     MODULE TO SET NUMBERS FOR ICE CLOUD SCHEMES.                                 ICLPRM3A.5     
!                                                                                  ICLPRM3A.6     
      INTEGER                                                                      ICLPRM3A.7     
     &     NPD_ICE_CLOUD_FIT                                                       ICLPRM3A.8     
!             NUMBER OF CLOUD FITTING SCHEMES                                      ICLPRM3A.9     
     &   , IP_SLINGO_SCHRECKER_ICE                                                 ICLPRM3A.10    
!             PARAMETRIZATION OF SLINGO AND SCHRECKER.                             ICLPRM3A.11    
     &   , IP_ICE_UNPARAMETRIZED                                                   ICLPRM3A.12    
!             UNPARAMETRIZED ICE CRYSTAL DATA                                      ICLPRM3A.13    
     &   , IP_SUN_SHINE_VN2_VIS                                                    ICLPRM3A.14    
!             SUN AND SHINE'S PARAMETRIZATION IN THE VISIBLE (VERSION 2)           ICLPRM3A.15    
     &   , IP_SUN_SHINE_VN2_IR                                                     ICLPRM3A.16    
!             SUN AND SHINE'S PARAMETRIZATION IN THE IR (VERSION 2)                ICLPRM3A.17    
     &   , IP_ICE_ADT                                                              ICLPRM3A.18    
!             SCHEME BASED ON ANOMALOUS DIFFRACTION THEORY                         ICLPRM3A.19    
!             FOR ICE CRYSTALS                                                     ICLPRM3A.20    
                                                                                   ICLPRM3A.21    
!                                                                                  ICLPRM3A.22    
      PARAMETER(                                                                   ICLPRM3A.23    
     &     NPD_ICE_CLOUD_FIT=6                                                     ICLPRM3A.24    
     &   , IP_SLINGO_SCHRECKER_ICE=1                                               ICLPRM3A.25    
     &   , IP_ICE_UNPARAMETRIZED=3                                                 ICLPRM3A.26    
     &   , IP_SUN_SHINE_VN2_VIS=4                                                  ICLPRM3A.27    
     &   , IP_SUN_SHINE_VN2_IR=5                                                   ICLPRM3A.28    
     &   , IP_ICE_ADT=6                                                            ICLPRM3A.29    
     &   )                                                                         ICLPRM3A.30    
!                                                                                  ICLPRM3A.31    
!     ------------------------------------------------------------------           ICLPRM3A.32    
!     ------------------------------------------------------------------           ERROR3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       ERROR3A.3     
!                                                                                  ERROR3A.4     
!     MODULE TO SET ERROR FLAGS IN THE RADIATION CODE.                             ERROR3A.5     
!                                                                                  ERROR3A.6     
      INTEGER                                                                      ERROR3A.7     
     &     I_NORMAL                                                                ERROR3A.8     
!             ERROR FREE CONDITION                                                 ERROR3A.9     
     &   , I_ERR_FATAL                                                             ERROR3A.10    
!             FATAL ERROR: IMMEDIATE RETURN                                        ERROR3A.11    
     &   , I_ABORT_CALCULATION                                                     ERROR3A.12    
!             CALCULATION ABORTED                                                  ERROR3A.13    
     &   , I_MISSING_DATA                                                          ERROR3A.14    
!             MISSING DATA ERROR: CONDITIONAL                                      ERROR3A.15    
     &   , I_ERR_IO                                                                ERROR3A.16    
!             I/O ERROR                                                            ERROR3A.17    
     &   , I_ERR_RANGE                                                             ERROR3A.18    
!             INTERPOLATION RANGE ERROR                                            ERROR3A.19    
     &   , I_ERR_EXIST                                                             ERROR3A.20    
!             EXISTENCE ERROR                                                      ERROR3A.21    
!                                                                                  ERROR3A.22    
      PARAMETER(                                                                   ERROR3A.23    
     &     I_NORMAL=0                                                              ERROR3A.24    
     &   , I_ERR_FATAL=1                                                           ERROR3A.25    
     &   , I_ABORT_CALCULATION=2                                                   ERROR3A.26    
     &   , I_MISSING_DATA=3                                                        ERROR3A.27    
     &   , I_ERR_IO=4                                                              ERROR3A.28    
     &   , I_ERR_RANGE=5                                                           ERROR3A.29    
     &   , I_ERR_EXIST=6                                                           ERROR3A.30    
     &   )                                                                         ERROR3A.31    
!                                                                                  ERROR3A.32    
!     ------------------------------------------------------------------           ERROR3A.33    
!                                                                                  RAD_ALL.12449 
!     DUMMY VARIABLES.                                                             RAD_ALL.12450 
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.12451 
     &     IERR                                                                    RAD_ALL.12452 
!             ERROR FLAG                                                           RAD_ALL.12453 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.12454 
     &     N_PROFILE                                                               RAD_ALL.12455 
!             NUMBER OF PROFILES                                                   RAD_ALL.12456 
     &   , N_LAYER                                                                 RAD_ALL.12457 
!             NUMBER OF LAYERS                                                     RAD_ALL.12458 
     &   , N_CLOUD_TOP                                                             RAD_ALL.12459 
!             TOPMOST CLOUDY LAYER                                                 RAD_ALL.12460 
     &   , I_PARAMETRIZATION_ICE                                                   RAD_ALL.12461 
!             TREATMENT OF ICE CRYSTALS                                            RAD_ALL.12462 
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                              RAD_ALL.12463 
!             NUMBER OF CLOUDY PROFILES                                            RAD_ALL.12464 
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.12465 
!             PROFILES CONTAINING CLOUDS                                           RAD_ALL.12466 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.12467 
     &     L_LAYER                                                                 RAD_ALL.12468 
!             VARIABLES GIVEN IN LAYERS                                            RAD_ALL.12469 
     &   , L_CLOUD_LAYER                                                           RAD_ALL.12470 
!             CLOUD VARIABLES GIVEN IN LAYERS                                      RAD_ALL.12471 
     &   , L_RESCALE                                                               RAD_ALL.12472 
!             DELTA-RESCALING REQUIRED                                             RAD_ALL.12473 
      REAL      !, INTENT(IN)                                                      RAD_ALL.12474 
     &     ICE_CLOUD_PARAMETER(NPD_CLOUD_PARAMETER)                                RAD_ALL.12475 
!             ICE CLOUD PARAMETERS                                                 RAD_ALL.12476 
     &   , ICE_MASS_FRAC(NPD_PROFILE, 0: NPD_LAYER)                                RAD_ALL.12477 
!             ICE MASS FRACTION                                                    RAD_ALL.12478 
     &   , DIM_CHAR_ICE(NPD_PROFILE, 0: NPD_LAYER)                                 RAD_ALL.12479 
!             CHARACTERISTIC DIMENSION FOR CRYSTALS                                RAD_ALL.12480 
     &   , T(NPD_PROFILE, 0: NPD_LAYER)                                            RAD_ALL.12481 
!             TEMPERATURE                                                          RAD_ALL.12482 
     &   , DENSITY(NPD_PROFILE, 0: NPD_LAYER)                                      RAD_ALL.12483 
!             DENSITY AT LEVELS                                                    RAD_ALL.12484 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.12485 
     &     K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER)                                RAD_ALL.12486 
!             SCATTERING EXTINCTION                                                RAD_ALL.12487 
     &   , K_EXT_TOT_CLOUD(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.12488 
!             TOTAL EXTINCTION                                                     RAD_ALL.12489 
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.12490 
!             CLOUDY ASYMMETRIES                                                   RAD_ALL.12491 
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER)                           RAD_ALL.12492 
!             CLOUDY FORWARD SCATTERING                                            RAD_ALL.12493 
!                                                                                  RAD_ALL.12494 
!     LOCAL VARIABLES.                                                             RAD_ALL.12495 
      INTEGER                                                                      RAD_ALL.12496 
     &     L                                                                       RAD_ALL.12497 
!             LOOP VARIABLE                                                        RAD_ALL.12498 
     &   , LL                                                                      RAD_ALL.12499 
!             LOOP VARIABLE                                                        RAD_ALL.12500 
     &   , I                                                                       RAD_ALL.12501 
!             LOOP VARIABLE                                                        RAD_ALL.12502 
      REAL                                                                         RAD_ALL.12503 
     &     ASYMMETRY_PROCESS(NPD_PROFILE)                                          RAD_ALL.12504 
!             ASYMMETRY FACTOR FOR CURRENT PROC.                                   RAD_ALL.12505 
     &   , DIM_CHAR_AVE                                                            RAD_ALL.12506 
!             AVERAGE CHARACTERISTIC DIMENSION IN LAYER                            RAD_ALL.12507 
     &   , X                                                                       RAD_ALL.12508 
!             TEMPORARY ALGEBRAIC VARIABLE                                         RAD_ALL.12509 
     &   , ICE_MASS_FRAC_AVE                                                       RAD_ALL.12510 
!             AVERAGE ICE MASS FRACTION                                            RAD_ALL.12511 
     &   , DENSITY_AVE                                                             RAD_ALL.12512 
!             AVERAGE DENSITY                                                      RAD_ALL.12513 
     &   , T_CELSIUS                                                               RAD_ALL.12514 
!             TEMPERATURE IN CELSIUS                                               RAD_ALL.12515 
     &   , TEMP_CORRECTION                                                         RAD_ALL.12516 
!             TEMPERATURE CORRECTION                                               RAD_ALL.12517 
!                                                                                  RAD_ALL.12518 
!                                                                                  RAD_ALL.12519 
!                                                                                  RAD_ALL.12520 
!                                                                                  RAD_ALL.12521 
      IF (I_PARAMETRIZATION_ICE.EQ.IP_SLINGO_SCHRECKER_ICE) THEN                   RAD_ALL.12522 
!                                                                                  RAD_ALL.12523 
!        WE CALCULATE AVERAGE PROPERTIES FOR THE LAYER AND PUT THESE               RAD_ALL.12524 
!        INTO THE PARAMETRIZATION, RATHER THAN CALCULATING THE                     RAD_ALL.12525 
!        PARAMETRIZATION AT EACH LEVEL: USUALLY THIS IS MORE ACCURATE.             RAD_ALL.12526 
!        IT ALSO FITS MORE NATURALLY WITH CASES WHERE DATA ARE GIVEN               RAD_ALL.12527 
!        IN LAYERS.                                                                RAD_ALL.12528 
!                                                                                  RAD_ALL.12529 
!        THE TOTAL EXTINCTIONS SHOULD BE INCREMENTED BY THE TOTAL                  RAD_ALL.12530 
!        CONTRIBUTIONS FROM CLOUDS, NOT JUST BY THE ABSORPTIVE                     RAD_ALL.12531 
!        EXTINCTIONS.                                                              RAD_ALL.12532 
!                                                                                  RAD_ALL.12533 
         DO I=N_CLOUD_TOP, N_LAYER                                                 RAD_ALL.12534 
            DO LL=1, N_CLOUD_PROFILE(I)                                            RAD_ALL.12535 
               L=I_CLOUD_PROFILE(LL, I)                                            RAD_ALL.12536 
               ICE_MASS_FRAC_AVE=ICE_MASS_FRAC(L, I)                               RAD_ALL.12537 
               DIM_CHAR_AVE=DIM_CHAR_ICE(L, I)                                     RAD_ALL.12538 
                                                                                   RAD_ALL.12539 
               K_EXT_TOT_CLOUD(L, I)                                               RAD_ALL.12540 
     &            =ICE_MASS_FRAC_AVE*(ICE_CLOUD_PARAMETER(1)                       RAD_ALL.12541 
     &            +ICE_CLOUD_PARAMETER(2)/DIM_CHAR_AVE)                            RAD_ALL.12542 
               K_EXT_SCAT_CLOUD(L, I)=K_EXT_TOT_CLOUD(L, I)                        RAD_ALL.12543 
     &            *(1.0E+00-ICE_CLOUD_PARAMETER(3)                                 RAD_ALL.12544 
     &            -ICE_CLOUD_PARAMETER(4)*DIM_CHAR_AVE)                            RAD_ALL.12545 
               ASYMMETRY_PROCESS(L)=                                               RAD_ALL.12546 
     &            ICE_CLOUD_PARAMETER(5)+ICE_CLOUD_PARAMETER(6)                    RAD_ALL.12547 
     &            *DIM_CHAR_AVE                                                    RAD_ALL.12548 
               ASYMMETRY_CLOUD(L, I)=                                              RAD_ALL.12549 
     &            K_EXT_SCAT_CLOUD(L, I)*ASYMMETRY_PROCESS(L)                      RAD_ALL.12550 
            ENDDO                                                                  RAD_ALL.12551 
            IF (L_RESCALE) THEN                                                    RAD_ALL.12552 
               DO LL=1, N_CLOUD_PROFILE(I)                                         RAD_ALL.12553 
                  L=I_CLOUD_PROFILE(LL, I)                                         RAD_ALL.12554 
                  FORWARD_SCATTER_CLOUD(L, I)                                      RAD_ALL.12555 
     &               =K_EXT_SCAT_CLOUD(L, I)                                       RAD_ALL.12556 
     &               *ASYMMETRY_PROCESS(L)**2                                      RAD_ALL.12557 
               ENDDO                                                               RAD_ALL.12558 
            ENDIF                                                                  RAD_ALL.12559 
         ENDDO                                                                     RAD_ALL.12560 
                                                                                   RAD_ALL.12561 
!                                                                                  RAD_ALL.12562 
      ELSE IF (I_PARAMETRIZATION_ICE.EQ.IP_ICE_ADT) THEN                           RAD_ALL.12563 
!                                                                                  RAD_ALL.12564 
         DO I=N_CLOUD_TOP, N_LAYER                                                 RAD_ALL.12565 
            DO LL=1, N_CLOUD_PROFILE(I)                                            RAD_ALL.12566 
               L=I_CLOUD_PROFILE(LL, I)                                            RAD_ALL.12567 
               ICE_MASS_FRAC_AVE=ICE_MASS_FRAC(L, I)                               RAD_ALL.12568 
               DIM_CHAR_AVE=DIM_CHAR_ICE(L, I)                                     RAD_ALL.12569 
               X=LOG(DIM_CHAR_AVE/ICE_CLOUD_PARAMETER(10))                         RAD_ALL.12570 
               IF (X.GT.0.0E+00) THEN                                              RAD_ALL.12571 
!                 LARGE MODE.                                                      RAD_ALL.12572 
                  K_EXT_TOT_CLOUD(L, I)=ICE_MASS_FRAC_AVE                          RAD_ALL.12573 
     &               *EXP(ICE_CLOUD_PARAMETER(1)                                   RAD_ALL.12574 
     &               +X*(ICE_CLOUD_PARAMETER(2)                                    RAD_ALL.12575 
     &               +X*(ICE_CLOUD_PARAMETER(3)                                    RAD_ALL.12576 
     &               +X*(ICE_CLOUD_PARAMETER(4)                                    RAD_ALL.12577 
     &               +X*ICE_CLOUD_PARAMETER(5)))))                                 RAD_ALL.12578 
               ELSE                                                                RAD_ALL.12579 
!                 SMALL MODE.                                                      RAD_ALL.12580 
                  K_EXT_TOT_CLOUD(L, I)=ICE_MASS_FRAC_AVE                          RAD_ALL.12581 
     &               *EXP(ICE_CLOUD_PARAMETER(1)                                   RAD_ALL.12582 
     &               +X*(ICE_CLOUD_PARAMETER(6)                                    RAD_ALL.12583 
     &               +X*(ICE_CLOUD_PARAMETER(7)                                    RAD_ALL.12584 
     &               +X*(ICE_CLOUD_PARAMETER(8)                                    RAD_ALL.12585 
     &               +X*ICE_CLOUD_PARAMETER(9)))))                                 RAD_ALL.12586 
               ENDIF                                                               RAD_ALL.12587 
               X=LOG(DIM_CHAR_AVE/ICE_CLOUD_PARAMETER(20))                         RAD_ALL.12588 
               IF (X.GT.0.0E+00) THEN                                              RAD_ALL.12589 
!                 LARGE MODE.                                                      RAD_ALL.12590 
                  K_EXT_SCAT_CLOUD(L, I)=K_EXT_TOT_CLOUD(L, I)                     RAD_ALL.12591 
     &               *(1.0E+00-(ICE_CLOUD_PARAMETER(11)                            RAD_ALL.12592 
     &               +X*(ICE_CLOUD_PARAMETER(12)                                   RAD_ALL.12593 
     &               +X*(ICE_CLOUD_PARAMETER(13)                                   RAD_ALL.12594 
     &               +X*(ICE_CLOUD_PARAMETER(14)                                   RAD_ALL.12595 
     &               +X*ICE_CLOUD_PARAMETER(15))))))                               RAD_ALL.12596 
               ELSE                                                                RAD_ALL.12597 
!                 SMALL MODE.                                                      RAD_ALL.12598 
                  K_EXT_SCAT_CLOUD(L, I)=K_EXT_TOT_CLOUD(L, I)                     RAD_ALL.12599 
     &               *(1.0E+00-(ICE_CLOUD_PARAMETER(11)                            RAD_ALL.12600 
     &               +X*(ICE_CLOUD_PARAMETER(16)                                   RAD_ALL.12601 
     &               +X*(ICE_CLOUD_PARAMETER(17)                                   RAD_ALL.12602 
     &               +X*(ICE_CLOUD_PARAMETER(18)                                   RAD_ALL.12603 
     &               +X*ICE_CLOUD_PARAMETER(19))))))                               RAD_ALL.12604 
               ENDIF                                                               RAD_ALL.12605 
               X=LOG(DIM_CHAR_AVE/ICE_CLOUD_PARAMETER(30))                         RAD_ALL.12606 
               IF (X.GT.0.0E+00) THEN                                              RAD_ALL.12607 
!                 LARGE MODE.                                                      RAD_ALL.12608 
                  ASYMMETRY_PROCESS(L)=ICE_CLOUD_PARAMETER(21)                     RAD_ALL.12609 
     &               +X*(ICE_CLOUD_PARAMETER(22)                                   RAD_ALL.12610 
     &               +X*(ICE_CLOUD_PARAMETER(23)                                   RAD_ALL.12611 
     &               +X*(ICE_CLOUD_PARAMETER(24)                                   RAD_ALL.12612 
     &               +X*ICE_CLOUD_PARAMETER(25))))                                 RAD_ALL.12613 
               ELSE                                                                RAD_ALL.12614 
!                 SMALL MODE.                                                      RAD_ALL.12615 
                  ASYMMETRY_PROCESS(L)=ICE_CLOUD_PARAMETER(21)                     RAD_ALL.12616 
     &               +X*(ICE_CLOUD_PARAMETER(26)                                   RAD_ALL.12617 
     &               +X*(ICE_CLOUD_PARAMETER(27)                                   RAD_ALL.12618 
     &               +X*(ICE_CLOUD_PARAMETER(28)                                   RAD_ALL.12619 
     &               +X*ICE_CLOUD_PARAMETER(29))))                                 RAD_ALL.12620 
               ENDIF                                                               RAD_ALL.12621 
               ASYMMETRY_CLOUD(L, I)=                                              RAD_ALL.12622 
     &            K_EXT_SCAT_CLOUD(L, I)*ASYMMETRY_PROCESS(L)                      RAD_ALL.12623 
            ENDDO                                                                  RAD_ALL.12624 
            IF (L_RESCALE) THEN                                                    RAD_ALL.12625 
               DO LL=1, N_CLOUD_PROFILE(I)                                         RAD_ALL.12626 
                  L=I_CLOUD_PROFILE(LL, I)                                         RAD_ALL.12627 
                  FORWARD_SCATTER_CLOUD(L, I)                                      RAD_ALL.12628 
     &               =K_EXT_SCAT_CLOUD(L, I)                                       RAD_ALL.12629 
     &               *ASYMMETRY_PROCESS(L)**2                                      RAD_ALL.12630 
               ENDDO                                                               RAD_ALL.12631 
            ENDIF                                                                  RAD_ALL.12632 
         ENDDO                                                                     RAD_ALL.12633 
!                                                                                  RAD_ALL.12634 
!                                                                                  RAD_ALL.12635 
      ELSE IF (I_PARAMETRIZATION_ICE.EQ.IP_SUN_SHINE_VN2_VIS) THEN                 RAD_ALL.12636 
!                                                                                  RAD_ALL.12637 
         DO I=N_CLOUD_TOP, N_LAYER                                                 RAD_ALL.12638 
            DO LL=1, N_CLOUD_PROFILE(I)                                            RAD_ALL.12639 
               L=I_CLOUD_PROFILE(LL, I)                                            RAD_ALL.12640 
               ICE_MASS_FRAC_AVE=ICE_MASS_FRAC(L, I)                               RAD_ALL.12641 
               DENSITY_AVE=DENSITY(L, I)                                           RAD_ALL.12642 
               T_CELSIUS=T(L, I)-2.7316E+02                                        RAD_ALL.12643 
               TEMP_CORRECTION=1.047E+00+T_CELSIUS*(-9.13E-05+T_CELSIUS            RAD_ALL.12644 
     &            *(2.026E-04-1.056E-05*T_CELSIUS))                                RAD_ALL.12645 
               K_EXT_TOT_CLOUD(L, I)=TEMP_CORRECTION*ICE_MASS_FRAC_AVE             RAD_ALL.12646 
     &            /(3.05548E-02                                                    RAD_ALL.12647 
     &            +2.54802E+02*DENSITY_AVE*ICE_MASS_FRAC_AVE)                      RAD_ALL.12648 
               K_EXT_SCAT_CLOUD(L, I)=K_EXT_TOT_CLOUD(L, I)                        RAD_ALL.12649 
     &            *(1.0E+00-ICE_CLOUD_PARAMETER(1)                                 RAD_ALL.12650 
     &            *EXP(ICE_CLOUD_PARAMETER(2)                                      RAD_ALL.12651 
     &            *LOG(DENSITY_AVE*ICE_MASS_FRAC_AVE+1.0E-12)))                    RAD_ALL.12652 
     &            *(1.0E+00+ICE_CLOUD_PARAMETER(5)                                 RAD_ALL.12653 
     &            *(TEMP_CORRECTION-1.0E+00)/TEMP_CORRECTION)                      RAD_ALL.12654 
               ASYMMETRY_PROCESS(L)=                                               RAD_ALL.12655 
     &            ICE_CLOUD_PARAMETER(3)*EXP(ICE_CLOUD_PARAMETER(4)                RAD_ALL.12656 
     &            *LOG(DENSITY_AVE*ICE_MASS_FRAC_AVE+1.0E-12))                     RAD_ALL.12657 
     &            *(1.0E+00+ICE_CLOUD_PARAMETER(6)                                 RAD_ALL.12658 
     &            *(TEMP_CORRECTION-1.0E+00)/TEMP_CORRECTION)                      RAD_ALL.12659 
               ASYMMETRY_CLOUD(L, I)=                                              RAD_ALL.12660 
     &            K_EXT_SCAT_CLOUD(L, I)*ASYMMETRY_PROCESS(L)                      RAD_ALL.12661 
            ENDDO                                                                  RAD_ALL.12662 
            IF (L_RESCALE) THEN                                                    RAD_ALL.12663 
               DO LL=1, N_CLOUD_PROFILE(I)                                         RAD_ALL.12664 
                  L=I_CLOUD_PROFILE(LL, I)                                         RAD_ALL.12665 
                  FORWARD_SCATTER_CLOUD(L, I)                                      RAD_ALL.12666 
     &               =K_EXT_SCAT_CLOUD(L, I)                                       RAD_ALL.12667 
     &               *ASYMMETRY_PROCESS(L)**2                                      RAD_ALL.12668 
               ENDDO                                                               RAD_ALL.12669 
            ENDIF                                                                  RAD_ALL.12670 
         ENDDO                                                                     RAD_ALL.12671 
!                                                                                  RAD_ALL.12672 
      ELSE IF (I_PARAMETRIZATION_ICE.EQ.IP_SUN_SHINE_VN2_IR) THEN                  RAD_ALL.12673 
!                                                                                  RAD_ALL.12674 
         DO I=N_CLOUD_TOP, N_LAYER                                                 RAD_ALL.12675 
            DO LL=1, N_CLOUD_PROFILE(I)                                            RAD_ALL.12676 
               L=I_CLOUD_PROFILE(LL, I)                                            RAD_ALL.12677 
               ICE_MASS_FRAC_AVE=ICE_MASS_FRAC(L, I)                               RAD_ALL.12678 
               DENSITY_AVE=DENSITY(L, I)                                           RAD_ALL.12679 
               T_CELSIUS=T(L, I)-2.7316E+02                                        RAD_ALL.12680 
               TEMP_CORRECTION=1.047E+00+T_CELSIUS*(-9.13E-05+T_CELSIUS            RAD_ALL.12681 
     &            *(2.026E-04-1.056E-05*T_CELSIUS))                                RAD_ALL.12682 
               K_EXT_TOT_CLOUD(L, I)=TEMP_CORRECTION*ICE_MASS_FRAC_AVE             RAD_ALL.12683 
     &            /(6.30689E-02                                                    RAD_ALL.12684 
     &            +2.65874E+02*DENSITY_AVE*ICE_MASS_FRAC_AVE)                      RAD_ALL.12685 
            ENDDO                                                                  RAD_ALL.12686 
         ENDDO                                                                     RAD_ALL.12687 
!                                                                                  RAD_ALL.12688 
      ELSE                                                                         RAD_ALL.12689 
         WRITE(IU_ERR, '(/A)') '*** ERROR: AN INVALID PARAMETRIZATION '            RAD_ALL.12690 
     &      //'OF ICE CRYSTALS HAS BEEN USED..'                                    RAD_ALL.12691 
         IERR=I_ERR_FATAL                                                          RAD_ALL.12692 
         RETURN                                                                    RAD_ALL.12693 
      ENDIF                                                                        RAD_ALL.12694 
!                                                                                  RAD_ALL.12695 
!                                                                                  RAD_ALL.12696 
!                                                                                  RAD_ALL.12697 
      RETURN                                                                       RAD_ALL.12698 
      END  
