*=*=*=*= RADITE.html =*=*=*=*
SUBROUTINE RADITE

SUBROUTINE RADITE


      SUBROUTINE RADITE(ig0,icount
     .  , KDLON, KFLEV, KMODE, KFLUX, KRAD, KAER
     .  , PAER, PALBS, PCCO2, PCLFR, PEMIS, PMU0, POZON
     S  , PPRES, PPRESF, PQS, PQW, PQ, PTH, PTS, PT, PVIEW
     S  , PDTLOG, PDTSOL, PCLLOG, PCLSOL, PFLUX, PRAD, PRADC
     S  , PFRACT,PORB
     .  , netrad)

      implicit none

#include "dimensions.h"
#include "dimphys.h"
#include "dimradmars.h"
#include "comg1d.h"
#include "callkeys.h"
C
C**** *RADITE* - RADIATION INTERFACE
C
C     PURPOSE.
C     --------
C           CONTROLS RADIATION COMPUTATIONS
C
C**   INTERFACE.
C     ----------
C     *CALL*           ( KDLON, KFLEV, KMODE, KFLUX, KRAD, KAER
C    S  , PAER, PALBS, PCCO2, PCLFR, PEMIS, PMU0, POZON
C    S  , PPRES, PPRESF, PQS, PQW, PQ, PTH, PTS, PT, PVIEW
C    S  , PDTLOG, PDTSOL, PCLLOG, PCLSOL, PFLUX, PRAD, PRADC )
C
C        EXPLICIT ARGUMENTS :
C        --------------------
C PMU0   : (KDLON)             ; SOLAR ANGLE
C PEMIS  : (KDLON)             ; SURFACE EMISSIVITY
C PALBS  : (KDLON,2)           ; ALBEDO IN THE TWO INTERVALS .25-.68 AND .68-4.
C PCCO2  :                     ; CONCENTRATION IN CO2 (PA/PA)
C POZON  : (KDLON,KFLEV)       ; CONCENTRATION IN OZONE (PA/PA)
C PTS    : (KDLON)             ; SURFACE TEMPERATURE
C PT     : (KDLON,KFLEV)       ; TEMPERATURE
C PTH    : (KDLON,0:KFLEV)     ; HALF LEVEL TEMPERATURE
C PPRES  : (KDLON,0:KFLEV)     ; HALF LEVEL PRESSURE
C PPRESF : (KDLON,KFLEV)       ; FULL LEVEL PRESSURE
C PQ     : (NDLON,KFLEV)       ; SPECIFIC HUMIDITY PA/PA
C PQW    : (KDLON,KFLEV)       ; LIQUID WATER KG/KG
C PQS    : (KDLON,KFLEV)       ; SOLID  WATER KG/KG
C PCLFR  : (KDLON,KFLEV)       ; CLOUD FRACTIONAL COVER
C PAER   : (KDLON,KFLEV,5)     ; OPTICAL THICKNESS OF THE AEROSOLS
C PVIEW  : (KDLON)             ; COSECANT OF VIEWING ANGLE
C     ==== OUTPUTS ===
C PDTLOG(KDLON,KFLEV)          ; LONG-WAVE TENDENCY
C PDTSOL(KDLON,KFLEV)          ; SHORT-WAVE TENDENCY
C PCLLOG(KDLON,KFLEV)          ; LONG-WAVE TENDENCY CLEAR SKY
C PCLSOL(KDLON,KFLEV)          ; SHORT-WAVE TENDENCY CLEAR SKY
C  IF KMODE = 0
C PFLUX(KDLON,KFLEV,KFLUX)     ; RADIATIVE FLUXES :
C                     1  ==>  UPWARD   FLUX TOTAL     LW
C                     2  ==>  UPWARD   FLUX TOTAL     SW VISIBLE
C                     3  ==>  UPWARD   FLUX TOTAL     SW NEAR IR
C                     4  ==>  DOWNWARD FLUX TOTAL     LW
C                     5  ==>  DOWNWARD   FLUX TOTAL     SW VISIBLE
C                     6  ==>  DOWNWARD   FLUX TOTAL     SW NEAR IR
C PDTLOG(KDLON,KFLEV)          ; LONG-WAVE TENDENCY
C PDTSOL(KDLON,KFLEV)          ; SHORT-WAVE TENDENCY
C  IF KMODE = 1
C PFLUX(KDLON,KFLEV,KFLUX)     ; RADIATIVE FLUXES :
C                     1  ==>  UPWARD   FLUX TOTAL     LW
C                     2  ==>  UPWARD   FLUX TOTAL     SW VISIBLE
C                     3  ==>  UPWARD   FLUX TOTAL     SW NEAR IR
C                     4  ==>  DOWNWARD FLUX TOTAL     LW
C                     5  ==>  DOWNWARD   FLUX TOTAL     SW VISIBLE
C                     6  ==>  DOWNWARD   FLUX TOTAL     SW NEAR IR
C                     7  ==>  UPWARD   FLUX CLEAR SKY LW
C                     8  ==>  UPWARD   FLUX CLEAR SKY SW VISIBLE
C                     9  ==>  UPWARD   FLUX CLEAR SKY SW NEAR IR
C                    10  ==>  DOWNWARD FLUX CLEAR SKY LW
C                    11  ==>  DOWNWARD   FLUX CLEAR SKY SW VISIBLE
C                    12  ==>  DOWNWARD   FLUX CLEAR SKY SW NEAR IR
C PDTLOG(KDLON,KFLEV)          ; LONG-WAVE TENDENCY
C PDTSOL(KDLON,KFLEV)          ; SHORT-WAVE TENDENCY
C PCLLOG(KDLON,KFLEV)          ; LONG-WAVE TENDENCY CLEAR SKY
C PCLSOL(KDLON,KFLEV)          ; SHORT-WAVE TENDENCY CLEAR SKY
C  IF KMODE = 2
C AS 1 BUT IN ADDITION THE RADIANCES :
C PRAD (KDLON,KRAD)            ; RADIANCES
C PRADC(KDLON,KRAD)            ; CLEAR SKY RADIANCES
C  IF KMODE = 3
C ONLY THE RADIANCES :
C PRAD (KDLON,KRAD)            ; RADIANCES
C PRADC(KDLON,KRAD)            ; CLEAR SKY RADIANCES
C
C        IMPLICIT ARGUMENTS :   NONE
C        --------------------
C
C     METHOD.
C     -------
C        SEE DOCUMENTATION
C
C     EXTERNALS.
C     ----------
C
C     REFERENCE.
C     ----------
C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE
C     "IN CORE MODEL"
C
C     AUTHORS.
C     --------
C        JEAN-JACQUES MORCRETTE  *ECMWF*
c   modif: 15/10/93 Frederic Hourdin.
c    adaptation to Mars. Change of the a vertical indices for
c   pt,pth,ppres,prresf
C
C     MODIFICATIONS.
C     --------------
C        ORIGINAL : 88-02-04
C-----------------------------------------------------------------------
C
C
C*COPY,PARDIM
C*COPY,YOMDIM
C*COPY YOMPHY
C
#include "yomphy.h"
#include "yomcst.h"
#include "yomrad.h"
#include "yomaer.h"
#include "yomlw.h"
#include "yomsw.h"
#include "yomrdu.h"
C
C-----------------------------------------------------------------------
C
C
C*       0.1   ARGUMENTS.
C              ----------

