pkg/rbcs/rbcs_add_tendency.F

C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_add_tendency.F,v 1.8 2011/05/21 00:44:53 gforget Exp $
C $Name:  $

#include "RBCS_OPTIONS.h"

CBOP
C !ROUTINE: RBCS_ADD_TSTENDENCY

C !INTERFACE: ==========================================================
      SUBROUTINE RBCS_ADD_TENDENCY(
     I                    bi, bj, k, tracerNum,
     I                    myTime, myThid )

C !DESCRIPTION:
C     Will update tendencies with terms to relax to 3-D field

C !USES: ===============================================================
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
c#include "GRID.h"
#include "DYNVARS.h"
#ifdef ALLOW_PTRACERS
#include "PTRACERS_SIZE.h"
#include "PTRACERS_FIELDS.h"
#endif
#include "RBCS_SIZE.h"
#include "RBCS_PARAMS.h"
#include "RBCS_FIELDS.h"

C !INPUT PARAMETERS: ===================================================
C  bi,bj          :: tile indices
C  k              :: vertical level index
C  tracerNum      :: tracer number (1=Temp, 2=Salt, >2 : ptracer)
C  myTime         :: current time
C  myIter         :: current timestep
C  myThid         :: my Thread Id number
      INTEGER bi, bj, k
      INTEGER tracerNum
      _RL myTime
c     INTEGER myIter
      INTEGER myThid

C !LOCAL VARIABLES: ====================================================
C  i,j            :: loop indices
      INTEGER i,j
      _RL rbcsVanishingFac
#ifdef ALLOW_PTRACERS
      INTEGER iTracer
      INTEGER irbc
#endif
CEOP

#ifdef ALLOW_RBCS

      if (rbcsVanishingTime.GT.0. _d 0) then
        rbcsVanishingFac = 
     &  MAX( 0. _d 0 , 1. _d 0 - mytime / rbcsVanishingTime )
      else
        rbcsVanishingFac = 1. _d 0
      endif
 
#ifndef DISABLE_RBCS_MOM
      IF ( tracerNum.EQ.-1 .AND. useRBCuVel ) THEN
        DO j=0,sNy+1
         DO i=0,sNx+1
          gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)
     &       - RBC_maskU(i,j,k,bi,bj)/tauRelaxU
     &        *( uVel(i,j,k,bi,bj)- RBCuVel(i,j,k,bi,bj) )
c    &        *maskW(i,j,k,bi,bj)
     &        *rbcsVanishingFac         
         ENDDO
        ENDDO
      ENDIF
      IF ( tracerNum.EQ.-2 .AND. useRBCvVel ) THEN
        DO j=0,sNy+1
         DO i=0,sNx+1
          gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)
     &       - RBC_maskV(i,j,k,bi,bj)/tauRelaxV
     &        *( vVel(i,j,k,bi,bj)- RBCvVel(i,j,k,bi,bj) )
c    &        *maskS(i,j,k,bi,bj)
     &        *rbcsVanishingFac         
         ENDDO
        ENDDO
      ENDIF
#endif /* DISABLE_RBCS_MOM */

      IF ( tracerNum.EQ.1 .AND. useRBCtemp ) THEN
        DO j=1,sNy
         DO i=1,sNx
          gT(i,j,k,bi,bj) = gT(i,j,k,bi,bj)
     &       - RBC_mask(i,j,k,bi,bj,1)/tauRelaxT
     &        *( theta(i,j,k,bi,bj)- RBCtemp(i,j,k,bi,bj) )
c    &        *maskC(i,j,k,bi,bj)
     &        *rbcsVanishingFac

         ENDDO
        ENDDO
      ENDIF

      IF ( tracerNum.EQ.2 .AND. useRBCsalt ) THEN
        DO j=1,sNy
         DO i=1,sNx
          gS(i,j,k,bi,bj) = gS(i,j,k,bi,bj)
     &       - RBC_mask(i,j,k,bi,bj,2)/tauRelaxS
     &        *( salt(i,j,k,bi,bj)- RBCsalt(i,j,k,bi,bj) )
