/[MITgcm]/MITgcm/pkg/timeave/timeave_cumul_2v.F
ViewVC logotype

Diff of /MITgcm/pkg/timeave/timeave_cumul_2v.F

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

revision 1.1 by jmc, Tue Mar 6 15:50:09 2001 UTC revision 1.6 by jmc, Mon Jul 26 16:57:29 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3  #include "CPP_OPTIONS.h"  #include "TIMEAVE_OPTIONS.h"
4    
5  CStartofinterface  CStartofinterface
6        SUBROUTINE TIMEAVE_CUMUL_2V(        SUBROUTINE TIMEAVE_CUMUL_2V(
7       O   fldtave,       O   fldtave,
8       I   fld1, fld2, Ksize, dir, deltaT,       I   fld1, fld2, Ksize, dir, deltaT,
9       I   bi, bj, myThid )       I   bi, bj, myThid )
10  C     /==========================================================\  C     /==========================================================*
11  C     | SUBROUTINE TIMEAVE_CUMUL_2V                              |  C     | SUBROUTINE TIMEAVE_CUMUL_2V
12  C     | o Sum over time a product of two arrays depending on the |  C     | o Sum over time a product of two arrays depending on the
13  C     |   type of the second array (tracer_grid, u_grid, v_grid) |  C     |   relative position of the 2 fields.
14  C     |   The first array must be on tracer_grid                 |  C     |      (tracer point, u, v, w ...)
15  C     \==========================================================/  C     \==========================================================*
16        IMPLICIT NONE        IMPLICIT NONE
17    
18  C     == Global variables ===  C     == Global variables ===
19  #include "SIZE.h"  #include "SIZE.h"
20  #include "EEPARAMS.h"  #include "EEPARAMS.h"
21    #include "GRID.h"
22    
23  C     == Routine arguments ==  C     == Routine arguments ==
24  C     myThid - Thread number for this instance of the routine.  C     myThid - Thread number for this instance of the routine.
25  C     fldtave - time averaged Field  C     fldtave - time averaged Field
26  C     fld1,fld2  - Input Field  C     fld1,fld2  - Input Field
27  C     dir - type of grid for 2nd array (0: tracer, 1: zonal, 2 merid)  C     dir - type of grid for 2nd array relatively to the 1rst array
28    C     0: same grid ; 1: dX/2 shift ; 2: dY/2 shift ; 3: dr/2 shift
29    C        (2 digits => also shift the 1rst array)
30  C     Ksize - 3rd dimension of local arrays (Input and Output fields)  C     Ksize - 3rd dimension of local arrays (Input and Output fields)
31        INTEGER Ksize, dir        INTEGER Ksize, dir
32        _RL fld1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Ksize,nSx,nSy)        _RL fld1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Ksize,nSx,nSy)
# Line 34  C     Ksize - 3rd dimension of local arr Line 37  C     Ksize - 3rd dimension of local arr
37    
38  CEndofinterface  CEndofinterface
39    
40    #ifdef ALLOW_TIMEAVE
41  C     == Local variables ==  C     == Local variables ==
42  C     i,j,k,bi,bj  - Loop counters  C     i,j,k,bi,bj  - Loop counters
43        INTEGER i, j, k        INTEGER i, j, k
44          INTEGER km1
45    
46        IF ( dir.eq.0 ) THEN        IF ( dir.eq.0 ) THEN
47    c-    both fields at the same location :
48    
49  C     DO bj = myByLo(myThid), myByHi(myThid)  C     DO bj = myByLo(myThid), myByHi(myThid)
50  C      DO bi = myBxLo(myThid), myBxHi(myThid)  C      DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 47  C      DO bi = myBxLo(myThid), myBxHi(my Line 53  C      DO bi = myBxLo(myThid), myBxHi(my
53            DO i=1,sNx            DO i=1,sNx
54               fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj)               fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj)
55       &       +  fld1(i,j,k,bi,bj)*fld2(i,j,k,bi,bj)*deltaT       &       +  fld1(i,j,k,bi,bj)*fld2(i,j,k,bi,bj)*deltaT
            ENDDO  
56            ENDDO            ENDDO
57           ENDDO           ENDDO
58  C       ENDDO          ENDDO
59  C      ENDDO  C      ENDDO
60    C     ENDDO
61    
62        ELSEIF ( dir.eq.1 )  THEN        ELSEIF ( dir.eq.1 )  THEN
63    c-    2nd field shifted by -dX/2 (e.g.: 1=T, 2=U) :
64    
 C     DO bj = myByLo(myThid), myByHi(myThid)  
 C      DO bi = myBxLo(myThid), myBxHi(myThid)  
65          DO k=1,Ksize          DO k=1,Ksize
66           DO j=1,sNy           DO j=1,sNy
67            DO i=1,sNx            DO i=1,sNx
# Line 64  C      DO bi = myBxLo(myThid), myBxHi(my Line 69  C      DO bi = myBxLo(myThid), myBxHi(my
69       &       + .5 * ( fld1(i-1,j,k,bi,bj) + fld1(i,j,k,bi,bj) )       &       + .5 * ( fld1(i-1,j,k,bi,bj) + fld1(i,j,k,bi,bj) )
70       &                *   fld2(i,j,k,bi,bj)       &                *   fld2(i,j,k,bi,bj)
71       &                *   deltaT       &                *   deltaT
            ENDDO  