c     SUBROUTINE RADITE(ig0,icount
c    .  , KDLON, KFLEV, KMODE, KFLUX, KRAD, KAER
c    .  , PAER, PALBS, PCCO2, PCLFR, PEMIS, PMU0, POZON
c    S  , PPRES, PPRESF, PQS, PQW, PQ, PTH, PTS, PT, PVIEW
c    S  , PDTLOG, PDTSOL, PCLLOG, PCLSOL, PFLUX, PRAD, PRADC
c    S  , PFRACT,PORB
c    .  , netrad)

      integer ig0
      integer icount
      integer kdlon            ! part of ngrid
      integer kflev            ! part of nlayer
      integer kmode            !
      integer kflux            !
      integer krad             !
      integer kaer             !

      real porb

      REAL PEMIS(NDLO2),PALBS(NDLO2,2)
      REAL PMU0(NDLO2)
      REAL PCCO2,POZON(NDLO2,KFLEV)
      REAL PTS(NDLO2)
      REAL PT(NDLO2,KFLEV)
      REAL PTH(NDLO2,KFLEV+1)
      REAL PPRES(NDLO2,KFLEV+1),PPRESF(NDLO2,KFLEV)
      REAL PQ(NDLO2,KFLEV)
      REAL PQW(NDLO2,KFLEV),PQS(NDLO2,KFLEV)
      REAL PCLFR(NDLO2,KFLEV)
      REAL PAER(NDLO2,KFLEV,5)
      REAL PVIEW(NDLO2)
      REAL PFRACT(NDLO2)
