/[MITgcm]/MITgcm/pkg/bulk_force/bulkf_sh2rh_aim.F
ViewVC logotype

Contents of /MITgcm/pkg/bulk_force/bulkf_sh2rh_aim.F

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

Revision 1.1 - (show annotations) (download)
Sun Jan 22 15:50:37 2006 UTC (20 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint58l_post, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint58e_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint58r_post, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint58a_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58k_post, checkpoint58v_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, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint58b_post, checkpoint58m_post, HEAD 
- add option and parameters to use AIM surface-flux formulae.
1 C $Header: $
2 C $Name: $
3
4 #include "BULK_FORCE_OPTIONS.h"
5
6 SUBROUTINE BULKF_SH2RH_AIM(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_BULK_FORCE
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
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_BULK_FORCE */
117 RETURN
118 END
  ViewVC Help
Powered by ViewVC 1.1.22