- Timestamp:
- 2017-12-05T14:06:56+01:00 (6 years ago)
- Location:
- branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM
- Files:
-
- 9 edited
-
CONFIG/SHARED/namelist_ref (modified) (1 diff)
-
NEMO/NST_SRC/agrif_opa_update.F90 (modified) (10 diffs)
-
NEMO/OPA_SRC/DOM/dom_oce.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynnxt.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynspg.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynspg_ts.F90 (modified) (8 diffs)
-
NEMO/OPA_SRC/DYN/sshwzv.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/nemogcm.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/oce.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/CONFIG/SHARED/namelist_ref
r8599 r8898 835 835 rn_bt_cmax = 0.8 ! =T : the Maximum Courant Number allowed 836 836 nn_baro = 30 ! =F : the number of sub-step in rn_rdt seconds 837 rn_bt_alpha = 0.1 ! Temporal diffusion parameter (if ln_bt_av=F) 837 838 / 838 839 !----------------------------------------------------------------------- -
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r8803 r8898 103 103 ! 104 104 nbcline = nbcline + 1 105 ! 106 # if ! defined DECAL_FEEDBACK 107 ! Account for updated thicknesses at boundary edges 108 IF (.NOT.ln_linssh) THEN 109 CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_u_bdy) 110 CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_v_bdy) 111 ENDIF 112 # endif 105 113 ! 106 114 IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN … … 379 387 ! 380 388 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 381 zub = ub(ji,jj,jk) * e3u_b(ji,jj,jk) 389 zub = ub(ji,jj,jk) * e3u_b(ji,jj,jk) ! fse3t_b prior update should be used 382 390 zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk) 383 391 zunu = tabres(ji,jj,jk) … … 399 407 END SUBROUTINE updateu 400 408 409 SUBROUTINE correct_u_bdy( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 410 !!--------------------------------------------- 411 !! *** ROUTINE correct_u_bdy *** 412 !!--------------------------------------------- 413 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 414 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 415 LOGICAL , INTENT(in ) :: before 416 INTEGER , INTENT(in) :: nb, ndir 417 !! 418 LOGICAL :: western_side, eastern_side 419 ! 420 INTEGER :: jj, jk 421 REAL(wp) :: zcor 422 !!--------------------------------------------- 423 ! 424 IF( .NOT.before ) THEN 425 ! 426 western_side = (nb == 1).AND.(ndir == 1) 427 eastern_side = (nb == 1).AND.(ndir == 2) 428 ! 429 IF (western_side) THEN 430 DO jj=j1,j2 431 zcor = un_b(i1-1,jj) * hu_a(i1-1,jj) * r1_hu_n(i1-1,jj) - un_b(i1-1,jj) 432 un_b(i1-1,jj) = un_b(i1-1,jj) + zcor 433 DO jk=1,jpkm1 434 un(i1-1,jj,jk) = un(i1-1,jj,jk) + zcor * umask(i1-1,jj,jk) 435 END DO 436 END DO 437 ENDIF 438 ! 439 IF (eastern_side) THEN 440 DO jj=j1,j2 441 zcor = un_b(i2+1,jj) * hu_a(i2+1,jj) * r1_hu_n(i2+1,jj) - un_b(i2+1,jj) 442 un_b(i2+1,jj) = un_b(i2+1,jj) + zcor 443 DO jk=1,jpkm1 444 un(i2+1,jj,jk) = un(i2+1,jj,jk) + zcor * umask(i2+1,jj,jk) 445 END DO 446 END DO 447 ENDIF 448 ! 449 ENDIF 450 ! 451 END SUBROUTINE correct_u_bdy 452 401 453 402 454 SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before) … … 428 480 ! 429 481 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 430 zvb = vb(ji,jj,jk) * e3v_b(ji,jj,jk) 482 zvb = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used 431 483 zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk) 432 484 zvnu = tabres(ji,jj,jk) … … 447 499 ! 448 500 END SUBROUTINE updatev 501 502 SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 503 !!--------------------------------------------- 504 !! *** ROUTINE correct_u_bdy *** 505 !!--------------------------------------------- 506 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 507 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 508 LOGICAL , INTENT(in ) :: before 509 INTEGER , INTENT(in) :: nb, ndir 510 !! 511 LOGICAL :: southern_side, northern_side 512 ! 513 INTEGER :: ji, jk 514 REAL(wp) :: zcor 515 !!--------------------------------------------- 516 ! 517 IF( .NOT.before ) THEN 518 ! 519 southern_side = (nb == 2).AND.(ndir == 1) 520 northern_side = (nb == 2).AND.(ndir == 2) 521 ! 522 IF (southern_side) THEN 523 DO ji=i1,i2 524 zcor = vn_b(ji,j1-1) * hv_a(ji,j1-1) * r1_hv_n(ji,j1-1) - vn_b(ji,j1-1) 525 vn_b(ji,j1-1) = vn_b(ji,j1-1) + zcor 526 DO jk=1,jpkm1 527 vn(ji,j1-1,jk) = vn(ji,j1-1,jk) + zcor * vmask(ji,j1-1,jk) 528 END DO 529 END DO 530 ENDIF 531 ! 532 IF (northern_side) THEN 533 DO ji=i1,i2 534 zcor = vn_b(ji,j2+1) * hv_a(ji,j2+1) * r1_hv_n(ji,j2+1) - vn_b(ji,j2+1) 535 vn_b(ji,j2+1) = vn_b(ji,j2+1) + zcor 536 DO jk=1,jpkm1 537 vn(ji,j2+1,jk) = vn(ji,j2+1,jk) + zcor * vmask(ji,j2+1,jk) 538 END DO 539 END DO 540 ENDIF 541 ! 542 ENDIF 543 ! 544 END SUBROUTINE correct_v_bdy 449 545 450 546 … … 602 698 END DO 603 699 ELSE 604 IF ( (.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_exp)) & 605 & .OR.(.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_ts & 606 & .AND.(.NOT.ln_bt_fw)))) THEN 607 ! tsplit_new 608 ! IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 700 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 609 701 DO jj=j1,j2 610 702 DO ji=i1,i2 … … 662 754 ub2_i_b(ji,jj) = ub2_i_b(ji,jj) + za1 * zcor 663 755 ! Update corrective fluxes: 664 ! tsplit_new 665 ! un_bf(ji,jj) = un_bf(ji,jj) + zcor 756 un_bf(ji,jj) = un_bf(ji,jj) + zcor 666 757 ! Update half step back fluxes: 667 758 ub2_b(ji,jj) = tabres(ji,jj) … … 720 811 END SUBROUTINE reflux_sshu 721 812 722 723 813 SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 724 814 !!--------------------------------------------- … … 752 842 vb2_i_b(ji,jj) = vb2_i_b(ji,jj) + za1 * zcor 753 843 ! Update corrective fluxes: 754 ! tsplit_new 755 ! vn_bf(ji,jj) = vn_bf(ji,jj) + zcor 844 vn_bf(ji,jj) = vn_bf(ji,jj) + zcor 756 845 ! Update half step back fluxes: 757 846 vb2_b(ji,jj) = tabres(ji,jj) … … 952 1041 ! hdivn(i1:i2,j1:j2,1:jpkm1) = e3t_b(i1:i2,j1:j2,1:jpkm1) 953 1042 954 IF ( (.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_exp)) & 955 & .OR.(.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_ts & 956 & .AND.(.NOT.ln_bt_fw)))) THEN 957 ! tsplit_new 958 ! IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 959 1043 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 960 1044 DO jk = 1, jpkm1 961 1045 DO jj=j1,j2 -
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r7914 r8898 53 53 INTEGER, PUBLIC :: nn_baro !: Number of barotropic iterations during one baroclinic step (rdt) 54 54 REAL(wp), PUBLIC :: rn_bt_cmax !: Maximum allowed courant number (used if ln_bt_auto=T) 55 REAL(wp), PUBLIC :: rn_bt_alpha !: Time stepping diffusion parameter 55 56 56 57 -
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r8741 r8898 209 209 ! (used as a now filtered scale factor until the swap) 210 210 ! ---------------------------------------------------- 211 IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN ! No asselin filtering on thicknesses if forward time splitting 212 e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 213 ELSE 214 DO jk = 1, jpkm1 215 e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 211 DO jk = 1, jpkm1 212 e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 213 END DO 214 ! Add volume filter correction: compatibility with tracer advection scheme 215 ! => time filter + conservation correction (only at the first level) 216 zcoef = atfp * rdt * r1_rau0 217 IF ( .NOT. ln_isf ) THEN ! if no ice shelf melting 218 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 219 & - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 220 ELSE ! if ice shelf melting 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 ikt = mikt(ji,jj) 224 e3t_b(ji,jj,ikt) = e3t_b(ji,jj,ikt) - zcoef * ( emp_b (ji,jj) - emp (ji,jj) & 225 & - rnf_b (ji,jj) + rnf (ji,jj) & 226 & + fwfisf_b(ji,jj) - fwfisf(ji,jj) ) * tmask(ji,jj,ikt) 227 END DO 216 228 END DO 217 ! Add volume filter correction: compatibility with tracer advection scheme 218 ! => time filter + conservation correction (only at the first level) 219 zcoef = atfp * rdt * r1_rau0 220 IF ( .NOT. ln_isf ) THEN ! if no ice shelf melting 221 e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 222 & - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 223 ELSE ! if ice shelf melting 224 DO jj = 1, jpj 225 DO ji = 1, jpi 226 ikt = mikt(ji,jj) 227 e3t_b(ji,jj,ikt) = e3t_b(ji,jj,ikt) - zcoef * ( emp_b (ji,jj) - emp (ji,jj) & 228 & - rnf_b (ji,jj) + rnf (ji,jj) & 229 & + fwfisf_b(ji,jj) - fwfisf(ji,jj) ) * tmask(ji,jj,ikt) 230 END DO 231 END DO 232 END IF 233 ENDIF 229 END IF 234 230 ! 235 231 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity -
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7753 r8898 183 183 NAMELIST/namdyn_spg/ ln_dynspg_exp , ln_dynspg_ts, & 184 184 & ln_bt_fw, ln_bt_av , ln_bt_auto , & 185 & nn_baro , rn_bt_cmax, nn_bt_flt 185 & nn_baro , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 186 186 !!---------------------------------------------------------------------- 187 187 ! -
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r8762 r8898 67 67 PUBLIC ts_rst ! " " " " 68 68 69 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro70 REAL(wp),SAVE :: rdtbt ! Barotropic time step69 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro 70 REAL(wp),SAVE :: rdtbt ! Barotropic time step 71 71 72 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1, wgtbtp2 !: 1st & 2nd weights used in time filtering of barotropic fields … … 151 151 REAL(wp) :: zhura, zhvra ! - - 152 152 REAL(wp) :: za0, za1, za2, za3 ! - - 153 !153 REAL(wp) :: zepsilon, zgamma ! - - 154 154 REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e 155 155 REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc … … 759 759 za3= 0._wp 760 760 ELSE ! AB3-AM4 Coefficients; bet=0.281105 ; eps=0.013 ; gam=0.0880 761 za0=0.614_wp ! za0 = 1/2 + gam + 2*eps 762 za1=0.285_wp ! za1 = 1/2 - 2*gam - 3*eps 763 za2=0.088_wp ! za2 = gam 764 za3=0.013_wp ! za3 = eps 761 IF (rn_bt_alpha==0._wp) THEN 762 za0=0.614_wp ! za0 = 1/2 + gam + 2*eps 763 za1=0.285_wp ! za1 = 1/2 - 2*gam - 3*eps 764 za2=0.088_wp ! za2 = gam 765 za3=0.013_wp ! za3 = eps 766 ELSE 767 zepsilon = 0.00976186_wp - 0.13451357_wp * rn_bt_alpha 768 zgamma = 0.08344500_wp - 0.51358400_wp * rn_bt_alpha 769 za0 = 0.5_wp + zgamma + 2._wp * rn_bt_alpha + 2._wp * zepsilon 770 za1 = 1._wp - za0 - zgamma - zepsilon 771 za2 = zgamma 772 za3 = zepsilon 773 ENDIF 765 774 ENDIF 766 775 ! … … 1024 1033 zwy(:,:) = vn_adv(:,:) 1025 1034 IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN 1026 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) 1027 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) 1028 END IF 1035 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) - atfp * un_bf(:,:) ) 1036 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) - atfp * vn_bf(:,:) ) 1037 ! 1038 ! Update corrective fluxes for next time step: 1039 un_bf(:,:) = atfp * un_bf(:,:) + (zwx(:,:) - ub2_b(:,:)) 1040 vn_bf(:,:) = atfp * vn_bf(:,:) + (zwy(:,:) - vb2_b(:,:)) 1041 ELSE 1042 un_bf(:,:) = 0._wp 1043 vn_bf(:,:) = 0._wp 1044 END IF 1029 1045 ! Save integrated transport for next computation 1030 1046 ub2_b(:,:) = zwx(:,:) … … 1198 1214 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) ) 1199 1215 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) ) 1216 CALL iom_get( numror, jpdom_autoglo, 'un_bf' , un_bf (:,:) ) 1217 CALL iom_get( numror, jpdom_autoglo, 'vn_bf' , vn_bf (:,:) ) 1200 1218 IF( .NOT.ln_bt_av ) THEN 1201 1219 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:) ) … … 1217 1235 CALL iom_rstput( kt, nitrst, numrow, 'ub2_b' , ub2_b (:,:) ) 1218 1236 CALL iom_rstput( kt, nitrst, numrow, 'vb2_b' , vb2_b (:,:) ) 1237 CALL iom_rstput( kt, nitrst, numrow, 'un_bf' , un_bf (:,:) ) 1238 CALL iom_rstput( kt, nitrst, numrow, 'vn_bf' , vn_bf (:,:) ) 1219 1239 ! 1220 1240 IF (.NOT.ln_bt_av) THEN … … 1295 1315 #if defined key_agrif 1296 1316 ! Restrict the use of Agrif to the forward case only 1297 IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() ) CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' )1317 !!! IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() ) CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' ) 1298 1318 #endif 1299 1319 ! … … 1311 1331 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1312 1332 ! 1333 IF(lwp) WRITE(numout,*) ' Time diffusion parameter rn_bt_alpha: ', rn_bt_alpha 1334 IF ((ln_bt_av.AND.nn_bt_flt/=0).AND.(rn_bt_alpha>0._wp)) THEN 1335 CALL ctl_stop( 'dynspg_ts ERROR: if rn_bt_alpha > 0, remove temporal averaging' ) 1336 ENDIF 1337 ! 1313 1338 IF( .NOT.ln_bt_av .AND. .NOT.ln_bt_fw ) THEN 1314 1339 CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' ) -
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r8741 r8898 260 260 ENDIF 261 261 ! !== Euler time-stepping: no filter, just swap ==! 262 IF( ( neuler == 0 .AND. kt == nit000 ) .OR. & 263 & ( ln_bt_fw .AND. ln_dynspg_ts ) ) THEN 262 IF ( neuler == 0 .AND. kt == nit000 ) THEN 264 263 sshb(:,:) = sshn(:,:) ! before <-- now 265 264 sshn(:,:) = ssha(:,:) ! now <-- after (before already = now) -
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r8570 r8898 606 606 & 'Compile with key_nosignedzero enabled' ) 607 607 ! 608 #if defined key_agrif 609 IF( nn_timing == 1 ) CALL ctl_stop( 'AGRIF not implemented with nn_timing = 1') 610 #endif 611 ! 608 612 END SUBROUTINE nemo_ctl 609 613 -
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/oce.F90
r7646 r8898 45 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hvr_e !: inverse of v-depth 46 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b , vb2_b !: Half step fluxes (ln_bt_fw=T) 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_bf , vn_bf !: Asselin filtered half step fluxes (ln_bt_fw=T) 47 48 #if defined key_agrif 48 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_i_b, vb2_i_b !: Half step time integrated fluxes … … 119 120 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT=ierr(5) ) 120 121 ! 121 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj) 122 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj) , STAT=ierr(6) ) 122 123 #if defined key_agrif 123 124 ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , STAT=ierr(7) )
Note: See TracChangeset
for help on using the changeset viewer.
