pkg/salt_plume/salt_plume_tendency_apply_s.F

e4775240e5 Dimi*0001 #include "SALT_PLUME_OPTIONS.h"
                0002
                0003 CBOP 0
762bde3a3e Dimi*0004 C     !ROUTINE: SALT_PLUME_TENDENCY_APPLY_S
                0005 C     !INTERFACE:
e4775240e5 Dimi*0006       SUBROUTINE SALT_PLUME_TENDENCY_APPLY_S(
73b1dccda0 Jean*0007      U                      gS_arr,
                0008      I                      iMin,iMax,jMin,jMax, k, bi, bj,
                0009      I                      myTime, myIter, myThid )
e4775240e5 Dimi*0010
                0011 C     !DESCRIPTION:
                0012 C     Add salt_plume tendency terms to S tendency.
                0013 C     Routine works for one level at a time.
                0014 C     SaltPlume is the amount of salt rejected by ice while freezing;
                0015 C     it is here redistributed to multiple vertical levels as per
                0016 C     Duffy et al. (GRL 1999).
                0017
73b1dccda0 Jean*0018 C     !USES:
e4775240e5 Dimi*0019       IMPLICIT NONE
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
73b1dccda0 Jean*0023 #include "GRID.h"
                0024 c#include "DYNVARS.h"
e4775240e5 Dimi*0025 #include "SALT_PLUME.h"
                0026
73b1dccda0 Jean*0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     gS_arr    :: the tendency array
                0029 C     iMin,iMax :: Working range of x-index for applying forcing.
                0030 C     jMin,jMax :: Working range of y-index for applying forcing.
                0031 C     k         :: Current vertical level index
                0032 C     bi,bj     :: Current tile indices
                0033 C     myTime    :: Current time in simulation
                0034 C     myIter    :: Current iteration number
                0035 C     myThid    :: my Thread Id number
                0036       _RL     gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0037       INTEGER iMin, iMax, jMin, jMax
                0038       INTEGER k, bi, bj
                0039       _RL     myTime
                0040       INTEGER myIter
                0041       INTEGER myThid
e4775240e5 Dimi*0042 CEOP
                0043