72            ENDDO            ENDDO
73           ENDDO           ENDDO
74  C       ENDDO          ENDDO
 C      ENDDO  
75    
76        ELSEIF ( dir.eq.2 ) THEN        ELSEIF ( dir.eq.2 ) THEN
77    c-    2nd field shifted by -dY/2 (e.g.: 1=T, 2=V) :
78    
 C     DO bj = myByLo(myThid), myByHi(myThid)  
 C      DO bi = myBxLo(myThid), myBxHi(myThid)  
79          DO k=1,Ksize          DO k=1,Ksize
80           DO j=1,sNy           DO j=1,sNy
81            DO i=1,sNx            DO i=1,sNx
# Line 81  C      DO bi = myBxLo(myThid), myBxHi(my Line 83  C      DO bi = myBxLo(myThid), myBxHi(my
83       &       + .5 * ( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) )       &       + .5 * ( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) )
84       &                *   fld2(i,j,k,bi,bj)       &                *   fld2(i,j,k,bi,bj)
85       &                *   deltaT       &                *   deltaT
            ENDDO  
86            ENDDO            ENDDO
87           ENDDO           ENDDO
88  C       ENDDO          ENDDO
89  C      ENDDO  
90          ELSEIF ( dir.eq.3 ) THEN
91    c-    2nd field shifted by -dR/2 (e.g.: 1=T, 2=W) :
92    
93            DO k=1,Ksize
94             km1 = MAX(k-1,1)
95             DO j=1,sNy
96              DO i=1,sNx
97                 fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj)
98         &       + .5 * ( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) )
99         &                *   fld2(i,j,k,bi,bj)
100         &                *   deltaT
101              ENDDO
102             ENDDO
103            ENDDO
104    
105          ELSEIF ( dir.eq.12 ) THEN
106    c-    1rst & 2nd fields shifted by -dY/2 & -dX/2
107    c           (e.g.: 1=U, 2=V, product at the corner) :
108    
109            DO k=1,Ksize
110             DO j=1,sNy
111              DO i=1,sNx
112               fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
113         &      + .25 _d 0*( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) )
114         &                *( fld2(i-1,j,k,bi,bj) + fld2(i,j,k,bi,bj) )
115         &                * deltaT
116              ENDDO
117             ENDDO
118            ENDDO
119    
120          ELSEIF ( dir.eq.13 ) THEN
121    c-    1rst & 2nd fields shifted by -dR/2 & -dX/2 (e.g.: 1=U, 2=W):
122    
123            DO k=1,Ksize
124             km1 = MAX(k-1,1)
125             DO j=1,sNy
126              DO i=1,sNx
127               fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
128         &      + .25 _d 0*( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) )
129         &                *( fld2(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
130         &                  +fld2( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
131         &                 )*recip_rAw(i,j,bi,bj)
132         &                * deltaT
133              ENDDO
134             ENDDO
135            ENDDO
136    
137          ELSEIF ( dir.eq.23 ) THEN
138    c-    1rst & 2nd fields shifted by -dR/2 & -dY/2 (e.g.: 1=V, 2=W):
139    
140            DO k=1,Ksize
141             km1 = MAX(k-1,1)
142             DO j=1,sNy
143              DO i=1,sNx
144               fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
145         &      + .25 _d 0*( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) )
146         &                *( fld2(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)
147         &                  +fld2(i, j ,k,bi,bj)*rA(i, j ,bi,bj)
148         &                 )*recip_rAs(i,j,bi,bj)
149         &                * deltaT
150              ENDDO
151             ENDDO
152            ENDDO
153    
154          ELSEIF ( dir.eq.-13 ) THEN
155    c-    gradient of the 1rst field * 2nd fields, shifted by -dR/2 & -dX/2 resp.
156    c-    (e.g.: used for advective form of vertical advection: w.du/dr)
157    
158            DO k=2,Ksize
159             DO j=1,sNy
160              DO i=1,sNx
161               fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
162         &       + .5 _d 0*( fld1(i,j,k-1,bi,bj) - fld1(i,j,k,bi,bj) )
163         &                *( fld2(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
164         &                  +fld2( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
165         &                 )*recip_rAw(i,j,bi,bj)
166         &                * deltaT
167              ENDDO
168             ENDDO
169            ENDDO
170    
171          ELSEIF ( dir.eq.-23 ) THEN
172    c-    gradient of the 1rst field * 2nd fields, shifted by -dR/2 & -dY/2 resp.
173    c-    (e.g.: used for advective form of vertical advection: w.dv/dr)
174    
175            DO k=2,Ksize
176             DO j=1,sNy
177              DO i=1,sNx
178               fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
179         &       + .5 _d 0*( fld1(i,j,k-1,bi,bj) - fld1(i,j,k,bi,bj) )
180         &                *( fld2(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)
181         &                  +fld2(i, j ,k,bi,bj)*rA(i, j ,bi,bj)
182         &                 )*recip_rAs(i,j,bi,bj)
183         &                * deltaT
184              ENDDO
185             ENDDO
186            ENDDO
187    
188        ENDIF        ENDIF
189    
190    #endif /* ALLOW_TIMEAVE */
191    
192        RETURN        RETURN
193        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22