tutorial_global_oce_latlon/code/ptracers_apply_forcing.F

97f6d163ab Davi*0001 #include "PTRACERS_OPTIONS.h"
                0002
                0003 CBOP
9d21426460 Jean*0004 C !ROUTINE: PTRACERS_APPLY_FORCING
97f6d163ab Davi*0005
                0006 C !INTERFACE: ==========================================================
9d21426460 Jean*0007       SUBROUTINE PTRACERS_APPLY_FORCING(
                0008      U                    gPtracer,
                0009      I                    surfForcPtr,
                0010      I                    iMin,iMax,jMin,jMax, k, bi, bj,
                0011      I                    iTracer, myTime, myIter, myThid )
97f6d163ab Davi*0012
                0013 C !DESCRIPTION:
9d21426460 Jean*0014 C     Apply passive tracer forcing, i.e., sources and sinks of tracer,
                0015 C      by adding forcing terms to the tendency array
97f6d163ab Davi*0016
                0017 C !USES: ===============================================================
                0018       IMPLICIT NONE
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
d6215f7b79 Jean*0023 #include "PTRACERS_SIZE.h"
                0024 #include "PTRACERS_PARAMS.h"
                0025 #include "PTRACERS_FIELDS.h"
97f6d163ab Davi*0026
                0027 C !INPUT PARAMETERS: ===================================================
9d21426460 Jean*0028 C  gPtracer             :: the tendency array
                0029 C  surfForcPtr          :: surface forcing term
97f6d163ab Davi*0030 C  iMin iMax jMin jMax  :: working range of tile for applying forcing
                0031 C  k                    :: vertical level number
9d21426460 Jean*0032 C  bi,bj                :: tile indices
97f6d163ab Davi*0033 C  iTracer              :: tracer number
                0034 C  myIter               :: time-step number
                0035 C  myTime               :: model time
                0036 C  myThid               :: thread number
9d21426460 Jean*0037       _RL gPtracer   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0038       _RL surfForcPtr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0039       INTEGER iMin,iMax,jMin,jMax
                0040       INTEGER k, bi,bj, iTracer
97f6d163ab Davi*0041       _RL myTime
9d21426460 Jean*0042       INTEGER myIter
97f6d163ab Davi*0043       INTEGER myThid
                0044
                0045 C !OUTPUT PARAMETERS: ==================================================
ae8a9c26a9 Davi*0046 C  gPtracer       :: updates tendency array
97f6d163ab Davi*0047
                0048 #ifdef ALLOW_PTRACERS
                0049
                0050 C !LOCAL VARIABLES: ====================================================
ae8a9c26a9 Davi*0051 C  i,j            :: loop indices
97f6d163ab Davi*0052       INTEGER i,j
                0053 C     number of surface interface layer
                0054       INTEGER kSurface
                0055 CEOP
                0056
                0057       IF ( usingPCoords ) THEN
                0058        kSurface = Nr
                0059       ELSE
                0060        kSurface = 1
                0061       ENDIF
                0062
9d21426460 Jean*0063 C--   Surface forcing term surfForcPtr is previously computed by
22e0cff85e Jean*0064 C     PTRACERS_FORCING_SURF (and stored as surfaceForcingPTr)
97f6d163ab Davi*0065 C     because it is needed by KPP_TRANSPORT_PTR.
                0066
                0067 #ifdef ALLOW_GCHEM
9d21426460 Jean*0068       IF ( useGCHEM ) THEN
                0069         CALL GCHEM_ADD_TENDENCY(
                0070      U                 gPtracer,
                0071      I                 iMin,iMax,jMin,jMax, k, bi, bj,
                0072      I                 iTracer, myTime, myIter, myThid )
                0073       ENDIF
a09a74749d Davi*0074 #endif /* ALLOW_GCHEM */
                0075
                0076       IF ( k .EQ. kSurface ) THEN
97f6d163ab Davi*0077         DO j=jMin,jMax
                0078          DO i=iMin,iMax
9d21426460 Jean*0079           gPtracer(i,j) = gPtracer(i,j)
                0080      &                  + surfForcPtr(i,j)
                0081      &                   *recip_drF(k)*recip_hFacC(i,j,k,bi,bj)
97f6d163ab Davi*0082          ENDDO
                0083         ENDDO
9d21426460 Jean*0084       ELSE
d6215f7b79 Jean*0085 C-    Case of age-tracer: in the interior, set aging tendency to one:
97f6d163ab Davi*0086         DO j=jMin,jMax
                0087          DO i=iMin,iMax
9d21426460 Jean*0088           gPtracer(i,j) = gPtracer(i,j)
                0089      &                  + 1. _d 0 * maskC(i,j,k,bi,bj)
97f6d163ab Davi*0090          ENDDO
                0091         ENDDO
a09a74749d Davi*0092       ENDIF
97f6d163ab Davi*0093
d6215f7b79 Jean*0094       IF (PTRACERS_linFSConserve(iTracer)) THEN
                0095         IF (k .EQ. kSurface) THEN
                0096           DO j=0,sNy+1
                0097            DO i=0,sNx+1
                0098             gPtracer(i,j) = gPtracer(i,j)
                0099      &           +meanSurfCorPTr(iTracer)*recip_drF(k)
                0100      &           *_recip_hFacC(i,j,k,bi,bj)
                0101            ENDDO
                0102           ENDDO
                0103         ENDIF
                0104       ENDIF
                0105
97f6d163ab Davi*0106 #ifdef ALLOW_RBCS
ae8a9c26a9 Davi*0107       IF ( useRBCS ) THEN
9d21426460 Jean*0108          CALL RBCS_ADD_TENDENCY(
                0109      U                 gPtracer,
                0110      I                 k, bi, bj, iTracer+2,
                0111      I                 myTime, myIter, myThid )
22e0cff85e Jean*0112       ENDIF
                0113 #endif /* ALLOW_RBCS */
97f6d163ab Davi*0114
                0115 #endif /* ALLOW_PTRACERS */
                0116
                0117       RETURN
                0118       END