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

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

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

Revision 1.3 - (show annotations) (download)
Thu Mar 11 14:33:19 2004 UTC (20 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57g_pre, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint54d_post, checkpoint54e_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint58, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint53, checkpoint58f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint54f_post, checkpoint55i_post, checkpoint57l_post, checkpoint57t_post, checkpoint55c_post, checkpoint57v_post, checkpoint57f_post, checkpoint53d_post, checkpoint57a_post, checkpoint57h_pre, checkpoint54b_post, checkpoint57h_post, checkpoint52m_post, checkpoint57y_pre, checkpoint55g_post, checkpoint57c_post, checkpoint55d_post, checkpoint58e_post, checkpoint54a_pre, checkpoint53c_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint57e_post, checkpoint55b_post, checkpoint53a_post, checkpoint55f_post, checkpoint53g_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint56a_post, checkpoint53f_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint58g_post, checkpoint52l_post, checkpoint52n_post, checkpoint53b_pre, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint57k_post, checkpoint53b_post, checkpoint57w_post, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint53d_pre, checkpoint55e_post, checkpoint54c_post
Changes since 1.2: +35 -8 lines 
a) Treat separately land / ocean / sea-ice surface fluxes
   to allow implicit computation of land & sea-ice surface temp.
b) add snow precipitation
c) other (little) modifications for new land formulation.
1 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/phy_shtorh.F,v 1.2 2003/04/26 23:38:15 jmc Exp $
2 C $Name: $
3
4 #include "AIM_OPTIONS.h"
5
6 SUBROUTINE SHTORH (IMODE,NGP,TA,PS,SIG,QA,RH,QSAT,myThid)
7 C--
8 C-- SUBROUTINE SHTORH (IMODE,NGP,TA,PS,SIG,QA,RH,QSAT)
9 C--
10 C-- Purpose: compute saturation specific humidity and
11 C-- relative hum. from specific hum. (or viceversa)
12 C-- Input: IMODE : mode of operation
13 C-- NGP : no. of grid-points
14 C-- TA : abs. temperature
15 C-- PS : normalized pressure (= p/1000_hPa) [if SIG < 0]
16 C-- : normalized sfc. pres. (= ps/1000_hPa) [if SIG > 0]
17 C-- SIG : sigma level
18 C-- QA : specific humidity in g/kg [if IMODE = 1]
19 C-- RH : relative humidity [if IMODE < 0]
20 C-- Output: RH : relative humidity [if IMODE = 1]
21 C-- QA : specific humidity in g/kg [if IMODE < 0]
22 C-- QSAT : saturation spec. hum. in g/kg
23 C-- RH : d.Qsat/d.T in g/kg/K [if IMODE = 2]
24 C--
25
26 IMPLICIT NONE
27
28 C-- Routine arguments:
29 INTEGER IMODE, NGP
30 INTEGER myThid
31 c _RL TA(NGP), PS(NGP), QA(NGP), RH(NGP), QSAT(NGP)
32 _RL TA(NGP), PS(NGP), QSAT(NGP), QA(*), RH(*)
33
34 C- jmc: declare all routine arguments:
35 _RL SIG
36
37 #ifdef ALLOW_AIM
38
39 C-- Local variables:
40 INTEGER J
41
42 C- jmc: declare all local variables:
43 _RL E0, C1, C2, T0, T1, T2, QS1, QS2
44 _RL sigP, recT, tmpQ
45 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
46
47 C--- 1. Compute Qsat (g/kg) from T (degK) and normalized pres. P (= p/1000_hPa)
48 C If SIG > 0, P = Ps * sigma, otherwise P = Ps(1) = const.
49 C
50 E0= 6.108 _d -3
51 C1= 17.269 _d 0
52 C2= 21.875 _d 0
53 T0=273.16 _d 0
54 T1= 35.86 _d 0
55 T2= 7.66 _d 0
56 QS1= 622. _d 0
57 QS2= .378 _d 0
58 C
59
60 IF (IMODE.EQ.2) THEN
61 C- Compute Qsat and d.Qsat/d.T :
62 DO J=1,NGP
63 QSAT(J)=0.
64 sigP = PS(1)
65 IF (SIG.GT.0.0) sigP=SIG*PS(J)
66 IF (TA(J).GE.T0) THEN
67 tmpQ = E0*EXP(C1*(TA(J)-T0)/(TA(J)-T1))
68 QSAT(J)= QS1*tmpQ/(sigP-QS2*tmpQ)
69 recT = 1. _d 0 / (TA(J)-T1)
70 RH(J) = QSAT(J)*C1*(T0-T1)*recT*recT*sigP/(sigP-QS2*tmpQ)
71 ELSE IF ( TA(J).GT.T2) THEN
72 tmpQ = E0*EXP(C2*(TA(J)-T0)/(TA(J)-T2))
73 QSAT(J)= QS1*tmpQ/(sigP-QS2*tmpQ)
74 recT = 1. _d 0 / (TA(J)-T2)
75 RH(J) = QSAT(J)*C2*(T0-T2)*recT*recT*sigP/(sigP-QS2*tmpQ)
76 ENDIF
77 ENDDO
78 RETURN
79 ENDIF
80
81 DO 110 J=1,NGP
82 QSAT(J)=0.
83 IF (TA(J).GE.T0) THEN
84 QSAT(J)=E0*EXP(C1*(TA(J)-T0)/(TA(J)-T1))
85 ELSE IF ( TA(J).GT.T2) THEN
86 QSAT(J)=E0*EXP(C2*(TA(J)-T0)/(TA(J)-T2))
87 ENDIF
88 110 CONTINUE
89 C
90 IF (SIG.LE.0.0) THEN
91 DO 120 J=1,NGP
92 QSAT(J)= QS1*QSAT(J)/( PS(1) - QS2*QSAT(J))
93 120 CONTINUE
94 ELSE
95 DO 130 J=1,NGP
96 QSAT(J)= QS1*QSAT(J)/(SIG*PS(J)- QS2*QSAT(J))
97 130 CONTINUE
98 ENDIF
99 C
100 C--- 2. Compute rel.hum. RH=Q/Qsat (IMODE>0), or Q=RH*Qsat (IMODE<0)
101 C
102 IF (IMODE.GT.0) THEN
103 DO 210 J=1,NGP
104 IF(QSAT(J).NE.0.) then
105 RH(J)=QA(J)/QSAT(J)
106 ELSE
107 RH(J)=0.
108 ENDIF
109 210 CONTINUE
110 ELSE IF (IMODE.LT.0) THEN
111 DO 220 J=1,NGP
112 QA(J)=RH(J)*QSAT(J)
113 220 CONTINUE
114 ENDIF
115
116 #endif /* ALLOW_AIM */
117 RETURN
118 END
119
120 SUBROUTINE ZMEDDY (NLON,NLAT,FF,ZM,EDDY)
121
122 IMPLICIT NONE
123
124 C *** Decompose a field into zonal-mean and eddy component
125
126 C-- Routine arguments:
127 INTEGER NLON, NLAT
128 _RL FF(NLON,NLAT), ZM(NLAT), EDDY(NLON,NLAT)
129
130 #ifdef ALLOW_AIM
131
132 C-- Local variables:
133 INTEGER I,J
134
135 C- jmc: declare all local variables:
136 _RL RNLON
137 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
138
139 RNLON=1./NLON
140 C
141 DO 130 J=1,NLAT
142 C
143 ZM(J)=0.
144 DO 110 I=1,NLON
145 ZM(J)=ZM(J)+FF(I,J)
146 110 CONTINUE
147 ZM(J)=ZM(J)*RNLON
148 C
149 DO 120 I=1,NLON
150 EDDY(I,J)=FF(I,J)-ZM(J)
151 120 CONTINUE
152 C
153 130 CONTINUE
154 C
155 C--
156 #endif /* ALLOW_AIM */
157
158 RETURN
159 END
  ViewVC Help
Powered by ViewVC 1.1.22