C     ==== COMPUTED IN RADITE ===
      REAL PDTLOG(NDLO2,KFLEV),PDTSOL(NDLO2,KFLEV)
      REAL PCLLOG(NDLO2,KFLEV),PCLSOL(NDLO2,KFLEV)

      REAL PFLUX(NDLO2,KFLUX)
      REAL PRAD(NDLO2,KRAD)
      REAL PRADC(NDLO2,KRAD)
      real netrad (ndlo2,kflev)     ! radiative budget (W/m2)

C
C     -----------------------------------------------------------------
C
C*       0.2   LOCAL ARRAYS.
C              -------------
C     -----------------------------------------------------------------
C
C-- ARRAYS FOR LOCAL VARIABLES -----------------------------------------
C

      integer jflux,jl,jrad,jk,jkp1,jkl,jklp1,jf,jr,ig1,jae
      logical lorad,lo1

      logical firstcall
      save firstcall
      data firstcall/.true./

      real zlwgkg
      real zfcca
      real zfccb
      real zfcc
      real zradef
      real ztaueq
      real zrmuz
      real pcst
      real cvmgt

      REAL
     *    ZALBSU(NDLON,2    ) ,ZCG   (NDLON,2,NFLEV),ZCLDLW(NDLON,NFLEV)
     *  , ZCLDSW(NDLON,NFLEV) ,ZCLD0(NDLON,NFLEV)   ,ZDP   (NDLON,NFLEV)
     *  , ZDT0(NDLON)         ,ZEMD  (NDLON,NFLEV)  ,ZEMU  (NDLON,NFLEV)
     *  , ZFDD(NDLON)         ,ZFLUX (NDLON,2,NFLEV+1)
     *  , ZFLUXC(NDLON,2,NFLEV+1)                   ,ZFLWP (NDLON)
     *  , ZOMEGA(NDLON,2,NFLEV+1),ZOZ(NDLON,NFLEV),ZPMB(NDLON,NFLEV+1)
     *  , ZPSOL(NDLON),ZTAU (NDLON,2,NFLEV),ZTAVE (NDLON,NFLEV)
     *  , ZTL(NDLON,NFLEV+1),ZFSDWN(NDLON,NFLEV+1) ,ZFSUP(NDLON,NFLEV+1)
     *  , ZFSUPN(NDLON)        , ZFSUPV(NDLON)
     *  , ZFCUPN(NDLON)        , ZFCUPV(NDLON)
     *  , ZFSDNN(NDLON)        , ZFSDNV(NDLON)
     *  , ZFCDNN(NDLON)        , ZFCDNV(NDLON)

C
C-----------------------------------------------------------------------
C
C     -----------------------------------------------------------------
C
C*       0.3   SET-UP RADIATION ROUTINE COEFFICIENTS
C              -------------------------------------
C
  30  CONTINUE
C
      if (firstcall) then
        firstcall = .false.
        IF(NDLON.NE.KDLON) THEN
          PRINT*,'WARNING!!! dans radite'
          PRINT*,'Probleme de dimensions'
          PRINT*,'NDLON = ',NDLON
          PRINT*,'KDLON = ',KDLON
        endif
      endif
c
      LORAD = .TRUE.
C
C
C     ------------------------------------------------------------------
C
C*         1.     SET-UP INPUT QUANTITIES FOR RADIATION
C                 -------------------------------------
C
 100  CONTINUE
