Changeset 10789 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynkeg.F90
- Timestamp:
- 2019-03-21T16:15:22+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynkeg.F90
r10425 r10789 44 44 CONTAINS 45 45 46 SUBROUTINE dyn_keg( kt, k scheme)46 SUBROUTINE dyn_keg( kt, ktlev, kscheme, pu_rhs, pv_rhs ) 47 47 !!---------------------------------------------------------------------- 48 48 !! *** ROUTINE dyn_keg *** … … 54 54 !! ** Method : * kscheme = nkeg_C2 : 2nd order centered scheme that 55 55 !! conserve kinetic energy. Compute the now horizontal kinetic energy 56 !! zhke = 1/2 [ mi-1( u n^2 ) + mj-1( vn^2 ) ]56 !! zhke = 1/2 [ mi-1( uu(:,:,:,ktlev)^2 ) + mj-1( vv(:,:,:,ktlev)^2 ) ] 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 * u n^2 + ((un(j+1)+un(j-1))/2)^2 )60 !! + mj-1( 2 * v n^2 + ((vn(i+1)+vn(i-1))/2)^2 ) ]59 !! zhke = 1/6 [ mi-1( 2 * uu(:,:,:,ktlev)^2 + ((uu(j+1,ktlev)+uu(j-1,ktlev))/2)^2 ) 60 !! + mj-1( 2 * vv(:,:,:,ktlev)^2 + ((vv(i+1,ktlev)+vv(i-1,ktlev))/2)^2 ) ] 61 61 !! 62 62 !! Take its horizontal gradient and add it to the general momentum 63 !! trend ( ua,va).64 !! ua = ua- 1/e1u di[ zhke ]65 !! va = va- 1/e2v dj[ zhke ]63 !! trend (pu_rhs,pv_rhs). 64 !! pu_rhs = pu_rhs - 1/e1u di[ zhke ] 65 !! pv_rhs = pv_rhs - 1/e2v dj[ zhke ] 66 66 !! 67 !! ** Action : - Update the ( ua, va) with the hor. ke gradient trend67 !! ** Action : - Update the (pu_rhs, pv_rhs) with the hor. ke gradient trend 68 68 !! - send this trends to trd_dyn (l_trddyn=T) for post-processing 69 69 !! … … 72 72 !!---------------------------------------------------------------------- 73 73 INTEGER, INTENT( in ) :: kt ! ocean time-step index 74 INTEGER, INTENT( in ) :: ktlev ! time level index for source terms 74 75 INTEGER, INTENT( in ) :: kscheme ! =0/1 type of KEG scheme 76 REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 75 77 ! 76 78 INTEGER :: ji, jj, jk, jb ! dummy loop indices … … 92 94 IF( l_trddyn ) THEN ! Save the input trends 93 95 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 94 ztrdu(:,:,:) = ua(:,:,:)95 ztrdv(:,:,:) = va(:,:,:)96 ztrdu(:,:,:) = pu_rhs(:,:,:) 97 ztrdv(:,:,:) = pv_rhs(:,:,:) 96 98 ENDIF 97 99 … … 109 111 ij = idx_bdy(ib_bdy)%nbj(jb,igrd) 110 112 ifu = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 111 u n(ii-ifu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk)113 uu(ii-ifu,ij,jk,ktlev) = uu(ii,ij,jk,ktlev) * umask(ii,ij,jk) 112 114 END DO 113 115 END DO … … 119 121 ij = idx_bdy(ib_bdy)%nbj(jb,igrd) 120 122 ifv = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 121 v n(ii,ij-ifv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk)123 vv(ii,ij-ifv,jk,ktlev) = vv(ii,ij,jk,ktlev) * vmask(ii,ij,jk) 122 124 END DO 123 125 END DO … … 132 134 DO jj = 2, jpj 133 135 DO ji = fs_2, jpi ! vector opt. 134 zu = u n(ji-1,jj ,jk) * un(ji-1,jj ,jk) &135 & + u n(ji ,jj ,jk) * un(ji ,jj ,jk)136 zv = v n(ji ,jj-1,jk) * vn(ji ,jj-1,jk) &137 & + v n(ji ,jj ,jk) * vn(ji ,jj ,jk)136 zu = uu(ji-1,jj ,jk,ktlev) * uu(ji-1,jj ,jk,ktlev) & 137 & + uu(ji ,jj ,jk,ktlev) * uu(ji ,jj ,jk,ktlev) 138 zv = vv(ji ,jj-1,jk,ktlev) * vv(ji ,jj-1,jk,ktlev) & 139 & + vv(ji ,jj ,jk,ktlev) * vv(ji ,jj ,jk,ktlev) 138 140 zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 139 141 END DO … … 145 147 DO jj = 2, jpjm1 146 148 DO ji = fs_2, jpim1 ! vector opt. 147 zu = 8._wp * ( u n(ji-1,jj ,jk) * un(ji-1,jj ,jk) &148 & + u n(ji ,jj ,jk) * un(ji ,jj ,jk) ) &149 & + ( u n(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) &150 & + ( u n(ji ,jj-1,jk) + un(ji ,jj+1,jk) ) * ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) )149 zu = 8._wp * ( uu(ji-1,jj ,jk,ktlev) * uu(ji-1,jj ,jk,ktlev) & 150 & + uu(ji ,jj ,jk,ktlev) * uu(ji ,jj ,jk,ktlev) ) & 151 & + ( uu(ji-1,jj-1,jk,ktlev) + uu(ji-1,jj+1,jk,ktlev) ) * ( uu(ji-1,jj-1,jk,ktlev) + uu(ji-1,jj+1,jk,ktlev) ) & 152 & + ( uu(ji ,jj-1,jk,ktlev) + uu(ji ,jj+1,jk,ktlev) ) * ( uu(ji ,jj-1,jk,ktlev) + uu(ji ,jj+1,jk,ktlev) ) 151 153 ! 152 zv = 8._wp * ( v n(ji ,jj-1,jk) * vn(ji ,jj-1,jk) &153 & + v n(ji ,jj ,jk) * vn(ji ,jj ,jk) ) &154 & + ( v n(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) &155 & + ( v n(ji-1,jj ,jk) + vn(ji+1,jj ,jk) ) * ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) )154 zv = 8._wp * ( vv(ji ,jj-1,jk,ktlev) * vv(ji ,jj-1,jk,ktlev) & 155 & + vv(ji ,jj ,jk,ktlev) * vv(ji ,jj ,jk,ktlev) ) & 156 & + ( vv(ji-1,jj-1,jk,ktlev) + vv(ji+1,jj-1,jk,ktlev) ) * ( vv(ji-1,jj-1,jk,ktlev) + vv(ji+1,jj-1,jk,ktlev) ) & 157 & + ( vv(ji-1,jj ,jk,ktlev) + vv(ji+1,jj ,jk,ktlev) ) * ( vv(ji-1,jj ,jk,ktlev) + vv(ji+1,jj ,jk,ktlev) ) 156 158 zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 157 159 END DO … … 164 166 IF (ln_bdy) THEN 165 167 ! restore velocity masks at points outside boundary 166 u n(:,:,:) = un(:,:,:) * umask(:,:,:)167 v n(:,:,:) = vn(:,:,:) * vmask(:,:,:)168 uu(:,:,:,ktlev) = uu(:,:,:,ktlev) * umask(:,:,:) 169 vv(:,:,:,ktlev) = vv(:,:,:,ktlev) * vmask(:,:,:) 168 170 ENDIF 169 171 … … 172 174 DO jj = 2, jpjm1 173 175 DO ji = fs_2, fs_jpim1 ! vector opt. 174 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)175 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)176 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 177 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 176 178 END DO 177 179 END DO … … 179 181 ! 180 182 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 181 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)182 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)183 ztrdu(:,:,:) = pu_rhs(:,:,:) - ztrdu(:,:,:) 184 ztrdv(:,:,:) = pv_rhs(:,:,:) - ztrdv(:,:,:) 183 185 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 184 186 DEALLOCATE( ztrdu , ztrdv )
Note: See TracChangeset
for help on using the changeset viewer.