/[MITgcm]/MITgcm/model/src/do_oceanic_phys.F
ViewVC logotype

Diff of /MITgcm/model/src/do_oceanic_phys.F

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

revision 1.31 by heimbach, Sun Oct 22 01:11:44 2006 UTC revision 1.36 by jmc, Fri Dec 29 00:20:12 2006 UTC
# Line 118  C--   dummy statement to end declaration Line 118  C--   dummy statement to end declaration
118        IF ( debugLevel .GE. debLevB )        IF ( debugLevel .GE. debLevB )
119       &     CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)       &     CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)
120  #endif  #endif
121    
122        doDiagsRho = 0        doDiagsRho = 0
123  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
124        IF ( useDiagnostics .AND. fluidIsWater ) THEN        IF ( useDiagnostics .AND. fluidIsWater ) THEN
# Line 144  C     under sea-ice may not be "exactly" Line 144  C     under sea-ice may not be "exactly"
144  C     theta is dumped or time-averaged.  C     theta is dumped or time-averaged.
145        IF ( useSEAICE ) THEN        IF ( useSEAICE ) THEN
146  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
147  CADJ STORE qnet,qsw            = comlev1, key = ikey_dynamics  CADJ STORE atemp,aqh,precip    = comlev1, key = ikey_dynamics
148  CADJ STORE aqh,precip,swdown   = comlev1, key = ikey_dynamics  CADJ STORE swdown,lwdown       = comlev1, key = ikey_dynamics
149  CADJ STORE theta               = comlev1, key = ikey_dynamics  cphCADJ STORE theta               = comlev1, key = ikey_dynamics
150  # ifdef SEAICE_ALLOW_DYNAMICS  cph# ifdef EXF_READ_EVAP
151    CADJ STORE evap                = comlev1, key = ikey_dynamics
152    cph# endif
153    cph# ifdef SEAICE_ALLOW_DYNAMICS
154  CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics  CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics
155    cph# endif
156    # ifdef SEAICE_CGRID
157    CADJ STORE fu, fv              = comlev1, key = ikey_dynamics
158    CADJ STORE siceload            = comlev1, key = ikey_dynamics
159    CADJ STORE seaicemasku         = comlev1, key = ikey_dynamics
160    CADJ STORE seaicemaskv         = comlev1, key = ikey_dynamics
161  # endif  # endif
162  #endif  #endif
163  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
# Line 207  CADJ STORE theta = comlev1, key = ikey_d Line 216  CADJ STORE theta = comlev1, key = ikey_d
216  #ifdef ALLOW_OCN_COMPON_INTERF  #ifdef ALLOW_OCN_COMPON_INTERF
217  C--    Apply imported data (from coupled interface) to forcing fields  C--    Apply imported data (from coupled interface) to forcing fields
218  C jmc: do not know precisely where to put this call (bf or af thSIce ?)  C jmc: do not know precisely where to put this call (bf or af thSIce ?)
219         IF ( useCoupler ) THEN        IF ( useCoupler ) THEN
220           CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )           CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )
221         ENDIF        ENDIF
222  #endif /* ALLOW_OCN_COMPON_INTERF */  #endif /* ALLOW_OCN_COMPON_INTERF */
223    
224  #ifdef ALLOW_BALANCE_FLUXES  #ifdef ALLOW_BALANCE_FLUXES
225  C     balance fluxes  C     balance fluxes
226         IF ( balanceEmPmR )        IF ( balanceEmPmR )
227       &        CALL REMOVE_MEAN_RS( 1, EmPmR, maskH, maskH, rA, drF,       &        CALL REMOVE_MEAN_RS( 1, EmPmR, maskH, maskH, rA, drF,
228       &        'EmPmR', myTime, myThid )       &        'EmPmR', myTime, myThid )
229         IF ( balanceQnet )        IF ( balanceQnet )
230       &        CALL REMOVE_MEAN_RS( 1, Qnet,  maskH, maskH, rA, drF,       &        CALL REMOVE_MEAN_RS( 1, Qnet,  maskH, maskH, rA, drF,
231       &        'Qnet ', myTime, myThid )       &        'Qnet ', myTime, myThid )
232  #endif /* ALLOW_BALANCE_FLUXES */  #endif /* ALLOW_BALANCE_FLUXES */
# Line 244  CHPF$ INDEPENDENT Line 253  CHPF$ INDEPENDENT
253            itdkey = (act1 + 1) + act2*max1            itdkey = (act1 + 1) + act2*max1
254       &                      + act3*max1*max2       &                      + act3*max1*max2
255       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
256    #else  /* ALLOW_AUTODIFF_TAMC */
257    C     if fluid is not water, by-pass find_rho, gmredi, surfaceForcing
258    C     and all vertical mixing schemes, but keep OBCS_CALC
259            IF ( fluidIsWater ) THEN
260  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
261    
262  C--   Set up work arrays with valid (i.e. not NaN) values  C--   Set up work arrays with valid (i.e. not NaN) values
# Line 313  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_ Line 326  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_
326  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
327    
328  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
329          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
330       &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)       &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
331  #endif  #endif
332    
# Line 330  cph Needed for rhok, rhokm1, in the case Line 343  cph Needed for rhok, rhokm1, in the case
343    
344  C--       Calculate gradients of potential density for isoneutral  C--       Calculate gradients of potential density for isoneutral
345  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
 c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN  