C
      DO 102 JFLUX = 1 , KFLUX
      DO 101 JL = 1 , KDLON
      PFLUX (JL,JFLUX) = 0.
 101  CONTINUE
 102  CONTINUE
C
      DO 104 JRAD = 1 , KRAD
      DO 103 JL = 1 , KDLON
      PRAD (JL,JRAD) = 0.
      PRADC(JL,JRAD) = 0.
 103  CONTINUE
 104  CONTINUE
C
      DO 106 JK = 1 , KFLEV
      DO 105 JL = 1 , KDLON
      PDTLOG(JL,JK) = 0.
      PDTSOL(JL,JK) = 0.
      PCLLOG(JL,JK) = 0.
      PCLSOL(JL,JK) = 0.
 105  CONTINUE
 106  CONTINUE
C
      DO 107 JL = 1 , KDLON
      ZFSUP(JL,KFLEV+1) = 0.
      ZFSDWN(JL,KFLEV+1) = ZEELOG
      ZFLUX(JL,1,KFLEV+1) = 0.
      ZFLUX(JL,2,KFLEV+1) = 0.
      ZFLUXC(JL,1,KFLEV+1) = 0.
      ZFLUXC(JL,2,KFLEV+1) = 0.
      ZFSDNN(JL) = 0.
      ZFSDNV(JL) = 0.
      ZFCDNN(JL) = 0.
      ZFCDNV(JL) = 0.
      ZFSUPN(JL) = 0.
      ZFSUPV(JL) = 0.
      ZFCUPN(JL) = 0.
      ZFCUPV(JL) = 0.
c     ZPSOL(JL) = PPRES(JL,KFLEV+1)
      ZPSOL(JL) = ppres(jl,1)
C     ZTL(JL,1) = pth(JL,1)
C     ZDT0(JK) = PTS(JL) - pth(JL,1)
 107  CONTINUE
C
C*         1.1    INITIALIZE VARIOUS FIELDS
C                 -------------------------
C
 110  CONTINUE
C
      DO 111 JL = 1 , KDLON
      ZALBSU(JL,1)=PALBS(JL,1)
      ZALBSU(JL,2)=PALBS(JL,2)
      ZFSUP(JL,KFLEV+1) = 0.
      ZFSDWN(JL,KFLEV+1) = ZEPSCO
C     PEMIS(JL) = 1. - PEMIS(JL)
      ZTL(JL,KFLEV+1) = pt(jl,kflev)
      ZDT0(JL) = PTS(JL) - pth(jl,1)
 111  CONTINUE
C
      DO 113 JK = 1 , KFLEV
      JKP1 = JK + 1
      JKL = KFLEV+ 1 - JK
      JKLP1 = JKL + 1
      DO 112 JL = 1 , KDLON
      ZDP(JL,JK) = PPRES(JL,JK) - PPRES(JL,JK+1)
      ZPMB(JL,JK) = PPRES(JL,JK) / 100.
      ZTL(JL,JK) = pth(jl,jk)
      ZTAVE(JL,JK) = pt(jl,jk)
      ZOZ(JL,JK)   = POZON(JL,JKL) * 46.6968 / RG
      ZCLD0(JL,JK) = 0.
      ZCLDSW(JL,JK) = PCLFR(JL,JKL)
      ZCLDLW(JL,JK) = PCLFR(JL,JKL)
      ZTAU(JL,1,JK) = ZEPSCW
      ZTAU(JL,2,JK) = ZEPSCW
      ZOMEGA(JL,1,JK) = 0.9994
      ZOMEGA(JL,2,JK) = 0.9963
      ZCG(JL,1,JK) = 0.865
      ZCG(JL,2,JK) = 0.910
      ZFSUP(JL,JK) = 0.
      ZFSDWN(JL,JK) = 0.
      ZFLUX(JL,1,JK) = 0.
      ZFLUX(JL,2,JK) = 0.
      ZFLUXC(JL,1,JK) = 0.
      ZFLUXC(JL,2,JK) = 0.
 112  CONTINUE
 113  CONTINUE
