/[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.7 by cnh, Sun Feb 4 14:38:50 2001 UTC revision 1.15 by heimbach, Fri Mar 7 23:51:02 2003 UTC
# Line 125  c instability. Line 125  c instability.
125  c (ghat is temporary storage for horizontally smoothed dbloc)  c (ghat is temporary storage for horizontally smoothed dbloc)
126  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
127    
128  CADJ STORE ghat = comlev1_kpp, key = ikey  cph(
129    cph these storings avoid recomp. of Ri_iwmix
130    CADJ STORE ghat  = comlev1_kpp, key = ikey
131    CADJ STORE dbloc = comlev1_kpp, key = ikey
132    cph)
133        call Ri_iwmix (        call Ri_iwmix (
134       I       kmtj, shsq, dbloc, ghat       I       kmtj, shsq, dbloc, ghat
135       I     , ikey       I     , ikey
136       O     , diffus )       O     , diffus )
137    
138    cph(
139    cph these storings avoid recomp. of Ri_iwmix
140    cph DESPITE TAFs 'not necessary' warning!
141    CADJ STORE dbloc  = comlev1_kpp, key = ikey
142    CADJ STORE shsq   = comlev1_kpp, key = ikey
143    CADJ STORE ghat   = comlev1_kpp, key = ikey
144    CADJ STORE diffus = comlev1_kpp, key = ikey
145    cph)
146    
147  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
148  c set seafloor values to zero and fill extra "Nrp1" coefficients  c set seafloor values to zero and fill extra "Nrp1" coefficients
149  c for blmix  c for blmix
# Line 169  c--------------------------------------- Line 181  c---------------------------------------
181       I       ustar, bfsfc, hbl, stable, casea, diffus, kbl       I       ustar, bfsfc, hbl, stable, casea, diffus, kbl
182       O     , dkm1, blmc, ghat, sigma, ikey       O     , dkm1, blmc, ghat, sigma, ikey
183       &     )       &     )
184    cph(
185  CADJ STORE dkm1,blmc,ghat = comlev1_kpp, key = ikey  CADJ STORE dkm1,blmc,ghat = comlev1_kpp, key = ikey
186    CADJ STORE hbl, kbl, diffus, casea = comlev1_kpp, key = ikey
187    cph)
188    
189  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
190  c enhance diffusivity at interface kbl - 1  c enhance diffusivity at interface kbl - 1
# Line 181  c--------------------------------------- Line 195  c---------------------------------------
195       U     , ghat       U     , ghat
196       O     , blmc )       O     , blmc )
197    
198    cph(
199    cph avoids recomp. of enhance
200    CADJ STORE blmc = comlev1_kpp, key = ikey
201    cph)
202    
203  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
204  c combine interior and boundary layer coefficients and nonlocal term  c combine interior and boundary layer coefficients and nonlocal term
205    c !!!NOTE!!! In shallow (2-level) regions and for shallow mixed layers
206    c (< 1 level), diffusivity blmc can become negative.  The max's below
207    c are a hack until this problem is properly diagnosed and fixed.
208  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
   
