Changeset 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf_lap_blp.F90
- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DYN/dynldf_lap_blp.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/DYN/dynldf_lap_blp.F90
r10425 r12928 27 27 28 28 !! * Substitutions 29 # include " vectopt_loop_substitute.h90"29 # include "do_loop_substitute.h90" 30 30 !!---------------------------------------------------------------------- 31 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 35 35 CONTAINS 36 36 37 SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass )37 SUBROUTINE dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, 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 a, pva increased by the harmonic operator applied on pub, pvb.47 !! ** Action : - pu_rhs, pv_rhs increased by the harmonic operator applied on pu, pv. 48 48 !!---------------------------------------------------------------------- 49 49 INTEGER , INTENT(in ) :: kt ! ocean time-step index 50 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 50 51 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 51 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu b, pvb! before velocity [m/s]52 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu a, pva! velocity trend [m/s2]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, pv_rhs ! velocity trend [m/s2] 53 54 ! 54 55 INTEGER :: ji, jj, jk ! dummy loop indices … … 71 72 DO jk = 1, jpkm1 ! Horizontal slab 72 73 ! ! =============== 73 DO jj = 2, jpj 74 DO ji = fs_2, jpi ! vector opt. 75 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 76 !!gm open question here : e3f at before or now ? probably now... 77 !!gm note that ahmf has already been multiplied by fmask 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) ) 81 ! ! ahm * div (computed from 2 to jpi/jpj) 82 !!gm note that ahmt has already been multiplied by tmask 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) ) 86 END DO 87 END DO 74 DO_2D_01_01 75 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 76 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & ! ahmf already * by fmask 77 & * ( e2v(ji ,jj-1) * pv(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk) & 78 & - e1u(ji-1,jj ) * pu(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk) ) 79 ! ! ahm * div (computed from 2 to jpi/jpj) 80 zdiv(ji,jj) = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb) & ! ahmt already * by tmask 81 & * ( e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk) & 82 & + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk) ) 83 END_2D 88 84 ! 89 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 90 DO ji = fs_2, fs_jpim1 ! vector opt. 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) & 93 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 94 ! 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) & 97 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 98 END DO 99 END DO 85 DO_2D_00_00 86 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 87 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 88 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 89 ! 90 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * ( & ! * by vmask is mandatory for dyn_ldf_blp use 91 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm) & 92 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 93 END_2D 100 94 ! ! =============== 101 95 END DO ! End of slab … … 105 99 106 100 107 SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva)101 SUBROUTINE dyn_ldf_blp( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs ) 108 102 !!---------------------------------------------------------------------- 109 103 !! *** ROUTINE dyn_ldf_blp *** … … 116 110 !! It is computed by two successive calls to dyn_ldf_lap routine 117 111 !! 118 !! ** Action : pt aupdated with the before rotated bilaplacian diffusion112 !! ** Action : pt(:,:,:,:,Krhs) updated with the before rotated bilaplacian diffusion 119 113 !!---------------------------------------------------------------------- 120 114 INTEGER , INTENT(in ) :: kt ! ocean time-step index 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 115 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 116 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv ! before velocity fields 117 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! momentum trend 123 118 ! 124 119 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zulap, zvlap ! laplacian at u- and v-point … … 134 129 zvlap(:,:,:) = 0._wp 135 130 ! 136 CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 ) ! rotated laplacian applied to ptb (output in zlap)131 CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 ) ! rotated laplacian applied to pt (output in zlap,Kbb) 137 132 ! 138 133 CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. ) ! Lateral boundary conditions 139 134 ! 140 CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 ) ! rotated laplacian applied to zlap (output in pta)135 CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 ) ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 141 136 ! 142 137 END SUBROUTINE dyn_ldf_blp
Note: See TracChangeset
for help on using the changeset viewer.
