/[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 38 by guez, Thu Jan 6 17:52:19 2011 UTC trunk/libf/phylmd/Radlwsw/sw.f90 revision 53 by guez, Fri Oct 7 13:11:58 2011 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 SUPHEC_M      ! 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'S 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 suphec_m, ONLY: rcpd, rday, rg, rmd, rmo3
36  C          3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL  (SW2S)      USE raddim, ONLY: kdlon, kflev
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 swpas ! Every swpas steps, sw is calculated
96        REAL*8 ZFACT(KDLON)      PARAMETER(swpas=1)
97        REAL*8 ZFD(KDLON,KFLEV+1)  
98        REAL*8 ZFDOWN(KDLON,KFLEV+1)      INTEGER itapsw
99        REAL*8 ZFU(KDLON,KFLEV+1)      LOGICAL appel1er
100        REAL*8 ZFUP(KDLON,KFLEV+1)      DATA itapsw /0/
101        REAL*8 ZRMU(KDLON)      DATA appel1er /.TRUE./
102        REAL*8 ZSEC(KDLON)      !jq-Introduced for aerosol forcings
103        REAL*8 ZUD(KDLON,5,KFLEV+1)      double precision flag_aer
104        REAL*8 ZCLDSW0(KDLON,KFLEV)      logical ok_ade, ok_aie ! use aerosol forcings or not?
105  c      double precision tauae(kdlon, kflev, 2) ! aerosol optical properties
106        REAL*8 ZFSUP(KDLON,KFLEV+1)      double precision pizae(kdlon, kflev, 2)
107        REAL*8 ZFSDN(KDLON,KFLEV+1)      ! aerosol optical properties(see aeropt.F)
108        REAL*8 ZFSUP0(KDLON,KFLEV+1)      
109        REAL*8 ZFSDN0(KDLON,KFLEV+1)      double precision cgae(kdlon, kflev, 2) !aerosol optical properties -"-
110  C      DOUBLE PRECISION PTAUA(KDLON, 2, KFLEV)
111        INTEGER inu, jl, jk, i, k, kpl1      ! CLOUD OPTICAL THICKNESS (pre-industrial value)
112  c  
113        INTEGER swpas  ! Every swpas steps, sw is calculated      DOUBLE PRECISION POMEGAA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
114        PARAMETER(swpas=1)      DOUBLE PRECISION PTOPSWAD(KDLON)
115  c      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
116        INTEGER itapsw  
117        LOGICAL appel1er      DOUBLE PRECISION PSOLSWAD(KDLON)
118        DATA itapsw /0/      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
119        DATA appel1er /.TRUE./  
120  cjq-Introduced for aerosol forcings      DOUBLE PRECISION PTOPSWAI(KDLON)
121        real*8 flag_aer      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
122        logical ok_ade, ok_aie    ! use aerosol forcings or not?  
123        real*8 tauae(kdlon,kflev,2)  ! aerosol optical properties      DOUBLE PRECISION PSOLSWAI(KDLON)
124        real*8 pizae(kdlon,kflev,2)  ! (see aeropt.F)      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
125        real*8 cgae(kdlon,kflev,2)   ! -"-  
126        REAL*8 PTAUA(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (pre-industrial value)      !jq - Fluxes including aerosol effects
127        REAL*8 POMEGAA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO      DOUBLE PRECISION ZFSUPAD(KDLON, KFLEV+1)
128        REAL*8 PTOPSWAD(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)      DOUBLE PRECISION ZFSDNAD(KDLON, KFLEV+1)
129        REAL*8 PSOLSWAD(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)      DOUBLE PRECISION ZFSUPAI(KDLON, KFLEV+1)
130        REAL*8 PTOPSWAI(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)      DOUBLE PRECISION ZFSDNAI(KDLON, KFLEV+1)
131        REAL*8 PSOLSWAI(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)      logical initialized
132  cjq - Fluxes including aerosol effects      SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes
133        REAL*8 ZFSUPAD(KDLON,KFLEV+1)      !rv
134        REAL*8 ZFSDNAD(KDLON,KFLEV+1)      save flag_aer
135        REAL*8 ZFSUPAI(KDLON,KFLEV+1)      data initialized/.false./
136        REAL*8 ZFSDNAI(KDLON,KFLEV+1)  
137        logical initialized      !-------------------------------------------------------------------
138        SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes  
139  !rv      if(.not.initialized) then
140        save flag_aer         flag_aer=0.
141        data initialized/.false./         initialized=.TRUE.
142  cjq-end      endif
143        if(.not.initialized) then      !rv
144          flag_aer=0.  
145          initialized=.TRUE.      IF (appel1er) THEN
146        endif         PRINT*, 'SW calling frequency: ', swpas
147  !rv         PRINT*, " In general, it should be 1"
148                 appel1er = .FALSE.
149  c      ENDIF
150        IF (appel1er) THEN  
151           PRINT*, 'SW calling frequency : ', swpas      IF (MOD(itapsw, swpas).EQ.0) THEN
152           PRINT*, "   In general, it should be 1"         DO JK = 1 , KFLEV
153           appel1er = .FALSE.            DO JL = 1, KDLON
154        ENDIF               ZCLDSW0(JL, JK) = 0.0
155  C     ------------------------------------------------------------------               IF (bug_ozone) then
156        IF (MOD(itapsw,swpas).EQ.0) THEN                  ZOZ(JL, JK) = POZON(JL, JK)*46.6968/RG &
157  c                       *PDP(JL, JK)*(101325.0/PPSOL(JL))
158        DO JK = 1 , KFLEV               ELSE
159        DO JL = 1, KDLON                  ! Correction MPL 100505
160           ZCLDSW0(JL,JK) = 0.0                  ZOZ(JL, JK) = POZON(JL, JK)*RMD/RMO3*46.6968/RG*PDP(JL, JK)
161           IF (bug_ozone) then               ENDIF
162             ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG            ENDDO
163       .               *PDP(JL,JK)*(101325.0/PPSOL(JL))         ENDDO
164           ELSE  
165  c        Correction MPL 100505         ! clear-sky:
166             ZOZ(JL,JK) = POZON(JL,JK)*RMD/RMO3*46.6968/RG*PDP(JL,JK)         CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
167           ENDIF                        PRMU0, PFRAC, PTAVE, PWV, &
168        ENDDO              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
169        ENDDO         INU = 1
170  C         CALL SW1S(INU, &
171  C              PAER, flag_aer, tauae, pizae, cgae, &
172  c clear-sky:              PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
173  cIM ctes ds clesphys.h  CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
174        CALL SWU(PSCT,ZCLDSW0,PPMB,PPSOL,              ZFD, ZFU)
175       S         PRMU0,PFRAC,PTAVE,PWV,         INU = 2
176       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)         CALL SW2S(INU, &
177        INU = 1              PAER, flag_aer, tauae, pizae, cgae, &
178        CALL SW1S(INU,              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
179       S     PAER, flag_aer, tauae, pizae, cgae,              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
180       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,              PWV, PQS, &
181       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,              ZFDOWN, ZFUP)
182       S     ZFD, ZFU)         DO JK = 1 , KFLEV+1
183        INU = 2            DO JL = 1, KDLON
184        CALL SW2S(INU,               ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
185       S     PAER, flag_aer, tauae, pizae, cgae,               ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
186       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,            ENDDO
187       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,         ENDDO
188       S     PWV, PQS,  
189       S     ZFDOWN, ZFUP)         flag_aer=0.0
190        DO JK = 1 , KFLEV+1         CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
191        DO JL = 1, KDLON              PRMU0, PFRAC, PTAVE, PWV, &
192           ZFSUP0(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
193           ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)         INU = 1
194        ENDDO         CALL SW1S(INU, &
195        ENDDO              PAER, flag_aer, tauae, pizae, cgae, &
196                      PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
197        flag_aer=0.0              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
198        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,              ZFD, ZFU)
199       S         PRMU0,PFRAC,PTAVE,PWV,         INU = 2
200       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)         CALL SW2S(INU, &
201        INU = 1              PAER, flag_aer, tauae, pizae, cgae, &
202        CALL SW1S(INU,              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
203       S     PAER, flag_aer, tauae, pizae, cgae,              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
204       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,              PWV, PQS, &
205       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,              ZFDOWN, ZFUP)
206       S     ZFD, ZFU)  
207        INU = 2         ! cloudy-sky:
208        CALL SW2S(INU,  
209       S     PAER, flag_aer, tauae, pizae, cgae,         DO JK = 1 , KFLEV+1
210       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,            DO JL = 1, KDLON
211       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,               ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
212       S     PWV, PQS,               ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
213       S    ZFDOWN, ZFUP)            ENDDO
214           ENDDO
215  c cloudy-sky:  
216                 IF (ok_ade) THEN
217        DO JK = 1 , KFLEV+1            ! cloudy-sky + aerosol dir OB
218        DO JL = 1, KDLON            flag_aer=1.0
219           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
220           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)                 PRMU0, PFRAC, PTAVE, PWV, &
221        ENDDO                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
222        ENDDO            INU = 1
223                    CALL SW1S(INU, &
224  c                       PAER, flag_aer, tauae, pizae, cgae, &
225        IF (ok_ade) THEN                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
226  c                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
227  c cloudy-sky + aerosol dir OB                 ZFD, ZFU)
228        flag_aer=1.0            INU = 2
229        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,            CALL SW2S(INU, &
230       S         PRMU0,PFRAC,PTAVE,PWV,                 PAER, flag_aer, tauae, pizae, cgae, &
231       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
232        INU = 1                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
233        CALL SW1S(INU,                 PWV, PQS, &
234       S     PAER, flag_aer, tauae, pizae, cgae,                 ZFDOWN, ZFUP)
235       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,            DO JK = 1 , KFLEV+1
236       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,               DO JL = 1, KDLON
237       S     ZFD, ZFU)                  ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
238        INU = 2                  ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
239        CALL SW2S(INU,                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
240       S     PAER, flag_aer, tauae, pizae, cgae,                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
241       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,               ENDDO
242       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,            ENDDO
243       S     PWV, PQS,         ENDIF
244       S    ZFDOWN, ZFUP)  
245        DO JK = 1 , KFLEV+1         IF (ok_aie) THEN
246        DO JL = 1, KDLON            !jq cloudy-sky + aerosol direct + aerosol indirect
247           ZFSUPAD(JL,JK) = ZFSUP(JL,JK)            flag_aer=1.0
248           ZFSDNAD(JL,JK) = ZFSDN(JL,JK)            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
249           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)                 PRMU0, PFRAC, PTAVE, PWV, &
250           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
251        ENDDO            INU = 1
252        ENDDO            CALL SW1S(INU, &
253                         PAER, flag_aer, tauae, pizae, cgae, &
254        ENDIF ! ok_ade                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
255                         ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
256        IF (ok_aie) THEN                 ZFD, ZFU)
257                      INU = 2
258  cjq   cloudy-sky + aerosol direct + aerosol indirect            CALL SW2S(INU, &
259        flag_aer=1.0                 PAER, flag_aer, tauae, pizae, cgae, &
260        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
261       S         PRMU0,PFRAC,PTAVE,PWV,                 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
262       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)                 PWV, PQS, &
263        INU = 1                 ZFDOWN, ZFUP)
264        CALL SW1S(INU,            DO JK = 1 , KFLEV+1
265       S     PAER, flag_aer, tauae, pizae, cgae,               DO JL = 1, KDLON
266       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,                  ZFSUPAI(JL, JK) = ZFSUP(JL, JK)
267       S     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,                  ZFSDNAI(JL, JK) = ZFSDN(JL, JK)
268       S     ZFD, ZFU)                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
269        INU = 2                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
270        CALL SW2S(INU,               ENDDO
271       S     PAER, flag_aer, tauae, pizae, cgae,            ENDDO
272       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,         ENDIF
273       S     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,  
274       S     PWV, PQS,         itapsw = 0
275       S    ZFDOWN, ZFUP)      ENDIF
276        DO JK = 1 , KFLEV+1      itapsw = itapsw + 1
277        DO JL = 1, KDLON  
278           ZFSUPAI(JL,JK) = ZFSUP(JL,JK)      DO k = 1, KFLEV
279           ZFSDNAI(JL,JK) = ZFSDN(JL,JK)                   kpl1 = k+1
280           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)         DO i = 1, KDLON
281           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)            PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
282        ENDDO                 -(ZFSDN(i, k)-ZFSDN(i, kpl1))
283        ENDDO            PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
284        ENDIF ! ok_aie                  PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
285  cjq -end                 -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
286                    PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
287        itapsw = 0         ENDDO
288        ENDIF      ENDDO
289        itapsw = itapsw + 1      DO i = 1, KDLON
290  C         PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
291        DO k = 1, KFLEV  
292           kpl1 = k+1         PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
293           DO i = 1, KDLON         PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
294              PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))  
295       .                     -(ZFSDN(i,k)-ZFSDN(i,kpl1))         PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
296              PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)         PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
297              PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))  
298       .                     -(ZFSDN0(i,k)-ZFSDN0(i,kpl1))         PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
299              PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)         PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
300           ENDDO  
301        ENDDO         PSOLSWAI(i) = ZFSDNAI(i, 1) - ZFSUPAI(i, 1)
302        DO i = 1, KDLON         PTOPSWAI(i) = ZFSDNAI(i, KFLEV+1) - ZFSUPAI(i, KFLEV+1)
303           PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)      ENDDO
304  c  
305           PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)    END SUBROUTINE SW
306           PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)  
307  c  end module sw_m
          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.38  
changed lines
  Added in v.53
  ViewVC Help
Powered by ViewVC 1.1.21