- Timestamp:
- 2011-03-15T16:27:46+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r2636 r2690 29 29 USE obc_oce 30 30 USE bdy_oce 31 USE diaar5, ONLY 31 USE diaar5, ONLY: lk_diaar5 32 32 USE iom 33 USE sbcrnf, ONLY : h_rnf, nk_rnf! River runoff33 USE sbcrnf, ONLY: h_rnf, nk_rnf ! River runoff 34 34 #if defined key_agrif 35 35 USE agrif_opa_update … … 52 52 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 53 53 !! $Id$ 54 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 55 !!---------------------------------------------------------------------- 56 54 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 55 !!---------------------------------------------------------------------- 57 56 CONTAINS 58 57 … … 76 75 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 77 76 !!---------------------------------------------------------------------- 78 USE oce, ONLY : z3d => ta ! use ta as 3D workspace79 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released80 USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, z2d => wrk_2d_281 ! !77 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 78 USE oce , ONLY: z3d => ta ! ta used as 3D workspace 79 USE wrk_nemo, ONLY: zhdiv => wrk_2d_1 , z2d => wrk_2d_2 ! 2D workspace 80 ! 82 81 INTEGER, INTENT(in) :: kt ! time step 83 !! 84 INTEGER :: ji, jj, jk ! dummy loop indices 85 REAL(wp) :: zcoefu, zcoefv, zcoeff ! temporary scalars 86 REAL(wp) :: z2dt, z1_2dt, z1_rau0 ! temporary scalars 82 ! 83 INTEGER :: ji, jj, jk ! dummy loop indices 84 REAL(wp) :: zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0 ! local scalars 87 85 !!---------------------------------------------------------------------- 88 86 … … 97 95 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 98 96 ! 99 wn(:,:,jpk) = 0. e0! bottom boundary condition: w=0 (set once for all)97 wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 100 98 ! 101 99 IF( lk_vvl ) THEN ! before and now Sea SSH at u-, v-, f-points (vvl case only) … … 150 148 hv(:,:) = hv_0(:,:) + sshv_n(:,:) 151 149 ! ! now masked inverse of the ocean depth (at u- and v-points) 152 hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1. e0- umask(:,:,1) )153 hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1. e0- vmask(:,:,1) )150 hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) ) 151 hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) ) 154 152 ! 155 153 ENDIF … … 157 155 CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity 158 156 ! 159 z2dt = 2. * rdt! set time step size (Euler/Leapfrog)160 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt157 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) 158 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 161 159 162 160 ! !------------------------------! 163 161 ! ! After Sea Surface Height ! 164 162 ! !------------------------------! 165 zhdiv(:,:) = 0. e0163 zhdiv(:,:) = 0._wp 166 164 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports 167 165 zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) … … 171 169 ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp 172 170 z1_rau0 = 0.5 / rau0 173 ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) & 174 & * tmask(:,:,1) 171 ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask(:,:,1) 175 172 176 173 #if defined key_agrif 177 CALL agrif_ssh( kt)174 CALL agrif_ssh( kt ) 178 175 #endif 179 176 #if defined key_obc 180 177 IF( Agrif_Root() ) THEN 181 178 ssha(:,:) = ssha(:,:) * obctmsk(:,:) 182 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm)179 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 183 180 ENDIF 184 181 #endif … … 200 197 END DO 201 198 END DO 202 ! Boundaries conditions 203 CALL lbc_lnk( sshu_a, 'U', 1. ) 204 CALL lbc_lnk( sshv_a, 'V', 1. ) 205 ENDIF 206 ! Include the IAU weighted SSH increment 199 CALL lbc_lnk( sshu_a, 'U', 1. ) ; CALL lbc_lnk( sshv_a, 'V', 1. ) ! Boundaries conditions 200 ENDIF 201 207 202 #if defined key_asminc 208 IF( ( lk_asminc ).AND.( ln_sshinc ).AND.( ln_asmiau ) ) THEN 203 ! ! Include the IAU weighted SSH increment 204 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 209 205 CALL ssh_asm_inc( kt ) 210 206 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) … … 218 214 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 219 215 ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise 220 wn(:,:,jk) = wn(:,:,jk+1) - 221 & - ( 216 wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) & 217 & - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) & 222 218 & * tmask(:,:,jk) * z1_2dt 223 219 #if defined key_bdy … … 281 277 282 278 ! !--------------------------! 283 IF( lk_vvl ) THEN ! Variable volume levels ! 279 IF( lk_vvl ) THEN ! Variable volume levels ! (ssh at t-, u-, v, f-points) 284 280 ! !--------------------------! 285 281 ! 286 ! ssh at t-, u-, v, f-points 287 !=========================== 288 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step : no filter 289 sshn (:,:) = ssha (:,:) ! now <-- after (before already = now) 282 IF( neuler == 0 .AND. kt == nit000 ) THEN !** Euler time-stepping at first time-step : no filter 283 sshn (:,:) = ssha (:,:) ! now <-- after (before already = now) 290 284 sshu_n(:,:) = sshu_a(:,:) 291 285 sshv_n(:,:) = sshv_a(:,:) 292 DO jj = 1, jpjm1 293 DO ji = 1, jpim1 ! NO Vector Opt. 294 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 295 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 296 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 297 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 298 END DO 299 END DO 300 ! Boundaries conditions 301 CALL lbc_lnk( sshf_n, 'F', 1. ) 302 ELSE ! Leap-Frog time-stepping: Asselin filter + swap 303 zec = atfp * rdt / rau0 304 DO jj = 1, jpj 305 DO ji = 1, jpi ! before <-- now filtered 306 sshb (ji,jj) = sshn (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) & 307 & - zec * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 308 sshn (ji,jj) = ssha (ji,jj) ! now <-- after 309 sshu_n(ji,jj) = sshu_a(ji,jj) 310 sshv_n(ji,jj) = sshv_a(ji,jj) 311 END DO 312 END DO 313 DO jj = 1, jpjm1 286 DO jj = 1, jpjm1 ! ssh now at f-point 314 287 DO ji = 1, jpim1 ! NO Vector Opt. 315 288 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & … … 319 292 END DO 320 293 END DO 321 ! Boundaries conditions 322 CALL lbc_lnk( sshf_n, 'F', 1. ) 323 DO jj = 1, jpjm1 294 CALL lbc_lnk( sshf_n, 'F', 1. ) ! Boundaries conditions 295 ! 296 ELSE !** Leap-Frog time-stepping: Asselin filter + swap 297 zec = atfp * rdt / rau0 298 DO jj = 1, jpj 299 DO ji = 1, jpi ! before <-- now filtered 300 sshb (ji,jj) = sshn (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) & 301 & - zec * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1) 302 sshn (ji,jj) = ssha (ji,jj) ! now <-- after 303 sshu_n(ji,jj) = sshu_a(ji,jj) 304 sshv_n(ji,jj) = sshv_a(ji,jj) 305 END DO 306 END DO 307 DO jj = 1, jpjm1 ! ssh now at f-point 308 DO ji = 1, jpim1 ! NO Vector Opt. 309 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 310 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 311 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 312 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 313 END DO 314 END DO 315 CALL lbc_lnk( sshf_n, 'F', 1. ) ! Boundaries conditions 316 ! 317 DO jj = 1, jpjm1 ! ssh before at u- & v-points 324 318 DO ji = 1, jpim1 ! NO Vector Opt. 325 319 sshu_b(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & … … 331 325 END DO 332 326 END DO 333 ! Boundaries conditions334 327 CALL lbc_lnk( sshu_b, 'U', 1. ) 335 CALL lbc_lnk( sshv_b, 'V', 1. ) 328 CALL lbc_lnk( sshv_b, 'V', 1. ) ! Boundaries conditions 329 ! 336 330 ENDIF 337 331 ! !--------------------------! 338 ELSE ! fixed levels ! 332 ELSE ! fixed levels ! (ssh at t-point only) 339 333 ! !--------------------------! 340 334 ! 341 ! ssh at t-point only 342 !==================== 343 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step : no filter 344 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 345 ! 346 ELSE ! Leap-Frog time-stepping: Asselin filter + swap 335 IF( neuler == 0 .AND. kt == nit000 ) THEN !** Euler time-stepping at first time-step : no filter 336 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) 337 ! 338 ELSE ! Leap-Frog time-stepping: Asselin filter + swap 347 339 DO jj = 1, jpj 348 DO ji = 1, jpi 340 DO ji = 1, jpi ! before <-- now filtered 349 341 sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) 350 sshn(ji,jj) = ssha(ji,jj) 342 sshn(ji,jj) = ssha(ji,jj) ! now <-- after 351 343 END DO 352 344 END DO
Note: See TracChangeset
for help on using the changeset viewer.