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

Annotation of /MITgcm/pkg/aim_v23/aim_land_impl.F

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


Revision 1.2 - (hide annotations) (download)
Fri May 21 17:43:04 2004 UTC (19 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint53d_post, checkpoint53c_post, checkpoint53d_pre
Changes since 1.1: +44 -13 lines
decide to evaporate snow (rather than liq.W) independently of snow precip

1 jmc 1.2 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_land_impl.F,v 1.1 2004/03/11 14:33:18 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "AIM_OPTIONS.h"
5     #ifdef ALLOW_LAND
6     #include "LAND_OPTIONS.h"
7     #endif
8    
9     CBOP
10     C !ROUTINE: AIM_LAND_IMPL
11     C !INTERFACE:
12     SUBROUTINE AIM_LAND_IMPL(
13 jmc 1.2 I FMASK, dTskin,
14 jmc 1.1 I Evp0, dEvp, Slr0, dSlr,
15 jmc 1.2 U sFlx,
16 jmc 1.1 U Tsurf, EVAP, SLRU,
17     I bi, bj, myTime, myIter, myThid)
18    
19     C !DESCRIPTION: \bv
20     C *==========================================================*
21     C | S/R AIM_LAND_IMPL
22     C | o AIM Interface to the implicit part of the land model
23     C *==========================================================*
24     C \ev
25    
26     C !USES:
27     IMPLICIT NONE
28    
29     C == Global variables ===
30     C-- size for MITgcm & Physics package :
31     #include "AIM_SIZE.h"
32    
33     #include "EEPARAMS.h"
34     #include "PARAMS.h"
35    
36     #include "AIM_FFIELDS.h"
37     #include "com_physcon.h"
38     c #include "com_physvar.h"
39    
40     #ifdef ALLOW_LAND
41     #include "LAND_SIZE.h"
42     #include "LAND_PARAMS.h"
43     #include "LAND_VARS.h"
44     #endif
45    
46     C !INPUT/OUTPUT PARAMETERS:
47     C == Routine arguments ==
48     C FMASK :: land fraction [0-1]
49     C dTskin :: temp. correction for daily-cycle heating [K]
50     C Evp0 :: evaporation computed over freezing surface (Ts=0.oC)
51     C dEvp :: evaporation derivative relative to surf. temp
52     C Slr0 :: upward long wave radiation over freezing surf.
53 jmc 1.2 C dSlr :: upward long wave derivative relative to surf. temp
54     C sFlx :: net surface flux (+=down) function of surf. temp Ts:
55     C 0: Flux(Ts=0.oC) ; 1: Flux(Ts^n) ; 2: d.Flux/d.Ts(Ts^n)
56 jmc 1.1 C Tsurf :: surface temperature (2-dim)
57     C EVAP :: evaporation [g/(m^2 s)] (2-dim)
58     C SLRU :: sfc lw radiation (upward flux) (2-dim)
59     C bi,bj :: Tile index
60     C myTime :: Current time of simulation ( s )
61     C myIter :: Current iteration number in simulation
62     C myThid :: Number of this instance of the routine
63 jmc 1.2 _RL FMASK(NGP), dTskin(NGP)
64 jmc 1.1 _RL Evp0(NGP), dEvp(NGP), Slr0(NGP), dSlr(NGP)
65 jmc 1.2 _RL sFlx(NGP,0:2)
66 jmc 1.1 _RL Tsurf(NGP), EVAP(NGP), SLRU(NGP)
67     INTEGER bi, bj, myIter, myThid
68     _RL myTime
69     CEOP
70    
71     #ifdef ALLOW_AIM
72     #ifdef ALLOW_LAND
73     C == Local variables ==
74     C i,j, I2 :: loop counters
75     C dTsurf :: surf. temp change after 1 implicit time step [oC]
76     _RL dTsurf(NGP)
77     INTEGER i,j, I2
78    
79 jmc 1.2 IF ( useLand .AND. land_impl_grT ) THEN
80 jmc 1.1
81 jmc 1.2 C- Initialisation :
82 jmc 1.1 DO j=1,sNy
83     DO i=1,sNx
84     I2 = i+(j-1)*sNx
85    
86     C- initialize temp. changes and fresh water flux :
87     dTsurf(I2) = 0.
88     land_Pr_m_Ev(i,j,bi,bj) = 0. _d 0
89 jmc 1.2 land_EnWFlux(i,j,bi,bj) = 0. _d 0
90 jmc 1.1
91     ENDDO
92     ENDDO
93    
94 jmc 1.2 IF ( land_calc_snow ) THEN
95     C- Evap of snow: substract Latent Heat of freezing from heatFlux
96     DO j=1,sNy
97     DO i=1,sNx
98     I2 = i+(j-1)*sNx
99     IF ( land_skinT(i,j,bi,bj).LT. 0. _d 0 .OR.
100     & land_hSnow(i,j,bi,bj).GT. 0. _d 0 ) THEN
101     sFlx(I2,0) = sFlx(I2,0) - ALHF*Evp0(I2)
102     sFlx(I2,1) = sFlx(I2,1) - ALHF*EVAP(I2)
103     sFlx(I2,2) = sFlx(I2,2) - ALHF*dEvp(I2)
104     land_EnWFlux(i,j,bi,bj) = -ALHF
105     ENDIF
106     ENDDO
107     ENDDO
108     ENDIF
109    
110 jmc 1.1 CALL LAND_IMPL_TEMP(
111     I aim_landFr,
112     I dTskin, sFlx,
113     O dTsurf,
114     I bi, bj, myTime, myIter, myThid)
115    
116 jmc 1.2 C-- Surface B.C. for atmospheric physics:
117 jmc 1.1 C- Update Surf.Temp., Evap, Upward SW according to surf. temp. changes
118     DO J=1,NGP
119     IF ( dTsurf(J) .GT. 999. ) THEN
120     Tsurf(J) = tFreeze
121     EVAP(J) = Evp0(J)
122     SLRU(J) = Slr0(J)
123     ELSE
124     Tsurf(J) = Tsurf(J)+ dTsurf(J)
125     EVAP(J) = EVAP(J) + dTsurf(J)*dEvp(J)
126     SLRU(J) = SLRU(J) + dTsurf(J)*dSlr(J)
127     ENDIF
128     ENDDO
129    
130 jmc 1.2 C- Update surface fluxes for Land model:
131     DO j=1,sNy
132     DO i=1,sNx
133     I2 = i+(j-1)*sNx
134     C- net surface downward heat flux :
135     IF ( dTsurf(I2) .GT. 999. ) THEN
136     land_HeatFlx(i,j,bi,bj) = sFlx(I2,0)
137     ELSE
138     land_HeatFlx(i,j,bi,bj) = sFlx(I2,1)+dTsurf(I2)*sFlx(I2,2)
139     ENDIF
140     C- energy flux associated with Evap of Snow
141     land_EnWFlux(i,j,bi,bj) = -land_EnWFlux(i,j,bi,bj)*EVAP(I2)
142     ENDDO
143     ENDDO
144    
145     C- end (if useLand & land_impl_grT)
146 jmc 1.1 ENDIF
147    
148     #endif /* ALLOW_LAND */
149     #endif /* ALLOW_AIM */
150    
151     RETURN
152     END

  ViewVC Help
Powered by ViewVC 1.1.22