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

Annotation of /MITgcm/pkg/aim/phy_shtorh.F

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

Revision 1.4 - (hide annotations) (download)
Thu Sep 6 13:28:01 2001 UTC (22 years, 9 months ago) by adcroft
Branch: MAIN
CVS Tags: icebear2, checkpoint44h_pre, release1_p12, release1_p10, release1_p11, release1_p16, release1_p15, ecco_c44_e17, ecco_c44_e16, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, icebear5, icebear4, checkpoint44f_pre, icebear3, checkpoint46f_post, release1_p13_pre, checkpoint46d_pre, checkpoint46e_post, release1-branch_tutorials, release1_p14, checkpoint44g_post, checkpoint46h_pre, checkpoint44h_post, release1_p12_pre, checkpoint44e_post, checkpoint46e_pre, ecco-branch-mod4, checkpoint43a-release1mods, checkpoint45d_post, checkpoint45b_post, checkpoint46b_pre, chkpt44a_pre, release1-branch-end, release1_final_v1, ecco_c44_e19, checkpoint46, ecco_c44_e20, checkpoint44, release1_p13, ecco_c44_e18, checkpoint44f_post, release1_p17, release1_b1, checkpoint44b_post, chkpt44c_post, chkpt44d_post, checkpoint42, release1_p9, release1_p8, checkpoint43, checkpoint46g_pre, release1_p2, release1_p3, release1_p4, release1_p6, checkpoint46a_post, chkpt44a_post, checkpoint44b_pre, release1_p1, checkpoint46a_pre, ecco-branch-mod1, checkpoint45c_post, release1_p5, checkpoint44e_pre, chkpt44c_pre, checkpoint40pre9, release1_p7, ecco_ice2, ecco_ice1, checkpoint46b_post, checkpoint46d_post, ecco-branch-mod2, checkpoint46g_post, checkpoint45a_post, checkpoint46c_pre, ecco-branch-mod3, ecco-branch-mod5, ecco_c44_e22, release1_beta1, ecco_c44_e23, release1-branch_branchpoint, checkpoint46c_post, checkpoint40, checkpoint45, checkpoint46h_post, release1_chkpt44d_post, ecco_c44_e25, checkpoint41
Branch point for: c24_e25_ice, ecco-branch, release1_coupled, icebear, release1_final, release1-branch, release1, release1_50yr
Changes since 1.3: +3 -1 lines 
Added missing declarations...
1 adcroft 1.4 C $Header: /u/gcmpack/models/MITgcmUV/pkg/aim/phy_shtorh.F,v 1.3 2001/05/29 19:28:53 cnh Exp $
2 cnh 1.3 C $Name: $
3 adcroft 1.2
4 cnh 1.3 SUBROUTINE SHTORH (IMODE,NGP,TA,PS,SIG,QA,RH,QSAT,myThid)
5 adcroft 1.2 C--
6     C-- SUBROUTINE SHTORH (IMODE,NGP,TA,PS,SIG,QA,RH,QSAT)
7     C--
8     C-- Purpose: compute saturation specific humidity and
9     C-- relative hum. from specific hum. (or viceversa)
10     C-- Input: IMODE : mode of operation
11     C-- NGP : no. of grid-points
12     C-- TA : abs. temperature
13     C-- PS : normalized pressure (= p/1000_hPa) [if SIG < 0]
14     C-- : normalized sfc. pres. (= ps/1000_hPa) [if SIG > 0]
15     C-- SIG : sigma level
16     C-- QA : specific humidity in g/kg [if IMODE > 0]
17     C-- RH : relative humidity [if IMODE < 0]
18     C-- QSAT : saturation spec. hum. in g/kg
19     C-- Output: RH : relative humidity [if IMODE > 0]
20     C-- QA : specific humidity in g/kg [if IMODE < 0]
21     C--
22    
23    
24     IMPLICIT rEAL*8 (A-H,O-Z)
25 adcroft 1.4 INTEGER IMODE,NGP,J
26 cnh 1.3 INTEGER myThid
27 adcroft 1.2
28    
29     CcnhDebugStarts
30     #include "SIZE.h"
31     CcnhDebugEnds
32     REAL TA(NGP), PS(NGP), QA(NGP), RH(NGP), QSAT(NGP)
33     C
34     C--- 1. Compute Qsat (g/kg) from T (degK) and normalized pres. P (= p/1000_hPa)
35     C If SIG > 0, P = Ps * sigma, otherwise P = Ps(1) = const.
36     C
37     E0= 6.108 _d -3
38     C1= 17.269 _d 0
39     C2= 21.875 _d 0
40     T0=273.16 _d 0
41     T1= 35.86 _d 0
42     T2= 7.66 _d 0
43     C
44     DO 110 J=1,NGP
45     QSAT(J)=0.
46     IF (TA(J).GE.T0) THEN
47     QSAT(J)=E0*EXP(C1*(TA(J)-T0)/(TA(J)-T1))
48     ELSE IF ( TA(J).GT.0.) then
49     QSAT(J)=E0*EXP(C2*(TA(J)-T0)/(TA(J)-T2))
50     ENDIF
51     110 CONTINUE
52     C
53     IF (SIG.LE.0.0) THEN
54     DO 120 J=1,NGP
55     QSAT(J)=622. _d 0*QSAT(J)/(PS(1)-0.378 _d 0*QSAT(J))
56     120 CONTINUE
57     ELSE
58     DO 130 J=1,NGP
59     QSAT(J)=622. _d 0*QSAT(J)/(SIG*PS(J)-0.378 _d 0*QSAT(J))
60     130 CONTINUE
61     ENDIF
62     chh write(0,*) 'MAXVAL(QSAT)=',MAXVAL(QSAT)
63     chh write(0,*) 'MINVAL(QSAT)=',MINVAL(QSAT)
64     C
65     C--- 2. Compute rel.hum. RH=Q/Qsat (IMODE>0), or Q=RH*Qsat (IMODE<0)
66     C
67     IF (IMODE.GT.0) THEN
68     DO 210 J=1,NGP
69     IF(QSAT(J).ne.0.) then
70     RH(J)=QA(J)/QSAT(J)
71     ELSE
72     RH(J)=0.
73     ENDIF
74     210 CONTINUE
75     ELSE IF (IMODE.LT.0) THEN
76     DO 220 J=1,NGP
77     QA(J)=RH(J)*QSAT(J)
78     220 CONTINUE
79     ENDIF
80     chh write(0,*) 'MAXVAL(QA)=',MAXVAL(QA)
81     chh write(0,*) 'MINVAL(QA)=',MINVAL(QA)
82     chh write(0,*) 'MAXVAL(RH)=',MAXVAL(RH)
83     chh write(0,*) 'MINVAL(RH)=',MINVAL(RH)
84     C
85     RETURN
86     END
87    
88     SUBROUTINE ZMEDDY (NLON,NLAT,FF,ZM,EDDY)
89    
90    
91     IMPLICIT rEAL*8 (A-H,O-Z)
92 adcroft 1.4 INTEGER NLON,NLAT,I,J
93 adcroft 1.2
94    
95     C
96     C *** Decompose a field into zonal-mean and eddy component
97     C
98     REAL FF(NLON,NLAT), ZM(NLAT), EDDY(NLON,NLAT)
99     C
100     RNLON=1./NLON
101     C
102     DO 130 J=1,NLAT
103     C
104     ZM(J)=0.
105     DO 110 I=1,NLON
106     ZM(J)=ZM(J)+FF(I,J)
107     110 CONTINUE
108     ZM(J)=ZM(J)*RNLON
109     C
110     DO 120 I=1,NLON
111     EDDY(I,J)=FF(I,J)-ZM(J)
112     120 CONTINUE
113     C
114     130 CONTINUE
115     C
116     C--
117     RETURN
118     END
119     C
  ViewVC Help
Powered by ViewVC 1.1.22