C***********************************************************************     IRRAD.2     
C*                         SUBROUTINE IRRAD                            *     IRRAD.3     
C***********************************************************************     IRRAD.4     
      SUBROUTINE IRRAD(GAS,CKD,NLEV,PRES,PFLUX,TEMP,MMR,CL,ACL,LWCCL,        IRRAD.5     
     $                BASCL,TOPCL,FUP,FDWN,FNET,DP,LLBLM,GR)                 IRRAD.6     
C 3-1-98                                                                     IRRAD.7     
C Piers commented out DP calc - it is now passed                             IRRAD.8     
C 18-1-00 SH                                                                 IRRAD.9     
C Fuller gas tables and choice between LBLM or NBM gas tables.               IRRAD.10    
C                                                                            IRRAD.11    
C Subroutine IRRAD calculates the the upward, downward and net               IRRAD.12    
C irradiances at each level of a given atmospheric profile, for a            IRRAD.13    
C given absorber                                                             IRRAD.14    
C                                                                            IRRAD.15    
C INPUT:  Selection of the absorbers (GAS)                                   IRRAD.16    
C         Water vapour continuum index (CKD)                                 IRRAD.17    
C         Number of levels in the atmosphere without the surface (NLEV)      IRRAD.18    
C         Pressure at each level (PRES)                                      IRRAD.19    
C         Pressure at flux levels (PFLUX)                                    IRRAD.20    
C         Temperature at each level (TEMP)                                   IRRAD.21    
C         Absorber mass mixing ratio at each level (MMR)                     IRRAD.22    
C         Selection of cloud types (CL)                                      IRRAD.23    
C         Cloud amount as a fraction (ACL)                                   IRRAD.24    
C         Liquid water content (LWCCL)                                       IRRAD.25    
C         Cloud base and top (BASCL,TOPCL)                                   IRRAD.26    
C         Slab pressure DP                                                   IRRAD.27    
C         Gas table switch LLBLM                                             IRRAD.28    
C OUTPUT: Upward, Downward and Net irradiances at each mid-level             IRRAD.29    
C         (FUP,FDWN,FNET)                                                    IRRAD.30    
                                                                             IRRAD.31    
C***********************************************************************     PARRAY.2     
C*                                                                     *     PARRAY.3     
C*                         P A R R A Y                                 *     PARRAY.4     
C*                                                                     *     PARRAY.5     
C***********************************************************************     PARRAY.6     
C-----------------------------------------------------------------------     PARRAY.7     
C In this part of the code the user can set the dimensions of arrays         PARRAY.8     
C used for the calculations, by setting the values in the paramter           PARRAY.9     
C statements                                                                 PARRAY.10    
C-----------------------------------------------------------------------     PARRAY.11    
                                                                             PARRAY.12    
      INTEGER MXGAS,MXLEV,MXBAND,MXCL                                        PARRAY.13    
                                                                             PARRAY.14    
      PARAMETER(MXGAS=8)     ! Maximum number of gases                       PARRAY.15    
                                                                             PARRAY.16    
      PARAMETER(MXLEV=5)     ! Maximum number of levels in the               NETCDF.37    
                             ! atmosphere (not including the surface)        PARRAY.18    
                                                                             PARRAY.19    
      PARAMETER(MXBAND=9)    ! Maximum number of spectral bands (not         PARRAY.20    
                             ! including the whole spectrum, 0-3000cm-1)     PARRAY.21    
                                                                             PARRAY.22    
      PARAMETER(MXCL=3)      ! Maximum number of cloud types                 PARRAY.23    
                                                                             PARRAY.24    
C-----------------------------------------------------------------------     PARRAY.25    
C-----------------                                                           IRRAD.33    
C Input Variables                                                            IRRAD.34    
C-----------------                                                           IRRAD.35    
      INTEGER GAS(MXGAS),CKD                                                 IRRAD.36    
      INTEGER NLEV                                                           IRRAD.37    
      REAL PRES(0:MXLEV),PFLUX(0:MXLEV)                                      IRRAD.38    
      REAL TEMP(0:MXLEV),MMR(MXGAS,0:MXLEV)                                  IRRAD.39    
      INTEGER CL(0:MXCL)                                                     IRRAD.40    
      REAL ACL(0:MXCL),LWCCL(MXCL),BASCL(0:MXCL),TOPCL(0:MXCL)               IRRAD.41    
      REAL GR      ! Constants  (grav. acceleration)                         IRRAD.42    
C------------------                                                          IRRAD.43    
C Output Variables                                                           IRRAD.44    
C------------------                                                          IRRAD.45    
      REAL FUP(0:MXLEV),FDWN(0:MXLEV),FNET(0:MXLEV)                          IRRAD.46    
C--------------------                                                        IRRAD.47    
C Internal Variables                                                         IRRAD.48    
C--------------------                                                        IRRAD.49    
                                                                             IRRAD.50    
      INTEGER IGAS,IBND,IHAL,ILAY,ICOUNT,IUP,IDWN,ICL                        IRRAD.51    
      INTEGER CLOUD   ! Clear/Cloudy sky index                               IRRAD.52    
                                                                             IRRAD.53    
      REAL ULAY(MXGAS,MXLEV) ! Abs. amount between 2 successive levels       IRRAD.54    
      REAL H2O(MXLEV)     ! Water vapour mid-point mixing ratio              IRRAD.55    
      REAL DP(MXLEV)      ! Thickness of the atmospheric layers              IRRAD.56    
      REAL PMID(MXLEV)    ! Mid-point pressures                              IRRAD.57    
      REAL TMID(MXLEV)    ! Mid-point temperatures                           IRRAD.58    
      REAL QULAY(MXLEV)   ! Abs. amount in sub-layers                        IRRAD.59    
      REAL QH2O(MXLEV)    ! Water vapour mixing ratio in sub-layers          IRRAD.60    
      REAL QDP(MXLEV)     ! Thickness of the sub-layers                      IRRAD.61    
      REAL QP(MXLEV)      ! Pressure in sub-layers                           IRRAD.62    
      REAL QT(MXLEV)      ! Temperature in sub-layers                        IRRAD.63    
      REAL TLEV(0:MXLEV)  ! Temperature at mid-levels                        IRRAD.64    
      REAL TSURF          ! Surface temperature                              IRRAD.65    
                                                                             IRRAD.66    
      REAL UPATH       ! Absorber amount in an atmospheric path              IRRAD.67    
      REAL WVEFF       ! Effective water vapour abs. amount                  IRRAD.68    
      REAL PEFF,TEFF   ! Effective pressure & effective temprature           IRRAD.69    
                                                                             IRRAD.71    
      REAL WVCNT(0:MXLEV-1,MXLEV) ! Effective H2O amount for                 IRRAD.72    
                                    ! continuum absorption                   IRRAD.73    
      REAL UH2O(0:MXLEV-1,MXLEV)  ! H2O amount                               IRRAD.74    
      REAL PH2O(0:MXLEV-1,MXLEV)  ! H2O effective pressure                   IRRAD.75    
      REAL TH2O(0:MXLEV-1,MXLEV)  ! H2O effective pressure                   IRRAD.76    
                                                                             IRRAD.77    
      REAL TRANS    ! Transmittance                                          IRRAD.78    
      REAL TRCNT    ! Continuum transmittance                                IRRAD.79    
      REAL HALTRAN  ! Halocarbon transmittance                               IRRAD.80    
                                                                             IRRAD.81    
      REAL SLP,INTCPT  ! Variables used for interpolation                    IRRAD.82    
                                                                             IRRAD.83    
      REAL TRIN(0:MXLEV-1,MXLEV)  ! Input/Output trans. used for             IRRAD.84    
      REAL TROUT(0:MXLEV-1,MXLEV) ! the treatment of spectral overlap        IRRAD.85    
                                                                             IRRAD.86    
      REAL PLANCK ! Planck function                                          IRRAD.87    
      REAL PF(MXLEV),DPF(0:MXLEV) ! Matrices used for the calculation        IRRAD.88    
                                    ! of the irradiances                     IRRAD.89    
      REAL TRCL(0:MXLEV-1,MXLEV)  ! Cloud transmittance                      IRRAD.90    
      REAL MTRCL(0:MXLEV-1,MXLEV) ! Modified tran. case                      IRRAD.91    
                                                                             IRRAD.92    
C Pre-computed tables for gas absorption                                     IRRAD.93    
                                                                             IRRAD.94    
      REAL AH2O(MXBAND,48,28),AGAS(MXBAND-1,48,28)                           IRRAD.95    
      REAL BH2O(MXBAND,48,28),BGAS(MXBAND-1,48,28)                           IRRAD.96    
      REAL CH2O(MXBAND,48,28),CGAS(MXBAND-1,48,28)                           IRRAD.97    
      REAL DH2O(MXBAND,48,28),DGAS(MXBAND-1,48,28)                           IRRAD.98    
      REAL AN03(48,28),BN03(48,28),CN03(48,28),DN03(48,28)                   IRRAD.99    
      REAL AC02(48,28),BC02(48,28),CC02(48,28),DC02(48,28)                   IRRAD.100   
      REAL AC06(48,28),BC06(48,28),CC06(48,28),DC06(48,28)                   IRRAD.101   
      REAL AC07(48,28),BC07(48,28),CC07(48,28),DC07(48,28)                   IRRAD.102   
                                                                             IRRAD.103   
      REAL FGUP(0:MXLEV)     ! Irradiances in bands of absorbers             IRRAD.104   
      REAL FGDWN(0:MXLEV)    ! (other than the water vapour                  IRRAD.105   
                               !  0-3000 cm-1 band)                          IRRAD.106   
      REAL FUPCL(0:MXCL,MXLEV)  ! Irradiances at cloud levels in             IRRAD.107   
      REAL FDWNCL(0:MXCL,MXLEV) ! the 0-3000 cm-1 band                       IRRAD.108   
                                                                             IRRAD.109   
      REAL FBACK  ! Background upward irradiance                             IRRAD.110   
      LOGICAL LLBLM                                                          IRRAD.111   
      INTEGER IFIRST                                                         IRRAD.112   
      DATA IFIRST/1/                                                         IRRAD.113   
                                                                             IRRAD.114   
C     READ in tables                                                         IRRAD.115   
      IF (IFIRST.EQ.1) THEN                                                  IRRAD.116   
        IFIRST=0                                                             IRRAD.117   
        IF(LLBLM)THEN                                                        IRRAD.118   
         READ(35) ah2o,bh2o,ch2o,dh2o,agas,bgas,cgas,dgas,ac02,bc02,         IRRAD.119   
     :        cc02,dc02,an03,bn03,cn03,dn03,ac06,bc06,cc06,dc06,             IRRAD.120   
     :        ac07,bc07,cc07,dc07                                            IRRAD.121   
         WRITE (2,*)'read in LBLM gas table'                                 IRRAD.122   
        ELSE                                                                 IRRAD.123   
          READ(36) ah2o,bh2o,ch2o,dh2o,agas,bgas,cgas,dgas,ac02,bc02,        IRRAD.124   
     :        cc02,dc02,an03,bn03,cn03,dn03,ac06,bc06,cc06,dc06,             IRRAD.125   
     :        ac07,bc07,cc07,dc07                                            IRRAD.126   
          WRITE (2,*)'read in NBM gas table'                                 IRRAD.127   
        ENDIF                                                                IRRAD.128   
        WRITE(2,*)'gases on:',gas(1),gas(2),gas(3),gas(4),gas(5),            IRRAD.129   
     :                     gas(6),gas(7),gas(8)                              IRRAD.130   
       ENDIF                                                                 IRRAD.131   
C Calculate pressure, temperature absorber amount and water vapour           IRRAD.132   
C mixing ratio between the first two mid-levels (PMID,TMID,ULAY,H2O),        IRRAD.133   
C split the layer into 2 and calculate the same for the upper sub-layer      IRRAD.134   
C (QLAY,QH2O,QP,QT). Sub-layers are required for calculations involving      IRRAD.135   
C modified transmittance. Also calculate the  temperature at                 IRRAD.136   
C  mid-levels (TLEV)                                                         IRRAD.137   
                                                                             IRRAD.138   
      PMID(1)=0.5*(0.5*(PRES(1)+PRES(2))+PRES(0))                            IRRAD.139   
      QP(1)=0.5*(PMID(1)+0.5*(PRES(1)+PRES(2)))                              IRRAD.140   
                                                                             IRRAD.141   
      SLP=(TEMP(0)-TEMP(2))/(PRES(0)-PRES(2))                                IRRAD.142   
      INTCPT=PRES(0)*TEMP(2)-PRES(2)*TEMP(0)                                 IRRAD.143   
      INTCPT=INTCPT/(PRES(0)-PRES(2))                                        IRRAD.144   
      TMID(1)=SLP*PMID(1)+INTCPT                                             IRRAD.145   
      QT(1)=SLP*QP(1)+INTCPT                                                 IRRAD.146   
                                                                             IRRAD.147   
C   Temperature at the surface and the first mid-level                       IRRAD.148   
      TLEV(0)=TEMP(0)                                                        IRRAD.149   
      TLEV(1)=0.5*SLP*(PRES(1)+PRES(2))+INTCPT                               IRRAD.150   
                                                                             IRRAD.151   
      DO IGAS=1,MXGAS                                                        IRRAD.152   
                                                                             IRRAD.153   
         IF (GAS(IGAS).EQ.1) THEN                                            IRRAD.154   
                                                                             IRRAD.155   
            IF ((IGAS.EQ.6).AND.(GAS(2).EQ.1)) THEN                          IRRAD.156   
               ULAY(IGAS,1)=ULAY(2,1)                                        IRRAD.157   
               GOTO 1972                                                     IRRAD.158   
            END IF                                                           IRRAD.159   
                                                                             IRRAD.160   
            IF ((IGAS.EQ.7).AND.(GAS(3).EQ.1)) THEN                          IRRAD.161   
               ULAY(IGAS,1)=ULAY(3,1)                                        IRRAD.162   
               GOTO 1972                                                     IRRAD.163   
            END IF                                                           IRRAD.164   
                                                                             IRRAD.165   
            SLP=(MMR(IGAS,0)-MMR(IGAS,2))/(PRES(0)-PRES(2))                  IRRAD.166   
            INTCPT=PRES(0)*MMR(IGAS,2)-PRES(2)*MMR(IGAS,0)                   IRRAD.167   
            INTCPT=INTCPT/(PRES(0)-PRES(2))                                  IRRAD.168   
            ULAY(IGAS,1)=SLP*PMID(1)+INTCPT                                  IRRAD.169   
            IF (IGAS.EQ.1) THEN                                              IRRAD.170   
               H2O(1)=ULAY(IGAS,1)                                           IRRAD.171   
            END IF                                                           IRRAD.172   
            ULAY(IGAS,1)=ULAY(IGAS,1)*DP(1)/GR                               IRRAD.173   
                                                                             IRRAD.174   
            IF (IGAS.EQ.1) THEN                                              IRRAD.175   
                                                                             IRRAD.176   
               QULAY(1)=SLP*QP(1)+INTCPT                                     IRRAD.177   
               QH2O(1)=QULAY(1)                                              IRRAD.178   
               QDP(1)=0.25*(2*PRES(0)-PRES(1)-PRES(2))                       IRRAD.179   
               QULAY(1)=QULAY(1)*QDP(1)/GR                                   IRRAD.180   
                                                                             IRRAD.181   
            END IF                                                           IRRAD.182   
                                                                             IRRAD.183   
 1972       CONTINUE                                                         IRRAD.184   
                                                                             IRRAD.185   
         END IF                                                              IRRAD.186   
      END DO                                                                 IRRAD.187   
                                                                             IRRAD.188   
C Calculate pressures and temperatures and absorber amounts                  IRRAD.189   
C between two successive mid-levels and in the sub-layers                    IRRAD.190   
                                                                             IRRAD.191   
      DO ILAY=2,NLEV-1                                                       IRRAD.192   
                                                                             IRRAD.193   
C      Mid-point & sub-layer pressures                                       IRRAD.194   
                                                                             IRRAD.195   
         PMID(ILAY)=PRES(ILAY)                                               IRRAD.196   
         QP(ILAY)=0.5*(PMID(ILAY)+0.5*(PRES(ILAY)+PRES(ILAY+1)))             IRRAD.197   
                                                                             IRRAD.198   
C      Mid-point & sub-layer temperatures                                    IRRAD.199   
                                                                             IRRAD.200   
         TMID(ILAY)=TEMP(ILAY)                                               IRRAD.201   
                                                                             IRRAD.202   
         SLP=(TEMP(ILAY)-TEMP(ILAY+1))/(PRES(ILAY)-PRES(ILAY+1))             IRRAD.203   
         INTCPT=PRES(ILAY)*TEMP(ILAY+1)-PRES(ILAY+1)*TEMP(ILAY)              IRRAD.204   
         INTCPT=INTCPT/(PRES(ILAY)-PRES(ILAY+1))                             IRRAD.205   
         QT(ILAY)=SLP*QP(ILAY)+INTCPT                                        IRRAD.206   
                                                                             IRRAD.207   
C      Temperature at mid-levels                                             IRRAD.208   
         TLEV(ILAY)=0.5*SLP*(PRES(ILAY)+PRES(ILAY+1))+INTCPT                 IRRAD.209   
                                                                             IRRAD.210   
C      Absorber amounts                                                      IRRAD.211   
                                                                             IRRAD.212   
C         DP(ILAY)=0.5*(PRES(ILAY-1)-PRES(ILAY+1))                           IRRAD.213   
                                                                             IRRAD.214   
         DO IGAS=1,MXGAS                                                     IRRAD.215   
                                                                             IRRAD.216   
            IF (GAS(IGAS).EQ.1) THEN                                         IRRAD.217   
                                                                             IRRAD.218   
               IF ((IGAS.EQ.6).AND.(GAS(2).EQ.1)) THEN                       IRRAD.219   
                  ULAY(IGAS,ILAY)=ULAY(2,ILAY)                               IRRAD.220   
                  GOTO 1973                                                  IRRAD.221   
               END IF                                                        IRRAD.222   
                                                                             IRRAD.223   
               IF ((IGAS.EQ.7).AND.(GAS(3).EQ.1)) THEN                       IRRAD.224   
                  ULAY(IGAS,ILAY)=ULAY(3,ILAY)                               IRRAD.225   
                  GOTO 1973                                                  IRRAD.226   
               END IF                                                        IRRAD.227   
                                                                             IRRAD.228   
               ULAY(IGAS,ILAY)=MMR(IGAS,ILAY)*DP(ILAY)/GR                    IRRAD.229   
               IF (IGAS.EQ.1) THEN                                           IRRAD.230   
                  H2O(ILAY)=MMR(IGAS,ILAY)                                   IRRAD.231   
               END IF                                                        IRRAD.232   
                                                                             IRRAD.233   
               IF (IGAS.EQ.1) THEN                                           IRRAD.234   
                                                                             IRRAD.235   
                  SLP=(MMR(IGAS,ILAY)-MMR(IGAS,ILAY+1))/                     IRRAD.236   
     $                (PRES(ILAY)-PRES(ILAY+1))                              IRRAD.237   
                  INTCPT=PRES(ILAY)*MMR(IGAS,ILAY+1)-                        IRRAD.238   
     $                   PRES(ILAY+1)*MMR(IGAS,ILAY)                         IRRAD.239   
                  INTCPT=INTCPT/(PRES(ILAY)-PRES(ILAY+1))                    IRRAD.240   
                  QULAY(ILAY)=SLP*QP(ILAY)+INTCPT                            IRRAD.241   
                  QH2O(ILAY)=QULAY(ILAY)                                     IRRAD.242   
                  QDP(ILAY)=0.25*(PRES(ILAY-1)-PRES(ILAY+1))                 IRRAD.243   
                  QULAY(ILAY)=QULAY(ILAY)*QDP(ILAY)/GR                       IRRAD.244   
                                                                             IRRAD.245   
               END IF                                                        IRRAD.246   
                                                                             IRRAD.247   
 1973          CONTINUE                                                      IRRAD.248   
                                                                             IRRAD.249   
            END IF                                                           IRRAD.250   
                                                                             IRRAD.251   
         END DO                                                              IRRAD.252   
                                                                             IRRAD.253   
      END DO                                                                 IRRAD.254   
                                                                             IRRAD.255   
C Calculate pressure, temperature and absorber amount for                    IRRAD.256   
C the upper atmospheric layer and its sub-layers                             IRRAD.257   
                                                                             IRRAD.258   
      PMID(NLEV)=0.5*(PRES(NLEV)+0.5*PRES(NLEV-1))                           IRRAD.259   
      QP(NLEV)=0.5*PMID(NLEV)                                                IRRAD.260   
                                                                             IRRAD.261   
      TMID(NLEV)=TEMP(NLEV)                                                  IRRAD.262   
      SLP=(TEMP(NLEV-1)-TEMP(NLEV))/(PRES(NLEV-1)-PRES(NLEV))                IRRAD.263   
      INTCPT=PRES(NLEV-1)*TEMP(NLEV)-PRES(NLEV)*TEMP(NLEV-1)                 IRRAD.264   
      INTCPT=INTCPT/(PRES(NLEV-1)-PRES(NLEV))                                IRRAD.265   
      QT(NLEV)=SLP*QP(NLEV)+INTCPT                                           IRRAD.266   
                                                                             IRRAD.267   
C   Temperature at the upper mid-level                                       IRRAD.268   
      TLEV(NLEV)=0.5*SLP*PRES(NLEV)+INTCPT                                   IRRAD.269   
                                                                             IRRAD.270   
      DO IGAS=1,MXGAS                                                        IRRAD.271   
                                                                             IRRAD.272   
         IF (GAS(IGAS).EQ.1) THEN                                            IRRAD.273   
                                                                             IRRAD.274   
            IF ((IGAS.EQ.6).AND.(GAS(2).EQ.1)) THEN                          IRRAD.275   
               ULAY(IGAS,NLEV)=ULAY(2,NLEV)                                  IRRAD.276   
               GOTO 1974                                                     IRRAD.277   
            END IF                                                           IRRAD.278   
                                                                             IRRAD.279   
            IF ((IGAS.EQ.7).AND.(GAS(3).EQ.1)) THEN                          IRRAD.280   
               ULAY(IGAS,NLEV)=ULAY(3,NLEV)                                  IRRAD.281   
               GOTO 1974                                                     IRRAD.282   
            END IF                                                           IRRAD.283   
                                                                             IRRAD.284   
            ULAY(IGAS,NLEV)=MMR(IGAS,NLEV)*DP(NLEV)/GR                       IRRAD.285   
            IF (IGAS.EQ.1) THEN                                              IRRAD.286   
               H2O(NLEV)=MMR(IGAS,NLEV)                                      IRRAD.287   
            END IF                                                           IRRAD.288   
                                                                             IRRAD.289   
            IF (IGAS.EQ.1) THEN                                              IRRAD.290   
                                                                             IRRAD.291   
               SLP=(MMR(IGAS,NLEV-1)-MMR(IGAS,NLEV))/                        IRRAD.292   
     $             (PRES(NLEV-1)-PRES(NLEV))                                 IRRAD.293   
               INTCPT=PRES(NLEV-1)*MMR(IGAS,NLEV)-                           IRRAD.294   
     $                PRES(NLEV)*MMR(IGAS,NLEV-1)                            IRRAD.295   
               INTCPT=INTCPT/(PRES(NLEV-1)-PRES(NLEV))                       IRRAD.296   
                                                                             IRRAD.297   
               QULAY(NLEV)=SLP*QP(NLEV)+INTCPT                               IRRAD.298   
               QH2O(NLEV)=QULAY(NLEV)                                        IRRAD.299   
               QDP(NLEV)=0.25*PRES(NLEV-1)                                   IRRAD.300   
               QULAY(NLEV)=QULAY(NLEV)*QDP(NLEV)/GR                          IRRAD.301   
                                                                             IRRAD.302   
            END IF                                                           IRRAD.303   
 1974       CONTINUE                                                         IRRAD.304   
                                                                             IRRAD.305   
         END IF                                                              IRRAD.306   
                                                                             IRRAD.307   
      END DO                                                                 IRRAD.308   
                                                                             IRRAD.309   
C Set cloud index                                                            IRRAD.310   
                                                                             IRRAD.311   
      CLOUD=0                                                                IRRAD.312   
      DO ICL=0,MXCL                                                          IRRAD.313   
         IF (CL(ICL).EQ.1) THEN                                              IRRAD.314   
            CLOUD=1                                                          IRRAD.315   
         END IF                                                              IRRAD.316   
      END DO                                                                 IRRAD.317   
                                                                             IRRAD.318   
C If cloudy skies then call the cloud scheme                                 IRRAD.319   
                                                                             IRRAD.320   
      IF (CLOUD.EQ.1) THEN                                                   IRRAD.321   
         CALL CLDTRAN(NLEV,PFLUX,DP,CL,ACL,LWCCL,BASCL,TOPCL,                IRRAD.322   
     $                TRCL,MTRCL)                                            IRRAD.323   
      END IF                                                                 IRRAD.324   
                                                                             IRRAD.325   
C---------------------------------                                           IRRAD.326   
C Calculation of  the irradiances                                            IRRAD.327   
C---------------------------------                                           IRRAD.328   
                                                                             IRRAD.329   
C--- Background upward irradiance                                            IRRAD.330   
                                                                             IRRAD.331   
      TSURF=TLEV(0)                                                          IRRAD.332   
      FBACK=PLANCK(0,TSURF)                                                  IRRAD.333   
                                                                             IRRAD.334   
C--- Initialise irradiances                                                  IRRAD.335   
                                                                             IRRAD.336   
      DO ILAY=0,NLEV                                                         IRRAD.337   
         FUP(ILAY)=FBACK                                                     IRRAD.338   
         FDWN(ILAY)=0.0                                                      IRRAD.339   
         FNET(ILAY)=FBACK                                                    IRRAD.340   
      END DO                                                                 IRRAD.341   
                                                                             IRRAD.342   
C--- Calculate the irradiances for water vapour absorption.                  IRRAD.343   
C    The wideband covers the whole thermal IR spectrum (0-3000cm-1)          IRRAD.344   
                                                                             IRRAD.345   
      IF (GAS(1).EQ.1) THEN                                                  IRRAD.346   
                                                                             IRRAD.347   
         CALL H2OFLUX(CKD,NLEV,ULAY,H2O,DP,PMID,TMID,QULAY,QH2O,QDP,         IRRAD.348   
     $                QP,QT,TLEV,CLOUD,TRCL,MTRCL,WVCNT,UH2O,PH2O,           IRRAD.349   
     $                TH2O,FUP,FDWN)                                         IRRAD.350   
                                                                             IRRAD.351   
C--- Avoid smoothing at cloud levels                                         IRRAD.352   
                                                                             IRRAD.353   
         IF (CLOUD.EQ.1) THEN                                                IRRAD.354   
            DO ICL=0,MXCL                                                    IRRAD.355   
               IF (CL(ICL).EQ.1) THEN                                        IRRAD.356   
                  DO ILAY=1,NLEV                                             IRRAD.357   
                     IF ((100.*PFLUX(ILAY).LE.(BASCL(ICL)+1.D4)).AND.        IRRAD.358   
     $                   (100.*PFLUX(ILAY).GE.(TOPCL(ICL)-1.D4))) THEN       IRRAD.359   
                        FUPCL(ICL,ILAY)=FUP(ILAY)                            IRRAD.360   
                        FDWNCL(ICL,ILAY)=FDWN(ILAY)                          IRRAD.361   
                     ELSE                                                    IRRAD.362   
                        FUPCL(ICL,ILAY)=0.0                                  IRRAD.363   
                        FDWNCL(ICL,ILAY)=0.0                                 IRRAD.364   
                     END IF                                                  IRRAD.365   
                  END DO                                                     IRRAD.366   
               END IF                                                        IRRAD.367   
            END DO                                                           IRRAD.368   
         END IF                                                              IRRAD.369   
                                                                             IRRAD.370   
