*IDENT tjtrac2,DC=TRACER
*/[02]
*/       - tjtrac2 23Apr99 SEVERITY MODTYPE
*/
*/       - Applies to level:
*/         6.1 tjtrac2
*/
*/       - Machine type:  ALL
*/
*/       - Description:
*/DELTA    DESCRIPTION
*/
*/       - Modules affected:  TRACER
*/
*/       - Depends on the following mods for update:  OSY1F405
*/
*/       - Depends on the following mods for execution:  NONE
*/
*/       - SPRs closed:  NONE
*/
*/       - TIRs closed:  NONE
*/
*/       - Supporting documents:  NONE
*/
*/DELTA  - Author: t20ba 
*/
*D OSY1F405.81
        FXA=CSTR(J)*DYTR(J)                                             
        FXB=FXA*CS(J-1)                                                 
*D OSY1F405.82,OSY1F405.83   
          FVST(I,K)=(V(I,K)*DXUQ(I,K)+                                  
     &               V(I-1,K)*DXUQ(I-1,K))*FXB*DXT4RQ(I,K)              
*D OSY1F405.84,OSY1F405.85   
      FXA=CSTR(J)*DYTR(J)                                               
      FXB=FXA*CS(J)                                                     
*D OSY1F405.86,OSY1F405.87   
        FVN(I,K)=(V(I  ,K)*DXUQ(I,K)+V (I-1,K)*DXUQ(I-1,K))*FXB         
     *           *DXT4RQ(I,K)                                           
*I TRACER.315   
      FVN(1,K)=0.0                                                      
*D OSY1F405.88,OSY1F405.95   
*D OSY1F405.96,OSY1F405.97   
        W(I,K+KOFF)=C2DZQ(I,K)*((FUW(I+1,K)-FUW (I,K))*DXT4RQ(I,K)      
     *                       +FVN(I  ,K)-FVST(I,K))                     
*D OSY1F405.98,OSY1F405.126  
C  1ST, COMPUTE FLUX THROUGH WEST FACE OF T BOX                         
C                                                                       
      IF (O_ADVECT_SCHEME(1,M).EQ.1) THEN                               
!      Centred differencing for all tracers for which                   
!      O_ADVECT_SCHEME equals zero.                                     
       DO 810 K=1,KM                                                    
       DO 811 I=2,IMT                                                   
        TEMPA(I,K)=FUW(I,K)*(T(I,K,M)+T(I-1,K,M))                       
 811   CONTINUE                                                         
       TEMPA(1,K)=0.0                                                   
 810   CONTINUE                                                         
C                                                                       
      ELSE                                                              
C                                                                       
!      Upwind differencing if O_ADVECT_SCHEME > zero                    
       DO K=1,KM                                                        
        DO I=2,IMT                                                      
         TEMPA(I,K) = 2.0 * AMAX1(FUW(I,K),0.0) * TB(I-1,K,M)           
     &              + 2.0 * AMIN1(FUW(I,K),0.0) * TB(I,K,M)             
        ENDDO                                                           
        TEMPA(1,K)=0.0                                                  
       ENDDO                                                            
C                                                                       
      ENDIF                                                             
C                                                                       
C  2ND, COMPUTE ZONAL FLUX DIVERGENCE                                   
C                                                                       
C     LOOP 815 INITIALIZES TA                                           
C                                                                       
      DO 815 K=1,KM                                                     
      DO 816 I=1,IMTM1                                                  
        TA(I,K,M)=(TEMPA(I,K)-TEMPA(I+1,K))*DXT4RQ(I,K)                 
 816  CONTINUE                                                          
      TA(IMT,K,M)=0.0                                                   
 815  CONTINUE                                                          
      IF ((M.EQ.1.AND.SF_DT(1)).OR.(M.EQ.2.AND.SF_DS(1))) THEN          
*D OSY1F405.128,OSY1F405.130  
        DO I=1,IMT                                                      
          WDTXADV(I,K)=TA(I,K,M)                                        
        ENDDO                                                           
*I OSY1F405.132   
C                                                                       
C  3RD, ADD IN MERIDIONAL FLUX DIVERGENCE                               
C                                                                       
      IF (O_ADVECT_SCHEME(1,M).EQ.1) THEN                               
!      Centred differencing for all tracers for which                   
!      O_ADVECT_SCHEME equals zero.                                     
      DO K=1,KM                                                         
            DO I=1,IMT                                                  
         WDTYADV(I,K)=-FVN (I,K)*(TP(I,K,M)+T (I,K,M))                  
     &                +FVST(I,K)*(T (I,K,M)+TM(I,K,M))                  
         TA(I,K,M)=TA(I,K,M)-FVN (I,K)*(TP(I,K,M)+T (I,K,M))            
     *                     +FVST(I,K)*(T (I,K,M)+TM(I,K,M))             
            ENDDO ! over I                                              
      ENDDO ! over K                                                    
