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

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

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


Revision 1.8 - (show annotations) (download)
Sat May 21 23:50:13 2005 UTC (19 years, 1 month ago) by molod
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint57t_post, checkpoint57o_post, checkpoint58e_post, checkpoint57v_post, checkpoint57m_post, checkpoint57s_post, checkpoint57k_post, checkpoint57i_post, checkpoint57y_post, checkpoint58h_post, checkpoint57y_pre, checkpoint58j_post, checkpoint57r_post, checkpoint58, checkpoint58f_post, checkpoint57x_post, checkpoint57n_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, checkpoint58g_post, checkpoint57z_post, checkpoint58k_post, checkpoint57j_post, checkpoint58b_post, checkpoint58m_post, checkpoint57l_post
Changes since 1.7: +20 -27 lines
Change code to use standard diagnostics filling

1 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_rayleigh.F,v 1.7 2004/12/14 19:56:45 molod Exp $
2 C $Name: $
3
4 #include "FIZHI_OPTIONS.h"
5 subroutine rayleigh(myid,pres,pkap,pekap,zsurf,u,v,t,s,im,jm,lm,
6 . bi,bj,rfu,rfv,rft)
7 C **********************************************************************
8 C
9 C PURPOSE
10 C Rayleigh Friction -- Linear Drag (Strong Damping) Above 70 Km
11 C
12 C ARGUMENTS DESCRIPTION
13 C
14 C INPUT:
15 C MYID .... PROCESS(OR) NUMBER
16 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 C BI ...... X-DIRECTION PROCESSOR INDEX
28 C BJ ...... Y-DIRECTION PROCESSOR INDEX
29 C OUTPUT:
30 C RFU ..... U-WIND TENDENCY
31 C RFV ..... V-WIND TENDENCY
32 C RFT ..... THETA TENDENCY
33 C
34 C **********************************************************************
35
36 implicit none
37
38 integer myid,im,jm,lm,bi,bj
39 _RL zsurf(im,jm),pres(im,jm,lm),pkap(im,jm,lm)
40 _RL pekap(im,jm,lm+1)
41 _RL u(im,jm,lm),v(im,jm,lm),t(im,jm,lm),s(im,jm,lm)
42 _RL rfu(im,jm,lm),rfv(im,jm,lm),rft(im,jm,lm)
43
44 integer i,j,L
45 _RL rf(im,jm,lm)
46 _RL z(im,jm,lm)
47 _RL dz(im,jm,lm)
48 _RL cpog, cpinv, virtcon, getcon, dampcoef
49 #ifdef ALLOW_DIAGNOSTICS
50 logical diagnostics_is_on
51 external diagnostics_is_on
52 _RL tmpdiag(im,jm)
53 #endif
54
55 C **********************************************************************
56 C **** APPLY RAYLEIGH FRICTION TO WIND (INCLUDE HEATING) ***
57 C **********************************************************************
58
59 cpog = getcon('CP')/getcon('GRAVITY')
60 cpinv = 1.0/getcon('CP')
61 virtcon = getcon('VIRTCON')
62 dampcoef = 2./3.
63
64 do L=1,lm
65 do j=1,jm
66 do i=1,im
67 dz(i,j,L) = cpog * (pekap(i,j,L+1)-pekap(i,j,L)) * t(i,j,L) *
68 . (1.+virtcon*s(i,j,L))
69 enddo
70 enddo
71 enddo
72
73 do j=1,jm
74 do i=1,im
75 z(i,j,lm) = zsurf(i,j) + 0.5 * dz(i,j,lm)
76 enddo
77 enddo
78
79 do L=lm-1,1,-1
80 do j=1,jm
81 do i=1,im
82 z(i,j,L) = z(i,j,L+1) + 0.5 * (dz(i,j,L)+dz(i,j,L+1))
83 enddo
84 enddo
85 enddo
86
87 do L=1,lm
88 do j=1,jm
89 do i=1,im
90 rf(i,j,L) = dampcoef*(1+tanh((z(i,j,L)-50000.)/5000.))/86400.
91 rfu(i,j,L) = - rf(i,j,L) * u(i,j,L)
92 rfv(i,j,L) = - rf(i,j,L) * v(i,j,L)
93 rft(i,j,L) = -(u(i,j,L)*rfu(i,j,L) + v(i,j,L)*rfv(i,j,L) )*cpinv
94 . /pkap(i,j,L)
95 enddo
96 enddo
97 enddo
98
99 #ifdef ALLOW_DIAGNOSTICS
100 do L=1,lm
101
102 if(diagnostics_is_on('RFU ',myid) ) then
103 do j=1,jm
104 do i=1,im
105 tmpdiag(i,j) = rfu(i,j,L)*86400
106 enddo
107 enddo
108 call diagnostics_fill(tmpdiag,'RFU ',L,1,3,bi,bj,myid)
109 endif
110
111 if(diagnostics_is_on('RFV ',myid) ) then
112 do j=1,jm
113 do i=1,im
114 tmpdiag(i,j) = rfv(i,j,L)*86400
115 enddo
116 enddo
117 call diagnostics_fill(tmpdiag,'RFV ',L,1,3,bi,bj,myid)
118 endif
119
120 if(diagnostics_is_on('RFT ',myid) ) then
121 do j=1,jm
122 do i=1,im
123 tmpdiag(i,j) = rft(i,j,L)*86400
124 enddo
125 enddo
126 call diagnostics_fill(tmpdiag,'RFT ',L,1,3,bi,bj,myid)
127 endif
128
129 enddo
130 #endif
131
132 return
133 end

  ViewVC Help
Powered by ViewVC 1.1.22