C--- Smoothing of the irradiance profiles                                    IRRAD.371   
                                                                             IRRAD.372   
         CALL SMFLUX(NLEV,PFLUX,FUP)                                         IRRAD.373   
         CALL SMFLUX(NLEV,PFLUX,FDWN)                                        IRRAD.374   
                                                                             IRRAD.375   
         IF (CLOUD.EQ.1) THEN                                                IRRAD.376   
            DO ICL=0,MXCL                                                    IRRAD.377   
               IF (CL(ICL).EQ.1) THEN                                        IRRAD.378   
                  DO ILAY=1,NLEV                                             IRRAD.379   
                     IF (FUPCL(ICL,ILAY).NE.0.0) THEN                        IRRAD.380   
                        FUP(ILAY)=FUPCL(ICL,ILAY)                            IRRAD.381   
                        FDWN(ILAY)=FDWNCL(ICL,ILAY)                          IRRAD.382   
                     END IF                                                  IRRAD.383   
                  END DO                                                     IRRAD.384   
               END IF                                                        IRRAD.385   
            END DO                                                           IRRAD.386   
         END IF                                                              IRRAD.387   
                                                                             IRRAD.388   
         FUP(0)=PLANCK(0,TLEV(0))                                            IRRAD.389   
         FDWN(NLEV)=0.0                                                      IRRAD.390   
                                                                             IRRAD.391   
         DO ILAY=0,NLEV                                                      IRRAD.392   
            FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                                  IRRAD.393   
         END DO                                                              IRRAD.394   
                                                                             IRRAD.395   
      END IF                                                                 IRRAD.396   
                                                                             IRRAD.397   
C-----------------------------------------------------------                 IRRAD.398   
C  S P E C T R A L    B A N D S    I N    T H E    R W B M                   IRRAD.399   
C-----------------------------------------------------------                 IRRAD.400   
C  IBND     0:      0 - 3000 cm-1   H2O                                      IRRAD.401   
C  IBND     1:    540 -  820 cm-1   H2O + CO2                                IRRAD.402   
C  IBND     2:    980 - 1100 cm-1   H2O +  O3 + CO2                          IRRAD.403   
C  IBND     3:   1200 - 1400 cm-1   H2O + CH4                                IRRAD.404   
C  IBND     4:   2100 - 2300 cm-1   H2O + N2O                                IRRAD.405   
C  IBND     5:    900 -  980 cm-1   H2O + CO2                                IRRAD.406   
C  IBND     6:    650 -  770 cm-1   H2O +  O3 + CO2                          IRRAD.407   
C  IBND     7:    550 -  630 cm-1   H2O + N2O + CO2                          IRRAD.408   
C  IBND     8:   1100 - 1200 cm-1   H2O + N2O                                IRRAD.409   
C  IBND  9-12:    820 -  900 cm-1   H2O + HALOCARBON                         IRRAD.410   
C-----------------------------------------------------------                 IRRAD.411   
                                                                             IRRAD.412   
C-----------------------                                                     IRRAD.413   
C    Loop over bands                                                         IRRAD.414   
C-----------------------                                                     IRRAD.415   
                                                                             IRRAD.416   
      DO IBND=1,MXBAND                                                       IRRAD.417   
                                                                             IRRAD.418   
C Skip the loop, if there is no gas that absorbs in the band                 IRRAD.419   
                                                                             IRRAD.420   
         IF ((IBND.EQ.1).AND.(GAS(2).EQ.0)) THEN                             IRRAD.421   
            GOTO 1975                                                        IRRAD.422   
         END IF                                                              IRRAD.423   
         IF ((IBND.EQ.2).AND.(GAS(3).EQ.0).AND.(GAS(6).EQ.0)) THEN           IRRAD.424   
            GOTO 1975                                                        IRRAD.425   
         END IF                                                              IRRAD.426   
         IF ((IBND.EQ.3).AND.(GAS(4).EQ.0).AND.(GAS(5).EQ.0)) THEN           IRRAD.427   
            GOTO 1975                                                        IRRAD.428   
         END IF                                                              IRRAD.429   
         IF ((IBND.EQ.4).AND.(GAS(5).EQ.0)) THEN                             IRRAD.430   
            GOTO 1975                                                        IRRAD.431   
         END IF                                                              IRRAD.432   
         IF ((IBND.EQ.5).AND.(GAS(6).EQ.0)) THEN                             IRRAD.433   
            GOTO 1975                                                        IRRAD.434   
         END IF                                                              IRRAD.435   
         IF ((IBND.EQ.6).AND.(GAS(7).EQ.0)) THEN                             IRRAD.436   
            GOTO 1975                                                        IRRAD.437   
         END IF                                                              IRRAD.438   
         IF ((IBND.EQ.7).AND.(GAS(5).EQ.0)) THEN                             IRRAD.439   
            GOTO 1975                                                        IRRAD.440   
         END IF                                                              IRRAD.441   
         IF ((IBND.EQ.8).AND.(GAS(5).EQ.0)) THEN                             IRRAD.442   
            GOTO 1975                                                        IRRAD.443   
         END IF                                                              IRRAD.444   
         IF ((IBND.EQ.9).AND.(GAS(8).EQ.0)) THEN                             IRRAD.445   
            GOTO 1975                                                        IRRAD.446   
         END IF                                                              IRRAD.447   
                                                                             IRRAD.448   
C Initialise input transmittances (used for overlap treatment)               IRRAD.449   
                                                                             IRRAD.450   
         DO IUP=1,NLEV                                                       IRRAD.451   
            DO IDWN=0,NLEV-1                                                 IRRAD.452   
               IF (CLOUD.EQ.1) THEN                                          IRRAD.453   
                  TRIN(IDWN,IUP)=TRCL(IDWN,IUP) ! Cloudy skies               IRRAD.454   
               ELSE                                                          IRRAD.455   
                  TRIN(IDWN,IUP)=1.0            ! Clear skies                IRRAD.456   
               END IF                                                        IRRAD.457   
            END DO                                                           IRRAD.458   
         END DO                                                              IRRAD.459   
                                                                             IRRAD.460   
C Calculate arrays PF and DPF used in the calculation of the fluxes          IRRAD.461   
C PF:  Integrated Planck function at mid-points                              IRRAD.462   
C DPF: Differences of the PFs                                                IRRAD.463   
                                                                             IRRAD.464   
         DO ILAY=1,NLEV                                                      IRRAD.465   
            PF(ILAY)=PLANCK(IBND,TMID(ILAY))                                 IRRAD.466   
         END DO                                                              IRRAD.467   
                                                                             IRRAD.468   
         DPF(0)=PLANCK(IBND,TSURF)-PLANCK(IBND,TMID(1))                      IRRAD.469   
         DPF(NLEV)=PLANCK(IBND,TMID(NLEV))                                   IRRAD.470   
                                                                             IRRAD.471   
         DO ILAY=1,NLEV-1                                                    IRRAD.472   
            DPF(ILAY)=PLANCK(IBND,TMID(ILAY))-PLANCK(IBND,TMID(ILAY+1))      IRRAD.473   
         END DO                                                              IRRAD.474   
                                                                             IRRAD.475   
                                                                             IRRAD.476   
C--- If overlap with H2O then calculate H2O irradiances in the               IRRAD.477   
C    absorber's band and subtract them from the total                        IRRAD.478   
                                                                             IRRAD.479   
         IF (GAS(1).EQ.1) THEN                                               IRRAD.480   
                                                                             IRRAD.481   
C Boundary Conditions                                                        IRRAD.482   
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.483   
            FGDWN(NLEV)=0.0                                                  IRRAD.484   
                                                                             IRRAD.485   
C Initialise the irradiances                                                 IRRAD.486   
            DO ILAY=1,NLEV                                                   IRRAD.487   
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.488   
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.489   
            END DO                                                           IRRAD.490   
                                                                             IRRAD.491   
            DO IUP=1,NLEV                                                    IRRAD.492   
               DO IDWN=0,IUP-1                                               IRRAD.493   
                                                                             IRRAD.494   
                  UPATH=UH2O(IDWN,IUP)                                       IRRAD.495   
                  PEFF=PH2O(IDWN,IUP)                                        IRRAD.496   
                  TEFF=TH2O(IDWN,IUP)                                        IRRAD.497   
                                                                             IRRAD.498   
                  CALL GASSEARCH(1,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,           IRRAD.499   
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.500   
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.501   
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.502   
                  TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                       IRRAD.503   
                                                                             IRRAD.504   
C          Calculate self-broadened continuum transmittance                  IRRAD.505   
                  IF (CKD.EQ.1) THEN                                         IRRAD.506   
                     WVEFF=WVCNT(IDWN,IUP)                                   IRRAD.507   
                     CALL GASCNT(IBND,WVEFF,TEFF,TRCNT)                      IRRAD.508   
                     TROUT(IDWN,IUP)=TROUT(IDWN,IUP)*TRCNT                   IRRAD.509   
                  END IF                                                     IRRAD.510   
                                                                             IRRAD.511   
                  FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)              IRRAD.512   
                  FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)           IRRAD.513   
                                                                             IRRAD.514   
               END DO                                                        IRRAD.515   
            END DO                                                           IRRAD.516   
                                                                             IRRAD.517   
            IF ((IBND.EQ.6).AND.(GAS(2).EQ.1)) THEN                          IRRAD.518   
               CONTINUE                                                      IRRAD.519   
            ELSE                                                             IRRAD.520   
               IF ((IBND.EQ.7).AND.(GAS(2).EQ.1)) THEN                       IRRAD.521   
                  CONTINUE                                                   IRRAD.522   
               ELSE                                                          IRRAD.523   
                  DO ILAY=0,NLEV                                             IRRAD.524   
                     FUP(ILAY)=FUP(ILAY)-FGUP(ILAY)                          IRRAD.525   
                     FDWN(ILAY)=FDWN(ILAY)-FGDWN(ILAY)                       IRRAD.526   
                     FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                         IRRAD.527   
                  END DO                                                     IRRAD.528   
               END IF                                                        IRRAD.529   
            END IF                                                           IRRAD.530   
                                                                             IRRAD.531   
            DO IUP=1,NLEV                                                    IRRAD.532   
               DO IDWN=0,NLEV-1                                              IRRAD.533   
                  TRIN(IDWN,IUP)=TROUT(IDWN,IUP)                             IRRAD.534   
               END DO                                                        IRRAD.535   
            END DO                                                           IRRAD.536   
                                                                             IRRAD.537   
         END IF                                                              IRRAD.538   
                                                                             IRRAD.539   
C Set halocarbon band index (for different overlap cases)                    IRRAD.540   
                                                                             IRRAD.541   
         IF (IBND.EQ.9) THEN                                                 IRRAD.542   
            IHAL=9                                                           IRRAD.543   
            IF (GAS(2).EQ.1) THEN                                            IRRAD.544   
               IHAL=10                                                       IRRAD.545   
            END IF                                                           IRRAD.546   
            IF (GAS(3).EQ.1) THEN                                            IRRAD.547   
               IHAL=11                                                       IRRAD.548   
            END IF                                                           IRRAD.549   
            IF ((GAS(2).EQ.1).AND.GAS(3).EQ.1) THEN                          IRRAD.550   
               IHAL=12                                                       IRRAD.551   
            END IF                                                           IRRAD.552   
         END IF                                                              IRRAD.553   
                                                                             IRRAD.554   
C------------------------                                                    IRRAD.555   
C  BAND 1: 540-820 cm-1                                                      IRRAD.556   
C------------------------                                                    IRRAD.557   
                                                                             IRRAD.558   
         IF (IBND.EQ.1) THEN                                                 IRRAD.559   
                                                                             IRRAD.560   
C Boundary Conditions                                                        IRRAD.561   
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.562   
            FGDWN(NLEV)=0.0                                                  IRRAD.563   
                                                                             IRRAD.564   
C Initialise the irradiances                                                 IRRAD.565   
            DO ILAY=1,NLEV                                                   IRRAD.566   
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.567   
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.568   
            END DO                                                           IRRAD.569   
                                                                             IRRAD.570   
                                    ! CO2 absorption                         IRRAD.571   
                                                                             IRRAD.572   
            DO IUP=1,NLEV                                                    IRRAD.573   
               DO IDWN=0,IUP-1                                               IRRAD.574   
                                                                             IRRAD.575   
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.576   
                  UPATH=0.0                                                  IRRAD.577   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.578   
                     UPATH=UPATH+ULAY(2,ILAY)                                IRRAD.579   
                  END DO                                                     IRRAD.580   
                                                                             IRRAD.581   
C          Calculate the effective pressure of the path                      IRRAD.582   
                  PEFF=0.0                                                   IRRAD.583   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.584   
                     PEFF=PEFF+PMID(ILAY)*ULAY(2,ILAY)                       IRRAD.585   
                  END DO                                                     IRRAD.586   
                  PEFF=PEFF/UPATH                                            IRRAD.587   
                                                                             IRRAD.588   
C          Calculate the effective temperature of the path                   IRRAD.589   
                  TEFF=0.0                                                   IRRAD.590   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.591   
                     TEFF=TEFF+TMID(ILAY)*ULAY(2,ILAY)                       IRRAD.592   
                  END DO                                                     IRRAD.593   
                  TEFF=TEFF/UPATH                                            IRRAD.594   
                                                                             IRRAD.595   
                  CALL GASSEARCH(2,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,           IRRAD.596   
     $                     CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,          IRRAD.597   
     $                     CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,          IRRAD.598   
     $                     CC06,DC06,AC07,BC07,CC07,DC07,TRANS)              IRRAD.599   
                  TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                       IRRAD.600   
                                                                             IRRAD.601   
               END DO                                                        IRRAD.602   
            END DO                                                           IRRAD.603   
                                                                             IRRAD.604   
            DO IUP=1,NLEV                                                    IRRAD.605   
               DO IDWN=0,IUP-1                                               IRRAD.606   
                  FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)              IRRAD.607   
                  FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)           IRRAD.608   
               END DO                                                        IRRAD.609   
            END DO                                                           IRRAD.610   
                                                                             IRRAD.611   
            IF (GAS(1).EQ.1) THEN                                            IRRAD.612   
               DO ILAY=0,NLEV                                                IRRAD.613   
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.614   
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.615   
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.616   
               END DO                                                        IRRAD.617   
            ELSE                                                             IRRAD.618   
               DO ILAY=0,NLEV                                                IRRAD.619   
                  FUP(ILAY)=FBACK-PLANCK(IBND,TSURF)+FGUP(ILAY)              IRRAD.620   
                  FDWN(ILAY)=FGDWN(ILAY)                                     IRRAD.621   
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.622   
               END DO                                                        IRRAD.623   
            END IF                                                           IRRAD.624   
                                                                             IRRAD.625   
            GOTO 1975                                                        IRRAD.626   
                                                                             IRRAD.627   
         END IF                                                              IRRAD.628   
                                                                             IRRAD.629   
C------------------------                                                    IRRAD.630   
C  BAND 2: 980-1100 cm-1                                                     IRRAD.631   
C------------------------                                                    IRRAD.632   
                                                                             IRRAD.633   
         IF (IBND.EQ.2) THEN                                                 IRRAD.634   
                                                                             IRRAD.635   
C Boundary Conditions                                                        IRRAD.636   
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.637   
            FGDWN(NLEV)=0.0                                                  IRRAD.638   
                                                                             IRRAD.639   
C Initialise the irradiances                                                 IRRAD.640   
            DO ILAY=1,NLEV                                                   IRRAD.641   
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.642   
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.643   
            END DO                                                           IRRAD.644   
                                                                             IRRAD.645   
            IF (GAS(3).EQ.1) THEN   ! O3 absorption                          IRRAD.646   
                                                                             IRRAD.647   
               DO IUP=1,NLEV                                                 IRRAD.648   
                  DO IDWN=0,IUP-1                                            IRRAD.649   
                                                                             IRRAD.650   
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.651   
                     UPATH=0.0                                               IRRAD.652   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.653   
                        UPATH=UPATH+ULAY(3,ILAY)                             IRRAD.654   
                     END DO                                                  IRRAD.655   
                                                                             IRRAD.656   
C          Calculate the effective pressure of the path                      IRRAD.657   
                     PEFF=0.0                                                IRRAD.658   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.659   
                        PEFF=PEFF+PMID(ILAY)*ULAY(3,ILAY)                    IRRAD.660   
                     END DO                                                  IRRAD.661   
                     PEFF=PEFF/UPATH                                         IRRAD.662   
                                                                             IRRAD.663   
C          Calculate the effective temperature of the path                   IRRAD.664   
                     TEFF=0.0                                                IRRAD.665   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.666   
                        TEFF=TEFF+TMID(ILAY)*ULAY(3,ILAY)                    IRRAD.667   
                     END DO                                                  IRRAD.668   
                     TEFF=TEFF/UPATH                                         IRRAD.669   
                                                                             IRRAD.670   
                     CALL GASSEARCH(3,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.671   
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.672   
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.673   
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.674   
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.675   
                                                                             IRRAD.676   
                  END DO                                                     IRRAD.677   
               END DO                                                        IRRAD.678   
                                                                             IRRAD.679   
               DO IUP=1,NLEV                                                 IRRAD.680   
                  DO IDWN=0,NLEV-1                                           IRRAD.681   
                     TRIN(IDWN,IUP)=TROUT(IDWN,IUP)                          IRRAD.682   
                  END DO                                                     IRRAD.683   
               END DO                                                        IRRAD.684   
                                                                             IRRAD.685   
            END IF                                                           IRRAD.686   
                                                                             IRRAD.687   
            IF (GAS(6).EQ.1) THEN   ! CO2 absorption                         IRRAD.688   
                                                                             IRRAD.689   
               DO IUP=1,NLEV                                                 IRRAD.690   
                  DO IDWN=0,IUP-1                                            IRRAD.691   
                                                                             IRRAD.692   
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.693   
                     UPATH=0.0                                               IRRAD.694   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.695   
                        UPATH=UPATH+ULAY(6,ILAY)                             IRRAD.696   
                     END DO                                                  IRRAD.697   
                                                                             IRRAD.698   
C          Calculate the effective pressure of the path                      IRRAD.699   
                     PEFF=0.0                                                IRRAD.700   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.701   
                        PEFF=PEFF+PMID(ILAY)*ULAY(6,ILAY)                    IRRAD.702   
                     END DO                                                  IRRAD.703   
                     PEFF=PEFF/UPATH                                         IRRAD.704   
                                                                             IRRAD.705   
C          Calculate the effective temperature of the path                   IRRAD.706   
                     TEFF=0.0                                                IRRAD.707   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.708   
                        TEFF=TEFF+TMID(ILAY)*ULAY(6,ILAY)                    IRRAD.709   
                     END DO                                                  IRRAD.710   
                     TEFF=TEFF/UPATH                                         IRRAD.711   
                                                                             IRRAD.712   
                     CALL GASSEARCH(6,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.713   
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.714   
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.715   
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.716   
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.717   
                                                                             IRRAD.718   
                  END DO                                                     IRRAD.719   
               END DO                                                        IRRAD.720   
                                                                             IRRAD.721   
            END IF                                                           IRRAD.722   
                                                                             IRRAD.723   
            DO IUP=1,NLEV                                                    IRRAD.724   
               DO IDWN=0,IUP-1                                               IRRAD.725   
                  FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)              IRRAD.726   
                  FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)           IRRAD.727   
               END DO                                                        IRRAD.728   
            END DO                                                           IRRAD.729   
                                                                             IRRAD.730   
            IF (GAS(1).EQ.1) THEN                                            IRRAD.731   
               DO ILAY=0,NLEV                                                IRRAD.732   
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.733   
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.734   
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.735   
               END DO                                                        IRRAD.736   
            ELSE                                                             IRRAD.737   
               DO ILAY=0,NLEV                                                IRRAD.738   
                  FUP(ILAY)=FUP(ILAY)-PLANCK(IBND,TSURF)+FGUP(ILAY)          IRRAD.739   
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.740   
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.741   
               END DO                                                        IRRAD.742   
            END IF                                                           IRRAD.743   
                                                                             IRRAD.744   
            GOTO 1975                                                        IRRAD.745   
                                                                             IRRAD.746   
         END IF                                                              IRRAD.747   
                                                                             IRRAD.748   
C-------------------------                                                   IRRAD.749   
C  BAND 3: 1200-1400 cm-1                                                    IRRAD.750   
C-------------------------                                                   IRRAD.751   
                                                                             IRRAD.752   
         IF (IBND.EQ.3) THEN                                                 IRRAD.753   
                                                                             IRRAD.754   
C Boundary Conditions                                                        IRRAD.755   
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.756   
            FGDWN(NLEV)=0.0                                                  IRRAD.757   
                                                                             IRRAD.758   
C Initialise the irradiances                                                 IRRAD.759   
            DO ILAY=1,NLEV                                                   IRRAD.760   
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.761   
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.762   
            END DO                                                           IRRAD.763   
                                                                             IRRAD.764   
            IF (GAS(4).EQ.1) THEN   ! CH4 absorption                         IRRAD.765   
                                                                             IRRAD.766   
               DO IUP=1,NLEV                                                 IRRAD.767   
                  DO IDWN=0,IUP-1                                            IRRAD.768   
                                                                             IRRAD.769   
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.770   
                     UPATH=0.0                                               IRRAD.771   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.772   
                        UPATH=UPATH+ULAY(4,ILAY)                             IRRAD.773   
                     END DO                                                  IRRAD.774   
                                                                             IRRAD.775   
C          Calculate the effective pressure of the path                      IRRAD.776   
                     PEFF=0.0                                                IRRAD.777   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.778   
                        PEFF=PEFF+PMID(ILAY)*ULAY(4,ILAY)                    IRRAD.779   
                     END DO                                                  IRRAD.780   
                     PEFF=PEFF/UPATH                                         IRRAD.781   
                                                                             IRRAD.782   
C          Calculate the effective temperature of the path                   IRRAD.783   
                     TEFF=0.0                                                IRRAD.784   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.785   
                        TEFF=TEFF+TMID(ILAY)*ULAY(4,ILAY)                    IRRAD.786   
                     END DO                                                  IRRAD.787   
                     TEFF=TEFF/UPATH                                         IRRAD.788   
                                                                             IRRAD.789   
                     CALL GASSEARCH(4,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.790   
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.791   
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.792   
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.793   
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.794   
                                                                             IRRAD.795   
                  END DO                                                     IRRAD.796   
               END DO                                                        IRRAD.797   
                                                                             IRRAD.798   
               DO IUP=1,NLEV                                                 IRRAD.799   
                  DO IDWN=0,NLEV-1                                           IRRAD.800   
                     TRIN(IDWN,IUP)=TROUT(IDWN,IUP)                          IRRAD.801   
                  END DO                                                     IRRAD.802   
               END DO                                                        IRRAD.803   
                                                                             IRRAD.804   
            END IF                                                           IRRAD.805   
                                                                             IRRAD.806   
            IF (GAS(5).EQ.1) THEN   ! N2O absorption                         IRRAD.807   
                                                                             IRRAD.808   
               DO IUP=1,NLEV                                                 IRRAD.809   
                  DO IDWN=0,IUP-1                                            IRRAD.810   
                                                                             IRRAD.811   
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.812   
                     UPATH=0.0                                               IRRAD.813   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.814   
                        UPATH=UPATH+ULAY(5,ILAY)                             IRRAD.815   
                     END DO                                                  IRRAD.816   
                                                                             IRRAD.817   
C          Calculate the effective pressure of the path                      IRRAD.818   
                     PEFF=0.0                                                IRRAD.819   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.820   
                        PEFF=PEFF+PMID(ILAY)*ULAY(5,ILAY)                    IRRAD.821   
                     END DO                                                  IRRAD.822   
                     PEFF=PEFF/UPATH                                         IRRAD.823   
                                                                             IRRAD.824   
C          Calculate the effective temperature of the path                   IRRAD.825   
                     TEFF=0.0                                                IRRAD.826   
                     DO ILAY=IDWN+1,IUP                                      IRRAD.827   
                        TEFF=TEFF+TMID(ILAY)*ULAY(5,ILAY)                    IRRAD.828   
                     END DO                                                  IRRAD.829   
                     TEFF=TEFF/UPATH                                         IRRAD.830   
                                                                             IRRAD.831   
                     CALL GASSEARCH(5,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.832   
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.833   
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.834   
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.835   
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.836   
                                                                             IRRAD.837   
                  END DO                                                     IRRAD.838   
               END DO                                                        IRRAD.839   
                                                                             IRRAD.840   
            END IF                                                           IRRAD.841   
            DO IUP=1,NLEV                                                    IRRAD.842   
               DO IDWN=0,IUP-1                                               IRRAD.843   
                  FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)              IRRAD.844   
                  FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)           IRRAD.845   
               END DO                                                        IRRAD.846   
            END DO                                                           IRRAD.847   
                                                                             IRRAD.848   
            IF (GAS(1).EQ.1) THEN                                            IRRAD.849   
               DO ILAY=0,NLEV                                                IRRAD.850   
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.851   
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.852   
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.853   
               END DO                                                        IRRAD.854   
            ELSE                                                             IRRAD.855   
               DO ILAY=0,NLEV                                                IRRAD.856   
                  FUP(ILAY)=FUP(ILAY)-PLANCK(IBND,TSURF)+FGUP(ILAY)          IRRAD.857   
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.858   
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.859   
               END DO                                                        IRRAD.860   
            END IF                                                           IRRAD.861   
                                                                             IRRAD.862   
            GOTO 1975                                                        IRRAD.863   
                                                                             IRRAD.864   
         END IF                                                              IRRAD.865   
                                                                             IRRAD.866   
C-------------------------                                                   IRRAD.867   
C  BAND 4: 2100-2300 cm-1                                                    IRRAD.868   
C-------------------------                                                   IRRAD.869   
                                                                             IRRAD.870   
         IF (IBND.EQ.4) THEN                                                 IRRAD.871   
                                                                             IRRAD.872   
C Boundary Conditions                                                        IRRAD.873   
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.874   
            FGDWN(NLEV)=0.0                                                  IRRAD.875   
                                                                             IRRAD.876   
C Initialise the irradiances                                                 IRRAD.877   
            DO ILAY=1,NLEV                                                   IRRAD.878   
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.879   
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.880   
            END DO                                                           IRRAD.881   
                                                                             IRRAD.882   
                                    ! N2O absorption                         IRRAD.883   
                                                                             IRRAD.884   
            DO IUP=1,NLEV                                                    IRRAD.885   
               DO IDWN=0,IUP-1                                               IRRAD.886   
                                                                             IRRAD.887   
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.888   
                  UPATH=0.0                                                  IRRAD.889   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.890   
                     UPATH=UPATH+ULAY(5,ILAY)                                IRRAD.891   
                  END DO                                                     IRRAD.892   
                                                                             IRRAD.893   
C          Calculate the effective pressure of the path                      IRRAD.894   
                  PEFF=0.0                                                   IRRAD.895   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.896   
                     PEFF=PEFF+PMID(ILAY)*ULAY(5,ILAY)                       IRRAD.897   
                  END DO                                                     IRRAD.898   
                  PEFF=PEFF/UPATH                                            IRRAD.899   
                                                                             IRRAD.900   
