pkg/ptracers/ptracers_apply_forcing.F

785a077159 Alis*0001 #include "PTRACERS_OPTIONS.h"
                0002
                0003 CBOP
e07d0b88b1 Jean*0004 C !ROUTINE: PTRACERS_APPLY_FORCING
785a077159 Alis*0005
                0006 C !INTERFACE: ==========================================================
e07d0b88b1 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 )
785a077159 Alis*0012
                0013 C !DESCRIPTION:
e07d0b88b1 Jean*0014 C     Apply passive tracer forcing, i.e., sources and sinks of tracer,
                0015 C      by adding forcing terms to the tendency array
785a077159 Alis*0016
                0017 C !USES: ===============================================================
                0018       IMPLICIT NONE
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
ab62c4c1c3 Mart*0023 #include "PTRACERS_SIZE.h"
                0024 #include "PTRACERS_PARAMS.h"
                0025 #include "PTRACERS_FIELDS.h"
785a077159 Alis*0026
                0027 C !INPUT PARAMETERS: ===================================================
e07d0b88b1 Jean*0028 C  gPtracer             :: the tendency array
                0029 C  surfForcPtr          :: surface forcing term
c61ca13fc6 Dimi*0030 C  iMin iMax jMin jMax  :: working range of tile for applying forcing
785a077159 Alis*0031 C  k                    :: vertical level number
e07d0b88b1 Jean*0032 C  bi,bj                :: tile indices
d38609479c Mart*0033 C  iTracer              :: tracer number
785a077159 Alis*0034 C  myIter               :: time-step number
                0035 C  myTime               :: model time
                0036 C  myThid               :: thread number
e07d0b88b1 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
785a077159 Alis*0041       _RL myTime
e07d0b88b1 Jean*0042       INTEGER myIter
785a077159 Alis*0043       INTEGER myThid
                0044
                0045 C !OUTPUT PARAMETERS: ==================================================
b689e79849 Jean*0046 C  gPtracer       :: updates tendency array
785a077159 Alis*0047
                0048 #ifdef ALLOW_PTRACERS
                0049
                0050 C !LOCAL VARIABLES: ====================================================
b689e79849 Jean*0051 C  i,j            :: loop indices
785a077159 Alis*0052       INTEGER i,j
c61ca13fc6 Dimi*0053 C     number of surface interface layer
                0054       INTEGER kSurface
785a077159 Alis*0055 CEOP
                0056
ee1ffce07f Jean*0057       IF ( fluidIsAir ) THEN
                0058        kSurface = 0
                0059       ELSEIF ( usingZCoords .AND. useShelfIce ) THEN
                0060        kSurface = -1
                0061       ELSEIF ( usingPCoords ) THEN
c61ca13fc6 Dimi*0062        kSurface = Nr
4f329e5bbf Davi*0063       ELSE
c61ca13fc6 Dimi*0064        kSurface = 1
4f329e5bbf Davi*0065       ENDIF
785a077159 Alis*0066
e07d0b88b1 Jean*0067 C--   Surface forcing term surfForcPtr is previously computed by
c643a48b7e Jean*0068 C     PTRACERS_FORCING_SURF (and stored as surfaceForcingPTr)
4f329e5bbf Davi*0069 C     because it is needed by KPP_TRANSPORT_PTR.
0dcd950fdd Patr*0070
29fd21a3ae Jean*0071 #ifdef ALLOW_GCHEM
e07d0b88b1 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
b0bb8bffec Davi*0078 #endif /* ALLOW_GCHEM */
                0079
                0080       IF ( k .EQ. kSurface ) THEN
ee1ffce07f 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
e07d0b88b1 Jean*0085           gPtracer(i,j) = gPtracer(i,j)
                0086      &                  + surfForcPtr(i,j)
                0087      &                   *recip_drF(k)*recip_hFacC(i,j,k,bi,bj)
785a077159 Alis*0088         ENDDO
ee1ffce07f 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
b0bb8bffec Davi*0100       ENDIF
785a077159 Alis*0101
0aacb0e819 Oliv*0102       IF (PTRACERS_linFSConserve(iTracer)) THEN
ee1ffce07f Jean*0103        DO j=0,sNy+1
                0104         DO i=0,sNx+1
                0105          IF ( kSurfC(i,j,bi,bj).EQ.k ) THEN
ab62c4c1c3 Mart*0106             gPtracer(i,j) = gPtracer(i,j)
0aacb0e819 Oliv*0107      &           +meanSurfCorPTr(iTracer)*recip_drF(k)
ab62c4c1c3 Mart*0108      &           *_recip_hFacC(i,j,k,bi,bj)
ee1ffce07f Jean*0109          ENDIF
                0110         ENDDO
                0111        ENDDO
ab62c4c1c3 Mart*0112       ENDIF
                0113
4a65a094e0 Step*0114 #ifdef ALLOW_RBCS
75e7d3137d Jean*0115       IF ( useRBCS ) THEN
e07d0b88b1 Jean*0116          CALL RBCS_ADD_TENDENCY(
                0117      U                 gPtracer,
                0118      I                 k, bi, bj, iTracer+2,
                0119      I                 myTime, myIter, myThid )
c643a48b7e Jean*0120       ENDIF
                0121 #endif /* ALLOW_RBCS */
4a65a094e0 Step*0122
785a077159 Alis*0123 #endif /* ALLOW_PTRACERS */
                0124
                0125       RETURN
                0126       END