/[MITgcm]/MITgcm/pkg/aim_v23/phy_suflux_land.F
ViewVC logotype

Contents of /MITgcm/pkg/aim_v23/phy_suflux_land.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.4 - (show annotations) (download)
Thu Jul 22 23:01:05 2004 UTC (19 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint58l_post, checkpoint64z, checkpoint57t_post, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint57o_post, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint58e_post, checkpoint57v_post, checkpoint58u_post, checkpoint58w_post, checkpoint57m_post, checkpoint55c_post, checkpoint54e_post, checkpoint57s_post, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint57k_post, checkpoint55d_pre, checkpoint57d_post, checkpoint57g_post, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint57b_post, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint56b_post, checkpoint57i_post, checkpoint57y_post, checkpoint57e_post, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint55h_post, checkpoint58n_post, checkpoint58x_post, checkpoint57g_pre, checkpoint55b_post, checkpoint58t_post, checkpoint58h_post, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint54d_post, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint56c_post, checkpoint57y_pre, checkpoint55, checkpoint57f_pre, checkpoint57a_post, checkpoint58q_post, checkpoint54f_post, checkpoint59q, checkpoint59p, checkpoint55g_post, checkpoint59r, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, eckpoint57e_pre, checkpoint57h_done, checkpoint58f_post, checkpoint57x_post, checkpoint57n_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint57f_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint57c_post, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint55e_post, checkpoint58k_post, checkpoint58v_post, checkpoint55a_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint57j_post, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint58b_post, checkpoint57h_pre, checkpoint58m_post, checkpoint57l_post, checkpoint57h_post, checkpoint56a_post, checkpoint55d_post, HEAD
Changes since 1.3: +25 -1 lines 
allow dew to form on land (evaporation < 0) with #define ALLOW_DEW_ON_LAND
1 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/phy_suflux_land.F,v 1.3 2004/06/24 23:43:11 jmc Exp $
2 C $Name: $
3
4 #include "AIM_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: SUFLUX_LAND
8 C !INTERFACE:
9 SUBROUTINE SUFLUX_LAND(
10 I PSA, FMASK, EMISloc,
11 I Tsurf, dTskin, SWAV, SSR, SLRD,
12 I T1, T0, Q0, DENVV,
13 O SHF, EVAP, SLRU,
14 O Shf0, dShf, Evp0, dEvp, Slr0, dSlr, sFlx,
15 O TSFC, TSKIN,
16 I bi,bj,myThid)
17
18 C !DESCRIPTION: \bv
19 C *==========================================================*
20 C | S/R SUFLUX_LAND
21 C | o compute surface flux over land
22 C *==========================================================*
23 C | o contains part of original S/R SUFLUX (Speedy code)
24 C *==========================================================*
25 C \ev
26
27 C !USES:
28 IMPLICIT NONE
29
30 C Resolution parameters
31
32 C-- size for MITgcm & Physics package :
33 #include "AIM_SIZE.h"
34 #include "EEPARAMS.h"
35
36 C-- Physics package
37 #include "AIM_PARAMS.h"
38
39 C Physical constants + functions of sigma and latitude
40 #include "com_physcon.h"
41
42 C Surface flux constants
43 #include "com_sflcon.h"
44
45 C !INPUT/OUTPUT PARAMETERS:
46 C == Routine Arguments ==
47 C-- Input:
48 C PSA :: norm. surface pressure [p/p0] (2-dim)
49 C FMASK :: fractional land-sea mask (2-dim)
50 C EMISloc:: longwave surface emissivity
51 C Tsurf :: surface temperature (2-dim)
52 C dTskin :: temp. correction for daily-cycle heating [K]
53 C SWAV :: soil wetness availability [0-1] (2-dim)
54 C SSR :: sfc sw radiation (net flux) (2-dim)
55 C SLRD :: sfc lw radiation (downward flux)(2-dim)
56 C T1 :: near-surface air temperature (from Pot.temp)
57 C T0 :: near-surface air temperature (2-dim)
58 C Q0 :: near-surface sp. humidity [g/kg](2-dim)
59 C DENVV :: surface flux (sens,lat.) coeff. (=Rho*|V|) [kg/m2/s]
60 C-- Output:
61 C SHF :: sensible heat flux (2-dim)
62 C EVAP :: evaporation [g/(m^2 s)] (2-dim)
63 C SLRU :: sfc lw radiation (upward flux) (2-dim)
64 C Shf0 :: sensible heat flux over freezing surf.
65 C dShf :: sensible heat flux derivative relative to surf. temp
66 C Evp0 :: evaporation computed over freezing surface (Ts=0.oC)
67 C dEvp :: evaporation derivative relative to surf. temp
68 C Slr0 :: upward long wave radiation over freezing surf.
69 C dSlr :: upward long wave rad. derivative relative to surf. temp
70 C sFlx :: net surface flux (+=down) function of surf. temp Ts:
71 C 0: Flux(Ts=0.oC) ; 1: Flux(Ts^n) ; 2: d.Flux/d.Ts(Ts^n)
72 C TSFC :: surface temperature (clim.) (2-dim)
73 C TSKIN :: skin surface temperature (2-dim)
74 C-- Input:
75 C bi,bj :: tile index
76 C myThid :: Thread number for this instance of the routine
77 C--
78 _RL PSA(NGP), FMASK(NGP), EMISloc
79 _RL Tsurf(NGP), dTskin(NGP), SWAV(NGP)
80 _RL SSR(NGP), SLRD(NGP)
81 _RL T1(NGP), T0(NGP), Q0(NGP), DENVV(NGP)
82
83 _RL SHF(NGP), EVAP(NGP), SLRU(NGP)
84 _RL Shf0(NGP), dShf(NGP), Evp0(NGP), dEvp(NGP)
85 _RL Slr0(NGP), dSlr(NGP), sFlx(NGP,0:2)
86 _RL TSFC(NGP), TSKIN(NGP)
87
88 INTEGER bi,bj,myThid
89 CEOP
90
91 #ifdef ALLOW_AIM
92
93 C-- Local variables:
94 C CDENVV :: surf. heat flux (sens.,lat.) coeff including stability effect
95 _RL CDENVV(NGP), RDTH, FSLAND
96 _RL Fstb0, dTstb, dFstb
97 _RL QSAT0(NGP,2)
98 _RL QDUMMY(1), RDUMMY(1), TS2
99 INTEGER J
100
101 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
102
103 C 1.5 Define effective skin temperature to compensate for
104 C non-linearity of heat/moisture fluxes during the daily cycle
105
106 DO J=1,NGP
107 TSKIN(J) = Tsurf(J) + dTskin(J)
108 TSFC(J)=273.16 _d 0 + dTskin(J)
109 ENDDO
110
111
112 C-- 2. Computation of fluxes over land and sea
113
114 C 2.1 Stability correction
115
116 RDTH = FSTAB/DTHETA
117
118 DO J=1,NGP
119 FSLAND=1.+MIN(DTHETA,MAX(-DTHETA,TSKIN(J)-T1(J)))*RDTH
120 CDENVV(J)=CHL*DENVV(J)*FSLAND
121 ENDDO
122
123 IF ( dTstab.GT.0. _d 0 ) THEN
124 C- account for stability function derivative relative to Tsurf:
125 C note: to avoid discontinuity in the derivative (because of min,max), compute
126 C the derivative using the discrete form: F(Ts+dTstab)-F(Ts-dTstab)/2.dTstab
127 DO J=1,NGP
128 Fstb0 = 1.+MIN(DTHETA,MAX(-DTHETA,TSFC(J) -T1(J)))*RDTH
129 Shf0(J) = CHL*DENVV(J)*Fstb0
130 dTstb = ( DTHETA+dTstab-ABS(TSKIN(J)-T1(J)) )/dTstab
131 dFstb = RDTH*MIN(1. _d 0, MAX(0. _d 0, dTstb*0.5 _d 0))
132 dShf(J) = CHL*DENVV(J)*dFstb
133 ENDDO
134 ENDIF
135
136 C 2.2 Evaporation
137
138 CALL SHTORH (2, NGP, TSKIN, PSA, 1. _d 0, QDUMMY, dEvp,
139 & QSAT0(1,1), myThid)
140 CALL SHTORH (0, NGP, TSFC, PSA, 1. _d 0, QDUMMY, RDUMMY,
141 & QSAT0(1,2), myThid)
142
143 #ifdef ALLOW_DEW_ON_LAND
144 C-- allow negative evaporation (dew):
145 IF ( dTstab.GT.0. _d 0 ) THEN
146 C- account for stability function derivative relative to Tsurf:
147 DO J=1,NGP
148 EVAP(J) = CDENVV(J)*SWAV(J)*(QSAT0(J,1)-Q0(J))
149 Evp0(J) = Shf0(J)*SWAV(J)*(QSAT0(J,2)-Q0(J))
150 dEvp(J) = CDENVV(J)*SWAV(J)*dEvp(J)
151 & + dShf(J)*SWAV(J)*(QSAT0(J,1)-Q0(J))
152 ENDDO
153 ELSE
154 DO J=1,NGP
155 EVAP(J) = CDENVV(J)*SWAV(J)*(QSAT0(J,1)-Q0(J))
156 Evp0(J) = CDENVV(J)*SWAV(J)*(QSAT0(J,2)-Q0(J))
157 dEvp(J) = CDENVV(J)*SWAV(J)*dEvp(J)
158 ENDDO
159 ENDIF
160 #else /* ALLOW_DEW_ON_LAND */
161 C-- allow only positive evaporation (no dew):
162 IF ( dTstab.GT.0. _d 0 ) THEN
163 C- account for stability function derivative relative to Tsurf:
164 DO J=1,NGP
165 EVAP(J) = CDENVV(J)*SWAV(J)*MAX(0. _d 0,QSAT0(J,1)-Q0(J))
166 Evp0(J) = Shf0(J)*SWAV(J)*MAX(0. _d 0,QSAT0(J,2)-Q0(J))
167 dEvp(J) = CDENVV(J)*SWAV(J)*dEvp(J)
168 & + dShf(J)*SWAV(J)*MAX(0. _d 0,QSAT0(J,1)-Q0(J))
169 ENDDO
170 ELSE
171 DO J=1,NGP
172 C EVAP(J,1) = CDENVV(J,1)*SWAV(J)*MAX(0. _d 0,QSAT0(J,1)-Q0(J))
173 c EVAP(J,1) = CDENVV(J,1)*MAX(0. _d 0,SWAV(J)*QSAT0(J,1)-Q0(J))
174 Cjmc: try the other formulation (= described in F.M paper):
175 EVAP(J) = CDENVV(J)*SWAV(J)*MAX(0. _d 0,QSAT0(J,1)-Q0(J))
176 Evp0(J) = CDENVV(J)*SWAV(J)*MAX(0. _d 0,QSAT0(J,2)-Q0(J))
177 dEvp(J) = CDENVV(J)*SWAV(J)*dEvp(J)
178 ENDDO
179 ENDIF
180 #endif /* ALLOW_DEW_ON_LAND */
181
182 C 2.3 Sensible heat flux
183
184 IF ( dTstab.GT.0. _d 0 ) THEN
185 C- account for stability function derivative relative to Tsurf:
186 DO J=1,NGP
187 SHF(J) = CDENVV(J)*CP*(TSKIN(J)-T0(J))
188 Shf0(J) = Shf0(J)*CP*(TSFC(J) -T0(J))
189 dShf(J) = CDENVV(J)*CP
190 & + dShf(J)*CP*(TSKIN(J)-T0(J))
191 dShf(J) = MAX( dShf(J), 0. _d 0 )
192 C-- do not allow negative derivative vs Ts of Sensible+Latent H.flux:
193 C a) quiet unrealistic ;
194 C b) garantee positive deriv. of total H.flux (needed for implicit solver)
195 dEvp(J) = MAX( dEvp(J), -dShf(J)/ALHC )
196 ENDDO
197 ELSE
198 DO J=1,NGP
199 SHF(J) = CDENVV(J)*CP*(TSKIN(J)-T0(J))
200 Shf0(J) = CDENVV(J)*CP*(TSFC(J) -T0(J))
201 dShf(J) = CDENVV(J)*CP
202 ENDDO
203 ENDIF
204
205 C 2.4 Emission of lw radiation from the surface
206
207 DO J=1,NGP
208 TS2 = TSFC(J)*TSFC(J)
209 Slr0(J) = SBC*TS2*TS2
210 TS2 = TSKIN(J)*TSKIN(J)
211 SLRU(J) = SBC*TS2*TS2
212 dSlr(J) = 4. _d 0 *SBC*TS2*TSKIN(J)
213 ENDDO
214
215 C-- Compute net surface heat flux (+=down) and its derivative ./. surf. temp.
216 DO J=1,NGP
217 sFlx(J,0)= ( SSR(J) + SLRD(J) - EMISloc*Slr0(J) )
218 & - ( Shf0(J) + ALHC*Evp0(J) )
219 sFlx(J,1)= ( SSR(J) + SLRD(J) - EMISloc*SLRU(J) )
220 & - ( SHF(J)+ ALHC*EVAP(J) )
221 sFlx(J,2)= - EMISloc*dSlr(J)
222 & - ( dShf(J) + ALHC*dEvp(J) )
223 ENDDO
224
225 C-- 3. Adjustment of skin temperature and fluxes over land
226 C-- based on energy balance (to be implemented)
227 C <= done separately for each surface type (land,sea,sea-ice)
228
229 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
230 #endif /* ALLOW_AIM */
231
232 RETURN
233 END
  ViewVC Help
Powered by ViewVC 1.1.22