C          Calculate the effective temperature of the path                   IRRAD.901   
                  TEFF=0.0                                                   IRRAD.902   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.903   
                     TEFF=TEFF+TMID(ILAY)*ULAY(5,ILAY)                       IRRAD.904   
                  END DO                                                     IRRAD.905   
                  TEFF=TEFF/UPATH                                            IRRAD.906   
                                                                             IRRAD.907   
                  CALL GASSEARCH(5,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,           IRRAD.908   
     $                     CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,          IRRAD.909   
     $                     CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,          IRRAD.910   
     $                     CC06,DC06,AC07,BC07,CC07,DC07,TRANS)              IRRAD.911   
                  TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                       IRRAD.912   
                                                                             IRRAD.913   
               END DO                                                        IRRAD.914   
            END DO                                                           IRRAD.915   
                                                                             IRRAD.916   
            DO IUP=1,NLEV                                                    IRRAD.917   
               DO IDWN=0,IUP-1                                               IRRAD.918   
                  FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)              IRRAD.919   
                  FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)           IRRAD.920   
               END DO                                                        IRRAD.921   
            END DO                                                           IRRAD.922   
                                                                             IRRAD.923   
            IF (GAS(1).EQ.1) THEN                                            IRRAD.924   
               DO ILAY=0,NLEV                                                IRRAD.925   
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.926   
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.927   
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.928   
               END DO                                                        IRRAD.929   
            ELSE                                                             IRRAD.930   
               DO ILAY=0,NLEV                                                IRRAD.931   
                  FUP(ILAY)=FUP(ILAY)-PLANCK(IBND,TSURF)+FGUP(ILAY)          IRRAD.932   
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.933   
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.934   
               END DO                                                        IRRAD.935   
            END IF                                                           IRRAD.936   
                                                                             IRRAD.937   
            GOTO 1975                                                        IRRAD.938   
                                                                             IRRAD.939   
         END IF                                                              IRRAD.940   
                                                                             IRRAD.941   
C-----------------------                                                     IRRAD.942   
C  BAND 5: 900-980 cm-1                                                      IRRAD.943   
C-----------------------                                                     IRRAD.944   
                                                                             IRRAD.945   
         IF (IBND.EQ.5) THEN                                                 IRRAD.946   
                                                                             IRRAD.947   
C Boundary Conditions                                                        IRRAD.948   
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.949   
            FGDWN(NLEV)=0.0                                                  IRRAD.950   
                                                                             IRRAD.951   
C Initialise the irradiances                                                 IRRAD.952   
            DO ILAY=1,NLEV                                                   IRRAD.953   
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.954   
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.955   
            END DO                                                           IRRAD.956   
                                                                             IRRAD.957   
                                    ! CO2 absorption                         IRRAD.958   
                                                                             IRRAD.959   
            DO IUP=1,NLEV                                                    IRRAD.960   
               DO IDWN=0,IUP-1                                               IRRAD.961   
                                                                             IRRAD.962   
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.963   
                  UPATH=0.0                                                  IRRAD.964   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.965   
                     UPATH=UPATH+ULAY(6,ILAY)                                IRRAD.966   
                  END DO                                                     IRRAD.967   
                                                                             IRRAD.968   
C          Calculate the effective pressure of the path                      IRRAD.969   
                  PEFF=0.0                                                   IRRAD.970   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.971   
                     PEFF=PEFF+PMID(ILAY)*ULAY(6,ILAY)                       IRRAD.972   
                  END DO                                                     IRRAD.973   
                  PEFF=PEFF/UPATH                                            IRRAD.974   
                                                                             IRRAD.975   
C          Calculate the effective temperature of the path                   IRRAD.976   
                  TEFF=0.0                                                   IRRAD.977   
                  DO ILAY=IDWN+1,IUP                                         IRRAD.978   
                     TEFF=TEFF+TMID(ILAY)*ULAY(6,ILAY)                       IRRAD.979   
                  END DO                                                     IRRAD.980   
                  TEFF=TEFF/UPATH                                            IRRAD.981   
                                                                             IRRAD.982   
                  CALL GASSEARCH(6,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,           IRRAD.983   
     $                     CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,          IRRAD.984   
     $                     CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,          IRRAD.985   
     $                     CC06,DC06,AC07,BC07,CC07,DC07,TRANS)              IRRAD.986   
                  TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                       IRRAD.987   
                                                                             IRRAD.988   
               END DO                                                        IRRAD.989   
            END DO                                                           IRRAD.990   
                                                                             IRRAD.991   
            DO IUP=1,NLEV                                                    IRRAD.992   
               DO IDWN=0,IUP-1                                               IRRAD.993   
                  FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)              IRRAD.994   
                  FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)           IRRAD.995   
               END DO                                                        IRRAD.996   
            END DO                                                           IRRAD.997   
                                                                             IRRAD.998   
            IF (GAS(1).EQ.1) THEN                                            IRRAD.999   
               DO ILAY=0,NLEV                                                IRRAD.1000  
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.1001  
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.1002  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1003  
               END DO                                                        IRRAD.1004  
            ELSE                                                             IRRAD.1005  
               DO ILAY=0,NLEV                                                IRRAD.1006  
                  FUP(ILAY)=FUP(ILAY)-PLANCK(IBND,TSURF)+FGUP(ILAY)          IRRAD.1007  
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.1008  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1009  
               END DO                                                        IRRAD.1010  
            END IF                                                           IRRAD.1011  
                                                                             IRRAD.1012  
            GOTO 1975                                                        IRRAD.1013  
                                                                             IRRAD.1014  
         END IF                                                              IRRAD.1015  
                                                                             IRRAD.1016  
C-----------------------                                                     IRRAD.1017  
C  BAND 6: 650-770 cm-1                                                      IRRAD.1018  
C-----------------------                                                     IRRAD.1019  
                                                                             IRRAD.1020  
         IF (IBND.EQ.6) THEN                                                 IRRAD.1021  
                                                                             IRRAD.1022  
C Boundary Conditions                                                        IRRAD.1023  
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.1024  
            FGDWN(NLEV)=0.0                                                  IRRAD.1025  
                                                                             IRRAD.1026  
C Initialise the irradiances                                                 IRRAD.1027  
            DO ILAY=1,NLEV                                                   IRRAD.1028  
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.1029  
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.1030  
            END DO                                                           IRRAD.1031  
                                                                             IRRAD.1032  
            IF (GAS(2).NE.1) THEN                                            IRRAD.1033  
                                    ! O3 absorption only                     IRRAD.1034  
               DO IUP=1,NLEV                                                 IRRAD.1035  
                  DO IDWN=0,IUP-1                                            IRRAD.1036  
                                                                             IRRAD.1037  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1038  
                     UPATH=0.0                                               IRRAD.1039  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1040  
                        UPATH=UPATH+ULAY(7,ILAY)                             IRRAD.1041  
                     END DO                                                  IRRAD.1042  
                                                                             IRRAD.1043  
C          Calculate the effective pressure of the path                      IRRAD.1044  
                     PEFF=0.0                                                IRRAD.1045  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1046  
                        PEFF=PEFF+PMID(ILAY)*ULAY(7,ILAY)                    IRRAD.1047  
                     END DO                                                  IRRAD.1048  
                     PEFF=PEFF/UPATH                                         IRRAD.1049  
                                                                             IRRAD.1050  
C          Calculate the effective temperature of the path                   IRRAD.1051  
                     TEFF=0.0                                                IRRAD.1052  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1053  
                        TEFF=TEFF+TMID(ILAY)*ULAY(7,ILAY)                    IRRAD.1054  
                     END DO                                                  IRRAD.1055  
                     TEFF=TEFF/UPATH                                         IRRAD.1056  
                                                                             IRRAD.1057  
                     CALL GASSEARCH(7,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.1058  
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.1059  
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.1060  
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.1061  
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.1062  
                                                                             IRRAD.1063  
                  END DO                                                     IRRAD.1064  
               END DO                                                        IRRAD.1065  
                                                                             IRRAD.1066  
               DO IUP=1,NLEV                                                 IRRAD.1067  
                  DO IDWN=0,IUP-1                                            IRRAD.1068  
                     FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)           IRRAD.1069  
                     FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)        IRRAD.1070  
                  END DO                                                     IRRAD.1071  
               END DO                                                        IRRAD.1072  
                                                                             IRRAD.1073  
               IF (GAS(1).EQ.1) THEN                                         IRRAD.1074  
                  DO ILAY=0,NLEV                                             IRRAD.1075  
                     FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                          IRRAD.1076  
                     FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                       IRRAD.1077  
                     FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                         IRRAD.1078  
                  END DO                                                     IRRAD.1079  
               ELSE                                                          IRRAD.1080  
                  DO ILAY=0,NLEV                                             IRRAD.1081  
                     FUP(ILAY)=FUP(ILAY)-PLANCK(IBND,TSURF)+FGUP(ILAY)       IRRAD.1082  
                     FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                       IRRAD.1083  
                     FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                         IRRAD.1084  
                  END DO                                                     IRRAD.1085  
               END IF                                                        IRRAD.1086  
                                                                             IRRAD.1087  
            ELSE                                                             IRRAD.1088  
                                    ! CO2 + O3 absorption                    IRRAD.1089  
                                    ! (a) CO2                                IRRAD.1090  
                                                                             IRRAD.1091  
               DO IUP=1,NLEV                                                 IRRAD.1092  
                  DO IDWN=0,IUP-1                                            IRRAD.1093  
                                                                             IRRAD.1094  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1095  
                     UPATH=0.0                                               IRRAD.1096  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1097  
                        UPATH=UPATH+ULAY(2,ILAY)                             IRRAD.1098  
                     END DO                                                  IRRAD.1099  
                                                                             IRRAD.1100  
C          Calculate the effective pressure of the path                      IRRAD.1101  
                     PEFF=0.0                                                IRRAD.1102  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1103  
                        PEFF=PEFF+PMID(ILAY)*ULAY(2,ILAY)                    IRRAD.1104  
                     END DO                                                  IRRAD.1105  
                     PEFF=PEFF/UPATH                                         IRRAD.1106  
                                                                             IRRAD.1107  
C          Calculate the effective temperature of the path                   IRRAD.1108  
                     TEFF=0.0                                                IRRAD.1109  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1110  
                        TEFF=TEFF+TMID(ILAY)*ULAY(2,ILAY)                    IRRAD.1111  
                     END DO                                                  IRRAD.1112  
                     TEFF=TEFF/UPATH                                         IRRAD.1113  
                                                                             IRRAD.1114  
                     CALL GASSEARCH(2,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.1115  
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.1116  
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.1117  
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.1118  
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.1119  
                                                                             IRRAD.1120  
                  END DO                                                     IRRAD.1121  
               END DO                                                        IRRAD.1122  
                                                                             IRRAD.1123  
               DO IUP=1,NLEV                                                 IRRAD.1124  
                  DO IDWN=0,IUP-1                                            IRRAD.1125  
                     FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)           IRRAD.1126  
                     FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)        IRRAD.1127  
                  END DO                                                     IRRAD.1128  
               END DO                                                        IRRAD.1129  
                                                                             IRRAD.1130  
               DO ILAY=0,NLEV                                                IRRAD.1131  
                  FUP(ILAY)=FUP(ILAY)-FGUP(ILAY)                             IRRAD.1132  
                  FDWN(ILAY)=FDWN(ILAY)-FGDWN(ILAY)                          IRRAD.1133  
               END DO                                                        IRRAD.1134  
                                                                             IRRAD.1135  
                                    ! (b) O3                                 IRRAD.1136  
                                                                             IRRAD.1137  
C Boundary Conditions                                                        IRRAD.1138  
               FGUP(0)=PLANCK(IBND,TSURF)                                    IRRAD.1139  
               FGDWN(NLEV)=0.0                                               IRRAD.1140  
                                                                             IRRAD.1141  
C Initialise the irradiances                                                 IRRAD.1142  
               DO ILAY=1,NLEV                                                IRRAD.1143  
                  FGUP(ILAY)=PF(ILAY)                                        IRRAD.1144  
                  FGDWN(ILAY-1)=PF(ILAY)                                     IRRAD.1145  
               END DO                                                        IRRAD.1146  
                                                                             IRRAD.1147  
               DO IUP=1,NLEV                                                 IRRAD.1148  
                  DO IDWN=0,IUP-1                                            IRRAD.1149  
                                                                             IRRAD.1150  
                     TRIN(IDWN,IUP)=TROUT(IDWN,IUP)                          IRRAD.1151  
                                                                             IRRAD.1152  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1153  
                     UPATH=0.0                                               IRRAD.1154  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1155  
                        UPATH=UPATH+ULAY(7,ILAY)                             IRRAD.1156  
                     END DO                                                  IRRAD.1157  
                                                                             IRRAD.1158  
C          Calculate the effective pressure of the path                      IRRAD.1159  
                     PEFF=0.0                                                IRRAD.1160  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1161  
                        PEFF=PEFF+PMID(ILAY)*ULAY(7,ILAY)                    IRRAD.1162  
                     END DO                                                  IRRAD.1163  
                     PEFF=PEFF/UPATH                                         IRRAD.1164  
                                                                             IRRAD.1165  
C          Calculate the effective temperature of the path                   IRRAD.1166  
                     TEFF=0.0                                                IRRAD.1167  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1168  
                        TEFF=TEFF+TMID(ILAY)*ULAY(7,ILAY)                    IRRAD.1169  
                     END DO                                                  IRRAD.1170  
                     TEFF=TEFF/UPATH                                         IRRAD.1171  
                                                                             IRRAD.1172  
                     CALL GASSEARCH(7,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.1173  
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.1174  
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.1175  
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.1176  
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.1177  
                                                                             IRRAD.1178  
                  END DO                                                     IRRAD.1179  
               END DO                                                        IRRAD.1180  
                                                                             IRRAD.1181  
               DO IUP=1,NLEV                                                 IRRAD.1182  
                  DO IDWN=0,IUP-1                                            IRRAD.1183  
                     FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)           IRRAD.1184  
                     FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)        IRRAD.1185  
                  END DO                                                     IRRAD.1186  
               END DO                                                        IRRAD.1187  
                                                                             IRRAD.1188  
               DO ILAY=0,NLEV                                                IRRAD.1189  
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.1190  
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.1191  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1192  
               END DO                                                        IRRAD.1193  
                                                                             IRRAD.1194  
            END IF                                                           IRRAD.1195  
                                                                             IRRAD.1196  
            GOTO 1975                                                        IRRAD.1197  
                                                                             IRRAD.1198  
         END IF                                                              IRRAD.1199  
                                                                             IRRAD.1200  
C-----------------------                                                     IRRAD.1201  
C  BAND 7: 550-630 cm-1                                                      IRRAD.1202  
C-----------------------                                                     IRRAD.1203  
                                                                             IRRAD.1204  
         IF (IBND.EQ.7) THEN                                                 IRRAD.1205  
                                                                             IRRAD.1206  
C Boundary Conditions                                                        IRRAD.1207  
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.1208  
            FGDWN(NLEV)=0.0                                                  IRRAD.1209  
                                                                             IRRAD.1210  
C Initialise the irradiances                                                 IRRAD.1211  
            DO ILAY=1,NLEV                                                   IRRAD.1212  
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.1213  
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.1214  
            END DO                                                           IRRAD.1215  
                                                                             IRRAD.1216  
            IF (GAS(2).NE.1) THEN                                            IRRAD.1217  
                                    ! N2O absorption only                    IRRAD.1218  
               DO IUP=1,NLEV                                                 IRRAD.1219  
                  DO IDWN=0,IUP-1                                            IRRAD.1220  
                                                                             IRRAD.1221  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1222  
                     UPATH=0.0                                               IRRAD.1223  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1224  
                        UPATH=UPATH+ULAY(5,ILAY)                             IRRAD.1225  
                     END DO                                                  IRRAD.1226  
                                                                             IRRAD.1227  
C          Calculate the effective pressure of the path                      IRRAD.1228  
                     PEFF=0.0                                                IRRAD.1229  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1230  
                        PEFF=PEFF+PMID(ILAY)*ULAY(5,ILAY)                    IRRAD.1231  
                     END DO                                                  IRRAD.1232  
                     PEFF=PEFF/UPATH                                         IRRAD.1233  
                                                                             IRRAD.1234  
C          Calculate the effective temperature of the path                   IRRAD.1235  
                     TEFF=0.0                                                IRRAD.1236  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1237  
                        TEFF=TEFF+TMID(ILAY)*ULAY(5,ILAY)                    IRRAD.1238  
                     END DO                                                  IRRAD.1239  
                     TEFF=TEFF/UPATH                                         IRRAD.1240  
                                                                             IRRAD.1241  
                     CALL GASSEARCH(5,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.1242  
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.1243  
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.1244  
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.1245  
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.1246  
                                                                             IRRAD.1247  
                  END DO                                                     IRRAD.1248  
               END DO                                                        IRRAD.1249  
                                                                             IRRAD.1250  
               DO IUP=1,NLEV                                                 IRRAD.1251  
                  DO IDWN=0,IUP-1                                            IRRAD.1252  
                     FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)           IRRAD.1253  
                     FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)        IRRAD.1254  
                  END DO                                                     IRRAD.1255  
               END DO                                                        IRRAD.1256  
                                                                             IRRAD.1257  
               IF (GAS(1).EQ.1) THEN                                         IRRAD.1258  
                  DO ILAY=0,NLEV                                             IRRAD.1259  
                     FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                          IRRAD.1260  
                     FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                       IRRAD.1261  
                     FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                         IRRAD.1262  
                  END DO                                                     IRRAD.1263  
               ELSE                                                          IRRAD.1264  
                  DO ILAY=0,NLEV                                             IRRAD.1265  
                     FUP(ILAY)=FUP(ILAY)-PLANCK(IBND,TSURF)+FGUP(ILAY)       IRRAD.1266  
                     FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                       IRRAD.1267  
                     FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                         IRRAD.1268  
                  END DO                                                     IRRAD.1269  
               END IF                                                        IRRAD.1270  
                                                                             IRRAD.1271  
            ELSE                                                             IRRAD.1272  
                                    ! CO2 + N2O absorption                   IRRAD.1273  
                                    ! (a) CO2                                IRRAD.1274  
                                                                             IRRAD.1275  
               DO IUP=1,NLEV                                                 IRRAD.1276  
                  DO IDWN=0,IUP-1                                            IRRAD.1277  
                                                                             IRRAD.1278  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1279  
                     UPATH=0.0                                               IRRAD.1280  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1281  
                        UPATH=UPATH+ULAY(2,ILAY)                             IRRAD.1282  
                     END DO                                                  IRRAD.1283  
                                                                             IRRAD.1284  
C          Calculate the effective pressure of the path                      IRRAD.1285  
                     PEFF=0.0                                                IRRAD.1286  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1287  
                        PEFF=PEFF+PMID(ILAY)*ULAY(2,ILAY)                    IRRAD.1288  
                     END DO                                                  IRRAD.1289  
                     PEFF=PEFF/UPATH                                         IRRAD.1290  
                                                                             IRRAD.1291  
C          Calculate the effective temperature of the path                   IRRAD.1292  
                     TEFF=0.0                                                IRRAD.1293  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1294  
                        TEFF=TEFF+TMID(ILAY)*ULAY(2,ILAY)                    IRRAD.1295  
                     END DO                                                  IRRAD.1296  
                     TEFF=TEFF/UPATH                                         IRRAD.1297  
                                                                             IRRAD.1298  
                     CALL GASSEARCH(2,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.1299  
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.1300  
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.1301  
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.1302  
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.1303  
                                                                             IRRAD.1304  
                  END DO                                                     IRRAD.1305  
               END DO                                                        IRRAD.1306  
                                                                             IRRAD.1307  
               DO IUP=1,NLEV                                                 IRRAD.1308  
                  DO IDWN=0,IUP-1                                            IRRAD.1309  
                     FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)           IRRAD.1310  
                     FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)        IRRAD.1311  
                  END DO                                                     IRRAD.1312  
               END DO                                                        IRRAD.1313  
                                                                             IRRAD.1314  
               DO ILAY=0,NLEV                                                IRRAD.1315  
                  FUP(ILAY)=FUP(ILAY)-FGUP(ILAY)                             IRRAD.1316  
                  FDWN(ILAY)=FDWN(ILAY)-FGDWN(ILAY)                          IRRAD.1317  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1318  
               END DO                                                        IRRAD.1319  
                                                                             IRRAD.1320  
                                    ! (b) N2O                                IRRAD.1321  
                                                                             IRRAD.1322  
C Boundary Conditions                                                        IRRAD.1323  
               FGUP(0)=PLANCK(IBND,TSURF)                                    IRRAD.1324  
               FGDWN(NLEV)=0.0                                               IRRAD.1325  
                                                                             IRRAD.1326  
C Initialise the irradiances                                                 IRRAD.1327  
               DO ILAY=1,NLEV                                                IRRAD.1328  
                  FGUP(ILAY)=PF(ILAY)                                        IRRAD.1329  
                  FGDWN(ILAY-1)=PF(ILAY)                                     IRRAD.1330  
               END DO                                                        IRRAD.1331  
                                                                             IRRAD.1332  
               DO IUP=1,NLEV                                                 IRRAD.1333  
                  DO IDWN=0,IUP-1                                            IRRAD.1334  
                                                                             IRRAD.1335  
                     TRIN(IDWN,IUP)=TROUT(IDWN,IUP)                          IRRAD.1336  
                                                                             IRRAD.1337  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1338  
                     UPATH=0.0                                               IRRAD.1339  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1340  
                        UPATH=UPATH+ULAY(5,ILAY)                             IRRAD.1341  
                     END DO                                                  IRRAD.1342  
                                                                             IRRAD.1343  
C          Calculate the effective pressure of the path                      IRRAD.1344  
                     PEFF=0.0                                                IRRAD.1345  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1346  
                        PEFF=PEFF+PMID(ILAY)*ULAY(5,ILAY)                    IRRAD.1347  
                     END DO                                                  IRRAD.1348  
                     PEFF=PEFF/UPATH                                         IRRAD.1349  
                                                                             IRRAD.1350  
C          Calculate the effective temperature of the path                   IRRAD.1351  
                     TEFF=0.0                                                IRRAD.1352  
                     DO ILAY=IDWN+1,IUP                                      IRRAD.1353  
                        TEFF=TEFF+TMID(ILAY)*ULAY(5,ILAY)                    IRRAD.1354  
                     END DO                                                  IRRAD.1355  
                     TEFF=TEFF/UPATH                                         IRRAD.1356  
                                                                             IRRAD.1357  
                     CALL GASSEARCH(5,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,        IRRAD.1358  
     $                        CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,       IRRAD.1359  
     $                        CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,       IRRAD.1360  
     $                        CC06,DC06,AC07,BC07,CC07,DC07,TRANS)           IRRAD.1361  
                     TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                    IRRAD.1362  
                                                                             IRRAD.1363  
                  END DO                                                     IRRAD.1364  
               END DO                                                        IRRAD.1365  
                                                                             IRRAD.1366  
               DO IUP=1,NLEV                                                 IRRAD.1367  
                  DO IDWN=0,IUP-1                                            IRRAD.1368  
                     FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)           IRRAD.1369  
                     FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)        IRRAD.1370  
                  END DO                                                     IRRAD.1371  
               END DO                                                        IRRAD.1372  
                                                                             IRRAD.1373  
               DO ILAY=0,NLEV                                                IRRAD.1374  
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.1375  
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.1376  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1377  
               END DO                                                        IRRAD.1378  
                                                                             IRRAD.1379  
            END IF                                                           IRRAD.1380  
                                                                             IRRAD.1381  
            GOTO 1975                                                        IRRAD.1382  
                                                                             IRRAD.1383  
         END IF                                                              IRRAD.1384  
C-------------------------                                                   IRRAD.1385  
C  BAND 8: 1100-1200 cm-1                                                    IRRAD.1386  
C-------------------------                                                   IRRAD.1387  
                                                                             IRRAD.1388  
         IF (IBND.EQ.8) THEN                                                 IRRAD.1389  
                                                                             IRRAD.1390  
C Boundary Conditions                                                        IRRAD.1391  
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.1392  
            FGDWN(NLEV)=0.0                                                  IRRAD.1393  
                                                                             IRRAD.1394  
C Initialise the irradiances                                                 IRRAD.1395  
            DO ILAY=1,NLEV                                                   IRRAD.1396  
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.1397  
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.1398  
            END DO                                                           IRRAD.1399  
                                                                             IRRAD.1400  
                                    ! N2O absorption                         IRRAD.1401  
                                                                             IRRAD.1402  
            DO IUP=1,NLEV                                                    IRRAD.1403  
               DO IDWN=0,IUP-1                                               IRRAD.1404  
                                                                             IRRAD.1405  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1406  
                  UPATH=0.0                                                  IRRAD.1407  
                  DO ILAY=IDWN+1,IUP                                         IRRAD.1408  
                     UPATH=UPATH+ULAY(5,ILAY)                                IRRAD.1409  
                  END DO                                                     IRRAD.1410  
                                                                             IRRAD.1411  
C          Calculate the effective pressure of the path                      IRRAD.1412  
                  PEFF=0.0                                                   IRRAD.1413  
                  DO ILAY=IDWN+1,IUP                                         IRRAD.1414  
                     PEFF=PEFF+PMID(ILAY)*ULAY(5,ILAY)                       IRRAD.1415  
                  END DO                                                     IRRAD.1416  
                  PEFF=PEFF/UPATH                                            IRRAD.1417  
                                                                             IRRAD.1418  
C          Calculate the effective temperature of the path                   IRRAD.1419  
                  TEFF=0.0                                                   IRRAD.1420  
                  DO ILAY=IDWN+1,IUP                                         IRRAD.1421  
                     TEFF=TEFF+TMID(ILAY)*ULAY(5,ILAY)                       IRRAD.1422  
                  END DO                                                     IRRAD.1423  
                  TEFF=TEFF/UPATH                                            IRRAD.1424  
                                                                             IRRAD.1425  
                  CALL GASSEARCH(5,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,           IRRAD.1426  
     $                     CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,          IRRAD.1427  
     $                     CN03,DN03,AC02,BC02,CC02,DC02,AC06,BC06,          IRRAD.1428  
     $                     CC06,DC06,AC07,BC07,CC07,DC07,TRANS)              IRRAD.1429  
                  TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                       IRRAD.1430  
                                                                             IRRAD.1431  
               END DO                                                        IRRAD.1432  
            END DO                                                           IRRAD.1433  
                                                                             IRRAD.1434  
            DO IUP=1,NLEV                                                    IRRAD.1435  
               DO IDWN=0,IUP-1                                               IRRAD.1436  
                  FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)              IRRAD.1437  
                  FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)           IRRAD.1438  
               END DO                                                        IRRAD.1439  
            END DO                                                           IRRAD.1440  
                                                                             IRRAD.1441  
            IF (GAS(1).EQ.1) THEN                                            IRRAD.1442  
               DO ILAY=0,NLEV                                                IRRAD.1443  
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.1444  
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.1445  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1446  
               END DO                                                        IRRAD.1447  
            ELSE                                                             IRRAD.1448  
               DO ILAY=0,NLEV                                                IRRAD.1449  
                  FUP(ILAY)=FUP(ILAY)-PLANCK(IBND,TSURF)+FGUP(ILAY)          IRRAD.1450  
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.1451  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1452  
               END DO                                                        IRRAD.1453  
            END IF                                                           IRRAD.1454  
                                                                             IRRAD.1455  
            GOTO 1975                                                        IRRAD.1456  
                                                                             IRRAD.1457  
         END IF                                                              IRRAD.1458  
                                                                             IRRAD.1459  