c    &        *maskC(i,j,k,bi,bj)
     &        *rbcsVanishingFac
         ENDDO
        ENDDO
      ENDIF

#ifdef ALLOW_PTRACERS
      IF ( usePTRACERS .AND. tracerNum.GT.2 ) THEN
       iTracer = tracerNum-2
       irbc = MIN(maskLEN,tracerNum)
       IF ( useRBCptrnum(iTracer) ) THEN
        DO j=1,sNy
         DO i=1,sNx
          gPtr(i,j,k,bi,bj,iTracer) = gPtr(i,j,k,bi,bj,iTracer)
     &       - RBC_mask(i,j,k,bi,bj,irbc)/tauRelaxPTR(iTracer)
     &        *( pTracer(i,j,k,bi,bj,iTracer)
     &           - RBC_ptracers(i,j,k,bi,bj,iTracer) )
c    &        *maskC(i,j,k,bi,bj)
     &        *rbcsVanishingFac
         ENDDO
        ENDDO
       ENDIF
      ENDIF
#endif /* ALLOW_PTRACERS */

#endif /* ALLOW_RBCS */

      RETURN
      END
1	gforget	1.9	C $Header: /u/gcmpack/MITgcm/pkg/rbcs/rbcs_add_tendency.F,v 1.8 2011/05/21 00:44:53 gforget Exp $
2	jmc	1.3	C $Name: $
3	stephd	1.1
4	jmc	1.5	#include "RBCS_OPTIONS.h"
5	stephd	1.1
6			CBOP
7			C !ROUTINE: RBCS_ADD_TSTENDENCY
8
9			C !INTERFACE: ==========================================================
10	jmc	1.5	SUBROUTINE RBCS_ADD_TENDENCY(
11			I bi, bj, k, tracerNum,
12			I myTime, myThid )
13	stephd	1.1
14			C !DESCRIPTION:
15			C Will update tendencies with terms to relax to 3-D field
16
17			C !USES: ===============================================================
18			IMPLICIT NONE
19			#include "SIZE.h"
20			#include "EEPARAMS.h"
21			#include "PARAMS.h"
22	jmc	1.6	c#include "GRID.h"
23			#include "DYNVARS.h"
24	stephd	1.1	#ifdef ALLOW_PTRACERS
25			#include "PTRACERS_SIZE.h"
26	jmc	1.4	#include "PTRACERS_FIELDS.h"
27	stephd	1.1	#endif
28	jmc	1.6	#include "RBCS_SIZE.h"
29			#include "RBCS_PARAMS.h"
30			#include "RBCS_FIELDS.h"
31	stephd	1.1
32			C !INPUT PARAMETERS: ===================================================
33	jmc	1.5	C bi,bj :: tile indices
34			C k :: vertical level index
35			C tracerNum :: tracer number (1=Temp, 2=Salt, >2 : ptracer)
36			C myTime :: current time
37			C myIter :: current timestep
38			C myThid :: my Thread Id number
39			INTEGER bi, bj, k
40			INTEGER tracerNum
41	stephd	1.1	_RL myTime
42	jmc	1.5	c INTEGER myIter
43			INTEGER myThid
44	stephd	1.1
45			C !LOCAL VARIABLES: ====================================================
46	jmc	1.5	C i,j :: loop indices
47	stephd	1.1	INTEGER i,j
48	gforget	1.9	_RL rbcsVanishingFac
49	jmc	1.5	#ifdef ALLOW_PTRACERS
50	stephd	1.1	INTEGER iTracer
51			INTEGER irbc
52	jmc	1.5	#endif
53	stephd	1.1	CEOP
54
55			#ifdef ALLOW_RBCS
56
57	gforget	1.9	if (rbcsVanishingTime.GT.0. _d 0) then
58			rbcsVanishingFac =
59			& MAX( 0. _d 0 , 1. _d 0 - mytime / rbcsVanishingTime )
60			else
61			rbcsVanishingFac = 1. _d 0
62			endif
63
64	jmc	1.6	#ifndef DISABLE_RBCS_MOM
65			IF ( tracerNum.EQ.-1 .AND. useRBCuVel ) THEN
66			DO j=0,sNy+1
67			DO i=0,sNx+1
68			gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)
69			& - RBC_maskU(i,j,k,bi,bj)/tauRelaxU
70			& *( uVel(i,j,k,bi,bj)- RBCuVel(i,j,k,bi,bj) )
71			c & *maskW(i,j,k,bi,bj)
72	gforget	1.9	& *rbcsVanishingFac
73	jmc	1.6	ENDDO
74			ENDDO
75			ENDIF
76			IF ( tracerNum.EQ.-2 .AND. useRBCvVel ) THEN
77			DO j=0,sNy+1
78			DO i=0,sNx+1
79			gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)
80			& - RBC_maskV(i,j,k,bi,bj)/tauRelaxV
81			& *( vVel(i,j,k,bi,bj)- RBCvVel(i,j,k,bi,bj) )
82			c & *maskS(i,j,k,bi,bj)
83	gforget	1.9	& *rbcsVanishingFac
84	jmc	1.6	ENDDO
85			ENDDO
86			ENDIF
87			#endif /* DISABLE_RBCS_MOM */
88
89	jmc	1.5	IF ( tracerNum.EQ.1 .AND. useRBCtemp ) THEN
90	stephd	1.1	DO j=1,sNy
91	jmc	1.5	DO i=1,sNx
92			gT(i,j,k,bi,bj) = gT(i,j,k,bi,bj)
93	jmc	1.6	& - RBC_mask(i,j,k,bi,bj,1)/tauRelaxT
94	jmc	1.5	& *( theta(i,j,k,bi,bj)- RBCtemp(i,j,k,bi,bj) )
95	jmc	1.6	c & *maskC(i,j,k,bi,bj)
96	gforget	1.9	& *rbcsVanishingFac
97
98	jmc	1.5	ENDDO
99	stephd	1.1	ENDDO
100	jmc	1.5	ENDIF
101	stephd	1.1
102	jmc	1.5	IF ( tracerNum.EQ.2 .AND. useRBCsalt ) THEN
103	stephd	1.1	DO j=1,sNy
104	jmc	1.5	DO i=1,sNx
105			gS(i,j,k,bi,bj) = gS(i,j,k,bi,bj)
106	jmc	1.6	& - RBC_mask(i,j,k,bi,bj,2)/tauRelaxS
107	jmc	1.5	& *( salt(i,j,k,bi,bj)- RBCsalt(i,j,k,bi,bj) )
108	jmc	1.6	c & *maskC(i,j,k,bi,bj)
109	gforget	1.9	& *rbcsVanishingFac
110	jmc	1.5	ENDDO
111	stephd	1.1	ENDDO
112	jmc	1.5	ENDIF
113	stephd	1.1
114			#ifdef ALLOW_PTRACERS
115	jmc	1.5	IF ( usePTRACERS .AND. tracerNum.GT.2 ) THEN
116			iTracer = tracerNum-2
117			irbc = MIN(maskLEN,tracerNum)
118			IF ( useRBCptrnum(iTracer) ) THEN
119			DO j=1,sNy
120	stephd	1.1	DO i=1,sNx
121	jmc	1.5	gPtr(i,j,k,bi,bj,iTracer) = gPtr(i,j,k,bi,bj,iTracer)
122	jmc	1.6	& - RBC_mask(i,j,k,bi,bj,irbc)/tauRelaxPTR(iTracer)
123	jmc	1.5	& *( pTracer(i,j,k,bi,bj,iTracer)
124			& - RBC_ptracers(i,j,k,bi,bj,iTracer) )
125	jmc	1.6	c & *maskC(i,j,k,bi,bj)
126	gforget	1.9	& *rbcsVanishingFac
127	stephd	1.1	ENDDO
128	jmc	1.5	ENDDO
129			ENDIF
130			ENDIF
131			#endif /* ALLOW_PTRACERS */
132	stephd	1.1
133			#endif /* ALLOW_RBCS */
134
135			RETURN
136			END