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 #ifdef EXACT_CONSERV
                0115       IF ( (nonlinFreeSurf.GT.0 .OR. usingPCoords)
                0116      &     .AND. useRealFreshWaterFlux ) THEN
                0117
                0118        DO iTrc=1,PTRACERS_numInUse
                0119
                0120 c-  NonLin_FrSurf and RealFreshWaterFlux : PmEpR effectively changes
                0121 c   the water column height ; temp., salt, (tracer) flux associated
                0122 c   with this input/output of water is added here to the surface tendency.
                0123 c
                0124          IF ( PTRACERS_StepFwd(iTrc) .AND.
                0125      &        PTRACERS_EvPrRn(iTrc).NE.UNSET_RL ) THEN
                0126           DO j = jMin, jMax
                0127            DO i = iMin, iMax
                0128              surfaceForcingPTr(i,j,bi,bj,iTrc) =
                0129      &          surfaceForcingPTr(i,j,bi,bj,iTrc)
                0130      &        + ( PmEpR(i,j,bi,bj) - add2EmP(i,j) )
                0131      &          *( PTRACERS_EvPrRn(iTrc) - pTracer(i,j,ks,bi,bj,iTrc) )
                0132      &          *mass2rUnit
                0133            ENDDO
                0134           ENDDO
                0135          ENDIF
                0136
                0137        ENDDO
                0138
                0139 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0140       ELSE
                0141 #else /* EXACT_CONSERV */
                0142       IF (.TRUE.) THEN
                0143 #endif /* EXACT_CONSERV */
                0144
                0145 C--   EmPmR does not really affect the water column height (for tracer budget)
                0146 C     and is converted to a salt tendency.
                0147
                0148        IF (convertFW2Salt .EQ. -1.) THEN
                0149 C-    use local surface tracer field to calculate forcing term:
                0150
                0151         DO iTrc=1,PTRACERS_numInUse
                0152
                0153          IF ( PTRACERS_StepFwd(iTrc) .AND.
                0154      &        PTRACERS_EvPrRn(iTrc).NE.UNSET_RL ) THEN
                0155 C        account for Rain/Evap tracer content (PTRACERS_EvPrRn) using
                0156 C        local surface tracer
                0157           DO j = jMin, jMax
                0158            DO i = iMin, iMax
                0159             surfaceForcingPTr(i,j,bi,bj,iTrc) =
                0160      &          surfaceForcingPTr(i,j,bi,bj,iTrc)
                0161      &        + ( EmPmR(i,j,bi,bj) + add2EmP(i,j) )
                0162      &          *( pTracer(i,j,ks,bi,bj,iTrc) - PTRACERS_EvPrRn(iTrc) )
                0163      &          *mass2rUnit
                0164            ENDDO
                0165           ENDDO
                0166          ENDIF
                0167
                0168         ENDDO
                0169
                0170        ELSE
                0171 C-    use uniform tracer value to calculate forcing term:
                0172
                0173         DO iTrc=1,PTRACERS_numInUse
                0174
                0175          IF ( PTRACERS_StepFwd(iTrc) .AND.
                0176      &        PTRACERS_EvPrRn(iTrc).NE.UNSET_RL ) THEN
                0177 C     account for Rain/Evap tracer content (PTRACERS_EvPrRn) assuming uniform
                0178 C     surface tracer (=PTRACERS_ref)
                0179           DO j = jMin, jMax
                0180            DO i = iMin, iMax
                0181             surfaceForcingPTr(i,j,bi,bj,iTrc) =
                0182      &          surfaceForcingPTr(i,j,bi,bj,iTrc)
                0183      &        + ( EmPmR(i,j,bi,bj) + add2EmP(i,j) )
                0184      &            *( PTRACERS_ref(ks,iTrc) - PTRACERS_EvPrRn(iTrc) )
                0185      &            *mass2rUnit
                0186            ENDDO
                0187           ENDDO
                0188          ENDIF
                0189
                0190         ENDDO
                0191
                0192 C-    end local-surface-tracer / uniform-value distinction
                0193        ENDIF
                0194
                0195       ENDIF
                0196
                0197 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0198
                0199 #endif /* ALLOW_PTRACERS */
                0200
                0201       RETURN
                0202       END