C-----------------------                                                     IRRAD.1460  
C  BAND 9: 820-900 cm-1                                                      IRRAD.1461  
C-----------------------                                                     IRRAD.1462  
                                                                             IRRAD.1463  
         IF (IBND.EQ.9) THEN                                                 IRRAD.1464  
                                                                             IRRAD.1465  
C Boundary Conditions                                                        IRRAD.1466  
            FGUP(0)=PLANCK(IBND,TSURF)                                       IRRAD.1467  
            FGDWN(NLEV)=0.0                                                  IRRAD.1468  
                                                                             IRRAD.1469  
C Initialise the irradiances                                                 IRRAD.1470  
            DO ILAY=1,NLEV                                                   IRRAD.1471  
               FGUP(ILAY)=PF(ILAY)                                           IRRAD.1472  
               FGDWN(ILAY-1)=PF(ILAY)                                        IRRAD.1473  
            END DO                                                           IRRAD.1474  
                                                                             IRRAD.1475  
                                    ! Halocarbon absorption                  IRRAD.1476  
                                                                             IRRAD.1477  
            DO IUP=1,NLEV                                                    IRRAD.1478  
               DO IDWN=0,IUP-1                                               IRRAD.1479  
                                                                             IRRAD.1480  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1481  
                  UPATH=0.0                                                  IRRAD.1482  
                  DO ILAY=IDWN+1,IUP                                         IRRAD.1483  
                     UPATH=UPATH+ULAY(8,ILAY)                                IRRAD.1484  
                  END DO                                                     IRRAD.1485  
                                                                             IRRAD.1486  
                  TRANS=HALTRAN(IHAL,UPATH)                                  IRRAD.1487  
                  TROUT(IDWN,IUP)=TRANS*TRIN(IDWN,IUP)                       IRRAD.1488  
                                                                             IRRAD.1489  
               END DO                                                        IRRAD.1490  
            END DO                                                           IRRAD.1491  
                                                                             IRRAD.1492  
            DO IUP=1,NLEV                                                    IRRAD.1493  
               DO IDWN=0,IUP-1                                               IRRAD.1494  
                  FGUP(IUP)=FGUP(IUP)+TROUT(IDWN,IUP)*DPF(IDWN)              IRRAD.1495  
                  FGDWN(IDWN)=FGDWN(IDWN)-TROUT(IDWN,IUP)*DPF(IUP)           IRRAD.1496  
               END DO                                                        IRRAD.1497  
            END DO                                                           IRRAD.1498  
                                                                             IRRAD.1499  
            IF (GAS(1).EQ.1) THEN                                            IRRAD.1500  
               DO ILAY=0,NLEV                                                IRRAD.1501  
                  FUP(ILAY)=FUP(ILAY)+FGUP(ILAY)                             IRRAD.1502  
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.1503  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1504  
               END DO                                                        IRRAD.1505  
            ELSE                                                             IRRAD.1506  
               DO ILAY=0,NLEV                                                IRRAD.1507  
                  FUP(ILAY)=FUP(ILAY)-PLANCK(IBND,TSURF)+FGUP(ILAY)          IRRAD.1508  
                  FDWN(ILAY)=FDWN(ILAY)+FGDWN(ILAY)                          IRRAD.1509  
                  FNET(ILAY)=FUP(ILAY)-FDWN(ILAY)                            IRRAD.1510  
               END DO                                                        IRRAD.1511  
            END IF                                                           IRRAD.1512  
                                                                             IRRAD.1513  
         END IF                                                              IRRAD.1514  
                                                                             IRRAD.1515  
 1975    CONTINUE                                                            IRRAD.1516  
                                                                             IRRAD.1517  
      END DO                                                                 IRRAD.1518  
                                                                             IRRAD.1519  
                                                                             IRRAD.1520  
      END                                                                    IRRAD.1521  
C***********************************************************************     IRRAD.1522  
C*                                                                     *     IRRAD.1523  
C*                     FUNCTION PLANCK                                 *     IRRAD.1524  
C*                                                                     *     IRRAD.1525  
C***********************************************************************     IRRAD.1526  
                                                                             IRRAD.1527  
      REAL FUNCTION PLANCK (IBND,TEMP)                                       IRRAD.1528  
                                                                             IRRAD.1529  
C This function returns the Planck function, integrated over a wide          IRRAD.1530  
C band at specific temperature                                               IRRAD.1531  
C                                                                            IRRAD.1532  
C INPUT:  Band index (IBND)                                                  IRRAD.1533  
C         Temperature (TEMP)                                                 IRRAD.1534  
C OUTPUT: Planck Function, integrated over band IBND at                      IRRAD.1535  
C         temperature TEMP (PLANCK)                                          IRRAD.1536  
C The integrated Planck function is tabulated for each band in the           IRRAD.1537  
C array B in plfunc, over a range of temperatures from 151 to 350 K,         IRRAD.1538  
C with a step of 1 K. A simple linear interpolation in temperature is        IRRAD.1539  
C employed.                                                                  IRRAD.1540  
C--------------------------------------------------                          IRRAD.1541  
C WARNING: The function works only for temperatures                          IRRAD.1542  
C          between 151 and 350 K                                             IRRAD.1543  
C--------------------------------------------------                          IRRAD.1544  
                                                                             IRRAD.1545  
      IMPLICIT NONE                                                          IRRAD.1546  
C***********************************************************************     PARRAY.2     
C*                                                                     *     PARRAY.3     
C*                         P A R R A Y                                 *     PARRAY.4     
C*                                                                     *     PARRAY.5     
C***********************************************************************     PARRAY.6     
C-----------------------------------------------------------------------     PARRAY.7     
C In this part of the code the user can set the dimensions of arrays         PARRAY.8     
C used for the calculations, by setting the values in the paramter           PARRAY.9     
C statements                                                                 PARRAY.10    
C-----------------------------------------------------------------------     PARRAY.11    
                                                                             PARRAY.12    
      INTEGER MXGAS,MXLEV,MXBAND,MXCL                                        PARRAY.13    
                                                                             PARRAY.14    
      PARAMETER(MXGAS=8)     ! Maximum number of gases                       PARRAY.15    
                                                                             PARRAY.16    
      PARAMETER(MXLEV=5)     ! Maximum number of levels in the               NETCDF.37    
                             ! atmosphere (not including the surface)        PARRAY.18    
                                                                             PARRAY.19    
      PARAMETER(MXBAND=9)    ! Maximum number of spectral bands (not         PARRAY.20    
                             ! including the whole spectrum, 0-3000cm-1)     PARRAY.21    
                                                                             PARRAY.22    
      PARAMETER(MXCL=3)      ! Maximum number of cloud types                 PARRAY.23    
                                                                             PARRAY.24    
C-----------------------------------------------------------------------     PARRAY.25    
                                                                             IRRAD.1548  
C Input Variables                                                            IRRAD.1549  
C-----------------                                                           IRRAD.1550  
                                                                             IRRAD.1551  
      INTEGER IBND,ICOUNT                                                    IRRAD.1552  
      REAL TEMP,TEMP1,TEMP2                                                  IRRAD.1553  
                                                                             IRRAD.1554  
                                                                             IRRAD.1555  
C Internal Variables                                                         IRRAD.1556  
C--------------------                                                        IRRAD.1557  
                                                                             IRRAD.1558  
      INTEGER IPF            ! Table element index                           IRRAD.1559  
      REAL SLP,INTCPT      ! Variables used for interpolation                IRRAD.1560  
      REAL B(0:MXBAND,200) ! Planck function pre-computed values             IRRAD.1561  
                                                                             IRRAD.1562  
      INTEGER IFIRST                                                         IRRAD.1563  
      DATA IFIRST/1/                                                         IRRAD.1564  
                                                                             IRRAD.1565  
C     READ in planck function                                                IRRAD.1566  
      IF (IFIRST.EQ.1) THEN                                                  IRRAD.1567  
         IFIRST=0                                                            IRRAD.1568  
         read(37) B                                                          IRRAD.1569  
         print *,'read in Planck function'                                   IRRAD.1570  
       ENDIF                                                                 IRRAD.1571  
                                                                             IRRAD.1572  
C-------------------------                                                   IRRAD.1573  
C Band 0:    0-3000 cm-1                                                     IRRAD.1574  
C Band 1:   540-820 cm-1                                                     IRRAD.1575  
C Band 2:  980-1100 cm-1                                                     IRRAD.1576  
C Band 3: 1200-1400 cm-1                                                     IRRAD.1577  
C Band 4: 2100-2300 cm-1                                                     IRRAD.1578  
C Band 5:   900-980 cm-1                                                     IRRAD.1579  
C Band 6:   650-770 cm-1                                                     IRRAD.1580  
C Band 7:   550-630 cm-1                                                     IRRAD.1581  
C Band 8: 1100-1200 cm-1                                                     IRRAD.1582  
C Band 9:   820-900 cm-1                                                     IRRAD.1583  
C-------------------------                                                   IRRAD.1584  
                                                                             IRRAD.1585  
C Catch temperatures that are out of bounds                                  IRRAD.1586  
      IF(TEMP.LT.151.0.OR.TEMP.GT.350.0)THEN                                 IRRAD.1587  
         print *,'WARNING: TEMP out of bounds for Planck function'           IRRAD.1588  
         print *,'model will crash. TEMP= ',TEMP                             IRRAD.1589  
      ENDIF                                                                  IRRAD.1590  
                                                                             IRRAD.1591  
      IPF=INT(TEMP-150.)                                                     IRRAD.1592  
      TEMP1=AINT(TEMP)                                                       IRRAD.1593  
      TEMP2=TEMP+1.                                                          IRRAD.1594  
                                                                             IRRAD.1595  
      IF ((TEMP-TEMP1).LE.0.01) THEN  ! No need to interpolate               IRRAD.1596  
         PLANCK=B(IBND,IPF)                                                  IRRAD.1597  
      ELSE                                 ! Linear interpolation            IRRAD.1598  
         SLP=(B(IBND,IPF)-B(IBND,IPF+1))/(TEMP1-TEMP2)                       IRRAD.1599  
         INTCPT=TEMP1*B(IBND,IPF+1)-TEMP2*B(IBND,IPF)                        IRRAD.1600  
         INTCPT=INTCPT/(TEMP1-TEMP2)                                         IRRAD.1601  
         PLANCK=SLP*TEMP+INTCPT                                              IRRAD.1602  
      END IF                                                                 IRRAD.1603  
                                                                             IRRAD.1604  
      END                                                                    IRRAD.1605  
                                                                             IRRAD.1606  
C***********************************************************************     IRRAD.1607  
C*                                                                     *     IRRAD.1608  
C*                         SUBROUTINE H2OFLUX                          *     IRRAD.1609  
C*                                                                     *     IRRAD.1610  
C***********************************************************************     IRRAD.1611  
                                                                             IRRAD.1612  
      SUBROUTINE H2OFLUX(CKD,NLEV,ULAY,H2O,DP,PMID,TMID,QULAY,QH2O,QDP,      IRRAD.1613  
     $                   QP,QT,TLEV,CLOUD,TRCL,MTRCL,WVCNT,UH2O,PH2O,        IRRAD.1614  
     $                   TH2O,FUP,FDWN)                                      IRRAD.1615  
                                                                             IRRAD.1616  
C Subroutine H2OFLUX calculates the irradiances (upward, downward and        IRRAD.1617  
C net) for water vapour line absorption. Wideband transmittance is used      IRRAD.1618  
C for the upward, and modified wideband transmittance is used for the        IRRAD.1619  
C downward irradiances, which cover the whole thermal IR                     IRRAD.1620  
C spectrum (0-3000)                                                          IRRAD.1621  
C                                                                            IRRAD.1622  
C INPUT:  Water vapour continuum index (CKD)                                 IRRAD.1623  
C         Number of levels in the atmosphere without the surface (NLEV)      IRRAD.1624  
C         Abs. amount between 2 successive levels (ULAY)                     IRRAD.1625  
C         Water vapour mid-point mixing ratio (H2O)                          IRRAD.1626  
C         Thickness of the atmospheric layers (DP)                           IRRAD.1627  
C         Mid-point pressures (PMID)                                         IRRAD.1628  
C         Mid-point temperatures(TMID)                                       IRRAD.1629  
C         Abs. amount in sub-layers (QULAY)                                  IRRAD.1630  
C         Water vapour mixing ratio in sub-layers (QH2O)                     IRRAD.1631  
C         Thickness of the sub-layers (QDP)                                  IRRAD.1632  
C         Pressure in sub-layers (QP)                                        IRRAD.1633  
C         Temperature in sub-layers (QT)                                     IRRAD.1634  
C         Temperature at mid-levels (TLEV)                                   IRRAD.1635  
C         Cloud index (CLOUD)                                                IRRAD.1636  
C         Cloud transmittance (TRCL)                                         IRRAD.1637  
C         Cloud transmittance for the modified transm. case (MTRCL)          IRRAD.1638  
C                                                                            IRRAD.1639  
C OUTPUT: Effective water vapour amount (WVCNT)                              IRRAD.1640  
C         Water vapour - path parameters (UH2O,PH2O,TH2O)                    IRRAD.1641  
C         Upward and Downward irradiances at each mid-level(FUP,FDWN)        IRRAD.1642  
                                                                             IRRAD.1643  
      IMPLICIT NONE                                                          IRRAD.1644  
C***********************************************************************     PARRAY.2     
C*                                                                     *     PARRAY.3     
C*                         P A R R A Y                                 *     PARRAY.4     
C*                                                                     *     PARRAY.5     
C***********************************************************************     PARRAY.6     
C-----------------------------------------------------------------------     PARRAY.7     
C In this part of the code the user can set the dimensions of arrays         PARRAY.8     
C used for the calculations, by setting the values in the paramter           PARRAY.9     
C statements                                                                 PARRAY.10    
C-----------------------------------------------------------------------     PARRAY.11    
                                                                             PARRAY.12    
      INTEGER MXGAS,MXLEV,MXBAND,MXCL                                        PARRAY.13    
                                                                             PARRAY.14    
      PARAMETER(MXGAS=8)     ! Maximum number of gases                       PARRAY.15    
                                                                             PARRAY.16    
      PARAMETER(MXLEV=5)     ! Maximum number of levels in the               NETCDF.37    
                             ! atmosphere (not including the surface)        PARRAY.18    
                                                                             PARRAY.19    
      PARAMETER(MXBAND=9)    ! Maximum number of spectral bands (not         PARRAY.20    
                             ! including the whole spectrum, 0-3000cm-1)     PARRAY.21    
                                                                             PARRAY.22    
      PARAMETER(MXCL=3)      ! Maximum number of cloud types                 PARRAY.23    
                                                                             PARRAY.24    
C-----------------------------------------------------------------------     PARRAY.25    
                                                                             IRRAD.1646  
C-----------------                                                           IRRAD.1647  
C Input Variables                                                            IRRAD.1648  
C-----------------                                                           IRRAD.1649  
                                                                             IRRAD.1650  
      INTEGER CKD,NLEV,CLOUD                                                 IRRAD.1651  
      REAL ULAY(MXGAS,MXLEV)                                                 IRRAD.1652  
      REAL H2O(MXLEV)                                                        IRRAD.1653  
      REAL DP(MXLEV)                                                         IRRAD.1654  
      REAL PMID(MXLEV)                                                       IRRAD.1655  
      REAL TMID(MXLEV)                                                       IRRAD.1656  
      REAL QULAY(MXLEV)                                                      IRRAD.1657  
      REAL QH2O(MXLEV)                                                       IRRAD.1658  
      REAL QDP(MXLEV)                                                        IRRAD.1659  
      REAL QP(MXLEV)                                                         IRRAD.1660  
      REAL QT(MXLEV)                                                         IRRAD.1661  
      REAL TLEV(0:MXLEV)                                                     IRRAD.1662  
      REAL TRCL(0:MXLEV-1,MXLEV)                                             IRRAD.1663  
      REAL MTRCL(0:MXLEV-1,MXLEV)                                            IRRAD.1664  
                                                                             IRRAD.1665  
C------------------                                                          IRRAD.1666  
C Output Variables                                                           IRRAD.1667  
C------------------                                                          IRRAD.1668  
                                                                             IRRAD.1669  
      REAL WVCNT(0:MXLEV-1,MXLEV)                                            IRRAD.1670  
      REAL UH2O(0:MXLEV-1,MXLEV)                                             IRRAD.1671  
      REAL PH2O(0:MXLEV-1,MXLEV)                                             IRRAD.1672  
      REAL TH2O(0:MXLEV-1,MXLEV)                                             IRRAD.1673  
      REAL FUP(0:MXLEV),FDWN(0:MXLEV)                                        IRRAD.1674  
                                                                             IRRAD.1675  
C--------------------                                                        IRRAD.1676  
C Internal Variables                                                         IRRAD.1677  
C--------------------                                                        IRRAD.1678  
                                                                             IRRAD.1679  
      INTEGER ICOUNT,ILAY,IUP,IDWN                                           IRRAD.1680  
      INTEGER MOD   ! Index for transmittance type                           IRRAD.1681  
                    ! (1 : Modified, 2 : Standard)                           IRRAD.1682  
                                                                             IRRAD.1683  
      REAL PF(0:MXLEV),DPF(MXLEV) ! Matrices used for the calculation        IRRAD.1684  
                                    ! of the irradiances                     IRRAD.1685  
                                                                             IRRAD.1686  
      REAL UPATH       ! Absorber amount in an atmospheric path              IRRAD.1687  
      REAL WVEFF       ! Effective water vapour abs. amount                  IRRAD.1688  
      REAL PEFF,TEFF   ! Effective pressure & effective temprature           IRRAD.1689  
      REAL CWVC        ! Parameter 1/(296K)                                  IRRAD.1690  
      PARAMETER(CWVC=3.3783783D-03)                                          IRRAD.1691  
                                                                             IRRAD.1692  
      REAL PLANCK      ! Planck function integrated over a band              IRRAD.1693  
                                                                             IRRAD.1694  
      REAL TRANS       ! Transmittance of a layer                            IRRAD.1695  
                                                                             IRRAD.1696  
C Pre-computed tables for H2O-line absorption                                IRRAD.1697  
      REAL AWVL(2,34,28),BWVL(2,34,28)                                       IRRAD.1698  
      REAL CWVL(2,34,28),DWVL(2,34,28)                                       IRRAD.1699  
                                                                             IRRAD.1700  
C Pre-computed tables for H2O-continuum absorption                           IRRAD.1701  
      REAL AWV(2,41,29,22),BWV(2,41,29,22)                                   IRRAD.1702  
      REAL CWV(2,41,29,22),DWV(2,41,29,22)                                   IRRAD.1703  
                                                                             IRRAD.1704  
      INTEGER IFIRST                                                         IRRAD.1705  
      DATA IFIRST/1/                                                         IRRAD.1706  
                                                                             IRRAD.1707  
C     READ in tables                                                         IRRAD.1708  
      IF (IFIRST.EQ.1) THEN                                                  IRRAD.1709  
         IFIRST=0                                                            IRRAD.1710  
         read(33) AWVL,BWVL,CWVL,DWVL,AWV,BWV,CWV,DWV                        IRRAD.1711  
         print *,'read in water'                                             IRRAD.1712  
       ENDIF                                                                 IRRAD.1713  
                                                                             IRRAD.1714  
C-----------------------------------------------------------------------     IRRAD.1715  
C Calculate irradiances                                                      IRRAD.1716  
C-----------------------------------------------------------------------     IRRAD.1717  
                                                                             IRRAD.1718  
C Boundary Conditions                                                        IRRAD.1719  
                                                                             IRRAD.1720  
      FUP(0)=PLANCK(0,TLEV(0))                                               IRRAD.1721  
      FDWN(NLEV)=0.0                                                         IRRAD.1722  
                                                                             IRRAD.1723  
C-----------------------------------------                                   IRRAD.1724  
C Calculations for the upward irradiances                                    IRRAD.1725  
C-----------------------------------------                                   IRRAD.1726  
                                                                             IRRAD.1727  
      MOD=1                                                                  IRRAD.1728  
                                                                             IRRAD.1729  
C Calculate arrays PF and DPF used in the calculation of the up. fluxes      IRRAD.1730  
C PF:  Integrated Planck function at atmospheric levels                      IRRAD.1731  
C DPF: Differences of the PFs                                                IRRAD.1732  
                                                                             IRRAD.1733  
      PF(0)=PLANCK(0,TLEV(0))                                                IRRAD.1734  
                                                                             IRRAD.1735  
      DO ILAY=1,NLEV                                                         IRRAD.1736  
         PF(ILAY)=PLANCK(0,TLEV(ILAY))                                       IRRAD.1737  
      END DO                                                                 IRRAD.1738  
                                                                             IRRAD.1739  
      DO ILAY=1,NLEV                                                         IRRAD.1740  
         DPF(ILAY)=PLANCK(0,TLEV(ILAY))-PLANCK(0,TLEV(ILAY-1))               IRRAD.1741  
      END DO                                                                 IRRAD.1742  
                                                                             IRRAD.1743  
C Initialise the irradiances                                                 IRRAD.1744  
                                                                             IRRAD.1745  
      DO ILAY=1,NLEV                                                         IRRAD.1746  
         FUP(ILAY)=PF(ILAY)                                                  IRRAD.1747  
      END DO                                                                 IRRAD.1748  
                                                                             IRRAD.1749  
C For each layer, calculate the transmittance and update the irradiances     IRRAD.1750  
                                                                             IRRAD.1751  
                                                                             IRRAD.1752  
      DO IUP=1,NLEV                                                          IRRAD.1753  
                                                                             IRRAD.1754  
         DO IDWN=0,IUP-1                                                     IRRAD.1755  
                                                                             IRRAD.1756  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1757  
            UPATH=QULAY(IDWN+1)                                              IRRAD.1758  
            IF ((IUP-IDWN).GT.1) THEN                                        IRRAD.1759  
               DO ILAY=IDWN+2,IUP                                            IRRAD.1760  
                  UPATH=UPATH+ULAY(1,ILAY)                                   IRRAD.1761  
               END DO                                                        IRRAD.1762  
            END IF                                                           IRRAD.1763  
                                                                             IRRAD.1764  
C          Calculate the effective pressure of the path                      IRRAD.1765  
            PEFF=QP(IDWN+1)*QULAY(IDWN+1)                                    IRRAD.1766  
            IF ((IUP-IDWN).GT.1) THEN                                        IRRAD.1767  
               DO ILAY=IDWN+2,IUP                                            IRRAD.1768  
                  PEFF=PEFF+PMID(ILAY)*ULAY(1,ILAY)                          IRRAD.1769  
               END DO                                                        IRRAD.1770  
            END IF                                                           IRRAD.1771  
            PEFF=PEFF/UPATH                                                  IRRAD.1772  
                                                                             IRRAD.1773  
C          Calculate the effective temperature of the path                   IRRAD.1774  
            TEFF=QT(IDWN+1)*QULAY(IDWN+1)                                    IRRAD.1775  
            IF ((IUP-IDWN).GT.1) THEN                                        IRRAD.1776  
               DO ILAY=IDWN+2,IUP                                            IRRAD.1777  
                  TEFF=TEFF+TMID(ILAY)*ULAY(1,ILAY)                          IRRAD.1778  
               END DO                                                        IRRAD.1779  
            END IF                                                           IRRAD.1780  
            TEFF=TEFF/UPATH                                                  IRRAD.1781  
                                                                             IRRAD.1782  
                                                                             IRRAD.1783  
            IF (CKD.NE.1) THEN                                               IRRAD.1784  
                                                                             IRRAD.1785  
C--- Line absorption                                                         IRRAD.1786  
               CALL LINSEARCH(MOD,UPATH,PEFF,TEFF,AWVL,BWVL,                 IRRAD.1787  
     $                        CWVL,DWVL,TRANS)                               IRRAD.1788  
                                                                             IRRAD.1789  
            ELSE                                                             IRRAD.1790  
                                                                             IRRAD.1791  
C--- Include continuum, if required                                          IRRAD.1792  
                                                                             IRRAD.1793  
C          Calculate effective water vapour amount                           IRRAD.1794  
               IF (QH2O(IDWN+1).GT.(1.0D-04)) THEN                           IRRAD.1795  
                  WVEFF=(QH2O(IDWN+1)**2)*PMID(IDWN+1)*QDP(IDWN+1)*          IRRAD.1796  
     $            EXP(1800.0*((1.0/TMID(IDWN+1))-CWVC))                      IRRAD.1797  
               ELSE                                                          IRRAD.1798  
                  WVEFF=0.0                                                  IRRAD.1799  
               END IF                                                        IRRAD.1800  
               IF ((IUP-IDWN).GT.1) THEN                                     IRRAD.1801  
                  DO ILAY=IDWN+2,IUP                                         IRRAD.1802  
                     IF (H2O(ILAY).GT.(1.0D-04)) THEN                        IRRAD.1803  
                        WVEFF=WVEFF+(H2O(ILAY)**2)*PMID(ILAY)*DP(ILAY)*      IRRAD.1804  
     $                  EXP(1800.0*((1.0/TMID(ILAY))-CWVC))                  IRRAD.1805  
                     END IF                                                  IRRAD.1806  
                  END DO                                                     IRRAD.1807  
               END IF                                                        IRRAD.1808  
               WVEFF=(1.6178235D-06)*WVEFF                                   IRRAD.1809  
               WVCNT(IDWN,IUP)=WVEFF                                         IRRAD.1810  
                                                                             IRRAD.1811  
               IF ((WVEFF.NE.0.0).AND.(LOG10(WVEFF).GT.(-4.5))) THEN         IRRAD.1812  
                  CALL CONSEARCH(MOD,UPATH,PEFF,TEFF,WVEFF,AWV,BWV,          IRRAD.1813  
     $                           CWV,DWV,TRANS)                              IRRAD.1814  
               ELSE                                                          IRRAD.1815  
                  CALL LINSEARCH(MOD,UPATH,PEFF,TEFF,AWVL,BWVL,              IRRAD.1816  
     $                           CWVL,DWVL,TRANS)                            IRRAD.1817  
               END IF                                                        IRRAD.1818  
                                                                             IRRAD.1819  
            END IF                                                           IRRAD.1820  
                                                                             IRRAD.1821  
C          Include cloud transmittance for cloudy skies                      IRRAD.1822  
            IF (CLOUD.EQ.1) THEN                                             IRRAD.1823  
               TRANS=TRANS*MTRCL(IDWN,IUP)                                   IRRAD.1824  
            END IF                                                           IRRAD.1825  
                                                                             IRRAD.1826  
            FUP(IUP)=FUP(IUP)-TRANS*DPF(IDWN+1)                              IRRAD.1827  
                                                                             IRRAD.1828  
         END DO                                                              IRRAD.1829  
      END DO                                                                 IRRAD.1830  
                                                                             IRRAD.1831  
                                                                             IRRAD.1832  
C--------------------------------------                                      IRRAD.1833  
C Calculations for the downward fluxes                                       IRRAD.1834  
C--------------------------------------                                      IRRAD.1835  
                                                                             IRRAD.1836  
      MOD=2                                                                  IRRAD.1837  
                                                                             IRRAD.1838  
