/[MITgcm]/MITgcm/pkg/fizhi/fizhi_rayleigh.F
ViewVC logotype

Annotation of /MITgcm/pkg/fizhi/fizhi_rayleigh.F

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


Revision 1.5 - (hide annotations) (download)
Tue Oct 26 01:01:58 2004 UTC (19 years, 8 months ago) by molod
Branch: MAIN
Changes since 1.4: +1 -10 lines
Remove repeated coded

1 molod 1.5 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_rayleigh.F,v 1.4 2004/10/22 17:56:03 molod Exp $
2 molod 1.1 C $Name: $
3 molod 1.3
4 molod 1.1 #include "FIZHI_OPTIONS.h"
5 molod 1.2 subroutine rayleigh(myid,pres,pkap,pekap,zsurf,u,v,t,s,im,jm,lm,
6     . bi,bj,rfu,rfv,rft)
7 molod 1.1 C **********************************************************************
8     C
9     C PURPOSE
10 molod 1.3 C Rayleigh Friction -- Linear Drag (Strong Damping) Above 70 Km
11 molod 1.1 C
12     C ARGUMENTS DESCRIPTION
13 molod 1.2 C
14     C INPUT:
15 molod 1.1 C MYID .... PROCESS(OR) NUMBER
16 molod 1.2 C PRES .... MID-LEVEL PRESSURE IN MB
17     C PKAP .... MID-LEVEL PRESSURE ** KAPPA
18     C PEKAP ... EDGE-LEVEL PRESSURE ** KAPPA
19     C ZSURF ... SURFACE ELEVATION IN M
20     C U ....... U-WIND
21     C V ....... V-WIND
22     C TH ...... THETA (ACTUALLY REAL THETA * P0**KAPPA) IN K
23     C S ...... SPECIFIC HUMIDITY (KG/KG)
24     C IM ...... NUMBER OF LONGITUDE POINTS
25     C JM ...... NUMBER OF LATITUDE POINTS
26     C LM ...... NUMBER OF VERTICAL LEVELS
27 molod 1.1 C BI ...... X-DIRECTION PROCESSOR INDEX
28     C BJ ...... Y-DIRECTION PROCESSOR INDEX
29 molod 1.2 C OUTPUT:
30     C RFU ..... U-WIND TENDENCY
31     C RFV ..... V-WIND TENDENCY
32     C RFT ..... THETA TENDENCY
33 molod 1.1 C
34     C **********************************************************************
35    
36     implicit none
37    
38     #ifdef ALLOW_DIAGNOSTICS
39     #include "SIZE.h"
40     #include "diagnostics_SIZE.h"
41     #include "diagnostics.h"
42     #endif
43    
44     integer myid,im,jm,lm,bi,bj
45 molod 1.4 _RL zsurf(im,jm),pres(im,jm,lm),pkap(im,jm,lm)
46     _RL pekap(im,jm,lm+1)
47 molod 1.2 _RL u(im,jm,lm),v(im,jm,lm),t(im,jm,lm),s(im,jm,lm)
48     _RL rfu(im,jm,lm),rfv(im,jm,lm),rft(im,jm,lm)
49 molod 1.1
50     integer i,j,L
51 molod 1.2 _RL rf(im,jm,lm)
52     _RL z(im,jm,lm)
53     _RL dz(im,jm,lm)
54 molod 1.3 _RL cpog, cpinv, virtcon, getcon, dampcoef
55 molod 1.1
56     C **********************************************************************
57 molod 1.2 C **** APPLY RAYLEIGH FRICTION TO WIND (INCLUDE HEATING) ***
58 molod 1.1 C **********************************************************************
59    
60 molod 1.2 cpog = getcon('CP')/getcon('GRAVITY')
61 molod 1.1 cpinv = 1.0/getcon('CP')
62 molod 1.2 virtcon = getcon('VIRTCON')
63 molod 1.3 dampcoef = 2./3.
64 molod 1.1
65 molod 1.2 do L=1,lm
66     do j=1,jm
67     do i=1,im
68     dz(i,j,L) = cpog * (pekap(i,j,L+1)-pekap(i,j,L)) * t(i,j,L) *
69     . (1.+virtcon*s(i,j,L))
70     enddo
71     enddo
72 molod 1.1 enddo
73    
74     do j=1,jm
75     do i=1,im
76 molod 1.2 z(i,j,lm) = zsurf(i,j) + 0.5 * dz(i,j,lm)
77 molod 1.1 enddo
78     enddo
79    
80 molod 1.2 do L=lm-1,1,-1
81     do j=1,jm
82     do i=1,im
83     z(i,j,L) = z(i,j,L+1) + 0.5 * (dz(i,j,L)+dz(i,j,L+1))
84     enddo
85     enddo
86 molod 1.1 enddo
87    
88 molod 1.2 do L=1,lm
89     do j=1,jm
90     do i=1,im
91 molod 1.3 rf(i,j,L) = dampcoef*(1+tanh((z(i,j,L)-80000.)/5000.))/86400.
92 molod 1.2 rfu(i,j,L) = - rf(i,j,L) * u(i,j,L)
93     rfv(i,j,L) = - rf(i,j,L) * v(i,j,L)
94     rft(i,j,L) = -(u(i,j,L)*rfu(i,j,L) + v(i,j,L)*rfv(i,j,L) )*cpinv
95     . /pkap(i,j,L)
96     enddo
97     enddo
98 molod 1.1 enddo
99    
100 molod 1.2 #ifdef ALLOW_DIAGNOSTICS
101     do L=1,lm
102     if( irfu.ne.0 ) then
103     do j=1,jm
104     do i=1,im
105     qdiag(i,j,irfu+L-1,bi,bj) = qdiag(i,j,irfu+L-1,bi,bj) +
106     . rfu(i,j,L)*86400
107     enddo
108     enddo
109     endif
110    
111     if( irfv.ne.0 ) then
112     do j=1,jm
113     do i=1,im
114     qdiag(i,j,irfv+L-1,bi,bj) = qdiag(i,j,irfv+L-1,bi,bj) +
115     . rfv(i,j,L)*86400
116     enddo
117     enddo
118     endif
119    
120     if( irft.ne.0 ) then
121     do j=1,jm
122     do i=1,im
123     qdiag(i,j,irft+L-1,bi,bj) = qdiag(i,j,irft+L-1,bi,bj) +
124     . rft(i,j,L)*86400
125     enddo
126     enddo
127     endif
128 molod 1.1 enddo
129 molod 1.2 #endif
130 molod 1.1
131 molod 1.2 #ifdef ALLOW_DIAGNOSTICS
132     if( (bi.eq.1) .and. (bj.eq.1) ) then
133     nrfu = nrfu + 1
134     nrfv = nrfv + 1
135     nrft = nrft + 1
136     endif
137     #endif
138 molod 1.1
139     return
140     end

  ViewVC Help
Powered by ViewVC 1.1.22