/[lmdze]/trunk/phylmd/Radlwsw/sw.f
ViewVC logotype

Diff of /trunk/phylmd/Radlwsw/sw.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/Radlwsw/sw.f revision 24 by guez, Wed Mar 3 13:23:49 2010 UTC trunk/phylmd/Radlwsw/sw.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC
# Line 1  Line 1 
1  cIM ctes ds clesphys.h   SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC,  module sw_m
2        SUBROUTINE SW(PSCT, PRMU0, PFRAC,  
3       S              PPMB, PDP,    IMPLICIT none
4       S              PPSOL, PALBD, PALBP,  
5       S              PTAVE, PWV, PQS, POZON, PAER,  contains
6       S              PCLDSW, PTAU, POMEGA, PCG,  
7       S              PHEAT, PHEAT0,    SUBROUTINE SW(PSCT, PRMU0, PFRAC, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
8       S              PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,         PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, &
9       S              ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,         PALBPLA, PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, &
10       S              tauae, pizae, cgae,         ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, PTOPSWAD, PSOLSWAD, &
11       s              PTAUA, POMEGAA,         PTOPSWAI, PSOLSWAI, ok_ade, ok_aie)
12       S              PTOPSWAD,PSOLSWAD,PTOPSWAI,PSOLSWAI,  
13       J              ok_ade, ok_aie )      ! Purpose.
14              ! This routine computes the shortwave radiation fluxes in two
15        use dimens_m      ! spectral intervals following Fouquart and Bonnel (1980).
16        use dimphy  
17        use clesphys      ! Method.
18        use YOMCST      ! 1. Computes absorber amounts (swu)
19        use raddim      ! 2. Computes fluxes in 1st spectral interval (SW1S)
20        IMPLICIT none      ! 3. Computes fluxes in 2nd spectral interval (SW2S)
21    
22  C      ! Reference.
23  C     ------------------------------------------------------------------      ! See radiation part of the ECMWF research department
24  C      ! documentation, and Fouquart and Bonnel (1980)
25  C     PURPOSE.  
26  C     --------      ! Author.
27  C      ! Jean-Jacques Morcrette *ecmwf*
28  C          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO  
29  C     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).      ! Modifications.
30  C      ! Original: 89-07-14
31  C     METHOD.      ! 95-01-01 J.-J. Morcrette direct/diffuse albedo
32  C     -------      ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)
33  C  
34  C          1. COMPUTES ABSORBER AMOUNTS                 (SWU)      USE clesphys, ONLY: bug_ozone
35  C          2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL  (SW1S)      USE raddim, ONLY: kdlon, kflev
36  C          3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL  (SW2S)      USE suphec_m, ONLY: rcpd, rday, rg, md, rmo3
37  C  
38  C     REFERENCE.      ! ARGUMENTS:
39  C     ----------  
40  C      DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
41  C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT  
42  C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)      DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
43  C      DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
44  C     AUTHOR.      DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
45  C     -------  
46  C        JEAN-JACQUES MORCRETTE  *ECMWF*      DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
47  C      DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
48  C     MODIFICATIONS.  
49  C     --------------      DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
50  C        ORIGINAL : 89-07-14      DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
51  C        95-01-01   J.-J. MORCRETTE  Direct/Diffuse Albedo      DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
52  c        03-11-27   J. QUAAS Introduce aerosol forcings (based on BOUCHER)      DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
53  C     ------------------------------------------------------------------      DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! AEROSOLS' OPTICAL THICKNESS
54  C  
55  C* ARGUMENTS:      DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
56  C      DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
57        REAL*8 PSCT  ! constante solaire (valeur conseillee: 1370)  
58  cIM ctes ds clesphys.h   REAL*8 RCO2  ! concentration CO2 (IPCC: 353.E-06*44.011/28.97)      DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
59  C      DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
60        REAL*8 PPSOL(KDLON)        ! SURFACE PRESSURE (PA)      DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
61        REAL*8 PDP(KDLON,KFLEV)    ! LAYER THICKNESS (PA)      DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
62        REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)  
63  C      DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
64        REAL*8 PRMU0(KDLON)  ! COSINE OF ZENITHAL ANGLE      DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
65        REAL*8 PFRAC(KDLON)  ! fraction de la journee      DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
66  C      DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
67        REAL*8 PTAVE(KDLON,KFLEV)  ! LAYER TEMPERATURE (K)      DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
68        REAL*8 PWV(KDLON,KFLEV)    ! SPECIFIC HUMIDITY (KG/KG)      DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
69        REAL*8 PQS(KDLON,KFLEV)    ! SATURATED WATER VAPOUR (KG/KG)      DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
70        REAL*8 POZON(KDLON,KFLEV)  ! OZONE CONCENTRATION (KG/KG)  
71        REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS      ! LOCAL VARIABLES:
72  C  
73        REAL*8 PALBD(KDLON,2)  ! albedo du sol (lumiere diffuse)      DOUBLE PRECISION ZOZ(KDLON, KFLEV)
74        REAL*8 PALBP(KDLON,2)  ! albedo du sol (lumiere parallele)      DOUBLE PRECISION ZAKI(KDLON, 2)
75  C      DOUBLE PRECISION ZCLD(KDLON, KFLEV)
76        REAL*8 PCLDSW(KDLON,KFLEV)    ! CLOUD FRACTION      DOUBLE PRECISION ZCLEAR(KDLON)
77        REAL*8 PTAU(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS      DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
78        REAL*8 PCG(KDLON,2,KFLEV)     ! ASYMETRY FACTOR      DOUBLE PRECISION ZFACT(KDLON)
79        REAL*8 POMEGA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO      DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
80  C      DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
81        REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)      DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
82        REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky      DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
83        REAL*8 PALBPLA(KDLON)     ! PLANETARY ALBEDO      DOUBLE PRECISION ZRMU(KDLON)
84        REAL*8 PTOPSW(KDLON)      ! SHORTWAVE FLUX AT T.O.A.      DOUBLE PRECISION ZSEC(KDLON)
85        REAL*8 PSOLSW(KDLON)      ! SHORTWAVE FLUX AT SURFACE      DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
86        REAL*8 PTOPSW0(KDLON)     ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)      DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
87        REAL*8 PSOLSW0(KDLON)     ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)  
88  C      DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
89  C* LOCAL VARIABLES:      DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
90  C      DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
91        REAL*8 ZOZ(KDLON,KFLEV)      DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
92        REAL*8 ZAKI(KDLON,2)      
93        REAL*8 ZCLD(KDLON,KFLEV)      INTEGER inu, jl, jk, i, k, kpl1
94        REAL*8 ZCLEAR(KDLON)  
95        REAL*8 ZDSIG(KDLON,KFLEV)      INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
96        REAL*8 ZFACT(KDLON)  
97        REAL*8 ZFD(KDLON,KFLEV+1)      INTEGER:: itapsw = 0
98        REAL*8 ZFDOWN(KDLON,KFLEV+1)      LOGICAL:: appel1er = .TRUE.
99        REAL*8 ZFU(KDLON,KFLEV+1)      !jq-Introduced for aerosol forcings
100        REAL*8 ZFUP(KDLON,KFLEV+1)      double precision, save:: flag_aer
101        REAL*8 ZRMU(KDLON)      logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?
102        REAL*8 ZSEC(KDLON)      double precision tauae(kdlon, kflev, 2) ! aerosol optical properties
103        REAL*8 ZUD(KDLON,5,KFLEV+1)      double precision pizae(kdlon, kflev, 2)
104        REAL*8 ZCLDSW0(KDLON,KFLEV)      ! aerosol optical properties(see aeropt.F)
105  c      
106        REAL*8 ZFSUP(KDLON,KFLEV+1)      double precision cgae(kdlon, kflev, 2) !aerosol optical properties -"-
107        REAL*8 ZFSDN(KDLON,KFLEV+1)      DOUBLE PRECISION PTAUA(KDLON, 2, KFLEV)
108        REAL*8 ZFSUP0(KDLON,KFLEV+1)      ! CLOUD OPTICAL THICKNESS (pre-industrial value)
109        REAL*8 ZFSDN0(KDLON,KFLEV+1)  
110  C      DOUBLE PRECISION POMEGAA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
111        INTEGER inu, jl, jk, i, k, kpl1      DOUBLE PRECISION PTOPSWAD(KDLON)
112  c      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
113        INTEGER swpas  ! Every swpas steps, sw is calculated  
114        PARAMETER(swpas=1)      DOUBLE PRECISION PSOLSWAD(KDLON)
115  c      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
116        INTEGER itapsw  
117        LOGICAL appel1er      DOUBLE PRECISION PTOPSWAI(KDLON)
118        DATA itapsw /0/      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
119        DATA appel1er /.TRUE./  
120  cjq-Introduced for aerosol forcings      DOUBLE PRECISION PSOLSWAI(KDLON)
121        real*8 flag_aer      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
122        logical ok_ade, ok_aie    ! use aerosol forcings or not?  
123        real*8 tauae(kdlon,kflev,2)  ! aerosol optical properties      !jq - Fluxes including aerosol effects
124        real*8 pizae(kdlon,kflev,2)  ! (see aeropt.F)      DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
125        real*8 cgae(kdlon,kflev,2)   ! -"-      DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
126        REAL*8 PTAUA(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (pre-industrial value)      DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)
127        REAL*8 POMEGAA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO      DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)
128        REAL*8 PTOPSWAD(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)  
129        REAL*8 PSOLSWAD(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)      logical:: initialized = .false.
130        REAL*8 PTOPSWAI(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)  
131        REAL*8 PSOLSWAI(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)      !-------------------------------------------------------------------
132  cjq - Fluxes including aerosol effects  
133        REAL*8 ZFSUPAD(KDLON,KFLEV+1)      if(.not.initialized) then
134        REAL*8 ZFSDNAD(KDLON,KFLEV+1)         flag_aer=0.
135        REAL*8 ZFSUPAI(KDLON,KFLEV+1)         initialized=.TRUE.
136        REAL*8 ZFSDNAI(KDLON,KFLEV+1)         ZFSUPAD = 0.
137        logical initialized         ZFSDNAD = 0.
138        SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes         ZFSUPAI = 0.
139  !rv         ZFSDNAI = 0.
140        save flag_aer      endif
141        data initialized/.false./      !rv
142  cjq-end  
143        if(.not.initialized) then      IF (appel1er) THEN
144          flag_aer=0.         PRINT*, 'SW calling frequency: ', swpas
145          initialized=.TRUE.         PRINT*, " In general, it should be 1"
146        endif         appel1er = .FALSE.
147  !rv      ENDIF
148          
149  c      IF (MOD(itapsw, swpas).EQ.0) THEN
150        IF (appel1er) THEN         DO JK = 1 , KFLEV
151           PRINT*, 'SW calling frequency : ', swpas            DO JL = 1, KDLON
152           PRINT*, "   In general, it should be 1"               ZCLDSW0(JL, JK) = 0.0
153           appel1er = .FALSE.               IF (bug_ozone) then
154        ENDIF                  ZOZ(JL, JK) = POZON(JL, JK)*46.6968/RG &
155  C     ------------------------------------------------------------------                       *PDP(JL, JK)*(101325.0/PPSOL(JL))
156        IF (MOD(itapsw,swpas).EQ.0) THEN               ELSE
157  c                  ! Correction MPL 100505
158        DO JK = 1 , KFLEV                  ZOZ(JL, JK) = POZON(JL, JK)*MD/RMO3*46.6968/RG*PDP(JL, JK)
159        DO JL = 1, KDLON               ENDIF
160           ZCLDSW0(JL,JK) = 0.0            ENDDO
161           IF (bug_ozone) then         ENDDO
162             ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG  
163       .               *PDP(JL,JK)*(101325.0/PPSOL(JL))         ! clear-sky:
164           ELSE         CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
165  c        Correction MPL 100505              PRMU0, PFRAC, PTAVE, PWV, &
166             ZOZ(JL,JK) = POZON(JL,JK)*RMD/RMO3*46.6968/RG*PDP(JL,JK)              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
167           ENDIF                   INU = 1
168        ENDDO         CALL SW1S(INU, &
169        ENDDO              PAER, flag_aer, tauae, pizae, cgae, &
170  C              PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
171  C              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
172  c clear-sky:              ZFD, ZFU)
173  cIM ctes ds clesphys.h  CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,         INU = 2
174        CALL SWU(PSCT,ZCLDSW0,PPMB,PPSOL,         CALL SW2S(INU, &
175       S         PRMU0,PFRAC,PTAVE,PWV,              PAER, flag_aer, tauae, pizae, cgae, &
176       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
177        INU = 1              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
178        CALL SW1S(INU,              PWV, PQS, &
179       S     PAER, flag_aer, tauae, pizae, cgae,              ZFDOWN, ZFUP)
180       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,         DO JK = 1 , KFLEV+1
181       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,            DO JL = 1, KDLON
182       S     ZFD, ZFU)               ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
183        INU = 2               ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
184        CALL SW2S(INU,            ENDDO
185       S     PAER, flag_aer, tauae, pizae, cgae,         ENDDO
186       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,  
187       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,         flag_aer=0.
188       S     PWV, PQS,         CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
189       S     ZFDOWN, ZFUP)              PRMU0, PFRAC, PTAVE, PWV, &
190        DO JK = 1 , KFLEV+1              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
191        DO JL = 1, KDLON         INU = 1
192           ZFSUP0(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)         CALL SW1S(INU, &
193           ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)              PAER, flag_aer, tauae, pizae, cgae, &
194        ENDDO              PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
195        ENDDO              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
196                      ZFD, ZFU)
197        flag_aer=0.0         INU = 2
198        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,         CALL SW2S(INU, &
199       S         PRMU0,PFRAC,PTAVE,PWV,              PAER, flag_aer, tauae, pizae, cgae, &
200       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
201        INU = 1              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
202        CALL SW1S(INU,              PWV, PQS, &
203       S     PAER, flag_aer, tauae, pizae, cgae,              ZFDOWN, ZFUP)
204       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,  
205       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,         ! cloudy-sky:
206       S     ZFD, ZFU)  
207        INU = 2         DO JK = 1 , KFLEV+1
208        CALL SW2S(INU,            DO JL = 1, KDLON
209       S     PAER, flag_aer, tauae, pizae, cgae,               ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
210       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,               ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
211       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,            ENDDO
212       S     PWV, PQS,         ENDDO
213       S    ZFDOWN, ZFUP)  
214           IF (ok_ade) THEN
215  c cloudy-sky:            ! cloudy-sky + aerosol dir OB
216                    flag_aer=1.
217        DO JK = 1 , KFLEV+1            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
218        DO JL = 1, KDLON                 PRMU0, PFRAC, PTAVE, PWV, &
219           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
220           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)            INU = 1
221        ENDDO            CALL SW1S(INU, &
222        ENDDO                 PAER, flag_aer, tauae, pizae, cgae, &
223                         PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
224  c                       ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
225        IF (ok_ade) THEN                 ZFD, ZFU)
226  c            INU = 2
227  c cloudy-sky + aerosol dir OB            CALL SW2S(INU, &
228        flag_aer=1.0                 PAER, flag_aer, tauae, pizae, cgae, &
229        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
230       S         PRMU0,PFRAC,PTAVE,PWV,                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
231       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)                 PWV, PQS, &
232        INU = 1                 ZFDOWN, ZFUP)
233        CALL SW1S(INU,            DO JK = 1 , KFLEV+1
234       S     PAER, flag_aer, tauae, pizae, cgae,               DO JL = 1, KDLON
235       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,                  ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
236       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,                  ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
237       S     ZFD, ZFU)                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
238        INU = 2                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
239        CALL SW2S(INU,               ENDDO
240       S     PAER, flag_aer, tauae, pizae, cgae,            ENDDO
241       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,         ENDIF
242       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,  
243       S     PWV, PQS,         IF (ok_aie) THEN
244       S    ZFDOWN, ZFUP)            !jq cloudy-sky + aerosol direct + aerosol indirect
245        DO JK = 1 , KFLEV+1            flag_aer=1.0
246        DO JL = 1, KDLON            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
247           ZFSUPAD(JL,JK) = ZFSUP(JL,JK)                 PRMU0, PFRAC, PTAVE, PWV, &
248           ZFSDNAD(JL,JK) = ZFSDN(JL,JK)                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
249           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)            INU = 1
250           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)            CALL SW1S(INU, &
251        ENDDO                 PAER, flag_aer, tauae, pizae, cgae, &
252        ENDDO                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
253                         ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
254        ENDIF ! ok_ade                 ZFD, ZFU)
255                    INU = 2
256        IF (ok_aie) THEN            CALL SW2S(INU, &
257                           PAER, flag_aer, tauae, pizae, cgae, &
258  cjq   cloudy-sky + aerosol direct + aerosol indirect                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
259        flag_aer=1.0                 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
260        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,                 PWV, PQS, &
261       S         PRMU0,PFRAC,PTAVE,PWV,                 ZFDOWN, ZFUP)
262       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)            DO JK = 1 , KFLEV+1
263        INU = 1               DO JL = 1, KDLON
264        CALL SW1S(INU,                  ZFSUPAI(JL, JK) = ZFSUP(JL, JK)
265       S     PAER, flag_aer, tauae, pizae, cgae,                  ZFSDNAI(JL, JK) = ZFSDN(JL, JK)
266       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
267       S     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
268       S     ZFD, ZFU)               ENDDO
269        INU = 2            ENDDO
270        CALL SW2S(INU,         ENDIF
271       S     PAER, flag_aer, tauae, pizae, cgae,  
272       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,         itapsw = 0
273       S     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,      ENDIF
274       S     PWV, PQS,      itapsw = itapsw + 1
275       S    ZFDOWN, ZFUP)  
276        DO JK = 1 , KFLEV+1      DO k = 1, KFLEV
277        DO JL = 1, KDLON         kpl1 = k+1
278           ZFSUPAI(JL,JK) = ZFSUP(JL,JK)         DO i = 1, KDLON
279           ZFSDNAI(JL,JK) = ZFSDN(JL,JK)                      PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
280           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)                 -(ZFSDN(i, k)-ZFSDN(i, kpl1))
281           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)            PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
282        ENDDO            PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
283        ENDDO                 -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
284        ENDIF ! ok_aie                  PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
285  cjq -end         ENDDO
286              ENDDO
287        itapsw = 0      DO i = 1, KDLON
288        ENDIF         PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
289        itapsw = itapsw + 1  
290  C         PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
291        DO k = 1, KFLEV         PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
292           kpl1 = k+1  
293           DO i = 1, KDLON         PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
294              PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))         PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
295       .                     -(ZFSDN(i,k)-ZFSDN(i,kpl1))  
296              PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)         PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
297              PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))         PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
298       .                     -(ZFSDN0(i,k)-ZFSDN0(i,kpl1))  
299              PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)         PSOLSWAI(i) = ZFSDNAI(i, 1) - ZFSUPAI(i, 1)
300           ENDDO         PTOPSWAI(i) = ZFSDNAI(i, KFLEV+1) - ZFSUPAI(i, KFLEV+1)
301        ENDDO      ENDDO
302        DO i = 1, KDLON  
303           PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)    END SUBROUTINE SW
304  c  
305           PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)  end module sw_m
          PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)  
 c  
          PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)  
          PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)  
 c-OB  
          PSOLSWAD(i) = ZFSDNAD(i,1) - ZFSUPAD(i,1)  
          PTOPSWAD(i) = ZFSDNAD(i,KFLEV+1) - ZFSUPAD(i,KFLEV+1)  
 c  
          PSOLSWAI(i) = ZFSDNAI(i,1) - ZFSUPAI(i,1)  
          PTOPSWAI(i) = ZFSDNAI(i,KFLEV+1) - ZFSUPAI(i,KFLEV+1)  
 c-fin  
       ENDDO  
 C  
       RETURN  
       END  
Legend:
Removed from v.24  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.21