Changeset 8010
- Timestamp:
- 2017-05-09T17:36:25+02:00 (8 years ago)
- Location:
- branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
r7988 r8010 35 35 LOGICAL , PUBLIC :: spongedoneU = .FALSE. !: dynamics sponge layer indicator 36 36 LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step 37 LOGICAL , PUBLIC :: lk_agrif_doupd = .TRUE. !: if true: send update from current grid38 37 LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE. !: if true: print debugging info 39 38 -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7988 r8010 972 972 IF( bdy_tinterp == 1 ) THEN 973 973 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 974 & - zt0**2._wp * ( zt0 - 1._wp) )974 & - zt0**2._wp * ( zt0 - 1._wp) ) 975 975 ELSEIF( bdy_tinterp == 2 ) THEN 976 976 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 977 & - zt0 * ( zt0 - 1._wp)**2._wp )977 & - zt0 * ( zt0 - 1._wp)**2._wp ) 978 978 979 979 ELSE … … 1048 1048 IF( bdy_tinterp == 1 ) THEN 1049 1049 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 1050 & - zt0**2._wp * ( zt0 - 1._wp) )1050 & - zt0**2._wp * ( zt0 - 1._wp) ) 1051 1051 ELSEIF( bdy_tinterp == 2 ) THEN 1052 1052 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 1053 & - zt0 * ( zt0 - 1._wp)**2._wp )1053 & - zt0 * ( zt0 - 1._wp)**2._wp ) 1054 1054 1055 1055 ELSE -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r7988 r8010 31 31 CONTAINS 32 32 33 RECURSIVESUBROUTINE Agrif_Update_Tra( )33 SUBROUTINE Agrif_Update_Tra( ) 34 34 !!--------------------------------------------- 35 35 !! *** ROUTINE Agrif_Update_Tra *** … … 60 60 Agrif_UseSpecialValueInUpdate = .FALSE. 61 61 ! 62 IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:63 CALL Agrif_ChildGrid_To_ParentGrid()64 CALL Agrif_Update_Tra()65 CALL Agrif_ParentGrid_To_ChildGrid()66 ENDIF67 !68 62 #endif 69 63 ! 70 64 END SUBROUTINE Agrif_Update_Tra 71 65 72 RECURSIVESUBROUTINE Agrif_Update_Dyn( )66 SUBROUTINE Agrif_Update_Dyn( ) 73 67 !!--------------------------------------------- 74 68 !! *** ROUTINE Agrif_Update_Dyn *** … … 145 139 #endif 146 140 ! 147 ! Do recursive update:148 IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:149 CALL Agrif_ChildGrid_To_ParentGrid()150 CALL Agrif_Update_Dyn()151 CALL Agrif_ParentGrid_To_ChildGrid()152 ENDIF153 !154 141 END SUBROUTINE Agrif_Update_Dyn 155 142 … … 179 166 # endif /* key_zdftke */ 180 167 181 RECURSIVESUBROUTINE Agrif_Update_vvl( )168 SUBROUTINE Agrif_Update_vvl( ) 182 169 !!--------------------------------------------- 183 170 !! *** ROUTINE Agrif_Update_vvl *** … … 205 192 CALL Agrif_ParentGrid_To_ChildGrid() 206 193 ! 207 IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update:208 CALL Agrif_ChildGrid_To_ParentGrid()209 CALL Agrif_Update_vvl()210 CALL Agrif_ParentGrid_To_ChildGrid()211 ENDIF212 !213 194 #endif 214 195 ! … … 232 213 fse3u_a(:,:,:) = fse3u_n(:,:,:) 233 214 fse3v_a(:,:,:) = fse3v_n(:,:,:) 215 ! ua(:,:,:) = fse3u_b(:,:,:) 216 ! va(:,:,:) = fse3v_b(:,:,:) 234 217 hu_a(:,:) = hu(:,:) 235 218 hv_a(:,:) = hv(:,:) … … 290 273 !! 291 274 INTEGER :: ji,jj,jk,jn 275 REAL(wp) :: ztb, ztnu, ztno 292 276 !!--------------------------------------------- 293 277 ! … … 320 304 DO ji=i1,i2 321 305 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 322 tsb(ji,jj,jk,jn) = ( tsb(ji,jj,jk,jn)*fse3t_b(ji,jj,jk) & ! jc: should be fse3t_b prior update 323 & + atfp * ( tabres(ji,jj,jk,jn) & 324 & - tsn(ji,jj,jk,jn)*fse3t_a(ji,jj,jk) ) & 325 & * tmask(ji,jj,jk) ) / fse3t_b(ji,jj,jk) 306 ztb = tsb(ji,jj,jk,jn) * fse3t_b(ji,jj,jk) ! fse3t_b prior update should be used 307 ztnu = tabres(ji,jj,jk,jn) 308 ztno = tsn(ji,jj,jk,jn) * fse3t_a(ji,jj,jk) 309 tsb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 310 & * tmask(ji,jj,jk) / fse3t_b(ji,jj,jk) 326 311 ENDIF 327 312 ENDDO … … 330 315 ENDDO 331 316 ENDIF 317 332 318 DO jn = n1,n2 333 319 DO jk=k1,k2 … … 341 327 END DO 342 328 END DO 329 ! 330 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 331 tsb(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 332 ENDIF 333 ! 343 334 ENDIF 344 335 ! 345 336 END SUBROUTINE updateTS 346 337 347 SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before )338 SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 348 339 !!--------------------------------------------- 349 340 !! *** ROUTINE updateu *** … … 354 345 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 355 346 LOGICAL, INTENT(in) :: before 347 INTEGER, INTENT(in) :: nb , ndir 356 348 !! 349 LOGICAL western_side, eastern_side 357 350 INTEGER :: ji, jj, jk 358 351 REAL(wp) :: zrhoy 352 REAL(wp) :: zub, zunu, zuno 359 353 !!--------------------------------------------- 360 354 ! … … 371 365 tabres = zrhoy * tabres 372 366 ELSE 367 western_side = (nb == 1).AND.(ndir == 1) 368 eastern_side = (nb == 1).AND.(ndir == 2) 373 369 DO jk=k1,k2 374 370 DO jj=j1,j2 … … 377 373 ! 378 374 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 379 ub(ji,jj,jk) = ( ub(ji,jj,jk)*fse3u_b(ji,jj,jk) & ! jc: should be fse3u_b prior update 380 & + atfp * ( tabres(ji,jj,jk) & 381 & - un(ji,jj,jk)*fse3u_a(ji,jj,jk) ) & 382 & * umask(ji,jj,jk) ) / fse3u_b(ji,jj,jk) 375 zub = ub(ji,jj,jk) * fse3u_b(ji,jj,jk) 376 zuno = un(ji,jj,jk) * fse3u_a(ji,jj,jk) 377 zunu = tabres(ji,jj,jk) 378 ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) & 379 & * umask(ji,jj,jk) / fse3u_b(ji,jj,jk) 383 380 ENDIF 384 381 ! … … 387 384 END DO 388 385 END DO 386 ! 387 ! IF (western_side) THEN 388 ! DO jk=k1,k2 389 ! DO jj=j1,j2 390 ! un(i1-1,jj,jk) = un(i1-1,jj,jk) * fse3u_a(i1-1,jj,jk) / fse3u_n(i1-1,jj,jk) 391 ! END DO 392 ! ENDDO 393 ! ENDIF 394 ! IF (eastern_side) THEN 395 ! DO jk=k1,k2 396 ! DO jj=j1,j2 397 ! un(i2+1,jj,jk) = un(i2+1,jj,jk) * fse3u_a(i2+1,jj,jk) / fse3u_n(i2+1,jj,jk) 398 ! END DO 399 ! ENDDO 400 ! ENDIF 401 ! 402 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 403 ub(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2) 404 ENDIF 405 ! 389 406 ENDIF 390 407 ! 391 408 END SUBROUTINE updateu 392 409 393 SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before )410 SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 394 411 !!--------------------------------------------- 395 412 !! *** ROUTINE updatev *** … … 401 418 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres 402 419 LOGICAL :: before 403 !! 420 INTEGER, INTENT(in) :: nb , ndir 421 !! 422 LOGICAL :: northern_side, southern_side 404 423 REAL(wp) :: zrhox 424 REAL(wp) :: zvb, zvnu, zvno 405 425 !!--------------------------------------------- 406 426 ! … … 417 437 tabres = zrhox * tabres 418 438 ELSE 439 southern_side = (nb == 2).AND.(ndir == 1) 440 northern_side = (nb == 2).AND.(ndir == 2) 419 441 DO jk=k1,k2 420 442 DO jj=j1,j2 … … 423 445 ! 424 446 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 425 vb(ji,jj,jk) = ( vb(ji,jj,jk)*fse3v_b(ji,jj,jk) & ! jc: should be fse3v_b prior update 426 & + atfp * ( tabres(ji,jj,jk) & 427 & - vn(ji,jj,jk)*fse3v_a(ji,jj,jk) ) & 428 & * vmask(ji,jj,jk) ) / fse3v_b(ji,jj,jk) 447 zvb = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 448 zvno = vn(ji,jj,jk) * fse3v_a(ji,jj,jk) 449 zvnu = tabres(ji,jj,jk) 450 vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) & 451 & * vmask(ji,jj,jk) / fse3v_b(ji,jj,jk) 429 452 ENDIF 430 453 ! … … 433 456 END DO 434 457 END DO 458 ! 459 ! IF (southern_side) THEN 460 ! DO jk=k1,k2 461 ! DO ji=i1,i2 462 ! vn(ji,j1-1,jk) = vn(ji,j1-1,jk) * fse3v_a(ji,j1-1,jk) / fse3v_n(ji,j1-1,jk) 463 ! END DO 464 ! ENDDO 465 ! ENDIF 466 ! IF (northern_side) THEN 467 ! DO jk=k1,k2 468 ! DO ji=i1,i2 469 ! vn(ji,j2+1,jk) = vn(ji,j2+1,jk) * fse3v_a(ji,j2+1,jk) / fse3v_n(ji,j2+1,jk) 470 ! END DO 471 ! ENDDO 472 ! ENDIF 473 ! 474 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 475 vb(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2) 476 ENDIF 477 ! 435 478 ENDIF 436 479 ! 437 480 END SUBROUTINE updatev 438 481 439 SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before )482 SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before, nb, ndir ) 440 483 !!--------------------------------------------- 441 484 !! *** ROUTINE updateu2d *** … … 446 489 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 447 490 LOGICAL, INTENT(in) :: before 448 !! 491 INTEGER, INTENT(in) :: nb , ndir 492 !! 493 LOGICAL western_side, eastern_side 449 494 INTEGER :: ji, jj, jk 450 495 REAL(wp) :: zrhoy … … 461 506 tabres = zrhoy * tabres 462 507 ELSE 508 western_side = (nb == 1).AND.(ndir == 1) 509 eastern_side = (nb == 1).AND.(ndir == 2) 463 510 DO jj=j1,j2 464 511 DO ji=i1,i2 … … 500 547 END DO 501 548 END DO 549 ! IF (western_side) THEN 550 ! DO jj=j1,j2 551 ! un_b(i1-1,jj) = un_b(i1-1,jj) * hu_a(i1-1,jj) * hur(i1-1,jj) 552 ! END DO 553 ! ENDIF 554 ! IF (eastern_side) THEN 555 ! DO jj=j1,j2 556 ! un_b(i2+1,jj) = un_b(i2+1,jj) * hu_a(i2+1,jj) * hur(i2+1,jj) 557 ! ENDDO 558 ! ENDIF 559 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 560 ub_b(i1:i2,j1:j2) = un_b(i1:i2,j1:j2) 561 ENDIF 502 562 ENDIF 503 563 ! 504 564 END SUBROUTINE updateu2d 505 565 506 SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before )566 SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before, nb, ndir ) 507 567 !!--------------------------------------------- 508 568 !! *** ROUTINE updatev2d *** … … 511 571 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 512 572 LOGICAL, INTENT(in) :: before 573 INTEGER, INTENT(in) :: nb , ndir 513 574 !! 575 LOGICAL :: northern_side, southern_side 514 576 INTEGER :: ji, jj, jk 515 577 REAL(wp) :: zrhox … … 526 588 tabres = zrhox * tabres 527 589 ELSE 590 southern_side = (nb == 2).AND.(ndir == 1) 591 northern_side = (nb == 2).AND.(ndir == 2) 528 592 DO jj=j1,j2 529 593 DO ji=i1,i2 … … 565 629 END DO 566 630 END DO 631 ! 632 ! IF (southern_side) THEN 633 ! DO ji=i1,i2 634 ! vn_b(ji,j1-1) = vn_b(ji,j1-1) * hv_a(ji,j1-1) * hvr(ji,j1-1) 635 ! END DO 636 ! ENDIF 637 ! IF (northern_side) THEN 638 ! DO ji=i1,i2 639 ! vn_b(ji,j2+1) = vn_b(ji,j2+1) * hv_a(ji,j2+1) * hvr(ji,j2+1) 640 ! END DO 641 ! ENDIF 642 ! 643 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 644 vb_b(i1:i2,j1:j2) = vn_b(i1:i2,j1:j2) 645 ENDIF 646 ! 567 647 ENDIF 568 648 ! … … 606 686 END DO 607 687 END DO 688 ! 689 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 690 sshb(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 691 ENDIF 692 ! 608 693 ENDIF 609 694 ! … … 619 704 !! 620 705 INTEGER :: ji, jj 621 REAL(wp) :: zrhoy 706 REAL(wp) :: zrhoy, za1 622 707 !!--------------------------------------------- 623 708 ! … … 631 716 tabres = zrhoy * tabres 632 717 ELSE 718 za1 = 1._wp / REAL(Agrif_rhot(), wp) 719 tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) 633 720 DO jj=j1,j2 634 DO ji=i1,i2 635 ub2_b(ji,jj) = tabres(ji,jj) / e2u(ji,jj) 721 DO ji=i1,i2 722 ub2_i_b(ji,jj) = ub2_i_b(ji,jj) & 723 & + za1 * (tabres(ji,jj) - ub2_b(ji,jj)) 724 ub2_b(ji,jj) = tabres(ji,jj) 636 725 END DO 637 726 END DO … … 649 738 !! 650 739 INTEGER :: ji, jj 651 REAL(wp) :: zrhox 740 REAL(wp) :: zrhox, za1 652 741 !!--------------------------------------------- 653 742 ! … … 661 750 tabres = zrhox * tabres 662 751 ELSE 752 za1 = 1._wp / REAL(Agrif_rhot(), wp) 753 tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) 663 754 DO jj=j1,j2 664 755 DO ji=i1,i2 665 vb2_b(ji,jj) = tabres(ji,jj) / e1v(ji,jj) 756 vb2_i_b(ji,jj) = vb2_i_b(ji,jj) & 757 & + za1 * (tabres(ji,jj) - vb2_b(ji,jj)) 758 vb2_b(ji,jj) = tabres(ji,jj) 666 759 END DO 667 760 END DO … … 800 893 ptab(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 801 894 !< jc tmp: 895 896 ! Save "old" scale factor (prior update) for subsequent asselin correction 897 ! of prognostic variables (needed to update initial state only) 898 fse3t_a(i1:i2,j1:j2,k1:k2) = fse3t_n(i1:i2,j1:j2,k1:k2) 899 ! hdivb(i1:i2,j1:j2,k1:k2) = fse3t_b(i1:i2,j1:j2,k1:k2) 802 900 803 901 #if ! defined key_dynspg_ts … … 839 937 ! ---------------------------- 840 938 ! 841 ! Save "old" scale factor (prior update) for subsequent asselin correction842 ! of prognostic variables (needed to update initial state only)843 fse3t_a(i1:i2,j1:j2,k1:k2) = fse3t_n(i1:i2,j1:j2,k1:k2)844 !845 939 ! Update vertical scale factor at T-points: 846 940 fse3t_n(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2) … … 872 966 END DO 873 967 ! 968 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 969 fse3t_b (i1:i2,j1:j2,1:jpk) = fse3t_n (i1:i2,j1:j2,1:jpk) 970 fse3w_b (i1:i2,j1:j2,1:jpk) = fse3w_n (i1:i2,j1:j2,1:jpk) 971 fsdepw_b(i1:i2,j1:j2,1:jpk) = fsdepw_n(i1:i2,j1:j2,1:jpk) 972 fsdept_b(i1:i2,j1:j2,1:jpk) = fsdept_n(i1:i2,j1:j2,1:jpk) 973 ENDIF 974 ! 874 975 ENDIF 875 976 ! -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r6204 r8010 28 28 CONTAINS 29 29 30 SUBROUTINE Agrif_Update_Trc( kt)30 SUBROUTINE Agrif_Update_Trc( ) 31 31 !!--------------------------------------------- 32 32 !! *** ROUTINE Agrif_Update_Trc *** 33 33 !!--------------------------------------------- 34 INTEGER, INTENT(in) :: kt35 34 !!--------------------------------------------- 36 35 ! 37 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 36 IF (Agrif_Root()) RETURN 37 38 38 #if defined TWO_WAY 39 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update trc from grid Number',Agrif_Fixed(), 'nbcline_trc', nbcline_trc 40 39 41 Agrif_UseSpecialValueInUpdate = .TRUE. 40 42 Agrif_SpecialValueFineGrid = 0. … … 56 58 Agrif_UseSpecialValueInUpdate = .FALSE. 57 59 nbcline_trc = nbcline_trc + 1 60 ! 58 61 #endif 59 62 ! … … 70 73 !! 71 74 INTEGER :: ji,jj,jk,jn 75 REAL(wp) :: ztb, ztnu, ztno 72 76 !!--------------------------------------------- 73 77 ! … … 77 81 DO jj=j1,j2 78 82 DO ji=i1,i2 79 ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 83 !> jc tmp 84 ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * fse3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) 85 ! ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) * fse3t_n(ji,jj,jk) 86 !< jc tmp 80 87 END DO 81 88 END DO … … 83 90 END DO 84 91 ELSE 92 !> jc tmp 93 DO jn = n1,n2 94 ptab(i1:i2,j1:j2,k1:k2,jn) = ptab(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) 95 ENDDO 96 !< jc tmp 97 85 98 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 86 99 ! Add asselin part … … 90 103 DO ji=i1,i2 91 104 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 92 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 93 & + atfp * ( ptab(ji,jj,jk,jn) & 94 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 105 ztb = trb(ji,jj,jk,jn) * fse3t_b(ji,jj,jk) ! fse3t_b prior update should be used 106 ztnu = ptab(ji,jj,jk,jn) 107 ztno = trn(ji,jj,jk,jn) * fse3t_a(ji,jj,jk) 108 trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) & 109 & * tmask(ji,jj,jk) / fse3t_b(ji,jj,jk) 95 110 ENDIF 96 111 ENDDO … … 99 114 ENDDO 100 115 ENDIF 116 101 117 DO jn = n1,n2 102 118 DO jk=k1,k2 … … 104 120 DO ji=i1,i2 105 121 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 106 trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk)122 trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) / fse3t_n(ji,jj,jk) 107 123 END IF 108 124 END DO … … 110 126 END DO 111 127 END DO 128 ! 129 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 130 trb(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 131 ENDIF 132 ! 112 133 ENDIF 113 134 ! -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r7988 r8010 1 #undef UPD_HIGH /* MIX HIGH UPDATE */ 1 2 #if defined key_agrif 2 3 !!---------------------------------------------------------------------- … … 90 91 # if defined key_top 91 92 CALL Agrif_InitValues_cont_top 92 # endif 93 # endif 94 95 nbcline = 0 96 #if defined key_top 97 nbcline_trc = 0 98 #endif 99 100 IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) CALL agrif_Update_ini() 101 102 Agrif_UseSpecialValueInUpdate = .FALSE. 103 93 104 END SUBROUTINE Agrif_initvalues 94 105 … … 150 161 ! 5. Update type 151 162 !--------------- 163 # if defined UPD_HIGH 164 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 165 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 166 #else 152 167 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 153 168 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 154 155 ! High order updates 156 ! CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 157 ! CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 169 #endif 158 170 ! 159 171 END SUBROUTINE agrif_declare_var_dom … … 302 314 ! 303 315 ENDIF 304 ! 305 ! Do update at initialisation because not done before writing restarts 306 ! This would indeed change boundary conditions values at initial time 307 ! hence produce restartability issues. 308 ! Note that update below is recursive (with lk_agrif_doupd=T): 309 ! 310 ! JC: I am not sure if Agrif_MaxLevel() is the "relative" 311 ! or the absolute maximum nesting level...TBC 312 nbcline = 0 313 IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 314 ! NB: Order matters below: 315 IF ( lk_vvl ) CALL Agrif_Update_vvl() 316 CALL Agrif_Update_tra() 317 CALL Agrif_Update_dyn() 318 ENDIF 319 ! 316 317 END SUBROUTINE Agrif_InitValues_cont 318 319 RECURSIVE SUBROUTINE Agrif_Update_ini( ) 320 ! 321 USE dom_oce 322 USE agrif_opa_update 323 #if defined key_top 324 USE agrif_top_update 325 #endif 326 ! 327 IMPLICIT NONE 328 ! 329 IF (Agrif_Root()) RETURN 330 ! 331 IF ( lk_vvl ) CALL Agrif_Update_vvl() 332 CALL Agrif_Update_tra() 333 #if defined key_top 334 CALL Agrif_Update_Trc() 335 #endif 336 CALL Agrif_Update_dyn() 320 337 # if defined key_zdftke 321 338 ! CALL Agrif_Update_tke(0) 322 339 # endif 323 ! 324 Agrif_UseSpecialValueInUpdate = .FALSE.325 lk_agrif_doupd = .FALSE.326 !327 END SUBROUTINE Agrif_InitValues_cont 328 340 341 CALL Agrif_ChildGrid_To_ParentGrid() 342 CALL Agrif_Update_ini() 343 CALL Agrif_ParentGrid_To_ChildGrid() 344 345 END SUBROUTINE agrif_update_ini 329 346 330 347 SUBROUTINE agrif_declare_var … … 431 448 ! 5. Update type 432 449 !--------------- 450 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 451 452 # if defined UPD_HIGH 453 CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 454 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 455 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 456 457 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 458 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 459 CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 460 CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 461 462 # if defined key_zdftke || defined key_zdfgls 463 CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 464 CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 465 CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 466 # endif 467 468 #else 433 469 CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 434 435 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)436 437 470 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 438 471 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 439 472 440 CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)441 442 473 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 443 474 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 475 CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 476 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 444 477 445 478 # if defined key_zdftke || defined key_zdfgls … … 449 482 # endif 450 483 451 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 452 453 ! High order updates 454 ! CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 455 ! CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 456 ! CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 457 ! 458 ! CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 459 ! CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 460 ! CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 461 462 ! CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 484 #endif 463 485 ! 464 486 END SUBROUTINE agrif_declare_var … … 660 682 ENDIF 661 683 ENDIF 662 nbcline_trc = 0663 CALL Agrif_Update_trc(0)664 !665 Agrif_UseSpecialValueInUpdate = .FALSE.666 684 ! 667 685 END SUBROUTINE Agrif_InitValues_cont_top … … 699 717 ! 5. Update type 700 718 !--------------- 719 # if defined UPD_HIGH 720 CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 721 #else 701 722 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 702 703 ! Higher order update 704 ! CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 705 723 #endif 706 724 ! 707 725 END SUBROUTINE agrif_declare_var_top -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r6204 r8010 323 323 END DO 324 324 END DO 325 326 IF( .NOT. AGRIF_Root() ) THEN 327 IF ((nbondi == 1).OR.(nbondi == 2)) rotn(nlci-1 , : ,jk) = 0.e0 ! east 328 IF ((nbondi == -1).OR.(nbondi == 2)) rotn(1 , : ,jk) = 0.e0 ! west 329 IF ((nbondj == 1).OR.(nbondj == 2)) rotn(: ,nlcj-1 ,jk) = 0.e0 ! north 330 IF ((nbondj == -1).OR.(nbondj == 2)) rotn(: ,1 ,jk) = 0.e0 ! south 331 ENDIF 325 332 ! ! =============== 326 333 END DO ! End of slab -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7973 r8010 576 576 ! Set fluxes during predictor step to ensure 577 577 ! volume conservation 578 IF ( (.NOT.Agrif_Root()).AND.ln_bt_fw) THEN578 IF (.NOT.Agrif_Root().AND.ln_bt_fw) THEN 579 579 IF((nbondi == -1).OR.(nbondi == 2)) THEN 580 580 DO jj=1,jpj … … 1139 1139 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables ' 1140 1140 ENDIF 1141 !1142 #if defined key_agrif1143 ! Restrict the use of Agrif to the forward case only1144 IF ((.NOT.ln_bt_fw ).AND.(.NOT.Agrif_Root())) CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' )1145 #endif1146 1141 ! 1147 1142 IF(lwp) WRITE(numout,*) ' Time filter choice, nn_bt_flt: ', nn_bt_flt -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r7972 r8010 223 223 ENDIF 224 224 #endif 225 #if defined key_agrif 226 IF( .NOT. AGRIF_Root() ) THEN 227 IF ((nbondi == 1).OR.(nbondi == 2)) wn(nlci-1 , : ,:) = 0.e0 ! east 228 IF ((nbondi == -1).OR.(nbondi == 2)) wn(2 , : ,:) = 0.e0 ! west 229 IF ((nbondj == 1).OR.(nbondj == 2)) wn(: ,nlcj-1 ,:) = 0.e0 ! north 230 IF ((nbondj == -1).OR.(nbondj == 2)) wn(: ,2 ,:) = 0.e0 ! south 231 ENDIF 232 #endif 225 233 ! 226 234 IF( nn_timing == 1 ) CALL timing_stop('wzv') -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/step.F90
r7971 r8010 353 353 CALL Agrif_Update_Tra() ! Update active tracers 354 354 CALL Agrif_Update_Dyn() ! Update momentum 355 #if defined key_top 356 CALL Agrif_Update_Trc() ! Update passive tracers 357 #endif 355 358 ENDIF 356 359 #endif -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r7502 r8010 114 114 USE agrif_opa_sponge ! Momemtum and tracers sponges 115 115 USE agrif_opa_update ! Update (2-way nesting) 116 #if defined key_top 117 USE agrif_top_update ! Update (2-way nesting) 118 #endif 116 119 #endif 117 120 #if defined key_top -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r6959 r8010 30 30 #if defined key_agrif 31 31 USE agrif_top_sponge ! tracers sponges 32 USE agrif_top_update ! tracers updates33 32 #endif 34 33 … … 85 84 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only 86 85 87 #if defined key_agrif88 IF( .NOT. Agrif_Root()) CALL Agrif_Update_Trc( kstp ) ! Update tracer at AGRIF zoom boundaries : children only89 #endif90 91 86 ELSE ! 1D vertical configuration 92 87 CALL trc_sbc( kstp ) ! surface boundary condition
Note: See TracChangeset
for help on using the changeset viewer.