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

Contents of /trunk/Sources/phylmd/Radlwsw/lw.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 139 - (show annotations)
Tue May 26 17:46:03 2015 UTC (9 years ago) by guez
File size: 5363 byte(s) 
dynetat0 read rlonu, rlatu, rlonv, rlatv, cu_2d, cv_2d, aire_2d from
"start.nc" and then these variables were overwritten by
inigeom. Corrected this. Now, inigeom does not compute rlonu, rlatu,
rlonv and rlatv. Moreover, cu_2d, cv_2d, aire_2d are not written to
"restart.nc". Since xprimu, xprimv, xprimm025, xprimp025, rlatu1,
rlatu2, yprimu1, yprimu2 are computed at the same time as rlonu,
rlatu, rlonv, rlatv, and since it would not be convenient to separate
those computations, we decide to write xprimu, xprimv, xprimm025,
xprimp025, rlatu1, rlatu2, yprimu1, yprimu2 into "restart.nc", read
them from "start.nc" and not compute them in inigeom. So, in summary,
"start.nc" contains all the coordinates and their derivatives, and
inigeom only computes the 2D-variables.

Technical details:

Moved variables rlatu, rlonv, rlonu, rlatv, xprimu, xprimv from module
comgeom to module dynetat0_m. Upgraded local variables rlatu1,
yprimu1, rlatu2, yprimu2, xprimm025, xprimp025 of procedure inigeom to
variables of module dynetat0_m.

Removed unused local variable yprimu of procedure inigeom and
corresponding argument yyprimu of fyhyp.

Moved variables clat, clon, grossismx, grossismy, dzoomx, dzoomy,
taux, tauy from module serre to module dynetat0_m (since they are read
from "start.nc"). The default values are now defined in read_serre
instead of in the declarations. Changed name of module serre to
read_serre_m, no more module variable here.

The calls to fxhyp and fyhyp are moved from inigeom to etat0.

Side effects in programs other than gcm: etat0 and read_serre write
variables of module dynetat0; the programs test_fxyp and
test_inter_barxy need more source files.

Removed unused arguments len and nd of cv3_tracer. Removed unused
argument PPSOL of LWU.

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