Changeset 12489 for NEMO/trunk/src/OCE/DOM/domvvl.F90
- Timestamp:
- 2020-02-28T16:55:11+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DOM/domvvl.F90
r12377 r12489 235 235 IF( ln_vvl_ztilde_as_zstar ) THEN ! z-star emulation using z-tile 236 236 frq_rst_e3t(:,:) = 0._wp !Ignore namelist settings 237 frq_rst_hdv(:,:) = 1._wp / r dt237 frq_rst_hdv(:,:) = 1._wp / rn_Dt 238 238 ENDIF 239 239 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator … … 247 247 ! values inside the equatorial band (ztilde as zstar) 248 248 frq_rst_e3t(ji,jj) = 0.0_wp 249 frq_rst_hdv(ji,jj) = 1.0_wp / r dt249 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 250 250 ELSE ! transition band (2.5 to 6 degrees N/S) 251 251 ! ! (linearly transition from z-tilde to z-star) … … 253 253 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 254 254 & * 180._wp / 3.5_wp ) ) 255 frq_rst_hdv(ji,jj) = (1.0_wp / r dt) &256 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / r dt) )*0.5_wp &255 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 256 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 257 257 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 258 258 & * 180._wp / 3.5_wp ) ) … … 264 264 ij0 = 128 ; ij1 = 135 ; 265 265 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 266 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / r dt266 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt 267 267 ENDIF 268 268 ENDIF … … 319 319 INTEGER :: ji, jj, jk ! dummy loop indices 320 320 INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers 321 REAL(wp) :: z 2dt, z_tmin, z_tmax! local scalars321 REAL(wp) :: z_tmin, z_tmax ! local scalars 322 322 LOGICAL :: ll_do_bclinic ! local logical 323 323 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv … … 373 373 IF( kt > nit000 ) THEN 374 374 DO jk = 1, jpkm1 375 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - r dt * frq_rst_hdv(:,:) &375 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rn_Dt * frq_rst_hdv(:,:) & 376 376 & * ( hdiv_lf(:,:,jk) - e3t(:,:,jk,Kmm) * ( hdiv(:,:,jk) - zhdiv(:,:) ) ) 377 377 END DO … … 430 430 ! 4 - Time stepping of baroclinic scale factors 431 431 ! --------------------------------------------- 432 ! Leapfrog time stepping433 ! ~~~~~~~~~~~~~~~~~~~~~~434 IF( neuler == 0 .AND. kt == nit000 ) THEN435 z2dt = rdt436 ELSE437 z2dt = 2.0_wp * rdt438 ENDIF439 432 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 440 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:)433 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 441 434 442 435 ! Maximum deformation control … … 624 617 ! - ML - e3(t/u/v)_b are allready computed in dynnxt. 625 618 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 626 IF( neuler == 0 .AND. kt == nit000) THEN619 IF( l_1st_euler ) THEN 627 620 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 628 621 ELSE 629 622 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 630 & + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) )623 & + rn_atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 631 624 ENDIF 632 625 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) … … 821 814 e3t(:,:,:,Kbb) = e3t_0(:,:,:) 822 815 END WHERE 823 IF( neuler == 0) THEN816 IF( l_1st_euler ) THEN 824 817 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 825 818 ENDIF … … 827 820 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 828 821 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 829 IF(lwp) write(numout,*) ' neuler is forced to 0'822 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 830 823 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 831 824 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 832 neuler = 0825 l_1st_euler = .true. 833 826 ELSE IF( id2 > 0 ) THEN 834 827 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 835 828 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 836 IF(lwp) write(numout,*) ' neuler is forced to 0'829 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 837 830 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 838 831 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 839 neuler = 0832 l_1st_euler = .true. 840 833 ELSE 841 834 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 842 835 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 843 IF(lwp) write(numout,*) ' neuler is forced to 0'836 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 844 837 DO jk = 1, jpk 845 838 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & … … 848 841 END DO 849 842 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 850 neuler = 0843 l_1st_euler = .true. 851 844 ENDIF 852 845 ! ! ----------- ! … … 1008 1001 WRITE(numout,*) ' rn_rst_e3t = 0.e0' 1009 1002 WRITE(numout,*) ' hard-wired : z-tilde cutoff frequency of low-pass filter (days)' 1010 WRITE(numout,*) ' rn_lf_cutoff = 1.0/r dt'1003 WRITE(numout,*) ' rn_lf_cutoff = 1.0/rn_Dt' 1011 1004 ELSE 1012 1005 WRITE(numout,*) ' z-tilde to zstar restoration timescale (days) rn_rst_e3t = ', rn_rst_e3t
Note: See TracChangeset
for help on using the changeset viewer.