/[MITgcm]/MITgcm/pkg/obcs/obcs_u1_adv_tracer.F
ViewVC logotype

Annotation of /MITgcm/pkg/obcs/obcs_u1_adv_tracer.F

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

Revision 1.1 - (hide annotations) (download)
Fri Mar 9 20:13:03 2012 UTC (12 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64o, checkpoint64a, checkpoint63r, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint64n, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint64b, checkpoint63m, checkpoint64e, checkpoint63q, checkpoint64d, checkpoint64c, checkpoint64g, checkpoint64f, checkpoint63l, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint63n, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint63k, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64i, checkpoint63o, checkpoint63p, checkpoint64h, checkpoint63s, checkpoint64k, checkpoint64, checkpoint65, checkpoint64j, checkpoint64m, checkpoint64l, HEAD 
- allow to switch to upwind 1rst order advection scheme for the advective
  flux computaion at the open-boundary (new S/R obcs_u1_adv_tracer.F)
1 jmc 1.1 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_exchanges.F,v 1.2 2011/05/24 14:31:14 jmc Exp $
2     C $Name: $
3    
4     #include "OBCS_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: OBCS_U1_ADV_TRACER
8    
9     C !INTERFACE: ==========================================================
10     SUBROUTINE OBCS_U1_ADV_TRACER(
11     I doAdvXdir,
12     I trIdentity, bi, bj, k,
13     I maskLoc, vTrans, tracer,
14     U vT,
15     I myThid )
16    
17     C !DESCRIPTION:
18     C Update advective flux by replacing values at Open-Boundaries
19     C with simply 1rst Order upwind advection scheme calculation.
20     C Provide the option to do the replacement only in case of outflow
21     C or indpendently of the sign of the flow.
22    
23     C !USES: ===============================================================
24     IMPLICIT NONE
25     C == Global variables ==
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     c#include "PARAMS.h"
29     #include "GRID.h"
30     #include "OBCS_PARAMS.h"
31     #ifdef ALLOW_PTRACERS
32     # include "PTRACERS_SIZE.h"
33     # include "OBCS_PTRACERS.h"
34     #endif /* ALLOW_PTRACERS */
35     #ifdef ALLOW_GENERIC_ADVDIFF
36     # include "GAD.h"
37     #endif
38    
39     C !INPUT/OUTPUT PARAMETERS: ============================================
40     C doAdvXdir :: =T: advection in X-direction ; =F: in Y-direction
41     C trIdentity :: tracer identifier
42     C bi,bj :: tile indices
43     C k :: vertical level
44     C maskLoc :: local mask at velocity location
45     C vTrans :: volume transport
46     C tracer :: tracer field
47     C vT :: advective flux
48     C myThid :: thread number
49     LOGICAL doAdvXdir
50     INTEGER trIdentity
51     INTEGER bi, bj, k
52     _RS maskLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53     _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54     _RL tracer (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55     _RL vT (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56     INTEGER myThid
57    
58     #ifdef ALLOW_OBCS
59     #ifdef ALLOW_GENERIC_ADVDIFF
60     C !LOCAL VARIABLES: ====================================================
61     C i,j :: loop indices
62     C msgBuf :: message buffer
63     INTEGER i,j
64     INTEGER updateAdvFlx
65     _RL vAbs, tmpVar
66     CHARACTER*(MAX_LEN_MBUF) msgBuf
67     #ifdef ALLOW_PTRACERS
68     INTEGER iTr
69     #endif /* ALLOW_PTRACERS */
70     CEOP
71    
72     updateAdvFlx = 0
73     IF ( trIdentity.EQ.GAD_TEMPERATURE ) THEN
74     updateAdvFlx = OBCS_u1_adv_T
75     ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN
76     updateAdvFlx = OBCS_u1_adv_S
77     #ifdef ALLOW_PTRACERS
78     ELSEIF ( trIdentity.GE.GAD_TR1) THEN
79     iTr = trIdentity - GAD_TR1 + 1
80     updateAdvFlx = OBCS_u1_adv_Tr(iTr)
81     #endif /* ALLOW_PTRACERS */
82     ELSE
83     WRITE(msgBuf,'(A,I4)')
84     & ' OBCS_U1_ADV_TRACER: Invalid tracer Id: ',trIdentity
85     CALL PRINT_ERROR(msgBuf, myThid)
86     STOP 'ABNORMAL END: S/R OBCS_U1_ADV_TRACER'
87     ENDIF
88    
89     IF ( updateAdvFlx .GT. 0 ) THEN
90    
91     #ifdef ALLOW_AUTODIFF_TAMC
92     STOP 'ABNORMAL END: S/R OBCS_U1_ADV_TRACER'
93     #else /* ALLOW_AUTODIFF_TAMC */
94    
95     IF ( doAdvXdir ) THEN
96     C-- Advective flux in X-direction
97    
98     IF ( updateAdvFlx .EQ. 1 ) THEN
99     C- only if outflow
100     DO j=1-OLy,sNy+OLy
101     DO i=2-OLx,sNx+OLx
102     tmpVar = vTrans(i,j)*maskLoc(i,j)
103     & *( maskInC(i-1,j,bi,bj) - maskInC(i,j,bi,bj) )
104     IF ( tmpVar.GT. 0. _d 0 ) THEN
105     vAbs = ABS(vTrans(i,j))
106     vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i-1,j)
107     & + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j)
108     ENDIF
109     ENDDO
110     ENDDO
111     ELSE
112     C- no condition (inflow & outflow)
113     DO j=1-OLy,sNy+OLy
114     DO i=2-OLx,sNx+OLx
115     IF ( maskLoc(i,j).EQ.1. .AND.
116     & maskInC(i-1,j,bi,bj).NE.maskInC(i,j,bi,bj) ) THEN
117     vAbs = ABS(vTrans(i,j))
118     vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i-1,j)
119     & + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j)
120     ENDIF
121     ENDDO
122     ENDDO
123     ENDIF
124    
125     ELSE
126     C-- Advective flux in Y-direction
127    
128     IF ( updateAdvFlx .EQ. 1 ) THEN
129     C- only if outflow
130     DO j=2-OLy,sNy+OLy
131     DO i=1-OLx,sNx+OLx
132     tmpVar = vTrans(i,j)*maskLoc(i,j)
133     & *( maskInC(i,j-1,bi,bj) - maskInC(i,j,bi,bj) )
134     IF ( tmpVar.GT. 0. _d 0 ) THEN
135     vAbs = ABS(vTrans(i,j))
136     vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i,j-1)
137     & + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j)
138     ENDIF
139     ENDDO
140     ENDDO
141     ELSE
142     C- no condition (inflow & outflow)
143     DO j=2-OLy,sNy+OLy
144     DO i=1-OLx,sNx+OLx
145     IF ( maskLoc(i,j).EQ.1. .AND.
146     & maskInC(i,j-1,bi,bj).NE.maskInC(i,j,bi,bj) ) THEN
147     vAbs = ABS(vTrans(i,j))
148     vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i,j-1)
149     & + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j)
150     ENDIF
151     ENDDO
152     ENDDO
153     ENDIF
154    
155     C-- end if X-direction / Y-direction
156     ENDIF
157    
158     #endif /* ALLOW_AUTODIFF_TAMC */
159    
160     C-- end if updateAdvFlx > 0
161     ENDIF
162    
163     #endif /* ALLOW_GENERIC_ADVDIFF */
164     #endif /* ALLOW_OBCS */
165    
166     RETURN
167     END
  ViewVC Help
Powered by ViewVC 1.1.22