346            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)
347       &                   .OR. doDiagsRho.GE.1 ) THEN       &                   .OR. doDiagsRho.GE.1 ) THEN
348  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
349              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
350       &       CALL DEBUG_CALL('FIND_RHO',myThid)       &       CALL DEBUG_CALL('FIND_RHO',myThid)
351  #endif  #endif
352  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 359  CADJ STORE salt (:,:,k-1,bi,bj) = comlev Line 371  CADJ STORE salt (:,:,k-1,bi,bj) = comlev
371       I        myThid )       I        myThid )
372              ENDIF              ENDIF
373  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
374              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
375       &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)       &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)
376  #endif  #endif
377  cph Avoid variable aliasing for adjoint !!!  cph Avoid variable aliasing for adjoint !!!
# Line 385  C--       Implicit Vertical Diffusion fo Line 397  C--       Implicit Vertical Diffusion fo
397  c ==> should use sigmaR !!!  c ==> should use sigmaR !!!
398            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
399  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
400              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
401       &       CALL DEBUG_CALL('CALC_IVDC',myThid)       &       CALL DEBUG_CALL('CALC_IVDC',myThid)
402  #endif  #endif
403              CALL CALC_IVDC(              CALL CALC_IVDC(
# Line 406  C--     end of diagnostic k loop (Nr:1) Line 418  C--     end of diagnostic k loop (Nr:1)
418          ENDDO          ENDDO
419    
420  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
 c       IF ( useDiagnostics .AND.  
 c    &       (useGMRedi .OR. ivdc_kappa.NE.0.) ) THEN  
421          IF ( doDiagsRho.GE.1 ) THEN          IF ( doDiagsRho.GE.1 ) THEN
422            CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,            CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,
423       &         2, bi, bj, myThid)       &         2, bi, bj, myThid)
424          ENDIF          ENDIF
425  #endif  #endif
426    
 #ifdef  ALLOW_OBCS  
 C--     Calculate future values on open boundaries  
         IF (useOBCS) THEN  
 #ifdef ALLOW_DEBUG  
           IF ( debugLevel .GE. debLevB )  
      &     CALL DEBUG_CALL('OBCS_CALC',myThid)  
 #endif  
           CALL OBCS_CALC( bi, bj, myTime+deltaTclock, myIter+1,  
      I            uVel, vVel, wVel, theta, salt,  
      I            myThid )  
         ENDIF  
 #endif  /* ALLOW_OBCS */  
   
 #ifndef ALLOW_AUTODIFF_TAMC  
         IF ( fluidIsWater ) THEN  
 #endif  
427  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
428  C       relaxation terms, etc.  C       relaxation terms, etc.
429  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
430          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
431       &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)       &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
432  #endif  #endif
433  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 450  CADJ STORE recip_hFacC(:,:,:,bi,bj) Line 444  CADJ STORE recip_hFacC(:,:,:,bi,bj)
444  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
445  # endif  # endif
446  #endif  #endif
447           CALL EXTERNAL_FORCING_SURF(          CALL EXTERNAL_FORCING_SURF(
448       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
449       I             myTime, myIter, myThid )       I             myTime, myIter, myThid )
 #ifndef ALLOW_AUTODIFF_TAMC  
         ENDIF  
 #endif  
