C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_u1_adv_tracer.F,v 1.1 2012/03/09 20:13:03 jmc Exp $ C $Name: $ #include "OBCS_OPTIONS.h" CBOP C !ROUTINE: OBCS_U1_ADV_TRACER C !INTERFACE: ========================================================== SUBROUTINE OBCS_U1_ADV_TRACER( I doAdvXdir, I trIdentity, bi, bj, k, I maskLoc, vTrans, tracer, U vT, I myThid ) C !DESCRIPTION: C Update advective flux by replacing values at Open-Boundaries C with simply 1rst Order upwind advection scheme calculation. C Provide the option to do the replacement only in case of outflow C or indpendently of the sign of the flow. C !USES: =============================================================== IMPLICIT NONE C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" c#include "PARAMS.h" #include "GRID.h" #include "OBCS_PARAMS.h" #ifdef ALLOW_PTRACERS # include "PTRACERS_SIZE.h" # include "OBCS_PTRACERS.h" #endif /* ALLOW_PTRACERS */ #ifdef ALLOW_GENERIC_ADVDIFF # include "GAD.h" #endif C !INPUT/OUTPUT PARAMETERS: ============================================ C doAdvXdir :: =T: advection in X-direction ; =F: in Y-direction C trIdentity :: tracer identifier C bi,bj :: tile indices C k :: vertical level C maskLoc :: local mask at velocity location C vTrans :: volume transport C tracer :: tracer field C vT :: advective flux C myThid :: thread number LOGICAL doAdvXdir INTEGER trIdentity INTEGER bi, bj, k _RS maskLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RL tracer (1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RL vT (1-OLx:sNx+OLx,1-OLy:sNy+OLy) INTEGER myThid #ifdef ALLOW_OBCS #ifdef ALLOW_GENERIC_ADVDIFF C !LOCAL VARIABLES: ==================================================== C i,j :: loop indices C msgBuf :: message buffer INTEGER i,j INTEGER updateAdvFlx _RL vAbs, tmpVar CHARACTER*(MAX_LEN_MBUF) msgBuf #ifdef ALLOW_PTRACERS INTEGER iTr #endif /* ALLOW_PTRACERS */ CEOP updateAdvFlx = 0 IF ( trIdentity.EQ.GAD_TEMPERATURE ) THEN updateAdvFlx = OBCS_u1_adv_T ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN updateAdvFlx = OBCS_u1_adv_S #ifdef ALLOW_PTRACERS ELSEIF ( trIdentity.GE.GAD_TR1) THEN iTr = trIdentity - GAD_TR1 + 1 updateAdvFlx = OBCS_u1_adv_Tr(iTr) #endif /* ALLOW_PTRACERS */ ELSE WRITE(msgBuf,'(A,I4)') & ' OBCS_U1_ADV_TRACER: Invalid tracer Id: ',trIdentity CALL PRINT_ERROR(msgBuf, myThid) STOP 'ABNORMAL END: S/R OBCS_U1_ADV_TRACER' ENDIF IF ( updateAdvFlx .GT. 0 ) THEN #ifdef ALLOW_AUTODIFF_TAMC STOP 'ABNORMAL END: S/R OBCS_U1_ADV_TRACER' #else /* ALLOW_AUTODIFF_TAMC */ IF ( doAdvXdir ) THEN C-- Advective flux in X-direction IF ( updateAdvFlx .EQ. 1 ) THEN C- only if outflow DO j=1-OLy,sNy+OLy DO i=2-OLx,sNx+OLx tmpVar = vTrans(i,j)*maskLoc(i,j) & *( maskInC(i-1,j,bi,bj) - maskInC(i,j,bi,bj) ) IF ( tmpVar.GT. 0. _d 0 ) THEN vAbs = ABS(vTrans(i,j)) vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i-1,j) & + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j) ENDIF ENDDO ENDDO ELSE C- no condition (inflow & outflow) DO j=1-OLy,sNy+OLy DO i=2-OLx,sNx+OLx IF ( maskLoc(i,j).EQ.1. .AND. & maskInC(i-1,j,bi,bj).NE.maskInC(i,j,bi,bj) ) THEN vAbs = ABS(vTrans(i,j)) vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i-1,j) & + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j) ENDIF ENDDO ENDDO ENDIF ELSE C-- Advective flux in Y-direction IF ( updateAdvFlx .EQ. 1 ) THEN C- only if outflow DO j=2-OLy,sNy+OLy DO i=1-OLx,sNx+OLx tmpVar = vTrans(i,j)*maskLoc(i,j) & *( maskInC(i,j-1,bi,bj) - maskInC(i,j,bi,bj) ) IF ( tmpVar.GT. 0. _d 0 ) THEN vAbs = ABS(vTrans(i,j)) vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i,j-1) & + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j) ENDIF ENDDO ENDDO ELSE C- no condition (inflow & outflow) DO j=2-OLy,sNy+OLy DO i=1-OLx,sNx+OLx IF ( maskLoc(i,j).EQ.1. .AND. & maskInC(i,j-1,bi,bj).NE.maskInC(i,j,bi,bj) ) THEN vAbs = ABS(vTrans(i,j)) vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i,j-1) & + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j) ENDIF ENDDO ENDDO ENDIF C-- end if X-direction / Y-direction ENDIF #endif /* ALLOW_AUTODIFF_TAMC */ C-- end if updateAdvFlx > 0 ENDIF #endif /* ALLOW_GENERIC_ADVDIFF */ #endif /* ALLOW_OBCS */ RETURN END