- Timestamp:
- 2017-06-06T15:55:44+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r8093 r8143 5 5 !!============================================================================== 6 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.)7 !! 3.4 ! 2011-09 (H. Liu) Make it consistent with semi-implicit Bottom friction (ln_drgimp =T) 8 !! 4.0 ! 2017-05 (G. Madec) drag coef. defined at t-point (zdfdrg.F90) 9 9 !!---------------------------------------------------------------------- 10 10 … … 14 14 USE oce ! ocean dynamics and tracers variables 15 15 USE dom_oce ! ocean space and time domain variables 16 USE zdf_oce ! ocean vertical physics variables 17 !!gm new 16 USE zdf_oce ! vertical physics: variables 18 17 USE zdfdrg ! vertical physics: top/bottom drag coef. 19 !!gm old20 USE zdfbfr ! ocean bottom friction variables21 !!gm22 18 USE trd_oce ! trends: ocean variables 23 19 USE trddyn ! trend manager: dynamics … … 26 22 USE prtctl ! Print control 27 23 USE timing ! Timing 28 USE wrk_nemo ! Memory Allocation29 24 30 25 IMPLICIT NONE … … 36 31 # include "vectopt_loop_substitute.h90" 37 32 !!---------------------------------------------------------------------- 38 !! NEMO/OPA 3.3 , NEMO Consortium (2010)33 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 39 34 !! $Id$ 40 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 47 42 !! 48 43 !! ** Purpose : compute the bottom friction ocean dynamics physics. 44 !! 45 !! only for explicit bottom friction form 46 !! implicit bfr is implemented in dynzdf_imp 49 47 !! 50 48 !! ** Action : (ua,va) momentum trend increased by bottom friction trend … … 61 59 IF( nn_timing == 1 ) CALL timing_start('dyn_bfr') 62 60 ! 63 !!gm issue: better to put the logical in step to control the call of zdf_bfr64 !! ==> change the logical from ln_bfrimp to ln_bfr_exp !!65 IF( .NOT.ln_bfrimp) THEN ! only for explicit bottom friction form66 ! implicit bfr is implemented in dynzdf_imp67 68 61 !!gm bug : time step is only rdt (not 2 rdt if euler start !) 69 62 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 70 63 71 72 73 64 IF( l_trddyn ) THEN ! trends: store the input trends 65 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 66 ztrdu(:,:,:) = ua(:,:,:) 74 67 ztrdv(:,:,:) = va(:,:,:) 75 68 ENDIF 76 69 77 70 71 DO jj = 2, jpjm1 72 DO ji = 2, jpim1 73 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels 74 ikbv = mbkv(ji,jj) 75 ! 76 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 77 zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu) 78 zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 79 ! 80 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * ub(ji,jj,ikbu) 81 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * vb(ji,jj,ikbv) 82 END DO 83 END DO 84 ! 85 IF( ln_isfcav ) THEN ! ocean cavities 78 86 DO jj = 2, jpjm1 79 87 DO ji = 2, jpim1 80 ikbu = m bku(ji,jj) ! deepest wet ocean u- & v-levels81 ikbv = m bkv(ji,jj)88 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 89 ikbv = mikv(ji,jj) 82 90 ! 83 91 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 84 !!gm old 85 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) 86 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) 87 !!gm new 88 ! zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu) 89 ! zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 90 ! ! 91 ! ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * ub(ji,jj,ikbu) 92 ! va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * vb(ji,jj,ikbv) 93 !!gm 94 END DO 92 zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu) ! NB: Cdtop masked 93 zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 94 ! 95 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * ub(ji,jj,ikbu) 96 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * vb(ji,jj,ikbv) 97 END DO 95 98 END DO 96 ! 97 IF( ln_isfcav ) THEN ! ocean cavities 98 DO jj = 2, jpjm1 99 DO ji = 2, jpim1 100 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 101 ikbv = mikv(ji,jj) 102 ! 103 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 104 !!gm old 105 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) & 106 & * (1.-umask(ji,jj,1)) 107 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) & 108 & * (1.-vmask(ji,jj,1)) 109 !!gm new 110 ! zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu) ! NB: Cdtop masked 111 ! zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 112 ! ! 113 ! ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * ub(ji,jj,ikbu) 114 ! va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * vb(ji,jj,ikbv) 115 !!gm 116 END DO 117 END DO 118 END IF 119 ! 120 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 121 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 122 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 123 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 124 DEALLOCATE( ztrdu, ztrdv ) 125 ENDIF 126 ! ! print mean trends (used for debugging) 127 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr - Ua: ', mask1=umask, & 128 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 129 ! 130 ENDIF ! end explicit bottom friction 99 ENDIF 100 ! 101 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 102 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 103 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 104 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 105 DEALLOCATE( ztrdu, ztrdv ) 106 ENDIF 107 ! ! print mean trends (used for debugging) 108 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr - Ua: ', mask1=umask, & 109 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 131 110 ! 132 111 IF( nn_timing == 1 ) CALL timing_stop('dyn_bfr')
Note: See TracChangeset
for help on using the changeset viewer.