pkg/obcs/obcs_u1_adv_tracer.F

4fb81a5efb Jean*0001 #include "OBCS_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: OBCS_U1_ADV_TRACER
                0005
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE OBCS_U1_ADV_TRACER(
                0008      I           doAdvXdir,
                0009      I           trIdentity, bi, bj, k,
                0010      I           maskLoc, vTrans, tracer,
                0011      U           vT,
                0012      I           myThid )
                0013
                0014 C !DESCRIPTION:
                0015 C  Update advective flux by replacing values at Open-Boundaries
                0016 C  with simply 1rst Order upwind advection scheme calculation.
                0017 C  Provide the option to do the replacement only in case of outflow
                0018 C  or indpendently of the sign of the flow.
                0019
                0020 C !USES: ===============================================================
                0021       IMPLICIT NONE
                0022 C == Global variables ==
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 c#include "PARAMS.h"
                0026 #include "GRID.h"
                0027 #include "OBCS_PARAMS.h"
                0028 #ifdef ALLOW_PTRACERS
                0029 # include "PTRACERS_SIZE.h"
                0030 # include "OBCS_PTRACERS.h"
                0031 #endif /* ALLOW_PTRACERS */
                0032 #ifdef ALLOW_GENERIC_ADVDIFF
                0033 # include "GAD.h"
                0034 #endif
                0035
                0036 C !INPUT/OUTPUT PARAMETERS: ============================================
                0037 C  doAdvXdir    :: =T: advection in X-direction ; =F: in Y-direction
                0038 C  trIdentity   :: tracer identifier
                0039 C  bi,bj        :: tile indices
                0040 C  k            :: vertical level
                0041 C  maskLoc      :: local mask at velocity location
                0042 C  vTrans       :: volume transport
                0043 C  tracer       :: tracer field
                0044 C  vT           :: advective flux
                0045 C  myThid       :: thread number
                0046       LOGICAL doAdvXdir
                0047       INTEGER trIdentity
                0048       INTEGER bi, bj, k
                0049       _RS maskLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0050       _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0051       _RL tracer (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0052       _RL vT     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0053       INTEGER myThid
                0054
                0055 #ifdef ALLOW_OBCS
                0056 #ifdef ALLOW_GENERIC_ADVDIFF
                0057 C !LOCAL VARIABLES: ====================================================
                0058 C  i,j          :: loop indices
                0059 C  msgBuf       :: message buffer
                0060       INTEGER i,j
                0061       INTEGER updateAdvFlx
                0062       _RL vAbs, tmpVar
                0063       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0064 #ifdef ALLOW_PTRACERS
                0065       INTEGER iTr
                0066 #endif /* ALLOW_PTRACERS */
                0067 CEOP
                0068
                0069       updateAdvFlx = 0
                0070       IF ( trIdentity.EQ.GAD_TEMPERATURE ) THEN
                0071         updateAdvFlx = OBCS_u1_adv_T
                0072       ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN
                0073         updateAdvFlx = OBCS_u1_adv_S
                0074 #ifdef ALLOW_PTRACERS
                0075       ELSEIF ( trIdentity.GE.GAD_TR1) THEN
                0076         iTr = trIdentity - GAD_TR1 + 1
                0077         updateAdvFlx = OBCS_u1_adv_Tr(iTr)
                0078 #endif /* ALLOW_PTRACERS */
                0079       ELSE
                0080         WRITE(msgBuf,'(A,I4)')
                0081      &       ' OBCS_U1_ADV_TRACER: Invalid tracer Id: ',trIdentity
                0082         CALL PRINT_ERROR(msgBuf, myThid)
                0083         STOP 'ABNORMAL END: S/R OBCS_U1_ADV_TRACER'
                0084       ENDIF
                0085
                0086       IF ( updateAdvFlx .GT. 0 ) THEN
                0087
                0088 #ifdef ALLOW_AUTODIFF_TAMC
                0089          STOP 'ABNORMAL END: S/R OBCS_U1_ADV_TRACER'
                0090 #else /* ALLOW_AUTODIFF_TAMC */
                0091
                0092         IF ( doAdvXdir ) THEN
                0093 C--   Advective flux in X-direction
                0094
                0095          IF ( updateAdvFlx .EQ. 1 ) THEN
                0096 C-    only if outflow
                0097           DO j=1-OLy,sNy+OLy
                0098            DO i=2-OLx,sNx+OLx
                0099             tmpVar = vTrans(i,j)*maskLoc(i,j)
                0100      &             *( maskInC(i-1,j,bi,bj) - maskInC(i,j,bi,bj) )
                0101             IF ( tmpVar.GT. 0. _d 0 ) THEN
                0102               vAbs = ABS(vTrans(i,j))
                0103               vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i-1,j)
                0104      &                + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j)
                0105             ENDIF
                0106            ENDDO
                0107           ENDDO
                0108          ELSE
                0109 C-    no condition (inflow & outflow)
                0110           DO j=1-OLy,sNy+OLy
                0111            DO i=2-OLx,sNx+OLx
                0112             IF ( maskLoc(i,j).EQ.1. .AND.
                0113      &           maskInC(i-1,j,bi,bj).NE.maskInC(i,j,bi,bj) ) THEN
                0114               vAbs = ABS(vTrans(i,j))
                0115               vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i-1,j)
                0116      &                + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j)
                0117             ENDIF
                0118            ENDDO
                0119           ENDDO
                0120          ENDIF
                0121
                0122         ELSE
                0123 C--   Advective flux in Y-direction
                0124
                0125          IF ( updateAdvFlx .EQ. 1 ) THEN
                0126 C-    only if outflow
                0127           DO j=2-OLy,sNy+OLy
                0128            DO i=1-OLx,sNx+OLx
                0129             tmpVar = vTrans(i,j)*maskLoc(i,j)
                0130      &             *( maskInC(i,j-1,bi,bj) - maskInC(i,j,bi,bj) )
                0131             IF ( tmpVar.GT. 0. _d 0 ) THEN
                0132               vAbs = ABS(vTrans(i,j))
                0133               vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i,j-1)
                0134      &                + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j)
                0135             ENDIF
                0136            ENDDO
                0137           ENDDO
                0138          ELSE
                0139 C-    no condition (inflow & outflow)
                0140           DO j=2-OLy,sNy+OLy
                0141            DO i=1-OLx,sNx+OLx
                0142             IF ( maskLoc(i,j).EQ.1. .AND.
                0143      &           maskInC(i,j-1,bi,bj).NE.maskInC(i,j,bi,bj) ) THEN
                0144               vAbs = ABS(vTrans(i,j))
                0145               vT(i,j) = ( vTrans(i,j)+vAbs )* 0.5 _d 0 * tracer(i,j-1)
                0146      &                + ( vTrans(i,j)-vAbs )* 0.5 _d 0 * tracer(i,j)
                0147             ENDIF
                0148            ENDDO
                0149           ENDDO
                0150          ENDIF
                0151
                0152 C--   end if X-direction / Y-direction
                0153         ENDIF
                0154
                0155 #endif /* ALLOW_AUTODIFF_TAMC */
                0156
                0157 C--   end if updateAdvFlx > 0
                0158       ENDIF
                0159
                0160 #endif /* ALLOW_GENERIC_ADVDIFF */
                0161 #endif /* ALLOW_OBCS */
                0162
                0163       RETURN
                0164       END