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
c3be04357d Jean*0057       IF ( fluidIsAir ) THEN
                0058        kSurface = 0
                0059       ELSEIF ( usingZCoords .AND. useShelfIce ) THEN
                0060        kSurface = -1
                0061       ELSEIF ( usingPCoords ) THEN
97f6d163ab Davi*0062        kSurface = Nr
                0063       ELSE
                0064        kSurface = 1
                0065       ENDIF
                0066
9d21426460 Jean*0067 C--   Surface forcing term surfForcPtr is previously computed by
22e0cff85e Jean*0068 C     PTRACERS_FORCING_SURF (and stored as surfaceForcingPTr)
97f6d163ab Davi*0069 C     because it is needed by KPP_TRANSPORT_PTR.
                0070
                0071 #ifdef ALLOW_GCHEM
9d21426460 Jean*0072       IF ( useGCHEM ) THEN
                0073         CALL GCHEM_ADD_TENDENCY(
                0074      U                 gPtracer,
                0075      I                 iMin,iMax,jMin,jMax, k, bi, bj,
                0076      I                 iTracer, myTime, myIter, myThid )
                0077       ENDIF
a09a74749d Davi*0078 #endif /* ALLOW_GCHEM */
                0079
                0080       IF ( k .EQ. kSurface ) THEN
c3be04357d Jean*0081 c      DO j=jMin,jMax
                0082 c       DO i=iMin,iMax
                0083        DO j=0,sNy+1
                0084         DO i=0,sNx+1
9d21426460 Jean*0085           gPtracer(i,j) = gPtracer(i,j)
                0086      &                  + surfForcPtr(i,j)
                0087      &                   *recip_drF(k)*recip_hFacC(i,j,k,bi,bj)
97f6d163ab Davi*0088         ENDDO
c3be04357d Jean*0089        ENDDO
                0090       ELSEIF ( kSurface.EQ.-1 ) THEN
                0091        DO j=0,sNy+1
                0092         DO i=0,sNx+1
                0093          IF ( kSurfC(i,j,bi,bj).EQ.k ) THEN
                0094           gPtracer(i,j) = gPtracer(i,j)
                0095      &                  + surfForcPtr(i,j)
                0096      &                   *recip_drF(k)*recip_hFacC(i,j,k,bi,bj)
                0097          ENDIF
                0098         ENDDO
                0099        ENDDO
                0100 C---  Customized code starts -----------------------------------------
9d21426460 Jean*0101       ELSE
d6215f7b79 Jean*0102 C-    Case of age-tracer: in the interior, set aging tendency to one:
c3be04357d Jean*0103        DO j=0,sNy+1
                0104         DO i=0,sNx+1
9d21426460 Jean*0105           gPtracer(i,j) = gPtracer(i,j)
                0106      &                  + 1. _d 0 * maskC(i,j,k,bi,bj)
97f6d163ab Davi*0107         ENDDO
c3be04357d Jean*0108        ENDDO
                0109 C---  Customized code ends -------------------------------------------
a09a74749d Davi*0110       ENDIF
97f6d163ab Davi*0111
d6215f7b79 Jean*0112       IF (PTRACERS_linFSConserve(iTracer)) THEN
c3be04357d Jean*0113        DO j=0,sNy+1
                0114         DO i=0,sNx+1
                0115          IF ( kSurfC(i,j,bi,bj).EQ.k ) THEN
d6215f7b79 Jean*0116             gPtracer(i,j) = gPtracer(i,j)
                0117      &           +meanSurfCorPTr(iTracer)*recip_drF(k)
                0118      &           *_recip_hFacC(i,j,k,bi,bj)
c3be04357d Jean*0119          ENDIF
                0120         ENDDO
                0121        ENDDO
d6215f7b79 Jean*0122       ENDIF
                0123
97f6d163ab Davi*0124 #ifdef ALLOW_RBCS
ae8a9c26a9 Davi*0125       IF ( useRBCS ) THEN
9d21426460 Jean*0126          CALL RBCS_ADD_TENDENCY(
                0127      U                 gPtracer,
                0128      I                 k, bi, bj, iTracer+2,
                0129      I                 myTime, myIter, myThid )
22e0cff85e Jean*0130       ENDIF
                0131 #endif /* ALLOW_RBCS */
97f6d163ab Davi*0132
                0133 #endif /* ALLOW_PTRACERS */
                0134
                0135       RETURN
                0136       END