pkg/kpp/kpp_calc_diff_ptr.F

4e66ab0b67 Oliv*0001 #include "KPP_OPTIONS.h"
                0002
                0003       SUBROUTINE KPP_CALC_DIFF_PTR(
                0004      I        bi,bj,iMin,iMax,jMin,jMax,kArg,kSize,
                0005      O        KappaRx,
aa553ae896 Jean*0006      I        iTr, myThid )
4e66ab0b67 Oliv*0007
aa553ae896 Jean*0008 C     *==========================================================*
                0009 C     | SUBROUTINE KPP_CALC_DIFF_PTR
                0010 C     | o Return contribution to net diffusivity from KPP mixing
                0011 C     *==========================================================*
4e66ab0b67 Oliv*0012       IMPLICIT NONE
                0013
                0014 C     == GLobal variables ==
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
aa553ae896 Jean*0018 c#include "DYNVARS.h"
                0019 c#include "GRID.h"
                0020 #include "KPP.h"
                0021 #ifdef ALLOW_PTRACERS
                0022 #include "PTRACERS_SIZE.h"
                0023 #include "PTRACERS_PARAMS.h"
                0024 #endif
4e66ab0b67 Oliv*0025 #ifdef ALLOW_LONGSTEP
                0026 #include "LONGSTEP.h"
                0027 #endif
                0028
                0029 C     == Routine arguments ==
                0030 C     bi, bj,   :: tile indices
                0031 C     iMin,iMax :: Range of points for which calculation is done
                0032 C     jMin,jMax :: Range of points for which calculation is done
                0033 C     kArg      :: = 0 -> do the k-loop here and treat all levels
                0034 C                  > 0 -> k-loop is done outside and treat only level k=kArg
                0035 C     kSize     :: 3rd Dimension of the vertical diffusivity array KappaRS
                0036 C     KappaRx   :: vertical diffusivity array
aa553ae896 Jean*0037 C     iTr       :: tracer index
4e66ab0b67 Oliv*0038 C     myThid    :: Instance number for this innvocation of KPP_CALC_DIFF_S
                0039 C
                0040       INTEGER bi,bj,iMin,iMax,jMin,jMax,kArg,kSize
                0041       _RL KappaRx(1-Olx:sNx+Olx,1-Oly:sNy+Oly,kSize)
aa553ae896 Jean*0042       INTEGER iTr
4e66ab0b67 Oliv*0043       INTEGER myThid
                0044
aa553ae896 Jean*0045 #ifdef ALLOW_PTRACERS
4e66ab0b67 Oliv*0046
                0047 C     == Local variables ==
                0048 C     i,j,k     :: Loop counters
                0049       INTEGER i,j,k
                0050
                0051 C--   Set vertical diffusivity contribution from KPP
                0052       IF ( kArg .EQ. 0 ) THEN
                0053 C-    do all levels :
                0054        DO k=1,MIN(Nr,kSize)
                0055         DO j=jMin,jMax
                0056          DO i=iMin,iMax
                0057 #ifdef ALLOW_LONGSTEP
                0058           KappaRx(i,j,k) = LS_KPPdiffKzS(i,j,k,bi,bj)
                0059 #else
                0060           KappaRx(i,j,k) = KPPdiffKzS(i,j,k,bi,bj)
                0061 #endif
aa553ae896 Jean*0062 #ifndef ALLOW_3D_DIFFKR
                0063           KappaRx(i,j,k) = KappaRx(i,j,k)
                0064      &          - diffKrNrS(k) + PTRACERS_diffKrNr(k,iTr)
                0065 #endif
4e66ab0b67 Oliv*0066          ENDDO
                0067         ENDDO
                0068        ENDDO
                0069       ELSE
                0070 C-    do level k=kArg only :
                0071        k = MIN(kArg,kSize)
                0072        DO j=jMin,jMax
                0073         DO i=iMin,iMax
                0074 #ifdef ALLOW_LONGSTEP
                0075          KappaRx(i,j,k) = LS_KPPdiffKzS(i,j,kArg,bi,bj)
                0076 #else
                0077          KappaRx(i,j,k) = KPPdiffKzS(i,j,kArg,bi,bj)
                0078 #endif
aa553ae896 Jean*0079 #ifndef ALLOW_3D_DIFFKR
                0080          KappaRx(i,j,k) = KappaRx(i,j,k)
                0081      &          - diffKrNrS(kArg) + PTRACERS_diffKrNr(kArg,iTr)
                0082 #endif
4e66ab0b67 Oliv*0083         ENDDO
                0084        ENDDO
                0085       ENDIF
                0086
aa553ae896 Jean*0087 #endif /* ALLOW_PTRACERS */
4e66ab0b67 Oliv*0088
                0089       RETURN
                0090       END