/[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.12 by molod, Wed Jan 18 19:00:38 2006 UTC revision 1.13 by jmc, Wed Jul 9 17:00:49 2014 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "FIZHI_OPTIONS.h"  #include "FIZHI_OPTIONS.h"
5        subroutine fizhi_tendency_apply_u(iMin, iMax, jMin, jMax,        subroutine fizhi_tendency_apply_u(
6       .    bi,bj,kLev,myTime,myThid)       U                        gU_arr,
7         I                        iMin,iMax,jMin,jMax, kLev, bi, bj,
8         I                        myTime, myIter, myThid )
9  C=======================================================================  C=======================================================================
10  C Routine: fizhi_tendency_apply_u  C Routine: fizhi_tendency_apply_u
11  C     Interpolate tendencies from physics grid to dynamics grid and  C     Interpolate tendencies from physics grid to dynamics grid and
12  C     add fizhi tendency terms to U tendency.  C     add fizhi tendency terms to U tendency.
13  C    C
14  C INPUT:  C INPUT:
15  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
16  C     iMax  C     iMax
17  C     jMin  C     jMin
# Line 29  C======================================= Line 31  C=======================================
31  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
32  #include "fizhi_coms.h"  #include "fizhi_coms.h"
33    
34        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid        _RL     gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
35        _RL myTime        INTEGER iMin, iMax, jMin, jMax
36        _RL rayleighdrag        INTEGER kLev, bi, bj
37        _RL tmpdiag(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL     myTime
38          INTEGER myIter
39          INTEGER myThid
40    
41          _RL rayleighdrag
42          _RL tmpdiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
43        integer i, j        integer i, j
44  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
45        logical  diagnostics_is_on        logical  diagnostics_is_on
# Line 48  C======================================= Line 54  C=======================================
54    
55        do j=jMin,jMax        do j=jMin,jMax
56         do i=iMin,iMax         do i=iMin,iMax
57          gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj) +          gU_arr(i,j) = gU_arr(i,j) +
58       .      maskW(i,j,kLev,bi,bj) * guphy(i,j,kLev,bi,bj)       .      maskW(i,j,kLev,bi,bj) * guphy(i,j,kLev,bi,bj)
59       . - rayleighdrag * maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)       . - rayleighdrag * maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)
60         enddo         enddo
# Line 57  C======================================= Line 63  C=======================================
63        if(diagnostics_is_on('DIABUDYN',myThid) ) then        if(diagnostics_is_on('DIABUDYN',myThid) ) then
64         do j=jMin,jMax         do j=jMin,jMax
65         do i=iMin,iMax         do i=iMin,iMax
66          tmpdiag(i,j) = ( maskW(i,j,kLev,bi,bj) * guphy(i,j,kLev,bi,bj)          tmpdiag(i,j) = ( maskW(i,j,kLev,bi,bj) * guphy(i,j,kLev,bi,bj)
67       .    - rayleighdrag * maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj) )       .    - rayleighdrag * maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj) )
68       .    * 86400       .    * 86400
69         enddo         enddo
70         enddo         enddo
# Line 68  C======================================= Line 74  C=======================================
74        if(diagnostics_is_on('RFU     ',myThid) ) then        if(diagnostics_is_on('RFU     ',myThid) ) then
75         do j=jMin,jMax         do j=jMin,jMax
76         do i=iMin,iMax         do i=iMin,iMax
77          tmpdiag(i,j) = -1. _d 0 * rayleighdrag *          tmpdiag(i,j) = -1. _d 0 * rayleighdrag *
78       .       maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj) * 86400       .       maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj) * 86400
79         enddo         enddo
80         enddo         enddo
# Line 77  C======================================= Line 83  C=======================================
83    
84        return        return
85        end        end
86        subroutine fizhi_tendency_apply_v(iMin, iMax, jMin, jMax,        subroutine fizhi_tendency_apply_v(
87       .    bi,bj,kLev,myTime,myThid)       U                        gV_arr,
88         I                        iMin,iMax,jMin,jMax, kLev, bi, bj,
89         I                        myTime, myIter, myThid )
90  C=======================================================================  C=======================================================================
91  C Routine: fizhi_tendency_apply_v  C Routine: fizhi_tendency_apply_v
92  C     Interpolate tendencies from physics grid to dynamics grid and  C     Interpolate tendencies from physics grid to dynamics grid and
93  C     add fizhi tendency terms to V tendency.  C     add fizhi tendency terms to V tendency.
94  C    C
95  C INPUT:  C INPUT:
96  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
97  C     iMax  C     iMax
98  C     jMin  C     jMin
# Line 104  C======================================= Line 112  C=======================================
112  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
113  #include "fizhi_coms.h"  #include "fizhi_coms.h"
114    
115        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid        _RL     gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
116        _RL myTime        INTEGER iMin, iMax, jMin, jMax
117        _RL rayleighdrag        INTEGER kLev, bi, bj
118        _RL tmpdiag(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL     myTime
119          INTEGER myIter
120          INTEGER myThid
121    
122          _RL rayleighdrag
123          _RL tmpdiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
124        integer i, j        integer i, j
125  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
126        logical  diagnostics_is_on        logical  diagnostics_is_on
# Line 123  C======================================= Line 135  C=======================================
135    
136        do j=jMin,jMax        do j=jMin,jMax
137         do i=iMin,iMax         do i=iMin,iMax
138          gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj) +          gV_arr(i,j) = gV_arr(i,j) +
139       .      maskS(i,j,kLev,bi,bj) * gvphy(i,j,kLev,bi,bj)       .      maskS(i,j,kLev,bi,bj) * gvphy(i,j,kLev,bi,bj)
140       . - rayleighdrag * maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)       . - rayleighdrag * maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)
141         enddo         enddo
# Line 132  C======================================= Line 144  C=======================================
144        if(diagnostics_is_on('DIABVDYN',myThid) ) then        if(diagnostics_is_on('DIABVDYN',myThid) ) then
145         do j=jMin,jMax         do j=jMin,jMax
146         do i=iMin,iMax         do i=iMin,iMax
147          tmpdiag(i,j) = ( maskS(i,j,kLev,bi,bj) * gvphy(i,j,kLev,bi,bj)          tmpdiag(i,j) = ( maskS(i,j,kLev,bi,bj) * gvphy(i,j,kLev,bi,bj)
148       .    - rayleighdrag * maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj) )       .    - rayleighdrag * maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj) )
149       .    * 86400       .    * 86400
150         enddo         enddo
151         enddo         enddo
# Line 143  C======================================= Line 155  C=======================================
155        if(diagnostics_is_on('RFV     ',myThid) ) then        if(diagnostics_is_on('RFV     ',myThid) ) then
156         do j=jMin,jMax         do j=jMin,jMax
157         do i=iMin,iMax         do i=iMin,iMax
158          tmpdiag(i,j) = -1. _d 0 * rayleighdrag *          tmpdiag(i,j) = -1. _d 0 * rayleighdrag *
159       .       maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj) * 86400       .       maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj) * 86400
160         enddo         enddo
161         enddo         enddo
# Line 152  C======================================= Line 164  C=======================================
164    
165        return        return
166        end        end
167        subroutine fizhi_tendency_apply_t(iMin, iMax, jMin, jMax,        subroutine fizhi_tendency_apply_t(
168       .    bi,bj,kLev,myTime,myThid)       U                        gT_arr,
169         I                        iMin,iMax,jMin,jMax, kLev, bi, bj,
170         I                        myTime, myIter, myThid )
171  C=======================================================================  C=======================================================================
172  C Routine: fizhi_tendency_apply_t  C Routine: fizhi_tendency_apply_t
173  C     Interpolate tendencies from physics grid to dynamics grid and  C     Interpolate tendencies from physics grid to dynamics grid and
174  C     add fizhi tendency terms to T (theta) tendency.  C     add fizhi tendency terms to T (theta) tendency.
175  C    C
176  C INPUT:  C INPUT:
177  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
178  C     iMax  C     iMax
179  C     jMin  C     jMin
# Line 178  C======================================= Line 192  C=======================================
192  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
193  #include "fizhi_coms.h"  #include "fizhi_coms.h"
194    
195        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid        _RL     gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
196        _RL myTime        INTEGER iMin, iMax, jMin, jMax
197        _RL rayleighdrag,getcon,cp,kappa,pNrkappa        INTEGER kLev, bi, bj
198        _RL tmpdiag(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL     myTime
199          INTEGER myIter
200          INTEGER myThid
201    
202          _RL rayleighdrag,getcon,cp,kappa,pNrkappa
203          _RL tmpdiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
204        integer i, j        integer i, j
205  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
206        logical  diagnostics_is_on        logical  diagnostics_is_on
# Line 192  C======================================= Line 210  C=======================================
210        if(klev.eq.Nr .or. rC(klev).lt.1000.)then        if(klev.eq.Nr .or. rC(klev).lt.1000.)then
211         cp = getcon('CP')         cp = getcon('CP')
212         kappa = getcon('KAPPA')         kappa = getcon('KAPPA')
213         pNrkappa = (rC(klev)/100000.)**kappa         pNrkappa = (rC(klev)/100000.)**kappa
214         rayleighdrag = 1./((31.*86400.*2.)*(pNrkappa*cp))         rayleighdrag = 1./((31.*86400.*2.)*(pNrkappa*cp))
215        else        else
216         rayleighdrag = 0.         rayleighdrag = 0.
# Line 200  C======================================= Line 218  C=======================================
218    
219        do j=jMin,jMax        do j=jMin,jMax
220         do i=iMin,iMax         do i=iMin,iMax
221          gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)          gT_arr(i,j) = maskC(i,j,kLev,bi,bj)
222       .       *( gT(i,j,kLev,bi,bj) + gthphy(i,j,kLev,bi,bj) )       .       *( gT_arr(i,j) + gthphy(i,j,kLev,bi,bj) )
223       . + rayleighdrag * 0.5 *       . + rayleighdrag * 0.5 *
224       . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+       . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+
225       .  maskW(i+1,j,kLev,bi,bj)*       .  maskW(i+1,j,kLev,bi,bj)*
226       .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+       .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+
227       .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+       .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+
228       .  maskS(i,j+1,kLev,bi,bj)*       .  maskS(i,j+1,kLev,bi,bj)*
229       .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj))       .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj))
# Line 215  C======================================= Line 233  C=======================================
233        if(diagnostics_is_on('DIABTDYN',myThid) ) then        if(diagnostics_is_on('DIABTDYN',myThid) ) then
234         do j=jMin,jMax         do j=jMin,jMax
235         do i=iMin,iMax         do i=iMin,iMax
236          tmpdiag(i,j) = ( maskC(i,j,kLev,bi,bj) * gthphy(i,j,kLev,bi,bj)          tmpdiag(i,j) = ( maskC(i,j,kLev,bi,bj) * gthphy(i,j,kLev,bi,bj)
237       . + rayleighdrag * 0.5 *       . + rayleighdrag * 0.5 *
238       . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+       . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+
239       .  maskW(i+1,j,kLev,bi,bj)*       .  maskW(i+1,j,kLev,bi,bj)*
240       .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+       .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+
241       .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+       .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+
242       .  maskS(i,j+1,kLev,bi,bj)*       .  maskS(i,j+1,kLev,bi,bj)*
243       .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)) )       .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)) )
# Line 233  C======================================= Line 251  C=======================================
251         do j=jMin,jMax         do j=jMin,jMax
252         do i=iMin,iMax         do i=iMin,iMax
253          tmpdiag(i,j) = ( rayleighdrag * 0.5 *          tmpdiag(i,j) = ( rayleighdrag * 0.5 *
254       . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+       . (maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)+
255       .  maskW(i+1,j,kLev,bi,bj)*       .  maskW(i+1,j,kLev,bi,bj)*
256       .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+       .                uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)+
257       .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+       .  maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)+
258       .  maskS(i,j+1,kLev,bi,bj)*       .  maskS(i,j+1,kLev,bi,bj)*
259       .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)) )       .                vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)) )
# Line 247  C======================================= Line 265  C=======================================
265    
266        return        return
267        end        end
268        subroutine fizhi_tendency_apply_s(iMin, iMax, jMin, jMax,        subroutine fizhi_tendency_apply_s(
269       .    bi,bj,kLev,myTime,myThid)       U                        gS_arr,
270         I                        iMin,iMax,jMin,jMax, kLev, bi, bj,
271         I                        myTime, myIter, myThid )
272  C=======================================================================  C=======================================================================
273  C Routine: fizhi_tendency_apply_s  C Routine: fizhi_tendency_apply_s
274  C     Interpolate tendencies from physics grid to dynamics grid and  C     Interpolate tendencies from physics grid to dynamics grid and
275  C     add fizhi tendency terms to S tendency.  C     add fizhi tendency terms to S tendency.
276  C    C
277  C INPUT:  C INPUT:
278  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
279  C     iMax  C     iMax
280  C     jMin  C     jMin
# Line 273  C======================================= Line 293  C=======================================
293  #include "fizhi_land_SIZE.h"  #include "fizhi_land_SIZE.h"
294  #include "fizhi_coms.h"  #include "fizhi_coms.h"
295    
296        integer iMin, iMax, jMin, jMax, kLev, bi, bj, myThid        _RL     gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
297        _RL myTime        INTEGER iMin, iMax, jMin, jMax
298        _RL tmpdiag(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        INTEGER kLev, bi, bj
299          _RL     myTime
300          INTEGER myIter
301          INTEGER myThid
302    
303          _RL tmpdiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
304        integer i, j        integer i, j
305  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
306        logical  diagnostics_is_on        logical  diagnostics_is_on
# Line 285  C======================================= Line 309  C=======================================
309    
310        do j=jMin,jMax        do j=jMin,jMax
311         do i=iMin,iMax         do i=iMin,iMax
312          gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)          gS_arr(i,j) = maskC(i,j,kLev,bi,bj)
313       .       *( gS(i,j,kLev,bi,bj) + gsphy(i,j,kLev,bi,bj) )       .       *( gS_arr(i,j) + gsphy(i,j,kLev,bi,bj) )
314         enddo         enddo
315        enddo        enddo
316    
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22