New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5621 for branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90 – NEMO

Ignore:
Timestamp:
2015-07-21T13:25:36+02:00 (9 years ago)
Author:
mathiot
Message:

UKMO_ISF: upgrade to NEMO_3.6_STABLE (r5554)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r5134 r5621  
    9191      !!------------------------------------------------------------------ 
    9292 
    93       CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer 
    94       CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer 
     93      CALL wrk_alloc( jpi,jpj, zremap_flag ) 
     94      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) 
    9595      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    9696      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    9797      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    9898      CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    99       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer  
     99      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    100100      CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 
    101101 
     
    128128               rswitch           = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) )     !0 if no ice and 1 if yes 
    129129               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch 
    130                rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) )    !0 if no ice and 1 if yes 
     130               rswitch           = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) ) 
    131131               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 
    132 !clem               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
    133                zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
     132               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement?  
    134133            END DO 
    135134         END DO 
     
    173172            ! 
    174173            zhbnew(ii,ij,jl) = hi_max(jl) 
    175             IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
     174            IF    ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
    176175               !interpolate between adjacent category growth rates 
    177176               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 
    178177               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 
    179             ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN 
     178            ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN 
    180179               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
    181             ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN 
     180            ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN 
    182181               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    183182            ENDIF 
     
    188187            ii = nind_i(ji) 
    189188            ij = nind_j(ji) 
    190             IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 
     189 
     190            ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible  
     191            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
     192            IF    ( a_i(ii,ij,jl  ) > epsi10 .AND. ht_i(ii,ij,jl  ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN 
    191193               zremap_flag(ii,ij) = 0 
    192             ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 
     194            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN 
    193195               zremap_flag(ii,ij) = 0 
    194196            ENDIF 
    195197 
    196198            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
     199            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
    197200            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 
    198             IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     201            ! clem bug: why is not the following instead? 
     202            !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     203            !!IF( zhbnew(ii,ij,jl) > hi_max(jl  ) ) zremap_flag(ii,ij) = 0 
     204  
    199205         END DO 
    200206 
     
    220226      DO jj = 1, jpj 
    221227         DO ji = 1, jpi 
    222             zhb0(ji,jj) = hi_max(0) ! 0eme 
    223             zhb1(ji,jj) = hi_max(1) ! 1er 
    224  
    225             zhbnew(ji,jj,klbnd-1) = 0._wp 
     228            zhb0(ji,jj) = hi_max(0) 
     229            zhb1(ji,jj) = hi_max(1) 
    226230 
    227231            IF( a_i(ji,jj,kubnd) > epsi10 ) THEN 
    228232               zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) ) 
    229233            ELSE 
    230                zhbnew(ji,jj,kubnd) = hi_max(kubnd)   
    231                !!? clem bug: since hi_max(jpl)=99, this limit is very high  
    232                !!? but I think it is erased in fitline subroutine  
     234!clem bug               zhbnew(ji,jj,kubnd) = hi_max(kubnd)   
     235               zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway 
     236            ENDIF 
     237 
     238            ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible  
     239            ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
     240            IF    ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) )  THEN 
     241               zremap_flag(ji,jj) = 0 
     242            ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) )  THEN 
     243               zremap_flag(ji,jj) = 0 
    233244            ENDIF 
    234245 
     
    249260 
    250261         IF( a_i(ii,ij,klbnd) > epsi10 ) THEN 
     262 
    251263            zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category 
    252             IF( zdh0 < 0.0 ) THEN !remove area from category 1 
     264 
     265            IF( zdh0 < 0.0 ) THEN      !remove area from category 1 
    253266               zdh0 = MIN( -zdh0, hi_max(klbnd) ) 
    254  
    255267               !Integrate g(1) from 0 to dh0 to estimate area melted 
    256268               zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd) 
     269 
    257270               IF( zetamax > 0.0 ) THEN 
    258                   zx1  = zetamax 
    259                   zx2  = 0.5 * zetamax * zetamax  
    260                   zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed 
    261                   ! Constrain new thickness <= ht_i 
    262                   zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! zdamax > 0 
    263                   !ice area lost due to melting of thin ice 
    264                   zda0   = MIN( zda0, zdamax ) 
    265  
     271                  zx1    = zetamax 
     272                  zx2    = 0.5 * zetamax * zetamax  
     273                  zda0   = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1                        ! ice area removed 
     274                  zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i                 
     275                  zda0   = MIN( zda0, zdamax )                                                  ! ice area lost due to melting  
     276                                                                                                !     of thin ice (zdamax > 0) 
    266277                  ! Remove area, conserving volume 
    267278                  ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 
     
    270281               ENDIF 
    271282 
    272             ELSE ! if ice accretion ! a_i > epsi10; zdh0 > 0 
     283            ELSE ! if ice accretion zdh0 > 0 
     284               ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1) 
    273285               zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) )  
    274                ! zhbnew was 0, and is shifted to the right to account for thin ice 
    275                ! growth in openwater (F0 = f1) 
    276             ENDIF ! zdh0  
    277  
    278          ENDIF ! a_i > epsi10 
     286            ENDIF 
     287 
     288         ENDIF 
    279289 
    280290      END DO 
     
    304314 
    305315            IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1 
    306  
    307316               ! left and right integration limits in eta space 
    308317               zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl) 
    309                zvetamax(ji) = MIN (zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl) 
     318               zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl) 
    310319               zdonor(ii,ij,jl) = jl 
    311320 
    312             ELSE  ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    313  
     321            ELSE                                    ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 
    314322               ! left and right integration limits in eta space 
    315323               zvetamin(ji) = 0.0 
     
    317325               zdonor(ii,ij,jl) = jl + 1 
    318326 
    319             ENDIF  ! zhbnew(jl) > hi_max(jl) 
     327            ENDIF 
    320328 
    321329            zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin 
     
    334342 
    335343         END DO 
    336       END DO ! jl klbnd -> kubnd - 1 
     344      END DO 
    337345 
    338346      !!---------------------------------------------------------------------------------------------- 
     
    376384      ENDIF 
    377385 
    378       CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer 
    379       CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer 
     386      CALL wrk_dealloc( jpi,jpj, zremap_flag ) 
     387      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) 
    380388      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    381389      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    382390      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    383391      CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )    
    384       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer  
     392      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )  
    385393      CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 
    386394 
     
    407415      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) ::   zremap_flag  ! 
    408416      ! 
    409       INTEGER ::   ji,jj           ! horizontal indices 
     417      INTEGER  ::   ji,jj        ! horizontal indices 
    410418      REAL(wp) ::   zh13         ! HbL + 1/3 * (HbR - HbL) 
    411419      REAL(wp) ::   zh23         ! HbL + 2/3 * (HbR - HbL) 
     
    414422      !!------------------------------------------------------------------ 
    415423      ! 
    416       ! 
    417424      DO jj = 1, jpj 
    418425         DO ji = 1, jpi 
    419426            ! 
    420427            IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10   & 
    421                &                        .AND. hice(ji,jj)        > 0._wp     ) THEN 
     428               &                        .AND. hice(ji,jj)        > 0._wp ) THEN 
    422429 
    423430               ! Initialize hL and hR 
    424  
    425431               hL(ji,jj) = HbL(ji,jj) 
    426432               hR(ji,jj) = HbR(ji,jj) 
    427433 
    428434               ! Change hL or hR if hice falls outside central third of range 
    429  
    430435               zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) ) 
    431436               zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) ) 
     
    436441 
    437442               ! Compute coefficients of g(eta) = g0 + g1*eta 
    438  
    439443               zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj)) 
    440444               zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr 
     
    443447               g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 ) 
    444448               ! 
    445             ELSE                   ! remap_flag = .false. or a_i < epsi10  
     449            ELSE  ! remap_flag = .false. or a_i < epsi10  
    446450               hL(ji,jj) = 0._wp 
    447451               hR(ji,jj) = 0._wp 
    448452               g0(ji,jj) = 0._wp 
    449453               g1(ji,jj) = 0._wp 
    450             ENDIF                  ! a_i > epsi10 
     454            ENDIF 
    451455            ! 
    452456         END DO 
     
    472476 
    473477      INTEGER ::   ji, jj, jl, jl2, jl1, jk   ! dummy loop indices 
    474       INTEGER ::   ii, ij          ! indices when changing from 2D-1D is done 
     478      INTEGER ::   ii, ij                     ! indices when changing from 2D-1D is done 
    475479 
    476480      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaTsfn 
     
    485489      INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions 
    486490 
    487       INTEGER ::   nbrem             ! number of cells with ice to transfer 
    488  
    489       LOGICAL ::   zdaice_negative         ! true if daice < -puny 
    490       LOGICAL ::   zdvice_negative         ! true if dvice < -puny 
    491       LOGICAL ::   zdaice_greater_aicen    ! true if daice > aicen 
    492       LOGICAL ::   zdvice_greater_vicen    ! true if dvice > vicen 
     491      INTEGER  ::   nbrem             ! number of cells with ice to transfer 
    493492      !!------------------------------------------------------------------ 
    494493 
    495494      CALL wrk_alloc( jpi,jpj,jpl, zaTsfn ) 
    496495      CALL wrk_alloc( jpi,jpj, zworka ) 
    497       CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
     496      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    498497 
    499498      !---------------------------------------------------------------------------------------------- 
     
    505504      END DO 
    506505 
    507 !clem: I think the following is wrong (if enabled, it creates negative concentration/volume around -epsi10) 
    508 !      !---------------------------------------------------------------------------------------------- 
    509 !      ! 2) Check for daice or dvice out of range, allowing for roundoff error 
    510 !      !---------------------------------------------------------------------------------------------- 
    511 !      ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl 
    512 !      ! has a small area, with h(n) very close to a boundary.  Then 
    513 !      ! the coefficients of g(h) are large, and the computed daice and 
    514 !      ! dvice can be in error. If this happens, it is best to transfer 
    515 !      ! either the entire category or nothing at all, depending on which 
    516 !      ! side of the boundary hice(n) lies. 
    517 !      !----------------------------------------------------------------- 
    518 !      DO jl = klbnd, kubnd-1 
    519 ! 
    520 !         zdaice_negative = .false. 
    521 !         zdvice_negative = .false. 
    522 !         zdaice_greater_aicen = .false. 
    523 !         zdvice_greater_vicen = .false. 
    524 ! 
    525 !         DO jj = 1, jpj 
    526 !            DO ji = 1, jpi 
    527 ! 
    528 !               IF (zdonor(ji,jj,jl) > 0) THEN 
    529 !                  jl1 = zdonor(ji,jj,jl) 
    530 ! 
    531 !                  IF (zdaice(ji,jj,jl) < 0.0) THEN 
    532 !                     IF (zdaice(ji,jj,jl) > -epsi10) THEN 
    533 !                        IF ( ( jl1 == jl   .AND. ht_i(ji,jj,jl1) >  hi_max(jl) ) .OR.  & 
    534 !                             ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN 
    535 !                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category 
    536 !                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
    537 !                        ELSE 
    538 !                           zdaice(ji,jj,jl) = 0.0 ! shift no ice 
    539 !                           zdvice(ji,jj,jl) = 0.0 
    540 !                        ENDIF 
    541 !                     ELSE 
    542 !                        zdaice_negative = .true. 
    543 !                     ENDIF 
    544 !                  ENDIF 
    545 ! 
    546 !                  IF (zdvice(ji,jj,jl) < 0.0) THEN 
    547 !                     IF (zdvice(ji,jj,jl) > -epsi10 ) THEN 
    548 !                        IF ( ( jl1 == jl   .AND. ht_i(ji,jj,jl1) >  hi_max(jl) ) .OR.  & 
    549 !                             ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN 
    550 !                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category 
    551 !                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    552 !                        ELSE 
    553 !                           zdaice(ji,jj,jl) = 0.0    ! shift no ice 
    554 !                           zdvice(ji,jj,jl) = 0.0 
    555 !                        ENDIF 
    556 !                    ELSE 
    557 !                       zdvice_negative = .true. 
    558 !                    ENDIF 
    559 !                 ENDIF 
    560 ! 
    561 !                  ! If daice is close to aicen, set daice = aicen. 
    562 !                  IF (zdaice(ji,jj,jl) > a_i(ji,jj,jl1) - epsi10 ) THEN 
    563 !                     IF (zdaice(ji,jj,jl) < a_i(ji,jj,jl1)+epsi10) THEN 
    564 !                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    565 !                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    566 !                    ELSE 
    567 !                       zdaice_greater_aicen = .true. 
    568 !                    ENDIF 
    569 !                  ENDIF 
    570 ! 
    571 !                  IF (zdvice(ji,jj,jl) > v_i(ji,jj,jl1)-epsi10) THEN 
    572 !                     IF (zdvice(ji,jj,jl) < v_i(ji,jj,jl1)+epsi10) THEN 
    573 !                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1) 
    574 !                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1)  
    575 !                     ELSE 
    576 !                        zdvice_greater_vicen = .true. 
    577 !                     ENDIF 
    578 !                  ENDIF 
    579 ! 
    580 !               ENDIF               ! donor > 0 
    581 !            END DO 
    582 !         END DO 
    583 ! 
    584 !      END DO 
    585 !clem 
    586506      !------------------------------------------------------------------------------- 
    587       ! 3) Transfer volume and energy between categories 
     507      ! 2) Transfer volume and energy between categories 
    588508      !------------------------------------------------------------------------------- 
    589509 
     
    605525 
    606526            jl1 = zdonor(ii,ij,jl) 
    607             rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi20 ) ) 
    608             zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi20 ) * rswitch 
     527            rswitch       = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) ) 
     528            zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch 
    609529            IF( jl1 == jl) THEN   ;   jl2 = jl1+1 
    610530            ELSE                  ;   jl2 = jl  
     
    614534            ! Ice areas 
    615535            !-------------- 
    616  
    617536            a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl) 
    618537            a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl) 
     
    621540            ! Ice volumes 
    622541            !-------------- 
    623  
    624542            v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl)  
    625543            v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl) 
     
    628546            ! Snow volumes 
    629547            !-------------- 
    630  
    631548            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij) 
    632549            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
     
    636553            ! Snow heat content   
    637554            !-------------------- 
    638  
    639555            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
    640556            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
     
    644560            ! Ice age  
    645561            !-------------- 
    646  
    647562            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
    648563            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
     
    652567            ! Ice salinity 
    653568            !-------------- 
    654  
    655569            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij) 
    656570            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
     
    660574            ! Surface temperature 
    661575            !--------------------- 
    662  
    663576            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
    664577            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
     
    711624      CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) 
    712625      CALL wrk_dealloc( jpi,jpj, zworka ) 
    713       CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
     626      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 
    714627      ! 
    715628   END SUBROUTINE lim_itd_shiftice 
     
    737650      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
    738651      !!------------------------------------------------------------------ 
    739       !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 
    740652       
    741653      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger 
     
    845757         ENDIF 
    846758 
    847 !         ! clem-change begin: why not doing that? 
    848 !         DO jj = 1, jpj 
    849 !            DO ji = 1, jpi 
    850 !               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    851 !                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
    852 !                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    853 !               ENDIF 
    854 !            END DO 
    855 !         END DO 
    856          ! clem-change end 
    857  
    858759      END DO 
    859760 
     
    872773      ENDIF 
    873774      ! 
    874       CALL wrk_dealloc( jpi,jpj,jpl, zdonor )   ! interger 
     775      CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) 
    875776      CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice ) 
    876777      CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) 
Note: See TracChangeset for help on using the changeset viewer.