/[MITgcm]/MITgcm/pkg/kpp/kpp_routines.F
ViewVC logotype

Diff of /MITgcm/pkg/kpp/kpp_routines.F

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

revision 1.5 by heimbach, Mon Jan 29 20:09:23 2001 UTC revision 1.12 by mlosch, Wed Sep 25 19:36:50 2002 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "KPP_OPTIONS.h"  #include "KPP_OPTIONS.h"
5    
# Line 384  c Line 385  c
385    
386           end do           end do
387        end do        end do
388          
389    cph(
390    cph  without this store, there's a recomputation error for
391    cph  rib in adbldepth (probably partial recomputation problem)    
392    CADJ store Rib = comlev1_kpp
393    CADJ &   , key = ikey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy),Nr /)
394    cph)
395    
396        do kl = 2, Nr        do kl = 2, Nr
397           do i = 1, imt           do i = 1, imt
398              if (kbl(i).eq.kmtj(i) .and. Rib(i,kl).gt.Ricr) kbl(i) = kl              if (kbl(i).eq.kmtj(i) .and. Rib(i,kl).gt.Ricr) kbl(i) = kl
# Line 431  c--   ensure bfsfc is never 0 Line 439  c--   ensure bfsfc is never 0
439           bfsfc(i) = sign(eins,bfsfc(i))*max(phepsi,abs(bfsfc(i)))           bfsfc(i) = sign(eins,bfsfc(i))*max(phepsi,abs(bfsfc(i)))
440        end do        end do
441    
442  CADJ store bfsfc = comlev1_kpp  cph(
443    cph  added stable to store list to avoid extensive recomp.
444    CADJ store bfsfc, stable = comlev1_kpp
445  CADJ &   , key = ikey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
446    cph)
447    
448  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
449  c check hbl limits for hekman or hmonob  c check hbl limits for hekman or hmonob
# Line 673  C     break data flow dependence on diff Line 684  C     break data flow dependence on diff
684    
685        do ki = 1, Nr        do ki = 1, Nr
686           do i = 1, imt           do i = 1, imt
687              if     (kmtj(i) .EQ. 0      ) then              if     (kmtj(i) .LE. 1      ) then
688                 diffus(i,ki,1) = 0.                 diffus(i,ki,1) = 0.
689                 diffus(i,ki,2) = 0.                 diffus(i,ki,2) = 0.
690              elseif (ki      .GE. kmtj(i)) then              elseif (ki      .GE. kmtj(i)) then
# Line 1297  c--------------------------------------- Line 1308  c---------------------------------------
1308  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1309  #include "PARAMS.h"  #include "PARAMS.h"
1310  #include "KPP_PARAMS.h"  #include "KPP_PARAMS.h"
1311    #include "DYNVARS.h"
1312    
1313  c-------------- Routine arguments -----------------------------------------  c-------------- Routine arguments -----------------------------------------
1314        INTEGER bi, bj, myThid        INTEGER bi, bj, myThid
# Line 1328  c     work1, work2 - work arrays for hol Line 1340  c     work1, work2 - work arrays for hol
1340  c calculate density, alpha, beta in surface layer, and set dbsfc to zero  c calculate density, alpha, beta in surface layer, and set dbsfc to zero
1341    
1342        call FIND_RHO(        call FIND_RHO(
1343       I     bi, bj, ibot, itop, jbot, jtop, 1, 1, eosType,       I     bi, bj, ibot, itop, jbot, jtop, 1, 1,
1344         I     theta, salt,
1345       O     WORK1,       O     WORK1,
1346       I     myThid )       I     myThid )
1347    
1348        call FIND_ALPHA(        call FIND_ALPHA(
1349       I     bi, bj, ibot, itop, jbot, jtop, 1, 1, eosType,       I     bi, bj, ibot, itop, jbot, jtop, 1, 1,
1350       O     WORK2 )       O     WORK2 )
1351    
1352        call FIND_BETA(        call FIND_BETA(
1353       I     bi, bj, ibot, itop, jbot, jtop, 1, 1, eosType,       I     bi, bj, ibot, itop, jbot, jtop, 1, 1,
1354       O     WORK3 )       O     WORK3 )
1355    
1356        DO J = jbot, jtop        DO J = jbot, jtop
1357           DO I = ibot, itop           DO I = ibot, itop
1358              RHO1(I,J)      = WORK1(I,J) + rhonil              RHO1(I,J)      = WORK1(I,J) + rhoConst
1359              TTALPHA(I,J,1) = WORK2(I,J)              TTALPHA(I,J,1) = WORK2(I,J)
1360              SSBETA(I,J,1)  = WORK3(I,J)              SSBETA(I,J,1)  = WORK3(I,J)
1361              DBSFC(I,J,1)   = 0.              DBSFC(I,J,1)   = 0.
# Line 1355  CHPF$  INDEPENDENT, NEW (RHOK,RHOKM1,RHO Line 1368  CHPF$  INDEPENDENT, NEW (RHOK,RHOKM1,RHO
1368        DO K = 2, Nr        DO K = 2, Nr
1369    
1370           call FIND_RHO(           call FIND_RHO(
1371       I        bi, bj, ibot, itop, jbot, jtop, K, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, K, K,
1372         I        theta, salt,
1373       O        RHOK,       O        RHOK,
1374       I        myThid )       I        myThid )
1375    
1376           call FIND_RHO(           call FIND_RHO(
1377       I        bi, bj, ibot, itop, jbot, jtop, K-1, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, K-1, K,
1378         I        theta, salt,
1379       O        RHOKM1,       O        RHOKM1,
1380       I        myThid )       I        myThid )
1381    
1382           call FIND_RHO(           call FIND_RHO(
1383       I        bi, bj, ibot, itop, jbot, jtop, 1, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, 1, K,
1384         I        theta, salt,
1385       O        RHO1K,       O        RHO1K,
1386       I        myThid )       I        myThid )
1387    
1388           call FIND_ALPHA(           call FIND_ALPHA(
1389       I        bi, bj, ibot, itop, jbot, jtop, K, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, K, K,
1390       O        WORK1 )       O        WORK1 )
1391    
1392           call FIND_BETA(           call FIND_BETA(
1393       I        bi, bj, ibot, itop, jbot, jtop, K, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, K, K,
1394       O        WORK2 )       O        WORK2 )
1395    
1396           DO J = jbot, jtop           DO J = jbot, jtop
# Line 1382  CHPF$  INDEPENDENT, NEW (RHOK,RHOKM1,RHO Line 1398  CHPF$  INDEPENDENT, NEW (RHOK,RHOKM1,RHO
1398                 TTALPHA(I,J,K) = WORK1 (I,J)                 TTALPHA(I,J,K) = WORK1 (I,J)
1399                 SSBETA(I,J,K)  = WORK2 (I,J)                 SSBETA(I,J,K)  = WORK2 (I,J)
1400                 DBLOC(I,J,K-1) = gravity * (RHOK(I,J) - RHOKM1(I,J)) /                 DBLOC(I,J,K-1) = gravity * (RHOK(I,J) - RHOKM1(I,J)) /
1401       &                                    (RHOK(I,J) + rhonil)       &                                    (RHOK(I,J) + rhoConst)
1402                 DBSFC(I,J,K)   = gravity * (RHOK(I,J) - RHO1K (I,J)) /                 DBSFC(I,J,K)   = gravity * (RHOK(I,J) - RHO1K (I,J)) /
1403       &                                    (RHOK(I,J) + rhonil)       &                                    (RHOK(I,J) + rhoConst)
1404              END DO              END DO
1405           END DO           END DO
1406    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22