tutorial_tracer_adjsens/code_tap/ptracers_forcing_surf.F

b4daa24319 Shre*0001 #include "PTRACERS_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: PTRACERS_FORCING_SURF
                0005
                0006 C !INTERFACE: ==========================================================
                0007       SUBROUTINE PTRACERS_FORCING_SURF(
                0008      I                            relaxForcingS,
                0009      I                            bi, bj, iMin, iMax, jMin, jMax,
                0010      I                            myTime,myIter,myThid )
                0011
                0012 C !DESCRIPTION:
                0013 C     Precomputes surface forcing term for pkg/ptracers.
                0014 C     Precomputation is needed because of non-local KPP transport term,
                0015 C     routine KPP_TRANSPORT_PTR.
                0016
                0017 C !USES: ===============================================================
                0018       IMPLICIT NONE
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
                0023 #include "SURFACE.h"
                0024 #include "DYNVARS.h"
                0025 #include "FFIELDS.h"
                0026 #include "PTRACERS_SIZE.h"
                0027 #include "PTRACERS_PARAMS.h"
                0028 #include "PTRACERS_START.h"
                0029 #include "PTRACERS_FIELDS.h"
                0030
                0031 C !INPUT PARAMETERS: ===================================================
                0032 C  relaxForcingS        :: Salt forcing due to surface relaxation
                0033 C  bi,bj                :: tile indices
                0034 C  myTime               :: model time
                0035 C  myIter               :: time-step number
                0036 C  myThid               :: thread number
                0037       _RL relaxForcingS(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0038       INTEGER bi, bj, iMin, iMax, jMin, jMax
                0039       _RL myTime
                0040       INTEGER myIter
                0041       INTEGER myThid
                0042
                0043 #ifdef ALLOW_PTRACERS
                0044
                0045 C !LOCAL VARIABLES: ====================================================
                0046 C  i,j                  :: loop indices
                0047 C  iTrc                 :: tracer index
                0048 C  ks                   :: surface level index
                0049       INTEGER i, j
                0050       INTEGER iTrc, ks
                0051       _RL add2EmP(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0052       _RL epsil, cutoff, tmpVar
                0053 CEOP
                0054
                0055       IF ( usingPCoords ) THEN
                0056         ks = Nr
                0057       ELSE
                0058         ks = 1
                0059       ENDIF
                0060
                0061 C Example of how to add forcing at the surface
                0062       DO iTrc=1,PTRACERS_numInUse
                0063 c       IF ( PTRACERS_StepFwd(iTrc) ) THEN
                0064           DO j = jMin, jMax
                0065            DO i = iMin, iMax
                0066              surfaceForcingPTr(i,j,bi,bj,iTrc) = 0. _d 0
                0067      &                        + surfaceForcingS(i,j,bi,bj)
                0068            ENDDO
                0069           ENDDO
                0070 c       ENDIF
                0071       ENDDO
                0072
                0073 C--   Option to convert Salt-relaxation into additional EmP contribution
                0074       IF ( PTRACERS_addSrelax2EmP ) THEN
                0075 C-    here we assume that salt_EvPrRn = 0
                0076 C     set cutoff value to prevent too large additional EmP:
                0077 C       current limit is set to 0.1 CFL
                0078         epsil = 1. _d -10
                0079         cutoff = 0.1 _d 0 *drF(ks)/PTRACERS_dTLev(ks)
                0080         IF ( ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
                0081      &         .AND. useRealFreshWaterFlux )
                0082      &     .OR.convertFW2Salt .EQ. -1. ) THEN
                0083          DO j = jMin, jMax
                0084           DO i = iMin, iMax
                0085             tmpVar = MAX( salt(i,j,ks,bi,bj), epsil )
                0086             add2EmP(i,j) = relaxForcingS(i,j)/tmpVar
                0087             add2EmP(i,j) = rUnit2mass
                0088      &                  *MAX( -cutoff, MIN( add2EmP(i,j), cutoff ) )
                0089           ENDDO
                0090          ENDDO
                0091         ELSE
                0092          DO j = jMin, jMax
                0093           DO i = iMin, iMax
                0094             add2EmP(i,j) = relaxForcingS(i,j)/convertFW2Salt
                0095             add2EmP(i,j) = rUnit2mass
                0096      &                  *MAX( -cutoff, MIN( add2EmP(i,j), cutoff ) )
                0097           ENDDO
                0098          ENDDO
                0099         ENDIF
                0100 #ifdef ALLOW_DIAGNOSTICS
                0101         IF ( useDiagnostics ) THEN
                0102          CALL DIAGNOSTICS_FILL(add2EmP,'Add2EmP ',0,1,2,bi,bj,myThid)
                0103         ENDIF
                0104 #endif /* ALLOW_DIAGNOSTICS */
                0105       ELSE
                0106         DO j = jMin, jMax
                0107           DO i = iMin, iMax
                0108             add2EmP(i,j) = 0. _d 0
                0109           ENDDO
                0110         ENDDO
                0111       ENDIF
                0112 C-- end of "addEmP" setting
                0113
                0114       IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
                0115      &     .AND. useRealFreshWaterFlux ) THEN
                0116
                0117        DO iTrc=1,PTRACERS_numInUse
                0118
                0119 c-  NonLin_FrSurf and RealFreshWaterFlux : PmEpR effectively changes
                0120 c   the water column height ; temp., salt, (tracer) flux associated
                0121 c   with this input/output of water is added here to the surface tendency.
                0122 c
                0123          IF ( PTRACERS_StepFwd(iTrc) .AND.
                0124      &        PTRACERS_EvPrRn(iTrc).NE.UNSET_RL ) THEN
                0125           DO j = jMin, jMax
                0126            DO i = iMin, iMax
                0127              surfaceForcingPTr(i,j,bi,bj,iTrc) =
                0128      &          surfaceForcingPTr(i,j,bi,bj,iTrc)
                0129      &        + ( PmEpR(i,j,bi,bj) - add2EmP(i,j) )
                0130      &          *( PTRACERS_EvPrRn(iTrc) - pTracer(i,j,ks,bi,bj,iTrc) )
                0131      &          *mass2rUnit
                0132            ENDDO
                0133           ENDDO
                0134          ENDIF
                0135
                0136        ENDDO
                0137
                0138 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0139       ELSE
                0140
                0141 C--   EmPmR does not really affect the water column height (for tracer budget)
                0142 C     and is converted to a salt tendency.
                0143
                0144        IF (convertFW2Salt .EQ. -1.) THEN
                0145 C-    use local surface tracer field to calculate forcing term:
                0146
                0147         DO iTrc=1,PTRACERS_numInUse
                0148
                0149          IF ( PTRACERS_StepFwd(iTrc) .AND.
                0150      &        PTRACERS_EvPrRn(iTrc).NE.UNSET_RL ) THEN
                0151 C        account for Rain/Evap tracer content (PTRACERS_EvPrRn) using
                0152 C        local surface tracer
                0153           DO j = jMin, jMax
                0154            DO i = iMin, iMax
                0155             surfaceForcingPTr(i,j,bi,bj,iTrc) =
                0156      &          surfaceForcingPTr(i,j,bi,bj,iTrc)
                0157      &        + ( EmPmR(i,j,bi,bj) + add2EmP(i,j) )
                0158      &          *( pTracer(i,j,ks,bi,bj,iTrc) - PTRACERS_EvPrRn(iTrc) )
                0159      &          *mass2rUnit
                0160            ENDDO
                0161           ENDDO
                0162          ENDIF
                0163
                0164         ENDDO
                0165
                0166        ELSE
                0167 C-    use uniform tracer value to calculate forcing term:
                0168
                0169         DO iTrc=1,PTRACERS_numInUse
                0170
                0171          IF ( PTRACERS_StepFwd(iTrc) .AND.
                0172      &        PTRACERS_EvPrRn(iTrc).NE.UNSET_RL ) THEN
                0173 C     account for Rain/Evap tracer content (PTRACERS_EvPrRn) assuming uniform
                0174 C     surface tracer (=PTRACERS_ref)
                0175           DO j = jMin, jMax
                0176            DO i = iMin, iMax
                0177             surfaceForcingPTr(i,j,bi,bj,iTrc) =
                0178      &          surfaceForcingPTr(i,j,bi,bj,iTrc)
                0179      &        + ( EmPmR(i,j,bi,bj) + add2EmP(i,j) )
                0180      &            *( PTRACERS_ref(ks,iTrc) - PTRACERS_EvPrRn(iTrc) )
                0181      &            *mass2rUnit
                0182            ENDDO
                0183           ENDDO
                0184          ENDIF
                0185
                0186         ENDDO
                0187
                0188 C-    end local-surface-tracer / uniform-value distinction
                0189        ENDIF
                0190
                0191       ENDIF
                0192
                0193 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0194
                0195 #endif /* ALLOW_PTRACERS */
                0196
                0197       RETURN
                0198       END