Changeset 10251 for branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
- Timestamp:
- 2018-10-29T15:20:26+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
r10248 r10251 9 9 !! 3.4 ! 09-2012 (R. Benshila, C. Herbaut) update and EVP 10 10 !!---------------------------------------------------------------------- 11 #if defined key_agrif && defined key_lim2 11 #if defined key_agrif && defined key_lim2 12 12 !!---------------------------------------------------------------------- 13 13 !! 'key_lim2' : LIM 2.0 sea-ice model … … 41 41 PUBLIC interp_adv_ice 42 42 43 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr44 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr45 46 47 43 !!---------------------------------------------------------------------- 48 44 !! NEMO/NST 3.4 , NEMO Consortium (2012) … … 69 65 u_ice_nst(:,:) = 0. 70 66 v_ice_nst(:,:) = 0. 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. )67 CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. ) 68 CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. ) 73 69 Agrif_SpecialValue=0. 74 70 Agrif_UseSpecialValue = .FALSE. … … 142 138 !! we are in inside a new parent ice time step 143 139 !!----------------------------------------------------------------------- 140 REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice 144 141 INTEGER :: ji,jj 145 142 REAL(wp) :: zrhox, zrhoy … … 158 155 Agrif_SpecialValue=-9999. 159 156 Agrif_UseSpecialValue = .TRUE. 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.) 157 zuice = 0. 158 zvice = 0. 159 CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.) 160 CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.) 167 161 Agrif_SpecialValue=0. 168 162 Agrif_UseSpecialValue = .FALSE. 169 163 ! 170 164 zrhox = agrif_rhox() ; zrhoy = agrif_rhoy() 171 uice_agr(:,:) = uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)172 vice_agr(:,:) = vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)165 zuice(:,:) = zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1) 166 zvice(:,:) = zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1) 173 167 ! fill boundaries 174 168 DO jj = 1, jpj 175 169 DO ji = 1, 2 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)170 u_ice_oe(ji, jj,2) = zuice(ji ,jj) 171 u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj) 178 172 END DO 179 173 END DO 180 174 DO jj = 1, jpj 181 v_ice_oe(2,jj,2) = vice_agr(2 ,jj)182 v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj)175 v_ice_oe(2,jj,2) = zvice(2 ,jj) 176 v_ice_oe(4,jj,2) = zvice(nlci-1,jj) 183 177 END DO 184 178 DO ji = 1, jpi 185 u_ice_sn(ji,2,2) = uice_agr(ji,2 )186 u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1)179 u_ice_sn(ji,2,2) = zuice(ji,2 ) 180 u_ice_sn(ji,4,2) = zuice(ji,nlcj-1) 187 181 END DO 188 182 DO jj = 1, 2 189 183 DO ji = 1, jpi 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)184 v_ice_sn(ji,jj ,2) = zvice(ji,jj ) 185 v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3) 192 186 END DO 193 187 END DO … … 340 334 !! we are in inside a new parent ice time step 341 335 !!----------------------------------------------------------------------- 336 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 342 337 INTEGER :: ji,jj,jn 343 338 !!----------------------------------------------------------------------- … … 350 345 adv_ice_sn(:,:,:,1) = adv_ice_sn(:,:,:,2) 351 346 ! interpolation of boundaries 352 IF(.NOT.ALLOCATED(tabice_agr))THEN 353 ALLOCATE(tabice_agr(jpi,jpj,7)) 354 ENDIF 355 tabice_agr(:,:,:) = 0. 347 ztab(:,:,:) = 0. 356 348 Agrif_SpecialValue=-9999. 357 349 Agrif_UseSpecialValue = .TRUE. 358 CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. )350 CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 359 351 Agrif_SpecialValue=0. 360 352 Agrif_UseSpecialValue = .FALSE. … … 364 356 DO jj = 1, jpj 365 357 DO ji=1,2 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)358 adv_ice_oe(ji ,jj,jn,2) = ztab(ji ,jj,jn) 359 adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn) 368 360 END DO 369 361 END DO … … 373 365 Do jj =1,2 374 366 DO ji = 1, jpi 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)367 adv_ice_sn(ji,jj ,jn,2) = ztab(ji,jj ,jn) 368 adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn) 377 369 END DO 378 370 END DO … … 392 384 INTEGER :: ji,jj,jn 393 385 REAL(wp) :: zalpha 394 REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr386 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab 395 387 !!----------------------------------------------------------------------- 396 388 ! … … 399 391 zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) 400 392 ! 401 tabice_agr(:,:,:) = 0.e0393 ztab(:,:,:) = 0.e0 402 394 DO jn =1,7 403 395 DO jj =1,2 404 396 DO ji = 1, jpi 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)397 ztab(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2) 398 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) 407 399 END DO 408 400 END DO … … 412 404 DO jj = 1, jpj 413 405 DO ji=1,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)416 END DO 417 END DO 418 END DO 419 ! 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 )406 ztab(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2) 407 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) 408 END DO 409 END DO 410 END DO 411 ! 412 CALL parcoursT( ztab(:,:, 1), frld ) 413 CALL parcoursT( ztab(:,:, 2), hicif ) 414 CALL parcoursT( ztab(:,:, 3), hsnif ) 415 CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) ) 416 CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) ) 417 CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) ) 418 CALL parcoursT( ztab(:,:, 7), qstoif ) 427 419 ! 428 420 END SUBROUTINE agrif_trp_lim2 … … 507 499 508 500 509 SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 , before)501 SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 ) 510 502 !!----------------------------------------------------------------------- 511 503 !! *** ROUTINE interp_u_ice *** … … 513 505 INTEGER, INTENT(in) :: i1, i2, j1, j2 514 506 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 515 LOGICAL, INTENT(in) :: before516 507 !! 517 508 INTEGER :: ji,jj … … 519 510 ! 520 511 #if defined key_lim2_vp 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 512 DO jj=MAX(j1,2),j2 513 DO ji=MAX(i1,2),i2 514 IF( tmu(ji,jj) == 0. ) THEN 515 tabres(ji,jj) = -9999. 516 ELSE 517 tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 518 ENDIF 519 END DO 520 END DO 532 521 #else 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 522 DO jj= j1, j2 523 DO ji= i1, i2 524 IF( umask(ji,jj,1) == 0. ) THEN 525 tabres(ji,jj) = -9999. 526 ELSE 527 tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 528 ENDIF 529 END DO 530 END DO 544 531 #endif 545 532 END SUBROUTINE interp_u_ice 546 533 547 534 548 SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 , before)535 SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 ) 549 536 !!----------------------------------------------------------------------- 550 537 !! *** ROUTINE interp_v_ice *** … … 552 539 INTEGER, INTENT(in) :: i1, i2, j1, j2 553 540 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 554 LOGICAL, INTENT(in) :: before555 541 !! 556 542 INTEGER :: ji, jj … … 558 544 ! 559 545 #if defined key_lim2_vp 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 546 DO jj=MAX(j1,2),j2 547 DO ji=MAX(i1,2),i2 548 IF( tmu(ji,jj) == 0. ) THEN 549 tabres(ji,jj) = -9999. 550 ELSE 551 tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 552 ENDIF 553 END DO 554 END DO 571 555 #else 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 556 DO jj= j1 ,j2 557 DO ji = i1, i2 558 IF( vmask(ji,jj,1) == 0. ) THEN 559 tabres(ji,jj) = -9999. 560 ELSE 561 tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 562 ENDIF 563 END DO 564 END DO 583 565 #endif 584 566 END SUBROUTINE interp_v_ice 585 567 586 568 587 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 , before)569 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 ) 588 570 !!----------------------------------------------------------------------- 589 571 !! *** ROUTINE interp_adv_ice *** … … 595 577 INTEGER, INTENT(in) :: i1, i2, j1, j2 596 578 REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres 597 LOGICAL, INTENT(in) :: before598 579 !! 599 580 INTEGER :: ji, jj, jk 600 581 !!----------------------------------------------------------------------- 601 582 ! 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 583 DO jj=j1,j2 584 DO ji=i1,i2 585 IF( tms(ji,jj) == 0. ) THEN 586 tabres(ji,jj,:) = -9999. 587 ELSE 588 tabres(ji,jj, 1) = frld (ji,jj) 589 tabres(ji,jj, 2) = hicif (ji,jj) 590 tabres(ji,jj, 3) = hsnif (ji,jj) 591 tabres(ji,jj, 4) = tbif (ji,jj,1) 592 tabres(ji,jj, 5) = tbif (ji,jj,2) 593 tabres(ji,jj, 6) = tbif (ji,jj,3) 594 tabres(ji,jj, 7) = qstoif(ji,jj) 595 ENDIF 596 END DO 597 END DO 619 598 ! 620 599 END SUBROUTINE interp_adv_ice
Note: See TracChangeset
for help on using the changeset viewer.
