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

Annotation of /trunk/phylmd/Radlwsw/lw.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 254 - (hide annotations)
Mon Feb 5 10:39:38 2018 UTC (6 years, 4 months ago) by guez
File size: 5208 byte(s)
Move Sources/* to root directory.
1 guez 71 module lw_m
2    
3     IMPLICIT none
4    
5     contains
6    
7 guez 145 SUBROUTINE LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &
8     PCLDLU, PVIEW, PCOLR, PCOLR0, PTOPLW, PSOLLW, PTOPLW0, PSOLLW0, &
9 guez 71 psollwdown, plwup, plwdn, plwup0, plwdn0)
10    
11 guez 155 use lwbv_m, only: lwbv
12 guez 71 use LWU_m, only: LWU
13     USE raddim, ONLY: kdlon, kflev
14     USE raddimlw, ONLY: nua
15 guez 168 USE suphec_m, ONLY: md, rcpd, rday, rg, rmo3
16 guez 71
17     ! Method.
18    
19     ! 1. Computes the pressure and temperature weighted amounts of
20     ! absorbers.
21    
22 guez 168 ! 2. Computes the Planck functions on the interfaces and the
23     ! gradient of Planck functions in the layers.
24 guez 71
25 guez 168 ! 3. Performs the vertical integration distinguishing the
26     ! contributions of the adjacent and distant layers and those from
27     ! the boundaries.
28 guez 71
29     ! 4. Computes the clear-sky downward and upward emissivities.
30    
31     ! 5. Introduces the effects of the clouds on the fluxes.
32    
33 guez 168 ! Reference: see radiation part of ECMWF documentation of the IFS.
34 guez 71
35     ! Author:
36 guez 168 ! Jean-Jacques Morcrette ECMWF
37 guez 71
38 guez 168 ! Original : July 14th, 1989
39 guez 71
40     DOUBLE PRECISION PCLDLD(KDLON, KFLEV) ! DOWNWARD EFFECTIVE CLOUD COVER
41     DOUBLE PRECISION PCLDLU(KDLON, KFLEV) ! UPWARD EFFECTIVE CLOUD COVER
42     DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER PRESSURE THICKNESS (Pa)
43     DOUBLE PRECISION PDT0(KDLON) ! SURFACE TEMPERATURE DISCONTINUITY (K)
44     DOUBLE PRECISION PEMIS(KDLON) ! SURFACE EMISSIVITY
45     DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF LEVEL PRESSURE (mb)
46     DOUBLE PRECISION POZON(KDLON, KFLEV) ! O3 CONCENTRATION (kg/kg)
47     DOUBLE PRECISION PTL(KDLON, KFLEV+1) ! HALF LEVEL TEMPERATURE (K)
48     DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! OPTICAL THICKNESS OF THE AEROSOLS
49     DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
50     DOUBLE PRECISION PVIEW(KDLON) ! COSECANT OF VIEWING ANGLE
51     DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (kg/kg)
52    
53     DOUBLE PRECISION PCOLR(KDLON, KFLEV) ! LONG-WAVE TENDENCY (K/day)
54     DOUBLE PRECISION PCOLR0(KDLON, KFLEV) ! LONG-WAVE TENDENCY (K/day) clear-sky
55     DOUBLE PRECISION PTOPLW(KDLON) ! LONGWAVE FLUX AT T.O.A.
56     DOUBLE PRECISION PSOLLW(KDLON) ! LONGWAVE FLUX AT SURFACE
57     DOUBLE PRECISION PTOPLW0(KDLON) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
58     DOUBLE PRECISION PSOLLW0(KDLON) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
59     ! Rajout LF
60     double precision psollwdown(kdlon) ! LONGWAVE downwards flux at surface
61     !IM
62     DOUBLE PRECISION plwup(KDLON, KFLEV+1) ! LW up total sky
63     DOUBLE PRECISION plwup0(KDLON, KFLEV+1) ! LW up clear sky
64     DOUBLE PRECISION plwdn(KDLON, KFLEV+1) ! LW down total sky
65     DOUBLE PRECISION plwdn0(KDLON, KFLEV+1) ! LW down clear sky
66    
67     DOUBLE PRECISION ZABCU(KDLON, NUA, 3*KFLEV+1)
68     DOUBLE PRECISION ZOZ(KDLON, KFLEV)
69    
70 guez 168 DOUBLE PRECISION, save:: ZFLUX(KDLON, 2, KFLEV+1)
71     ! RADIATIVE FLUXES (1:up; 2:down)
72 guez 71
73 guez 168 DOUBLE PRECISION, save:: ZFLUC(KDLON, 2, KFLEV+1)
74     ! CLEAR-SKY RADIATIVE FLUXES
75    
76     ! Intermediate variables:
77     DOUBLE PRECISION, save:: ZBINT(KDLON, KFLEV+1)
78     DOUBLE PRECISION, save:: ZBSUI(KDLON)
79     DOUBLE PRECISION, save:: ZCTS(KDLON, KFLEV)
80     DOUBLE PRECISION, save:: ZCNTRB(KDLON, KFLEV+1, KFLEV+1)
81    
82 guez 71 INTEGER ilim, i, k, kpl1
83    
84     INTEGER, PARAMETER:: lw0pas = 1 ! Every lw0pas steps, clear-sky is done
85     INTEGER, PARAMETER:: lwpas = 1 ! Every lwpas steps, cloudy-sky is done
86     ! In general, lw0pas and lwpas should be 1
87    
88     INTEGER:: itaplw0 = 0, itaplw = 0
89    
90     ! ------------------------------------------------------------------
91    
92     IF (MOD(itaplw0, lw0pas) == 0) THEN
93     DO k = 1, KFLEV
94     DO i = 1, KDLON
95     ! convertir ozone de kg/kg en pa (modif MPL 100505)
96     ZOZ(i, k) = POZON(i, k)*PDP(i, k) * MD/RMO3
97     ENDDO
98     ENDDO
99 guez 139 CALL LWU(PAER, PDP, PPMB, ZOZ, PTAVE, PVIEW, PWV, ZABCU)
100 guez 155 CALL LWBV(ILIM, PDT0, PEMIS, PPMB, PTL, PTAVE, ZABCU, &
101 guez 71 ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB)
102     itaplw0 = 0
103     ENDIF
104     itaplw0 = itaplw0 + 1
105    
106     IF (MOD(itaplw, lwpas) == 0) THEN
107     CALL LWC(ILIM, PCLDLD, PCLDLU, PEMIS, &
108     ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB, &
109     ZFLUX)
110     itaplw = 0
111     ENDIF
112     itaplw = itaplw + 1
113    
114     DO k = 1, KFLEV
115     kpl1 = k+1
116     DO i = 1, KDLON
117     PCOLR(i, k) = ZFLUX(i, 1, kpl1)+ZFLUX(i, 2, kpl1) &
118     - ZFLUX(i, 1, k)- ZFLUX(i, 2, k)
119     PCOLR(i, k) = PCOLR(i, k) * RDAY*RG/RCPD / PDP(i, k)
120     PCOLR0(i, k) = ZFLUC(i, 1, kpl1)+ZFLUC(i, 2, kpl1) &
121     - ZFLUC(i, 1, k)- ZFLUC(i, 2, k)
122     PCOLR0(i, k) = PCOLR0(i, k) * RDAY*RG/RCPD / PDP(i, k)
123     ENDDO
124     ENDDO
125     DO i = 1, KDLON
126     PSOLLW(i) = -ZFLUX(i, 1, 1)-ZFLUX(i, 2, 1)
127     PTOPLW(i) = ZFLUX(i, 1, KFLEV+1) + ZFLUX(i, 2, KFLEV+1)
128    
129     PSOLLW0(i) = -ZFLUC(i, 1, 1)-ZFLUC(i, 2, 1)
130     PTOPLW0(i) = ZFLUC(i, 1, KFLEV+1) + ZFLUC(i, 2, KFLEV+1)
131     psollwdown(i) = -ZFLUX(i, 2, 1)
132    
133     !IM attention aux signes !; LWtop >0, LWdn < 0
134     DO k = 1, KFLEV+1
135     plwup(i, k) = ZFLUX(i, 1, k)
136     plwup0(i, k) = ZFLUC(i, 1, k)
137     plwdn(i, k) = ZFLUX(i, 2, k)
138     plwdn0(i, k) = ZFLUC(i, 2, k)
139     ENDDO
140     ENDDO
141    
142     END SUBROUTINE LW
143    
144     end module lw_m

  ViewVC Help
Powered by ViewVC 1.1.21