Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:44:35 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
6d54cf9ca1 Ed H*0001 #include "TIMEAVE_OPTIONS.h"
bcd01ec185 Jean*0002 
                0003 CStartofinterface
                0004       SUBROUTINE TIMEAVE_CUMUL_2V( 
                0005      O   fldtave,
873fffa31d Patr*0006      I   fld1, fld2, Ksize, dir, deltaTloc,
bcd01ec185 Jean*0007      I   bi, bj, myThid )
4237a8e6b2 Jean*0008 C     /==========================================================*
                0009 C     | SUBROUTINE TIMEAVE_CUMUL_2V
                0010 C     | o Sum over time a product of two arrays depending on the
                0011 C     |   relative position of the 2 fields.
                0012 C     |      (tracer point, u, v, w ...)
                0013 C     \==========================================================*
bcd01ec185 Jean*0014       IMPLICIT NONE
                0015 
                0016 C     == Global variables ===
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
bdd0d0a23c Jean*0019 #include "GRID.h"
bcd01ec185 Jean*0020 
                0021 C     == Routine arguments ==
                0022 C     myThid - Thread number for this instance of the routine.
                0023 C     fldtave - time averaged Field
                0024 C     fld1,fld2  - Input Field
aa7db3783b Jean*0025 C     dir - type of grid for 2nd array relatively to the 1rst array
                0026 C     0: same grid ; 1: dX/2 shift ; 2: dY/2 shift ; 3: dr/2 shift
4237a8e6b2 Jean*0027 C        (2 digits => also shift the 1rst array)
bcd01ec185 Jean*0028 C     Ksize - 3rd dimension of local arrays (Input and Output fields)
                0029       INTEGER Ksize, dir
                0030       _RL fld1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Ksize,nSx,nSy)
                0031       _RL fld2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Ksize,nSx,nSy)
                0032       _RL fldtave(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Ksize,nSx,nSy)
873fffa31d Patr*0033       _RL deltaTloc
bcd01ec185 Jean*0034       INTEGER bi, bj, myThid
                0035 
                0036 CEndofinterface
                0037 
4237a8e6b2 Jean*0038 #ifdef ALLOW_TIMEAVE
bcd01ec185 Jean*0039 C     == Local variables ==
                0040 C     i,j,k,bi,bj  - Loop counters
                0041       INTEGER i, j, k
69cdb047e7 Jean*0042       INTEGER km1
bcd01ec185 Jean*0043  
                0044       IF ( dir.eq.0 ) THEN 
bdd0d0a23c Jean*0045 c-    both fields at the same location :
bcd01ec185 Jean*0046 
                0047 C     DO bj = myByLo(myThid), myByHi(myThid)
                0048 C      DO bi = myBxLo(myThid), myBxHi(myThid)
                0049         DO k=1,Ksize
                0050          DO j=1,sNy
                0051           DO i=1,sNx
                0052              fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj)
873fffa31d Patr*0053      &       +  fld1(i,j,k,bi,bj)*fld2(i,j,k,bi,bj)*deltaTloc
bcd01ec185 Jean*0054           ENDDO
                0055          ENDDO
4237a8e6b2 Jean*0056         ENDDO
bcd01ec185 Jean*0057 C      ENDDO
4237a8e6b2 Jean*0058 C     ENDDO
bcd01ec185 Jean*0059 
                0060       ELSEIF ( dir.eq.1 )  THEN
bdd0d0a23c Jean*0061 c-    2nd field shifted by -dX/2 (e.g.: 1=T, 2=U) :
bcd01ec185 Jean*0062  
                0063         DO k=1,Ksize
                0064          DO j=1,sNy
                0065           DO i=1,sNx
                0066              fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj)
                0067      &       + .5 * ( fld1(i-1,j,k,bi,bj) + fld1(i,j,k,bi,bj) )
                0068      &                *   fld2(i,j,k,bi,bj)
873fffa31d Patr*0069      &                *   deltaTloc
bcd01ec185 Jean*0070           ENDDO
                0071          ENDDO
4237a8e6b2 Jean*0072         ENDDO
bcd01ec185 Jean*0073 
                0074       ELSEIF ( dir.eq.2 ) THEN
bdd0d0a23c Jean*0075 c-    2nd field shifted by -dY/2 (e.g.: 1=T, 2=V) :
bcd01ec185 Jean*0076  
                0077         DO k=1,Ksize
                0078          DO j=1,sNy
                0079           DO i=1,sNx
                0080              fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj)
                0081      &       + .5 * ( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) )
                0082      &                *   fld2(i,j,k,bi,bj)
873fffa31d Patr*0083      &                *   deltaTloc
bcd01ec185 Jean*0084           ENDDO
                0085          ENDDO
4237a8e6b2 Jean*0086         ENDDO
bcd01ec185 Jean*0087 
aa7db3783b Jean*0088       ELSEIF ( dir.eq.3 ) THEN
bdd0d0a23c Jean*0089 c-    2nd field shifted by -dR/2 (e.g.: 1=T, 2=W) :
aa7db3783b Jean*0090  
69cdb047e7 Jean*0091         DO k=1,Ksize
                0092          km1 = MAX(k-1,1)
