Changeset 12489 for NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90
- Timestamp:
- 2020-02-28T16:55:11+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90
r12377 r12489 209 209 IF( ln_vvl_ztilde_as_zstar ) THEN ! z-star emulation using z-tile 210 210 frq_rst_e3t(:,:) = 0._wp !Ignore namelist settings 211 frq_rst_hdv(:,:) = 1._wp / r dt211 frq_rst_hdv(:,:) = 1._wp / rn_Dt 212 212 ENDIF 213 213 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator … … 222 222 ! values inside the equatorial band (ztilde as zstar) 223 223 frq_rst_e3t(ji,jj) = 0.0_wp 224 frq_rst_hdv(ji,jj) = 1.0_wp / r dt224 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 225 225 ELSE ! transition band (2.5 to 6 degrees N/S) 226 226 ! ! (linearly transition from z-tilde to z-star) … … 228 228 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 229 229 & * 180._wp / 3.5_wp ) ) 230 frq_rst_hdv(ji,jj) = (1.0_wp / r dt) &231 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / r dt) )*0.5_wp &230 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 231 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 232 232 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 233 233 & * 180._wp / 3.5_wp ) ) … … 240 240 ij0 = 128 ; ij1 = 135 ; 241 241 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 242 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / r dt242 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt 243 243 ENDIF 244 244 ENDIF … … 295 295 INTEGER :: ji, jj, jk ! dummy loop indices 296 296 INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers 297 REAL(wp) :: z 2dt, z_tmin, z_tmax! local scalars297 REAL(wp) :: z_tmin, z_tmax ! local scalars 298 298 LOGICAL :: ll_do_bclinic ! local logical 299 299 REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv … … 349 349 IF( kt > nit000 ) THEN 350 350 DO jk = 1, jpkm1 351 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - r dt * frq_rst_hdv(:,:) &351 hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rn_Dt * frq_rst_hdv(:,:) & 352 352 & * ( hdiv_lf(:,:,jk) - e3t(:,:,jk,Kmm) * ( hdiv(:,:,jk) - zhdiv(:,:) ) ) 353 353 END DO … … 418 418 ! Leapfrog time stepping 419 419 ! ~~~~~~~~~~~~~~~~~~~~~~ 420 IF( neuler == 0 .AND. kt == nit000 ) THEN421 z2dt = rdt422 ELSE423 z2dt = 2.0_wp * rdt424 ENDIF425 420 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 426 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:)421 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 427 422 428 423 ! Maximum deformation control … … 610 605 ! - ML - e3(t/u/v)_b are allready computed in dynnxt. 611 606 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 612 IF( neuler == 0 .AND. kt == nit000) THEN607 IF( l_1st_euler ) THEN 613 608 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 614 609 ELSE 615 610 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 616 & + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) )611 & + rn_atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 617 612 ENDIF 618 613 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) … … 827 822 e3t(:,:,:,Kbb) = e3t_0(:,:,:) 828 823 END WHERE 829 IF( neuler == 0) THEN824 IF( l_1st_euler ) THEN 830 825 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 831 826 ENDIF … … 833 828 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 834 829 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 835 IF(lwp) write(numout,*) ' neuler is forced to 0'830 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 836 831 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 837 832 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 838 neuler = 0833 l_1st_euler = .true. 839 834 ELSE IF( id2 > 0 ) THEN 840 835 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 841 836 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 842 IF(lwp) write(numout,*) ' neuler is forced to 0'837 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 843 838 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 844 839 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 845 neuler = 0840 l_1st_euler = .true. 846 841 ELSE 847 842 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 848 843 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 849 IF(lwp) write(numout,*) ' neuler is forced to 0'844 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.' 850 845 DO jk = 1, jpk 851 846 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & … … 854 849 END DO 855 850 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 856 neuler = 0851 l_1st_euler = .true. 857 852 ENDIF 858 853 ! ! ----------- ! … … 1015 1010 WRITE(numout,*) ' rn_rst_e3t = 0.e0' 1016 1011 WRITE(numout,*) ' hard-wired : z-tilde cutoff frequency of low-pass filter (days)' 1017 WRITE(numout,*) ' rn_lf_cutoff = 1.0/r dt'1012 WRITE(numout,*) ' rn_lf_cutoff = 1.0/rn_Dt' 1018 1013 ELSE 1019 1014 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.