Changeset 9943 for NEMO/trunk/src/ICE/icevar.F90
- Timestamp:
- 2018-07-13T16:15:22+02:00 (6 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/ICE/icevar.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icevar.F90
r9935 r9943 44 44 !! ice_var_salprof1d : salinity profile in the ice 1D 45 45 !! ice_var_zapsmall : remove very small area and volume 46 !! ice_var_zapneg : remove negative ice fields (to debug the advection scheme UM3-5) 46 47 !! ice_var_itd : convert 1-cat to jpl-cat 47 48 !! ice_var_itd2 : convert N-cat to jpl-cat … … 68 69 PUBLIC ice_var_salprof1d 69 70 PUBLIC ice_var_zapsmall 71 PUBLIC ice_var_zapneg 70 72 PUBLIC ice_var_itd 71 73 PUBLIC ice_var_itd2 … … 462 464 DO jl = 1, jpl !== loop over the categories ==! 463 465 ! 466 WHERE( a_i(:,:,jl) > epsi10 ) ; h_i(:,:,jl) = v_i(:,:,jl) / a_i(:,:,jl) 467 ELSEWHERE ; h_i(:,:,jl) = 0._wp 468 END WHERE 469 ! 470 WHERE( a_i(:,:,jl) < epsi10 .OR. v_i(:,:,jl) < epsi10 .OR. h_i(:,:,jl) < epsi10 ) ; zswitch(:,:) = 0._wp 471 ELSEWHERE ; zswitch(:,:) = 1._wp 472 END WHERE 473 ! 464 474 !----------------------------------------------------------------- 465 475 ! Zap ice energy and use ocean heat to melt ice 466 476 !----------------------------------------------------------------- 467 WHERE( a_i(:,:,jl) > epsi10 ) ; h_i(:,:,jl) = v_i(:,:,jl) / a_i(:,:,jl)468 ELSEWHERE ; h_i(:,:,jl) = 0._wp469 END WHERE470 !471 WHERE( a_i(:,:,jl) < epsi10 .OR. v_i(:,:,jl) < epsi10 .OR. h_i(:,:,jl) < epsi10 ) ; zswitch(:,:) = 0._wp472 ELSEWHERE ; zswitch(:,:) = 1._wp473 END WHERE474 !475 477 DO jk = 1, nlay_i 476 478 DO jj = 1 , jpj … … 495 497 END DO 496 498 ! 499 !----------------------------------------------------------------- 500 ! zap ice and snow volume, add water and salt to ocean 501 !----------------------------------------------------------------- 497 502 DO jj = 1 , jpj 498 503 DO ji = 1 , jpi … … 502 507 wfx_res(ji,jj) = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl) * rhos * r1_rdtice 503 508 ! 504 !-----------------------------------------------------------------505 ! zap ice and snow volume, add water and salt to ocean506 !-----------------------------------------------------------------507 509 a_i (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 508 510 v_i (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj) … … 533 535 534 536 537 SUBROUTINE ice_var_zapneg( pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 538 !!------------------------------------------------------------------- 539 !! *** ROUTINE ice_var_zapneg *** 540 !! 541 !! ** Purpose : Remove negative sea ice fields and correct fluxes 542 !!------------------------------------------------------------------- 543 INTEGER :: ji, jj, jl, jk ! dummy loop indices 544 ! 545 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pato_i ! open water area 546 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i ! ice volume 547 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_s ! snw volume 548 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: psv_i ! salt content 549 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: poa_i ! age content 550 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_i ! ice concentration 551 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pa_ip ! melt pond fraction 552 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_ip ! melt pond volume 553 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s ! snw heat content 554 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i ! ice heat content 555 !!------------------------------------------------------------------- 556 ! 557 WHERE( pato_i(:,:) < 0._wp ) pato_i(:,:) = 0._wp 558 WHERE( poa_i (:,:,:) < 0._wp ) poa_i (:,:,:) = 0._wp 559 WHERE( pa_i (:,:,:) < 0._wp ) pa_i (:,:,:) = 0._wp 560 WHERE( pa_ip (:,:,:) < 0._wp ) pa_ip (:,:,:) = 0._wp 561 WHERE( pv_ip (:,:,:) < 0._wp ) pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 562 ! but it does not change conservation, so keep it this way is ok 563 ! 564 DO jl = 1, jpl !== loop over the categories ==! 565 ! 566 !---------------------------------------- 567 ! zap ice energy and send it to the ocean 568 !---------------------------------------- 569 DO jk = 1, nlay_i 570 DO jj = 1 , jpj 571 DO ji = 1 , jpi 572 IF( pe_i(ji,jj,jk,jl) < 0._wp ) THEN 573 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 574 pe_i(ji,jj,jk,jl) = 0._wp 575 ENDIF 576 END DO 577 END DO 578 END DO 579 ! 580 DO jk = 1, nlay_s 581 DO jj = 1 , jpj 582 DO ji = 1 , jpi 583 IF( pe_s(ji,jj,jk,jl) < 0._wp ) THEN 584 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 585 pe_s(ji,jj,jk,jl) = 0._wp 586 ENDIF 587 END DO 588 END DO 589 END DO 590 ! 591 !----------------------------------------------------- 592 ! zap ice and snow volume, add water and salt to ocean 593 !----------------------------------------------------- 594 DO jj = 1 , jpj 595 DO ji = 1 , jpi 596 IF( pv_i(ji,jj,jl) < 0._wp ) THEN 597 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * r1_rdtice 598 pv_i (ji,jj,jl) = 0._wp 599 ENDIF 600 IF( pv_s(ji,jj,jl) < 0._wp ) THEN 601 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * r1_rdtice 602 pv_s (ji,jj,jl) = 0._wp 603 ENDIF 604 IF( psv_i(ji,jj,jl) < 0._wp ) THEN 605 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * r1_rdtice 606 psv_i (ji,jj,jl) = 0._wp 607 ENDIF 608 END DO 609 END DO 610 ! 611 END DO 612 ! 613 END SUBROUTINE ice_var_zapneg 614 615 535 616 SUBROUTINE ice_var_itd( zhti, zhts, zati, zh_i, zh_s, za_i ) 536 617 !!-------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