C
C     ------------------------------------------------------------------
C
C*         2.     CLOUD AND AEROSOL PARAMETERS
C                 ----------------------------
C
 200  CONTINUE
C
      DO 202 JK = 2 , KFLEV-1
      JKL = KFLEV + 1 - JK
      DO 201 JL = 1 , KDLON
      PCLFR(JL,JKL) = AMAX1(ZEPSC,PCLFR(JL,JKL))
      LO1 = PCLFR(JL,JKL).GT.ZEPSC
      ZLWGKG = CVMGT(3.*PQW(JL,JKL)*1000./PCLFR(JL,JKL),0.,LO1)
      ZFCCA = AMIN1 ( PCLFR(JL,JKL) , PCLFR(JL,JKL-1) )
      ZFCCB = AMIN1 ( PCLFR(JL,JKL) , PCLFR(JL,JKL+1) )
      ZFCC  = AMAX1 ( ZFCCA , ZFCCB )
      ZFCC = 0.0
      ZLWGKG = ZFCC * CCLWMR + (PCLFR(JL,JKL) - ZFCC) * ZLWGKG
      ZFLWP(JL) = CVMGT( ZLWGKG*ZDP(JL,JKL)/(RG*PCLFR(JL,JKL)) ,
     S                    ZEPSCW , LO1 )
      ZCLDSW(JL,JK) = PCLFR(JL,JKL)
      ZCLDLW(JL,JK) = PCLFR(JL,JKL)*(1. - EXP(-0.158 * ZFLWP(JL)))
      ZRADEF = 15.0
      ZTAUEQ = 1.5 * ZFLWP(JL) / ZRADEF
      ZTAU(JL,1,JK) = ZTAUEQ
      ZTAU(JL,2,JK) = ZTAUEQ
      ZOMEGA(JL,1,JK) = 0.9999 - 5.0E-04*EXP(-0.5 * ZTAUEQ)
      ZOMEGA(JL,2,JK) = 0.9988 - 2.5E-03*EXP(-0.05 * ZTAUEQ)
      ZCG(JL,1,JK)=0.865
      ZCG(JL,2,JK)=0.910
 201  CONTINUE
 202  CONTINUE
C
      DO 203 JL = 1 , KDLON
      ZPMB (JL,KFLEV+1) = 0.0
      ZTL(JL,KFLEV+1) = pt(jl,kflev)
 203  CONTINUE
C
      NUAER = NUA
      NTRAER = NTRA
C
      IF (KAER.EQ.0) THEN
         NUAER = NUA
         NTRAER = NTRA
         DO 209 JK = 1 , KFLEV
         DO 208 JAE = 1 , 5
         DO 207 JL = 1 , KDLON
         PAER(JL,JK,JAE)=1.E-15
 207     CONTINUE
 208     CONTINUE
 209     CONTINUE

      END IF
c minimum value for aerosols Hourdin 1993
c     DO 209 JK = 1 , KFLEV
c     DO 208 JAE = KAER+1 , 5
c     DO 207 JL = 1 , KDLON
c        PAER(JL,JK,JAE)=1.E-15
c207  CONTINUE
c208  CONTINUE
c209  CONTINUE
C
      IF (NIMP.LT.4) THEN
         WRITE(NOUT,889) (RT1(IG1),WG1(IG1),IG1=1,NG1)
C        DO 210 JL = 1 , KDLON
         JL = JLIMPRAD
         WRITE(NOUT,891)(ZPMB(JL,JK),  JK = 1 , KFLEV+1)
         WRITE(NOUT,891)(ZTL (JL,JK),  JK = 1 , KFLEV+1)
         WRITE(NOUT,883)(PQ (JL,JK),  JK=KFLEV,1,-1)
         WRITE(NOUT,884)(POZON(JL,JK),JK=KFLEV,1,-1)
         WRITE(NOUT,884)(ZOZ (JL,JK),JK = 1 , KFLEV)
         WRITE(NOUT,885)(ZTAVE(JL,JK), JK = 1 , KFLEV)
         WRITE(NOUT,889)(ZCLDSW(JL,JK),  JK = 1 , KFLEV)
         WRITE(NOUT,889)(ZCLDLW(JL,JK), JK = 1 , KFLEV)
         WRITE(NOUT,889)(PCLFR(JL,JK), JK=KFLEV,1,-1)
         WRITE(NOUT,889)(PQW (JL,JK),  JK=KFLEV,1,-1)
         WRITE(NOUT,889)(ZTAU(JL,1,JK),  JK = 1 , KFLEV)
         WRITE(NOUT,889)(ZOMEGA(JL,1,JK),JK = 1 , KFLEV)
 210     CONTINUE
         WRITE(NOUT,887) PCCO2 ,RSIGMA,RI0,RG,RCPD
      END IF
