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

Diff of /MITgcm/pkg/fizhi/fizhi_tendency_apply.F

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

revision 1.1 by molod, Thu Jan 29 14:22:24 2004 UTC revision 1.11 by molod, Tue Jan 17 18:46:27 2006 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "FIZHI_OPTIONS.h"
5        subroutine fizhi_tendency_apply_u(iMin, iMax, jMin, jMax,        subroutine fizhi_tendency_apply_u(iMin, iMax, jMin, jMax,
6       .    bi,bj,kLev,myTime,myThid)       .    bi,bj,kLev,myTime,myThid)
7  C=======================================================================  C=======================================================================
# Line 17  C        Assumes that U and V tendencies Line 21  C        Assumes that U and V tendencies
21  C=======================================================================  C=======================================================================
22        implicit none        implicit none
23    
 #include "CPP_OPTIONS.h"  
24  #include "SIZE.h"  #include "SIZE.h"
25  #include "GRID.h"  #include "GRID.h"
26  #include "EEPARAMS.h"  #include "EEPARAMS.h"
27  #include "DYNVARS.h"  #include "DYNVARS.h"
28  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
29  #include "land_SIZE.h"  #include "fizhi_land_SIZE.h"
30  #include "fizhi_coms.h"  #include "fizhi_coms.h"
31    
32        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid
33        _RL myTime        _RL myTime
34          _RL rayleighdrag
35          _RL tmpdiag(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
36    
37        integer i, j        integer i, j
38    #ifdef ALLOW_DIAGNOSTICS
39          logical  diagnostics_is_on
40          external diagnostics_is_on
41    #endif
42    
43          if(klev.eq.Nr .or. rC(klev).lt.1000.)then
44           rayleighdrag = 1./(31.*86400.*2.)
45          else
46           rayleighdrag = 0.
47          endif
48    
49        do j=jMin,jMax        do j=jMin,jMax
50         do i=iMin,iMax         do i=iMin,iMax
51          gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj) +          gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj) +
52       .      maskC(i,j,kLev,bi,bj) * guphy(i,j,kLev,bi,bj)       .      maskW(i,j,kLev,bi,bj) * guphy(i,j,kLev,bi,bj)
53         . - rayleighdrag * maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)
54         enddo         enddo
55        enddo        enddo
56    
57          if(diagnostics_is_on('DIABUDYN',myThid) ) then
58           do j=jMin,jMax
59           do i=iMin,iMax
60            tmpdiag(i,j) = ( maskW(i,j,kLev,bi,bj) * guphy(i,j,kLev,bi,bj)
61         .    - rayleighdrag * maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj) )
62         .    * 86400
63           enddo
64           enddo
65           call diagnostics_fill(tmpdiag,'DIABUDYN',kLev,1,2,bi,bj,myThid)
66          endif
67    
68          if(diagnostics_is_on('RFU     ',myThid) ) then
69           do j=jMin,jMax
70           do i=iMin,iMax
71            tmpdiag(i,j) = -1. _d 0 * rayleighdrag *
72         .       maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj) * 86400
73           enddo
74           enddo
75           call diagnostics_fill(tmpdiag,'RFU     ',kLev,1,2,bi,bj,myThid)
76          endif
77    
78        return        return
79        end        end
80        subroutine fizhi_tendency_apply_v(iMin, iMax, jMin, jMax,        subroutine fizhi_tendency_apply_v(iMin, iMax, jMin, jMax,
# Line 59  C        Assumes that U and V tendencies Line 96  C        Assumes that U and V tendencies
96  C=======================================================================  C=======================================================================
97        implicit none        implicit none
98    
 #include "CPP_OPTIONS.h"  
99  #include "SIZE.h"  #include "SIZE.h"
100  #include "GRID.h"  #include "GRID.h"
101  #include "EEPARAMS.h"  #include "EEPARAMS.h"
102  #include "DYNVARS.h"  #include "DYNVARS.h"
103  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
104  #include "land_SIZE.h"  #include "fizhi_land_SIZE.h"
105  #include "fizhi_coms.h"  #include "fizhi_coms.h"
106    
107        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid
108        _RL myTime        _RL myTime
109          _RL rayleighdrag
110          _RL tmpdiag(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
111    
112        integer i, j        integer i, j
113    #ifdef ALLOW_DIAGNOSTICS
114          logical  diagnostics_is_on
115          external diagnostics_is_on
116    #endif
117    
118          if(klev.eq.Nr .or. rC(klev).lt.1000.)then
119           rayleighdrag = 1./(31.*86400.*2.)
120          else
121           rayleighdrag = 0.
122          endif
123    
124        do j=jMin,jMax        do j=jMin,jMax
125         do i=iMin,iMax         do i=iMin,iMax
126          gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj) +          gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj) +
127       .      maskC(i,j,kLev,bi,bj) * gvphy(i,j,kLev,bi,bj)       .      maskS(i,j,kLev,bi,bj) * gvphy(i,j,kLev,bi,bj)
128         . - rayleighdrag * maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)
129         enddo         enddo
130        enddo        enddo
131    
132          if(diagnostics_is_on('DIABVDYN',myThid) ) then
133           do j=jMin,jMax
134           do i=iMin,iMax
135            tmpdiag(i,j) = ( maskS(i,j,kLev,bi,bj) * gvphy(i,j,kLev,bi,bj)
136         .    - rayleighdrag * maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj) )
137         .    * 86400
138           enddo
139           enddo
140           call diagnostics_fill(tmpdiag,'DIABVDYN',kLev,1,2,bi,bj,myThid)
141          endif
142    
143          if(diagnostics_is_on('RFV     ',myThid) ) then
144           do j=jMin,jMax
145           do i=iMin,iMax
146            tmpdiag(i,j) = -1. _d 0 * rayleighdrag *
147         .       maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj) * 86400
148           enddo
149           enddo
150           call diagnostics_fill(tmpdiag,'RFV     ',kLev,1,2,bi,bj,myThid)
151          endif
152    
153        return        return
154        end        end
155        subroutine fizhi_tendency_apply_t(iMin, iMax, jMin, jMax,        subroutine fizhi_tendency_apply_t(iMin, iMax, jMin, jMax,
# Line 100  C Notes: Routine works for one level at Line 170  C Notes: Routine works for one level at
170  C=======================================================================  C=======================================================================
171        implicit none        implicit none
172    
 #include "CPP_OPTIONS.h"  
173  #include "SIZE.h"  #include "SIZE.h"
174  #include "GRID.h"  #include "GRID.h"
175  #include "EEPARAMS.h"  #include "EEPARAMS.h"
176  #include "DYNVARS.h"  #include "DYNVARS.h"
177  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
178  #include "land_SIZE.h"  #include "fizhi_land_SIZE.h"
179  #include "fizhi_coms.h"  #include "fizhi_coms.h"
180    
181        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid
182        _RL myTime        _RL myTime
183          _RL rayleighdrag,getcon,cp,kappa,pNrkappa
184          _RL tmpdiag(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
185    
186        integer i, j        integer i, j
187    #ifdef ALLOW_DIAGNOSTICS
188          logical  diagnostics_is_on
189          external diagnostics_is_on
190    #endif
191    
192          if(klev.eq.Nr .or. rC(klev).lt.1000.)then
193           cp = getcon('CP')
194           kappa = getcon('KAPPA')
195           pNrkappa = (rC(klev)/100000.)**kappa
196           rayleighdrag = 1./((31.*86400.*2.)*(pNrkappa*cp))
197          else
198           rayleighdrag = 0.
199          endif
200    
201        do j=1,sNy        do j=jMin,jMax
202         do i=1,sNx         do i=iMin,iMax
203          gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)          gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)
204       .       *( gT(i,j,kLev,bi,bj) + gthphy(i,j,kLev,bi,bj) )       .       *( gT(i,j,kLev,bi,bj) + gthphy(i,j,kLev,bi,bj) )
205         . + rayleighdrag * 0.5 *
206         . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+
207         .  maskW(i+1,j,kLev,bi,bj)*
208         .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+
209         .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+
210         .  maskS(i,j+1,kLev,bi,bj)*
211         .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj))
212         enddo         enddo
213        enddo        enddo
214    
215          if(diagnostics_is_on('DIABTDYN',myThid) ) then
216           do j=jMin,jMax
217           do i=iMin,iMax
218            tmpdiag(i,j) = ( maskC(i,j,kLev,bi,bj) * gthphy(i,j,kLev,bi,bj)
219         . + rayleighdrag * 0.5 *
220         . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+
221         .  maskW(i+1,j,kLev,bi,bj)*
222         .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+
223         .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+
224         .  maskS(i,j+1,kLev,bi,bj)*
225         .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)) )
226         .    * 86400
227           enddo
228           enddo
229           call diagnostics_fill(tmpdiag,'DIABTDYN',kLev,1,2,bi,bj,myThid)
230          endif
231    
232          if(diagnostics_is_on('RFT     ',myThid) ) then
233           do j=jMin,jMax
234           do i=iMin,iMax
235            tmpdiag(i,j) = rayleighdrag * 0.5 *
236         . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+
237         .  maskW(i+1,j,kLev,bi,bj)*
238         .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+
239         .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+
240         .  maskS(i,j+1,kLev,bi,bj)*
241         .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)) )
242         .       * 86400
243           enddo
244           enddo
245           call diagnostics_fill(tmpdiag,'RFT     ',kLev,1,2,bi,bj,myThid)
246          endif
247    
248        return        return
249        end        end
250        subroutine fizhi_tendency_apply_s(iMin, iMax, jMin, jMax,        subroutine fizhi_tendency_apply_s(iMin, iMax, jMin, jMax,
# Line 141  C Notes: Routine works for one level at Line 265  C Notes: Routine works for one level at
265  C=======================================================================  C=======================================================================
266        implicit none        implicit none
267    
 #include "CPP_OPTIONS.h"  
268  #include "SIZE.h"  #include "SIZE.h"
269  #include "GRID.h"  #include "GRID.h"
270  #include "EEPARAMS.h"  #include "EEPARAMS.h"
271  #include "DYNVARS.h"  #include "DYNVARS.h"
272  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
273  #include "land_SIZE.h"  #include "fizhi_land_SIZE.h"
274  #include "fizhi_coms.h"  #include "fizhi_coms.h"
275    
276        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid
277        _RL myTime        _RL myTime
278          _RL tmpdiag(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
279    
280        integer i, j        integer i, j
281    #ifdef ALLOW_DIAGNOSTICS
282          logical  diagnostics_is_on
283          external diagnostics_is_on
284    #endif
285    
286        do j=1,sNy        do j=jMin,jMax
287         do i=1,sNx         do i=iMin,iMax
288          gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)          gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)
289       .       *( gS(i,j,kLev,bi,bj) + gsphy(i,j,kLev,bi,bj) )       .       *( gS(i,j,kLev,bi,bj) + gsphy(i,j,kLev,bi,bj) )
290         enddo         enddo
291        enddo        enddo
292    
293          if(diagnostics_is_on('DIABQDYN',myThid) ) then
294           do j=jMin,jMax
295           do i=iMin,iMax
296            tmpdiag(i,j) = ( maskC(i,j,kLev,bi,bj) * gsphy(i,j,kLev,bi,bj) )
297         .    * 86400
298           enddo
299           enddo
300           call diagnostics_fill(tmpdiag,'DIABQDYN',kLev,1,2,bi,bj,myThid)
301          endif
302    
303        return        return
304        end        end
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22