- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
OCE/DYN/dynkeg.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynkeg.F90
r11536 r11949 44 44 CONTAINS 45 45 46 SUBROUTINE dyn_keg( kt, kscheme )46 SUBROUTINE dyn_keg( kt, kscheme, Kmm, puu, pvv, Krhs ) 47 47 !!---------------------------------------------------------------------- 48 48 !! *** ROUTINE dyn_keg *** … … 57 57 !! * kscheme = nkeg_HW : Hollingsworth correction following 58 58 !! Arakawa (2001). The now horizontal kinetic energy is given by: 59 !! zhke = 1/6 [ mi-1( 2 * un^2 + ((u n(j+1)+un(j-1))/2)^2 )60 !! + mj-1( 2 * vn^2 + ((v n(i+1)+vn(i-1))/2)^2 ) ]59 !! zhke = 1/6 [ mi-1( 2 * un^2 + ((u(j+1)+u(j-1))/2)^2 ) 60 !! + mj-1( 2 * vn^2 + ((v(i+1)+v(i-1))/2)^2 ) ] 61 61 !! 62 62 !! Take its horizontal gradient and add it to the general momentum 63 !! trend (ua,va).64 !! u a = ua- 1/e1u di[ zhke ]65 !! v a = va- 1/e2v dj[ zhke ]63 !! trend. 64 !! u(rhs) = u(rhs) - 1/e1u di[ zhke ] 65 !! v(rhs) = v(rhs) - 1/e2v dj[ zhke ] 66 66 !! 67 !! ** Action : - Update the ( ua, va) with the hor. ke gradient trend67 !! ** Action : - Update the (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) with the hor. ke gradient trend 68 68 !! - send this trends to trd_dyn (l_trddyn=T) for post-processing 69 69 !! … … 71 71 !! Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 72 72 !!---------------------------------------------------------------------- 73 INTEGER, INTENT( in ) :: kt ! ocean time-step index 74 INTEGER, INTENT( in ) :: kscheme ! =0/1 type of KEG scheme 73 INTEGER , INTENT( in ) :: kt ! ocean time-step index 74 INTEGER , INTENT( in ) :: kscheme ! =0/1 type of KEG scheme 75 INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices 76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation 75 77 ! 76 78 INTEGER :: ji, jj, jk ! dummy loop indices … … 90 92 IF( l_trddyn ) THEN ! Save the input trends 91 93 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 92 ztrdu(:,:,:) = ua(:,:,:)93 ztrdv(:,:,:) = va(:,:,:)94 ztrdu(:,:,:) = puu(:,:,:,Krhs) 95 ztrdv(:,:,:) = pvv(:,:,:,Krhs) 94 96 ENDIF 95 97 … … 102 104 DO jj = 2, jpj 103 105 DO ji = fs_2, jpi ! vector opt. 104 zu = un(ji-1,jj ,jk) * un(ji-1,jj ,jk) &105 & + un(ji ,jj ,jk) * un(ji ,jj ,jk)106 zv = vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) &107 & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk)106 zu = puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 107 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) 108 zv = pvv(ji ,jj-1,jk,Kmm) * pvv(ji ,jj-1,jk,Kmm) & 109 & + pvv(ji ,jj ,jk,Kmm) * pvv(ji ,jj ,jk,Kmm) 108 110 zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 109 111 END DO … … 114 116 DO jj = 2, jpjm1 115 117 DO ji = fs_2, jpim1 ! vector opt. 116 zu = 8._wp * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) &117 & + un(ji ,jj ,jk) * un(ji ,jj ,jk) ) &118 & + ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) &119 & + ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) ) * ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) )118 zu = 8._wp * ( puu(ji-1,jj ,jk,Kmm) * puu(ji-1,jj ,jk,Kmm) & 119 & + puu(ji ,jj ,jk,Kmm) * puu(ji ,jj ,jk,Kmm) ) & 120 & + ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) & 121 & + ( puu(ji ,jj-1,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) * ( puu(ji ,jj-1,jk,Kmm) + puu(ji ,jj+1,jk,Kmm) ) 120 122 ! 121 zv = 8._wp * ( vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) &122 & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) &123 & + ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) &124 & + ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) ) * ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) )123 zv = 8._wp * ( pvv(ji ,jj-1,jk,Kmm) * pvv(ji ,jj-1,jk,Kmm) & 124 & + pvv(ji ,jj ,jk,Kmm) * pvv(ji ,jj ,jk,Kmm) ) & 125 & + ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) & 126 & + ( pvv(ji-1,jj ,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) ) * ( pvv(ji-1,jj ,jk,Kmm) + pvv(ji+1,jj ,jk,Kmm) ) 125 127 zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 126 128 END DO … … 134 136 DO jj = 2, jpjm1 135 137 DO ji = fs_2, fs_jpim1 ! vector opt. 136 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)137 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)138 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 139 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 138 140 END DO 139 141 END DO … … 141 143 ! 142 144 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 143 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)144 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)145 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt )145 ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 146 ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 147 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt, Kmm ) 146 148 DEALLOCATE( ztrdu , ztrdv ) 147 149 ENDIF 148 150 ! 149 IF(ln_ctl) CALL prt_ctl( tab3d_1= ua, clinfo1=' keg - Ua: ', mask1=umask, &150 & tab3d_2= va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )151 IF(ln_ctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' keg - Ua: ', mask1=umask, & 152 & tab3d_2=pvv(:,:,:,Krhs), clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 151 153 ! 152 154 IF( ln_timing ) CALL timing_stop('dyn_keg')
Note: See TracChangeset
for help on using the changeset viewer.
