Changeset 8010 for branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
- Timestamp:
- 2017-05-09T17:36:25+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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 !
Note: See TracChangeset
for help on using the changeset viewer.
