/[MITgcm]/MITgcm/pkg/gmredi/gmredi_calc_tensor.F
ViewVC logotype

Diff of /MITgcm/pkg/gmredi/gmredi_calc_tensor.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.36 by jmc, Wed Jan 20 01:20:29 2010 UTC revision 1.39 by jmc, Thu Feb 10 21:24:19 2011 UTC
# Line 71  C     == Local variables == Line 71  C     == Local variables ==
71        _RL dSigmaDr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
72        _RL SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
73        _RL taperFct(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL taperFct(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
       _RL Kgm_tmp  
74        _RL ldd97_LrhoC(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL ldd97_LrhoC(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
75        _RL ldd97_LrhoW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL ldd97_LrhoW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
76        _RL ldd97_LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL ldd97_LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
77        _RL Cspd, LrhoInf, LrhoSup, fCoriLoc        _RL Cspd, LrhoInf, LrhoSup, fCoriLoc
78          _RL Kgm_tmp, isopycK, bolus_K
79    
80        INTEGER kLow_W (1-Olx:sNx+Olx,1-Oly:sNy+Oly)        INTEGER kLow_W (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
81        INTEGER kLow_S (1-Olx:sNx+Olx,1-Oly:sNy+Oly)        INTEGER kLow_S (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
# Line 83  C     == Local variables == Line 83  C     == Local variables ==
83        _RL baseSlope  (1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL baseSlope  (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
84        _RL hTransLay  (1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL hTransLay  (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
85        _RL recipLambda(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL recipLambda(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
86          INTEGER  km1
87  #if ( defined (GM_NON_UNITY_DIAGONAL) || defined (GM_EXTRA_DIAGONAL) )  #if ( defined (GM_NON_UNITY_DIAGONAL) || defined (GM_EXTRA_DIAGONAL) )
88        INTEGER kp1        INTEGER kp1
89        _RL maskp1        _RL maskp1
# Line 105  C     == Local variables == Line 106  C     == Local variables ==
106        LOGICAL  DIAGNOSTICS_IS_ON        LOGICAL  DIAGNOSTICS_IS_ON
107        EXTERNAL DIAGNOSTICS_IS_ON        EXTERNAL DIAGNOSTICS_IS_ON
108  #if ( defined (GM_NON_UNITY_DIAGONAL) || defined (GM_EXTRA_DIAGONAL) )  #if ( defined (GM_NON_UNITY_DIAGONAL) || defined (GM_EXTRA_DIAGONAL) )
       INTEGER  km1  
109        _RL dTdz        _RL dTdz
110        _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
111  #endif  #endif
# Line 480  C-    express the Tensor in term of Diff Line 480  C-    express the Tensor in term of Diff
480  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
481         kkey = (igmkey-1)*Nr + k         kkey = (igmkey-1)*Nr + k
482  # if (defined (GM_NON_UNITY_DIAGONAL) || \  # if (defined (GM_NON_UNITY_DIAGONAL) || \
483       defined (GM_VISBECK_VARIABLE_K))        defined (GM_VISBECK_VARIABLE_K))
484  CADJ STORE Kwx(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE Kwx(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
485  CADJ STORE Kwy(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE Kwy(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
486  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
487  # endif  # endif
488  #endif  #endif
489           km1 = MAX(k-1,1)
490           isopycK = GM_isopycK
491         &         *(GM_isoFac1d(km1)+GM_isoFac1d(k))*op5
492           bolus_K = GM_background_K
493         &         *(GM_bolFac1d(km1)+GM_bolFac1d(k))*op5
494         DO j=1-Oly+1,sNy+Oly-1         DO j=1-Oly+1,sNy+Oly-1
495          DO i=1-Olx+1,sNx+Olx-1          DO i=1-Olx+1,sNx+Olx-1
496  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
497           Kgm_tmp = kapredi(i,j,k,bi,bj)           Kgm_tmp = kapredi(i,j,k,bi,bj)
498  #else  #else
499           Kgm_tmp = GM_isopycK           Kgm_tmp = isopycK*GM_isoFac2d(i,j,bi,bj)
500  #endif  #endif
501  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
502       &           + GM_skewflx*kapgm(i,j,k,bi,bj)       &           + GM_skewflx*kapgm(i,j,k,bi,bj)
503  #else  #else
504       &           + GM_skewflx*GM_background_K       &           + GM_skewflx*bolus_K*GM_bolFac2d(i,j,bi,bj)
505  #endif  #endif
506  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
507       &           + VisbeckK(i,j,bi,bj)*(1. _d 0 + GM_skewflx)       &           + VisbeckK(i,j,bi,bj)*(1. _d 0 + GM_skewflx)
# Line 506  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bi Line 511  CADJ STORE Kwz(:,:,k,bi,bj) = comlev1_bi
511  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
512           Kwz(i,j,k,bi,bj)= ( kapredi(i,j,k,bi,bj)           Kwz(i,j,k,bi,bj)= ( kapredi(i,j,k,bi,bj)
513  #else  #else
514           Kwz(i,j,k,bi,bj)= ( GM_isopycK           Kwz(i,j,k,bi,bj)= ( isopycK*GM_isoFac2d(i,j,bi,bj)
515  #endif  #endif
516  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
517       &                     + VisbeckK(i,j,bi,bj)       &                     + VisbeckK(i,j,bi,bj)
# Line 616  c      IF ( GM_nonUnitDiag ) THEN Line 621  c      IF ( GM_nonUnitDiag ) THEN
621  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
622       &     ( kapredi(i,j,k,bi,bj)       &     ( kapredi(i,j,k,bi,bj)
623  #else  #else
624       &     ( GM_isopycK       &     ( GM_isopycK*GM_isoFac1d(k)
625         &        *op5*(GM_isoFac2d(i-1,j,bi,bj)+GM_isoFac2d(i,j,bi,bj))
626  #endif  #endif
627  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
628       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))
# Line 650  CADJ STORE taperFct(:,:)     = comlev1_b Line 656  CADJ STORE taperFct(:,:)     = comlev1_b
656  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
657       &     ( kapredi(i,j,k,bi,bj)       &     ( kapredi(i,j,k,bi,bj)
658  #else  #else
659       &     ( GM_isopycK       &     ( GM_isopycK*GM_isoFac1d(k)
660         &        *op5*(GM_isoFac2d(i-1,j,bi,bj)+GM_isoFac2d(i,j,bi,bj))
661  #endif  #endif
662  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
663       &     - GM_skewflx*kapgm(i,j,k,bi,bj)       &     - GM_skewflx*kapgm(i,j,k,bi,bj)
664  #else  #else
665       &     - GM_skewflx*GM_background_K       &     - GM_skewflx*GM_background_K*GM_bolFac1d(k)
666         &        *op5*(GM_bolFac2d(i-1,j,bi,bj)+GM_bolFac2d(i,j,bi,bj))
667  #endif  #endif
668  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
669       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))*GM_advect       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))*GM_advect
# Line 675  C         store in tmp1k Kuz_Redi Line 683  C         store in tmp1k Kuz_Redi
683  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
684            tmp1k(i,j) = ( kapredi(i,j,k,bi,bj)            tmp1k(i,j) = ( kapredi(i,j,k,bi,bj)
685  #else  #else
686            tmp1k(i,j) = ( GM_isopycK            tmp1k(i,j) = ( GM_isopycK*GM_isoFac1d(k)
687         &        *op5*(GM_isoFac2d(i-1,j,bi,bj)+GM_isoFac2d(i,j,bi,bj))
688  #endif  #endif
689  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
690       &     +(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))*0.5 _d 0       &     +(VisbeckK(i,j,bi,bj)+VisbeckK(i-1,j,bi,bj))*0.5 _d 0
# Line 804  c      IF ( GM_nonUnitDiag ) THEN Line 813  c      IF ( GM_nonUnitDiag ) THEN
813  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
814       &     ( kapredi(i,j,k,bi,bj)       &     ( kapredi(i,j,k,bi,bj)
815  #else  #else
816       &     ( GM_isopycK       &     ( GM_isopycK*GM_isoFac1d(k)
817         &        *op5*(GM_isoFac2d(i,j-1,bi,bj)+GM_isoFac2d(i,j,bi,bj))
818  #endif  #endif
819  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
820       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))
# Line 838  CADJ STORE taperFct(:,:)     = comlev1_b Line 848  CADJ STORE taperFct(:,:)     = comlev1_b
848  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
849       &     ( kapredi(i,j,k,bi,bj)       &     ( kapredi(i,j,k,bi,bj)
850  #else  #else
851       &     ( GM_isopycK       &     ( GM_isopycK*GM_isoFac1d(k)
852         &        *op5*(GM_isoFac2d(i,j-1,bi,bj)+GM_isoFac2d(i,j,bi,bj))
853  #endif  #endif
854  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
855       &     - GM_skewflx*kapgm(i,j,k,bi,bj)       &     - GM_skewflx*kapgm(i,j,k,bi,bj)
856  #else  #else
857       &     - GM_skewflx*GM_background_K       &     - GM_skewflx*GM_background_K*GM_bolFac1d(k)
858         &        *op5*(GM_bolFac2d(i,j-1,bi,bj)+GM_bolFac2d(i,j,bi,bj))
859  #endif  #endif
860  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
861       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))*GM_advect       &     +op5*(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))*GM_advect
# Line 863  C         store in tmp1k Kvz_Redi Line 875  C         store in tmp1k Kvz_Redi
875  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
876            tmp1k(i,j) = ( kapredi(i,j,k,bi,bj)            tmp1k(i,j) = ( kapredi(i,j,k,bi,bj)
877  #else  #else
878            tmp1k(i,j) = ( GM_isopycK            tmp1k(i,j) = ( GM_isopycK*GM_isoFac1d(k)
879         &        *op5*(GM_isoFac2d(i,j-1,bi,bj)+GM_isoFac2d(i,j,bi,bj))
880  #endif  #endif
881  #ifdef GM_VISBECK_VARIABLE_K  #ifdef GM_VISBECK_VARIABLE_K
882       &     +(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))*0.5 _d 0       &     +(VisbeckK(i,j,bi,bj)+VisbeckK(i,j-1,bi,bj))*0.5 _d 0
# Line 904  C-- end 3rd  loop on vertical level inde Line 917  C-- end 3rd  loop on vertical level inde
917    
918  #ifdef GM_BOLUS_ADVEC  #ifdef GM_BOLUS_ADVEC
919        IF (GM_AdvForm) THEN        IF (GM_AdvForm) THEN
920         CALL GMREDI_CALC_PSI_B(  #ifdef GM_BOLUS_BVP
921           IF (GM_UseBVP) THEN
922            CALL GMREDI_CALC_PSI_BVP(
923       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
924       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
      I             ldd97_LrhoW, ldd97_LrhoS,  
925       I             myThid )       I             myThid )
926           ELSE
927    #endif
928            CALL GMREDI_CALC_PSI_B(
929         I              bi, bj, iMin, iMax, jMin, jMax,
930         I              sigmaX, sigmaY, sigmaR,
931         I              ldd97_LrhoW, ldd97_LrhoS,
932         I              myThid )
933    #ifdef GM_BOLUS_BVP
934           ENDIF
935    #endif
936        ENDIF        ENDIF
937  #endif  #endif
938    
# Line 954  C--   Time-average Line 978  C--   Time-average
978    
979  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
980    
981    CBOP
982    C     !ROUTINE: GMREDI_CALC_TENSOR_DUMMY
983    C     !INTERFACE:
984        SUBROUTINE GMREDI_CALC_TENSOR_DUMMY(        SUBROUTINE GMREDI_CALC_TENSOR_DUMMY(
985       I             iMin, iMax, jMin, jMax,       I             iMin, iMax, jMin, jMax,
986       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
987       I             bi, bj, myTime, myIter, myThid )       I             bi, bj, myTime, myIter, myThid )
988  C     /==========================================================\  
989  C     | SUBROUTINE GMREDI_CALC_TENSOR                            |  C     !DESCRIPTION: \bv
990  C     | o Calculate tensor elements for GM/Redi tensor.          |  C     *==========================================================*
991  C     |==========================================================|  C     | SUBROUTINE GMREDI_CALC_TENSOR_DUMMY
992  C     \==========================================================/  C     | o Calculate tensor elements for GM/Redi tensor.
993    C     *==========================================================*
994    C     \ev
995    
996    C     !USES:
997        IMPLICIT NONE        IMPLICIT NONE
998    
999  C     == Global variables ==  C     == Global variables ==
# Line 970  C     == Global variables == Line 1001  C     == Global variables ==
1001  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1002  #include "GMREDI.h"  #include "GMREDI.h"
1003    
1004  C     == Routine arguments ==  C     !INPUT/OUTPUT PARAMETERS:
 C  
1005        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
1006        _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaY(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
1007        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL sigmaR(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
# Line 980  C Line 1010  C
1010        _RL     myTime        _RL     myTime
1011        INTEGER myIter        INTEGER myIter
1012        INTEGER myThid        INTEGER myThid
1013  CEndOfInterface  CEOP
1014    
1015  #ifdef ALLOW_GMREDI  #ifdef ALLOW_GMREDI
1016    C     !LOCAL VARIABLES:
1017        INTEGER i, j, k        INTEGER i, j, k
1018    
1019        DO k=1,Nr        DO k=1,Nr
Legend:
Removed from v.1.36  
changed lines
  Added in v.1.39
  ViewVC Help
Powered by ViewVC 1.1.22