dynbfr.F90 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120
  1. MODULE dynbfr
  2. !!==============================================================================
  3. !! *** MODULE dynbfr ***
  4. !! Ocean dynamics : bottom friction component of the momentum mixing trend
  5. !!==============================================================================
  6. !! History : 3.2 ! 2008-11 (A. C. Coward) Original code
  7. !! 3.4 ! 2011-09 (H. Liu) Make it consistent with semi-implicit
  8. !! Bottom friction (ln_bfrimp = .true.)
  9. !!----------------------------------------------------------------------
  10. !!----------------------------------------------------------------------
  11. !! dyn_bfr : Update the momentum trend with the bottom friction contribution
  12. !!----------------------------------------------------------------------
  13. USE oce ! ocean dynamics and tracers variables
  14. USE dom_oce ! ocean space and time domain variables
  15. USE zdf_oce ! ocean vertical physics variables
  16. USE zdfbfr ! ocean bottom friction variables
  17. USE trd_oce ! trends: ocean variables
  18. USE trddyn ! trend manager: dynamics
  19. USE in_out_manager ! I/O manager
  20. USE prtctl ! Print control
  21. USE timing ! Timing
  22. USE wrk_nemo ! Memory Allocation
  23. IMPLICIT NONE
  24. PRIVATE
  25. PUBLIC dyn_bfr ! routine called by step.F90
  26. !! * Substitutions
  27. # include "domzgr_substitute.h90"
  28. # include "zdfddm_substitute.h90"
  29. # include "vectopt_loop_substitute.h90"
  30. !!----------------------------------------------------------------------
  31. !! NEMO/OPA 3.3 , NEMO Consortium (2010)
  32. !! $Id: dynbfr.F90 4990 2014-12-15 16:42:49Z timgraham $
  33. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  34. !!----------------------------------------------------------------------
  35. CONTAINS
  36. SUBROUTINE dyn_bfr( kt )
  37. !!----------------------------------------------------------------------
  38. !! *** ROUTINE dyn_bfr ***
  39. !!
  40. !! ** Purpose : compute the bottom friction ocean dynamics physics.
  41. !!
  42. !! ** Action : (ua,va) momentum trend increased by bottom friction trend
  43. !!---------------------------------------------------------------------
  44. INTEGER, INTENT(in) :: kt ! ocean time-step index
  45. !!
  46. INTEGER :: ji, jj ! dummy loop indexes
  47. INTEGER :: ikbu, ikbv ! local integers
  48. REAL(wp) :: zm1_2dt ! local scalar
  49. REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv
  50. !!---------------------------------------------------------------------
  51. !
  52. IF( nn_timing == 1 ) CALL timing_start('dyn_bfr')
  53. !
  54. !!gm issue: better to put the logical in step to control the call of zdf_bfr
  55. !! ==> change the logical from ln_bfrimp to ln_bfr_exp !!
  56. IF( .NOT.ln_bfrimp) THEN ! only for explicit bottom friction form
  57. ! implicit bfr is implemented in dynzdf_imp
  58. !!gm bug : time step is only rdt (not 2 rdt if euler start !)
  59. zm1_2dt = - 1._wp / ( 2._wp * rdt )
  60. IF( l_trddyn ) THEN ! temporary save of ua and va trends
  61. CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
  62. ztrdu(:,:,:) = ua(:,:,:)
  63. ztrdv(:,:,:) = va(:,:,:)
  64. ENDIF
  65. DO jj = 2, jpjm1
  66. DO ji = 2, jpim1
  67. ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels
  68. ikbv = mbkv(ji,jj)
  69. !
  70. ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
  71. ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu)
  72. va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv)
  73. END DO
  74. END DO
  75. IF ( ln_isfcav ) THEN
  76. DO jj = 2, jpjm1
  77. DO ji = 2, jpim1
  78. ! (ISF) stability criteria for top friction
  79. ikbu = miku(ji,jj) ! first wet ocean u- & v-levels
  80. ikbv = mikv(ji,jj)
  81. !
  82. ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
  83. ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( tfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) &
  84. & * (1.-umask(ji,jj,1))
  85. va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( tfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) &
  86. & * (1.-vmask(ji,jj,1))
  87. ! (ISF)
  88. END DO
  89. END DO
  90. END IF
  91. !
  92. IF( l_trddyn ) THEN ! save the vertical diffusive trends for further diagnostics
  93. ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
  94. ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
  95. CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )
  96. CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )
  97. ENDIF
  98. ! ! print mean trends (used for debugging)
  99. IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr - Ua: ', mask1=umask, &
  100. & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )
  101. !
  102. ENDIF ! end explicit bottom friction
  103. !
  104. IF( nn_timing == 1 ) CALL timing_stop('dyn_bfr')
  105. !
  106. END SUBROUTINE dyn_bfr
  107. !!==============================================================================
  108. END MODULE dynbfr