C Calculate arrays PF and DPF used in the calculation of the dn. fluxes      IRRAD.1839  
C PF:  Integrated Planck function at mid-points                              IRRAD.1840  
C DPF: Differences of the PFs                                                IRRAD.1841  
                                                                             IRRAD.1842  
      DO ILAY=1,NLEV                                                         IRRAD.1843  
         PF(ILAY)=PLANCK(0,TMID(ILAY))                                       IRRAD.1844  
      END DO                                                                 IRRAD.1845  
                                                                             IRRAD.1846  
      DPF(NLEV)=PLANCK(0,TMID(NLEV))                                         IRRAD.1847  
                                                                             IRRAD.1848  
      DO ILAY=1,NLEV-1                                                       IRRAD.1849  
         DPF(ILAY)=PLANCK(0,TMID(ILAY))-PLANCK(0,TMID(ILAY+1))               IRRAD.1850  
      END DO                                                                 IRRAD.1851  
                                                                             IRRAD.1852  
C Initialise the irradiances                                                 IRRAD.1853  
                                                                             IRRAD.1854  
      DO ILAY=1,NLEV                                                         IRRAD.1855  
         FDWN(ILAY-1)=PF(ILAY)                                               IRRAD.1856  
      END DO                                                                 IRRAD.1857  
                                                                             IRRAD.1858  
C For each layer, calculate the transmittance and update the irradiances     IRRAD.1859  
                                                                             IRRAD.1860  
      DO IUP=1,NLEV                                                          IRRAD.1861  
                                                                             IRRAD.1862  
         DO IDWN=0,IUP-1                                                     IRRAD.1863  
                                                                             IRRAD.1864  
C          Calculate absorber amount in the path between IDWN and IUP        IRRAD.1865  
            UPATH=0.0                                                        IRRAD.1866  
            DO ILAY=IDWN+1,IUP                                               IRRAD.1867  
               UPATH=UPATH+ULAY(1,ILAY)                                      IRRAD.1868  
            END DO                                                           IRRAD.1869  
            UH2O(IDWN,IUP)=UPATH                                             IRRAD.1870  
                                                                             IRRAD.1871  
C          Calculate the effective pressure of the path                      IRRAD.1872  
            PEFF=0.0                                                         IRRAD.1873  
            DO ILAY=IDWN+1,IUP                                               IRRAD.1874  
               PEFF=PEFF+PMID(ILAY)*ULAY(1,ILAY)                             IRRAD.1875  
            END DO                                                           IRRAD.1876  
            PEFF=PEFF/UPATH                                                  IRRAD.1877  
            PH2O(IDWN,IUP)=PEFF                                              IRRAD.1878  
                                                                             IRRAD.1879  
C          Calculate the effective temperature of the path                   IRRAD.1880  
            TEFF=0.0                                                         IRRAD.1881  
            DO ILAY=IDWN+1,IUP                                               IRRAD.1882  
               TEFF=TEFF+TMID(ILAY)*ULAY(1,ILAY)                             IRRAD.1883  
            END DO                                                           IRRAD.1884  
            TEFF=TEFF/UPATH                                                  IRRAD.1885  
            TH2O(IDWN,IUP)=TEFF                                              IRRAD.1886  
                                                                             IRRAD.1887  
            IF (CKD.NE.1) THEN                                               IRRAD.1888  
                                                                             IRRAD.1889  
               CALL LINSEARCH(MOD,UPATH,PEFF,TEFF,AWVL,BWVL,                 IRRAD.1890  
     $                        CWVL,DWVL,TRANS)                               IRRAD.1891  
                                                                             IRRAD.1892  
            ELSE                                                             IRRAD.1893  
                                                                             IRRAD.1894  
C--- Include continuum if required                                           IRRAD.1895  
                                                                             IRRAD.1896  
C          Calculate effective water vapour amount                           IRRAD.1897  
               WVEFF=0.0                                                     IRRAD.1898  
               DO ILAY=IDWN+1,IUP                                            IRRAD.1899  
                  WVEFF=WVEFF+(H2O(ILAY)**2)*PMID(ILAY)*DP(ILAY)*            IRRAD.1900  
     $                  EXP(1800.0*((1.0/TMID(ILAY))-CWVC))                  IRRAD.1901  
               END DO                                                        IRRAD.1902  
               WVEFF=(1.6178235D-06)*WVEFF                                   IRRAD.1903  
                                                                             IRRAD.1904  
               IF (WVEFF.NE.0.0) THEN                                        IRRAD.1905  
                  IF ((LOG10(WVEFF).LT.(-4.5)).AND.                          IRRAD.1906  
     $               (UPATH.LT.1.0D-02)) THEN                                IRRAD.1907  
                     CALL LINSEARCH(MOD,UPATH,PEFF,TEFF,AWVL,BWVL,           IRRAD.1908  
     $                              CWVL,DWVL,TRANS)                         IRRAD.1909  
                  ELSE                                                       IRRAD.1910  
                     CALL CONSEARCH(MOD,UPATH,PEFF,TEFF,WVEFF,AWV,BWV,       IRRAD.1911  
     $                              CWV,DWV,TRANS)                           IRRAD.1912  
                  END IF                                                     IRRAD.1913  
               ELSE                                                          IRRAD.1914  
                  CALL LINSEARCH(MOD,UPATH,PEFF,TEFF,AWVL,BWVL,              IRRAD.1915  
     $                           CWVL,DWVL,TRANS)                            IRRAD.1916  
               END IF                                                        IRRAD.1917  
                                                                             IRRAD.1918  
            END IF                                                           IRRAD.1919  
                                                                             IRRAD.1920  
C          Include cloud transmittance for cloudy skies                      IRRAD.1921  
            IF (CLOUD.EQ.1) THEN                                             IRRAD.1922  
               TRANS=TRANS*TRCL(IDWN,IUP)                                    IRRAD.1923  
            END IF                                                           IRRAD.1924  
                                                                             IRRAD.1925  
            FDWN(IDWN)=FDWN(IDWN)-TRANS*DPF(IUP)                             IRRAD.1926  
                                                                             IRRAD.1927  
         END DO                                                              IRRAD.1928  
      END DO                                                                 IRRAD.1929  
                                                                             IRRAD.1930  
      END                                                                    IRRAD.1931  
                                                                             IRRAD.1932  
                                                                             IRRAD.1933  
C***********************************************************************     IRRAD.1934  
C*                                                                     *     IRRAD.1935  
C*                         SUBROUTINE LINSEARCH                        *     IRRAD.1936  
C*                                                                     *     IRRAD.1937  
C***********************************************************************     IRRAD.1938  
                                                                             IRRAD.1939  
      SUBROUTINE LINSEARCH(MOD,UPATH,PEFF,TEFF,AWVL,BWVL,                    IRRAD.1940  
     $                     CWVL,DWVL,TRANS)                                  IRRAD.1941  
                                                                             IRRAD.1942  
C Subroutine LINSEARCH calculates the water vapour line transmittane of      IRRAD.1943  
C a homogeneous  atmospheric path, using the data of pre-computed            IRRAD.1944  
C tables stored in 'wvlin.f'                                                 IRRAD.1945  
C                                                                            IRRAD.1946  
C INPUT:  Index for transmittance type (MOD)                                 IRRAD.1947  
C         Absorber amount (UPATH)                                            IRRAD.1948  
C         Pressure (PEFF)                                                    IRRAD.1949  
C         Pre-computed tables (AWVL,BWVL,CWVL,DWVL)                          IRRAD.1950  
C         Temperature (TEFF)                                                 IRRAD.1951  
C                                                                            IRRAD.1952  
C OUTPUT: Transmittance (TRANS)                                              IRRAD.1953  
                                                                             IRRAD.1954  
      IMPLICIT NONE                                                          IRRAD.1955  
                                                                             IRRAD.1956  
C-----------------                                                           IRRAD.1957  
C Input Variables                                                            IRRAD.1958  
C-----------------                                                           IRRAD.1959  
                                                                             IRRAD.1960  
      INTEGER MOD                                                            IRRAD.1961  
      REAL UPATH,PEFF,TEFF                                                   IRRAD.1962  
      REAL AWVL(2,34,28),BWVL(2,34,28)                                       IRRAD.1963  
      REAL CWVL(2,34,28),DWVL(2,34,28)                                       IRRAD.1964  
                                                                             IRRAD.1965  
C-----------------                                                           IRRAD.1966  
C Output Variable                                                            IRRAD.1967  
C-----------------                                                           IRRAD.1968  
                                                                             IRRAD.1969  
      REAL TRANS                                                             IRRAD.1970  
                                                                             IRRAD.1971  
C--------------------                                                        IRRAD.1972  
C Internal Variables                                                         IRRAD.1973  
C--------------------                                                        IRRAD.1974  
                                                                             IRRAD.1975  
      INTEGER IABS,IPRES,NABS,NPRES                                          IRRAD.1976  
      PARAMETER(NABS=34,NPRES=28)                                            IRRAD.1977  
      REAL USTR(NABS),PSTR(NPRES)  ! Stored values of absorber               IRRAD.1978  
                                     ! amount and pressure                   IRRAD.1979  
                                                                             IRRAD.1980  
      REAL TRU,DTU,TRP,DTP         ! Variables used for interpolation        IRRAD.1981  
                                                                             IRRAD.1982  
                                                                             IRRAD.1983  
C Stored values of absorber amount (kg m-2)                                  IRRAD.1984  
                                                                             IRRAD.1985  
      DATA(USTR(IABS),IABS=1,NABS)/  1.0D-09, 1.0D-08, 5.0D-08,              IRRAD.1986  
     $                               1.0D-07, 5.0D-07, 1.0D-06,              IRRAD.1987  
     $                               5.0D-06, 1.0D-05, 5.0D-05,              IRRAD.1988  
     $                               1.0D-04, 5.0D-04, 1.0D-03,              IRRAD.1989  
     $                               5.0D-03, 1.0D-02, 2.0D-02,              IRRAD.1990  
     $                               4.0D-02, 6.0D-02, 8.0D-02,              IRRAD.1991  
     $                               1.0D-01, 2.0D-01, 4.0D-01,              IRRAD.1992  
     $                               6.0D-01, 8.0D-01, 1.0, 2.0,             IRRAD.1993  
     $                               4.0, 6.0, 8.0, 10.0, 20.0,              IRRAD.1994  
     $                               40.0, 60.0, 80.0, 100.0/                IRRAD.1995  
                                                                             IRRAD.1996  
                                                                             IRRAD.1997  
C Stored values of pressure (Pa)                                             IRRAD.1998  
                                                                             IRRAD.1999  
      DATA(PSTR(IPRES),IPRES=1,NPRES)/ 1.0, 1.0D+01, 2.0D+01, 4.0D+01,       IRRAD.2000  
     $                                 6.0D+01, 8.0D+01, 1.0D+02,            IRRAD.2001  
     $                                 2.0D+02, 4.0D+02, 6.0D+02,            IRRAD.2002  
     $                                 8.0D+02, 1.0D+03, 2.0D+03,            IRRAD.2003  
     $                                 4.0D+03, 6.0D+03, 8.0D+03,            IRRAD.2004  
     $                                 1.0D+04, 2.0D+04, 3.0D+04,            IRRAD.2005  
     $                                 4.0D+04, 5.0D+04, 6.0D+04,            IRRAD.2006  
     $                                 7.0D+04, 8.0D+04, 9.0D+04,            IRRAD.2007  
     $                                 1.0D+05, 1.1D+05, 1.2D+05/            IRRAD.2008  
                                                                             IRRAD.2009  
                                                                             IRRAD.2010  
C Find the table index for the absorber amount                               IRRAD.2011  
                                                                             IRRAD.2012  
      IABS=INT(NABS/2.)                                                      IRRAD.2013  
                                                                             IRRAD.2014  
      IF (UPATH.NE.USTR(IABS)) THEN                                          IRRAD.2015  
                                                                             IRRAD.2016  
         IF (UPATH.LT.USTR(IABS)) THEN                                       IRRAD.2017  
                                                                             IRRAD.2018  
            IABS=INT(IABS/2.)                                                IRRAD.2019  
                                                                             IRRAD.2020  
            IF (UPATH.LT.USTR(IABS)) THEN                                    IRRAD.2021  
               IABS=1                                                        IRRAD.2022  
               IF (UPATH.GT.USTR(1)) THEN                                    IRRAD.2023  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2024  
                     IABS=IABS+1                                             IRRAD.2025  
                  END DO                                                     IRRAD.2026  
               END IF                                                        IRRAD.2027  
            ELSE                                                             IRRAD.2028  
               IF (UPATH.NE.USTR(IABS)) THEN                                 IRRAD.2029  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2030  
                     IABS=IABS+1                                             IRRAD.2031  
                  END DO                                                     IRRAD.2032  
               END IF                                                        IRRAD.2033  
            END IF                                                           IRRAD.2034  
                                                                             IRRAD.2035  
         ELSE                                                                IRRAD.2036  
                                                                             IRRAD.2037  
            IABS=IABS+INT(NABS/4.)                                           IRRAD.2038  
                                                                             IRRAD.2039  
            IF (UPATH.GT.USTR(IABS)) THEN                                    IRRAD.2040  
               IF (UPATH.GE.USTR(NABS)) THEN                                 IRRAD.2041  
                  IABS=NABS                                                  IRRAD.2042  
               ELSE                                                          IRRAD.2043  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2044  
                     IABS=IABS+1                                             IRRAD.2045  
                  END DO                                                     IRRAD.2046  
               END IF                                                        IRRAD.2047  
            ELSE                                                             IRRAD.2048  
               IF (UPATH.NE.USTR(IABS)) THEN                                 IRRAD.2049  
                  IABS=INT(NABS/2.)                                          IRRAD.2050  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2051  
                     IABS=IABS+1                                             IRRAD.2052  
                  END DO                                                     IRRAD.2053  
               END IF                                                        IRRAD.2054  
            END IF                                                           IRRAD.2055  
                                                                             IRRAD.2056  
         END IF                                                              IRRAD.2057  
                                                                             IRRAD.2058  
      END IF                                                                 IRRAD.2059  
                                                                             IRRAD.2060  
C Find the table index for the pressure                                      IRRAD.2061  
                                                                             IRRAD.2062  
      IPRES=INT(NPRES/2.)                                                    IRRAD.2063  
                                                                             IRRAD.2064  
      IF (PEFF.NE.PSTR(IPRES)) THEN                                          IRRAD.2065  
                                                                             IRRAD.2066  
         IF (PEFF.LT.PSTR(IPRES)) THEN                                       IRRAD.2067  
                                                                             IRRAD.2068  
            IPRES=INT(IPRES/2.)                                              IRRAD.2069  
                                                                             IRRAD.2070  
            IF (PEFF.LE.PSTR(IPRES)) THEN                                    IRRAD.2071  
               IPRES=2                                                       IRRAD.2072  
               IF (PEFF.GT.PSTR(1)) THEN                                     IRRAD.2073  
                  DO WHILE(PEFF.GT.PSTR(IPRES))                              IRRAD.2074  
                     IPRES=IPRES+1                                           IRRAD.2075  
                  END DO                                                     IRRAD.2076  
               END IF                                                        IRRAD.2077  
            ELSE                                                             IRRAD.2078  
               IF (PEFF.NE.PSTR(IPRES)) THEN                                 IRRAD.2079  
                  DO WHILE(PEFF.GT.PSTR(IPRES))                              IRRAD.2080  
                     IPRES=IPRES+1                                           IRRAD.2081  
                  END DO                                                     IRRAD.2082  
               END IF                                                        IRRAD.2083  
            END IF                                                           IRRAD.2084  
                                                                             IRRAD.2085  
         ELSE                                                                IRRAD.2086  
                                                                             IRRAD.2087  
            IPRES=IPRES+INT(NPRES/4.)                                        IRRAD.2088  
                                                                             IRRAD.2089  
            IF (PEFF.GT.PSTR(IPRES)) THEN                                    IRRAD.2090  
               IF (PEFF.GE.PSTR(NPRES)) THEN                                 IRRAD.2091  
                  IPRES=NPRES                                                IRRAD.2092  
               ELSE                                                          IRRAD.2093  
                  DO WHILE(PEFF.GT.PSTR(IPRES))                              IRRAD.2094  
                     IPRES=IPRES+1                                           IRRAD.2095  
                  END DO                                                     IRRAD.2096  
               END IF                                                        IRRAD.2097  
            ELSE                                                             IRRAD.2098  
               IF (PEFF.NE.PSTR(IPRES)) THEN                                 IRRAD.2099  
                  IPRES=INT(NPRES/2.)                                        IRRAD.2100  
                  DO WHILE(PEFF.GT.PSTR(IPRES))                              IRRAD.2101  
                     IPRES=IPRES+1                                           IRRAD.2102  
                  END DO                                                     IRRAD.2103  
               END IF                                                        IRRAD.2104  
            END IF                                                           IRRAD.2105  
                                                                             IRRAD.2106  
         END IF                                                              IRRAD.2107  
                                                                             IRRAD.2108  
      END IF                                                                 IRRAD.2109  
                                                                             IRRAD.2110  
C Transmittance calculation                                                  IRRAD.2111  
                                                                             IRRAD.2112  
      TEFF=TEFF-250.0                                                        IRRAD.2113  
                                                                             IRRAD.2114  
      TRANS=DWVL(MOD,IABS,IPRES)+TEFF*(CWVL(MOD,IABS,IPRES)+                 IRRAD.2115  
     $      TEFF*(BWVL(MOD,IABS,IPRES)+                                      IRRAD.2116  
     $      TEFF*AWVL(MOD,IABS,IPRES)))                                      IRRAD.2117  
                                                                             IRRAD.2118  
C-------------------------------------------                                 IRRAD.2119  
C Simple interpolation/extrapolation scheme                                  IRRAD.2120  
C-------------------------------------------                                 IRRAD.2121  
                                                                             IRRAD.2122  
      IF (IABS.GT.1) THEN  ! Avoid extrapolation for small abs. amounts      IRRAD.2123  
                                                                             IRRAD.2124  
         IF (UPATH.NE.USTR(IABS)) THEN                                       IRRAD.2125  
                                                                             IRRAD.2126  
            TRU=DWVL(MOD,IABS-1,IPRES)+TEFF*(CWVL(MOD,IABS-1,IPRES)+         IRRAD.2127  
     $          TEFF*(BWVL(MOD,IABS-1,IPRES)+                                IRRAD.2128  
     $          TEFF*AWVL(MOD,IABS-1,IPRES)))                                IRRAD.2129  
            DTU=(TRANS-TRU)*                                                 IRRAD.2130  
     $          (UPATH-USTR(IABS))/(USTR(IABS)-USTR(IABS-1))                 IRRAD.2131  
            TRU=TRANS+DTU       ! Correction for the abs. amount             IRRAD.2132  
            IF (TRU.LT.0.0) THEN                                             IRRAD.2133  
               TRU=0.0          ! Very high abs. amounts                     IRRAD.2134  
            END IF                                                           IRRAD.2135  
                                                                             IRRAD.2136  
         ELSE                   ! Avoid interpolation                        IRRAD.2137  
            TRU=TRANS                                                        IRRAD.2138  
         END IF                                                              IRRAD.2139  
                                                                             IRRAD.2140  
         IF (PEFF.NE.PSTR(IPRES)) THEN                                       IRRAD.2141  
                                                                             IRRAD.2142  
            TRP=DWVL(MOD,IABS,IPRES-1)+TEFF*(CWVL(MOD,IABS,IPRES-1)+         IRRAD.2143  
     $          TEFF*(BWVL(MOD,IABS,IPRES-1)+                                IRRAD.2144  
     $          TEFF*AWVL(MOD,IABS,IPRES-1)))                                IRRAD.2145  
            DTP=(TRANS-TRP)*                                                 IRRAD.2146  
     $          (PEFF-PSTR(IPRES))/(PSTR(IPRES)-PSTR(IPRES-1))               IRRAD.2147  
            TRP=TRU+DTP         ! Correction for the pressure                IRRAD.2148  
            IF (TRP.LT.0.0) THEN                                             IRRAD.2149  
               TRP=0.0          ! Very high pressures                        IRRAD.2150  
            END IF                                                           IRRAD.2151  
            TRANS=TRP                                                        IRRAD.2152  
                                                                             IRRAD.2153  
         ELSE                   ! Avoid interpolation                        IRRAD.2154  
            TRANS=TRU                                                        IRRAD.2155  
         END IF                                                              IRRAD.2156  
                                                                             IRRAD.2157  
      END IF                                                                 IRRAD.2158  
                                                                             IRRAD.2159  
                                                                             IRRAD.2160  
      END                                                                    IRRAD.2161  
                                                                             IRRAD.2162  
                                                                             IRRAD.2163  
C***********************************************************************     IRRAD.2164  
C*                                                                     *     IRRAD.2165  
C*                         SUBROUTINE CONSEARCH                        *     IRRAD.2166  
C*                                                                     *     IRRAD.2167  
C***********************************************************************     IRRAD.2168  
                                                                             IRRAD.2169  
      SUBROUTINE CONSEARCH(MOD,UPATH,PEFF,TEFF,WVEFF,AWV,BWV,                IRRAD.2170  
     $                     CWV,DWV,TRANS)                                    IRRAD.2171  
                                                                             IRRAD.2172  
C Subroutine CONSEARCH calculates the water vapour transmittane of a         IRRAD.2173  
C homogeneous atmospheric path for both line+continuum absorption over       IRRAD.2174  
C the whole thermal IR spectrum (0-3000 cm-1). The subroutine uses the       IRRAD.2175  
C data of pre-computed tables stored in 'wvcon.f'                            IRRAD.2176  
C                                                                            IRRAD.2177  
C INPUT:  Index for transmittance type (MOD)                                 IRRAD.2178  
C         Absorber amount (UPATH)                                            IRRAD.2179  
C         Pressure (PEFF)                                                    IRRAD.2180  
C         Temperature (TEFF)                                                 IRRAD.2181  
C         Effective water vapour abs. amount (WVEFF)                         IRRAD.2182  
C         Pre-computed tables (AWV,BWV,CWV,DWV)                              IRRAD.2183  
C                                                                            IRRAD.2184  
C OUTPUT: Transmittance (TRANS)                                              IRRAD.2185  
                                                                             IRRAD.2186  
      IMPLICIT NONE                                                          IRRAD.2187  
                                                                             IRRAD.2188  
C-----------------                                                           IRRAD.2189  
C Input Variables                                                            IRRAD.2190  
C-----------------                                                           IRRAD.2191  
                                                                             IRRAD.2192  
      INTEGER MOD                                                            IRRAD.2193  
      REAL UPATH,PEFF,TEFF,WVEFF                                             IRRAD.2194  
      REAL AWV(2,41,29,22),BWV(2,41,29,22)                                   IRRAD.2195  
      REAL CWV(2,41,29,22),DWV(2,41,29,22)                                   IRRAD.2196  
                                                                             IRRAD.2197  
C-----------------                                                           IRRAD.2198  
C Output Variable                                                            IRRAD.2199  
C-----------------                                                           IRRAD.2200  
                                                                             IRRAD.2201  
      REAL TRANS                                                             IRRAD.2202  
                                                                             IRRAD.2203  
C--------------------                                                        IRRAD.2204  
C Internal Variables                                                         IRRAD.2205  
C--------------------                                                        IRRAD.2206  
                                                                             IRRAD.2207  
      INTEGER IABS,IPRES,IWV,NABS,NPRES,NWV                                  IRRAD.2208  
      PARAMETER(NABS=29,NPRES=22,NWV=41)                                     IRRAD.2209  
      REAL USTR(NABS)          ! Stored values of abs. amount,               IRRAD.2210  
      REAL PSTR(NPRES)         ! pressure and                                IRRAD.2211  
      REAL WVSTR(NWV)          ! logarithm of eff. H2O amount                IRRAD.2212  
                                                                             IRRAD.2213  
      REAL TR(0:2),TRU,TRP     ! Variables used                              IRRAD.2214  
      REAL DTU,DTP,DTU1,DTU2   ! for interpolation                           IRRAD.2215  
      REAL SLP, INTCPT                                                       IRRAD.2216  
                                                                             IRRAD.2217  
C Stored values of absorber amount (kg m-2)                                  IRRAD.2218  
                                                                             IRRAD.2219  
      DATA(USTR(IABS),IABS=1,NABS)/                                          IRRAD.2220  
     $                               1.0D-06, 5.0D-06, 1.0D-05,              IRRAD.2221  
     $                               5.0D-05, 1.0D-04, 5.0D-04,              IRRAD.2222  
     $                               1.0D-03, 5.0D-03, 1.0D-02,              IRRAD.2223  
     $                               2.0D-02, 4.0D-02, 6.0D-02,              IRRAD.2224  
     $                               8.0D-02, 1.0D-01, 2.0D-01,              IRRAD.2225  
     $                               4.0D-01, 6.0D-01, 8.0D-01,              IRRAD.2226  
     $                               1.0, 2.0, 4.0, 6.0, 8.0,                IRRAD.2227  
     $                               10.0, 20.0, 40.0, 60.0,                 IRRAD.2228  
     $                               80.0, 100.0/                            IRRAD.2229  
                                                                             IRRAD.2230  
                                                                             IRRAD.2231  
C Stored values of pressure (Pa)                                             IRRAD.2232  
                                                                             IRRAD.2233  
      DATA(PSTR(IPRES),IPRES=1,NPRES)/ 1.0D+02, 2.0D+02, 4.0D+02,            IRRAD.2234  
     $                                 6.0D+02, 8.0D+02, 1.0D+03,            IRRAD.2235  
     $                                 2.0D+03, 4.0D+03, 6.0D+03,            IRRAD.2236  
     $                                 8.0D+03, 1.0D+04, 2.0D+04,            IRRAD.2237  
     $                                 3.0D+04, 4.0D+04, 5.0D+04,            IRRAD.2238  
     $                                 6.0D+04, 7.0D+04, 8.0D+04,            IRRAD.2239  
     $                                 9.0D+04, 1.0D+05, 1.1D+05,            IRRAD.2240  
     $                                 1.2D+05/                              IRRAD.2241  
                                                                             IRRAD.2242  
C Stored values of the logarithm of the H2O effective amount                 IRRAD.2243  
                                                                             IRRAD.2244  
      DATA(WVSTR(IWV),IWV=1,NWV)/ -4.6, -4.4, -4.2, -4.0, -3.8, -3.6,        IRRAD.2245  
     $                            -3.4, -3.2, -3.0, -2.9, -2.8, -2.7,        IRRAD.2246  
     $                            -2.6, -2.5, -2.4, -2.3, -2.2, -2.1,        IRRAD.2247  
     $                            -2.0, -1.9, -1.8, -1.7, -1.6, -1.5,        IRRAD.2248  
     $                            -1.4, -1.3, -1.2, -1.1, -1.0, -0.9,        IRRAD.2249  
     $                            -0.8, -0.7, -0.6, -0.5, -0.4, -0.3,        IRRAD.2250  
     $                            -0.2, -0.1,  0.0,  0.1,  0.2/              IRRAD.2251  
                                                                             IRRAD.2252  
      WVEFF=LOG10(WVEFF)                                                     IRRAD.2253  
                                                                             IRRAD.2254  