C                                                                       
      ELSE                                                              
C                                                                       
!      Upwind differencing if O_ADVECT_SCHEME > zero                    
        DO K=1,KM                                                       
              DO I=1,IMT                                                
         TA(I,K,M)=TA(I,K,M) - 2.0 * AMAX1(FVN(I,K),0.0) * TB(I,K,M)    
     &                       - 2.0 * AMIN1(FVN(I,K),0.0) * TBP(I,K,M)   
     &                   + 2.0 * AMAX1(FVST(I,K),0.0) * TBM(I,K,M)      
     &                   + 2.0 * AMIN1(FVST(I,K),0.0) * TB(I,K,M)       
              ENDDO ! over I                                            
        ENDDO                                                           
C                                                                       
      ENDIF                                                             
C                                                                       
       IF (L_OBIOLOGY) THEN                                             
         DO K=1,KM                                                      
          DO I=1,IMT                                                    
            WHADV_NUT(I,K)=TA(I,K,M)                                    
          ENDDO                                                         
         ENDDO                                                          
       ENDIF                                                            
C                                                                       
       IF (.NOT.(L_OIMPADDF)) THEN                                      
C                                                                       
C  4TH, COMPUTE FLUX THROUGH TOP OF T BOX                               
C                                                                       
      IF (O_ADVECT_SCHEME(1,M).EQ.1) THEN                               
!      Centred differencing for all tracers for which                   
!      O_ADVECT_SCHEME equals zero.                                     
C                                                                       
      DO K=2,KM                                                         
            DO I=1,IMT                                                  
               TEMPB(I,K)=W(I,K)*(T(I,K-1,M)+T(I,K,M))                  
            ENDDO ! over I                                              
      ENDDO ! over K                                                    
C                                                                       
C                                                                       
C the following calculation for the flux at the surface for the free    
C surface solution follows the method used by Killworth and used in     
C the MOMA code. It is not second order accurate                        
C                                                                       
      IF (L_OFREESFC) THEN                                              
        DO I=1,IMT                                                      
          TEMPB(I,1)=2.0*W(I,1)*T(I,1,M)                                
          TEMPB(I,KMP1)=0.0                                             
        ENDDO                                                           
*D OSY1F405.134,OSY1F405.138  
      ELSE                                                              
        DO I=1,IMT                                                      
          TEMPB(I,1)=0.0                                                
          TEMPB(I,KMP1)=0.0                                             
*I OSY1F405.139   
                                                                        
      ENDIF     ! L_OFREESFC                                            
                                                                        
      ELSE                                                              
C                                                                       
!      Upwind differencing if O_ADVECT_SCHEME > zero                    
      DO K=2,KM                                                         
           DO I=1,IMT                                                   
              TEMPB(I,K) = 2.0 * AMAX1(W(I,K),0.0) * TB(I,K,M)          
     &              + 2.0 * AMIN1(W(I,K),0.0) * TB(I,K-1,M)             
           ENDDO ! over I                                               
      ENDDO ! over K                                                    
C                                                                       
                                                                        
      IF (L_OFREESFC) THEN                                              
        DO I=1,IMT                                                      
          TEMPB(I,1)=2.0 * AMAX1(W(I,1),0.0) * T(I,1,M)                 
          TEMPB(I,KMP1)=0.0                                             
        ENDDO                                                           
                                                                        
      ELSE                                                              
        DO I=1,IMT                                                      
          TEMPB(I,1)=0.0                                                
          TEMPB(I,KMP1)=0.0                                             
        ENDDO                                                           
                                                                        
      ENDIF     ! L_OFREESFC                                            
C                                                                       
*I OSY1F405.140   
C                                                                       
C                                                                       
C  5TH, ADD IN VERTICAL FLUX DIVERGENCE                                 
C                                                                       
      DO K=1,KM                                                         
            DO I=1,IMT                                                  
C                                                                       
         TA(I,K,M)=TA(I,K,M)+(TEMPB(I,K+1)-TEMPB(I,K))*DZ2RQ(I,K)       
         WDTZADV(I,K)=(TEMPB(I,K+1)-TEMPB(I,K))*DZ2RQ(I,K)              
         IF (L_OBIOLOGY) THEN                                           
            IF (M.EQ.NUTRIENT_TRACER) WNUT_FLUX(I,K)=TEMPB(I,K+1)*0.5   
         ENDIF                                                          
            ENDDO ! over I                                              
C                                                                       
      ENDDO ! over K                                                    
C                                                                       
      ENDIF  ! L_OIMPADDF = false                                       
*D OSY1F405.141
      FX=CST(J)*DYT(J)*CSTR(J+1)*DYTR(J+1)                              
*D OSY1F405.142,OSY1F405.144  
*/
*/       - End of mod tjtrac2
*/
*/ ---------------------------------------------------------------------
