/[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.36 by dimitri, Tue Dec 18 09:05:59 2007 UTC revision 1.37 by atn, Fri Dec 21 02:54:34 2007 UTC
# Line 290  c Line 290  c
290        IMPLICIT NONE        IMPLICIT NONE
291    
292  #include "SIZE.h"  #include "SIZE.h"
293    #include "EEPARAMS.h"
294    #include "PARAMS.h"
295  #include "KPP_PARAMS.h"  #include "KPP_PARAMS.h"
296    
297  c input  c input
# Line 357  c wm, ws    : turbulent velocity scales Line 359  c wm, ws    : turbulent velocity scales
359        _RL         minusone        _RL         minusone
360        parameter ( minusone=-1.0 )        parameter ( minusone=-1.0 )
361    
362    #ifdef ALLOW_DIAGNOSTICS
363    c     KPPBFSFC - Bo+radiation absorbed to d=hbf*hbl + plume (m^2/s^3)
364          _RL KPPBFSFC(imt,Nr)
365    #endif /* ALLOW_DIAGNOSTICS */
366    
367  c find bulk Richardson number at every grid level until > Ricr  c find bulk Richardson number at every grid level until > Ricr
368  c  c
369  c note: the reference depth is -epsilon/2.*zgrid(k), but the reference  c note: the reference depth is -epsilon/2.*zgrid(k), but the reference
# Line 374  c     initialize hbl and kbl to bottomed Line 381  c     initialize hbl and kbl to bottomed
381           hbl(i) = -zgrid(kbl(i))           hbl(i) = -zgrid(kbl(i))
382        end do        end do
383    
384    #ifdef ALLOW_DIAGNOSTICS
385          do kl = 1, Nr
386             do i = 1, imt
387                KPPBFSFC(i,kl) = 0.0
388             enddo
389          enddo
390    #endif /* ALLOW_DIAGNOSTICS */
391    
392        do kl = 2, Nr        do kl = 2, Nr
393    
394  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 405  c     compute bfsfc= Bo + radiative cont Line 420  c     compute bfsfc= Bo + radiative cont
420           end do           end do
421  #ifdef ALLOW_SALT_PLUME  #ifdef ALLOW_SALT_PLUME
422  c     compute bfsfc = plume fraction at hbf * zgrid  c     compute bfsfc = plume fraction at hbf * zgrid
423             IF ( useSALT_PLUME ) THEN
424               do i = 1, imt
425                  worka(i) = zgrid(kl)
426               enddo
427               call SALT_PLUME_FRAC(
428         I         imt, hbf,SPDepth,
429         U         worka,
430         I         myTime, myIter, myThid)
431               do i = 1, imt
432                  bfsfc(i) = bfsfc(i) + boplume(i)*(1. - worka(i))
433               enddo
434             ENDIF
435    #endif /* ALLOW_SALT_PLUME */
436    
437    #ifdef ALLOW_DIAGNOSTICS
438           do i = 1, imt           do i = 1, imt
439              worka(i) = zgrid(kl)              KPPBFSFC(i,kl) = bfsfc(i)
          enddo  
          call SALT_PLUME_FRAC(  
      I       imt, hbf,SPDepth,  
      U       worka,  
      I       myTime, myIter, myThid)  
          do i = 1, imt  
             bfsfc(i) = bfsfc(i) + boplume(i)*(1. - worka(i))  
440           enddo           enddo
441  #endif /* ALLOW_SALT_PLUME */  #endif /* ALLOW_DIAGNOSTICS */
442    
443           do i = 1, imt           do i = 1, imt
444              stable(i) = p5 + sign(p5,bfsfc(i))              stable(i) = p5 + sign(p5,bfsfc(i))
# Line 466  c Line 489  c
489           end do           end do
490        end do        end do
491    
492    #ifdef ALLOW_DIAGNOSTICS
493             CALL DIAGNOSTICS_FILL(KPPBFSFC,'KPPbfsfc',0,Nr,0,1,1,myThid)
494    #endif /* ALLOW_DIAGNOSTICS */
495    
496  cph(  cph(
497  cph  without this store, there is a recomputation error for  cph  without this store, there is a recomputation error for
498  cph  rib in adbldepth (probably partial recomputation problem)      cph  rib in adbldepth (probably partial recomputation problem)    
# Line 516  CADJ &   , key = ikppkey, shape = (/ (sN Line 543  CADJ &   , key = ikppkey, shape = (/ (sN
543        end do        end do
544    
545  #ifdef ALLOW_SALT_PLUME  #ifdef ALLOW_SALT_PLUME
546        do i = 1, imt        IF ( useSALT_PLUME ) THEN
547           worka(i) = hbl(i)          do i = 1, imt
548        enddo             worka(i) = hbl(i)
549        call SALT_PLUME_FRAC(          enddo
550       I       imt,minusone,SPDepth,          call SALT_PLUME_FRAC(
551       U       worka,       I         imt,minusone,SPDepth,
552       I       myTime, myIter, myThid )       U         worka,
553        do i = 1, imt       I         myTime, myIter, myThid )
554           bfsfc(i) = bfsfc(i) + boplume(i) * (1. - worka(i))          do i = 1, imt
555        enddo             bfsfc(i) = bfsfc(i) + boplume(i) * (1. - worka(i))
556            enddo
557          ENDIF
558  #endif /* ALLOW_SALT_PLUME */  #endif /* ALLOW_SALT_PLUME */
559  CADJ store bfsfc = comlev1_kpp  CADJ store bfsfc = comlev1_kpp
560  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
# Line 601  CADJ &   , key = ikppkey, shape = (/ (sN Line 630  CADJ &   , key = ikppkey, shape = (/ (sN
630        end do        end do
631    
632  #ifdef ALLOW_SALT_PLUME  #ifdef ALLOW_SALT_PLUME
633        do i = 1, imt        IF ( useSALT_PLUME ) THEN
634           worka(i) = hbl(i)          do i = 1, imt
635        enddo             worka(i) = hbl(i)
636        call SALT_PLUME_FRAC(          enddo
637       I       imt,minusone,SPDepth,          call SALT_PLUME_FRAC(
638       U       worka,       I         imt,minusone,SPDepth,
639       I       myTime, myIter, myThid )       U         worka,
640        do i = 1, imt       I         myTime, myIter, myThid )
641           bfsfc(i) = bfsfc(i) + boplume(i) * (1. - worka(i))          do i = 1, imt
642        enddo             bfsfc(i) = bfsfc(i) + boplume(i) * (1. - worka(i))
643            enddo
644          ENDIF
645  #endif /* ALLOW_SALT_PLUME */  #endif /* ALLOW_SALT_PLUME */
646  CADJ store bfsfc = comlev1_kpp  CADJ store bfsfc = comlev1_kpp
647  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
# Line 1614  c     compute arrays for K = Nrp1 Line 1645  c     compute arrays for K = Nrp1
1645  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
1646        IF ( useDiagnostics ) THEN        IF ( useDiagnostics ) THEN
1647           CALL DIAGNOSTICS_FILL(KPPmld,'KPPmld  ',0,1,3,bi,bj,myThid)           CALL DIAGNOSTICS_FILL(KPPmld,'KPPmld  ',0,1,3,bi,bj,myThid)
1648             CALL DIAGNOSTICS_FILL(DBSFC ,'KPPdbsfc',0,Nr,0,1,1,myThid)
1649             CALL DIAGNOSTICS_FILL(DBLOC ,'KPPdbloc',0,Nr,0,1,1,myThid)
1650        ENDIF        ENDIF
1651  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
1652    
Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37
  ViewVC Help
Powered by ViewVC 1.1.22