C Find the table index for the mixing ratio                                  IRRAD.2255  
                                                                             IRRAD.2256  
      IWV=INT(NWV/2.)                                                        IRRAD.2257  
                                                                             IRRAD.2258  
      IF (WVEFF.NE.WVSTR(IWV)) THEN                                          IRRAD.2259  
                                                                             IRRAD.2260  
         IF (WVEFF.LT.WVSTR(IWV)) THEN                                       IRRAD.2261  
                                                                             IRRAD.2262  
            IWV=INT(IWV/2.)                                                  IRRAD.2263  
                                                                             IRRAD.2264  
            IF (WVEFF.LT.WVSTR(IWV)) THEN                                    IRRAD.2265  
               IWV=1                                                         IRRAD.2266  
               DO WHILE(WVEFF.GT.WVSTR(IWV))                                 IRRAD.2267  
                  IWV=IWV+1                                                  IRRAD.2268  
               END DO                                                        IRRAD.2269  
            ELSE                                                             IRRAD.2270  
               IF (WVEFF.NE.WVSTR(IWV)) THEN                                 IRRAD.2271  
                  DO WHILE(WVEFF.GT.WVSTR(IWV))                              IRRAD.2272  
                     IWV=IWV+1                                               IRRAD.2273  
                  END DO                                                     IRRAD.2274  
               END IF                                                        IRRAD.2275  
            END IF                                                           IRRAD.2276  
                                                                             IRRAD.2277  
         ELSE                                                                IRRAD.2278  
                                                                             IRRAD.2279  
            IWV=IWV+INT(NWV/4.)                                              IRRAD.2280  
                                                                             IRRAD.2281  
            IF (WVEFF.GT.WVSTR(IWV)) THEN                                    IRRAD.2282  
               IF (WVEFF.GE.WVSTR(NWV)) THEN                                 IRRAD.2283  
                  IWV=NWV                                                    IRRAD.2284  
               ELSE                                                          IRRAD.2285  
                  DO WHILE(WVEFF.GT.WVSTR(IWV))                              IRRAD.2286  
                     IWV=IWV+1                                               IRRAD.2287  
                  END DO                                                     IRRAD.2288  
               END IF                                                        IRRAD.2289  
            ELSE                                                             IRRAD.2290  
               IF (WVEFF.NE.WVSTR(IWV)) THEN                                 IRRAD.2291  
                  IWV=INT(NWV/2.)                                            IRRAD.2292  
                  DO WHILE(WVEFF.GT.WVSTR(IWV))                              IRRAD.2293  
                     IWV=IWV+1                                               IRRAD.2294  
                  END DO                                                     IRRAD.2295  
               END IF                                                        IRRAD.2296  
            END IF                                                           IRRAD.2297  
                                                                             IRRAD.2298  
         END IF                                                              IRRAD.2299  
                                                                             IRRAD.2300  
      END IF                                                                 IRRAD.2301  
                                                                             IRRAD.2302  
C Find the table index for the absorber amount                               IRRAD.2303  
                                                                             IRRAD.2304  
      IABS=INT(NABS/2.)                                                      IRRAD.2305  
                                                                             IRRAD.2306  
      IF (UPATH.NE.USTR(IABS)) THEN                                          IRRAD.2307  
                                                                             IRRAD.2308  
         IF (UPATH.LT.USTR(IABS)) THEN                                       IRRAD.2309  
                                                                             IRRAD.2310  
            IABS=INT(IABS/2.)                                                IRRAD.2311  
                                                                             IRRAD.2312  
            IF (UPATH.LT.USTR(IABS)) THEN                                    IRRAD.2313  
               IABS=1                                                        IRRAD.2314  
               IF (UPATH.GT.USTR(1)) THEN                                    IRRAD.2315  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2316  
                     IABS=IABS+1                                             IRRAD.2317  
                  END DO                                                     IRRAD.2318  
               END IF                                                        IRRAD.2319  
            ELSE                                                             IRRAD.2320  
               IF (UPATH.NE.USTR(IABS)) THEN                                 IRRAD.2321  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2322  
                     IABS=IABS+1                                             IRRAD.2323  
                  END DO                                                     IRRAD.2324  
               END IF                                                        IRRAD.2325  
            END IF                                                           IRRAD.2326  
                                                                             IRRAD.2327  
         ELSE                                                                IRRAD.2328  
                                                                             IRRAD.2329  
            IABS=IABS+INT(NABS/4.)                                           IRRAD.2330  
                                                                             IRRAD.2331  
            IF (UPATH.GT.USTR(IABS)) THEN                                    IRRAD.2332  
               IF (UPATH.GE.USTR(NABS)) THEN                                 IRRAD.2333  
                  IABS=NABS                                                  IRRAD.2334  
               ELSE                                                          IRRAD.2335  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2336  
                     IABS=IABS+1                                             IRRAD.2337  
                  END DO                                                     IRRAD.2338  
               END IF                                                        IRRAD.2339  
            ELSE                                                             IRRAD.2340  
               IF (UPATH.NE.USTR(IABS)) THEN                                 IRRAD.2341  
                  IABS=INT(NABS/2.)                                          IRRAD.2342  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2343  
                     IABS=IABS+1                                             IRRAD.2344  
                  END DO                                                     IRRAD.2345  
               END IF                                                        IRRAD.2346  
            END IF                                                           IRRAD.2347  
                                                                             IRRAD.2348  
         END IF                                                              IRRAD.2349  
                                                                             IRRAD.2350  
      END IF                                                                 IRRAD.2351  
                                                                             IRRAD.2352  
C Find the table index for the pressure                                      IRRAD.2353  
                                                                             IRRAD.2354  
      IF(PEFF.LT.PSTR(1))THEN                                                IRRAD.2355  
        IPRES=1                                                              IRRAD.2356  
        WRITE(2,*)'WARNING: Top level pressure < 1mbar. Out                  IRRAD.2357  
     :             of range of pre-computed table.'                          IRRAD.2358  
      ELSE                                                                   IRRAD.2359  
                                                                             IRRAD.2360  
        IPRES=INT(NPRES/2.)                                                  IRRAD.2361  
                                                                             IRRAD.2362  
        IF (PEFF.NE.PSTR(IPRES)) THEN                                        IRRAD.2363  
                                                                             IRRAD.2364  
           IF (PEFF.LT.PSTR(IPRES)) THEN                                     IRRAD.2365  
                                                                             IRRAD.2366  
              IPRES=INT(IPRES/2.)                                            IRRAD.2367  
                                                                             IRRAD.2368  
              IF (PEFF.LE.PSTR(IPRES)) THEN                                  IRRAD.2369  
                 IPRES=2                                                     IRRAD.2370  
                 IF (PEFF.GT.PSTR(1)) THEN                                   IRRAD.2371  
                    DO WHILE(PEFF.GT.PSTR(IPRES))                            IRRAD.2372  
                       IPRES=IPRES+1                                         IRRAD.2373  
                    END DO                                                   IRRAD.2374  
                 END IF                                                      IRRAD.2375  
              ELSE                                                           IRRAD.2376  
                 IF (PEFF.NE.PSTR(IPRES)) THEN                               IRRAD.2377  
                    DO WHILE(PEFF.GT.PSTR(IPRES))                            IRRAD.2378  
                       IPRES=IPRES+1                                         IRRAD.2379  
                    END DO                                                   IRRAD.2380  
                 END IF                                                      IRRAD.2381  
              END IF                                                         IRRAD.2382  
                                                                             IRRAD.2383  
           ELSE                                                              IRRAD.2384  
                                                                             IRRAD.2385  
              IPRES=IPRES+INT(NPRES/4.)                                      IRRAD.2386  
                                                                             IRRAD.2387  
              IF (PEFF.GT.PSTR(IPRES)) THEN                                  IRRAD.2388  
                 IF (PEFF.GE.PSTR(NPRES)) THEN                               IRRAD.2389  
                    IPRES=NPRES                                              IRRAD.2390  
                 ELSE                                                        IRRAD.2391  
                    DO WHILE(PEFF.GT.PSTR(IPRES))                            IRRAD.2392  
                       IPRES=IPRES+1                                         IRRAD.2393  
                    END DO                                                   IRRAD.2394  
                 END IF                                                      IRRAD.2395  
              ELSE                                                           IRRAD.2396  
                 IF (PEFF.NE.PSTR(IPRES)) THEN                               IRRAD.2397  
                    IPRES=INT(NPRES/2.)                                      IRRAD.2398  
                    DO WHILE(PEFF.GT.PSTR(IPRES))                            IRRAD.2399  
                       IPRES=IPRES+1                                         IRRAD.2400  
                    END DO                                                   IRRAD.2401  
                 END IF                                                      IRRAD.2402  
              END IF                                                         IRRAD.2403  
                                                                             IRRAD.2404  
           END IF                                                            IRRAD.2405  
                                                                             IRRAD.2406  
        END IF                                                               IRRAD.2407  
      ENDIF                                                                  IRRAD.2408  
C-------------------------------------------                                 IRRAD.2409  
C Simple interpolation/extrapolation scheme                                  IRRAD.2410  
C-------------------------------------------                                 IRRAD.2411  
                                                                             IRRAD.2412  
C PIERS' fix                                                                 IRRAD.2413  
      IF (IWV.LE.1) IWV=2                                                    IRRAD.2414  
C--- MOD=1                                                                   IRRAD.2415  
                                                                             IRRAD.2416  
C An interpolated transmittance (with respect to pressure and absorber       IRRAD.2417  
C amount) is calculated on two successive levels of effective H2O amount     IRRAD.2418  
C and the final transmittance results from the interpolation between         IRRAD.2419  
C the 2 values                                                               IRRAD.2420  
                                                                             IRRAD.2421  
      TEFF=TEFF-250.0                                                        IRRAD.2422  
                                                                             IRRAD.2423  
      IF (MOD.EQ.1) THEN                                                     IRRAD.2424  
                                                                             IRRAD.2425  
         TR(0)=DWV(MOD,IWV,IABS,IPRES)+                                      IRRAD.2426  
     $         TEFF*(CWV(MOD,IWV,IABS,IPRES)+                                IRRAD.2427  
     $         TEFF*(BWV(MOD,IWV,IABS,IPRES)+                                IRRAD.2428  
     $         TEFF*AWV(MOD,IWV,IABS,IPRES)))                                IRRAD.2429  
                                                                             IRRAD.2430  
         TRANS=TR(0)                                                         IRRAD.2431  
                                                                             IRRAD.2432  
         IF (IABS.GT.1) THEN    ! Avoid extrap. for small abs. amounts       IRRAD.2433  
                                                                             IRRAD.2434  
            IF (UPATH.NE.USTR(IABS)) THEN                                    IRRAD.2435  
                                                                             IRRAD.2436  
               TRU=DWV(MOD,IWV,IABS-1,IPRES)+                                IRRAD.2437  
     $             TEFF*(CWV(MOD,IWV,IABS-1,IPRES)+                          IRRAD.2438  
     $             TEFF*(BWV(MOD,IWV,IABS-1,IPRES)+                          IRRAD.2439  
     $             TEFF*AWV(MOD,IWV,IABS-1,IPRES)))                          IRRAD.2440  
               DTU=(TRANS-TRU)*                                              IRRAD.2441  
     $             (UPATH-USTR(IABS))/(USTR(IABS)-USTR(IABS-1))              IRRAD.2442  
               TRU=TR(0)+DTU    ! Correction for the abs. amount             IRRAD.2443  
               IF (TRU.LT.0.0) THEN                                          IRRAD.2444  
                  TRU=0.0       ! Very high abs. amounts                     IRRAD.2445  
               END IF                                                        IRRAD.2446  
                                                                             IRRAD.2447  
            ELSE                ! Avoid interpolation                        IRRAD.2448  
               TRU=TR(0)                                                     IRRAD.2449  
            END IF                                                           IRRAD.2450  
                                                                             IRRAD.2451  
            IF (PEFF.NE.PSTR(IPRES)) THEN                                    IRRAD.2452  
                                                                             IRRAD.2453  
               TRP=DWV(MOD,IWV,IABS,IPRES-1)+                                IRRAD.2454  
     $             TEFF*(CWV(MOD,IWV,IABS,IPRES-1)+                          IRRAD.2455  
     $             TEFF*(BWV(MOD,IWV,IABS,IPRES-1)+                          IRRAD.2456  
     $             TEFF*AWV(MOD,IWV,IABS,IPRES-1)))                          IRRAD.2457  
               DTP=(TRANS-TRP)*                                              IRRAD.2458  
     $              (PEFF-PSTR(IPRES))/(PSTR(IPRES)-PSTR(IPRES-1))           IRRAD.2459  
               TRP=TRU+DTP      ! Correction for the pressure                IRRAD.2460  
               IF (TRP.LT.0.0) THEN                                          IRRAD.2461  
                  TRP=0.0       ! Very high pressures                        IRRAD.2462  
               END IF                                                        IRRAD.2463  
               TR(1)=TRP                                                     IRRAD.2464  
                                                                             IRRAD.2465  
            ELSE                ! Avoid interpolation                        IRRAD.2466  
               TR(1)=TRU                                                     IRRAD.2467  
            END IF                                                           IRRAD.2468  
                                                                             IRRAD.2469  
            TRANS=TR(1)                                                      IRRAD.2470  
                                                                             IRRAD.2471  
         END IF                                                              IRRAD.2472  
                                                                             IRRAD.2473  
C Interpolation between effective absorber amounts                           IRRAD.2474  
                                                                             IRRAD.2475  
         IF (WVEFF.NE.WVSTR(IWV)) THEN                                       IRRAD.2476  
                                                                             IRRAD.2477  
            TR(0)=DWV(MOD,IWV-1,IABS,IPRES)+                                 IRRAD.2478  
     $            TEFF*(CWV(MOD,IWV-1,IABS,IPRES)+                           IRRAD.2479  
     $            TEFF*(BWV(MOD,IWV-1,IABS,IPRES)+                           IRRAD.2480  
     $            TEFF*AWV(MOD,IWV-1,IABS,IPRES)))                           IRRAD.2481  
                                                                             IRRAD.2482  
            IF (IABS.GT.1) THEN ! Avoid extrap. for small abs. amounts       IRRAD.2483  
                                                                             IRRAD.2484  
               IF (UPATH.NE.USTR(IABS)) THEN                                 IRRAD.2485  
                                                                             IRRAD.2486  
                  TRU=DWV(MOD,IWV-1,IABS-1,IPRES)+                           IRRAD.2487  
     $                TEFF*(CWV(MOD,IWV-1,IABS-1,IPRES)+                     IRRAD.2488  
     $                TEFF*(BWV(MOD,IWV-1,IABS-1,IPRES)+                     IRRAD.2489  
     $                TEFF*AWV(MOD,IWV-1,IABS-1,IPRES)))                     IRRAD.2490  
                  DTU=(TRANS-TRU)*                                           IRRAD.2491  
     $                (UPATH-USTR(IABS))/(USTR(IABS)-USTR(IABS-1))           IRRAD.2492  
                  TRU=TR(0)+DTU   ! Correction for the abs. amount           IRRAD.2493  
                  IF (TRU.LT.0.0) THEN                                       IRRAD.2494  
                     TRU=0.0      ! Very high abs. amounts                   IRRAD.2495  
                  END IF                                                     IRRAD.2496  
                                                                             IRRAD.2497  
               ELSE               ! Avoid interpolation                      IRRAD.2498  
                  TRU=TR(0)                                                  IRRAD.2499  
               END IF                                                        IRRAD.2500  
                                                                             IRRAD.2501  
               IF (PEFF.NE.PSTR(IPRES)) THEN                                 IRRAD.2502  
                                                                             IRRAD.2503  
                  TRP=DWV(MOD,IWV-1,IABS,IPRES-1)+                           IRRAD.2504  
     $                TEFF*(CWV(MOD,IWV-1,IABS,IPRES-1)+                     IRRAD.2505  
     $                TEFF*(BWV(MOD,IWV-1,IABS,IPRES-1)+                     IRRAD.2506  
     $                TEFF*AWV(MOD,IWV-1,IABS,IPRES-1)))                     IRRAD.2507  
                  DTP=(TRANS-TRP)*                                           IRRAD.2508  
     $                (PEFF-PSTR(IPRES))/(PSTR(IPRES)-PSTR(IPRES-1))         IRRAD.2509  
                  TRP=TRU+DTP     ! Correction for the pressure              IRRAD.2510  
                  IF (TRP.LT.0.0) THEN                                       IRRAD.2511  
                     TRP=0.0      ! Very high pressures                      IRRAD.2512  
                  END IF                                                     IRRAD.2513  
                  TR(2)=TRP                                                  IRRAD.2514  
                                                                             IRRAD.2515  
               ELSE               ! Avoid interpolation                      IRRAD.2516  
                  TR(2)=TRU                                                  IRRAD.2517  
               END IF                                                        IRRAD.2518  
                                                                             IRRAD.2519  
            END IF                                                           IRRAD.2520  
                                                                             IRRAD.2521  
            SLP=(TR(1)-TR(2))/(WVSTR(IWV)-WVSTR(IWV-1))                      IRRAD.2522  
            INTCPT=WVSTR(IWV)*TR(2)-WVSTR(IWV-1)*TR(1)                       IRRAD.2523  
            INTCPT=INTCPT/(WVSTR(IWV)-WVSTR(IWV-1))                          IRRAD.2524  
            TRANS=SLP*WVEFF+INTCPT                                           IRRAD.2525  
                                                                             IRRAD.2526  
         END IF                                                              IRRAD.2527  
                                                                             IRRAD.2528  
C--- MOD=2                                                                   IRRAD.2529  
                                                                             IRRAD.2530  
C The transmittances between 2 successive levels of the effective H2O        IRRAD.2531  
C are projected on a value on the actual level and interpolation is          IRRAD.2532  
C performed on the actual level. Interpolation between pressure levels       IRRAD.2533  
C is not considered                                                          IRRAD.2534  
                                                                             IRRAD.2535  
C Transmittance calculation                                                  IRRAD.2536  
                                                                             IRRAD.2537  
      ELSE                                                                   IRRAD.2538  
                                                                             IRRAD.2539  
         TR(1)=DWV(MOD,IWV,IABS,IPRES)+                                      IRRAD.2540  
     $         TEFF*(CWV(MOD,IWV,IABS,IPRES)+                                IRRAD.2541  
     $         TEFF*(BWV(MOD,IWV,IABS,IPRES)+                                IRRAD.2542  
     $         TEFF*AWV(MOD,IWV,IABS,IPRES)))                                IRRAD.2543  
                                                                             IRRAD.2544  
         TR(2)=DWV(MOD,IWV-1,IABS,IPRES)+                                    IRRAD.2545  
     $         TEFF*(CWV(MOD,IWV-1,IABS,IPRES)+                              IRRAD.2546  
     $         TEFF*(BWV(MOD,IWV-1,IABS,IPRES)+                              IRRAD.2547  
     $         TEFF*AWV(MOD,IWV-1,IABS,IPRES)))                              IRRAD.2548  
                                                                             IRRAD.2549  
C Interpolation between effective absorber amounts                           IRRAD.2550  
                                                                             IRRAD.2551  
         IF (WVEFF.NE.WVSTR(IWV)) THEN                                       IRRAD.2552  
            TR(0)=TR(2)+(TR(1)-TR(2))*(WVEFF-WVSTR(IWV-1))/                  IRRAD.2553  
     $            (WVSTR(IWV)-WVSTR(IWV-1))                                  IRRAD.2554  
         ELSE                                                                IRRAD.2555  
            TR(0)=TR(1)                                                      IRRAD.2556  
         END IF                                                              IRRAD.2557  
                                                                             IRRAD.2558  
C Interpolation between absorber amounts                                     IRRAD.2559  
                                                                             IRRAD.2560  
         IF (IABS.GT.1) THEN    ! Avoid extrap. for small abs. amounts       IRRAD.2561  
                                                                             IRRAD.2562  
            IF (UPATH.NE.USTR(IABS)) THEN                                    IRRAD.2563  
                                                                             IRRAD.2564  
               TRU=DWV(MOD,IWV,IABS-1,IPRES)+                                IRRAD.2565  
     $             TEFF*(CWV(MOD,IWV,IABS-1,IPRES)+                          IRRAD.2566  
     $             TEFF*(BWV(MOD,IWV,IABS-1,IPRES)+                          IRRAD.2567  
     $             TEFF*AWV(MOD,IWV,IABS-1,IPRES)))                          IRRAD.2568  
               DTU1=(TR(1)-TRU)*                                             IRRAD.2569  
     $              (UPATH-USTR(IABS))/(USTR(IABS)-USTR(IABS-1))             IRRAD.2570  
                                                                             IRRAD.2571  
               TRU=DWV(MOD,IWV-1,IABS-1,IPRES)+                              IRRAD.2572  
     $             TEFF*(CWV(MOD,IWV-1,IABS-1,IPRES)+                        IRRAD.2573  
     $             TEFF*(BWV(MOD,IWV-1,IABS-1,IPRES)+                        IRRAD.2574  
     $             TEFF*AWV(MOD,IWV-1,IABS-1,IPRES)))                        IRRAD.2575  
               DTU2=(TR(2)-TRU)*                                             IRRAD.2576  
     $              (UPATH-USTR(IABS))/(USTR(IABS)-USTR(IABS-1))             IRRAD.2577  
                                                                             IRRAD.2578  
               IF (WVEFF.NE.WVSTR(IWV)) THEN                                 IRRAD.2579  
                  DTU=DTU2+(DTU1-DTU2)*(WVEFF-WVSTR(IWV-1))/                 IRRAD.2580  
     $               (WVSTR(IWV)-WVSTR(IWV-1))                               IRRAD.2581  
               ELSE                                                          IRRAD.2582  
                  DTU=0.0                                                    IRRAD.2583  
               END IF                                                        IRRAD.2584  
                                                                             IRRAD.2585  
               TRU=TR(0)+DTU    ! Correction for the abs. amount             IRRAD.2586  
               IF (TRU.LT.0.0) THEN                                          IRRAD.2587  
                  TRU=0.0       ! Very high abs. amounts                     IRRAD.2588  
               END IF                                                        IRRAD.2589  
                                                                             IRRAD.2590  
            ELSE                ! Avoid interpolation                        IRRAD.2591  
               TRU=TR(0)                                                     IRRAD.2592  
            END IF                                                           IRRAD.2593  
                                                                             IRRAD.2594  
            TRANS =TRU                                                       IRRAD.2595  
                                                                             IRRAD.2596  
         ELSE                                                                IRRAD.2597  
                                                                             IRRAD.2598  
            TRANS=TR(0)                                                      IRRAD.2599  
                                                                             IRRAD.2600  
         END IF                                                              IRRAD.2601  
                                                                             IRRAD.2602  
      END IF                                                                 IRRAD.2603  
                                                                             IRRAD.2604  
      IF (TRANS.LT.0.0) THEN                                                 IRRAD.2605  
         TRANS=0.0                                                           IRRAD.2606  
      END IF                                                                 IRRAD.2607  
                                                                             IRRAD.2608  
      IF (TRANS.GT.1.0) THEN                                                 IRRAD.2609  
         TRANS=1.0                                                           IRRAD.2610  
      END IF                                                                 IRRAD.2611  
                                                                             IRRAD.2612  
      END                                                                    IRRAD.2613  
                                                                             IRRAD.2614  
                                                                             IRRAD.2615  
C***********************************************************************     IRRAD.2616  
C*                                                                     *     IRRAD.2617  
C*                         SUBROUTINE GASSEARCH                        *     IRRAD.2618  
C*                                                                     *     IRRAD.2619  
C***********************************************************************     IRRAD.2620  
                                                                             IRRAD.2621  
      SUBROUTINE GASSEARCH(IGAS,IBND,UPATH,PEFF,TEFF,AH2O,BH2O,CH2O,         IRRAD.2622  
     $                     DH2O,AGAS,BGAS,CGAS,DGAS,AN03,BN03,CN03,          IRRAD.2623  
     $                     DN03,AC02,BC02,CC02,DC02,AC06,BC06,CC06,          IRRAD.2624  
     $                     DC06,AC07,BC07,CC07,DC07,TRANS)                   IRRAD.2625  
                                                                             IRRAD.2626  
C Subroutine GASSEARCH calculates the transmittane of a homogeneous          IRRAD.2627  
C atmospheric path, using the data of pre-computed tables stored             IRRAD.2628  
C in 'gastab'                                                                IRRAD.2629  
C                                                                            IRRAD.2630  
C INPUT:  Gas index (IGAS)                                                   IRRAD.2631  
C         Band index (IBND)                                                  IRRAD.2632  
C         Absorber amount (UPATH)                                            IRRAD.2633  
C         Pressure (PEFF)                                                    IRRAD.2634  
C         Temperature (TEFF)                                                 IRRAD.2635  
C         Pre-computed tables (AH2O,BH2O,CH2O,DH2O,AGAS,BGAS,CGAS,DGAS,      IRRAD.2636  
C                              AN03,BN03,CN03,DN03,AC02,BC02,CC02,DC02,      IRRAD.2637  
C                              AC06,BC06,CC06,DC06,AC07,BC07,CC07,DC07)      IRRAD.2638  
C                                                                            IRRAD.2639  
C OUTPUT: Transmittance (TRANS)                                              IRRAD.2640  
                                                                             IRRAD.2641  
      IMPLICIT NONE                                                          IRRAD.2642  
C***********************************************************************     PARRAY.2     
C*                                                                     *     PARRAY.3     
C*                         P A R R A Y                                 *     PARRAY.4     
C*                                                                     *     PARRAY.5     
C***********************************************************************     PARRAY.6     
C-----------------------------------------------------------------------     PARRAY.7     
C In this part of the code the user can set the dimensions of arrays         PARRAY.8     
C used for the calculations, by setting the values in the paramter           PARRAY.9     
C statements                                                                 PARRAY.10    
C-----------------------------------------------------------------------     PARRAY.11    
                                                                             PARRAY.12    
      INTEGER MXGAS,MXLEV,MXBAND,MXCL                                        PARRAY.13    
                                                                             PARRAY.14    
      PARAMETER(MXGAS=8)     ! Maximum number of gases                       PARRAY.15    
                                                                             PARRAY.16    
      PARAMETER(MXLEV=5)     ! Maximum number of levels in the               NETCDF.37    
                             ! atmosphere (not including the surface)        PARRAY.18    
                                                                             PARRAY.19    
      PARAMETER(MXBAND=9)    ! Maximum number of spectral bands (not         PARRAY.20    
                             ! including the whole spectrum, 0-3000cm-1)     PARRAY.21    
                                                                             PARRAY.22    
      PARAMETER(MXCL=3)      ! Maximum number of cloud types                 PARRAY.23    
                                                                             PARRAY.24    
C-----------------------------------------------------------------------     PARRAY.25    
                                                                             IRRAD.2644  
C-----------------                                                           IRRAD.2645  
C Input Variables                                                            IRRAD.2646  
C-----------------                                                           IRRAD.2647  
                                                                             IRRAD.2648  
      INTEGER IGAS,IBND                                                      IRRAD.2649  
      REAL UPATH,PEFF,TEFF                                                   IRRAD.2650  
                                                                             IRRAD.2651  
      REAL AH2O(MXBAND,48,28),AGAS(MXBAND-1,48,28)                           IRRAD.2652  
      REAL BH2O(MXBAND,48,28),BGAS(MXBAND-1,48,28)                           IRRAD.2653  
      REAL CH2O(MXBAND,48,28),CGAS(MXBAND-1,48,28)                           IRRAD.2654  
      REAL DH2O(MXBAND,48,28),DGAS(MXBAND-1,48,28)                           IRRAD.2655  
      REAL AN03(48,28),BN03(48,28),CN03(48,28),DN03(48,28)                   IRRAD.2656  
      REAL AC02(48,28),BC02(48,28),CC02(48,28),DC02(48,28)                   IRRAD.2657  
      REAL AC06(48,28),BC06(48,28),CC06(48,28),DC06(48,28)                   IRRAD.2658  
      REAL AC07(48,28),BC07(48,28),CC07(48,28),DC07(48,28)                   IRRAD.2659  
                                                                             IRRAD.2660  
C-----------------                                                           IRRAD.2661  
C Output Variable                                                            IRRAD.2662  
C-----------------                                                           IRRAD.2663  
                                                                             IRRAD.2664  
      REAL TRANS                                                             IRRAD.2665  
                                                                             IRRAD.2666  
