Changeset 4221 for branches/2013
- Timestamp:
- 2013-11-15T16:39:17+01:00 (10 years ago)
- Location:
- branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO
- Files:
-
- 6 edited
-
NST_SRC/agrif_oce.F90 (modified) (1 diff)
-
NST_SRC/agrif_opa_interp.F90 (modified) (21 diffs)
-
NST_SRC/agrif_user.F90 (modified) (6 diffs)
-
OPA_SRC/DYN/dynspg_oce.F90 (modified) (2 diffs)
-
OPA_SRC/DYN/dynspg_ts.F90 (modified) (8 diffs)
-
OPA_SRC/DYN/sshwzv.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
r3680 r4221 40 40 INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 41 41 INTEGER :: trn_id, trb_id, tra_id 42 INTEGER :: unb_id, vnb_id 42 43 43 44 !!---------------------------------------------------------------------- -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r3294 r4221 27 27 USE agrif_opa_sponge 28 28 USE lib_mpp 29 USE wrk_nemo 29 USE wrk_nemo 30 USE dynspg_oce 30 31 31 32 IMPLICIT NONE 32 33 PRIVATE 34 35 ! Barotropic arrays used to store open boundary data during 36 ! time-splitting loop: 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_w, vbdy_w, hbdy_w 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_e, vbdy_e, hbdy_e 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_n, vbdy_n, hbdy_n 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_s, vbdy_s, hbdy_s 33 41 34 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, interpu, interpv 42 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts 43 PUBLIC interpu, interpv, interpunb, interpvnb, interpsshn 35 44 36 45 # include "domzgr_substitute.h90" … … 169 178 REAL(wp) :: timeref 170 179 REAL(wp) :: z2dt, znugdt 171 REAL(wp) :: zrhox, rhoy180 REAL(wp) :: zrhox, zrhoy 172 181 REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva 173 182 REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d … … 180 189 181 190 zrhox = Agrif_Rhox() 182 rhoy = Agrif_Rhoy()191 zrhoy = Agrif_Rhoy() 183 192 184 193 timeref = 1. … … 201 210 zva2d = 0. 202 211 212 #if defined key_dynspg_flt 203 213 Agrif_SpecialValue=0. 204 214 Agrif_UseSpecialValue = ln_spc_dyn 205 215 CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d) 206 216 CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d) 217 #endif 207 218 Agrif_UseSpecialValue = .FALSE. 208 219 … … 210 221 IF((nbondi == -1).OR.(nbondi == 2)) THEN 211 222 223 #if defined key_dynspg_flt 212 224 DO jj=1,jpj 213 laplacu(2,jj) = timeref * (zua2d(2,jj)/(rhoy*e2u(2,jj)))*umask(2,jj,1) 214 END DO 215 216 DO jk=1,jpkm1 217 DO jj=1,jpj 218 ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(rhoy*e2u(1:2,jj))) 225 laplacu(2,jj) = timeref * (zua2d(2,jj)/(zrhoy*e2u(2,jj)))*umask(2,jj,1) 226 END DO 227 #endif 228 229 DO jk=1,jpkm1 230 DO jj=1,jpj 231 ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(zrhoy*e2u(1:2,jj))) 219 232 ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u(1:2,jj,jk) 220 233 END DO 221 234 END DO 222 235 236 #if defined key_dynspg_flt 223 237 DO jk=1,jpkm1 224 238 DO jj=1,jpj … … 240 254 ENDIF 241 255 END DO 256 #else 257 spgu(2,:) = ua_b(2,:) 258 #endif 242 259 243 260 DO jk=1,jpkm1 … … 278 295 279 296 IF((nbondi == 1).OR.(nbondi == 2)) THEN 280 297 #if defined key_dynspg_flt 281 298 DO jj=1,jpj 282 laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(rhoy*e2u(nlci-2,jj))) 283 END DO 284 285 DO jk=1,jpkm1 286 DO jj=1,jpj 287 ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(rhoy*e2u(nlci-2:nlci-1,jj))) 299 laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj))) 300 END DO 301 #endif 302 303 DO jk=1,jpkm1 304 DO jj=1,jpj 305 ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(zrhoy*e2u(nlci-2:nlci-1,jj))) 288 306 289 307 ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u(nlci-2:nlci-1,jj,jk) … … 292 310 END DO 293 311 312 #if defined key_dynspg_flt 294 313 DO jk=1,jpkm1 295 314 DO jj=1,jpj … … 312 331 ENDIF 313 332 END DO 333 #else 334 spgu(nlci-2,:) = ua_b(nlci-2,:) 335 #endif 314 336 315 337 DO jk=1,jpkm1 … … 353 375 IF((nbondj == -1).OR.(nbondj == 2)) THEN 354 376 377 #if defined key_dynspg_flt 355 378 DO ji=1,jpi 356 379 laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2))) 357 380 END DO 381 #endif 358 382 359 383 DO jk=1,jpkm1 … … 364 388 END DO 365 389 390 #if defined key_dynspg_flt 366 391 DO jk=1,jpkm1 367 392 DO ji=1,jpi … … 383 408 ENDIF 384 409 END DO 410 #else 411 spgv(:,2)=va_b(:,2) 412 #endif 385 413 386 414 DO jk=1,jpkm1 … … 413 441 DO jk=1,jpkm1 414 442 DO ji=1,jpi 415 ua(ji,2,jk) = (zua(ji,2,jk)/( rhoy*e2u(ji,2)))*umask(ji,2,jk)443 ua(ji,2,jk) = (zua(ji,2,jk)/(zrhoy*e2u(ji,2)))*umask(ji,2,jk) 416 444 ua(ji,2,jk) = ua(ji,2,jk) / fse3u(ji,2,jk) 417 445 END DO … … 422 450 IF((nbondj == 1).OR.(nbondj == 2)) THEN 423 451 452 #if defined key_dynspg_flt 424 453 DO ji=1,jpi 425 454 laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2))) 426 455 END DO 456 #endif 427 457 428 458 DO jk=1,jpkm1 … … 433 463 END DO 434 464 465 #if defined key_dynspg_flt 435 466 DO jk=1,jpkm1 436 467 DO ji=1,jpi … … 438 469 END DO 439 470 END DO 440 441 471 442 472 spgv(:,nlcj-2)=0. … … 453 483 ENDIF 454 484 END DO 485 #else 486 spgv(:,nlcj-2)=va_b(:,nlcj-2) 487 #endif 455 488 456 489 DO jk=1,jpkm1 … … 483 516 DO jk=1,jpkm1 484 517 DO ji=1,jpi 485 ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/( rhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk)518 ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(zrhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk) 486 519 ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u(ji,nlcj-1,jk) 487 520 END DO … … 495 528 END SUBROUTINE Agrif_dyn 496 529 530 SUBROUTINE Agrif_dyn_ts( kt, jn ) 531 !!---------------------------------------------------------------------- 532 !! *** ROUTINE Agrif_dyn_ts *** 533 !!---------------------------------------------------------------------- 534 !! 535 INTEGER, INTENT(in) :: kt, jn 536 !! 537 INTEGER :: ji, jj 538 REAL(wp) :: zrhox, zrhoy 539 REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 540 REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn 541 !!---------------------------------------------------------------------- 542 543 IF( Agrif_Root() ) RETURN 544 545 IF ((kt==nit000).AND.(jn==1)) THEN 546 ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj)) 547 ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj)) 548 ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi)) 549 ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi)) 550 ENDIF 551 552 IF (jn==1) THEN 553 ! Fill boundary arrays at each baroclinic step 554 ! with Parent grid barotropic fluxes and sea level 555 ! 556 CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn ) 557 558 zrhox = Agrif_Rhox() 559 zrhoy = Agrif_Rhoy() 560 561 !alt Agrif_SpecialValue = 0.e0 562 !alt Agrif_UseSpecialValue = .TRUE. 563 !alt CALL Agrif_Bc_variable(zsshn, sshn_id, procname=interpsshn ) 564 !alt Agrif_UseSpecialValue = .FALSE. 565 566 Agrif_SpecialValue=0. 567 Agrif_UseSpecialValue = ln_spc_dyn 568 zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp 569 CALL Agrif_Bc_variable(zunb,unb_id,procname=interpunb) 570 CALL Agrif_Bc_variable(zvnb,vnb_id,procname=interpvnb) 571 Agrif_UseSpecialValue = .FALSE. 572 573 IF((nbondi == -1).OR.(nbondi == 2)) THEN 574 DO jj=1,jpj 575 ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) 576 vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) 577 hbdy_w(jj) = zsshn(2,jj) 578 END DO 579 ENDIF 580 581 IF((nbondi == 1).OR.(nbondi == 2)) THEN 582 DO jj=1,jpj 583 ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) 584 vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) 585 hbdy_e(jj) = zsshn(nlci-1,jj) 586 END DO 587 ENDIF 588 589 IF((nbondj == -1).OR.(nbondj == 2)) THEN 590 DO ji=1,jpi 591 ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) 592 vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) 593 hbdy_s(ji) = zsshn(ji,2) 594 END DO 595 ENDIF 596 597 IF((nbondj == 1).OR.(nbondj == 2)) THEN 598 DO ji=1,jpi 599 ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) 600 vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) 601 hbdy_n(ji) = zsshn(ji,nlcj-1) 602 END DO 603 ENDIF 604 605 CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn ) 606 ENDIF ! jn==1 607 608 ! Then update velocities at each barotropic time step 609 IF((nbondi == -1).OR.(nbondi == 2)) THEN 610 DO jj=1,jpj 611 va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj) 612 ! Specified fluxes: 613 ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj) 614 ! Characteristics method: 615 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 616 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 617 END DO 618 ENDIF 619 620 IF((nbondi == 1).OR.(nbondi == 2)) THEN 621 DO jj=1,jpj 622 va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj) 623 ! Specified fluxes: 624 ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj) 625 ! Characteristics method: 626 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 627 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 628 END DO 629 ENDIF 630 631 IF((nbondj == -1).OR.(nbondj == 2)) THEN 632 DO ji=1,jpi 633 ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2) 634 ! Specified fluxes: 635 va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2) 636 ! Characteristics method: 637 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 638 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 639 END DO 640 ENDIF 641 642 IF((nbondj == 1).OR.(nbondj == 2)) THEN 643 DO ji=1,jpi 644 ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1) 645 ! Specified fluxes: 646 va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2) 647 ! Characteristics method: 648 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 649 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 650 END DO 651 ENDIF 652 ! 653 END SUBROUTINE Agrif_dyn_ts 497 654 498 655 SUBROUTINE Agrif_ssh( kt ) … … 518 675 519 676 IF((nbondj == -1).OR.(nbondj == 2)) THEN 520 ssha(:,2)=ssh n(:,3)521 sshn(:,2)=ssh b(:,3)677 ssha(:,2)=ssha(:,3) 678 sshn(:,2)=sshn(:,3) 522 679 ENDIF 523 680 524 681 IF((nbondj == 1).OR.(nbondj == 2)) THEN 525 682 ssha(:,nlcj-1)=ssha(:,nlcj-2) 526 ssh a(:,nlcj-1)=sshn(:,nlcj-2)683 sshn(:,nlcj-1)=sshn(:,nlcj-2) 527 684 ENDIF 528 685 529 686 END SUBROUTINE Agrif_ssh 530 687 688 SUBROUTINE Agrif_ssh_ts( kt ) 689 !!---------------------------------------------------------------------- 690 !! *** ROUTINE Agrif_ssh_ts *** 691 !!---------------------------------------------------------------------- 692 INTEGER, INTENT(in) :: kt 693 !! 694 !!---------------------------------------------------------------------- 695 696 IF((nbondi == -1).OR.(nbondi == 2)) THEN 697 ssha_e(2,:) = ssha_e(3,:) 698 ENDIF 699 700 IF((nbondi == 1).OR.(nbondi == 2)) THEN 701 ssha_e(nlci-1,:) = ssha_e(nlci-2,:) 702 ENDIF 703 704 IF((nbondj == -1).OR.(nbondj == 2)) THEN 705 ssha_e(:,2) = ssha_e(:,3) 706 ENDIF 707 708 IF((nbondj == 1).OR.(nbondj == 2)) THEN 709 ssha_e(:,nlcj-1) = ssha_e(:,nlcj-2) 710 ENDIF 711 712 END SUBROUTINE Agrif_ssh_ts 713 714 SUBROUTINE interpsshn(tabres,i1,i2,j1,j2) 715 !!---------------------------------------------------------------------- 716 !! *** ROUTINE interpsshn *** 717 !!---------------------------------------------------------------------- 718 INTEGER, INTENT(in) :: i1,i2,j1,j2 719 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 720 !! 721 INTEGER :: ji,jj 722 !!---------------------------------------------------------------------- 723 724 tabres(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 725 726 END SUBROUTINE interpsshn 531 727 532 728 SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2) … … 611 807 612 808 END SUBROUTINE interpv2d 809 810 SUBROUTINE interpunb(tabres,i1,i2,j1,j2) 811 !!---------------------------------------------------------------------- 812 !! *** ROUTINE interpunb *** 813 !!---------------------------------------------------------------------- 814 INTEGER, INTENT(in) :: i1,i2,j1,j2 815 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 816 !! 817 INTEGER :: ji,jj,jk 818 !!---------------------------------------------------------------------- 819 820 tabres(:,:) = 0.e0 821 DO jk=1,jpkm1 822 DO jj=j1,j2 823 DO ji=i1,i2 824 tabres(ji,jj) = tabres(ji,jj) + e2u(ji,jj) * un(ji,jj,jk) & 825 * umask(ji,jj,jk) * fse3u(ji,jj,jk) 826 END DO 827 END DO 828 END DO 829 830 END SUBROUTINE interpunb 831 832 SUBROUTINE interpvnb(tabres,i1,i2,j1,j2) 833 !!---------------------------------------------------------------------- 834 !! *** ROUTINE interpvnb *** 835 !!---------------------------------------------------------------------- 836 INTEGER, INTENT(in) :: i1,i2,j1,j2 837 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 838 !! 839 INTEGER :: ji,jj,jk 840 !!---------------------------------------------------------------------- 841 842 tabres(:,:) = 0.e0 843 DO jk=1,jpkm1 844 DO jj=j1,j2 845 DO ji=i1,i2 846 tabres(ji,jj) = tabres(ji,jj) + e1v(ji,jj) * vn(ji,jj,jk) & 847 * vmask(ji,jj,jk) * fse3v(ji,jj,jk) 848 END DO 849 END DO 850 END DO 851 852 END SUBROUTINE interpvnb 613 853 614 854 #else -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r3680 r4221 175 175 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 176 176 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: tabuvtemp 177 REAL(wp), DIMENSION(:,: ), ALLOCATABLE :: tab2d 177 178 LOGICAL :: check_namelist 178 179 !!---------------------------------------------------------------------- … … 180 181 ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 181 182 ALLOCATE( tabuvtemp(jpi, jpj, jpk) ) 183 ALLOCATE( tab2d(jpi, jpj) ) 182 184 183 185 … … 197 199 Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 198 200 Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 201 202 Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb) 203 Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb) 204 Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn) 205 199 206 Agrif_UseSpecialValue = .FALSE. 200 207 … … 255 262 DEALLOCATE(tabtstemp) 256 263 DEALLOCATE(tabuvtemp) 264 DEALLOCATE(tab2d) 257 265 ! 258 266 END SUBROUTINE Agrif_InitValues_cont … … 282 290 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 283 291 292 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 293 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 284 294 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 285 295 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) … … 296 306 Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 297 307 308 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 309 Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 310 Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 311 298 312 ! 3. Location of interpolation 299 313 !----------------------------- 300 314 Call Agrif_Set_bc(un_id,(/0,1/)) 301 315 Call Agrif_Set_bc(vn_id,(/0,1/)) 316 317 Call Agrif_Set_bc(sshn_id,(/0,1/)) 318 Call Agrif_Set_bc(unb_id,(/0,1/)) 319 Call Agrif_Set_bc(vnb_id,(/0,1/)) 302 320 303 321 Call Agrif_Set_bc(tsn_id,(/0,1/)) -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r3294 r4221 39 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_b ! before field without time-filter 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_b, va_b ! after averaged velocities 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_b, vn_b ! now averaged velocities 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub_b, vb_b ! before averaged velocities 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv, vn_adv ! Advection vel. at "now" barocl. step 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b, vb2_b ! Advection vel. at "now-0.5" barocl. step 41 46 42 47 !!---------------------------------------------------------------------- … … 53 58 ALLOCATE( sshn_e(jpi,jpj) , ua_e(jpi,jpj) , hu_e(jpi,jpj) , hur_e(jpi,jpj) , & 54 59 & ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) , & 60 & ub_b(jpi,jpj) , vb_b(jpi,jpj) , un_b(jpi,jpj) , vn_b(jpi,jpj) , & 61 & ua_b(jpi,jpj) , va_b(jpi,jpj) , & 62 & ub2_b(jpi,jpj) , vb2_b(jpi,jpj) , & 63 & un_adv(jpi,jpj) , vn_adv(jpi,jpj) , & 55 64 & sshn_b(jpi,jpj) , STAT = dynspg_oce_alloc ) 56 65 ! -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4057 r4221 42 42 USE sbcapr ! surface boundary condition: atmospheric pressure 43 43 USE dynadv, ONLY: ln_dynadv_vec 44 #if defined key_agrif 45 USE agrif_opa_interp ! agrif 46 #endif 44 47 45 48 … … 70 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne ! triad of coriolis parameter 71 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme) 72 73 ! Would be convenient to have arrays below defined whatever the free surface option ?74 ! These could be computed once for all at the beginning of the each baroclinic time step75 ! and eventually swapped at the end76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_b, va_b ! after averaged velocities77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_b, vn_b ! now averaged velocities78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub_b, vb_b ! before averaged velocities79 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv, vn_adv ! Advection vel. at "now" barocl. step81 REAL(wp), PRIVATE,ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b, vb2_b ! Advection vel. at "now-0.5" barocl. step82 75 83 76 ! Arrays below are saved to allow testing of the "no time averaging" option … … 105 98 ierr(:) = 0 106 99 107 ALLOCATE( ub_b(jpi,jpj) , vb_b(jpi,jpj) , & 108 & un_b(jpi,jpj) , vn_b(jpi,jpj) , & 109 & ua_b(jpi,jpj) , va_b(jpi,jpj) , & 110 & un_adv(jpi,jpj), vn_adv(jpi,jpj) , & 111 & sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 100 ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 112 101 & ub_e(jpi,jpj) , vb_e(jpi,jpj) , & 113 & ubb_e(jpi,jpj) , vbb_e(jpi,jpj) , & 114 & wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), & 115 & zwz(jpi,jpj), STAT= ierr(1) ) 116 117 IF( ln_bt_fw ) ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), STAT=ierr(2) ) 102 & ubb_e(jpi,jpj) , vbb_e(jpi,jpj) , STAT= ierr(1) ) 103 104 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 118 105 119 106 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & … … 131 118 !! 132 119 !! ** Purpose : 133 !! -Compute the now trend due to the explicit time stepping 134 !! of the quasi-linear barotropic system. Barotropic variables are 135 !! advanced from internal time steps "n" to "n+1" (if ln_bt_cen=F) 136 !! or from "n-1" to "n+1" time steps (if ln_bt_cen=T) with a 137 !! generalized forward-backward (see ref. below) time stepping. 138 !! -Update the free surface at step "n+1" (ssha, sshu_a, sshv_a). 139 !! -Compute barotropic advective velocities at step "n" to be used 140 !! to advect tracers latter on. These are compliant with discrete 141 !! continuity equation taken at the baroclinic time steps, thus 142 !! ensuring tracers conservation. 120 !! - Compute the now trend due to the explicit time stepping 121 !! of the quasi-linear barotropic system. 122 !! Barotropic variables are advanced from internal time steps 123 !! "n" to "n+1" (if ln_bt_fw = .TRUE.) 124 !! or from "n-1" to "n+1" (if ln_bt_fw = .FALSE.) 125 !! with a generalized forward-backward time stepping (see ref. below). 143 126 !! 144 !! ** Method : 127 !! - Set barotropic velocities at step "n+1" (ua_b, va_b). 128 !! 129 !! - Set free surface at step "n+1" (ssha, sshu_a, sshv_a). 130 !! 131 !! - Update velocity tendencies (ua, va) so that the barotropic component 132 !! matches the one issued from time splitting loop. 133 !! 134 !! - Compute barotropic advective velocities at central time step "n" 135 !! to be used to advect tracers latter on. These are compliant with discrete 136 !! continuity equation taken at the baroclinic time steps, thus 137 !! ensuring tracers conservation. 138 !! 139 !! ** Method : 145 140 !! 146 141 !! ** Action : - Update barotropic velocities: ua_b, va_b 147 !! - Update trend (ua,va) with barotropic component148 !! - Update ssha, sshu_a, sshv_a149 !! - Update barotropic advective velocity at kt= now142 !! - Update sea level ssha, sshu_a, sshv_a 143 !! - Update trend (ua,va) with barotropic component. 144 !! - Update barotropic advective velocity at kt="n" 150 145 !! 151 !! Reference s: Shchepetkin, A.F. and J.C. McWilliams, 2005:152 !! 153 !! 154 !! 155 !! 146 !! Reference : Shchepetkin, A.F. and J.C. McWilliams, 2005: 147 !! The regional oceanic modeling system (ROMS): 148 !! a split-explicit, free-surface, 149 !! topography-following-coordinate oceanic model. 150 !! Ocean Modelling, 9, 347-404. 156 151 !!--------------------------------------------------------------------- 157 152 ! … … 578 573 ! Duplicate sea level across open boundaries (this is only cosmetic if lk_vvl=.false.) 579 574 IF (lk_bdy) CALL bdy_ssh( ssha_e ) 575 #endif 576 #if defined key_agrif 577 IF( .NOT.Agrif_Root() ) CALL agrif_ssh_ts( jn ) 580 578 #endif 581 579 ! … … 727 725 END DO 728 726 729 ELSE ! Flux form 727 ELSE ! Flux form 728 730 729 DO jj = 2, jpjm1 731 730 DO ji = fs_2, fs_jpim1 ! vector opt. 732 733 731 zhura = umask(ji,jj,1)/(hu_0(ji,jj) + sshu_a(ji,jj) + 1._wp - umask(ji,jj,1)) 734 732 zhvra = vmask(ji,jj,1)/(hv_0(ji,jj) + sshv_a(ji,jj) + 1._wp - vmask(ji,jj,1)) … … 772 770 773 771 IF( lk_bdy ) CALL bdy_dyn2d( kt ) ! open boundaries 772 #endif 773 #if defined key_agrif 774 IF( .NOT.Agrif_Root() ) CALL agrif_dyn_ts( kt, jn ) ! Agrif 774 775 #endif 775 776 ! !* Swap … … 1044 1045 1045 1046 IF(ln_bt_av) THEN 1046 IF(lwp) WRITE(numout,*) ' ln_bt_av=.true. => Time averaging over nn_baro time steps is on'1047 IF(lwp) WRITE(numout,*) ' ln_bt_av=.true. => Use Time Filtering of bt variables ' 1047 1048 ELSE 1048 1049 IF(lwp) WRITE(numout,*) ' ln_bt_av=.false. => No time averaging of barotropic variables ' -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r3970 r4221 313 313 #endif 314 314 END DO 315 316 #if defined key_agrif 317 ! Set verticaly velocity to zero along open boundaries (cosmetic) 318 IF( .NOT. AGRIF_Root() ) THEN 319 DO jk = 1, jpkm1 320 IF ((nbondi == 1).OR.(nbondi == 2)) wn(nlci-1 , : ,jk) = 0.e0 ! east 321 IF ((nbondi == -1).OR.(nbondi == 2)) wn(2 , : ,jk) = 0.e0 ! west 322 IF ((nbondj == 1).OR.(nbondj == 2)) wn(: ,nlcj-1 ,jk) = 0.e0 ! north 323 IF ((nbondj == -1).OR.(nbondj == 2)) wn(: ,2 ,jk) = 0.e0 ! south 324 END DO 325 ENDIF 326 #endif 315 327 ! 316 328 CALL wrk_dealloc( jpi,jpj,jpk, z3d )
Note: See TracChangeset
for help on using the changeset viewer.