762bde3a3e Dimi*0044 #ifdef ALLOW_SALT_PLUME
1f89baba18 Patr*0045 C#ifndef SALT_PLUME_VOLUME
762bde3a3e Dimi*0046
e4775240e5 Dimi*0047 C     !LOCAL VARIABLES:
73b1dccda0 Jean*0048       INTEGER i, j
2dc2789309 Mart*0049       _RL minusone
b5aa60a554 Dimi*0050       parameter(minusone = -1.)
2dc2789309 Mart*0051       _RL plumefrac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
2c01608d7b Gael*0052       _RL plumetend(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
2dc2789309 Mart*0053 #ifdef TARGET_NEC_SX
                0054       integer imt
                0055       parameter( imt=(sNx+2*OLx)*(sNy+2*OLy) )
                0056       _RL plumekb2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0057 #else
                0058       integer two2
                0059       parameter(two2 = 2)
                0060       _RL plumekb(two2), SPdepth(two2)
1f89baba18 Patr*0061 #ifdef SALT_PLUME_SPLIT_BASIN
                0062       _RL lon(two2), lat(two2)
                0063 #endif /* SALT_PLUME_SPLIT_BASIN */
2dc2789309 Mart*0064 #endif
e4775240e5 Dimi*0065
2dc2789309 Mart*0066 #ifdef TARGET_NEC_SX
                0067 C     The vector version computes plumekb2D at each grid point, but this
                0068 C     is still faster than non-vector code.
73b1dccda0 Jean*0069       IF ( k .LT. Nr ) THEN
1f89baba18 Patr*0070 #ifndef SALT_PLUME_VOLUME
73b1dccda0 Jean*0071        DO j=1-OLy,sNy+OLy
                0072         DO i=1-OLx,sNx+OLx
                0073          plumekb2D(i,j)=ABS(rF(k))
2dc2789309 Mart*0074         ENDDO
                0075        ENDDO
                0076        CALL SALT_PLUME_FRAC(
73b1dccda0 Jean*0077      I      imt,minusone,SaltPlumeDepth(1-OLx,1-OLy,bi,bj),
1f89baba18 Patr*0078 #ifdef SALT_PLUME_SPLIT_BASIN
73b1dccda0 Jean*0079      I      XC(1-OLx,1-OLy,bi,bj),YC(1-OLx,1-OLy,bi,bj),
1f89baba18 Patr*0080 #endif /* SALT_PLUME_SPLIT_BASIN */
2dc2789309 Mart*0081      U      plumekb2D,
                0082      I      myTime, 1, myThid )
73b1dccda0 Jean*0083        DO j=1-OLy,sNy+OLy
                0084         DO i=1-OLx,sNx+OLx
364f5b7e62 An T*0085          plumefrac(I,J) = plumekb2D(i,j)
73b1dccda0 Jean*0086          plumekb2D(i,j) = ABS(rF(k+1))
2dc2789309 Mart*0087         ENDDO
                0088        ENDDO
                0089        CALL SALT_PLUME_FRAC(
73b1dccda0 Jean*0090      I      imt,minusone,SaltPlumeDepth(1-OLx,1-OLy,bi,bj),
1f89baba18 Patr*0091 #ifdef SALT_PLUME_SPLIT_BASIN
73b1dccda0 Jean*0092      I      XC(1-OLx,1-OLy,bi,bj),YC(1-OLx,1-OLy,bi,bj),
1f89baba18 Patr*0093 #endif /* SALT_PLUME_SPLIT_BASIN */
2dc2789309 Mart*0094      U      plumekb2D,
                0095      I      myTime, 1, myThid )
1f89baba18 Patr*0096 #endif /* SALT_PLUME_VOLUME */
73b1dccda0 Jean*0097        DO j=1-OLy,sNy+OLy
                0098         DO i=1-OLx,sNx+OLx
                0099 C     Penetrating saltplume fraction:cumSP(k+1)-cumSP(k)
                0100          IF ( SaltPlumeDepth(i,j,bi,bj) .GT. ABS(rF(k)) ) THEN
1f89baba18 Patr*0101 #ifndef SALT_PLUME_VOLUME
364f5b7e62 An T*0102           plumefrac(i,j) = ( plumekb2D(i,j)-plumefrac(i,j) )
73b1dccda0 Jean*0103      &                     *maskC(i,j,k,bi,bj)
2c01608d7b Gael*0104           plumetend(I,J) = saltPlumeFlux(i,j,bi,bj)*plumefrac(I,J)
1f89baba18 Patr*0105 #else /* SALT_PLUME_VOLUME */
73b1dccda0 Jean*0106           plumetend(I,J) = SPforcingS(i,j,k,bi,bj)
1f89baba18 Patr*0107 #endif /* SALT_PLUME_VOLUME */
73b1dccda0 Jean*0108           gS_arr(i,j) = gS_arr(i,j) + plumetend(I,J)
                0109      &        *recip_drF(k)*mass2rUnit*_recip_hFacC(i,j,k,bi,bj)
2dc2789309 Mart*0110          ELSE
364f5b7e62 An T*0111           plumefrac(i,j) = 0. _d 0
2c01608d7b Gael*0112           plumetend(I,J) = 0. _d 0
2dc2789309 Mart*0113          ENDIF
                0114         ENDDO
                0115        ENDDO
                0116       ENDIF
                0117 #else
                0118       DO j=jMin,jMax
                0119        DO i=iMin,iMax
73b1dccda0 Jean*0120 C Penetrating saltplume fraction:cumulativeSP(k+1)-cumulativeSP(k)
                0121         IF ( SaltPlumeDepth(i,j,bi,bj) .GT. ABS(rF(k)) ) THEN
2dc2789309 Mart*0122          plumefrac(I,J) = 0. _d 0
1f89baba18 Patr*0123 #ifndef SALT_PLUME_VOLUME
73b1dccda0 Jean*0124          plumekb(1)=ABS(rF(k))
                0125          plumekb(2)=ABS(rF(k+1))
2dc2789309 Mart*0126          SPdepth(1)=SaltPlumeDepth(i,j,bi,bj)
                0127          SPdepth(2)=SaltPlumeDepth(i,j,bi,bj)
1f89baba18 Patr*0128 #ifdef SALT_PLUME_SPLIT_BASIN
                0129          lon(1) = XC(i,j,bi,bj)
                0130          lon(2) = XC(i,j,bi,bj)
                0131          lat(1) = YC(i,j,bi,bj)
                0132          lat(2) = YC(i,j,bi,bj)
                0133 #endif /* SALT_PLUME_SPLIT_BASIN */
2dc2789309 Mart*0134          CALL SALT_PLUME_FRAC(
e4775240e5 Dimi*0135      I                   two2,minusone,SPdepth,
1f89baba18 Patr*0136 #ifdef SALT_PLUME_SPLIT_BASIN
                0137      I                   lon,lat,
                0138 #endif /* SALT_PLUME_SPLIT_BASIN */
e4775240e5 Dimi*0139      U                   plumekb,
                0140      I                   myTime, 1, myThid )
73b1dccda0 Jean*0141          plumefrac(I,J) = (plumekb(2)-plumekb(1))*maskC(i,j,k,bi,bj)
2c01608d7b Gael*0142          plumetend(I,J) = saltPlumeFlux(i,j,bi,bj)*plumefrac(I,J)
1f89baba18 Patr*0143 #else /* SALT_PLUME_VOLUME */
73b1dccda0 Jean*0144          plumetend(i,j) = SPforcingS(i,j,k,bi,bj)
1f89baba18 Patr*0145 #endif /* SALT_PLUME_VOLUME */
73b1dccda0 Jean*0146          gS_arr(i,j) = gS_arr(i,j) + plumetend(I,J)
                0147      &        *recip_drF(k)*mass2rUnit*_recip_hFacC(i,j,k,bi,bj)
2c01608d7b Gael*0148         ELSE
                0149          plumefrac(I,J) = 0. _d 0
                0150          plumetend(I,J) = 0. _d 0
2dc2789309 Mart*0151         ENDIF
e4775240e5 Dimi*0152        ENDDO
2dc2789309 Mart*0153       ENDDO
                0154 #endif /* TARGET_NEC_SX */
e4775240e5 Dimi*0155
                0156 #ifdef ALLOW_DIAGNOSTICS
2dc2789309 Mart*0157       IF ( useDiagnostics ) THEN
                0158        CALL DIAGNOSTICS_FILL (
73b1dccda0 Jean*0159      &      plumefrac,'PLUMEKB ',k,1,2,bi,bj,myThid )
2c01608d7b Gael*0160        CALL DIAGNOSTICS_FILL (
73b1dccda0 Jean*0161      &      plumetend,'oceSPtnd',k,1,2,bi,bj,myThid )
2dc2789309 Mart*0162       ENDIF
e4775240e5 Dimi*0163 #endif /* ALLOW_DIAGNOSTICS */
73b1dccda0 Jean*0164
1f89baba18 Patr*0165 C#endif /* SALT_PLUME_VOLUME */
762bde3a3e Dimi*0166 #endif /* ALLOW_SALT_PLUME */
73b1dccda0 Jean*0167
2dc2789309 Mart*0168       RETURN
                0169       END