- Timestamp:
- 2014-09-25T18:26:34+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r4785 r4789 12 12 USE wrk_nemo 13 13 USE dynspg_oce 14 USE zdf_oce ! vertical physics: ocean variables 14 15 15 16 IMPLICIT NONE … … 17 18 18 19 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 19 20 # if defined key_zdftke 21 PUBLIC Agrif_Update_Tke 22 # endif 20 23 !!---------------------------------------------------------------------- 21 !! NEMO/NST 3. 3, NEMO Consortium (2010)24 !! NEMO/NST 3.6 , NEMO Consortium (2010) 22 25 !! $Id$ 23 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 115 118 CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b) 116 119 # endif 117 END IF 120 END IF 118 121 # endif 119 122 ! … … 132 135 END SUBROUTINE Agrif_Update_Dyn 133 136 137 # if defined key_zdftke 138 SUBROUTINE Agrif_Update_Tke( kt ) 139 !!--------------------------------------------- 140 !! *** ROUTINE Agrif_Update_Tke *** 141 !!--------------------------------------------- 142 !! 143 INTEGER, INTENT(in) :: kt 144 ! 145 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 146 # if defined TWO_WAY 147 148 Agrif_UseSpecialValueInUpdate = .TRUE. 149 Agrif_SpecialValueFineGrid = 0. 150 151 CALL Agrif_Update_Variable(avt_id ,locupdate=(/0,0/), procname=updateAVT ) 152 CALL Agrif_Update_Variable(avm_id ,locupdate=(/0,0/), procname=updateAVM ) 153 CALL Agrif_Update_Variable(avmu_id,locupdate=(/0,0/), procname=updateAVMu) 154 CALL Agrif_Update_Variable(avmv_id,locupdate=(/0,0/), procname=updateAVMv) 155 156 Agrif_UseSpecialValueInUpdate = .FALSE. 157 158 # endif 159 160 END SUBROUTINE Agrif_Update_Tke 161 # endif /* key_zdftke */ 134 162 135 163 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) … … 164 192 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 165 193 tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 166 & + atfp * ( tabres(ji,jj,jk,jn) &167 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)194 & + atfp * ( tabres(ji,jj,jk,jn) & 195 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 168 196 ENDIF 169 197 ENDDO … … 220 248 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 221 249 ub(ji,jj,jk) = ub(ji,jj,jk) & 222 & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)250 & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 223 251 ENDIF 224 252 ! … … 264 292 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 265 293 vb(ji,jj,jk) = vb(ji,jj,jk) & 266 & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)294 & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 267 295 ENDIF 268 296 ! … … 406 434 ! 407 435 END SUBROUTINE updatev2d 408 436 409 437 410 438 SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before ) … … 430 458 DO jj=j1,j2 431 459 DO ji=i1,i2 432 sshb(ji,jj) = sshb(ji,jj) &433 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)460 sshb(ji,jj) = sshb(ji,jj) & 461 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 434 462 END DO 435 463 END DO … … 507 535 508 536 SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 509 ! currently not used537 ! currently not used 510 538 !!--------------------------------------------- 511 539 !! *** ROUTINE updateT *** … … 521 549 522 550 IF (before) THEN 523 524 525 526 527 528 529 530 531 532 533 534 535 ELSE 536 537 538 539 551 DO jk=k1,k2 552 DO jj=j1,j2 553 DO ji=i1,i2 554 tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 555 tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk) 556 tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk) 557 END DO 558 END DO 559 END DO 560 tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy() 561 tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox() 562 tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy() 563 ELSE 564 DO jk=k1,k2 565 DO jj=j1,j2 566 DO ji=i1,i2 567 IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN 540 568 print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 541 569 print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk) … … 544 572 print *,'CORR = ',ztemp-1. 545 573 print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, & 546 tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp574 tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp 547 575 e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp 548 576 e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp 549 550 551 552 553 ENDIF 554 577 END IF 578 END DO 579 END DO 580 END DO 581 ENDIF 582 ! 555 583 END SUBROUTINE update_scales 584 585 # if defined key_zdftke 586 SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 587 !!--------------------------------------------- 588 !! *** ROUTINE updateavt *** 589 !!--------------------------------------------- 590 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 591 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 592 LOGICAL, INTENT(in) :: before 593 !!--------------------------------------------- 594 ! 595 IF (before) THEN 596 ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 597 ELSE 598 avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 599 ENDIF 600 ! 601 END SUBROUTINE updateAVT 602 603 604 SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 605 !!--------------------------------------------- 606 !! *** ROUTINE updateavm *** 607 !!--------------------------------------------- 608 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 609 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 610 LOGICAL, INTENT(in) :: before 611 !!--------------------------------------------- 612 ! 613 IF (before) THEN 614 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 615 ELSE 616 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 617 ENDIF 618 ! 619 END SUBROUTINE updateAVM 620 621 622 SUBROUTINE updateAVMu( ptab, i1, i2, j1, j2, k1, k2, before ) 623 !!--------------------------------------------- 624 !! *** ROUTINE updateavmu *** 625 !!--------------------------------------------- 626 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 627 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 628 LOGICAL, INTENT(in) :: before 629 !!--------------------------------------------- 630 ! 631 IF (before) THEN 632 ptab (i1:i2,j1:j2,k1:k2) = avmu_k(i1:i2,j1:j2,k1:k2) 633 ELSE 634 avmu_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 635 ENDIF 636 ! 637 END SUBROUTINE updateAVMu 638 639 640 SUBROUTINE updateAVMv( ptab, i1, i2, j1, j2, k1, k2, before ) 641 !!--------------------------------------------- 642 !! *** ROUTINE updateavmv *** 643 !!--------------------------------------------- 644 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 645 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 646 LOGICAL, INTENT(in) :: before 647 !!--------------------------------------------- 648 ! 649 IF (before) THEN 650 ptab (i1:i2,j1:j2,k1:k2) = avmv_k(i1:i2,j1:j2,k1:k2) 651 ELSE 652 avmv_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 653 ENDIF 654 ! 655 END SUBROUTINE updateAVMv 656 657 # endif /* key_zdftke */ 556 658 557 659 #else
Note: See TracChangeset
for help on using the changeset viewer.