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

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

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

revision 1.1 by cnh, Fri Jan 26 00:14:32 2001 UTC revision 1.2 by adcroft, Fri Feb 2 21:36:29 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    C $Name$
3    
4          SUBROUTINE SHTORH (IMODE,NGP,TA,PS,SIG,QA,RH,QSAT)
5    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    
26    
27    CcnhDebugStarts
28    #include "SIZE.h"
29    CcnhDebugEnds
30          REAL TA(NGP), PS(NGP), QA(NGP), RH(NGP), QSAT(NGP)
31    C
32    C---  1. Compute Qsat (g/kg) from T (degK) and normalized pres. P (= p/1000_hPa)
33    C        If SIG > 0, P = Ps * sigma, otherwise P = Ps(1) = const.
34    C
35          E0=  6.108 _d -3
36          C1= 17.269 _d 0
37          C2= 21.875 _d 0
38          T0=273.16 _d 0
39          T1= 35.86 _d 0
40          T2=  7.66 _d 0
41    C
42          DO 110 J=1,NGP
43            QSAT(J)=0.
44            IF (TA(J).GE.T0) THEN
45              QSAT(J)=E0*EXP(C1*(TA(J)-T0)/(TA(J)-T1))
46            ELSE IF ( TA(J).GT.0.) then
47              QSAT(J)=E0*EXP(C2*(TA(J)-T0)/(TA(J)-T2))
48            ENDIF
49      110 CONTINUE
50    C
51          IF (SIG.LE.0.0) THEN
52            DO 120 J=1,NGP
53              QSAT(J)=622. _d 0*QSAT(J)/(PS(1)-0.378 _d 0*QSAT(J))
54      120   CONTINUE
55          ELSE
56            DO 130 J=1,NGP
57              QSAT(J)=622. _d 0*QSAT(J)/(SIG*PS(J)-0.378 _d 0*QSAT(J))
58      130   CONTINUE
59          ENDIF
60    chh      write(0,*) 'MAXVAL(QSAT)=',MAXVAL(QSAT)
61    chh      write(0,*) 'MINVAL(QSAT)=',MINVAL(QSAT)
62    C
63    C---  2. Compute rel.hum. RH=Q/Qsat (IMODE>0), or Q=RH*Qsat (IMODE<0)
64    C
65          IF (IMODE.GT.0) THEN
66            DO 210 J=1,NGP
67              IF(QSAT(J).ne.0.) then
68                RH(J)=QA(J)/QSAT(J)
69              ELSE
70                RH(J)=0.
71              ENDIF
72      210   CONTINUE
73          ELSE IF (IMODE.LT.0) THEN
74            DO 220 J=1,NGP
75              QA(J)=RH(J)*QSAT(J)
76      220   CONTINUE
77          ENDIF
78    chh      write(0,*) 'MAXVAL(QA)=',MAXVAL(QA)
79    chh      write(0,*) 'MINVAL(QA)=',MINVAL(QA)
80    chh      write(0,*) 'MAXVAL(RH)=',MAXVAL(RH)
81    chh      write(0,*) 'MINVAL(RH)=',MINVAL(RH)
82    C                              
83          RETURN
84          END
85    
86          SUBROUTINE ZMEDDY (NLON,NLAT,FF,ZM,EDDY)
87    
88    
89          IMPLICIT rEAL*8 (A-H,O-Z)
90    
91    
92    C
93    C *** Decompose a field into zonal-mean and eddy component
94    C
95          REAL FF(NLON,NLAT), ZM(NLAT), EDDY(NLON,NLAT)
96    C
97          RNLON=1./NLON
98    C
99          DO 130 J=1,NLAT
100    C
101            ZM(J)=0.
102            DO 110 I=1,NLON
103              ZM(J)=ZM(J)+FF(I,J)
104     110    CONTINUE
105            ZM(J)=ZM(J)*RNLON
106    C
107            DO 120 I=1,NLON
108              EDDY(I,J)=FF(I,J)-ZM(J)
109     120    CONTINUE
110    C
111     130  CONTINUE
112    C
113    C--
114          RETURN
115          END
116    C

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.22