- Timestamp:
- 2014-09-25T21:14:43+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
r4785 r4790 9 9 !! 3.4 ! 09-2012 (R. Benshila, C. Herbaut) update and EVP 10 10 !!---------------------------------------------------------------------- 11 #undef toto12 11 #if defined key_agrif && defined key_lim2 13 12 !!---------------------------------------------------------------------- … … 42 41 PUBLIC interp_adv_ice 43 42 43 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr 44 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr 45 46 44 47 !!---------------------------------------------------------------------- 45 48 !! NEMO/NST 3.4 , NEMO Consortium (2012) … … 66 69 u_ice_nst(:,:) = 0. 67 70 v_ice_nst(:,:) = 0. 68 #undef toto 69 #ifdef toto 70 CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. ) 71 CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. ) 72 #endif 71 CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. ) 72 CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. ) 73 73 Agrif_SpecialValue=0. 74 74 Agrif_UseSpecialValue = .FALSE. … … 142 142 !! we are in inside a new parent ice time step 143 143 !!----------------------------------------------------------------------- 144 REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice145 144 INTEGER :: ji,jj 146 145 REAL(wp) :: zrhox, zrhoy … … 159 158 Agrif_SpecialValue=-9999. 160 159 Agrif_UseSpecialValue = .TRUE. 161 zuice = 0.162 zvice = 0.163 #undef toto 164 #ifdef toto 165 CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.)166 CALL Agrif_Bc_variable( zvice,v_ice_id,procname=interp_v_ice, calledweight=1.)167 #endif 160 IF( .NOT. ALLOCATED(uice_agr) )THEN 161 ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj)) 162 ENDIF 163 uice_agr = 0. 164 vice_agr = 0. 165 CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.) 166 CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.) 168 167 Agrif_SpecialValue=0. 169 168 Agrif_UseSpecialValue = .FALSE. 170 169 ! 171 170 zrhox = agrif_rhox() ; zrhoy = agrif_rhoy() 172 zuice(:,:) = zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)173 zvice(:,:) = zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)171 uice_agr(:,:) = uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1) 172 vice_agr(:,:) = vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1) 174 173 ! fill boundaries 175 174 DO jj = 1, jpj 176 175 DO ji = 1, 2 177 u_ice_oe(ji, jj,2) = zuice(ji ,jj)178 u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj)176 u_ice_oe(ji, jj,2) = uice_agr(ji ,jj) 177 u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj) 179 178 END DO 180 179 END DO 181 180 DO jj = 1, jpj 182 v_ice_oe(2,jj,2) = zvice(2 ,jj)183 v_ice_oe(4,jj,2) = zvice(nlci-1,jj)181 v_ice_oe(2,jj,2) = vice_agr(2 ,jj) 182 v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj) 184 183 END DO 185 184 DO ji = 1, jpi 186 u_ice_sn(ji,2,2) = zuice(ji,2 )187 u_ice_sn(ji,4,2) = zuice(ji,nlcj-1)185 u_ice_sn(ji,2,2) = uice_agr(ji,2 ) 186 u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1) 188 187 END DO 189 188 DO jj = 1, 2 190 189 DO ji = 1, jpi 191 v_ice_sn(ji,jj ,2) = zvice(ji,jj )192 v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3)190 v_ice_sn(ji,jj ,2) = vice_agr(ji,jj ) 191 v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3) 193 192 END DO 194 193 END DO … … 341 340 !! we are in inside a new parent ice time step 342 341 !!----------------------------------------------------------------------- 343 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab344 342 INTEGER :: ji,jj,jn 345 343 !!----------------------------------------------------------------------- … … 352 350 adv_ice_sn(:,:,:,1) = adv_ice_sn(:,:,:,2) 353 351 ! interpolation of boundaries 354 ztab(:,:,:) = 0. 352 IF(.NOT.ALLOCATED(tabice_agr))THEN 353 ALLOCATE(tabice_agr(jpi,jpj,7)) 354 ENDIF 355 tabice_agr(:,:,:) = 0. 355 356 Agrif_SpecialValue=-9999. 356 357 Agrif_UseSpecialValue = .TRUE. 357 #undef toto 358 #ifdef toto 359 CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 360 #endif 358 CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 361 359 Agrif_SpecialValue=0. 362 360 Agrif_UseSpecialValue = .FALSE. … … 366 364 DO jj = 1, jpj 367 365 DO ji=1,2 368 adv_ice_oe(ji ,jj,jn,2) = ztab(ji ,jj,jn)369 adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn)366 adv_ice_oe(ji ,jj,jn,2) = tabice_agr(ji ,jj,jn) 367 adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn) 370 368 END DO 371 369 END DO … … 375 373 Do jj =1,2 376 374 DO ji = 1, jpi 377 adv_ice_sn(ji,jj ,jn,2) = ztab(ji,jj ,jn)378 adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn)375 adv_ice_sn(ji,jj ,jn,2) = tabice_agr(ji,jj ,jn) 376 adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn) 379 377 END DO 380 378 END DO … … 394 392 INTEGER :: ji,jj,jn 395 393 REAL(wp) :: zalpha 396 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab394 REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr 397 395 !!----------------------------------------------------------------------- 398 396 ! … … 401 399 zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) 402 400 ! 403 ztab(:,:,:) = 0.e0401 tabice_agr(:,:,:) = 0.e0 404 402 DO jn =1,7 405 403 DO jj =1,2 406 404 DO ji = 1, jpi 407 ztab(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2)408 ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2)405 tabice_agr(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2) 406 tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 409 407 END DO 410 408 END DO … … 414 412 DO jj = 1, jpj 415 413 DO ji=1,2 416 ztab(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2)417 ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2)414 tabice_agr(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2) 415 tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 418 416 END DO 419 417 END DO 420 418 END DO 421 419 ! 422 CALL parcoursT( ztab(:,:, 1), frld )423 CALL parcoursT( ztab(:,:, 2), hicif )424 CALL parcoursT( ztab(:,:, 3), hsnif )425 CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) )426 CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) )427 CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) )428 CALL parcoursT( ztab(:,:, 7), qstoif )420 CALL parcoursT( tabice_agr(:,:, 1), frld ) 421 CALL parcoursT( tabice_agr(:,:, 2), hicif ) 422 CALL parcoursT( tabice_agr(:,:, 3), hsnif ) 423 CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) ) 424 CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) ) 425 CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) ) 426 CALL parcoursT( tabice_agr(:,:, 7), qstoif ) 429 427 ! 430 428 END SUBROUTINE agrif_trp_lim2 … … 509 507 510 508 511 SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 )509 SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before ) 512 510 !!----------------------------------------------------------------------- 513 511 !! *** ROUTINE interp_u_ice *** … … 515 513 INTEGER, INTENT(in) :: i1, i2, j1, j2 516 514 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 515 LOGICAL, INTENT(in) :: before 517 516 !! 518 517 INTEGER :: ji,jj … … 520 519 ! 521 520 #if defined key_lim2_vp 522 DO jj=MAX(j1,2),j2 523 DO ji=MAX(i1,2),i2 524 IF( tmu(ji,jj) == 0. ) THEN 525 tabres(ji,jj) = -9999. 526 ELSE 527 tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 528 ENDIF 529 END DO 530 END DO 521 IF( before ) THEN 522 DO jj=MAX(j1,2),j2 523 DO ji=MAX(i1,2),i2 524 IF( tmu(ji,jj) == 0. ) THEN 525 tabres(ji,jj) = -9999. 526 ELSE 527 tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 528 ENDIF 529 END DO 530 END DO 531 ENDIF 531 532 #else 532 DO jj= j1, j2 533 DO ji= i1, i2 534 IF( umask(ji,jj,1) == 0. ) THEN 535 tabres(ji,jj) = -9999. 536 ELSE 537 tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 538 ENDIF 539 END DO 540 END DO 533 IF( before ) THEN 534 DO jj= j1, j2 535 DO ji= i1, i2 536 IF( umask(ji,jj,1) == 0. ) THEN 537 tabres(ji,jj) = -9999. 538 ELSE 539 tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 540 ENDIF 541 END DO 542 END DO 543 ENDIF 541 544 #endif 542 545 END SUBROUTINE interp_u_ice 543 546 544 547 545 SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 )548 SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before ) 546 549 !!----------------------------------------------------------------------- 547 550 !! *** ROUTINE interp_v_ice *** … … 549 552 INTEGER, INTENT(in) :: i1, i2, j1, j2 550 553 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 554 LOGICAL, INTENT(in) :: before 551 555 !! 552 556 INTEGER :: ji, jj … … 554 558 ! 555 559 #if defined key_lim2_vp 556 DO jj=MAX(j1,2),j2 557 DO ji=MAX(i1,2),i2 558 IF( tmu(ji,jj) == 0. ) THEN 559 tabres(ji,jj) = -9999. 560 ELSE 561 tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 562 ENDIF 563 END DO 564 END DO 560 IF( before ) THEN 561 DO jj=MAX(j1,2),j2 562 DO ji=MAX(i1,2),i2 563 IF( tmu(ji,jj) == 0. ) THEN 564 tabres(ji,jj) = -9999. 565 ELSE 566 tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 567 ENDIF 568 END DO 569 END DO 570 ENDIF 565 571 #else 566 DO jj= j1 ,j2 567 DO ji = i1, i2 568 IF( vmask(ji,jj,1) == 0. ) THEN 569 tabres(ji,jj) = -9999. 570 ELSE 571 tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 572 ENDIF 573 END DO 574 END DO 572 IF( before ) THEN 573 DO jj= j1 ,j2 574 DO ji = i1, i2 575 IF( vmask(ji,jj,1) == 0. ) THEN 576 tabres(ji,jj) = -9999. 577 ELSE 578 tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 579 ENDIF 580 END DO 581 END DO 582 ENDIF 575 583 #endif 576 584 END SUBROUTINE interp_v_ice 577 585 578 586 579 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 )587 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before ) 580 588 !!----------------------------------------------------------------------- 581 589 !! *** ROUTINE interp_adv_ice *** … … 587 595 INTEGER, INTENT(in) :: i1, i2, j1, j2 588 596 REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres 597 LOGICAL, INTENT(in) :: before 589 598 !! 590 599 INTEGER :: ji, jj, jk 591 600 !!----------------------------------------------------------------------- 592 601 ! 593 DO jj=j1,j2 594 DO ji=i1,i2 595 IF( tms(ji,jj) == 0. ) THEN 596 tabres(ji,jj,:) = -9999. 597 ELSE 598 tabres(ji,jj, 1) = frld (ji,jj) 599 tabres(ji,jj, 2) = hicif (ji,jj) 600 tabres(ji,jj, 3) = hsnif (ji,jj) 601 tabres(ji,jj, 4) = tbif (ji,jj,1) 602 tabres(ji,jj, 5) = tbif (ji,jj,2) 603 tabres(ji,jj, 6) = tbif (ji,jj,3) 604 tabres(ji,jj, 7) = qstoif(ji,jj) 605 ENDIF 606 END DO 607 END DO 602 IF( before ) THEN 603 DO jj=j1,j2 604 DO ji=i1,i2 605 IF( tms(ji,jj) == 0. ) THEN 606 tabres(ji,jj,:) = -9999. 607 ELSE 608 tabres(ji,jj, 1) = frld (ji,jj) 609 tabres(ji,jj, 2) = hicif (ji,jj) 610 tabres(ji,jj, 3) = hsnif (ji,jj) 611 tabres(ji,jj, 4) = tbif (ji,jj,1) 612 tabres(ji,jj, 5) = tbif (ji,jj,2) 613 tabres(ji,jj, 6) = tbif (ji,jj,3) 614 tabres(ji,jj, 7) = qstoif(ji,jj) 615 ENDIF 616 END DO 617 END DO 618 ENDIF 608 619 ! 609 620 END SUBROUTINE interp_adv_ice
Note: See TracChangeset
for help on using the changeset viewer.
