- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r7753 r8882 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 physicsvariables17 USE zdf bfr ! ocean bottom friction variables16 USE zdf_oce ! vertical physics: variables 17 USE zdfdrg ! vertical physics: top/bottom drag coef. 18 18 USE trd_oce ! trends: ocean variables 19 19 USE trddyn ! trend manager: dynamics 20 ! 20 21 USE in_out_manager ! I/O manager 21 22 USE prtctl ! Print control 22 23 USE timing ! Timing 23 USE wrk_nemo ! Memory Allocation24 24 25 25 IMPLICIT NONE … … 31 31 # include "vectopt_loop_substitute.h90" 32 32 !!---------------------------------------------------------------------- 33 !! NEMO/OPA 3.3 , NEMO Consortium (2010)33 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 34 34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 43 !! ** Purpose : compute the bottom friction ocean dynamics physics. 44 44 !! 45 !! only for explicit bottom friction form 46 !! implicit bfr is implemented in dynzdf_imp 47 !! 45 48 !! ** Action : (ua,va) momentum trend increased by bottom friction trend 46 49 !!--------------------------------------------------------------------- … … 50 53 INTEGER :: ikbu, ikbv ! local integers 51 54 REAL(wp) :: zm1_2dt ! local scalar 52 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 55 REAL(wp) :: zCdu, zCdv ! - - 56 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdu, ztrdv 53 57 !!--------------------------------------------------------------------- 54 58 ! 55 IF( nn_timing == 1 )CALL timing_start('dyn_bfr')59 IF( ln_timing ) CALL timing_start('dyn_bfr') 56 60 ! 57 !!gm issue: better to put the logical in step to control the call of zdf_bfr 58 !! ==> change the logical from ln_bfrimp to ln_bfr_exp !! 59 IF( .NOT.ln_bfrimp) THEN ! only for explicit bottom friction form 60 ! implicit bfr is implemented in dynzdf_imp 61 !!gm bug : time step is only rdt (not 2 rdt if euler start !) 62 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 61 63 62 !!gm bug : time step is only rdt (not 2 rdt if euler start !) 63 zm1_2dt = - 1._wp / ( 2._wp * rdt ) 64 65 IF( l_trddyn ) THEN ! trends: store the input trends 66 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 67 ztrdu(:,:,:) = ua(:,:,:) 68 ztrdv(:,:,:) = va(:,:,:) 69 ENDIF 64 IF( l_trddyn ) THEN ! trends: store the input trends 65 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 66 ztrdu(:,:,:) = ua(:,:,:) 67 ztrdv(:,:,:) = va(:,:,:) 68 ENDIF 70 69 71 70 72 DO jj = 2, jpjm1 73 DO ji = 2, jpim1 74 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 75 ikbv = mbkv(ji,jj) 76 ! 77 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 78 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) 79 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) 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 86 DO jj = 2, jpjm1 87 DO ji = 2, jpim1 88 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 89 ikbv = mikv(ji,jj) 90 ! 91 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 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) 80 97 END DO 81 END DO 82 ! 83 IF( ln_isfcav ) THEN ! ocean cavities 84 DO jj = 2, jpjm1 85 DO ji = 2, jpim1 86 ! (ISF) stability criteria for top friction 87 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 88 ikbv = mikv(ji,jj) 89 ! 90 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 91 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX( tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt ) * ub(ji,jj,ikbu) & 92 & * (1.-umask(ji,jj,1)) 93 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX( tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt ) * vb(ji,jj,ikbv) & 94 & * (1.-vmask(ji,jj,1)) 95 ! (ISF) 96 END DO 97 END DO 98 END IF 99 ! 100 IF( l_trddyn ) THEN ! trends: send trends to trddyn for further diagnostics 101 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 102 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 103 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 104 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 105 ENDIF 106 ! ! print mean trends (used for debugging) 107 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr - Ua: ', mask1=umask, & 108 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 109 ! 110 ENDIF ! end explicit bottom friction 98 END DO 99 ENDIF 111 100 ! 112 IF( nn_timing == 1 ) CALL timing_stop('dyn_bfr') 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' ) 110 ! 111 IF( ln_timing ) CALL timing_stop('dyn_bfr') 113 112 ! 114 113 END SUBROUTINE dyn_bfr
Note: See TracChangeset
for help on using the changeset viewer.