C
C
C     ------------------------------------------------------------------
C
C*         3.     CALL LONGWAVE RADIATION CODE
C                 ----------------------------
C
 300  CONTINUE
C
      IF (LORAD) THEN
C
C
C*         3.1    FULL LONGWAVE RADIATION COMPUTATIONS
C                 ------------------------------------
C
 310  CONTINUE
C
      call lwmain (ig0,icount,kdlon,kflev
     .            ,zdp, zdt0,pemis, ppres,ztl,ztave
     .            ,paer,pcllog,zfluxc(1,2,1)
     .            ,netrad)

c  zfluxc(jl,2,1)   2 pour downward et 1 pour le sol
c   c'est donc le flux descendant dans le sol (effet de serre sur le sol)


C
      IF (NIMP.LT.4) THEN
      PRINT 9300
      PRINT 9301,(ZFLUX (JLIMPRAD,1,JK),JK=1,KFLEV+1)
      PRINT 9301,(ZFLUX (JLIMPRAD,2,JK),JK=1,KFLEV+1)
      PRINT 9302,(PDTLOG(JLIMPRAD,JK),JK=1,KFLEV)
      PRINT 9301,(ZFLUXC(JLIMPRAD,1,JK),JK=1,KFLEV+1)
      PRINT 9301,(ZFLUXC(JLIMPRAD,2,JK),JK=1,KFLEV+1)
      PRINT 9302,(PCLLOG(JLIMPRAD,JK),JK=1,KFLEV)
      END IF
C
      ELSE
C
C*         3.2    PARTIAL LONGWAVE RADIATION COMPUTATIONS
C                 ---------------------------------------
C
 320  CONTINUE
C
         DO 321 JL = 1 , KDLON
         ZFDD(JL)=0.
         ZFLUX(JL,2,KFLEV+1) = 0.
 321     CONTINUE
C
         DO 323 JKL = 1 , KFLEV
         JK = KFLEV+1 - JKL
         DO 322 JL = 1 , KDLON
C        ZEMD(JL,JK) = FF(I,NABSB+K-1)
         ZFDD(JL) = ZCLDLW(JL,JK) * RSIGMA * ZTL(JL,JK)**4.
     S    + (1. - ZCLDLW(JL,JK)) * (ZFDD(JL) * (1. - ZEMD(JL,JK))
     S    + ZEMD(JL,JK) * RSIGMA * ZTAVE(JL,JK)**4. )
         ZFLUX(JL,2,JK) = -ZFDD(JL)
 322     CONTINUE
 323     CONTINUE
C
         DO 324 JL = 1 , KDLON
         ZFLUX(JL,1,1) = PEMIS(JL) * RSIGMA * ZTL(JL,1)**4.
     S                  - ( 1. - PEMIS(JL)) * ZFLUX(JL,2,1)
         ZFDD(JL) = ZFLUX(JL,1,1)
 324     CONTINUE
C
         DO 326 JK = 1 , KFLEV
         DO 325 JL = 1 , KDLON
C        ZEMU(JL,JK) = FF(I,NABSB+K-1)
         ZFDD(JL) = ZCLDLW(JL,JK) * RSIGMA * ZTL(JL,JK+1)**4.
     S    + (1. - ZCLDLW(JL,JK)) * (ZFDD(JL) * (1. - ZEMU(JL,JK))
     S    + ZEMU(JL,JK) * RSIGMA * ZTAVE(JL,JK)**4. )
         ZFLUX(JL,1,JK+1) = ZFDD(JL)
 325     CONTINUE
 326     CONTINUE