209        do k = 1, Nr        do k = 1, Nr
210           do i = 1, imt           do i = 1, imt
211              if (k .lt. kbl(i)) then              if (k .lt. kbl(i)) then
212                 do md = 1, mdiff                 diffus(i,k,1) = max ( blmc(i,k,1), viscAr  )
213                    diffus(i,k,md) = blmc(i,k,md)                 diffus(i,k,2) = max ( blmc(i,k,2), diffKrS )
214                 end do                 diffus(i,k,3) = max ( blmc(i,k,3), diffKrT )
215              else              else
216                 ghat(i,k) = 0.                 ghat(i,k) = 0.
217              endif              endif
# Line 385  c Line 406  c
406    
407           end do           end do
408        end do        end do
409          
410    cph(
411    cph  without this store, there's a recomputation error for
412    cph  rib in adbldepth (probably partial recomputation problem)    
413    CADJ store Rib = comlev1_kpp
414    CADJ &   , key = ikey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy),Nr /)
415    cph)
416    
417        do kl = 2, Nr        do kl = 2, Nr
418           do i = 1, imt           do i = 1, imt
419              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 432  c--   ensure bfsfc is never 0 Line 460  c--   ensure bfsfc is never 0
460           bfsfc(i) = sign(eins,bfsfc(i))*max(phepsi,abs(bfsfc(i)))           bfsfc(i) = sign(eins,bfsfc(i))*max(phepsi,abs(bfsfc(i)))
461        end do        end do
462    
463  CADJ store bfsfc = comlev1_kpp  cph(
464    cph  added stable to store list to avoid extensive recomp.
465    CADJ store bfsfc, stable = comlev1_kpp
466  CADJ &   , key = ikey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
467    cph)
468    
469  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
470  c check hbl limits for hekman or hmonob  c check hbl limits for hekman or hmonob
# Line 651  c     fRi, fcon             function of Line 682  c     fRi, fcon             function of
682        _KPP_RL Rig        _KPP_RL Rig
683        _KPP_RL fRi, fcon        _KPP_RL fRi, fcon
684        _KPP_RL ratio        _KPP_RL ratio
685        integer i, ki, mr        integer i, ki
686        _KPP_RL c1, c0        _KPP_RL c1, c0
687    
688  #ifdef ALLOW_KPP_VERTICALLY_SMOOTH  #ifdef ALLOW_KPP_VERTICALLY_SMOOTH
689          integer mr
690  CADJ INIT kpp_ri_tape_mr = common, 1  CADJ INIT kpp_ri_tape_mr = common, 1
691  #endif  #endif
692    
# Line 674  C     break data flow dependence on diff Line 706  C     break data flow dependence on diff
706    
707        do ki = 1, Nr        do ki = 1, Nr
708           do i = 1, imt           do i = 1, imt
709              if     (kmtj(i) .EQ. 0      ) then              if     (kmtj(i) .LE. 1      ) then
710                 diffus(i,ki,1) = 0.                 diffus(i,ki,1) = 0.
711                 diffus(i,ki,2) = 0.                 diffus(i,ki,2) = 0.
712              elseif (ki      .GE. kmtj(i)) then              elseif (ki      .GE. kmtj(i)) then
# Line 1330  c     work1, work2 - work arrays for hol Line 1362  c     work1, work2 - work arrays for hol
1362  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
1363    
1364        call FIND_RHO(        call FIND_RHO(
1365       I     bi, bj, ibot, itop, jbot, jtop, 1, 1, eosType,       I     bi, bj, ibot, itop, jbot, jtop, 1, 1,
1366       I     theta, salt,       I     theta, salt,
1367       O     WORK1,       O     WORK1,
1368       I     myThid )       I     myThid )
1369    
1370        call FIND_ALPHA(        call FIND_ALPHA(
1371       I     bi, bj, ibot, itop, jbot, jtop, 1, 1, eosType,       I     bi, bj, ibot, itop, jbot, jtop, 1, 1,
1372       O     WORK2 )       O     WORK2 )
1373    
1374        call FIND_BETA(        call FIND_BETA(
1375       I     bi, bj, ibot, itop, jbot, jtop, 1, 1, eosType,       I     bi, bj, ibot, itop, jbot, jtop, 1, 1,
1376       O     WORK3 )       O     WORK3 )
1377    
1378        DO J = jbot, jtop        DO J = jbot, jtop
1379           DO I = ibot, itop           DO I = ibot, itop
1380              RHO1(I,J)      = WORK1(I,J) + rhonil              RHO1(I,J)      = WORK1(I,J) + rhoConst
1381              TTALPHA(I,J,1) = WORK2(I,J)              TTALPHA(I,J,1) = WORK2(I,J)
1382              SSBETA(I,J,1)  = WORK3(I,J)              SSBETA(I,J,1)  = WORK3(I,J)
1383              DBSFC(I,J,1)   = 0.              DBSFC(I,J,1)   = 0.
# Line 1358  CHPF$  INDEPENDENT, NEW (RHOK,RHOKM1,RHO Line 1390  CHPF$  INDEPENDENT, NEW (RHOK,RHOKM1,RHO
1390        DO K = 2, Nr        DO K = 2, Nr
1391    
1392           call FIND_RHO(           call FIND_RHO(
1393       I        bi, bj, ibot, itop, jbot, jtop, K, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, K, K,
1394       I        theta, salt,       I        theta, salt,
1395       O        RHOK,       O        RHOK,
1396       I        myThid )       I        myThid )
1397    
1398           call FIND_RHO(           call FIND_RHO(
1399       I        bi, bj, ibot, itop, jbot, jtop, K-1, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, K-1, K,
1400       I        theta, salt,       I        theta, salt,
1401       O        RHOKM1,       O        RHOKM1,
1402       I        myThid )       I        myThid )
1403    
1404           call FIND_RHO(           call FIND_RHO(
1405       I        bi, bj, ibot, itop, jbot, jtop, 1, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, 1, K,
1406       I        theta, salt,       I        theta, salt,
1407       O        RHO1K,       O        RHO1K,
1408       I        myThid )       I        myThid )
1409    
1410           call FIND_ALPHA(           call FIND_ALPHA(
1411       I        bi, bj, ibot, itop, jbot, jtop, K, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, K, K,
1412       O        WORK1 )       O        WORK1 )
1413    
1414           call FIND_BETA(           call FIND_BETA(
1415       I        bi, bj, ibot, itop, jbot, jtop, K, K, eosType,       I        bi, bj, ibot, itop, jbot, jtop, K, K,
1416       O        WORK2 )       O        WORK2 )
1417    
1418           DO J = jbot, jtop           DO J = jbot, jtop
# Line 1388  CHPF$  INDEPENDENT, NEW (RHOK,RHOKM1,RHO Line 1420  CHPF$  INDEPENDENT, NEW (RHOK,RHOKM1,RHO
1420                 TTALPHA(I,J,K) = WORK1 (I,J)                 TTALPHA(I,J,K) = WORK1 (I,J)
1421                 SSBETA(I,J,K)  = WORK2 (I,J)                 SSBETA(I,J,K)  = WORK2 (I,J)
1422                 DBLOC(I,J,K-1) = gravity * (RHOK(I,J) - RHOKM1(I,J)) /                 DBLOC(I,J,K-1) = gravity * (RHOK(I,J) - RHOKM1(I,J)) /
1423       &                                    (RHOK(I,J) + rhonil)       &                                    (RHOK(I,J) + rhoConst)
1424                 DBSFC(I,J,K)   = gravity * (RHOK(I,J) - RHO1K (I,J)) /                 DBSFC(I,J,K)   = gravity * (RHOK(I,J) - RHO1K (I,J)) /
1425       &                                    (RHOK(I,J) + rhonil)       &                                    (RHOK(I,J) + rhoConst)
1426              END DO              END DO
1427           END DO           END DO
1428    
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22