Changeset 10874 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynldf_lap_blp.F90
- Timestamp:
- 2019-04-15T15:57:37+02: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/dynldf_lap_blp.F90
r10806 r10874 35 35 CONTAINS 36 36 37 SUBROUTINE dyn_ldf_lap( kt, ktlev1, ktlev2, pu, pv, pu_rhs, pva_rhs, kpass )37 SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass ) 38 38 !!---------------------------------------------------------------------- 39 39 !! *** ROUTINE dyn_ldf_lap *** … … 45 45 !! writen as : grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) ) 46 46 !! 47 !! ** Action : - pu _rhs, pva_rhs increased by the harmonic operator applied on pu, pv.47 !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb. 48 48 !!---------------------------------------------------------------------- 49 INTEGER , INTENT(in ) :: kt ! ocean time-step index 50 INTEGER , INTENT(in ) :: ktlev1, ktlev2 ! time level index for scale factors 49 INTEGER , INTENT(in ) :: kt ! ocean time-step index 51 50 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 52 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu , pv! before velocity [m/s]53 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu _rhs, pva_rhs! velocity trend [m/s2]51 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity [m/s] 52 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! velocity trend [m/s2] 54 53 ! 55 54 INTEGER :: ji, jj, jk ! dummy loop indices … … 77 76 !!gm open question here : e3f at before or now ? probably now... 78 77 !!gm note that ahmf has already been multiplied by fmask 79 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f (ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) &80 & * ( e2v(ji ,jj-1) * pv (ji ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk) &81 & - e1u(ji-1,jj ) * pu (ji-1,jj ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk) )78 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f_n(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & 79 & * ( e2v(ji ,jj-1) * pvb(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk) & 80 & - e1u(ji-1,jj ) * pub(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk) ) 82 81 ! ! ahm * div (computed from 2 to jpi/jpj) 83 82 !!gm note that ahmt has already been multiplied by tmask 84 zdiv(ji,jj) = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t (ji,jj,jk,ktlev1) &85 & * ( e2u(ji,jj)*e3u (ji,jj,jk,ktlev1) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,ktlev1) * pu(ji-1,jj,jk) &86 & + e1v(ji,jj)*e3v (ji,jj,jk,ktlev1) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,ktlev1) * pv(ji,jj-1,jk) )83 zdiv(ji,jj) = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t_b(ji,jj,jk) & 84 & * ( e2u(ji,jj)*e3u_b(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*e3u_b(ji-1,jj,jk) * pub(ji-1,jj,jk) & 85 & + e1v(ji,jj)*e3v_b(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*e3v_b(ji,jj-1,jk) * pvb(ji,jj-1,jk) ) 87 86 END DO 88 87 END DO … … 90 89 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 91 90 DO ji = fs_2, fs_jpim1 ! vector opt. 92 pu _rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * ( &93 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u (ji,jj,jk,ktlev2) &91 pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * ( & 92 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk) & 94 93 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 95 94 ! 96 pva _rhs(ji,jj,jk) = pva_rhs(ji,jj,jk) + zsign * ( &97 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v (ji,jj,jk,ktlev2) &95 pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * ( & 96 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk) & 98 97 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 99 98 END DO … … 106 105 107 106 108 SUBROUTINE dyn_ldf_blp( kt, ktlev1, ktlev2, pu, pv, pu_rhs, pva_rhs)107 SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva ) 109 108 !!---------------------------------------------------------------------- 110 109 !! *** ROUTINE dyn_ldf_blp *** … … 117 116 !! It is computed by two successive calls to dyn_ldf_lap routine 118 117 !! 119 !! ** Action : pt _rhsupdated with the before rotated bilaplacian diffusion118 !! ** Action : pta updated with the before rotated bilaplacian diffusion 120 119 !!---------------------------------------------------------------------- 121 120 INTEGER , INTENT(in ) :: kt ! ocean time-step index 122 INTEGER , INTENT(in ) :: ktlev1, ktlev2 ! time level index for scale factors 123 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv ! before velocity fields 124 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pva_rhs ! momentum trend 121 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pub, pvb ! before velocity fields 122 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend 125 123 ! 126 124 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zulap, zvlap ! laplacian at u- and v-point … … 136 134 zvlap(:,:,:) = 0._wp 137 135 ! 138 CALL dyn_ldf_lap( kt, ktlev1, ktlev2, pu, pv, zulap, zvlap, 1 ) ! rotated laplacian applied to pt(output in zlap)136 CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 ) ! rotated laplacian applied to ptb (output in zlap) 139 137 ! 140 138 CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. ) ! Lateral boundary conditions 141 139 ! 142 CALL dyn_ldf_lap( kt, ktlev1, ktlev2, zulap, zvlap, pu_rhs, pva_rhs, 2 ) ! rotated laplacian applied to zlap (output in pt_rhs)140 CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 ) ! rotated laplacian applied to zlap (output in pta) 143 141 ! 144 142 END SUBROUTINE dyn_ldf_blp
Note: See TracChangeset
for help on using the changeset viewer.
