*=*=*=*= RADITE.html =*=*=*=*
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