C--------------------                                                        IRRAD.2667  
C Internal Variables                                                         IRRAD.2668  
C--------------------                                                        IRRAD.2669  
                                                                             IRRAD.2670  
      INTEGER IABS,IPRES,NABS,NPRES                                          IRRAD.2671  
      PARAMETER(NABS=48,NPRES=28)                                            IRRAD.2672  
      REAL USTR(NABS),PSTR(NPRES)  ! Stored values of absorber               IRRAD.2673  
                                     ! amount and pressure                   IRRAD.2674  
                                                                             IRRAD.2675  
      REAL FU,FFU,FP,FFP          ! Variables                                IRRAD.2676  
      REAL A0,A1,A2,B0,B1,B2      ! used for                                 IRRAD.2677  
      REAL C0,C1,C2,D0,D1,D2      ! interpolation                            IRRAD.2678  
                                                                             IRRAD.2679  
C Stored values of absorber amount (kg m-2)                                  IRRAD.2680  
                                                                             IRRAD.2681  
      DATA(USTR(IABS),IABS=1,NABS)/  1.0D-08, 1.0D-07, 5.0D-07,              IRRAD.2682  
     $                               1.0D-06, 2.0D-06, 4.0D-06,              IRRAD.2683  
     $                               6.0D-06, 8.0D-06, 1.0D-05,              IRRAD.2684  
     $                               2.0D-05, 4.0D-05, 6.0D-05,              IRRAD.2685  
     $                               8.0D-05, 1.0D-04, 2.0D-04,              IRRAD.2686  
     $                               4.0D-04, 6.0D-04, 8.0D-04,              IRRAD.2687  
     $                               1.0D-03, 2.0D-03, 4.0D-03,              IRRAD.2688  
     $                               6.0D-03, 8.0D-03, 1.0D-02,              IRRAD.2689  
     $                               2.0D-02, 4.0D-02, 6.0D-02,              IRRAD.2690  
     $                               8.0D-02, 1.0D-01, 2.0D-01,              IRRAD.2691  
     $                               4.0D-01, 6.0D-01, 8.0D-01,              IRRAD.2692  
     $                               1.0, 2.0, 4.0, 6.0, 8.0,                IRRAD.2693  
     $                               1.0D+01, 2.0D+01, 4.0D+01,              IRRAD.2694  
     $                               6.0D+01, 8.0D+01, 1.0D+02,              IRRAD.2695  
     $                               2.0D+02, 4.0D+02, 6.0D+02,              IRRAD.2696  
     $                               8.0D+02/                                IRRAD.2697  
                                                                             IRRAD.2698  
C Stored values of pressure (Pa)                                             IRRAD.2699  
                                                                             IRRAD.2700  
      DATA(PSTR(IPRES),IPRES=1,NPRES)/ 1.0, 1.0D+01, 2.0D+01, 4.0D+01,       IRRAD.2701  
     $                                 6.0D+01, 8.0D+01, 1.0D+02,            IRRAD.2702  
     $                                 2.0D+02, 4.0D+02, 6.0D+02,            IRRAD.2703  
     $                                 8.0D+02, 1.0D+03, 2.0D+03,            IRRAD.2704  
     $                                 4.0D+03, 6.0D+03, 8.0D+03,            IRRAD.2705  
     $                                 1.0D+04, 2.0D+04, 3.0D+04,            IRRAD.2706  
     $                                 4.0D+04, 5.0D+04, 6.0D+04,            IRRAD.2707  
     $                                 7.0D+04, 8.0D+04, 9.0D+04,            IRRAD.2708  
     $                                 1.0D+05, 1.1D+05, 1.2D+05/            IRRAD.2709  
                                                                             IRRAD.2710  
                                                                             IRRAD.2711  
      FU=99.                                                                 IRRAD.2712  
      FP=99.                                                                 IRRAD.2713  
                                                                             IRRAD.2714  
C Find the table index for the absorber amount                               IRRAD.2715  
                                                                             IRRAD.2716  
      IABS=INT(NABS/2.)                                                      IRRAD.2717  
                                                                             IRRAD.2718  
      IF (UPATH.NE.USTR(IABS)) THEN                                          IRRAD.2719  
                                                                             IRRAD.2720  
         IF (UPATH.LT.USTR(IABS)) THEN                                       IRRAD.2721  
                                                                             IRRAD.2722  
            IABS=INT(IABS/2.)                                                IRRAD.2723  
                                                                             IRRAD.2724  
            IF (UPATH.LT.USTR(IABS)) THEN                                    IRRAD.2725  
               IABS=1                                                        IRRAD.2726  
               IF (UPATH.GT.USTR(1)) THEN                                    IRRAD.2727  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2728  
                     IABS=IABS+1                                             IRRAD.2729  
                  END DO                                                     IRRAD.2730  
               END IF                                                        IRRAD.2731  
               IF (UPATH.LE.USTR(1)) THEN                                    IRRAD.2732  
                  IABS=2                                                     IRRAD.2733  
                  FFU=0.                                                     IRRAD.2734  
                  FU=1.                                                      IRRAD.2735  
               END IF                                                        IRRAD.2736  
            ELSE                                                             IRRAD.2737  
               IF (UPATH.NE.USTR(IABS)) THEN                                 IRRAD.2738  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2739  
                     IABS=IABS+1                                             IRRAD.2740  
                  END DO                                                     IRRAD.2741  
               END IF                                                        IRRAD.2742  
            END IF                                                           IRRAD.2743  
                                                                             IRRAD.2744  
         ELSE                                                                IRRAD.2745  
                                                                             IRRAD.2746  
            IABS=IABS+INT(NABS/4.)                                           IRRAD.2747  
                                                                             IRRAD.2748  
            IF (UPATH.GT.USTR(IABS)) THEN                                    IRRAD.2749  
               IF (UPATH.GE.USTR(NABS)) THEN                                 IRRAD.2750  
                  IABS=NABS                                                  IRRAD.2751  
                  FFU=1.                                                     IRRAD.2752  
                  FU=0.                                                      IRRAD.2753  
               ELSE                                                          IRRAD.2754  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2755  
                     IABS=IABS+1                                             IRRAD.2756  
                  END DO                                                     IRRAD.2757  
               END IF                                                        IRRAD.2758  
            ELSE                                                             IRRAD.2759  
               IF (UPATH.NE.USTR(IABS)) THEN                                 IRRAD.2760  
                  IABS=INT(NABS/2.)                                          IRRAD.2761  
                  DO WHILE(UPATH.GT.USTR(IABS))                              IRRAD.2762  
                     IABS=IABS+1                                             IRRAD.2763  
                  END DO                                                     IRRAD.2764  
               END IF                                                        IRRAD.2765  
            END IF                                                           IRRAD.2766  
                                                                             IRRAD.2767  
         END IF                                                              IRRAD.2768  
                                                                             IRRAD.2769  
      END IF                                                                 IRRAD.2770  
                                                                             IRRAD.2771  
                                                                             IRRAD.2772  
C Find the table index for the pressure                                      IRRAD.2773  
                                                                             IRRAD.2774  
      IPRES=INT(NPRES/2.)                                                    IRRAD.2775  
                                                                             IRRAD.2776  
      IF (PEFF.NE.PSTR(IPRES)) THEN                                          IRRAD.2777  
                                                                             IRRAD.2778  
         IF (PEFF.LT.PSTR(IPRES)) THEN                                       IRRAD.2779  
                                                                             IRRAD.2780  
            IPRES=INT(IPRES/2.)                                              IRRAD.2781  
                                                                             IRRAD.2782  
            IF (PEFF.LE.PSTR(IPRES)) THEN                                    IRRAD.2783  
               IPRES=2                                                       IRRAD.2784  
               IF (PEFF.GT.PSTR(1)) THEN                                     IRRAD.2785  
                  DO WHILE(PEFF.GT.PSTR(IPRES))                              IRRAD.2786  
                     IPRES=IPRES+1                                           IRRAD.2787  
                  END DO                                                     IRRAD.2788  
               END IF                                                        IRRAD.2789  
               IF (PEFF.LE.PSTR(1)) THEN                                     IRRAD.2790  
                  FFP=0.                                                     IRRAD.2791  
                  FP=1.                                                      IRRAD.2792  
               END IF                                                        IRRAD.2793  
            ELSE                                                             IRRAD.2794  
               IF (PEFF.NE.PSTR(IPRES)) THEN                                 IRRAD.2795  
                  DO WHILE(PEFF.GT.PSTR(IPRES))                              IRRAD.2796  
                     IPRES=IPRES+1                                           IRRAD.2797  
                  END DO                                                     IRRAD.2798  
               END IF                                                        IRRAD.2799  
            END IF                                                           IRRAD.2800  
                                                                             IRRAD.2801  
         ELSE                                                                IRRAD.2802  
                                                                             IRRAD.2803  
            IPRES=IPRES+INT(NPRES/4.)                                        IRRAD.2804  
                                                                             IRRAD.2805  
            IF (PEFF.GT.PSTR(IPRES)) THEN                                    IRRAD.2806  
               IF (PEFF.GE.PSTR(NPRES)) THEN                                 IRRAD.2807  
                  IPRES=NPRES                                                IRRAD.2808  
                  FFP=1.                                                     IRRAD.2809  
                  FP=0.                                                      IRRAD.2810  
               ELSE                                                          IRRAD.2811  
                  DO WHILE(PEFF.GT.PSTR(IPRES))                              IRRAD.2812  
                     IPRES=IPRES+1                                           IRRAD.2813  
                  END DO                                                     IRRAD.2814  
               END IF                                                        IRRAD.2815  
            ELSE                                                             IRRAD.2816  
               IF (PEFF.NE.PSTR(IPRES)) THEN                                 IRRAD.2817  
                  IPRES=INT(NPRES/2.)                                        IRRAD.2818  
                  DO WHILE(PEFF.GT.PSTR(IPRES))                              IRRAD.2819  
                     IPRES=IPRES+1                                           IRRAD.2820  
                  END DO                                                     IRRAD.2821  
               END IF                                                        IRRAD.2822  
            END IF                                                           IRRAD.2823  
                                                                             IRRAD.2824  
         END IF                                                              IRRAD.2825  
                                                                             IRRAD.2826  
      END IF                                                                 IRRAD.2827  
                                                                             IRRAD.2828  
C Transmittance calculation                                                  IRRAD.2829  
                                                                             IRRAD.2830  
      TEFF=TEFF-250.0                                                        IRRAD.2831  
                                                                             IRRAD.2832  
C----------------------                                                      IRRAD.2833  
C Interpolation scheme                                                       IRRAD.2834  
C----------------------                                                      IRRAD.2835  
                                                                             IRRAD.2836  
      IF ((FU.GT.98.).AND.(FP.GT.98)) THEN                                   IRRAD.2837  
         FU=(USTR(IABS)-UPATH)/(USTR(IABS)-USTR(IABS-1))                     IRRAD.2838  
         FP=(PSTR(IPRES)-PEFF)/(PSTR(IPRES)-PSTR(IPRES-1))                   IRRAD.2839  
         FFU=1.-FU                                                           IRRAD.2840  
         FFP=1.-FP                                                           IRRAD.2841  
      END IF                                                                 IRRAD.2842  
                                                                             IRRAD.2843  
      IF (IGAS.EQ.1) THEN                                                    IRRAD.2844  
                                                                             IRRAD.2845  
         A1=AH2O(IBND,IABS,IPRES)*FFP+                                       IRRAD.2846  
     $      AH2O(IBND,IABS,IPRES-1)*FP                                       IRRAD.2847  
         A2=AH2O(IBND,IABS-1,IPRES)*FFP+                                     IRRAD.2848  
     $      AH2O(IBND,IABS-1,IPRES-1)*FP                                     IRRAD.2849  
         A0=A1*FFU+A2*FU                                                     IRRAD.2850  
                                                                             IRRAD.2851  
         B1=BH2O(IBND,IABS,IPRES)*FFP+                                       IRRAD.2852  
     $      BH2O(IBND,IABS,IPRES-1)*FP                                       IRRAD.2853  
         B2=BH2O(IBND,IABS-1,IPRES)*FFP+                                     IRRAD.2854  
     $      BH2O(IBND,IABS-1,IPRES-1)*FP                                     IRRAD.2855  
         B0=B1*FFU+B2*FU                                                     IRRAD.2856  
                                                                             IRRAD.2857  
         C1=CH2O(IBND,IABS,IPRES)*FFP+                                       IRRAD.2858  
     $      CH2O(IBND,IABS,IPRES-1)*FP                                       IRRAD.2859  
         C2=CH2O(IBND,IABS-1,IPRES)*FFP+                                     IRRAD.2860  
     $      CH2O(IBND,IABS-1,IPRES-1)*FP                                     IRRAD.2861  
         C0=C1*FFU+C2*FU                                                     IRRAD.2862  
                                                                             IRRAD.2863  
         D1=DH2O(IBND,IABS,IPRES)*FFP+                                       IRRAD.2864  
     $      DH2O(IBND,IABS,IPRES-1)*FP                                       IRRAD.2865  
         D2=DH2O(IBND,IABS-1,IPRES)*FFP+                                     IRRAD.2866  
     $      DH2O(IBND,IABS-1,IPRES-1)*FP                                     IRRAD.2867  
         D0=D1*FFU+D2*FU                                                     IRRAD.2868  
                                                                             IRRAD.2869  
         TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                                IRRAD.2870  
         GOTO 1976                                                           IRRAD.2871  
                                                                             IRRAD.2872  
      END IF                                                                 IRRAD.2873  
                                                                             IRRAD.2874  
      IF (IGAS.EQ.2) THEN                                                    IRRAD.2875  
                                                                             IRRAD.2876  
         IF (IBND.EQ.1) THEN                                                 IRRAD.2877  
            A1=AGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.2878  
     $         AGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.2879  
            A2=AGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.2880  
     $         AGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.2881  
            A0=A1*FFU+A2*FU                                                  IRRAD.2882  
                                                                             IRRAD.2883  
            B1=BGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.2884  
     $         BGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.2885  
            B2=BGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.2886  
     $         BGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.2887  
            B0=B1*FFU+B2*FU                                                  IRRAD.2888  
                                                                             IRRAD.2889  
            C1=CGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.2890  
     $         CGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.2891  
            C2=CGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.2892  
     $         CGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.2893  
            C0=C1*FFU+C2*FU                                                  IRRAD.2894  
                                                                             IRRAD.2895  
            D1=DGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.2896  
     $         DGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.2897  
            D2=DGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.2898  
     $         DGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.2899  
            D0=D1*FFU+D2*FU                                                  IRRAD.2900  
                                                                             IRRAD.2901  
            TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                             IRRAD.2902  
            GOTO 1976                                                        IRRAD.2903  
         END IF                                                              IRRAD.2904  
                                                                             IRRAD.2905  
         IF (IBND.EQ.6) THEN                                                 IRRAD.2906  
            A1=AC06(IABS,IPRES)*FFP+AC06(IABS,IPRES-1)*FP                    IRRAD.2907  
            A2=AC06(IABS-1,IPRES)*FFP+AC06(IABS-1,IPRES-1)*FP                IRRAD.2908  
            A0=A1*FFU+A2*FU                                                  IRRAD.2909  
                                                                             IRRAD.2910  
            B1=BC06(IABS,IPRES)*FFP+BC06(IABS,IPRES-1)*FP                    IRRAD.2911  
            B2=BC06(IABS-1,IPRES)*FFP+BC06(IABS-1,IPRES-1)*FP                IRRAD.2912  
            B0=B1*FFU+B2*FU                                                  IRRAD.2913  
                                                                             IRRAD.2914  
            C1=CC06(IABS,IPRES)*FFP+CC06(IABS,IPRES-1)*FP                    IRRAD.2915  
            C2=CC06(IABS-1,IPRES)*FFP+CC06(IABS-1,IPRES-1)*FP                IRRAD.2916  
            C0=C1*FFU+C2*FU                                                  IRRAD.2917  
                                                                             IRRAD.2918  
            D1=DC06(IABS,IPRES)*FFP+DC06(IABS,IPRES-1)*FP                    IRRAD.2919  
            D2=DC06(IABS-1,IPRES)*FFP+DC06(IABS-1,IPRES-1)*FP                IRRAD.2920  
            D0=D1*FFU+D2*FU                                                  IRRAD.2921  
                                                                             IRRAD.2922  
            TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                             IRRAD.2923  
            GOTO 1976                                                        IRRAD.2924  
         END IF                                                              IRRAD.2925  
                                                                             IRRAD.2926  
         IF (IBND.EQ.7) THEN                                                 IRRAD.2927  
            A1=AC07(IABS,IPRES)*FFP+AC07(IABS,IPRES-1)*FP                    IRRAD.2928  
            A2=AC07(IABS-1,IPRES)*FFP+AC07(IABS-1,IPRES-1)*FP                IRRAD.2929  
            A0=A1*FFU+A2*FU                                                  IRRAD.2930  
                                                                             IRRAD.2931  
            B1=BC07(IABS,IPRES)*FFP+BC07(IABS,IPRES-1)*FP                    IRRAD.2932  
            B2=BC07(IABS-1,IPRES)*FFP+BC07(IABS-1,IPRES-1)*FP                IRRAD.2933  
            B0=B1*FFU+B2*FU                                                  IRRAD.2934  
                                                                             IRRAD.2935  
            C1=CC07(IABS,IPRES)*FFP+CC07(IABS,IPRES-1)*FP                    IRRAD.2936  
            C2=CC07(IABS-1,IPRES)*FFP+CC07(IABS-1,IPRES-1)*FP                IRRAD.2937  
            C0=C1*FFU+C2*FU                                                  IRRAD.2938  
                                                                             IRRAD.2939  
            D1=DC07(IABS,IPRES)*FFP+DC07(IABS,IPRES-1)*FP                    IRRAD.2940  
            D2=DC07(IABS-1,IPRES)*FFP+DC07(IABS-1,IPRES-1)*FP                IRRAD.2941  
            D0=D1*FFU+D2*FU                                                  IRRAD.2942  
                                                                             IRRAD.2943  
            TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                             IRRAD.2944  
            GOTO 1976                                                        IRRAD.2945  
         END IF                                                              IRRAD.2946  
                                                                             IRRAD.2947  
      END IF                                                                 IRRAD.2948  
                                                                             IRRAD.2949  
      IF ((IGAS.EQ.3).OR.(IGAS.EQ.4).OR.                                     IRRAD.2950  
     $    (IGAS.EQ.7).OR.(IBND.EQ.8)) THEN                                   IRRAD.2951  
                                                                             IRRAD.2952  
         A1=AGAS(IBND,IABS,IPRES)*FFP+                                       IRRAD.2953  
     $      AGAS(IBND,IABS,IPRES-1)*FP                                       IRRAD.2954  
         A2=AGAS(IBND,IABS-1,IPRES)*FFP+                                     IRRAD.2955  
     $      AGAS(IBND,IABS-1,IPRES-1)*FP                                     IRRAD.2956  
         A0=A1*FFU+A2*FU                                                     IRRAD.2957  
                                                                             IRRAD.2958  
         B1=BGAS(IBND,IABS,IPRES)*FFP+                                       IRRAD.2959  
     $      BGAS(IBND,IABS,IPRES-1)*FP                                       IRRAD.2960  
         B2=BGAS(IBND,IABS-1,IPRES)*FFP+                                     IRRAD.2961  
     $      BGAS(IBND,IABS-1,IPRES-1)*FP                                     IRRAD.2962  
         B0=B1*FFU+B2*FU                                                     IRRAD.2963  
                                                                             IRRAD.2964  
         C1=CGAS(IBND,IABS,IPRES)*FFP+                                       IRRAD.2965  
     $      CGAS(IBND,IABS,IPRES-1)*FP                                       IRRAD.2966  
         C2=CGAS(IBND,IABS-1,IPRES)*FFP+                                     IRRAD.2967  
     $      CGAS(IBND,IABS-1,IPRES-1)*FP                                     IRRAD.2968  
         C0=C1*FFU+C2*FU                                                     IRRAD.2969  
                                                                             IRRAD.2970  
         D1=DGAS(IBND,IABS,IPRES)*FFP+                                       IRRAD.2971  
     $      DGAS(IBND,IABS,IPRES-1)*FP                                       IRRAD.2972  
         D2=DGAS(IBND,IABS-1,IPRES)*FFP+                                     IRRAD.2973  
     $      DGAS(IBND,IABS-1,IPRES-1)*FP                                     IRRAD.2974  
         D0=D1*FFU+D2*FU                                                     IRRAD.2975  
                                                                             IRRAD.2976  
         TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                                IRRAD.2977  
         GOTO 1976                                                           IRRAD.2978  
                                                                             IRRAD.2979  
      END IF                                                                 IRRAD.2980  
                                                                             IRRAD.2981  
      IF (IGAS.EQ.5) THEN                                                    IRRAD.2982  
                                                                             IRRAD.2983  
         IF ((IBND.EQ.4).OR.(IBND.EQ.7)) THEN                                IRRAD.2984  
            A1=AGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.2985  
     $         AGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.2986  
            A2=AGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.2987  
     $         AGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.2988  
            A0=A1*FFU+A2*FU                                                  IRRAD.2989  
                                                                             IRRAD.2990  
            B1=BGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.2991  
     $         BGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.2992  
            B2=BGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.2993  
     $         BGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.2994  
            B0=B1*FFU+B2*FU                                                  IRRAD.2995  
                                                                             IRRAD.2996  
            C1=CGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.2997  
     $         CGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.2998  
            C2=CGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.2999  
     $         CGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.3000  
            C0=C1*FFU+C2*FU                                                  IRRAD.3001  
                                                                             IRRAD.3002  
            D1=DGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.3003  
     $         DGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.3004  
            D2=DGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.3005  
     $         DGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.3006  
            D0=D1*FFU+D2*FU                                                  IRRAD.3007  
                                                                             IRRAD.3008  
            TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                             IRRAD.3009  
            GOTO 1976                                                        IRRAD.3010  
         END IF                                                              IRRAD.3011  
                                                                             IRRAD.3012  
         IF (IBND.EQ.3) THEN                                                 IRRAD.3013  
            A1=AN03(IABS,IPRES)*FFP+AN03(IABS,IPRES-1)*FP                    IRRAD.3014  
            A2=AN03(IABS-1,IPRES)*FFP+AN03(IABS-1,IPRES-1)*FP                IRRAD.3015  
            A0=A1*FFU+A2*FU                                                  IRRAD.3016  
                                                                             IRRAD.3017  
            B1=BN03(IABS,IPRES)*FFP+BN03(IABS,IPRES-1)*FP                    IRRAD.3018  
            B2=BN03(IABS-1,IPRES)*FFP+BN03(IABS-1,IPRES-1)*FP                IRRAD.3019  
            B0=B1*FFU+B2*FU                                                  IRRAD.3020  
                                                                             IRRAD.3021  
            C1=CN03(IABS,IPRES)*FFP+CN03(IABS,IPRES-1)*FP                    IRRAD.3022  
            C2=CN03(IABS-1,IPRES)*FFP+CN03(IABS-1,IPRES-1)*FP                IRRAD.3023  
            C0=C1*FFU+C2*FU                                                  IRRAD.3024  
                                                                             IRRAD.3025  
            D1=DN03(IABS,IPRES)*FFP+DN03(IABS,IPRES-1)*FP                    IRRAD.3026  
            D2=DN03(IABS-1,IPRES)*FFP+DN03(IABS-1,IPRES-1)*FP                IRRAD.3027  
            D0=D1*FFU+D2*FU                                                  IRRAD.3028  
                                                                             IRRAD.3029  
            TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                             IRRAD.3030  
            GOTO 1976                                                        IRRAD.3031  
         END IF                                                              IRRAD.3032  
                                                                             IRRAD.3033  
      END IF                                                                 IRRAD.3034  
                                                                             IRRAD.3035  
      IF (IGAS.EQ.6) THEN                                                    IRRAD.3036  
                                                                             IRRAD.3037  
         IF (IBND.EQ.5) THEN                                                 IRRAD.3038  
            A1=AGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.3039  
     $         AGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.3040  
            A2=AGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.3041  
     $         AGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.3042  
            A0=A1*FFU+A2*FU                                                  IRRAD.3043  
                                                                             IRRAD.3044  
            B1=BGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.3045  
     $         BGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.3046  
            B2=BGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.3047  
     $         BGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.3048  
            B0=B1*FFU+B2*FU                                                  IRRAD.3049  
                                                                             IRRAD.3050  
            C1=CGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.3051  
     $         CGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.3052  
            C2=CGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.3053  
     $         CGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.3054  
            C0=C1*FFU+C2*FU                                                  IRRAD.3055  
                                                                             IRRAD.3056  
            D1=DGAS(IBND,IABS,IPRES)*FFP+                                    IRRAD.3057  
     $         DGAS(IBND,IABS,IPRES-1)*FP                                    IRRAD.3058  
            D2=DGAS(IBND,IABS-1,IPRES)*FFP+                                  IRRAD.3059  
     $         DGAS(IBND,IABS-1,IPRES-1)*FP                                  IRRAD.3060  
            D0=D1*FFU+D2*FU                                                  IRRAD.3061  
                                                                             IRRAD.3062  
            TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                             IRRAD.3063  
            GOTO 1976                                                        IRRAD.3064  
         END IF                                                              IRRAD.3065  
                                                                             IRRAD.3066  
         IF (IBND.EQ.2) THEN                                                 IRRAD.3067  
            A1=AC02(IABS,IPRES)*FFP+AC02(IABS,IPRES-1)*FP                    IRRAD.3068  
            A2=AC02(IABS-1,IPRES)*FFP+AC02(IABS-1,IPRES-1)*FP                IRRAD.3069  
            A0=A1*FFU+A2*FU                                                  IRRAD.3070  
                                                                             IRRAD.3071  
            B1=BC02(IABS,IPRES)*FFP+BC02(IABS,IPRES-1)*FP                    IRRAD.3072  
            B2=BC02(IABS-1,IPRES)*FFP+BC02(IABS-1,IPRES-1)*FP                IRRAD.3073  
            B0=B1*FFU+B2*FU                                                  IRRAD.3074  
                                                                             IRRAD.3075  
            C1=CC02(IABS,IPRES)*FFP+CC02(IABS,IPRES-1)*FP                    IRRAD.3076  
            C2=CC02(IABS-1,IPRES)*FFP+CC02(IABS-1,IPRES-1)*FP                IRRAD.3077  
            C0=C1*FFU+C2*FU                                                  IRRAD.3078  
                                                                             IRRAD.3079  
            D1=DC02(IABS,IPRES)*FFP+DC02(IABS,IPRES-1)*FP                    IRRAD.3080  
            D2=DC02(IABS-1,IPRES)*FFP+DC02(IABS-1,IPRES-1)*FP                IRRAD.3081  
            D0=D1*FFU+D2*FU                                                  IRRAD.3082  
                                                                             IRRAD.3083  
            TRANS=D0+TEFF*(C0+TEFF*(B0+TEFF*A0))                             IRRAD.3084  
         END IF                                                              IRRAD.3085  
                                                                             IRRAD.3086  
      END IF                                                                 IRRAD.3087  
                                                                             IRRAD.3088  
 1976 CONTINUE                                                               IRRAD.3089  
                                                                             IRRAD.3090  
      TEFF=TEFF+250.0                                                        IRRAD.3091  
                                                                             IRRAD.3092  
                                                                             IRRAD.3093  
      END                                                                    IRRAD.3094  
                                                                             IRRAD.3095  
                                                                             IRRAD.3096  