C
      END IF
C

c
#ifdef CRAY
#else
c     g1d_tmp1='flwa'
c     g1d_tmp2='flux ascendant lw'
c     DO JK = 1 , KFLEV
c       tmp_g1d(JK)=ZFLUXC(1,1,JK)
c     ENDDO
c     CALL writeg1d(kdlon,KFLEV,tmp_g1d,g1d_tmp1,g1d_tmp2)
#endif
c
c
#ifdef CRAY
#else
c     g1d_tmp1='flwd'
c     g1d_tmp2='flux descendant lw'
c     DO JK = 1 , KFLEV
c       tmp_g1d(JK)=ZFLUXC(1,2,JK)
c     ENDDO
c     CALL writeg1d(kdlon,KFLEV,tmp_g1d,g1d_tmp1,g1d_tmp2)
#endif
c


C     ------------------------------------------------------------------
C
C*         4.     CALL SHORTWAVE RADIATION CODE
C                 -----------------------------
C
 400  CONTINUE
C
      ZRMUZ=0.
      DO 401 JL = 1 , KDLON
      ZRMUZ = AMAX1 (ZRMUZ, PMU0(JL))
 401  CONTINUE
C
C
      IF (ZRMUZ.GT.0.) THEN
C
      PCST=RI0/(PORB*PORB)
      CALL SW ( KDLON, KFLEV, KAER, PCST, PCCO2, ZPSOL, PALBS, PQ,
     S PMU0, ZCG, ZCLDSW, ZDP, ZOMEGA, ZOZ, ZPMB, ZTAU, ZTAVE, PAER,
     S  PDTSOL, ZFSDWN, ZFSUP, ZFSDNN, ZFSDNV, ZFSUPN, ZFSUPV
     S      ,PFRACT)
C
      IF (NIMP.LT.4) THEN
      PRINT 9400
      PRINT 9401,(ZFSUP(JLIMPRAD,JK),JK=1,KFLEV+1)
      PRINT 9401,(ZFSDWN(JLIMPRAD,JK),JK=1,KFLEV+1)
      PRINT 9402,(PDTSOL(JLIMPRAD,JK),JK=1,KFLEV)
      END IF
C
      IF (KMODE.EQ.1.OR.KMODE.EQ.2) THEN
      PCST=RI0/(PORB*PORB)
      CALL SW ( KDLON, KFLEV, KAER, PCST, PCCO2, ZPSOL, PALBS, PQ,
     S PMU0, ZCG, ZCLD0 , ZDP, ZOMEGA, ZOZ, ZPMB, ZTAU, ZTAVE, PAER,
     S  PCLSOL, ZFSDWN, ZFSUP, ZFCDNN, ZFCDNV, ZFCUPN, ZFCUPV ,
     S   PFRACT    )
C
      IF (NIMP.LT.4) THEN
      PRINT 9410
      PRINT 9401,(ZFSUP(JLIMPRAD,JK),JK=1,KFLEV+1)
      PRINT 9401,(ZFSDWN(JLIMPRAD,JK),JK=1,KFLEV+1)
      PRINT 9402,(PCLSOL(JLIMPRAD,JK),JK=1,KFLEV)
      END IF
C
      END IF
C
      END IF
C


c
#ifdef CRAY
#else
c     g1d_tmp1='fswa'
c     g1d_tmp2='flux ascendant sw'
c     DO JK = 1 , KFLEV
c       tmp_g1d(JK)=ZFSUP(1,JK)
c     ENDDO
c     CALL writeg1d(kdlon,KFLEV,tmp_g1d,g1d_tmp1,g1d_tmp2)
#endif
c
c
#ifdef CRAY
#else
c     g1d_tmp1='fswd'
c     g1d_tmp2='flux descendant sw'
c     DO JK = 1 , KFLEV
c       tmp_g1d(JK)=ZFSDWN(1,JK)
c     ENDDO
c     CALL writeg1d(kdlon,KFLEV,tmp_g1d,g1d_tmp1,g1d_tmp2)
#endif
c