aa7db3783b Jean*0093          DO j=1,sNy
                0094           DO i=1,sNx
                0095              fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj)
69cdb047e7 Jean*0096      &       + .5 * ( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) )
aa7db3783b Jean*0097      &                *   fld2(i,j,k,bi,bj)
873fffa31d Patr*0098      &                *   deltaTloc
aa7db3783b Jean*0099           ENDDO
                0100          ENDDO
4237a8e6b2 Jean*0101         ENDDO
                0102 
                0103       ELSEIF ( dir.eq.12 ) THEN
bdd0d0a23c Jean*0104 c-    1rst & 2nd fields shifted by -dY/2 & -dX/2 
                0105 c           (e.g.: 1=U, 2=V, product at the corner) :
4237a8e6b2 Jean*0106  
                0107         DO k=1,Ksize
                0108          DO j=1,sNy
                0109           DO i=1,sNx
                0110            fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
                0111      &      + .25 _d 0*( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) )
                0112      &                *( fld2(i-1,j,k,bi,bj) + fld2(i,j,k,bi,bj) )
873fffa31d Patr*0113      &                * deltaTloc
4237a8e6b2 Jean*0114           ENDDO
                0115          ENDDO
                0116         ENDDO
aa7db3783b Jean*0117 
bdd0d0a23c Jean*0118       ELSEIF ( dir.eq.13 ) THEN
                0119 c-    1rst & 2nd fields shifted by -dR/2 & -dX/2 (e.g.: 1=U, 2=W):
                0120  
69cdb047e7 Jean*0121         DO k=1,Ksize
                0122          km1 = MAX(k-1,1)
bdd0d0a23c Jean*0123          DO j=1,sNy
                0124           DO i=1,sNx
                0125            fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
69cdb047e7 Jean*0126      &      + .25 _d 0*( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) )
bdd0d0a23c Jean*0127      &                *( fld2(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
                0128      &                  +fld2( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
                0129      &                 )*recip_rAw(i,j,bi,bj)
873fffa31d Patr*0130      &                * deltaTloc
bdd0d0a23c Jean*0131           ENDDO
                0132          ENDDO
                0133         ENDDO
                0134 
                0135       ELSEIF ( dir.eq.23 ) THEN
                0136 c-    1rst & 2nd fields shifted by -dR/2 & -dY/2 (e.g.: 1=V, 2=W):
                0137  
69cdb047e7 Jean*0138         DO k=1,Ksize
                0139          km1 = MAX(k-1,1)
bdd0d0a23c Jean*0140          DO j=1,sNy
                0141           DO i=1,sNx
                0142            fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
69cdb047e7 Jean*0143      &      + .25 _d 0*( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) )
bdd0d0a23c Jean*0144      &                *( fld2(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)
                0145      &                  +fld2(i, j ,k,bi,bj)*rA(i, j ,bi,bj)
                0146      &                 )*recip_rAs(i,j,bi,bj)
873fffa31d Patr*0147      &                * deltaTloc
bdd0d0a23c Jean*0148           ENDDO
                0149          ENDDO
                0150         ENDDO
                0151 
                0152       ELSEIF ( dir.eq.-13 ) THEN
                0153 c-    gradient of the 1rst field * 2nd fields, shifted by -dR/2 & -dX/2 resp.
                0154 c-    (e.g.: used for advective form of vertical advection: w.du/dr)
                0155  
                0156         DO k=2,Ksize
                0157          DO j=1,sNy
                0158           DO i=1,sNx
                0159            fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
                0160      &       + .5 _d 0*( fld1(i,j,k-1,bi,bj) - fld1(i,j,k,bi,bj) )
                0161      &                *( fld2(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj)
                0162      &                  +fld2( i ,j,k,bi,bj)*rA( i ,j,bi,bj)
                0163      &                 )*recip_rAw(i,j,bi,bj)
873fffa31d Patr*0164      &                * deltaTloc
bdd0d0a23c Jean*0165           ENDDO
                0166          ENDDO
                0167         ENDDO
                0168 
                0169       ELSEIF ( dir.eq.-23 ) THEN
                0170 c-    gradient of the 1rst field * 2nd fields, shifted by -dR/2 & -dY/2 resp.
                0171 c-    (e.g.: used for advective form of vertical advection: w.dv/dr)
                0172  
                0173         DO k=2,Ksize
                0174          DO j=1,sNy
                0175           DO i=1,sNx
                0176            fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj)
                0177      &       + .5 _d 0*( fld1(i,j,k-1,bi,bj) - fld1(i,j,k,bi,bj) )
                0178      &                *( fld2(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj)
                0179      &                  +fld2(i, j ,k,bi,bj)*rA(i, j ,bi,bj)
                0180      &                 )*recip_rAs(i,j,bi,bj)
873fffa31d Patr*0181      &                * deltaTloc
bdd0d0a23c Jean*0182           ENDDO
                0183          ENDDO
                0184         ENDDO
                0185 
bcd01ec185 Jean*0186       ENDIF
                0187 
4237a8e6b2 Jean*0188 #endif /* ALLOW_TIMEAVE */
                0189 
bcd01ec185 Jean*0190       RETURN
                0191       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!