C***********************************************************************     IRRAD.3097  
C*                                                                     *     IRRAD.3098  
C*                     FUNCTION HALTRAN                                *     IRRAD.3099  
C*                                                                     *     IRRAD.3100  
C***********************************************************************     IRRAD.3101  
                                                                             IRRAD.3102  
      REAL FUNCTION HALTRAN (IBND,UPATH)                                     IRRAD.3103  
                                                                             IRRAD.3104  
C This function returns the halocarbon transmittance, calculated by the      IRRAD.3105  
C simple expression Tr=1-a*u, where u is the column amount per molecular     IRRAD.3106  
C weight The values of 'a' were chosed, so that the model can reproduce      IRRAD.3107  
C the radiative forcing of a typical halocarbon (average of CFC-11,          IRRAD.3108  
C CFC-12, CFC-113, HCFC-141b, HFC-134a, HCFC-22) computed by a               IRRAD.3109  
C narrow-band model with a mid-latitude summer profile, for different        IRRAD.3110  
C overlap cases                                                              IRRAD.3111  
C                                                                            IRRAD.3112  
C INPUT:  Band index (IBND)                                                  IRRAD.3113  
C         Absorber amount (UPATH)                                            IRRAD.3114  
C OUTPUT: Halocarbon Transmittance (HALTRAN)                                 IRRAD.3115  
                                                                             IRRAD.3116  
      IMPLICIT NONE                                                          IRRAD.3117  
                                                                             IRRAD.3118  
C Input Variables                                                            IRRAD.3119  
C-----------------                                                           IRRAD.3120  
                                                                             IRRAD.3121  
      INTEGER IBND                                                           IRRAD.3122  
      REAL UPATH                                                             IRRAD.3123  
                                                                             IRRAD.3124  
                                                                             IRRAD.3125  
C Internal Variables                                                         IRRAD.3126  
C--------------------                                                        IRRAD.3127  
                                                                             IRRAD.3128  
      REAL ALPHA(4)                                                          IRRAD.3129  
                                                                             IRRAD.3130  
      DATA ALPHA(1), ALPHA(2), ALPHA(3), ALPHA(4) /                          IRRAD.3131  
     $     1.300D+05, 1.200D+05, 1.200D+05, 1.133D+05/                       IRRAD.3132  
                                                                             IRRAD.3133  
      IF (IBND.EQ.9) THEN                                                    IRRAD.3134  
         HALTRAN=1.0-ALPHA(1)*UPATH                                          IRRAD.3135  
      END IF                                                                 IRRAD.3136  
                                                                             IRRAD.3137  
      IF (IBND.EQ.10) THEN                                                   IRRAD.3138  
         HALTRAN=1.0-ALPHA(2)*UPATH                                          IRRAD.3139  
      END IF                                                                 IRRAD.3140  
                                                                             IRRAD.3141  
      IF (IBND.EQ.11) THEN                                                   IRRAD.3142  
         HALTRAN=1.0-ALPHA(3)*UPATH                                          IRRAD.3143  
      END IF                                                                 IRRAD.3144  
                                                                             IRRAD.3145  
      IF (IBND.EQ.12) THEN                                                   IRRAD.3146  
         HALTRAN=1.0-ALPHA(4)*UPATH                                          IRRAD.3147  
      END IF                                                                 IRRAD.3148  
                                                                             IRRAD.3149  
      END                                                                    IRRAD.3150  
                                                                             IRRAD.3151  
                                                                             IRRAD.3152  
C***********************************************************************     IRRAD.3153  
C*                                                                     *     IRRAD.3154  
C*                         SUBROUTINE GASCNT                           *     IRRAD.3155  
C*                                                                     *     IRRAD.3156  
C***********************************************************************     IRRAD.3157  
                                                                             IRRAD.3158  
      SUBROUTINE GASCNT(IBND,WVEFF,TEFF,TRCNT)                               IRRAD.3159  
                                                                             IRRAD.3160  
C Subroutine GASCNT calculates the self-broadened continuum                  IRRAD.3161  
C transmittance in the bands of gases                                        IRRAD.3162  
C                                                                            IRRAD.3163  
C INPUT:  Band index (IBND)                                                  IRRAD.3164  
C         Effective H2O amount for continuum absorption (WVEFF)              IRRAD.3165  
C         Effective temperature (TEFF)                                       IRRAD.3166  
C                                                                            IRRAD.3167  
C OUTPUT: Self-broadened continuum transmittance (TRCNT)                     IRRAD.3168  
                                                                             IRRAD.3169  
      IMPLICIT NONE                                                          IRRAD.3170  
                                                                             IRRAD.3171  
C-----------------                                                           IRRAD.3172  
C Input Variables                                                            IRRAD.3173  
C-----------------                                                           IRRAD.3174  
                                                                             IRRAD.3175  
      INTEGER IBND                                                           IRRAD.3176  
      REAL WVEFF,TEFF                                                        IRRAD.3177  
                                                                             IRRAD.3178  
C-----------------                                                           IRRAD.3179  
C Output Variable                                                            IRRAD.3180  
C-----------------                                                           IRRAD.3181  
                                                                             IRRAD.3182  
      REAL TRCNT                                                             IRRAD.3183  
                                                                             IRRAD.3184  
C--------------------                                                        IRRAD.3185  
C Internal Variables                                                         IRRAD.3186  
C--------------------                                                        IRRAD.3187  
                                                                             IRRAD.3188  
      REAL BND1    ! Abs. Xsection in band 1                                 IRRAD.3189  
      REAL BND2    ! Abs. Xection  in band 2                                 IRRAD.3190  
      REAL BND3    ! Abs. Xsection in band 3                                 IRRAD.3191  
      REAL BND4    ! Abs. Xsection in band 4                                 IRRAD.3192  
      REAL BND5    ! Abs. Xsection in band 5                                 IRRAD.3193  
      REAL BND6    ! Abs. Xsection in band 6                                 IRRAD.3194  
      REAL BND7    ! Abs. Xsection in band 7                                 IRRAD.3195  
      REAL BND8    ! Abs. Xsection in band 8                                 IRRAD.3196  
      REAL BND9    ! Abs. Xsection in band 9                                 IRRAD.3197  
                                                                             IRRAD.3198  
      DATA BND1, BND2 / 5.47, 0.83 /                                         IRRAD.3199  
      DATA BND3, BND4 / 2.03, 0.13 /                                         IRRAD.3200  
      DATA BND5, BND6 / 1.33, 3.99 /                                         IRRAD.3201  
      DATA BND7, BND8, BND9 / 8.61, 0.65, 1.86 /                             IRRAD.3202  
                                                                             IRRAD.3203  
C--- Band 1                                                                  IRRAD.3204  
      IF (IBND.EQ.1) THEN                                                    IRRAD.3205  
         TRCNT=EXP(-WVEFF*BND1)                                              IRRAD.3206  
      END IF                                                                 IRRAD.3207  
                                                                             IRRAD.3208  
C--- Band 2                                                                  IRRAD.3209  
      IF (IBND.EQ.2) THEN                                                    IRRAD.3210  
         TRCNT=EXP(-WVEFF*BND2)                                              IRRAD.3211  
      END IF                                                                 IRRAD.3212  
                                                                             IRRAD.3213  
C--- Band 3                                                                  IRRAD.3214  
      IF (IBND.EQ.3) THEN                                                    IRRAD.3215  
         TRCNT=EXP(-WVEFF*BND3)                                              IRRAD.3216  
      END IF                                                                 IRRAD.3217  
                                                                             IRRAD.3218  
C--- Band 4                                                                  IRRAD.3219  
      IF (IBND.EQ.4) THEN                                                    IRRAD.3220  
         TRCNT=EXP(-WVEFF*BND4)                                              IRRAD.3221  
      END IF                                                                 IRRAD.3222  
                                                                             IRRAD.3223  
C--- Band 5                                                                  IRRAD.3224  
      IF (IBND.EQ.5) THEN                                                    IRRAD.3225  
         TRCNT=EXP(-WVEFF*BND5)                                              IRRAD.3226  
      END IF                                                                 IRRAD.3227  
                                                                             IRRAD.3228  
C--- Band 6                                                                  IRRAD.3229  
      IF (IBND.EQ.6) THEN                                                    IRRAD.3230  
         TRCNT=EXP(-WVEFF*BND6)                                              IRRAD.3231  
      END IF                                                                 IRRAD.3232  
                                                                             IRRAD.3233  
C--- Band 7                                                                  IRRAD.3234  
      IF (IBND.EQ.7) THEN                                                    IRRAD.3235  
         TRCNT=EXP(-WVEFF*BND7)                                              IRRAD.3236  
      END IF                                                                 IRRAD.3237  
                                                                             IRRAD.3238  
C--- Band 8                                                                  IRRAD.3239  
      IF (IBND.EQ.8) THEN                                                    IRRAD.3240  
         TRCNT=EXP(-WVEFF*BND8)                                              IRRAD.3241  
      END IF                                                                 IRRAD.3242  
C--- Band 9                                                                  IRRAD.3243  
      IF (IBND.EQ.9) THEN                                                    IRRAD.3244  
         TRCNT=EXP(-WVEFF*BND9)                                              IRRAD.3245  
      END IF                                                                 IRRAD.3246  
                                                                             IRRAD.3247  
      END                                                                    IRRAD.3248  
                                                                             IRRAD.3249  
                                                                             IRRAD.3250  
C***********************************************************************     IRRAD.3251  
C*                                                                     *     IRRAD.3252  
C*                         SUBROUTINE SMFLUX                           *     IRRAD.3253  
C*                                                                     *     IRRAD.3254  
C***********************************************************************     IRRAD.3255  
                                                                             IRRAD.3256  
      SUBROUTINE SMFLUX(NLEV,PFLUX,FLUX)                                     IRRAD.3257  
                                                                             IRRAD.3258  
C Subroutine SMFLUX smooths out the flux profiles, assuming that             IRRAD.3259  
C the fluxes in an atmospheric layers of a certain thickness above and       IRRAD.3260  
C below an atmospheric level vary as   FLUX = A0 + A1*P + A2*(P**2)          IRRAD.3261  
C                                                                            IRRAD.3262  
C INPUT:  Number of levels in the atmosphere without the surface (NLEV)      IRRAD.3263  
C         Pressure at each level (PFLUX)                                     IRRAD.3264  
C         Irradiance at each mid-level (FUP)                                 IRRAD.3265  
C                                                                            IRRAD.3266  
C OUTPUT: Smoothed upward and downward irradiances at                        IRRAD.3267  
C         each level (FUP,FDWN)                                              IRRAD.3268  
                                                                             IRRAD.3269  
      IMPLICIT NONE                                                          IRRAD.3270  
C***********************************************************************     PARRAY.2     
C*                                                                     *     PARRAY.3     
C*                         P A R R A Y                                 *     PARRAY.4     
C*                                                                     *     PARRAY.5     
C***********************************************************************     PARRAY.6     
C-----------------------------------------------------------------------     PARRAY.7     
C In this part of the code the user can set the dimensions of arrays         PARRAY.8     
C used for the calculations, by setting the values in the paramter           PARRAY.9     
C statements                                                                 PARRAY.10    
C-----------------------------------------------------------------------     PARRAY.11    
                                                                             PARRAY.12    
      INTEGER MXGAS,MXLEV,MXBAND,MXCL                                        PARRAY.13    
                                                                             PARRAY.14    
      PARAMETER(MXGAS=8)     ! Maximum number of gases                       PARRAY.15    
                                                                             PARRAY.16    
      PARAMETER(MXLEV=5)     ! Maximum number of levels in the               NETCDF.37    
                             ! atmosphere (not including the surface)        PARRAY.18    
                                                                             PARRAY.19    
      PARAMETER(MXBAND=9)    ! Maximum number of spectral bands (not         PARRAY.20    
                             ! including the whole spectrum, 0-3000cm-1)     PARRAY.21    
                                                                             PARRAY.22    
      PARAMETER(MXCL=3)      ! Maximum number of cloud types                 PARRAY.23    
                                                                             PARRAY.24    
C-----------------------------------------------------------------------     PARRAY.25    
                                                                             IRRAD.3272  
C-----------------                                                           IRRAD.3273  
C Input Variables                                                            IRRAD.3274  
C-----------------                                                           IRRAD.3275  
                                                                             IRRAD.3276  
      INTEGER NLEV                                                           IRRAD.3277  
      REAL PFLUX(0:MXLEV),FLUX(0:MXLEV)                                      IRRAD.3278  
                                                                             IRRAD.3279  
C--------------------                                                        IRRAD.3280  
C Internal Variables                                                         IRRAD.3281  
C--------------------                                                        IRRAD.3282  
                                                                             IRRAD.3283  
      INTEGER ILAY,ILEV,KOUNTSM                                              IRRAD.3284  
      REAL THICKN    ! Thickness of a layer above/below a level in mb        IRRAD.3285  
      REAL DET,A0(0:MXLEV),A1(0:MXLEV),A2(0:MXLEV)                           IRRAD.3286  
      INTEGER SN                               ! Sums used for least         IRRAD.3287  
      REAL SX,SX2,SX3,SX4,SX2Y,SXY,SY        ! square fit method             IRRAD.3288  
                                                                             IRRAD.3289  
                                                                             IRRAD.3290  
C--- Set the thickness of the layers in which regression is performed        IRRAD.3291  
                                                                             IRRAD.3292  
      IF (NLEV.GT.30) THEN                                                   IRRAD.3293  
         THICKN=75.0                                                         IRRAD.3294  
      ELSE                                                                   IRRAD.3295  
         THICKN=100.0                                                        IRRAD.3296  
      ENDIF                                                                  IRRAD.3297  
                                                                             IRRAD.3298  
C--- Calculate regression coefficients for the first atmospheric level       IRRAD.3299  
                                                                             IRRAD.3300  
      SN=0                                                                   IRRAD.3301  
      SX=0.0                                                                 IRRAD.3302  
      SX2=0.0                                                                IRRAD.3303  
      SX3=0.0                                                                IRRAD.3304  
      SX4=0.0                                                                IRRAD.3305  
      SX2Y=0.0                                                               IRRAD.3306  
      SXY=0.0                                                                IRRAD.3307  
      SY=0.0                                                                 IRRAD.3308  
                                                                             IRRAD.3309  
      DO ILAY=0,NLEV                                                         IRRAD.3310  
         IF ((PFLUX(0)-PFLUX(ILAY)).LE.100.0) THEN                           IRRAD.3311  
            SN=SN+1                                                          IRRAD.3312  
            SX=SX+PFLUX(ILAY)                                                IRRAD.3313  
            SX2=SX2+(PFLUX(ILAY)**2)                                         IRRAD.3314  
            SX3=SX3+(PFLUX(ILAY)**3)                                         IRRAD.3315  
            SX4=SX4+(PFLUX(ILAY)**4)                                         IRRAD.3316  
            SX2Y=SX2Y+((PFLUX(ILAY)**2)*FLUX(ILAY))                          IRRAD.3317  
            SXY=SXY+(PFLUX(ILAY)*FLUX(ILAY))                                 IRRAD.3318  
            SY=SY+FLUX(ILAY)                                                 IRRAD.3319  
         END IF                                                              IRRAD.3320  
      END DO                                                                 IRRAD.3321  
                                                                             IRRAD.3322  
      DET=(SX2**3)+(SX*SX*SX4)+(SN*SX3*SX3)-                                 IRRAD.3323  
     $     SX2*(SN*SX4+2*SX*SX3)                                             IRRAD.3324  
                                                                             IRRAD.3325  
      IF ((DET.EQ.0.0).OR.(SN.LE.2)) THEN                                    IRRAD.3326  
         SN=0                                                                IRRAD.3327  
         SX=0.0                                                              IRRAD.3328  
         SX2=0.0                                                             IRRAD.3329  
         SX3=0.0                                                             IRRAD.3330  
         SX4=0.0                                                             IRRAD.3331  
         SX2Y=0.0                                                            IRRAD.3332  
         SXY=0.0                                                             IRRAD.3333  
         SY=0.0                                                              IRRAD.3334  
         DO ILAY=0,2                                                         IRRAD.3335  
            SN=SN+1                                                          IRRAD.3336  
            SX=SX+PFLUX(ILAY)                                                IRRAD.3337  
            SX2=SX2+(PFLUX(ILAY)**2)                                         IRRAD.3338  
            SX3=SX3+(PFLUX(ILAY)**3)                                         IRRAD.3339  
            SX4=SX4+(PFLUX(ILAY)**4)                                         IRRAD.3340  
            SX2Y=SX2Y+((PFLUX(ILAY)**2)*FLUX(ILAY))                          IRRAD.3341  
            SXY=SXY+(PFLUX(ILAY)*FLUX(ILAY))                                 IRRAD.3342  
            SY=SY+FLUX(ILAY)                                                 IRRAD.3343  
         END DO                                                              IRRAD.3344  
         DET=(SX2**3)+(SX*SX*SX4)+(SN*SX3*SX3)-                              IRRAD.3345  
     $        SX2*(SN*SX4+2*SX*SX3)                                          IRRAD.3346  
      END IF                                                                 IRRAD.3347  
                                                                             IRRAD.3348  
      A0(0)=(SX2*SX2*SX2Y)+SX4*(SX*SXY-SX2*SY)+                              IRRAD.3349  
     $       SX3*(SY*SX3-SXY*SX2-SX2Y*SX)                                    IRRAD.3350  
                                                                             IRRAD.3351  
      A1(0)=(SX*SY*SX4)+SN*(SX3*SX2Y-SX4*SXY)+                               IRRAD.3352  
     $       SX2*(SXY*SX2-SX*SX2Y-SX3*SY)                                    IRRAD.3353  
                                                                             IRRAD.3354  
      A2(0)=(SY*SX2*SX2)+SN*(SXY*SX3-SX2*SX2Y)+                              IRRAD.3355  
     $       SX*(SX*SX2Y-SX3*SY-SX2*SXY)                                     IRRAD.3356  
                                                                             IRRAD.3357  
      A0(0)=A0(0)/DET                                                        IRRAD.3358  
      A1(0)=A1(0)/DET                                                        IRRAD.3359  
      A2(0)=A2(0)/DET                                                        IRRAD.3360  
                                                                             IRRAD.3361  
C--- Calculate regression coefficients for the upper atmospheric level       IRRAD.3362  
                                                                             IRRAD.3363  
      SN=0.0                                                                 IRRAD.3364  
      SX=0.0                                                                 IRRAD.3365  
      SX2=0.0                                                                IRRAD.3366  
      SX3=0.0                                                                IRRAD.3367  
      SX4=0.0                                                                IRRAD.3368  
      SX2Y=0.0                                                               IRRAD.3369  
      SXY=0.0                                                                IRRAD.3370  
      SY=0.0                                                                 IRRAD.3371  
                                                                             IRRAD.3372  
      DO ILAY=1,NLEV                                                         IRRAD.3373  
         IF ((PFLUX(ILAY)-PFLUX(NLEV)).LE.200.0) THEN                        IRRAD.3374  
            SN=SN+1                                                          IRRAD.3375  
            SX=SX+PFLUX(ILAY)                                                IRRAD.3376  
            SX2=SX2+(PFLUX(ILAY)**2)                                         IRRAD.3377  
            SX3=SX3+(PFLUX(ILAY)**3)                                         IRRAD.3378  
            SX4=SX4+(PFLUX(ILAY)**4)                                         IRRAD.3379  
            SX2Y=SX2Y+((PFLUX(ILAY)**2)*FLUX(ILAY))                          IRRAD.3380  
            SXY=SXY+(PFLUX(ILAY)*FLUX(ILAY))                                 IRRAD.3381  
            SY=SY+FLUX(ILAY)                                                 IRRAD.3382  
         END IF                                                              IRRAD.3383  
      END DO                                                                 IRRAD.3384  
                                                                             IRRAD.3385  
      DET=(SX2**3)+(SX*SX*SX4)+(SN*SX3*SX3)-                                 IRRAD.3386  
     $     SX2*(SN*SX4+2*SX*SX3)                                             IRRAD.3387  
      IF ((DET.EQ.0.0).OR.(SN.LE.2)) THEN                                    IRRAD.3388  
         SN=0.0                                                              IRRAD.3389  
         SX=0.0                                                              IRRAD.3390  
         SX2=0.0                                                             IRRAD.3391  
         SX3=0.0                                                             IRRAD.3392  
         SX4=0.0                                                             IRRAD.3393  
         SX2Y=0.0                                                            IRRAD.3394  
         SXY=0.0                                                             IRRAD.3395  
         SY=0.0                                                              IRRAD.3396  
         DO ILAY=NLEV-2,NLEV                                                 IRRAD.3397  
            SN=SN+1                                                          IRRAD.3398  
            SX=SX+PFLUX(ILAY)                                                IRRAD.3399  
            SX2=SX2+(PFLUX(ILAY)**2)                                         IRRAD.3400  
            SX3=SX3+(PFLUX(ILAY)**3)                                         IRRAD.3401  
            SX4=SX4+(PFLUX(ILAY)**4)                                         IRRAD.3402  
            SX2Y=SX2Y+((PFLUX(ILAY)**2)*FLUX(ILAY))                          IRRAD.3403  
            SXY=SXY+(PFLUX(ILAY)*FLUX(ILAY))                                 IRRAD.3404  
            SY=SY+FLUX(ILAY)                                                 IRRAD.3405  
         END DO                                                              IRRAD.3406  
         DET=(SX2**3)+(SX*SX*SX4)+(SN*SX3*SX3)-                              IRRAD.3407  
     $        SX2*(SN*SX4+2*SX*SX3)                                          IRRAD.3408  
      END IF                                                                 IRRAD.3409  
                                                                             IRRAD.3410  
      A0(NLEV)=(SX2*SX2*SX2Y)+SX4*(SX*SXY-SX2*SY)+                           IRRAD.3411  
     $          SX3*(SY*SX3-SXY*SX2-SX2Y*SX)                                 IRRAD.3412  
                                                                             IRRAD.3413  
      A1(NLEV)=(SX*SY*SX4)+SN*(SX3*SX2Y-SX4*SXY)+                            IRRAD.3414  
     $          SX2*(SXY*SX2-SX*SX2Y-SX3*SY)                                 IRRAD.3415  
                                                                             IRRAD.3416  
      A2(NLEV)=(SY*SX2*SX2)+SN*(SXY*SX3-SX2*SX2Y)+                           IRRAD.3417  
     $          SX*(SX*SX2Y-SX3*SY-SX2*SXY)                                  IRRAD.3418  
                                                                             IRRAD.3419  
      A0(NLEV)=A0(NLEV)/DET                                                  IRRAD.3420  
      A1(NLEV)=A1(NLEV)/DET                                                  IRRAD.3421  
      A2(NLEV)=A2(NLEV)/DET                                                  IRRAD.3422  
                                                                             IRRAD.3423  
C--- Calculate regression coefficients for the rest of the levels            IRRAD.3424  
                                                                             IRRAD.3425  
      DO ILAY=1,NLEV-1                                                       IRRAD.3426  
                                                                             IRRAD.3427  
         KOUNTSM=0.                                                          IRRAD.3428  
                                                                             IRRAD.3429  
 1997    CONTINUE                                                            IRRAD.3430  
                                                                             IRRAD.3431  
         SN=0                                                                IRRAD.3432  
         SX=0.0                                                              IRRAD.3433  
         SX2=0.0                                                             IRRAD.3434  
         SX3=0.0                                                             IRRAD.3435  
         SX4=0.0                                                             IRRAD.3436  
         SX2Y=0.0                                                            IRRAD.3437  
         SXY=0.0                                                             IRRAD.3438  
         SY=0.0                                                              IRRAD.3439  
                                                                             IRRAD.3440  
         DO ILEV=0,NLEV                                                      IRRAD.3441  
            IF (ABS(PFLUX(ILAY)-PFLUX(ILEV)).LE.THICKN) THEN                 IRRAD.3442  
               SN=SN+1                                                       IRRAD.3443  
               SX=SX+PFLUX(ILEV)                                             IRRAD.3444  
               SX2=SX2+(PFLUX(ILEV)**2)                                      IRRAD.3445  
               SX3=SX3+(PFLUX(ILEV)**3)                                      IRRAD.3446  
               SX4=SX4+(PFLUX(ILEV)**4)                                      IRRAD.3447  
               SX2Y=SX2Y+((PFLUX(ILEV)**2)*FLUX(ILEV))                       IRRAD.3448  
               SXY=SXY+(PFLUX(ILEV)*FLUX(ILEV))                              IRRAD.3449  
               SY=SY+FLUX(ILEV)                                              IRRAD.3450  
            END IF                                                           IRRAD.3451  
         END DO                                                              IRRAD.3452  
                                                                             IRRAD.3453  
         DET=(SX2**3)+(SX*SX*SX4)+(SN*SX3*SX3)-                              IRRAD.3454  
     $        SX2*(SN*SX4+2*SX*SX3)                                          IRRAD.3455  
                                                                             IRRAD.3456  
         IF ((DET.EQ.0.0).OR.(SN.LE.2)) THEN                                 IRRAD.3457  
            KOUNTSM=KOUNTSM+1                                                IRRAD.3458  
            IF (KOUNTSM.GT.5)THEN                                            IRRAD.3459  
               WRITE(2,*)'SUBROUTINE SMFLUX STUCK IN INFINITE                IRRAD.3460  
     $                    LOOP. ABORT.'                                      IRRAD.3461  
               CALL ABORT                                                    IRRAD.3462  
            ENDIF                                                            IRRAD.3463  
            THICKN=THICKN+100.0                                              IRRAD.3464  
            GOTO 1997                                                        IRRAD.3465  
         END IF                                                              IRRAD.3466  
                                                                             IRRAD.3467  
         A0(ILAY)=(SX2*SX2*SX2Y)+SX4*(SX*SXY-SX2*SY)+                        IRRAD.3468  
     $             SX3*(SY*SX3-SXY*SX2-SX2Y*SX)                              IRRAD.3469  
                                                                             IRRAD.3470  
         A1(ILAY)=(SX*SY*SX4)+SN*(SX3*SX2Y-SX4*SXY)+                         IRRAD.3471  
     $             SX2*(SXY*SX2-SX*SX2Y-SX3*SY)                              IRRAD.3472  
                                                                             IRRAD.3473  
         A2(ILAY)=(SY*SX2*SX2)+SN*(SXY*SX3-SX2*SX2Y)+                        IRRAD.3474  
     $             SX*(SX*SX2Y-SX3*SY-SX2*SXY)                               IRRAD.3475  
                                                                             IRRAD.3476  
         A0(ILAY)=A0(ILAY)/DET                                               IRRAD.3477  
         A1(ILAY)=A1(ILAY)/DET                                               IRRAD.3478  
         A2(ILAY)=A2(ILAY)/DET                                               IRRAD.3479  
                                                                             IRRAD.3480  
      END DO                                                                 IRRAD.3481  
                                                                             IRRAD.3482  
      DO ILAY=0,NLEV                                                         IRRAD.3483  
         FLUX(ILAY)=A0(ILAY)+PFLUX(ILAY)*(A1(ILAY)+                          IRRAD.3484  
     $              A2(ILAY)*PFLUX(ILAY))                                    IRRAD.3485  
         IF (FLUX(ILAY).LT.0.0) THEN                                         IRRAD.3486  
            FLUX(ILAY)=0.0                                                   IRRAD.3487  
         END IF                                                              IRRAD.3488  
      END DO                                                                 IRRAD.3489  
                                                                             IRRAD.3490  
                                                                             IRRAD.3491  
      END                                                                    IRRAD.3492  