C     ------------------------------------------------------------------
C
C*         5.     FILL UP THE MODEL NET LW AND SW RADIATIVE FLUXES
C                 ------------------------------------------------
C
 500  CONTINUE
C
      IF (KMODE.EQ.0) THEN
         DO 501 JL = 1 , KDLON
c._.         PFLUX(JL, 1) = - ZFLUX(JL,1,KFLEV+1)
         PFLUX(JL, 1) = - ZFLUXC(JL,1,KFLEV+1)
         PFLUX(JL, 2) = - ZFSUPV(JL)
         PFLUX(JL, 3) = - ZFSUPN(JL)
c._.         PFLUX(JL, 4) = - ZFLUX(JL,2,1)
         PFLUX(JL, 4) = - ZFLUXC(JL,2,1)
         PFLUX(JL, 5) =   ZFSDNV(JL)
         PFLUX(JL, 6) =   ZFSDNN(JL)
 501     CONTINUE
C
      ELSE IF (KMODE.EQ.1.OR.KMODE.EQ.2) THEN
C
 510  CONTINUE
C
         DO 511 JL = 1 , KDLON
         PFLUX(JL, 1) = - ZFLUX(JL,1,KFLEV+1)
         PFLUX(JL, 2) = - ZFSUPV(JL)
         PFLUX(JL, 3) = - ZFSUPN(JL)
         PFLUX(JL, 4) = - ZFLUX(JL,2,1)
         PFLUX(JL, 5) =   ZFSDNV(JL)
         PFLUX(JL, 6) =   ZFSDNN(JL)
         PFLUX(JL, 7) = - ZFLUXC(JL,1,KFLEV+1)
         PFLUX(JL, 8) = - ZFCUPV(JL)
         PFLUX(JL, 9) = - ZFCUPN(JL)
         PFLUX(JL,10) = - ZFLUXC(JL,2,1)
         PFLUX(JL,11) =   ZFCDNV(JL)
         PFLUX(JL,12) =   ZFCDNN(JL)
 511     CONTINUE
C
      ELSE IF (KMODE.EQ.3) THEN
C
 520  CONTINUE
C
 523     CONTINUE
C
      END IF
C
 530  CONTINUE
C
      IF (NIMP.LT.5) THEN
c     DO 531 JL = 1 , KDLON
      JL=JLIMPRAD
      WRITE(NOUT,889) (PDTLOG(JL,JK),JK = 1 , KFLEV)
      WRITE(NOUT,889) (PCLLOG(JL,JK),JK = 1 , KFLEV)
      WRITE(NOUT,889) (PDTSOL(JL,JK),JK = 1 , KFLEV)
      WRITE(NOUT,889) (PCLSOL(JL,JK),JK = 1 , KFLEV)
      WRITE(NOUT,891) (PFLUX (JL,JF),JF = 1 , KFLUX)
      WRITE(NOUT,891) (PRAD  (JL,JR),JR = 1 , KRAD )
      WRITE(NOUT,891) (PRADC (JL,JR),JR = 1 , KRAD )
 531  CONTINUE
      END IF
C
C
C-----------------------------------------------------------------------
C                       FORMATS
C                       -------
C
C
 883  FORMAT(2X,16E8.2)
 884  FORMAT(4X,18F7.4)
 885  FORMAT(4X,18F7.1)
 886  FORMAT(20I5)
 887  FORMAT(1X,10E12.6)
 888  FORMAT (13E9.2)
 889  FORMAT(4X,18F7.3)
 890  FORMAT(1X,3E12.6,2X,E12.6,3X,4E12.6)
 891  FORMAT(1X,18F7.1)
 9300 FORMAT (1X,' END OF *LW*')
 9301 FORMAT (1X,20F6.1)
 9302 FORMAT (4X,20F6.3)
 9400 FORMAT (1X,' END OF *SW*')
 9401 FORMAT (1X,20F6.1)
 9402 FORMAT (4X,20F6.3)
 9410 FORMAT (1X,' END OF *SWCLEAR*')
C
C     --------------------------------------------------------------
C
      RETURN
      END