450  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
451  # ifdef EXACT_CONSERV  # ifdef EXACT_CONSERV
452  cph-test  cph-test
# Line 495  CADJ STORE sigmaR(:,:,:)        = comlev Line 486  CADJ STORE sigmaR(:,:,:)        = comlev
486  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
487          IF (useGMRedi) THEN          IF (useGMRedi) THEN
488  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
489            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
490       &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)       &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
491  #endif  #endif
492            CALL GMREDI_CALC_TENSOR(            CALL GMREDI_CALC_TENSOR(
# Line 517  C--     Calculate iso-neutral slopes for Line 508  C--     Calculate iso-neutral slopes for
508  C--     Compute KPP mixing coefficients  C--     Compute KPP mixing coefficients
509          IF (useKPP) THEN          IF (useKPP) THEN
510  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
511            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
512       &     CALL DEBUG_CALL('KPP_CALC',myThid)       &     CALL DEBUG_CALL('KPP_CALC',myThid)
513  #endif  #endif
514            CALL KPP_CALC(            CALL KPP_CALC(
# Line 535  C--     Compute KPP mixing coefficients Line 526  C--     Compute KPP mixing coefficients
526  C--     Compute PP81 mixing coefficients  C--     Compute PP81 mixing coefficients
527          IF (usePP81) THEN          IF (usePP81) THEN
528  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
529            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
530       &     CALL DEBUG_CALL('PP81_CALC',myThid)       &     CALL DEBUG_CALL('PP81_CALC',myThid)
531  #endif  #endif
532            CALL PP81_CALC(            CALL PP81_CALC(
# Line 547  C--     Compute PP81 mixing coefficients Line 538  C--     Compute PP81 mixing coefficients
538  C--     Compute MY82 mixing coefficients  C--     Compute MY82 mixing coefficients
539          IF (useMY82) THEN          IF (useMY82) THEN
540  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
541            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
542       &     CALL DEBUG_CALL('MY82_CALC',myThid)       &     CALL DEBUG_CALL('MY82_CALC',myThid)
543  #endif  #endif
544            CALL MY82_CALC(            CALL MY82_CALC(
# Line 559  C--     Compute MY82 mixing coefficients Line 550  C--     Compute MY82 mixing coefficients
550  C--     Compute GGL90 mixing coefficients  C--     Compute GGL90 mixing coefficients
551          IF (useGGL90) THEN          IF (useGGL90) THEN
552  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
553            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
554       &     CALL DEBUG_CALL('GGL90_CALC',myThid)       &     CALL DEBUG_CALL('GGL90_CALC',myThid)
555  #endif  #endif
556            CALL GGL90_CALC(            CALL GGL90_CALC(
# Line 568  C--     Compute GGL90 mixing coefficient Line 559  C--     Compute GGL90 mixing coefficient
559  #endif /* ALLOW_GGL90 */  #endif /* ALLOW_GGL90 */
560    
561  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
562          IF ( taveFreq.GT. 0. _d 0 .AND. fluidIsWater ) THEN          IF ( taveFreq.GT. 0. _d 0 ) THEN
563            CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)            CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)
564          ENDIF          ENDIF
565          IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN          IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
# Line 577  C--     Compute GGL90 mixing coefficient Line 568  C--     Compute GGL90 mixing coefficient
568          ENDIF          ENDIF
569  #endif /* ALLOW_TIMEAVE */  #endif /* ALLOW_TIMEAVE */
570    
571    #ifndef ALLOW_AUTODIFF_TAMC
572    C---  if fluid Is Water: end
573            ENDIF
574    #endif
575    
576    #ifdef  ALLOW_OBCS
577    C--     Calculate future values on open boundaries
578            IF (useOBCS) THEN
579    #ifdef ALLOW_DEBUG
580              IF ( debugLevel .GE. debLevB )
581         &     CALL DEBUG_CALL('OBCS_CALC',myThid)
582    #endif
583              CALL OBCS_CALC( bi, bj, myTime+deltaTclock, myIter+1,
584         I            uVel, vVel, wVel, theta, salt,
585         I            myThid )
586            ENDIF
587    #endif  /* ALLOW_OBCS */
588    
589  C--   end bi,bj loops.  C--   end bi,bj loops.
590         ENDDO         ENDDO
591        ENDDO        ENDDO
Legend:
Removed from v.1.31  
changed lines
  Added in v.1.36
  ViewVC Help
Powered by ViewVC 1.1.22