Changeset 13469


Ignore:
Timestamp:
2020-09-15T12:49:18+02:00 (4 months ago)
Author:
smasson
Message:

r4_trunk: first change of DO loops for routines to be merged, see #2523

Location:
NEMO/branches/2020/temporary_r4_trunk
Files:
32 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icealb.F90

    r13466 r13469  
    122122      ! 
    123123      DO jl = 1, jpl 
    124          DO jj = 1, jpj 
    125             DO ji = 1, jpi 
    126                ! 
    127                !---------------------------------------------! 
    128                !--- Specific snow, ice and pond fractions ---! 
    129                !---------------------------------------------!                
    130                zafrac_snw = za_s_fra(ji,jj,jl) 
    131                IF( ld_pnd_alb ) THEN 
    132                   zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1 
    133                ELSE 
    134                   zafrac_pnd = 0._wp 
    135                ENDIF 
    136                zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors 
    137                ! 
    138                !---------------! 
    139                !--- Albedos ---! 
    140                !---------------!                
    141                !                       !--- Bare ice albedo (for hi > 150cm) 
    142                IF( ld_pnd_alb ) THEN 
    143                   zalb_ice = rn_alb_idry 
    144                ELSE 
    145                   IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN   ;   zalb_ice = rn_alb_imlt 
    146                   ELSE                                                                ;   zalb_ice = rn_alb_idry   ;   ENDIF 
    147                ENDIF 
    148                !                       !--- Bare ice albedo (for hi < 150cm) 
    149                IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN      ! 5cm < hi < 150cm 
    150                   zalb_ice = zalb_ice    + ( 0.18 - zalb_ice   ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) ) 
    151                ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN                               ! 0cm < hi < 5cm 
    152                   zalb_ice = rn_alb_oce  + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 
    153                ENDIF 
    154                ! 
    155                !                       !--- Snow-covered ice albedo (freezing, melting cases) 
    156                IF( pt_su(ji,jj,jl) < rt0 ) THEN 
    157                   zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 ) 
    158                ELSE 
    159                   zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 ) 
    160                ENDIF 
    161                !                       !--- Ponded ice albedo 
    162                zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd )  
    163                ! 
    164                !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 
    165                zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
    166                ! 
    167                zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  & 
    168                   &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 
    169                ! 
    170                ! albedo depends on cloud fraction because of non-linear spectral effects 
    171                palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 
    172  
    173             END DO 
    174          END DO 
     124         DO_2D_11_11 
     125            ! 
     126            !---------------------------------------------! 
     127            !--- Specific snow, ice and pond fractions ---! 
     128            !---------------------------------------------!                
     129            zafrac_snw = za_s_fra(ji,jj,jl) 
     130            IF( ld_pnd_alb ) THEN 
     131               zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1 
     132            ELSE 
     133               zafrac_pnd = 0._wp 
     134            ENDIF 
     135            zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors 
     136            ! 
     137            !---------------! 
     138            !--- Albedos ---! 
     139            !---------------!                
     140            !                       !--- Bare ice albedo (for hi > 150cm) 
     141            IF( ld_pnd_alb ) THEN 
     142               zalb_ice = rn_alb_idry 
     143            ELSE 
     144               IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN   ;   zalb_ice = rn_alb_imlt 
     145               ELSE                                                                ;   zalb_ice = rn_alb_idry   ;   ENDIF 
     146            ENDIF 
     147            !                       !--- Bare ice albedo (for hi < 150cm) 
     148            IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN      ! 5cm < hi < 150cm 
     149               zalb_ice = zalb_ice    + ( 0.18 - zalb_ice   ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) ) 
     150            ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN                               ! 0cm < hi < 5cm 
     151               zalb_ice = rn_alb_oce  + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 
     152            ENDIF 
     153            ! 
     154            !                       !--- Snow-covered ice albedo (freezing, melting cases) 
     155            IF( pt_su(ji,jj,jl) < rt0 ) THEN 
     156               zalb_snw = rn_alb_sdry - ( rn_alb_sdry - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c3 ) 
     157            ELSE 
     158               zalb_snw = rn_alb_smlt - ( rn_alb_smlt - zalb_ice ) * EXP( - ph_snw(ji,jj,jl) * z1_c4 ) 
     159            ENDIF 
     160            !                       !--- Ponded ice albedo 
     161            zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd )  
     162            ! 
     163            !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 
     164            zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
     165            ! 
     166            zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  & 
     167               &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 
     168            ! 
     169            ! albedo depends on cloud fraction because of non-linear spectral effects 
     170            palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 
     171 
     172         END_2D 
    175173      END DO 
    176174      ! 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icecor.F90

    r13466 r13469  
    9292         zzc = rhoi * r1_rdtice 
    9393         DO jl = 1, jpl 
    94             DO jj = 1, jpj  
    95                DO ji = 1, jpi 
    96                   zsal = sv_i(ji,jj,jl) 
    97                   sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  ) 
    98                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux 
    99                END DO 
    100             END DO 
     94            DO_2D_11_11 
     95               zsal = sv_i(ji,jj,jl) 
     96               sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  ) 
     97               sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux 
     98            END_2D 
    10199         END DO 
    102100      ENDIF 
     
    107105      !                             !----------------------------------------------------- 
    108106      IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values ! 
    109          DO jj = 2, jpjm1           !----------------------------------------------------- 
    110             DO ji = 2, jpim1 
    111                IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice 
    112                   IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side 
    113                   IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side 
    114                   IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side 
    115                   IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side 
    116                ENDIF 
    117             END DO 
    118          END DO 
     107         DO_2D_00_00 
     108            IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice 
     109               IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side 
     110               IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side 
     111               IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side 
     112               IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side 
     113            ENDIF 
     114         END_2D 
    119115         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 
    120116      ENDIF 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icectl.F90

    r13466 r13469  
    366366      cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 
    367367      DO jl = 1, jpl 
    368          DO jj = 1, jpj 
    369             DO ji = 1, jpi 
    370                IF( v_i(ji,jj,jl) > epsi10  ) THEN 
    371                   IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 
    372                      WRITE(numout,*) ' ALERTE :   Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 
    373                      WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
    374                      inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    375                   ENDIF 
     368         DO_2D_11_11 
     369            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     370               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 
     371                  WRITE(numout,*) ' ALERTE :   Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 
     372                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     373                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    376374               ENDIF 
    377             END DO 
    378          END DO 
     375            ENDIF 
     376         END_2D 
    379377      END DO 
    380378 
     
    383381      cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 
    384382      DO jl = 1, jpl 
    385          DO jj = 1, jpj 
    386             DO ji = 1, jpi 
    387                IF( v_i(ji,jj,jl) > epsi10  ) THEN 
    388                   IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 
    389                      WRITE(numout,*) ' ALERTE :   Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 
    390                      WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
    391                      inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    392                   ENDIF 
     383         DO_2D_11_11 
     384            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     385               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 
     386                  WRITE(numout,*) ' ALERTE :   Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 
     387                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     388                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    393389               ENDIF 
    394             END DO 
    395          END DO 
     390            ENDIF 
     391         END_2D 
    396392      END DO 
    397393 
     
    400396      cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 
    401397      DO jl = 1, jpl 
    402          DO jk = 1, nlay_i 
    403             DO jj = 1, jpj 
    404                DO ji = 1, jpi 
    405                   ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    406                   IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
    407                      WRITE(numout,*) ' ALERTE :   Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 
    408                      WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
    409                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    410                   ENDIF 
    411                END DO 
    412             END DO 
    413          END DO 
     398         DO_3D_11_11( 1, nlay_i ) 
     399            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
     400            IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     401               WRITE(numout,*) ' ALERTE :   Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 
     402               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
     403              inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     404            ENDIF 
     405         END_3D 
    414406      END DO 
    415407   
     
    418410      cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 
    419411      DO jl = 1, jpl 
    420          DO jk = 1, nlay_i 
    421             DO jj = 1, jpj 
    422                DO ji = 1, jpi 
    423                   ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    424                   IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
    425                      WRITE(numout,*) ' ALERTE :   Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 
    426                      WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
    427                     inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    428                   ENDIF 
    429                END DO 
    430             END DO 
    431          END DO 
     412         DO_3D_11_11( 1, nlay_i ) 
     413            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
     414            IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     415               WRITE(numout,*) ' ALERTE :   Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 
     416               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
     417              inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     418            ENDIF 
     419         END_3D 
    432420      END DO 
    433421       
     
    436424      cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 
    437425      jl = jpl  
    438       DO jj = 1, jpj 
    439          DO ji = 1, jpi 
    440             IF( h_i(ji,jj,jl) > 50._wp ) THEN 
    441                WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl) 
    442                WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
    443                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    444             ENDIF 
    445          END DO 
    446       END DO 
     426      DO_2D_11_11 
     427         IF( h_i(ji,jj,jl) > 50._wp ) THEN 
     428            WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl) 
     429            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     430            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     431         ENDIF 
     432      END_2D 
    447433 
    448434      ! Alerte if very thin ice 
     
    450436      cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 
    451437      jl = 1  
    452       DO jj = 1, jpj 
    453          DO ji = 1, jpi 
    454             IF( h_i(ji,jj,jl) < rn_himin ) THEN 
    455                WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl) 
    456                WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
    457                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    458             ENDIF 
    459          END DO 
    460       END DO 
     438      DO_2D_11_11 
     439         IF( h_i(ji,jj,jl) < rn_himin ) THEN 
     440            WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl) 
     441            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     442            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     443         ENDIF 
     444      END_2D 
    461445 
    462446      ! Alert if very fast ice 
    463447      ialert_id = ialert_id + 1 ! reference number of this alert 
    464448      cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 
    465       DO jj = 1, jpj 
    466          DO ji = 1, jpi 
    467             IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 
    468                WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 
    469                WRITE(numout,*) ' at i,j = ',ji,jj 
    470                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    471             ENDIF 
    472          END DO 
    473       END DO 
     449      DO_2D_11_11 
     450         IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 
     451            WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 
     452            WRITE(numout,*) ' at i,j = ',ji,jj 
     453            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     454         ENDIF 
     455      END_2D 
    474456 
    475457      ! Alert if there is ice on continents 
    476458      ialert_id = ialert_id + 1 ! reference number of this alert 
    477459      cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 
    478       DO jj = 1, jpj 
    479          DO ji = 1, jpi 
    480             IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN  
    481                WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
    482                WRITE(numout,*) ' at i,j = ',ji,jj 
    483                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    484             ENDIF 
    485          END DO 
    486       END DO 
     460      DO_2D_11_11 
     461         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN  
     462            WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
     463            WRITE(numout,*) ' at i,j = ',ji,jj 
     464            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     465         ENDIF 
     466      END_2D 
    487467 
    488468      ! Alert if incompatible ice concentration and volume 
    489469      ialert_id = ialert_id + 1 ! reference number of this alert 
    490470      cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 
    491       DO jj = 1, jpj 
    492          DO ji = 1, jpi 
    493             IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
    494                & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN  
    495                WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 
    496                WRITE(numout,*) ' at i,j = ',ji,jj 
    497                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    498             ENDIF 
    499          END DO 
    500       END DO 
     471      DO_2D_11_11 
     472         IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
     473            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN  
     474            WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 
     475            WRITE(numout,*) ' at i,j = ',ji,jj 
     476            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     477         ENDIF 
     478      END_2D 
    501479 
    502480      ! sum of the alerts on all processors 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn.F90

    r13466 r13469  
    127127         ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length 
    128128         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s  
    129          DO jj = 1, jpj 
    130             DO ji = 1, jpi 
    131                zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 
    132                zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 
    133                u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 
    134                v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 
    135             END DO 
    136          END DO 
     129         DO_2D_11_11 
     130            zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 
     131            zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 
     132            u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 
     133            v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 
     134         END_2D 
    137135         ! --- 
    138136         CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice 
     
    158156 
    159157            ALLOCATE( zdivu_i(jpi,jpj) ) 
    160             DO jj = 2, jpjm1 
    161                DO ji = 2, jpim1 
    162                   zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
    163                      &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 
    164                END DO 
    165             END DO 
     158            DO_2D_00_00 
     159               zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     160                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 
     161            END_2D 
    166162            CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 
    167163            ! output 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_pra.F90

    r13466 r13469  
    110110      END WHERE 
    111111      DO jl = 1, jpl 
    112          DO jj = 2, jpjm1 
    113             DO ji = fs_2, fs_jpim1 
    114                zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
    115                   &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
    116                   &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 
    117                   &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 
    118                zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), & 
    119                   &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), & 
    120                   &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 
    121                   &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 
    122                zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), & 
    123                   &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), & 
    124                   &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
    125                   &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
    126                zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), & 
    127                   &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), & 
    128                   &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 
    129                   &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 
    130             END DO 
    131          END DO 
     112         DO_2D_00_00 
     113            zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
     114               &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
     115               &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 
     116               &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 
     117            zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), & 
     118               &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), & 
     119               &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 
     120               &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 
     121            zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), & 
     122               &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), & 
     123               &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
     124               &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
     125            zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), & 
     126               &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), & 
     127               &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 
     128               &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 
     129         END_2D 
    132130      END DO 
    133131      CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1., zsi_max, 'T', 1. ) 
     
    145143      END DO 
    146144      DO jl = 1, jpl 
    147          DO jk = 1, nlay_i 
    148             DO jj = 2, jpjm1 
    149                DO ji = fs_2, fs_jpim1 
    150                   zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
    151                      &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
    152                      &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 
    153                      &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 
    154                END DO 
    155             END DO 
    156          END DO 
     145         DO_3D_00_00( 1, nlay_i ) 
     146            zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
     147               &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
     148               &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 
     149               &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 
     150         END_3D 
    157151      END DO 
    158152      DO jl = 1, jpl 
    159          DO jk = 1, nlay_s 
    160             DO jj = 2, jpjm1 
    161                DO ji = fs_2, fs_jpim1 
    162                   zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
    163                      &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
    164                      &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 
    165                      &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 
    166                END DO 
    167             END DO 
    168          END DO 
     153         DO_3D_00_00( 1, nlay_s ) 
     154            zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
     155               &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
     156               &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 
     157               &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 
     158         END_3D 
    169159      END DO 
    170160      CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 
     
    317307         ! derive open water from ice concentration 
    318308         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
    319          DO jj = 2, jpjm1 
    320             DO ji = fs_2, fs_jpim1 
    321                pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &                        !--- open water 
    322                   &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    323             END DO 
    324          END DO 
     309         DO_2D_00_00 
     310            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &                        !--- open water 
     311               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
     312         END_2D 
    325313         CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T',  1. ) 
    326314         ! 
     
    375363         ! 
    376364         ! Limitation of moments.                                            
    377          DO jj = 2, jpjm1 
    378             DO ji = 1, jpi 
    379                !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    380                psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 
    381                ! 
    382                zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 
    383                zs1max  = 1.5 * zslpmax 
    384                zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 
    385                zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    386                   &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  ) 
    387                rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    388  
    389                ps0 (ji,jj,jl) = zslpmax   
    390                psx (ji,jj,jl) = zs1new         * rswitch 
    391                psxx(ji,jj,jl) = zs2new         * rswitch 
    392                psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 
    393                psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 
    394                psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
    395             END DO 
    396          END DO 
     365         DO_2D_00_11 
     366            !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
     367            psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 
     368            ! 
     369            zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 
     370            zs1max  = 1.5 * zslpmax 
     371            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 
     372            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
     373               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  ) 
     374            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
     375 
     376            ps0 (ji,jj,jl) = zslpmax   
     377            psx (ji,jj,jl) = zs1new         * rswitch 
     378            psxx(ji,jj,jl) = zs2new         * rswitch 
     379            psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 
     380            psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 
     381            psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
     382         END_2D 
    397383 
    398384         !  Calculate fluxes and moments between boxes i<-->i+1               
    399          DO jj = 2, jpjm1                      !  Flux from i to i+1 WHEN u GT 0  
    400             DO ji = 1, jpi 
    401                zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
    402                zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 
    403                zalfq        =  zalf * zalf 
    404                zalf1        =  1.0 - zalf 
    405                zalf1q       =  zalf1 * zalf1 
    406                ! 
    407                zfm (ji,jj)  =  zalf  *   psm (ji,jj,jl) 
    408                zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 
    409                zfx (ji,jj)  =  zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 
    410                zfxx(ji,jj)  =  zalf  *   psxx(ji,jj,jl) * zalfq 
    411                zfy (ji,jj)  =  zalf  * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 
    412                zfxy(ji,jj)  =  zalfq *   psxy(ji,jj,jl) 
    413                zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl) 
    414  
    415                !  Readjust moments remaining in the box. 
    416                psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
    417                ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
    418                psx (ji,jj,jl)  =  zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 
    419                psxx(ji,jj,jl)  =  zalf1  * zalf1q * psxx(ji,jj,jl) 
    420                psy (ji,jj,jl)  =  psy (ji,jj,jl) - zfy(ji,jj) 
    421                psyy(ji,jj,jl)  =  psyy(ji,jj,jl) - zfyy(ji,jj) 
    422                psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
    423             END DO 
    424          END DO 
    425  
    426          DO jj = 2, jpjm1                      !  Flux from i+1 to i when u LT 0. 
    427             DO ji = 1, fs_jpim1 
    428                zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl)  
    429                zalg  (ji,jj) = zalf 
    430                zalfq         = zalf * zalf 
    431                zalf1         = 1.0 - zalf 
    432                zalg1 (ji,jj) = zalf1 
    433                zalf1q        = zalf1 * zalf1 
    434                zalg1q(ji,jj) = zalf1q 
    435                ! 
    436                zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji+1,jj,jl) 
    437                zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) & 
    438                   &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 
    439                zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 
    440                zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq 
    441                zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 
    442                zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl) 
    443                zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl) 
    444             END DO 
    445          END DO 
    446  
    447          DO jj = 2, jpjm1                     !  Readjust moments remaining in the box.  
    448             DO ji = fs_2, fs_jpim1 
    449                zbt  =       zbet(ji-1,jj) 
    450                zbt1 = 1.0 - zbet(ji-1,jj) 
    451                ! 
    452                psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 
    453                ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 
    454                psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 
    455                psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 
    456                psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 
    457                psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 
    458                psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 
    459             END DO 
    460          END DO 
     385         DO_2D_00_11 
     386            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
     387            zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 
     388            zalfq        =  zalf * zalf 
     389            zalf1        =  1.0 - zalf 
     390            zalf1q       =  zalf1 * zalf1 
     391            ! 
     392            zfm (ji,jj)  =  zalf  *   psm (ji,jj,jl) 
     393            zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 
     394            zfx (ji,jj)  =  zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 
     395            zfxx(ji,jj)  =  zalf  *   psxx(ji,jj,jl) * zalfq 
     396            zfy (ji,jj)  =  zalf  * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 
     397            zfxy(ji,jj)  =  zalfq *   psxy(ji,jj,jl) 
     398            zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl) 
     399 
     400            !  Readjust moments remaining in the box. 
     401            psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
     402            ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
     403            psx (ji,jj,jl)  =  zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 
     404            psxx(ji,jj,jl)  =  zalf1  * zalf1q * psxx(ji,jj,jl) 
     405            psy (ji,jj,jl)  =  psy (ji,jj,jl) - zfy(ji,jj) 
     406            psyy(ji,jj,jl)  =  psyy(ji,jj,jl) - zfyy(ji,jj) 
     407            psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
     408         END_2D 
     409 
     410         DO_2D_00_10 
     411            zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl)  
     412            zalg  (ji,jj) = zalf 
     413            zalfq         = zalf * zalf 
     414            zalf1         = 1.0 - zalf 
     415            zalg1 (ji,jj) = zalf1 
     416            zalf1q        = zalf1 * zalf1 
     417            zalg1q(ji,jj) = zalf1q 
     418            ! 
     419            zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji+1,jj,jl) 
     420            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) & 
     421               &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 
     422            zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 
     423            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq 
     424            zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 
     425            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl) 
     426            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl) 
     427         END_2D 
     428 
     429         DO_2D_00_00 
     430            zbt  =       zbet(ji-1,jj) 
     431            zbt1 = 1.0 - zbet(ji-1,jj) 
     432            ! 
     433            psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 
     434            ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 
     435            psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 
     436            psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 
     437            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 
     438            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 
     439            psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 
     440         END_2D 
    461441 
    462442         !   Put the temporary moments into appropriate neighboring boxes.     
    463          DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0. 
    464             DO ji = fs_2, fs_jpim1 
    465                zbt  =       zbet(ji-1,jj) 
    466                zbt1 = 1.0 - zbet(ji-1,jj) 
    467                psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 
    468                zalf          = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 
    469                zalf1         = 1.0 - zalf 
    470                ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 
    471                ! 
    472                ps0 (ji,jj,jl) =  zbt  * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 
    473                psx (ji,jj,jl) =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 
    474                psxx(ji,jj,jl) =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl)                             & 
    475                   &                     + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  ) & 
    476                   &            + zbt1 * psxx(ji,jj,jl) 
    477                psxy(ji,jj,jl) =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl)             & 
    478                   &                     + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj,jl) ) )   & 
    479                   &            + zbt1 * psxy(ji,jj,jl) 
    480                psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 
    481                psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 
    482             END DO 
    483          END DO 
    484  
    485          DO jj = 2, jpjm1                      !  Flux from i+1 to i IF u LT 0. 
    486             DO ji = fs_2, fs_jpim1 
    487                zbt  =       zbet(ji,jj) 
    488                zbt1 = 1.0 - zbet(ji,jj) 
    489                psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 
    490                zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 
    491                zalf1         = 1.0 - zalf 
    492                ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 
    493                ! 
    494                ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 
    495                psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 
    496                psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 
    497                   &                                           + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) )    & 
    498                   &                                           + ( zalf1 - zalf ) * ztemp ) ) 
    499                psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  & 
    500                   &                                           + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 
    501                psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 
    502                psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 
    503             END DO 
    504          END DO 
     443         DO_2D_00_00 
     444            zbt  =       zbet(ji-1,jj) 
     445            zbt1 = 1.0 - zbet(ji-1,jj) 
     446            psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 
     447            zalf          = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 
     448            zalf1         = 1.0 - zalf 
     449            ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 
     450            ! 
     451            ps0 (ji,jj,jl) =  zbt  * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 
     452            psx (ji,jj,jl) =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 
     453            psxx(ji,jj,jl) =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl)                             & 
     454               &                     + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  ) & 
     455               &            + zbt1 * psxx(ji,jj,jl) 
     456            psxy(ji,jj,jl) =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl)             & 
     457               &                     + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj,jl) ) )   & 
     458               &            + zbt1 * psxy(ji,jj,jl) 
     459            psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 
     460            psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 
     461         END_2D 
     462 
     463         DO_2D_00_00 
     464            zbt  =       zbet(ji,jj) 
     465            zbt1 = 1.0 - zbet(ji,jj) 
     466            psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 
     467            zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 
     468            zalf1         = 1.0 - zalf 
     469            ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 
     470            ! 
     471            ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 
     472            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 
     473            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 
     474               &                                           + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) )    & 
     475               &                                           + ( zalf1 - zalf ) * ztemp ) ) 
     476            psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  & 
     477               &                                           + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 
     478            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 
     479            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 
     480         END_2D 
    505481 
    506482      END DO 
     
    544520         ! 
    545521         ! Limitation of moments. 
    546          DO jj = 1, jpj 
    547             DO ji = fs_2, fs_jpim1 
    548                !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    549                psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  ) 
    550                ! 
    551                zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 
    552                zs1max  = 1.5 * zslpmax 
    553                zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 
    554                zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    555                   &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  ) 
    556                rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    557                ! 
    558                ps0 (ji,jj,jl) = zslpmax   
    559                psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 
    560                psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 
    561                psy (ji,jj,jl) = zs1new         * rswitch 
    562                psyy(ji,jj,jl) = zs2new         * rswitch 
    563                psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
    564             END DO 
    565          END DO 
     522         DO_2D_11_00 
     523            !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
     524            psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  ) 
     525            ! 
     526            zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 
     527            zs1max  = 1.5 * zslpmax 
     528            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 
     529            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
     530               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  ) 
     531            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
     532            ! 
     533            ps0 (ji,jj,jl) = zslpmax   
     534            psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 
     535            psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 
     536            psy (ji,jj,jl) = zs1new         * rswitch 
     537            psyy(ji,jj,jl) = zs2new         * rswitch 
     538            psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
     539         END_2D 
    566540  
    567541         !  Calculate fluxes and moments between boxes j<-->j+1               
    568          DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
    569             DO ji = fs_2, fs_jpim1 
    570                zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
    571                zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 
    572                zalfq        =  zalf * zalf 
    573                zalf1        =  1.0 - zalf 
    574                zalf1q       =  zalf1 * zalf1 
    575                ! 
    576                zfm (ji,jj)  =  zalf  * psm(ji,jj,jl) 
    577                zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl)  + (zalf1-zalf) * psyy(ji,jj,jl) ) )  
    578                zfy (ji,jj)  =  zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 
    579                zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj,jl) 
    580                zfx (ji,jj)  =  zalf  * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 
    581                zfxy(ji,jj)  =  zalfq * psxy(ji,jj,jl) 
    582                zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl) 
    583                ! 
    584                !  Readjust moments remaining in the box. 
    585                psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
    586                ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
    587                psy (ji,jj,jl)  =  zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 
    588                psyy(ji,jj,jl)  =  zalf1 * zalf1q * psyy(ji,jj,jl) 
    589                psx (ji,jj,jl)  =  psx (ji,jj,jl) - zfx(ji,jj) 
    590                psxx(ji,jj,jl)  =  psxx(ji,jj,jl) - zfxx(ji,jj) 
    591                psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
    592             END DO 
    593          END DO 
    594          ! 
    595          DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    596             DO ji = fs_2, fs_jpim1 
    597                zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl)  
    598                zalg  (ji,jj) = zalf 
    599                zalfq         = zalf * zalf 
    600                zalf1         = 1.0 - zalf 
    601                zalg1 (ji,jj) = zalf1 
    602                zalf1q        = zalf1 * zalf1 
    603                zalg1q(ji,jj) = zalf1q 
    604                ! 
    605                zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji,jj+1,jl) 
    606                zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji,jj+1,jl) & 
    607                   &                                   - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 
    608                zfy   (ji,jj) = zfy (ji,jj) + zalfq * (  psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 
    609                zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji,jj+1,jl) * zalfq 
    610                zfx   (ji,jj) = zfx (ji,jj) + zalf  * (  psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 
    611                zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji,jj+1,jl) 
    612                zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji,jj+1,jl) 
    613             END DO 
    614          END DO 
     542         DO_2D_11_00 
     543            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
     544            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 
     545            zalfq        =  zalf * zalf 
     546            zalf1        =  1.0 - zalf 
     547            zalf1q       =  zalf1 * zalf1 
     548            ! 
     549            zfm (ji,jj)  =  zalf  * psm(ji,jj,jl) 
     550            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl)  + (zalf1-zalf) * psyy(ji,jj,jl) ) )  
     551            zfy (ji,jj)  =  zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 
     552            zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj,jl) 
     553            zfx (ji,jj)  =  zalf  * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 
     554            zfxy(ji,jj)  =  zalfq * psxy(ji,jj,jl) 
     555            zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl) 
     556            ! 
     557            !  Readjust moments remaining in the box. 
     558            psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
     559            ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
     560            psy (ji,jj,jl)  =  zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 
     561            psyy(ji,jj,jl)  =  zalf1 * zalf1q * psyy(ji,jj,jl) 
     562            psx (ji,jj,jl)  =  psx (ji,jj,jl) - zfx(ji,jj) 
     563            psxx(ji,jj,jl)  =  psxx(ji,jj,jl) - zfxx(ji,jj) 
     564            psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
     565         END_2D 
     566         ! 
     567         DO_2D_10_00 
     568            zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl)  
     569            zalg  (ji,jj) = zalf 
     570            zalfq         = zalf * zalf 
     571            zalf1         = 1.0 - zalf 
     572            zalg1 (ji,jj) = zalf1 
     573            zalf1q        = zalf1 * zalf1 
     574            zalg1q(ji,jj) = zalf1q 
     575            ! 
     576            zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji,jj+1,jl) 
     577            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji,jj+1,jl) & 
     578               &                                   - zalf1 * (psy(ji,jj+1,jl) - (zalf1 - zalf ) * psyy(ji,jj+1,jl) ) ) 
     579            zfy   (ji,jj) = zfy (ji,jj) + zalfq * (  psy (ji,jj+1,jl) - 3.0 * zalf1 * psyy(ji,jj+1,jl) ) 
     580            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji,jj+1,jl) * zalfq 
     581            zfx   (ji,jj) = zfx (ji,jj) + zalf  * (  psx (ji,jj+1,jl) - zalf1 * psxy(ji,jj+1,jl) ) 
     582            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji,jj+1,jl) 
     583            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji,jj+1,jl) 
     584         END_2D 
    615585 
    616586         !  Readjust moments remaining in the box.  
    617          DO jj = 2, jpjm1 
    618             DO ji = fs_2, fs_jpim1 
    619                zbt  =         zbet(ji,jj-1) 
    620                zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
    621                ! 
    622                psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 
    623                ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 
    624                psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 
    625                psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 
    626                psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 
    627                psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 
    628                psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 
    629             END DO 
    630          END DO 
     587         DO_2D_00_00 
     588            zbt  =         zbet(ji,jj-1) 
     589            zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
     590            ! 
     591            psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 
     592            ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 
     593            psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 
     594            psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 
     595            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 
     596            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 
     597            psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 
     598         END_2D 
    631599 
    632600         !   Put the temporary moments into appropriate neighboring boxes.     
    633          DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0. 
    634             DO ji = fs_2, fs_jpim1 
    635                zbt  =       zbet(ji,jj-1) 
    636                zbt1 = 1.0 - zbet(ji,jj-1) 
    637                psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl)  
    638                zalf          = zbt * zfm(ji,jj-1) / psm(ji,jj,jl)  
    639                zalf1         = 1.0 - zalf 
    640                ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 
    641                ! 
    642                ps0(ji,jj,jl)  =   zbt  * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 
    643                psy(ji,jj,jl)  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )  & 
    644                   &             + zbt1 * psy(ji,jj,jl)   
    645                psyy(ji,jj,jl) =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl)                           & 
    646                   &                      + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) &  
    647                   &             + zbt1 * psyy(ji,jj,jl) 
    648                psxy(ji,jj,jl) =   zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl)            & 
    649                   &                      + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) )  & 
    650                   &             + zbt1 * psxy(ji,jj,jl) 
    651                psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 
    652                psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 
    653             END DO 
    654          END DO 
    655  
    656          DO jj = 2, jpjm1                      !  Flux from j+1 to j IF v LT 0. 
    657             DO ji = fs_2, fs_jpim1 
    658                zbt  =       zbet(ji,jj) 
    659                zbt1 = 1.0 - zbet(ji,jj) 
    660                psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 
    661                zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 
    662                zalf1         = 1.0 - zalf 
    663                ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 
    664                ! 
    665                ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * (  ps0(ji,jj,jl) + zf0(ji,jj) ) 
    666                psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 
    667                psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 
    668                   &                                            + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) )    & 
    669                   &                                            + ( zalf1 - zalf ) * ztemp ) ) 
    670                psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  & 
    671                   &                                            + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 
    672                psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 
    673                psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 
    674             END DO 
    675          END DO 
     601         DO_2D_00_00 
     602            zbt  =       zbet(ji,jj-1) 
     603            zbt1 = 1.0 - zbet(ji,jj-1) 
     604            psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl)  
     605            zalf          = zbt * zfm(ji,jj-1) / psm(ji,jj,jl)  
     606            zalf1         = 1.0 - zalf 
     607            ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 
     608            ! 
     609            ps0(ji,jj,jl)  =   zbt  * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 
     610            psy(ji,jj,jl)  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )  & 
     611               &             + zbt1 * psy(ji,jj,jl)   
     612            psyy(ji,jj,jl) =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl)                           & 
     613               &                      + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) &  
     614               &             + zbt1 * psyy(ji,jj,jl) 
     615            psxy(ji,jj,jl) =   zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl)            & 
     616               &                      + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) )  & 
     617               &             + zbt1 * psxy(ji,jj,jl) 
     618            psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 
     619            psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 
     620         END_2D 
     621 
     622         DO_2D_00_00 
     623            zbt  =       zbet(ji,jj) 
     624            zbt1 = 1.0 - zbet(ji,jj) 
     625            psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 
     626            zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 
     627            zalf1         = 1.0 - zalf 
     628            ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 
     629            ! 
     630            ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * (  ps0(ji,jj,jl) + zf0(ji,jj) ) 
     631            psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 
     632            psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 
     633               &                                            + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) )    & 
     634               &                                            + ( zalf1 - zalf ) * ztemp ) ) 
     635            psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  & 
     636               &                                            + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 
     637            psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 
     638            psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 
     639         END_2D 
    676640 
    677641      END DO 
     
    715679      ! 
    716680      DO jl = 1, jpl 
    717          DO jj = 1, jpj 
    718             DO ji = 1, jpi 
    719                IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     681         DO_2D_11_11 
     682            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     683               ! 
     684               !                               ! -- check h_ip -- ! 
     685               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
     686               IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     687                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
     688                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
     689                     pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 
     690                  ENDIF 
     691               ENDIF 
     692               ! 
     693               !                               ! -- check h_i -- ! 
     694               ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 
     695               zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 
     696               IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     697                  pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m) 
     698               ENDIF 
     699               ! 
     700               !                               ! -- check h_s -- ! 
     701               ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 
     702               zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 
     703               IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     704                  zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 
    720705                  ! 
    721                   !                               ! -- check h_ip -- ! 
    722                   ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    723                   IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    724                      zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    725                      IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    726                         pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 
    727                      ENDIF 
    728                   ENDIF 
     706                  wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 
     707                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    729708                  ! 
    730                   !                               ! -- check h_i -- ! 
    731                   ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 
    732                   zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 
    733                   IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    734                      pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m) 
    735                   ENDIF 
    736                   ! 
    737                   !                               ! -- check h_s -- ! 
    738                   ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 
    739                   zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 
    740                   IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    741                      zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 
    742                      ! 
    743                      wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 
    744                      hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    745                      ! 
    746                      pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
    747                      pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 
    748                   ENDIF            
    749                   !                   
    750                   !                               ! -- check s_i -- ! 
    751                   ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
    752                   zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
    753                   IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    754                      zfra = psi_max(ji,jj,jl) / zsi 
    755                      sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
    756                      psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
    757                   ENDIF 
    758                   ! 
    759                ENDIF 
    760             END DO 
    761          END DO 
     709                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
     710                  pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 
     711               ENDIF            
     712               !                   
     713               !                               ! -- check s_i -- ! 
     714               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
     715               zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
     716               IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     717                  zfra = psi_max(ji,jj,jl) / zsi 
     718                  sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
     719                  psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
     720               ENDIF 
     721               ! 
     722            ENDIF 
     723         END_2D 
    762724      END DO  
    763725      ! 
    764726      !                                           ! -- check e_i/v_i -- ! 
    765727      DO jl = 1, jpl 
    766          DO jk = 1, nlay_i 
    767             DO jj = 1, jpj 
    768                DO ji = 1, jpi 
    769                   IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    770                      ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
    771                      zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
    772                      IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    773                         zfra = pei_max(ji,jj,jk,jl) / zei 
    774                         hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    775                         pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
    776                      ENDIF 
    777                   ENDIF 
    778                END DO 
    779             END DO 
    780          END DO 
     728         DO_3D_11_11( 1, nlay_i ) 
     729            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     730               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     731               zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
     732               IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     733                  zfra = pei_max(ji,jj,jk,jl) / zei 
     734                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     735                  pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
     736               ENDIF 
     737            ENDIF 
     738         END_3D 
    781739      END DO 
    782740      !                                           ! -- check e_s/v_s -- ! 
    783741      DO jl = 1, jpl 
    784          DO jk = 1, nlay_s 
    785             DO jj = 1, jpj 
    786                DO ji = 1, jpi 
    787                   IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    788                      ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
    789                      zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
    790                      IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    791                         zfra = pes_max(ji,jj,jk,jl) / zes 
    792                         hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    793                         pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
    794                      ENDIF 
    795                   ENDIF 
    796                END DO 
    797             END DO 
    798          END DO 
     742         DO_3D_11_11( 1, nlay_s ) 
     743            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
     744               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     745               zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
     746               IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     747                  zfra = pes_max(ji,jj,jk,jl) / zes 
     748                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     749                  pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
     750               ENDIF 
     751            ENDIF 
     752         END_3D 
    799753      END DO 
    800754      ! 
     
    829783      ! -- check snow load -- ! 
    830784      DO jl = 1, jpl 
    831          DO jj = 1, jpj 
    832             DO ji = 1, jpi 
    833                IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    834                   ! 
    835                   zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 
    836                   ! 
    837                   IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface 
    838                      ! put snow excess in the ocean 
    839                      zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 
    840                      wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 
    841                      hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    842                      ! correct snow volume and heat content 
    843                      pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
    844                      pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess 
    845                   ENDIF 
    846                   ! 
    847                ENDIF 
    848             END DO 
    849          END DO 
     785         DO_2D_11_11 
     786            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     787               ! 
     788               zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 
     789               ! 
     790               IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface 
     791                  ! put snow excess in the ocean 
     792                  zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 
     793                  wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 
     794                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     795                  ! correct snow volume and heat content 
     796                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
     797                  pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess 
     798               ENDIF 
     799               ! 
     800            ENDIF 
     801         END_2D 
    850802      END DO 
    851803      ! 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_adv_umx.F90

    r13466 r13469  
    114114      END WHERE 
    115115      DO jl = 1, jpl 
    116          DO jj = 2, jpjm1 
    117             DO ji = fs_2, fs_jpim1 
    118                zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
    119                   &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
    120                   &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 
    121                   &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 
    122                zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), & 
    123                   &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), & 
    124                   &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 
    125                   &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 
    126                zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), & 
    127                   &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), & 
    128                   &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
    129                   &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
    130                zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), & 
    131                   &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), & 
    132                   &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 
    133                   &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 
    134             END DO 
    135          END DO 
     116         DO_2D_00_00 
     117            zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
     118               &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
     119               &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 
     120               &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 
     121            zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), & 
     122               &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), & 
     123               &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 
     124               &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 
     125            zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), & 
     126               &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), & 
     127               &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
     128               &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
     129            zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), & 
     130               &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), & 
     131               &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 
     132               &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 
     133         END_2D 
    136134      END DO 
    137135      CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1., zsi_max, 'T', 1. ) 
     
    149147      END DO 
    150148      DO jl = 1, jpl 
    151          DO jk = 1, nlay_i 
    152             DO jj = 2, jpjm1 
    153                DO ji = fs_2, fs_jpim1 
    154                   zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
    155                      &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
    156                      &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 
    157                      &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 
    158                END DO 
    159             END DO 
    160          END DO 
    161       END DO 
    162       DO jl = 1, jpl 
    163          DO jk = 1, nlay_s 
    164             DO jj = 2, jpjm1 
    165                DO ji = fs_2, fs_jpim1 
    166                   zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
    167                      &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
    168                      &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 
    169                      &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 
    170                END DO 
    171             END DO 
    172          END DO 
     149         DO_3D_00_00( 1, nlay_i ) 
     150            zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
     151               &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
     152               &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 
     153               &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 
     154         END_3D 
     155      END DO 
     156      DO jl = 1, jpl 
     157         DO_3D_00_00( 1, nlay_s ) 
     158            zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
     159               &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
     160               &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 
     161               &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 
     162         END_3D 
    173163      END DO 
    174164      CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 
     
    201191      ! 
    202192      ! --- define velocity for advection: u*grad(H) --- ! 
    203       DO jj = 2, jpjm1 
    204          DO ji = fs_2, fs_jpim1 
    205             IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp 
    206             ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj) 
    207             ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj) 
    208             ENDIF 
    209  
    210             IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp 
    211             ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1) 
    212             ELSE                                                      ;   zcv_box(ji,jj) = pv_ice(ji,jj  ) 
    213             ENDIF 
    214          END DO 
    215       END DO 
     193      DO_2D_00_00 
     194         IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp 
     195         ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj) 
     196         ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj) 
     197         ENDIF 
     198 
     199         IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp 
     200         ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1) 
     201         ELSE                                                      ;   zcv_box(ji,jj) = pv_ice(ji,jj  ) 
     202         ENDIF 
     203      END_2D 
    216204 
    217205      !---------------! 
     
    236224            IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) )  
    237225            DO jl = 1, jpl 
    238                DO jj = 1, jpjm1 
    239                   DO ji = 1, jpim1 
    240                      zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 
    241                      IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0 
    242                      ELSE                         ;   imsk_small(ji,jj,jl) = 1   ;   ENDIF 
    243                      zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 
    244                      IF( zvi_cen < epsi06) THEN   ;   jmsk_small(ji,jj,jl) = 0 
    245                      ELSE                         ;   jmsk_small(ji,jj,jl) = 1   ;   ENDIF 
    246                   END DO 
    247                END DO 
     226               DO_2D_10_10 
     227                  zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 
     228                  IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0 
     229                  ELSE                         ;   imsk_small(ji,jj,jl) = 1   ;   ENDIF 
     230                  zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 
     231                  IF( zvi_cen < epsi06) THEN   ;   jmsk_small(ji,jj,jl) = 0 
     232                  ELSE                         ;   jmsk_small(ji,jj,jl) = 1   ;   ENDIF 
     233               END_2D 
    248234            END DO 
    249235         ENDIF 
     
    394380         !== Open water area ==! 
    395381         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
    396          DO jj = 2, jpjm1 
    397             DO ji = fs_2, fs_jpim1 
    398                pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &  
    399                   &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    400             END DO 
    401          END DO 
     382         DO_2D_00_00 
     383            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &  
     384               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
     385         END_2D 
    402386         CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T',  1. ) 
    403387         ! 
     
    506490      IF( pamsk == 0._wp ) THEN 
    507491         DO jl = 1, jpl 
    508             DO jj = 1, jpjm1 
    509                DO ji = 1, fs_jpim1 
    510                   IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 
    511                      zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc    (ji,jj,jl) / pu(ji,jj) 
    512                      zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj) 
    513                   ELSE 
    514                      zfu_ho (ji,jj,jl) = 0._wp 
    515                      zfu_ups(ji,jj,jl) = 0._wp 
    516                   ENDIF 
    517                   ! 
    518                   IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 
    519                      zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc    (ji,jj,jl) / pv(ji,jj) 
    520                      zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 
    521                   ELSE 
    522                      zfv_ho (ji,jj,jl) = 0._wp   
    523                      zfv_ups(ji,jj,jl) = 0._wp   
    524                   ENDIF 
    525                END DO 
    526             END DO 
     492            DO_2D_10_10 
     493               IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 
     494                  zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc    (ji,jj,jl) / pu(ji,jj) 
     495                  zfu_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) * pua_ups(ji,jj,jl) / pu(ji,jj) 
     496               ELSE 
     497                  zfu_ho (ji,jj,jl) = 0._wp 
     498                  zfu_ups(ji,jj,jl) = 0._wp 
     499               ENDIF 
     500               ! 
     501               IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 
     502                  zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc    (ji,jj,jl) / pv(ji,jj) 
     503                  zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 
     504               ELSE 
     505                  zfv_ho (ji,jj,jl) = 0._wp   
     506                  zfv_ups(ji,jj,jl) = 0._wp   
     507               ENDIF 
     508            END_2D 
    527509         END DO 
    528510 
     
    530512         ! thus we calculate the upstream solution and apply a limiter again 
    531513         DO jl = 1, jpl 
    532             DO jj = 2, jpjm1 
    533                DO ji = fs_2, fs_jpim1 
    534                   ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 
    535                   ! 
    536                   zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 
    537                END DO 
    538             END DO 
     514            DO_2D_00_00 
     515               ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 
     516               ! 
     517               zt_ups(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 
     518            END_2D 
    539519         END DO 
    540520         CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T',  1. ) 
     
    553533      IF( PRESENT( pua_ho ) ) THEN 
    554534         DO jl = 1, jpl 
    555             DO jj = 1, jpjm1 
    556                DO ji = 1, fs_jpim1 
    557                   pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 
    558                   pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 
    559               END DO 
    560             END DO 
     535            DO_2D_10_10 
     536               pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 
     537               pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 
     538            END_2D 
    561539         END DO 
    562540      ENDIF 
     
    565543      ! --------------------------------- 
    566544      DO jl = 1, jpl 
    567          DO jj = 2, jpjm1 
    568             DO ji = fs_2, fs_jpim1  
    569                ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )   
    570                ! 
    571                ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)                
    572             END DO 
    573          END DO 
     545         DO_2D_00_00 
     546            ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )   
     547            ! 
     548            ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)                
     549         END_2D 
    574550      END DO 
    575551      CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T',  1. ) 
     
    601577         ! 
    602578         DO jl = 1, jpl 
    603             DO jj = 1, jpjm1 
    604                DO ji = 1, fs_jpim1 
     579            DO_2D_10_10 
     580               pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
     581               pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
     582            END_2D 
     583         END DO 
     584         ! 
     585      ELSE                              !** alternate directions **! 
     586         ! 
     587         IF( MOD( (kt - 1) / nn_fsbc , 2 ) ==  MOD( (jt - 1) , 2 ) ) THEN   !==  odd ice time step:  adv_x then adv_y  ==! 
     588            ! 
     589            DO jl = 1, jpl              !-- flux in x-direction 
     590               DO_2D_10_10 
    605591                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
     592               END_2D 
     593            END DO 
     594            ! 
     595            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
     596               DO_2D_00_00 
     597                  ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              & 
     598                     &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
     599                  ! 
     600                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     601               END_2D 
     602            END DO 
     603            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     604            ! 
     605            DO jl = 1, jpl              !-- flux in y-direction 
     606               DO_2D_10_10 
     607                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 
     608               END_2D 
     609            END DO 
     610            ! 
     611         ELSE                                                               !==  even ice time step:  adv_y then adv_x  ==! 
     612            ! 
     613            DO jl = 1, jpl              !-- flux in y-direction 
     614               DO_2D_10_10 
    606615                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    607                END DO 
    608             END DO 
    609          END DO 
    610          ! 
    611       ELSE                              !** alternate directions **! 
    612          ! 
    613          IF( MOD( (kt - 1) / nn_fsbc , 2 ) ==  MOD( (jt - 1) , 2 ) ) THEN   !==  odd ice time step:  adv_x then adv_y  ==! 
     616               END_2D 
     617            END DO 
     618            ! 
     619            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
     620               DO_2D_00_00 
     621                  ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  & 
     622                     &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
     623                  ! 
     624                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     625               END_2D 
     626            END DO 
     627            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    614628            ! 
    615629            DO jl = 1, jpl              !-- flux in x-direction 
    616                DO jj = 1, jpjm1 
    617                   DO ji = 1, fs_jpim1 
    618                      pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    619                   END DO 
    620                END DO 
    621             END DO 
    622             ! 
    623             DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    624                DO jj = 2, jpjm1 
    625                   DO ji = fs_2, fs_jpim1 
    626                      ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              & 
    627                         &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    628                      ! 
    629                      zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
    630                   END DO 
    631                END DO 
    632             END DO 
    633             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    634             ! 
    635             DO jl = 1, jpl              !-- flux in y-direction 
    636                DO jj = 1, jpjm1 
    637                   DO ji = 1, fs_jpim1 
    638                      pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 
    639                   END DO 
    640                END DO 
    641             END DO 
    642             ! 
    643          ELSE                                                               !==  even ice time step:  adv_y then adv_x  ==! 
    644             ! 
    645             DO jl = 1, jpl              !-- flux in y-direction 
    646                DO jj = 1, jpjm1 
    647                   DO ji = 1, fs_jpim1 
    648                      pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    649                   END DO 
    650                END DO 
    651             END DO 
    652             ! 
    653             DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    654                DO jj = 2, jpjm1 
    655                   DO ji = fs_2, fs_jpim1 
    656                      ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  & 
    657                         &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    658                      ! 
    659                      zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
    660                   END DO 
    661                END DO 
    662             END DO 
    663             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    664             ! 
    665             DO jl = 1, jpl              !-- flux in x-direction 
    666                DO jj = 1, jpjm1 
    667                   DO ji = 1, fs_jpim1 
    668                      pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 
    669                   END DO 
    670                END DO 
     630               DO_2D_10_10 
     631                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 
     632               END_2D 
    671633            END DO 
    672634            ! 
     
    676638      ! 
    677639      DO jl = 1, jpl                    !-- after tracer with upstream scheme 
    678          DO jj = 2, jpjm1 
    679             DO ji = fs_2, fs_jpim1 
    680                ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   & 
    681                   &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) & 
    682                   &   + (   pu     (ji,jj   ) - pu     (ji-1,jj     )   & 
    683                   &       + pv     (ji,jj   ) - pv     (ji  ,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    684                ! 
    685                pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
    686             END DO 
    687          END DO 
     640         DO_2D_00_00 
     641            ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   & 
     642               &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) & 
     643               &   + (   pu     (ji,jj   ) - pu     (ji-1,jj     )   & 
     644               &       + pv     (ji,jj   ) - pv     (ji  ,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
     645            ! 
     646            pt_ups(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     647         END_2D 
    688648      END DO 
    689649      CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1. ) 
     
    717677         ! 
    718678         DO jl = 1, jpl 
    719             DO jj = 1, jpjm1 
    720                DO ji = 1, fs_jpim1 
    721                   pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) ) 
    722                   pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) ) 
    723                END DO 
    724             END DO 
     679            DO_2D_10_10 
     680               pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) ) 
     681               pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) ) 
     682            END_2D 
    725683         END DO 
    726684         ! 
     
    737695            ! 
    738696            DO jl = 1, jpl              !-- flux in x-direction 
    739                DO jj = 1, jpjm1 
    740                   DO ji = 1, fs_jpim1 
    741                      pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
    742                   END DO 
    743                END DO 
     697               DO_2D_10_10 
     698                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
     699               END_2D 
    744700            END DO 
    745701            IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 
    746702 
    747703            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    748                DO jj = 2, jpjm1 
    749                   DO ji = fs_2, fs_jpim1 
    750                      ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              & 
    751                         &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    752                      ! 
    753                      zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
    754                   END DO 
    755                END DO 
     704               DO_2D_00_00 
     705                  ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              & 
     706                     &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
     707                  ! 
     708                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     709               END_2D 
    756710            END DO 
    757711            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    758712 
    759713            DO jl = 1, jpl              !-- flux in y-direction 
    760                DO jj = 1, jpjm1 
    761                   DO ji = 1, fs_jpim1 
    762                      pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
    763                   END DO 
    764                END DO 
     714               DO_2D_10_10 
     715                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
     716               END_2D 
    765717            END DO 
    766718            IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 
     
    769721            ! 
    770722            DO jl = 1, jpl              !-- flux in y-direction 
    771                DO jj = 1, jpjm1 
    772                   DO ji = 1, fs_jpim1 
    773                      pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
    774                   END DO 
    775                END DO 
     723               DO_2D_10_10 
     724                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
     725               END_2D 
    776726            END DO 
    777727            IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 
    778728            ! 
    779729            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    780                DO jj = 2, jpjm1 
    781                   DO ji = fs_2, fs_jpim1 
    782                      ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  & 
    783                         &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    784                      ! 
    785                      zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
    786                   END DO 
    787                END DO 
     730               DO_2D_00_00 
     731                  ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  & 
     732                     &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
     733                  ! 
     734                  zpt(ji,jj,jl) = ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     735               END_2D 
    788736            END DO 
    789737            CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    790738            ! 
    791739            DO jl = 1, jpl              !-- flux in x-direction 
    792                DO jj = 1, jpjm1 
    793                   DO ji = 1, fs_jpim1 
    794                      pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
    795                   END DO 
    796                END DO 
     740               DO_2D_10_10 
     741                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
     742               END_2D 
    797743            END DO 
    798744            IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 
     
    840786         !                                                        !--  advective form update in zpt  --! 
    841787         DO jl = 1, jpl 
    842             DO jj = 2, jpjm1 
    843                DO ji = fs_2, fs_jpim1 
    844                   zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) & 
    845                      &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) & 
    846                      &                                                                                        * pamsk           & 
    847                      &                             ) * pdt ) * tmask(ji,jj,1) 
    848                END DO 
    849             END DO 
     788            DO_2D_00_00 
     789               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) & 
     790                  &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) & 
     791                  &                                                                                        * pamsk           & 
     792                  &                             ) * pdt ) * tmask(ji,jj,1) 
     793            END_2D 
    850794         END DO 
    851795         CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     
    869813         !                                                        !--  advective form update in zpt  --! 
    870814         DO jl = 1, jpl 
    871             DO jj = 2, jpjm1 
    872                DO ji = fs_2, fs_jpim1 
    873                   zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) & 
    874                      &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) & 
    875                      &                                                                                        * pamsk           & 
    876                      &                             ) * pdt ) * tmask(ji,jj,1)  
    877                END DO 
    878             END DO 
     815            DO_2D_00_00 
     816               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) & 
     817                  &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) & 
     818                  &                                                                                        * pamsk           & 
     819                  &                             ) * pdt ) * tmask(ji,jj,1)  
     820            END_2D 
    879821         END DO 
    880822         CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     
    953895         !         
    954896         DO jl = 1, jpl 
    955             DO jj = 1, jpjm1 
    956                DO ji = 1, fs_jpim1   ! vector opt. 
    957                   pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    958                      &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
    959                END DO 
    960             END DO 
     897            DO_2D_10_10 
     898               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
     899                  &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
     900            END_2D 
    961901         END DO 
    962902         ! 
     
    964904         ! 
    965905         DO jl = 1, jpl 
    966             DO jj = 1, jpjm1 
    967                DO ji = 1, fs_jpim1   ! vector opt. 
    968                   zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    969                   pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    970                      &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )  
    971                END DO 
    972             END DO 
     906            DO_2D_10_10 
     907               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
     908               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
     909                  &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )  
     910            END_2D 
    973911         END DO 
    974912         !   
     
    976914         ! 
    977915         DO jl = 1, jpl 
    978             DO jj = 1, jpjm1 
    979                DO ji = 1, fs_jpim1   ! vector opt. 
    980                   zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    981                   zdx2 = e1u(ji,jj) * e1u(ji,jj) 
     916            DO_2D_10_10 
     917               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
     918               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    982919!!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj) 
    983                   pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
    984                      &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
    985                      &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
    986                      &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 
    987                END DO 
    988             END DO 
     920               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
     921                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
     922                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
     923                  &                                               - SIGN( 1._wp, zcu ) * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 
     924            END_2D 
    989925         END DO 
    990926         ! 
     
    992928         ! 
    993929         DO jl = 1, jpl 
    994             DO jj = 1, jpjm1 
    995                DO ji = 1, fs_jpim1   ! vector opt. 
    996                   zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    997                   zdx2 = e1u(ji,jj) * e1u(ji,jj) 
     930            DO_2D_10_10 
     931               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
     932               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    998933!!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj) 
    999                   pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
    1000                      &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
    1001                      &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
    1002                      &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 
    1003                END DO 
    1004             END DO 
     934               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (         (                      pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
     935                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
     936                  &        + z1_6 * zdx2 * ( zcu*zcu - 1._wp ) *    (                      ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
     937                  &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) ) 
     938            END_2D 
    1005939         END DO 
    1006940         ! 
     
    1008942         ! 
    1009943         DO jl = 1, jpl 
    1010             DO jj = 1, jpjm1 
    1011                DO ji = 1, fs_jpim1   ! vector opt. 
    1012                   zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    1013                   zdx2 = e1u(ji,jj) * e1u(ji,jj) 
     944            DO_2D_10_10 
     945               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
     946               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    1014947!!rachid          zdx2 = e1u(ji,jj) * e1t(ji,jj) 
    1015                   zdx4 = zdx2 * zdx2 
    1016                   pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (        (                       pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
    1017                      &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
    1018                      &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) * (                       ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
    1019                      &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) & 
    1020                      &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl)     & 
    1021                      &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) ) 
    1022                END DO 
    1023             END DO 
     948               zdx4 = zdx2 * zdx2 
     949               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (        (                       pt  (ji+1,jj,jl) + pt  (ji,jj,jl)     & 
     950                  &                                                            - zcu   * ( pt  (ji+1,jj,jl) - pt  (ji,jj,jl) ) ) & 
     951                  &        + z1_6   * zdx2 * ( zcu*zcu - 1._wp ) * (                       ztu2(ji+1,jj,jl) + ztu2(ji,jj,jl)     & 
     952                  &                                                   - 0.5_wp * zcu   * ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) ) & 
     953                  &        + z1_120 * zdx4 * ( zcu*zcu - 1._wp ) * ( zcu*zcu - 4._wp ) * ( ztu4(ji+1,jj,jl) + ztu4(ji,jj,jl)     & 
     954                  &                                               - SIGN( 1._wp, zcu ) * ( ztu4(ji+1,jj,jl) - ztu4(ji,jj,jl) ) ) ) 
     955            END_2D 
    1024956         END DO 
    1025957         ! 
     
    1031963      IF( ll_neg ) THEN 
    1032964         DO jl = 1, jpl 
    1033             DO jj = 1, jpjm1 
    1034                DO ji = 1, fs_jpim1 
    1035                   IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    1036                      pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    1037                         &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
    1038                   ENDIF 
    1039                END DO 
    1040             END DO 
     965            DO_2D_10_10 
     966               IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
     967                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
     968                     &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
     969               ENDIF 
     970            END_2D 
    1041971         END DO 
    1042972      ENDIF 
    1043973      !                                                     !-- High order flux in i-direction  --! 
    1044974      DO jl = 1, jpl 
    1045          DO jj = 1, jpjm1 
    1046             DO ji = 1, fs_jpim1   ! vector opt. 
    1047                pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 
    1048             END DO 
    1049          END DO 
     975         DO_2D_10_10 
     976            pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 
     977         END_2D 
    1050978      END DO 
    1051979      ! 
     
    10781006      !                                                     !--  Laplacian in j-direction  --! 
    10791007      DO jl = 1, jpl 
    1080          DO jj = 1, jpjm1         ! First derivative (gradient) 
    1081             DO ji = fs_2, fs_jpim1 
    1082                ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    1083             END DO 
    1084          END DO 
    1085          DO jj = 2, jpjm1         ! Second derivative (Laplacian) 
    1086             DO ji = fs_2, fs_jpim1 
    1087                ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    1088             END DO 
    1089          END DO 
     1008         DO_2D_10_00 
     1009            ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
     1010         END_2D 
     1011         DO_2D_00_00 
     1012            ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
     1013         END_2D 
    10901014      END DO 
    10911015      CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1. ) 
     
    10931017      !                                                     !--  BiLaplacian in j-direction  --! 
    10941018      DO jl = 1, jpl 
    1095          DO jj = 1, jpjm1         ! First derivative 
    1096             DO ji = fs_2, fs_jpim1 
    1097                ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    1098             END DO 
    1099          END DO 
    1100          DO jj = 2, jpjm1         ! Second derivative 
    1101             DO ji = fs_2, fs_jpim1 
    1102                ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    1103             END DO 
    1104          END DO 
     1019         DO_2D_10_00 
     1020            ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
     1021         END_2D 
     1022         DO_2D_00_00 
     1023            ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
     1024         END_2D 
    11051025      END DO 
    11061026      CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1. ) 
     
    11111031      CASE( 1 )                                                !==  1st order central TIM  ==! (Eq. 21) 
    11121032         DO jl = 1, jpl 
    1113             DO jj = 1, jpjm1 
    1114                DO ji = 1, fs_jpim1 
    1115                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    1116                      &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    1117                END DO 
    1118             END DO 
     1033            DO_2D_10_10 
     1034               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
     1035                  &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
     1036            END_2D 
    11191037         END DO 
    11201038         ! 
    11211039      CASE( 2 )                                                !==  2nd order central TIM  ==! (Eq. 23) 
    11221040         DO jl = 1, jpl 
    1123             DO jj = 1, jpjm1 
    1124                DO ji = 1, fs_jpim1 
    1125                   zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    1126                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    1127                      &                                                            - zcv *   ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    1128                END DO 
    1129             END DO 
     1041            DO_2D_10_10 
     1042               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
     1043               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
     1044                  &                                                            - zcv *   ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
     1045            END_2D 
    11301046         END DO 
    11311047         ! 
    11321048      CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24) 
    11331049         DO jl = 1, jpl 
    1134             DO jj = 1, jpjm1 
    1135                DO ji = 1, fs_jpim1 
    1136                   zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    1137                   zdy2 = e2v(ji,jj) * e2v(ji,jj) 
     1050            DO_2D_10_10 
     1051               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
     1052               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    11381053!!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj) 
    1139                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
    1140                      &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
    1141                      &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
    1142                      &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 
    1143                END DO 
    1144             END DO 
     1054               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
     1055                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
     1056                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
     1057                  &                                               - SIGN( 1._wp, zcv ) * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 
     1058            END_2D 
    11451059         END DO 
    11461060         ! 
    11471061      CASE( 4 )                                                !==  4th order central TIM  ==! (Eq. 27) 
    11481062         DO jl = 1, jpl 
    1149             DO jj = 1, jpjm1 
    1150                DO ji = 1, fs_jpim1 
    1151                   zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    1152                   zdy2 = e2v(ji,jj) * e2v(ji,jj) 
     1063            DO_2D_10_10 
     1064               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
     1065               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    11531066!!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj) 
    1154                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
    1155                      &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
    1156                      &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
    1157                      &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 
    1158                END DO 
    1159             END DO 
     1067               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (      (                         pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
     1068                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
     1069                  &        + z1_6 * zdy2 * ( zcv*zcv - 1._wp ) * (                         ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
     1070                  &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) ) 
     1071            END_2D 
    11601072         END DO 
    11611073         ! 
    11621074      CASE( 5 )                                                !==  5th order central TIM  ==! (Eq. 29) 
    11631075         DO jl = 1, jpl 
    1164             DO jj = 1, jpjm1 
    1165                DO ji = 1, fs_jpim1 
    1166                   zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    1167                   zdy2 = e2v(ji,jj) * e2v(ji,jj) 
     1076            DO_2D_10_10 
     1077               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
     1078               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    11681079!!rachid          zdy2 = e2v(ji,jj) * e2t(ji,jj) 
    1169                   zdy4 = zdy2 * zdy2 
    1170                   pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
    1171                      &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
    1172                      &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) * (                       ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
    1173                      &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) & 
    1174                      &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl)     & 
    1175                      &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) ) 
    1176                END DO 
    1177             END DO 
     1080               zdy4 = zdy2 * zdy2 
     1081               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt  (ji,jj+1,jl) + pt  (ji,jj,jl)     & 
     1082                  &                                                            - zcv   * ( pt  (ji,jj+1,jl) - pt  (ji,jj,jl) ) ) & 
     1083                  &        + z1_6   * zdy2 * ( zcv*zcv - 1._wp ) * (                       ztv2(ji,jj+1,jl) + ztv2(ji,jj,jl)     & 
     1084                  &                                                   - 0.5_wp * zcv   * ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) ) & 
     1085                  &        + z1_120 * zdy4 * ( zcv*zcv - 1._wp ) * ( zcv*zcv - 4._wp ) * ( ztv4(ji,jj+1,jl) + ztv4(ji,jj,jl)     & 
     1086                  &                                               - SIGN( 1._wp, zcv ) * ( ztv4(ji,jj+1,jl) - ztv4(ji,jj,jl) ) ) ) 
     1087            END_2D 
    11781088         END DO 
    11791089         ! 
     
    11851095      IF( ll_neg ) THEN 
    11861096         DO jl = 1, jpl 
    1187             DO jj = 1, jpjm1 
    1188                DO ji = 1, fs_jpim1 
    1189                   IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    1190                      pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
    1191                         &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    1192                   ENDIF 
    1193                END DO 
    1194             END DO 
     1097            DO_2D_10_10 
     1098               IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
     1099                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
     1100                     &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
     1101               ENDIF 
     1102            END_2D 
    11951103         END DO 
    11961104      ENDIF 
    11971105      !                                                     !-- High order flux in j-direction  --! 
    11981106      DO jl = 1, jpl 
    1199          DO jj = 1, jpjm1 
    1200             DO ji = 1, fs_jpim1   ! vector opt. 
    1201                pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 
    1202             END DO 
    1203          END DO 
     1107         DO_2D_10_10 
     1108            pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 
     1109         END_2D 
    12041110      END DO 
    12051111      ! 
     
    12351141      ! -------------------------------------------------- 
    12361142      DO jl = 1, jpl 
    1237          DO jj = 1, jpjm1 
    1238             DO ji = 1, fs_jpim1   ! vector opt. 
    1239                pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 
    1240                pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 
    1241             END DO 
    1242          END DO 
     1143         DO_2D_10_10 
     1144            pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 
     1145            pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 
     1146         END_2D 
    12431147      END DO 
    12441148 
     
    12541158          
    12551159         DO jl = 1, jpl 
    1256             DO jj = 2, jpjm1 
    1257                DO ji = fs_2, fs_jpim1  
    1258                   zti_ups(ji,jj,jl)= pt_ups(ji+1,jj  ,jl) 
    1259                   ztj_ups(ji,jj,jl)= pt_ups(ji  ,jj+1,jl) 
    1260                END DO 
    1261             END DO 
     1160            DO_2D_00_00 
     1161               zti_ups(ji,jj,jl)= pt_ups(ji+1,jj  ,jl) 
     1162               ztj_ups(ji,jj,jl)= pt_ups(ji  ,jj+1,jl) 
     1163            END_2D 
    12621164         END DO 
    12631165         CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1., ztj_ups, 'T', 1. ) 
    12641166 
    12651167         DO jl = 1, jpl 
    1266             DO jj = 2, jpjm1 
    1267                DO ji = fs_2, fs_jpim1 
    1268                   IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  & 
    1269                      & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 
    1270                      ! 
    1271                      IF(  pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj  ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND.  & 
    1272                         & pfv_ho(ji,jj,jl) * ( ztj_ups(ji  ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN 
    1273                         pfu_ho(ji,jj,jl)=0._wp 
    1274                         pfv_ho(ji,jj,jl)=0._wp 
    1275                      ENDIF 
    1276                      ! 
    1277                      IF(  pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj  ,jl) ) <= 0._wp .AND.  & 
    1278                         & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji  ,jj-1,jl) ) <= 0._wp ) THEN 
    1279                         pfu_ho(ji,jj,jl)=0._wp 
    1280                         pfv_ho(ji,jj,jl)=0._wp 
    1281                      ENDIF 
    1282                      ! 
     1168            DO_2D_00_00 
     1169               IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  & 
     1170                  & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 
     1171                  ! 
     1172                  IF(  pfu_ho(ji,jj,jl) * ( zti_ups(ji+1,jj  ,jl) - zti_ups(ji,jj,jl) ) <= 0._wp .AND.  & 
     1173                     & pfv_ho(ji,jj,jl) * ( ztj_ups(ji  ,jj+1,jl) - ztj_ups(ji,jj,jl) ) <= 0._wp ) THEN 
     1174                     pfu_ho(ji,jj,jl)=0._wp 
     1175                     pfv_ho(ji,jj,jl)=0._wp 
    12831176                  ENDIF 
    1284                END DO 
    1285             END DO 
     1177                  ! 
     1178                  IF(  pfu_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji-1,jj  ,jl) ) <= 0._wp .AND.  & 
     1179                     & pfv_ho(ji,jj,jl) * ( pt_ups(ji,jj,jl) - pt_ups(ji  ,jj-1,jl) ) <= 0._wp ) THEN 
     1180                     pfu_ho(ji,jj,jl)=0._wp 
     1181                     pfv_ho(ji,jj,jl)=0._wp 
     1182                  ENDIF 
     1183                  ! 
     1184               ENDIF 
     1185            END_2D 
    12861186         END DO 
    12871187         CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1., pfv_ho, 'V', -1. )   ! lateral boundary cond. 
     
    12951195      DO jl = 1, jpl 
    12961196          
    1297          DO jj = 1, jpj 
    1298             DO ji = 1, jpi 
    1299                IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 
    1300                   zbup(ji,jj) = -zbig 
    1301                   zbdo(ji,jj) =  zbig 
    1302                ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN 
    1303                   zbup(ji,jj) = pt_ups(ji,jj,jl) 
    1304                   zbdo(ji,jj) = pt_ups(ji,jj,jl) 
    1305                ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 
    1306                   zbup(ji,jj) = pt(ji,jj,jl) 
    1307                   zbdo(ji,jj) = pt(ji,jj,jl) 
    1308                ELSE 
    1309                   zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 
    1310                   zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 
    1311                ENDIF 
    1312             END DO 
    1313          END DO 
    1314  
    1315          DO jj = 2, jpjm1 
    1316             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1317                ! 
    1318                zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood 
    1319                zdo  = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) ) 
    1320                ! 
    1321                zpos = MAX( 0._wp, pfu_ho(ji-1,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji  ,jj  ,jl) ) &  ! positive/negative part of the flux 
    1322                   & + MAX( 0._wp, pfv_ho(ji  ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj  ,jl) ) 
    1323                zneg = MAX( 0._wp, pfu_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj  ,jl) ) & 
    1324                   & + MAX( 0._wp, pfv_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj-1,jl) ) 
    1325                ! 
    1326                zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) & 
    1327                   &          ) * ( 1. - pamsk ) 
    1328                zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) & 
    1329                   &          ) * ( 1. - pamsk ) 
    1330                ! 
    1331                !                                  ! up & down beta terms 
    1332                ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!) 
    1333                IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 
    1334                ELSE                     ; zbetup(ji,jj,jl) = 0._wp ! zbig 
    1335                ENDIF 
    1336                ! 
    1337                IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 
    1338                ELSE                     ; zbetdo(ji,jj,jl) = 0._wp ! zbig 
    1339                ENDIF 
    1340                ! 
    1341                ! if all the points are outside ice cover 
    1342                IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig 
    1343                IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig             
    1344                ! 
    1345             END DO 
    1346          END DO 
     1197         DO_2D_11_11 
     1198            IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 
     1199               zbup(ji,jj) = -zbig 
     1200               zbdo(ji,jj) =  zbig 
     1201            ELSEIF( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) > 0._wp ) THEN 
     1202               zbup(ji,jj) = pt_ups(ji,jj,jl) 
     1203               zbdo(ji,jj) = pt_ups(ji,jj,jl) 
     1204            ELSEIF( pt(ji,jj,jl) > 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 
     1205               zbup(ji,jj) = pt(ji,jj,jl) 
     1206               zbdo(ji,jj) = pt(ji,jj,jl) 
     1207            ELSE 
     1208               zbup(ji,jj) = MAX( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 
     1209               zbdo(ji,jj) = MIN( pt(ji,jj,jl) , pt_ups(ji,jj,jl) ) 
     1210            ENDIF 
     1211         END_2D 
     1212 
     1213         DO_2D_00_00 
     1214            ! 
     1215            zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood 
     1216            zdo  = MIN( zbdo(ji,jj), zbdo(ji-1,jj), zbdo(ji+1,jj), zbdo(ji,jj-1), zbdo(ji,jj+1) ) 
     1217            ! 
     1218            zpos = MAX( 0._wp, pfu_ho(ji-1,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji  ,jj  ,jl) ) &  ! positive/negative part of the flux 
     1219               & + MAX( 0._wp, pfv_ho(ji  ,jj-1,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj  ,jl) ) 
     1220            zneg = MAX( 0._wp, pfu_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfu_ho(ji-1,jj  ,jl) ) & 
     1221               & + MAX( 0._wp, pfv_ho(ji  ,jj  ,jl) ) - MIN( 0._wp, pfv_ho(ji  ,jj-1,jl) ) 
     1222            ! 
     1223            zpos = zpos - (pt(ji,jj,jl) * MIN( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MIN( 0., pv(ji,jj) - pv(ji,jj-1) ) & 
     1224               &          ) * ( 1. - pamsk ) 
     1225            zneg = zneg + (pt(ji,jj,jl) * MAX( 0., pu(ji,jj) - pu(ji-1,jj) ) + pt(ji,jj,jl) * MAX( 0., pv(ji,jj) - pv(ji,jj-1) ) & 
     1226               &          ) * ( 1. - pamsk ) 
     1227            ! 
     1228            !                                  ! up & down beta terms 
     1229            ! clem: zbetup and zbetdo must be 0 for zpos>1.e-10 & zneg>1.e-10 (do not put 0 instead of 1.e-10 !!!) 
     1230            IF( zpos > epsi10 ) THEN ; zbetup(ji,jj,jl) = MAX( 0._wp, zup - pt_ups(ji,jj,jl) ) / zpos * e1e2t(ji,jj) * z1_dt 
     1231            ELSE                     ; zbetup(ji,jj,jl) = 0._wp ! zbig 
     1232            ENDIF 
     1233            ! 
     1234            IF( zneg > epsi10 ) THEN ; zbetdo(ji,jj,jl) = MAX( 0._wp, pt_ups(ji,jj,jl) - zdo ) / zneg * e1e2t(ji,jj) * z1_dt 
     1235            ELSE                     ; zbetdo(ji,jj,jl) = 0._wp ! zbig 
     1236            ENDIF 
     1237            ! 
     1238            ! if all the points are outside ice cover 
     1239            IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig 
     1240            IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig             
     1241            ! 
     1242         END_2D 
    13471243      END DO 
    13481244      CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
     
    13521248      ! --------------------------------- 
    13531249      DO jl = 1, jpl 
    1354          DO jj = 1, jpjm1 
    1355             DO ji = 1, fs_jpim1   ! vector opt. 
    1356                zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 
    1357                zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 
    1358                zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) ) 
    1359                ! 
    1360                zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu ) 
    1361                ! 
    1362                pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl) 
    1363                ! 
    1364             END DO 
    1365          END DO 
    1366  
    1367          DO jj = 1, jpjm1 
    1368             DO ji = 1, fs_jpim1   ! vector opt. 
    1369                zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 
    1370                zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 
    1371                zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) ) 
    1372                ! 
    1373                zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv ) 
    1374                ! 
    1375                pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl) 
    1376                ! 
    1377             END DO 
    1378          END DO 
     1250         DO_2D_10_10 
     1251            zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 
     1252            zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 
     1253            zcu = 0.5_wp + SIGN( 0.5_wp , pfu_ho(ji,jj,jl) ) 
     1254            ! 
     1255            zcoef = ( zcu * zau + ( 1._wp - zcu ) * zbu ) 
     1256            ! 
     1257            pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) * zcoef + pfu_ups(ji,jj,jl) 
     1258            ! 
     1259         END_2D 
     1260 
     1261         DO_2D_10_10 
     1262            zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 
     1263            zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 
     1264            zcv = 0.5_wp + SIGN( 0.5_wp , pfv_ho(ji,jj,jl) ) 
     1265            ! 
     1266            zcoef = ( zcv * zav + ( 1._wp - zcv ) * zbv ) 
     1267            ! 
     1268            pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) * zcoef + pfv_ups(ji,jj,jl) 
     1269            ! 
     1270         END_2D 
    13791271 
    13801272      END DO 
     
    14011293      ! 
    14021294      DO jl = 1, jpl 
    1403          DO jj = 2, jpjm1 
    1404             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1405                zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 
    1406             END DO 
    1407          END DO 
     1295         DO_2D_00_00 
     1296            zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 
     1297         END_2D 
    14081298      END DO 
    14091299      CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.)   ! lateral boundary cond. 
    14101300       
    14111301      DO jl = 1, jpl 
    1412          DO jj = 2, jpjm1 
    1413             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1414                uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 
    1415                 
    1416                Rjm = zslpx(ji-1,jj,jl) 
    1417                Rj  = zslpx(ji  ,jj,jl) 
    1418                Rjp = zslpx(ji+1,jj,jl) 
    1419  
    1420                IF( np_limiter == 3 ) THEN 
    1421  
    1422                   IF( pu(ji,jj) > 0. ) THEN   ;   Rr = Rjm 
    1423                   ELSE                        ;   Rr = Rjp 
     1302         DO_2D_00_00 
     1303            uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 
     1304             
     1305            Rjm = zslpx(ji-1,jj,jl) 
     1306            Rj  = zslpx(ji  ,jj,jl) 
     1307            Rjp = zslpx(ji+1,jj,jl) 
     1308 
     1309            IF( np_limiter == 3 ) THEN 
     1310 
     1311               IF( pu(ji,jj) > 0. ) THEN   ;   Rr = Rjm 
     1312               ELSE                        ;   Rr = Rjp 
     1313               ENDIF 
     1314 
     1315               zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)      
     1316               IF( Rj > 0. ) THEN 
     1317                  zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)),  & 
     1318                     &        MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 
     1319               ELSE 
     1320                  zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)),  & 
     1321                     &        MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 
     1322               ENDIF 
     1323               pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter 
     1324 
     1325            ELSEIF( np_limiter == 2 ) THEN 
     1326               IF( Rj /= 0. ) THEN 
     1327                  IF( pu(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj 
     1328                  ELSE                        ;   Cr = Rjp / Rj 
    14241329                  ENDIF 
    1425  
    1426                   zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)      
    1427                   IF( Rj > 0. ) THEN 
    1428                      zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)),  & 
    1429                         &        MIN( 2. * Rr * 0.5 * ABS(pu(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 
    1430                   ELSE 
    1431                      zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pu(ji,jj)),  & 
    1432                         &        MIN(-2. * Rr * 0.5 * ABS(pu(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pu(ji,jj)) ) ) ) ) 
    1433                   ENDIF 
    1434                   pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter 
    1435  
    1436                ELSEIF( np_limiter == 2 ) THEN 
    1437                   IF( Rj /= 0. ) THEN 
    1438                      IF( pu(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj 
    1439                      ELSE                        ;   Cr = Rjp / Rj 
    1440                      ENDIF 
    1441                   ELSE 
    1442                      Cr = 0. 
    1443                   ENDIF 
    1444  
    1445                   ! -- superbee -- 
    1446                   zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 
    1447                   ! -- van albada 2 -- 
    1448                   !!zpsi = 2.*Cr / (Cr*Cr+1.) 
    1449                   ! -- sweby (with beta=1) -- 
    1450                   !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 
    1451                   ! -- van Leer -- 
    1452                   !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 
    1453                   ! -- ospre -- 
    1454                   !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 
    1455                   ! -- koren -- 
    1456                   !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 
    1457                   ! -- charm -- 
    1458                   !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 
    1459                   !ELSE                 ;   zpsi = 0. 
    1460                   !ENDIF 
    1461                   ! -- van albada 1 -- 
    1462                   !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 
    1463                   ! -- smart -- 
    1464                   !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 
    1465                   ! -- umist -- 
    1466                   !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 
    1467  
    1468                   ! high order flux corrected by the limiter 
    1469                   pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5 
    1470  
     1330               ELSE 
     1331                  Cr = 0. 
    14711332               ENDIF 
    1472             END DO 
    1473          END DO 
     1333 
     1334               ! -- superbee -- 
     1335               zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 
     1336               ! -- van albada 2 -- 
     1337               !!zpsi = 2.*Cr / (Cr*Cr+1.) 
     1338               ! -- sweby (with beta=1) -- 
     1339               !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 
     1340               ! -- van Leer -- 
     1341               !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 
     1342               ! -- ospre -- 
     1343               !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 
     1344               ! -- koren -- 
     1345               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 
     1346               ! -- charm -- 
     1347               !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 
     1348               !ELSE                 ;   zpsi = 0. 
     1349               !ENDIF 
     1350               ! -- van albada 1 -- 
     1351               !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 
     1352               ! -- smart -- 
     1353               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 
     1354               ! -- umist -- 
     1355               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 
     1356 
     1357               ! high order flux corrected by the limiter 
     1358               pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - ABS( pu(ji,jj) ) * ( (1.-zpsi) + uCFL*zpsi ) * Rj * 0.5 
     1359 
     1360            ENDIF 
     1361         END_2D 
    14741362      END DO 
    14751363      CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.)   ! lateral boundary cond. 
     
    14961384      ! 
    14971385      DO jl = 1, jpl 
    1498          DO jj = 2, jpjm1 
    1499             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1500                zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 
    1501             END DO 
    1502          END DO 
     1386         DO_2D_00_00 
     1387            zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 
     1388         END_2D 
    15031389      END DO 
    15041390      CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.)   ! lateral boundary cond. 
    15051391 
    15061392      DO jl = 1, jpl 
    1507          DO jj = 2, jpjm1 
    1508             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1509                vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 
    1510  
    1511                Rjm = zslpy(ji,jj-1,jl) 
    1512                Rj  = zslpy(ji,jj  ,jl) 
    1513                Rjp = zslpy(ji,jj+1,jl) 
    1514  
    1515                IF( np_limiter == 3 ) THEN 
    1516  
    1517                   IF( pv(ji,jj) > 0. ) THEN   ;   Rr = Rjm 
    1518                   ELSE                        ;   Rr = Rjp 
     1393         DO_2D_00_00 
     1394            vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 
     1395 
     1396            Rjm = zslpy(ji,jj-1,jl) 
     1397            Rj  = zslpy(ji,jj  ,jl) 
     1398            Rjp = zslpy(ji,jj+1,jl) 
     1399 
     1400            IF( np_limiter == 3 ) THEN 
     1401 
     1402               IF( pv(ji,jj) > 0. ) THEN   ;   Rr = Rjm 
     1403               ELSE                        ;   Rr = Rjp 
     1404               ENDIF 
     1405 
     1406               zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)      
     1407               IF( Rj > 0. ) THEN 
     1408                  zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)),  & 
     1409                     &        MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 
     1410               ELSE 
     1411                  zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)),  & 
     1412                     &        MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 
     1413               ENDIF 
     1414               pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter 
     1415 
     1416            ELSEIF( np_limiter == 2 ) THEN 
     1417 
     1418               IF( Rj /= 0. ) THEN 
     1419                  IF( pv(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj 
     1420                  ELSE                        ;   Cr = Rjp / Rj 
    15191421                  ENDIF 
    1520  
    1521                   zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)      
    1522                   IF( Rj > 0. ) THEN 
    1523                      zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)),  & 
    1524                         &        MIN( 2. * Rr * 0.5 * ABS(pv(ji,jj)),  zh3,  1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 
    1525                   ELSE 
    1526                      zlimiter = -MAX( 0., MIN(-zh3, MAX( Rr * 0.5 * ABS(pv(ji,jj)),  & 
    1527                         &        MIN(-2. * Rr * 0.5 * ABS(pv(ji,jj)), -zh3, -1.5 * Rj * 0.5 * ABS(pv(ji,jj)) ) ) ) ) 
    1528                   ENDIF 
    1529                   pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter 
    1530  
    1531                ELSEIF( np_limiter == 2 ) THEN 
    1532  
    1533                   IF( Rj /= 0. ) THEN 
    1534                      IF( pv(ji,jj) > 0. ) THEN   ;   Cr = Rjm / Rj 
    1535                      ELSE                        ;   Cr = Rjp / Rj 
    1536                      ENDIF 
    1537                   ELSE 
    1538                      Cr = 0. 
    1539                   ENDIF 
    1540  
    1541                   ! -- superbee -- 
    1542                   zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 
    1543                   ! -- van albada 2 -- 
    1544                   !!zpsi = 2.*Cr / (Cr*Cr+1.) 
    1545                   ! -- sweby (with beta=1) -- 
    1546                   !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 
    1547                   ! -- van Leer -- 
    1548                   !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 
    1549                   ! -- ospre -- 
    1550                   !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 
    1551                   ! -- koren -- 
    1552                   !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 
    1553                   ! -- charm -- 
    1554                   !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 
    1555                   !ELSE                 ;   zpsi = 0. 
    1556                   !ENDIF 
    1557                   ! -- van albada 1 -- 
    1558                   !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 
    1559                   ! -- smart -- 
    1560                   !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 
    1561                   ! -- umist -- 
    1562                   !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 
    1563  
    1564                   ! high order flux corrected by the limiter 
    1565                   pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5 
    1566  
     1422               ELSE 
     1423                  Cr = 0. 
    15671424               ENDIF 
    1568             END DO 
    1569          END DO 
     1425 
     1426               ! -- superbee -- 
     1427               zpsi = MAX( 0., MAX( MIN(1.,2.*Cr), MIN(2.,Cr) ) ) 
     1428               ! -- van albada 2 -- 
     1429               !!zpsi = 2.*Cr / (Cr*Cr+1.) 
     1430               ! -- sweby (with beta=1) -- 
     1431               !!zpsi = MAX( 0., MAX( MIN(1.,1.*Cr), MIN(1.,Cr) ) ) 
     1432               ! -- van Leer -- 
     1433               !!zpsi = ( Cr + ABS(Cr) ) / ( 1. + ABS(Cr) ) 
     1434               ! -- ospre -- 
     1435               !!zpsi = 1.5 * ( Cr*Cr + Cr ) / ( Cr*Cr + Cr + 1. ) 
     1436               ! -- koren -- 
     1437               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( (1.+2*Cr)/3., 2. ) ) ) 
     1438               ! -- charm -- 
     1439               !IF( Cr > 0. ) THEN   ;   zpsi = Cr * (3.*Cr + 1.) / ( (Cr + 1.) * (Cr + 1.) ) 
     1440               !ELSE                 ;   zpsi = 0. 
     1441               !ENDIF 
     1442               ! -- van albada 1 -- 
     1443               !!zpsi = (Cr*Cr + Cr) / (Cr*Cr +1) 
     1444               ! -- smart -- 
     1445               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, 4. ) ) ) 
     1446               ! -- umist -- 
     1447               !!zpsi = MAX( 0., MIN( 2.*Cr, MIN( 0.25+0.75*Cr, MIN(0.75+0.25*Cr, 2. ) ) ) ) 
     1448 
     1449               ! high order flux corrected by the limiter 
     1450               pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - ABS( pv(ji,jj) ) * ( (1.-zpsi) + vCFL*zpsi ) * Rj * 0.5 
     1451 
     1452            ENDIF 
     1453         END_2D 
    15701454      END DO 
    15711455      CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.)   ! lateral boundary cond. 
     
    16041488      ! 
    16051489      DO jl = 1, jpl 
    1606          DO jj = 1, jpj 
    1607             DO ji = 1, jpi 
    1608                IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     1490         DO_2D_11_11 
     1491            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     1492               ! 
     1493               !                               ! -- check h_ip -- ! 
     1494               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
     1495               IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     1496                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
     1497                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
     1498                     pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 
     1499                  ENDIF 
     1500               ENDIF 
     1501               ! 
     1502               !                               ! -- check h_i -- ! 
     1503               ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 
     1504               zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 
     1505               IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1506                  pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m) 
     1507               ENDIF 
     1508               ! 
     1509               !                               ! -- check h_s -- ! 
     1510               ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 
     1511               zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 
     1512               IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1513                  zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 
    16091514                  ! 
    1610                   !                               ! -- check h_ip -- ! 
    1611                   ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    1612                   IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    1613                      zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    1614                      IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    1615                         pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 
    1616                      ENDIF 
    1617                   ENDIF 
     1515                  wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 
     1516                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    16181517                  ! 
    1619                   !                               ! -- check h_i -- ! 
    1620                   ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 
    1621                   zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 
    1622                   IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    1623                      pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m) 
    1624                   ENDIF 
    1625                   ! 
    1626                   !                               ! -- check h_s -- ! 
    1627                   ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 
    1628                   zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 
    1629                   IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    1630                      zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 
    1631                      ! 
    1632                      wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 
    1633                      hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    1634                      ! 
    1635                      pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
    1636                      pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 
    1637                   ENDIF            
    1638                   !                   
    1639                   !                               ! -- check s_i -- ! 
    1640                   ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
    1641                   zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
    1642                   IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    1643                      zfra = psi_max(ji,jj,jl) / zsi 
    1644                      sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
    1645                      psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
    1646                   ENDIF 
    1647                   ! 
     1518                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
     1519                  pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 
     1520               ENDIF            
     1521               !                   
     1522               !                               ! -- check s_i -- ! 
     1523               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
     1524               zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
     1525               IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1526                  zfra = psi_max(ji,jj,jl) / zsi 
     1527                  sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
     1528                  psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
    16481529               ENDIF 
    1649             END DO 
    1650          END DO 
     1530               ! 
     1531            ENDIF 
     1532         END_2D 
    16511533      END DO  
    16521534      ! 
    16531535      !                                           ! -- check e_i/v_i -- ! 
    16541536      DO jl = 1, jpl 
    1655          DO jk = 1, nlay_i 
    1656             DO jj = 1, jpj 
    1657                DO ji = 1, jpi 
    1658                   IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    1659                      ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
    1660                      zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
    1661                      IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    1662                         zfra = pei_max(ji,jj,jk,jl) / zei 
    1663                         hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    1664                         pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
    1665                      ENDIF 
    1666                   ENDIF 
    1667                END DO 
    1668             END DO 
    1669          END DO 
     1537         DO_3D_11_11( 1, nlay_i ) 
     1538            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     1539               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     1540               zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
     1541               IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1542                  zfra = pei_max(ji,jj,jk,jl) / zei 
     1543                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1544                  pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
     1545               ENDIF 
     1546            ENDIF 
     1547         END_3D 
    16701548      END DO 
    16711549      !                                           ! -- check e_s/v_s -- ! 
    16721550      DO jl = 1, jpl 
    1673          DO jk = 1, nlay_s 
    1674             DO jj = 1, jpj 
    1675                DO ji = 1, jpi 
    1676                   IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    1677                      ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
    1678                      zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
    1679                      IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
    1680                         zfra = pes_max(ji,jj,jk,jl) / zes 
    1681                         hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    1682                         pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
    1683                      ENDIF 
    1684                   ENDIF 
    1685                END DO 
    1686             END DO 
    1687          END DO 
     1551         DO_3D_11_11( 1, nlay_s ) 
     1552            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
     1553               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     1554               zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
     1555               IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1556                  zfra = pes_max(ji,jj,jk,jl) / zes 
     1557                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1558                  pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
     1559               ENDIF 
     1560            ENDIF 
     1561         END_3D 
    16881562      END DO 
    16891563      ! 
     
    17181592      ! -- check snow load -- ! 
    17191593      DO jl = 1, jpl 
    1720          DO jj = 1, jpj 
    1721             DO ji = 1, jpi 
    1722                IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    1723                   ! 
    1724                   zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 
    1725                   ! 
    1726                   IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface 
    1727                      ! put snow excess in the ocean 
    1728                      zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 
    1729                      wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 
    1730                      hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
    1731                      ! correct snow volume and heat content 
    1732                      pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
    1733                      pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess 
    1734                   ENDIF 
    1735                   ! 
     1594         DO_2D_11_11 
     1595            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     1596               ! 
     1597               zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 
     1598               ! 
     1599               IF( zvs_excess > 0._wp ) THEN   ! snow-ice interface deplets below the ocean surface 
     1600                  ! put snow excess in the ocean 
     1601                  zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 
     1602                  wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 
     1603                  hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1604                  ! correct snow volume and heat content 
     1605                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
     1606                  pv_s(ji,jj,jl)          = pv_s(ji,jj,jl) - zvs_excess 
    17361607               ENDIF 
    1737             END DO 
    1738          END DO 
     1608               ! 
     1609            ENDIF 
     1610         END_2D 
    17391611      END DO 
    17401612      ! 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rdgrft.F90

    r13466 r13469  
    159159      npti = 0   ;   nptidx(:) = 0 
    160160      ipti = 0   ;   iptidx(:) = 0 
    161       DO jj = 1, jpj 
    162          DO ji = 1, jpi 
    163             IF ( at_i(ji,jj) > epsi10 ) THEN 
    164                npti           = npti + 1 
    165                nptidx( npti ) = (jj - 1) * jpi + ji 
    166             ENDIF 
    167          END DO 
    168       END DO 
     161      DO_2D_11_11 
     162         IF ( at_i(ji,jj) > epsi10 ) THEN 
     163            npti           = npti + 1 
     164            nptidx( npti ) = (jj - 1) * jpi + ji 
     165         ENDIF 
     166      END_2D 
    169167       
    170168      !-------------------------------------------------------- 
     
    777775      !                              !--------------------------------------------------! 
    778776      CASE( 1 )               !--- Spatial smoothing 
    779          DO jj = 2, jpjm1 
    780             DO ji = 2, jpim1 
    781                IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN  
    782                   zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
    783                      &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &   
    784                      &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) & 
    785                      &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 
    786                ELSE 
    787                   zworka(ji,jj) = 0._wp 
    788                ENDIF 
    789             END DO 
    790          END DO 
     777         DO_2D_00_00 
     778            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN  
     779               zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
     780                  &                  + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) &   
     781                  &                  + strength(ji,jj-1) * tmask(ji,jj-1,1) + strength(ji,jj+1) * tmask(ji,jj+1,1) & 
     782                  &            ) / ( 4.0 + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 
     783            ELSE 
     784               zworka(ji,jj) = 0._wp 
     785            ENDIF 
     786         END_2D 
    791787          
    792          DO jj = 2, jpjm1 
    793             DO ji = 2, jpim1 
    794                strength(ji,jj) = zworka(ji,jj) 
    795             END DO 
    796          END DO 
     788         DO_2D_00_00 
     789            strength(ji,jj) = zworka(ji,jj) 
     790         END_2D 
    797791         CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 
    798792         ! 
     
    803797         ENDIF 
    804798         ! 
    805          DO jj = 2, jpjm1 
    806             DO ji = 2, jpim1 
    807                IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN  
    808                   itframe = 1 ! number of time steps for the running mean 
    809                   IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1 
    810                   IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1 
    811                   zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe 
    812                   zstrp2  (ji,jj) = zstrp1  (ji,jj) 
    813                   zstrp1  (ji,jj) = strength(ji,jj) 
    814                   strength(ji,jj) = zp 
    815                ENDIF 
    816             END DO 
    817          END DO 
     799         DO_2D_00_00 
     800            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN  
     801               itframe = 1 ! number of time steps for the running mean 
     802               IF ( zstrp1(ji,jj) > 0._wp ) itframe = itframe + 1 
     803               IF ( zstrp2(ji,jj) > 0._wp ) itframe = itframe + 1 
     804               zp = ( strength(ji,jj) + zstrp1(ji,jj) + zstrp2(ji,jj) ) / itframe 
     805               zstrp2  (ji,jj) = zstrp1  (ji,jj) 
     806               zstrp1  (ji,jj) = strength(ji,jj) 
     807               strength(ji,jj) = zp 
     808            ENDIF 
     809         END_2D 
    818810         CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 
    819811         ! 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90

    r13467 r13469  
    182182      ! for diagnostics and convergence tests 
    183183      ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
    184       DO jj = 1, jpj 
    185          DO ji = 1, jpi 
    186             zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    187             zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    188          END DO 
    189       END DO 
     184      DO_2D_11_11 
     185         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     186         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     187      END_2D 
    190188      ! 
    191189      !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
     
    194192      !------------------------------------------------------------------------------! 
    195193      ! ocean/land mask 
    196       DO jj = 1, jpjm1 
    197          DO ji = 1, jpim1      ! NO vector opt. 
    198             zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    199          END DO 
    200       END DO 
     194      DO_2D_10_10 
     195         zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     196      END_2D 
    201197      CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 
    202198 
    203199      ! Lateral boundary conditions on velocity (modify zfmask) 
    204       DO jj = 2, jpjm1 
    205          DO ji = fs_2, fs_jpim1   ! vector opt. 
    206             IF( zfmask(ji,jj) == 0._wp ) THEN 
    207                zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    208                   &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
    209             ENDIF 
    210          END DO 
    211       END DO 
     200      DO_2D_00_00 
     201         IF( zfmask(ji,jj) == 0._wp ) THEN 
     202            zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     203               &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     204         ENDIF 
     205      END_2D 
    212206      DO jj = 2, jpjm1 
    213207         IF( zfmask(1,jj) == 0._wp ) THEN 
     
    272266      zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 
    273267 
    274       DO jj = 2, jpjm1 
    275          DO ji = fs_2, fs_jpim1 
    276  
    277             ! ice fraction at U-V points 
    278             zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    279             zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    280  
    281             ! Ice/snow mass at U-V points 
    282             zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) ) 
    283             zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) ) 
    284             zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) ) 
    285             zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    286             zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    287  
    288             ! Ocean currents at U-V points 
    289             v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 
    290             u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 
    291  
    292             ! Coriolis at T points (m*f) 
    293             zmf(ji,jj)      = zm1 * ff_t(ji,jj) 
    294  
    295             ! dt/m at T points (for alpha and beta coefficients) 
    296             zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin ) 
    297              
    298             ! m/dt 
    299             zmU_t(ji,jj)    = zmassU * z1_dtevp 
    300             zmV_t(ji,jj)    = zmassV * z1_dtevp 
    301              
    302             ! Drag ice-atm. 
    303             ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 
    304             ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 
    305  
    306             ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 
    307             zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) 
    308             zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) 
    309  
    310             ! masks 
    311             zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
    312             zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
    313  
    314             ! switches 
    315             IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp 
    316             ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF 
    317             IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp 
    318             ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF 
    319  
    320          END DO 
    321       END DO 
     268      DO_2D_00_00 
     269 
     270         ! ice fraction at U-V points 
     271         zaU(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
     272         zaV(ji,jj) = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
     273 
     274         ! Ice/snow mass at U-V points 
     275         zm1 = ( rhos * vt_s(ji  ,jj  ) + rhoi * vt_i(ji  ,jj  ) ) 
     276         zm2 = ( rhos * vt_s(ji+1,jj  ) + rhoi * vt_i(ji+1,jj  ) ) 
     277         zm3 = ( rhos * vt_s(ji  ,jj+1) + rhoi * vt_i(ji  ,jj+1) ) 
     278         zmassU = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
     279         zmassV = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
     280 
     281         ! Ocean currents at U-V points 
     282         v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 
     283         u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 
     284 
     285         ! Coriolis at T points (m*f) 
     286         zmf(ji,jj)      = zm1 * ff_t(ji,jj) 
     287 
     288         ! dt/m at T points (for alpha and beta coefficients) 
     289         zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin ) 
     290          
     291         ! m/dt 
     292         zmU_t(ji,jj)    = zmassU * z1_dtevp 
     293         zmV_t(ji,jj)    = zmassV * z1_dtevp 
     294          
     295         ! Drag ice-atm. 
     296         ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 
     297         ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 
     298 
     299         ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 
     300         zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) 
     301         zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) 
     302 
     303         ! masks 
     304         zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
     305         zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
     306 
     307         ! switches 
     308         IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp 
     309         ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF 
     310         IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp 
     311         ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF 
     312 
     313      END_2D 
    322314      CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1., zdt_m, 'T', 1. ) 
    323315      ! 
     
    325317      ! 
    326318      IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016 
    327          DO jj = 2, jpjm1 
    328             DO ji = fs_2, fs_jpim1 
    329                ! ice thickness at U-V points 
    330                zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    331                zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    332                ! ice-bottom stress at U points 
    333                zvCr = zaU(ji,jj) * rn_lf_depfra * hu_n(ji,jj) 
    334                ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    335                ! ice-bottom stress at V points 
    336                zvCr = zaV(ji,jj) * rn_lf_depfra * hv_n(ji,jj) 
    337                ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    338                ! ice_bottom stress at T points 
    339                zvCr = at_i(ji,jj) * rn_lf_depfra * ht_n(ji,jj) 
    340                tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    341             END DO 
    342          END DO 
     319         DO_2D_00_00 
     320            ! ice thickness at U-V points 
     321            zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
     322            zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
     323            ! ice-bottom stress at U points 
     324            zvCr = zaU(ji,jj) * rn_lf_depfra * hu_n(ji,jj) 
     325            ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
     326            ! ice-bottom stress at V points 
     327            zvCr = zaV(ji,jj) * rn_lf_depfra * hv_n(ji,jj) 
     328            ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
     329            ! ice_bottom stress at T points 
     330            zvCr = at_i(ji,jj) * rn_lf_depfra * ht_n(ji,jj) 
     331            tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
     332         END_2D 
    343333         CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 
    344334         ! 
    345335      ELSE                               !-- no landfast 
    346          DO jj = 2, jpjm1 
    347             DO ji = fs_2, fs_jpim1 
    348                ztaux_base(ji,jj) = 0._wp 
    349                ztauy_base(ji,jj) = 0._wp 
    350             END DO 
    351          END DO 
     336         DO_2D_00_00 
     337            ztaux_base(ji,jj) = 0._wp 
     338            ztauy_base(ji,jj) = 0._wp 
     339         END_2D 
    352340      ENDIF 
    353341 
     
    363351         ! convergence test 
    364352         IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2  ) THEN 
    365             DO jj = 1, jpj 
    366                DO ji = 1, jpi 
    367                   zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 
    368                   zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
    369                END DO 
    370             END DO 
     353            DO_2D_11_11 
     354               zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 
     355               zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
     356            END_2D 
    371357         ENDIF 
    372358 
    373359         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    374          DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 
    375             DO ji = 1, jpim1 
    376  
    377                ! shear at F points 
    378                zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    379                   &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    380                   &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
    381  
    382             END DO 
    383          END DO 
     360         DO_2D_10_10 
     361 
     362            ! shear at F points 
     363            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
     364               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
     365               &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     366 
     367         END_2D 
    384368         CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. ) 
    385369 
    386          DO jj = 2, jpj    ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 
    387             DO ji = 2, jpi ! no vector loop 
    388  
    389                ! shear**2 at T points (doc eq. A16) 
    390                zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  & 
    391                   &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  & 
    392                   &   ) * 0.25_wp * r1_e1e2t(ji,jj) 
    393                
    394                ! divergence at T points 
    395                zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
    396                   &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
    397                   &    ) * r1_e1e2t(ji,jj) 
    398                zdiv2 = zdiv * zdiv 
    399                 
    400                ! tension at T points 
    401                zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
    402                   &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
    403                   &   ) * r1_e1e2t(ji,jj) 
    404                zdt2 = zdt * zdt 
    405                 
    406                ! delta at T points 
    407                zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
    408  
    409                ! P/delta at T points 
    410                zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 
    411  
    412                ! alpha for aEVP 
    413                !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 
    414                !   alpha = beta = sqrt(4*gamma) 
    415                IF( ln_aEVP ) THEN 
    416                   zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
    417                   z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 
    418                   zalph2   = zalph1 
    419                   z1_alph2 = z1_alph1 
    420                   ! explicit: 
    421                   ! z1_alph1 = 1._wp / zalph1 
    422                   ! z1_alph2 = 1._wp / zalph1 
    423                   ! zalph1 = zalph1 - 1._wp 
    424                   ! zalph2 = zalph1 
    425                ENDIF 
    426                 
    427                ! stress at T points (zkt/=0 if landfast) 
    428                zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 
    429                zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
    430               
    431             END DO 
    432          END DO 
     370         DO_2D_01_01 
     371 
     372            ! shear**2 at T points (doc eq. A16) 
     373            zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  & 
     374               &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  & 
     375               &   ) * 0.25_wp * r1_e1e2t(ji,jj) 
     376            
     377            ! divergence at T points 
     378            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     379               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     380               &    ) * r1_e1e2t(ji,jj) 
     381            zdiv2 = zdiv * zdiv 
     382             
     383            ! tension at T points 
     384            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     385               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     386               &   ) * r1_e1e2t(ji,jj) 
     387            zdt2 = zdt * zdt 
     388             
     389            ! delta at T points 
     390            zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
     391 
     392            ! P/delta at T points 
     393            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 
     394 
     395            ! alpha for aEVP 
     396            !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 
     397            !   alpha = beta = sqrt(4*gamma) 
     398            IF( ln_aEVP ) THEN 
     399               zalph1   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
     400               z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 
     401               zalph2   = zalph1 
     402               z1_alph2 = z1_alph1 
     403               ! explicit: 
     404               ! z1_alph1 = 1._wp / zalph1 
     405               ! z1_alph2 = 1._wp / zalph1 
     406               ! zalph1 = zalph1 - 1._wp 
     407               ! zalph2 = zalph1 
     408            ENDIF 
     409             
     410            ! stress at T points (zkt/=0 if landfast) 
     411            zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 
     412            zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
     413           
     414         END_2D 
    433415         CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. ) 
    434416 
    435417         ! Save beta at T-points for further computations 
    436418         IF( ln_aEVP ) THEN 
    437             DO jj = 1, jpj 
    438                DO ji = 1, jpi 
    439                   zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
    440                END DO 
    441             END DO 
     419            DO_2D_11_11 
     420               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
     421            END_2D 
    442422         ENDIF 
    443423          
    444          DO jj = 1, jpjm1 
    445             DO ji = 1, jpim1 
    446  
    447                ! alpha for aEVP 
    448                IF( ln_aEVP ) THEN 
    449                   zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 
    450                   z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
    451                   ! explicit: 
    452                   ! z1_alph2 = 1._wp / zalph2 
    453                   ! zalph2 = zalph2 - 1._wp 
    454                ENDIF 
    455                 
    456                ! P/delta at F points 
    457                zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 
    458                 
    459                ! stress at F points (zkt/=0 if landfast) 
    460                zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2 
    461  
    462             END DO 
    463          END DO 
     424         DO_2D_10_10 
     425 
     426            ! alpha for aEVP 
     427            IF( ln_aEVP ) THEN 
     428               zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 
     429               z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
     430               ! explicit: 
     431               ! z1_alph2 = 1._wp / zalph2 
     432               ! zalph2 = zalph2 - 1._wp 
     433            ENDIF 
     434             
     435            ! P/delta at F points 
     436            zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 
     437             
     438            ! stress at F points (zkt/=0 if landfast) 
     439            zs12(ji,jj)= ( zs12(ji,jj) * zalph2 + zp_delf * ( zds(ji,jj) * z1_ecc2 * (1._wp + zkt) ) * 0.5_wp ) * z1_alph2 
     440 
     441         END_2D 
    464442 
    465443         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
    466          DO jj = 2, jpjm1 
    467             DO ji = fs_2, fs_jpim1                
    468                !                   !--- U points 
    469                zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
    470                   &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    & 
    471                   &                    ) * r1_e2u(ji,jj)                                                                      & 
    472                   &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  & 
    473                   &                    ) * 2._wp * r1_e1u(ji,jj)                                                              & 
    474                   &                  ) * r1_e1e2u(ji,jj) 
    475                ! 
    476                !                !--- V points 
    477                zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             & 
    478                   &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    & 
    479                   &                    ) * r1_e1v(ji,jj)                                                                      & 
    480                   &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  & 
    481                   &                    ) * 2._wp * r1_e2v(ji,jj)                                                              & 
    482                   &                  ) * r1_e1e2v(ji,jj) 
    483                ! 
    484                !                !--- ice currents at U-V point 
    485                v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 
    486                u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 
    487                ! 
    488             END DO 
    489          END DO 
     444         DO_2D_00_00 
     445            !                   !--- U points 
     446            zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
     447               &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    & 
     448               &                    ) * r1_e2u(ji,jj)                                                                      & 
     449               &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  & 
     450               &                    ) * 2._wp * r1_e1u(ji,jj)                                                              & 
     451               &                  ) * r1_e1e2u(ji,jj) 
     452            ! 
     453            !                !--- V points 
     454            zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             & 
     455               &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    & 
     456               &                    ) * r1_e1v(ji,jj)                                                                      & 
     457               &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  & 
     458               &                    ) * 2._wp * r1_e2v(ji,jj)                                                              & 
     459               &                  ) * r1_e1e2v(ji,jj) 
     460            ! 
     461            !                !--- ice currents at U-V point 
     462            v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 
     463            u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 
     464            ! 
     465         END_2D 
    490466         ! 
    491467         ! --- Computation of ice velocity --- ! 
     
    494470         IF( MOD(jter,2) == 0 ) THEN ! even iterations 
    495471            ! 
    496             DO jj = 2, jpjm1 
    497                DO ji = fs_2, fs_jpim1 
    498                   !                 !--- tau_io/(v_oce - v_ice) 
    499                   zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
    500                      &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 
    501                   !                 !--- Ocean-to-Ice stress 
    502                   ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 
    503                   ! 
    504                   !                 !--- tau_bottom/v_ice 
    505                   zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 
    506                   zTauB = ztauy_base(ji,jj) / zvel 
    507                   !                 !--- OceanBottom-to-Ice stress 
    508                   ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 
    509                   ! 
    510                   !                 !--- Coriolis at V-points (energy conserving formulation) 
    511                   zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
    512                      &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
    513                      &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
    514                   ! 
    515                   !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    516                   zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
    517                   ! 
    518                   !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
    519                   !                                         1 = sliding friction : TauB < RHS 
    520                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
    521                   ! 
    522                   IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    523                      zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
    524                      v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
    525                         &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    526                         &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    527                         &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &  
    528                         &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
    529                         &                                    ) / ( zbetav + 1._wp )                                              & 
    530                         &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    531                         &           )   * zmsk00y(ji,jj) 
    532                   ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    533                      v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
    534                         &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    535                         &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
    536                         &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
    537                         &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    538                         &            )  * zmsk00y(ji,jj) 
    539                   ENDIF 
    540                END DO 
    541             END DO 
     472            DO_2D_00_00 
     473               !                 !--- tau_io/(v_oce - v_ice) 
     474               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
     475                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 
     476               !                 !--- Ocean-to-Ice stress 
     477               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 
     478               ! 
     479               !                 !--- tau_bottom/v_ice 
     480               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 
     481               zTauB = ztauy_base(ji,jj) / zvel 
     482               !                 !--- OceanBottom-to-Ice stress 
     483               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 
     484               ! 
     485               !                 !--- Coriolis at V-points (energy conserving formulation) 
     486               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
     487                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
     488                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
     489               ! 
     490               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
     491               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
     492               ! 
     493               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
     494               !                                         1 = sliding friction : TauB < RHS 
     495               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
     496               ! 
     497               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
     498                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
     499                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     500                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     501                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     502                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &  
     503                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     504                     &                                    ) / ( zbetav + 1._wp )                                              & 
     505                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     506                     &           )   * zmsk00y(ji,jj) 
     507               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
     508                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
     509                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     510                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     511                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     512                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     513                     &            )  * zmsk00y(ji,jj) 
     514               ENDIF 
     515            END_2D 
    542516            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 
    543517            ! 
     
    548522            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
    549523            ! 
    550             DO jj = 2, jpjm1 
    551                DO ji = fs_2, fs_jpim1           
    552                   !                 !--- tau_io/(u_oce - u_ice) 
    553                   zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
    554                      &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 
    555                   !                 !--- Ocean-to-Ice stress 
    556                   ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 
    557                   ! 
    558                   !                 !--- tau_bottom/u_ice 
    559                   zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 
    560                   zTauB = ztaux_base(ji,jj) / zvel 
    561                   !                 !--- OceanBottom-to-Ice stress 
    562                   ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 
    563                   ! 
    564                   !                 !--- Coriolis at U-points (energy conserving formulation) 
    565                   zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
    566                      &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
    567                      &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
    568                   ! 
    569                   !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    570                   zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
    571                   ! 
    572                   !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
    573                   !                                         1 = sliding friction : TauB < RHS 
    574                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
    575                   ! 
    576                   IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    577                      zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
    578                      u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
    579                         &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    580                         &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    581                         &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
    582                         &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
    583                         &                                    ) / ( zbetau + 1._wp )                                              & 
    584                         &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    585                         &           )   * zmsk00x(ji,jj) 
    586                   ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    587                      u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
    588                         &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    589                         &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
    590                         &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
    591                         &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    592                         &           )   * zmsk00x(ji,jj) 
    593                   ENDIF 
    594                END DO 
    595             END DO 
     524            DO_2D_00_00 
     525               !                 !--- tau_io/(u_oce - u_ice) 
     526               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
     527                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 
     528               !                 !--- Ocean-to-Ice stress 
     529               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 
     530               ! 
     531               !                 !--- tau_bottom/u_ice 
     532               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 
     533               zTauB = ztaux_base(ji,jj) / zvel 
     534               !                 !--- OceanBottom-to-Ice stress 
     535               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 
     536               ! 
     537               !                 !--- Coriolis at U-points (energy conserving formulation) 
     538               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
     539                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
     540                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
     541               ! 
     542               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
     543               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
     544               ! 
     545               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
     546               !                                         1 = sliding friction : TauB < RHS 
     547               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
     548               ! 
     549               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
     550                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
     551                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     552                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     553                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     554                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
     555                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     556                     &                                    ) / ( zbetau + 1._wp )                                              & 
     557                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     558                     &           )   * zmsk00x(ji,jj) 
     559               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
     560                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
     561                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     562                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     563                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     564                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     565                     &           )   * zmsk00x(ji,jj) 
     566               ENDIF 
     567            END_2D 
    596568            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 
    597569            ! 
     
    604576         ELSE ! odd iterations 
    605577            ! 
    606             DO jj = 2, jpjm1 
    607                DO ji = fs_2, fs_jpim1 
    608                   !                 !--- tau_io/(u_oce - u_ice) 
    609                   zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
    610                      &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 
    611                   !                 !--- Ocean-to-Ice stress 
    612                   ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 
    613                   ! 
    614                   !                 !--- tau_bottom/u_ice 
    615                   zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 
    616                   zTauB = ztaux_base(ji,jj) / zvel 
    617                   !                 !--- OceanBottom-to-Ice stress 
    618                   ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 
    619                   ! 
    620                   !                 !--- Coriolis at U-points (energy conserving formulation) 
    621                   zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
    622                      &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
    623                      &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
    624                   ! 
    625                   !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    626                   zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
    627                   ! 
    628                   !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
    629                   !                                         1 = sliding friction : TauB < RHS 
    630                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
    631                   ! 
    632                   IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    633                      zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
    634                      u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
    635                         &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    636                         &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    637                         &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
    638                         &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
    639                         &                                    ) / ( zbetau + 1._wp )                                              & 
    640                         &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    641                         &           )   * zmsk00x(ji,jj) 
    642                   ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    643                      u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
    644                         &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    645                         &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
    646                         &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
    647                         &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    648                         &           )   * zmsk00x(ji,jj) 
    649                   ENDIF 
    650                END DO 
    651             END DO 
     578            DO_2D_00_00 
     579               !                 !--- tau_io/(u_oce - u_ice) 
     580               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
     581                  &                              + ( v_iceU(ji,jj) - v_oceU(ji,jj) ) * ( v_iceU(ji,jj) - v_oceU(ji,jj) ) ) 
     582               !                 !--- Ocean-to-Ice stress 
     583               ztaux_oi(ji,jj) = zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 
     584               ! 
     585               !                 !--- tau_bottom/u_ice 
     586               zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 
     587               zTauB = ztaux_base(ji,jj) / zvel 
     588               !                 !--- OceanBottom-to-Ice stress 
     589               ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 
     590               ! 
     591               !                 !--- Coriolis at U-points (energy conserving formulation) 
     592               zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
     593                  &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
     594                  &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
     595               ! 
     596               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
     597               zRHS = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
     598               ! 
     599               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
     600               !                                         1 = sliding friction : TauB < RHS 
     601               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztaux_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
     602               ! 
     603               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
     604                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
     605                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     606                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     607                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     608                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
     609                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     610                     &                                    ) / ( zbetau + 1._wp )                                              & 
     611                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     612                     &           )   * zmsk00x(ji,jj) 
     613               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
     614                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
     615                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     616                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     617                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     618                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     619                     &           )   * zmsk00x(ji,jj) 
     620               ENDIF 
     621            END_2D 
    652622            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 
    653623            ! 
     
    658628            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
    659629            ! 
    660             DO jj = 2, jpjm1 
    661                DO ji = fs_2, fs_jpim1 
    662                   !                 !--- tau_io/(v_oce - v_ice) 
    663                   zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
    664                      &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 
    665                   !                 !--- Ocean-to-Ice stress 
    666                   ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 
    667                   ! 
    668                   !                 !--- tau_bottom/v_ice 
    669                   zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 
    670                   zTauB = ztauy_base(ji,jj) / zvel 
    671                   !                 !--- OceanBottom-to-Ice stress 
    672                   ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 
    673                   ! 
    674                   !                 !--- Coriolis at v-points (energy conserving formulation) 
    675                   zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
    676                      &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
    677                      &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
    678                   ! 
    679                   !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    680                   zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
    681                   ! 
    682                   !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
    683                   !                                         1 = sliding friction : TauB < RHS 
    684                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
    685                   ! 
    686                   IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    687                      zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
    688                      v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
    689                         &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    690                         &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    691                         &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
    692                         &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
    693                         &                                    ) / ( zbetav + 1._wp )                                              &  
    694                         &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    695                         &           )   * zmsk00y(ji,jj) 
    696                   ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    697                      v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
    698                         &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    699                         &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
    700                         &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
    701                         &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    702                         &           )   * zmsk00y(ji,jj) 
    703                   ENDIF 
    704                END DO 
    705             END DO 
     630            DO_2D_00_00 
     631               !                 !--- tau_io/(v_oce - v_ice) 
     632               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
     633                  &                              + ( u_iceV(ji,jj) - u_oceV(ji,jj) ) * ( u_iceV(ji,jj) - u_oceV(ji,jj) ) ) 
     634               !                 !--- Ocean-to-Ice stress 
     635               ztauy_oi(ji,jj) = zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 
     636               ! 
     637               !                 !--- tau_bottom/v_ice 
     638               zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 
     639               zTauB = ztauy_base(ji,jj) / zvel 
     640               !                 !--- OceanBottom-to-Ice stress 
     641               ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 
     642               ! 
     643               !                 !--- Coriolis at v-points (energy conserving formulation) 
     644               zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
     645                  &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
     646                  &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
     647               ! 
     648               !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
     649               zRHS = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
     650               ! 
     651               !                 !--- landfast switch => 0 = static  friction : TauB > RHS & sign(TauB) /= sign(RHS) 
     652               !                                         1 = sliding friction : TauB < RHS 
     653               rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zRHS + ztauy_base(ji,jj) ) - SIGN( 1._wp, zRHS ) ) ) 
     654               ! 
     655               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
     656                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
     657                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     658                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     659                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     660                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
     661                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     662                     &                                    ) / ( zbetav + 1._wp )                                              &  
     663                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     664                     &           )   * zmsk00y(ji,jj) 
     665               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
     666                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
     667                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     668                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     669                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     670                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     671                     &           )   * zmsk00y(ji,jj) 
     672               ENDIF 
     673            END_2D 
    706674            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 
    707675            ! 
     
    725693      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)  
    726694      !------------------------------------------------------------------------------! 
    727       DO jj = 1, jpjm1 
    728          DO ji = 1, jpim1 
    729  
    730             ! shear at F points 
    731             zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    732                &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    733                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
    734  
    735          END DO 
    736       END DO            
     695      DO_2D_10_10 
     696 
     697         ! shear at F points 
     698         zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
     699            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
     700            &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     701 
     702      END_2D 
    737703       
    738       DO jj = 2, jpjm1 
    739          DO ji = 2, jpim1 ! no vector loop 
    740              
    741             ! tension**2 at T points 
    742             zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
    743                &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
    744                &   ) * r1_e1e2t(ji,jj) 
    745             zdt2 = zdt * zdt 
    746              
    747             ! shear**2 at T points (doc eq. A16) 
    748             zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  & 
    749                &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  & 
    750                &   ) * 0.25_wp * r1_e1e2t(ji,jj) 
    751              
    752             ! shear at T points 
    753             pshear_i(ji,jj) = SQRT( zdt2 + zds2 ) 
    754  
    755             ! divergence at T points 
    756             pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
    757                &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
    758                &             ) * r1_e1e2t(ji,jj) 
    759              
    760             ! delta at T points 
    761             zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
    762             rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 
    763             pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 
    764  
    765          END DO 
    766       END DO 
     704      DO_2D_00_00 
     705          
     706         ! tension**2 at T points 
     707         zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     708            &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     709            &   ) * r1_e1e2t(ji,jj) 
     710         zdt2 = zdt * zdt 
     711          
     712         ! shear**2 at T points (doc eq. A16) 
     713         zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  & 
     714            &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  & 
     715            &   ) * 0.25_wp * r1_e1e2t(ji,jj) 
     716          
     717         ! shear at T points 
     718         pshear_i(ji,jj) = SQRT( zdt2 + zds2 ) 
     719 
     720         ! divergence at T points 
     721         pdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     722            &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     723            &             ) * r1_e1e2t(ji,jj) 
     724          
     725         ! delta at T points 
     726         zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
     727         rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 
     728         pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 
     729 
     730      END_2D 
    767731      CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 
    768732       
     
    802766         ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) 
    803767         !          
    804          DO jj = 2, jpjm1 
    805             DO ji = 2, jpim1 
    806                zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point 
    807                   &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  & 
    808                   &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 
    809  
    810                zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress   
    811  
    812                zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 
     768         DO_2D_00_00 
     769            zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point 
     770               &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  & 
     771               &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 
     772 
     773            zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress   
     774 
     775            zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 
    813776 
    814777!!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) 
     
    816779!!               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress 
    817780!!                                                                                                               ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11)) 
    818                zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015 
    819                zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                     ! shear stress 
    820                zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 
    821             END DO 
    822          END DO 
     781            zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015 
     782            zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                     ! shear stress 
     783            zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 
     784         END_2D 
    823785         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 
    824786         ! 
     
    855817            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 
    856818         ! 
    857          DO jj = 2, jpjm1 
    858             DO ji = 2, jpim1 
    859                ! 2D ice mass, snow mass, area transport arrays (X, Y) 
    860                zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
    861                zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 
    862  
    863                zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 
    864                zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   '' 
    865  
    866                zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 
    867                zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   '' 
    868  
    869                zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component 
    870                zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   '' 
    871  
    872             END DO 
    873          END DO 
     819         DO_2D_00_00 
     820            ! 2D ice mass, snow mass, area transport arrays (X, Y) 
     821            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
     822            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 
     823 
     824            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 
     825            zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   '' 
     826 
     827            zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 
     828            zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   '' 
     829 
     830            zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component 
     831            zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   '' 
     832 
     833         END_2D 
    874834 
    875835         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
     
    957917         zresm = 0._wp 
    958918      ELSE 
    959          DO jj = 1, jpj 
    960             DO ji = 1, jpi 
    961                zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    962                   &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
    963             END DO 
    964          END DO 
     919         DO_2D_11_11 
     920            zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     921               &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
     922         END_2D 
    965923         zresm = MAXVAL( zres ) 
    966924         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceistate.F90

    r13466 r13469  
    287287         ! select ice covered grid points 
    288288         npti = 0 ; nptidx(:) = 0 
    289          DO jj = 1, jpj 
    290             DO ji = 1, jpi 
    291                IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
    292                   npti         = npti  + 1 
    293                   nptidx(npti) = (jj - 1) * jpi + ji 
    294                ENDIF 
    295             END DO 
    296          END DO 
     289         DO_2D_11_11 
     290            IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
     291               npti         = npti  + 1 
     292               nptidx(npti) = (jj - 1) * jpi + ji 
     293            ENDIF 
     294         END_2D 
    297295 
    298296         ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 
     
    344342         CALL ice_var_salprof ! for sz_i 
    345343         DO jl = 1, jpl 
    346             DO jj = 1, jpj 
    347                DO ji = 1, jpi 
    348                   v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
    349                   v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
    350                   sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
    351                END DO 
    352             END DO 
     344            DO_2D_11_11 
     345               v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
     346               v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
     347               sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
     348            END_2D 
    353349         END DO 
    354350         ! 
    355351         DO jl = 1, jpl 
    356             DO jk = 1, nlay_s 
    357                DO jj = 1, jpj 
    358                   DO ji = 1, jpi 
    359                      t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
    360                      e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
    361                         &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
    362                   END DO 
    363                END DO 
    364             END DO 
     352            DO_3D_11_11( 1, nlay_s ) 
     353               t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
     354               e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
     355                  &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
     356            END_3D 
    365357         END DO 
    366358         ! 
    367359         DO jl = 1, jpl 
    368             DO jk = 1, nlay_i 
    369                DO jj = 1, jpj 
    370                   DO ji = 1, jpi 
    371                      t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
    372                      ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
    373                      e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
    374                         &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
    375                         &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
    376                         &                       - rcp   * ( ztmelts - rt0 ) ) 
    377                   END DO 
    378                END DO 
    379             END DO 
     360            DO_3D_11_11( 1, nlay_i ) 
     361               t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
     362               ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
     363               e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
     364                  &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
     365                  &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
     366                  &                       - rcp   * ( ztmelts - rt0 ) ) 
     367            END_3D 
    380368         END DO 
    381369 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceitd.F90

    r13466 r13469  
    9797      ! 
    9898      npti = 0   ;   nptidx(:) = 0 
    99       DO jj = 1, jpj 
    100          DO ji = 1, jpi 
    101             IF ( at_i(ji,jj) > epsi10 ) THEN 
    102                npti = npti + 1 
    103                nptidx( npti ) = (jj - 1) * jpi + ji 
    104             ENDIF 
    105          END DO 
    106       END DO 
     99      DO_2D_11_11 
     100         IF ( at_i(ji,jj) > epsi10 ) THEN 
     101            npti = npti + 1 
     102            nptidx( npti ) = (jj - 1) * jpi + ji 
     103         ENDIF 
     104      END_2D 
    107105       
    108106      !----------------------------------------------------------------------------------------------- 
     
    606604         !                    !--------------------------------------- 
    607605         npti = 0   ;   nptidx(:) = 0 
    608          DO jj = 1, jpj 
    609             DO ji = 1, jpi 
    610                IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 
    611                   npti = npti + 1 
    612                   nptidx( npti ) = (jj - 1) * jpi + ji                   
    613                ENDIF 
    614             END DO 
    615          END DO 
     606         DO_2D_11_11 
     607            IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 
     608               npti = npti + 1 
     609               nptidx( npti ) = (jj - 1) * jpi + ji                   
     610            ENDIF 
     611         END_2D 
    616612         ! 
    617613!!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) 
     
    647643         !                    !----------------------------------------- 
    648644         npti = 0 ; nptidx(:) = 0 
    649          DO jj = 1, jpj 
    650             DO ji = 1, jpi 
    651                IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 
    652                   npti = npti + 1 
    653                   nptidx( npti ) = (jj - 1) * jpi + ji                   
    654                ENDIF 
    655             END DO 
    656          END DO 
     645         DO_2D_11_11 
     646            IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 
     647               npti = npti + 1 
     648               nptidx( npti ) = (jj - 1) * jpi + ji                   
     649            ENDIF 
     650         END_2D 
    657651         ! 
    658652         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icesbc.F90

    r13466 r13469  
    7777      IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation 
    7878                                   CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    79          DO jj = 2, jpjm1 
    80             DO ji = 2, jpim1 
    81                utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    82                vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    83             END DO 
    84          END DO 
     79         DO_2D_00_00 
     80            utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
     81            vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
     82         END_2D 
    8583         CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
    8684      ENDIF 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icestp.F90

    r13467 r13469  
    209209      ! --- Ocean time step --- ! 
    210210      !-------------------------! 
    211       IF( ln_icedyn )                   CALL ice_update_tau( kt, ub(:,:,1), vb(:,:,1) )   ! -- update surface ocean stresses 
     211      IF( ln_icedyn )                   CALL ice_update_tau( kt, uu(:,:,1,Nnn), vv(:,:,1,Nnn) )   ! -- update surface ocean stresses 
    212212!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    213213      ! 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90

    r13466 r13469  
    120120         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
    121121         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    122          DO jj = 2, jpjm1  
    123             DO ji = fs_2, fs_jpim1 
    124                zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
    125                   &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    126                   &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
    127             END DO 
    128          END DO 
     122         DO_2D_00_00 
     123            zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
     124               &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
     125               &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
     126         END_2D 
    129127      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
    130          DO jj = 2, jpjm1 
    131             DO ji = fs_2, fs_jpim1 
    132                zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
    133                   &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    134                   &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
    135             END DO 
    136          END DO 
     128         DO_2D_00_00 
     129            zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
     130               &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     131               &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
     132         END_2D 
    137133      ENDIF 
    138134      CALL lbc_lnk( 'icethd', zfric, 'T',  1. ) 
     
    141137      ! Partial computation of forcing for the thermodynamic sea ice model 
    142138      !--------------------------------------------------------------------! 
    143       DO jj = 1, jpj 
    144          DO ji = 1, jpi 
    145             rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
    146             ! 
    147             !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    148             !           !  practically no "direct lateral ablation" 
    149             !            
    150             !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    151             !           !  temperature and turbulent mixing (McPhee, 1992) 
    152             ! 
    153             ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 
    154             zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    155                &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  & 
    156                &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
    157  
    158             ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 
    159             zqfr     = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 
    160             zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0 
    161  
    162             ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 
    163             zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    164             qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
    165  
    166             qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
    167             ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
    168             !                              the freezing point, so that we do not have SST < T_freeze 
    169             !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
    170  
    171             !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 
    172             qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
    173  
    174             ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting  
    175             ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 
    176             IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 
    177                IF( ln_leadhfx ) THEN   ;   fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
    178                ELSE                    ;   fhld(ji,jj) = 0._wp 
    179                ENDIF 
    180                qlead(ji,jj) = 0._wp 
    181             ELSE 
    182                fhld (ji,jj) = 0._wp 
     139      DO_2D_11_11 
     140         rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
     141         ! 
     142         !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
     143         !           !  practically no "direct lateral ablation" 
     144         !            
     145         !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
     146         !           !  temperature and turbulent mixing (McPhee, 1992) 
     147         ! 
     148         ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 
     149         zqld =  tmask(ji,jj,1) * rdt_ice *  & 
     150            &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  & 
     151            &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
     152 
     153         ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 
     154         zqfr     = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 
     155         zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0 
     156 
     157         ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 
     158         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
     159         qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
     160 
     161         qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     162         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
     163         !                              the freezing point, so that we do not have SST < T_freeze 
     164         !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
     165 
     166         !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 
     167         qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
     168 
     169         ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting  
     170         ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 
     171         IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 
     172            IF( ln_leadhfx ) THEN   ;   fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     173            ELSE                    ;   fhld(ji,jj) = 0._wp 
    183174            ENDIF 
    184             ! 
    185             ! Net heat flux on top of the ice-ocean [W.m-2] 
    186             ! --------------------------------------------- 
    187             qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    188          END DO 
    189       END DO 
     175            qlead(ji,jj) = 0._wp 
     176         ELSE 
     177            fhld (ji,jj) = 0._wp 
     178         ENDIF 
     179         ! 
     180         ! Net heat flux on top of the ice-ocean [W.m-2] 
     181         ! --------------------------------------------- 
     182         qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
     183      END_2D 
    190184       
    191185      ! In case we bypass open-water ice formation 
     
    215209         ! select ice covered grid points 
    216210         npti = 0 ; nptidx(:) = 0 
    217          DO jj = 1, jpj 
    218             DO ji = 1, jpi 
    219                IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
    220                   npti         = npti  + 1 
    221                   nptidx(npti) = (jj - 1) * jpi + ji 
    222                ENDIF 
    223             END DO 
    224          END DO 
     211         DO_2D_11_11 
     212            IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
     213               npti         = npti  + 1 
     214               nptidx(npti) = (jj - 1) * jpi + ji 
     215            ENDIF 
     216         END_2D 
    225217 
    226218         IF( npti > 0 ) THEN  ! If there is no ice, do nothing. 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/iceupdate.F90

    r13466 r13469  
    114114      ENDIF 
    115115       
    116       DO jj = 1, jpj 
    117          DO ji = 1, jpi 
    118  
    119             ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
    120             !--------------------------------------------------- 
    121             zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 
    122  
    123             ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2)  
    124             !--------------------------------------------------- 
    125             zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
    126             qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr 
    127  
    128             ! Add the residual from heat diffusion equation and sublimation (W.m-2) 
    129             !---------------------------------------------------------------------- 
    130             qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   & 
    131                &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 
    132  
    133             ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    134             !---------------------------------------------------------------------------- 
    135             qsr(ji,jj) = zqsr                                       
    136             qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr               
    137  
    138             ! Mass flux at the atm. surface        
    139             !----------------------------------- 
    140             wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) 
    141  
    142             ! Mass flux at the ocean surface       
    143             !------------------------------------ 
    144             !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
    145             !  -------------------------------------------------------------------------------------  
    146             !  The idea of this approach is that the system that we consider is the ICE-OCEAN system 
    147             !  Thus  FW  flux  =  External ( E-P+snow melt) 
    148             !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW 
    149             !                     Associated to Ice formation AND Ice melting 
    150             !                     Even if i see Ice melting as a FW and SALT flux 
    151             !         
    152             ! mass flux from ice/ocean 
    153             wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    154                &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) 
    155  
    156             ! add the snow melt water to snow mass flux to the ocean 
    157             wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj) 
    158  
    159             ! mass flux at the ocean/ice interface 
    160             fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model 
    161             emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    162  
    163  
    164             ! Salt flux at the ocean surface       
    165             !------------------------------------------ 
    166             sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   & 
    167                &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) 
    168              
    169             ! Mass of snow and ice per unit area    
    170             !---------------------------------------- 
    171             snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step 
    172             !                                               ! new mass per unit area 
    173             snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  )  
    174             !                                               ! time evolution of snow+ice mass 
    175             snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 
    176              
    177          END DO 
    178       END DO 
     116      DO_2D_11_11 
     117 
     118         ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
     119         !--------------------------------------------------- 
     120         zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 
     121 
     122         ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2)  
     123         !--------------------------------------------------- 
     124         zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     125         qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr 
     126 
     127         ! Add the residual from heat diffusion equation and sublimation (W.m-2) 
     128         !---------------------------------------------------------------------- 
     129         qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   & 
     130            &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 
     131 
     132         ! New qsr and qns used to compute the oceanic heat flux at the next time step 
     133         !---------------------------------------------------------------------------- 
     134         qsr(ji,jj) = zqsr                                       
     135         qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr               
     136 
     137         ! Mass flux at the atm. surface        
     138         !----------------------------------- 
     139         wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) 
     140 
     141         ! Mass flux at the ocean surface       
     142         !------------------------------------ 
     143         !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
     144         !  -------------------------------------------------------------------------------------  
     145         !  The idea of this approach is that the system that we consider is the ICE-OCEAN system 
     146         !  Thus  FW  flux  =  External ( E-P+snow melt) 
     147         !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW 
     148         !                     Associated to Ice formation AND Ice melting 
     149         !                     Even if i see Ice melting as a FW and SALT flux 
     150         !         
     151         ! mass flux from ice/ocean 
     152         wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
     153            &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) 
     154 
     155         ! add the snow melt water to snow mass flux to the ocean 
     156         wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj) 
     157 
     158         ! mass flux at the ocean/ice interface 
     159         fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model 
     160         emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     161 
     162 
     163         ! Salt flux at the ocean surface       
     164         !------------------------------------------ 
     165         sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   & 
     166            &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) 
     167          
     168         ! Mass of snow and ice per unit area    
     169         !---------------------------------------- 
     170         snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step 
     171         !                                               ! new mass per unit area 
     172         snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  )  
     173         !                                               ! time evolution of snow+ice mass 
     174         snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 
     175          
     176      END_2D 
    179177 
    180178      ! Storing the transmitted variables 
     
    335333      ! 
    336334      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    337          DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
    338             DO ji = fs_2, fs_jpim1 
    339                !                                               ! 2*(U_ice-U_oce) at T-point 
    340                zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)    
    341                zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1)  
    342                !                                              ! |U_ice-U_oce|^2 
    343                zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  ) 
    344                !                                               ! update the ocean stress modulus 
    345                taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 
    346                tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
    347             END DO 
    348          END DO 
     335         DO_2D_00_00 
     336            !                                               ! 2*(U_ice-U_oce) at T-point 
     337            zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)    
     338            zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1)  
     339            !                                              ! |U_ice-U_oce|^2 
     340            zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  ) 
     341            !                                               ! update the ocean stress modulus 
     342            taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * zrhoco * zmodt 
     343            tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
     344         END_2D 
    349345         CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1., tmod_io, 'T', 1. ) 
    350346         ! 
     
    363359      ENDIF 
    364360      ! 
    365       DO jj = 2, jpjm1                                !* update the stress WITHOUT an ice-ocean rotation angle 
    366          DO ji = fs_2, fs_jpim1   ! Vect. Opt.    
    367             ! ice area at u and v-points  
    368             zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  & 
    369                &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) ) 
    370             zat_v  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji  ,jj+1  ) * tmask(ji  ,jj+1,1) )  & 
    371                &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji  ,jj+1,1) ) 
    372             !                                                   ! linearized quadratic drag formulation 
    373             zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - zflagi * pu_oce(ji,jj) ) 
    374             zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - zflagi * pv_oce(ji,jj) ) 
    375             !                                                   ! stresses at the ocean surface 
    376             utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice 
    377             vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 
    378          END DO 
    379       END DO 
     361      DO_2D_00_00 
     362         ! ice area at u and v-points  
     363         zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  & 
     364            &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) ) 
     365         zat_v  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji  ,jj+1  ) * tmask(ji  ,jj+1,1) )  & 
     366            &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji  ,jj+1,1) ) 
     367         !                                                   ! linearized quadratic drag formulation 
     368         zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - zflagi * pu_oce(ji,jj) ) 
     369         zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - zflagi * pv_oce(ji,jj) ) 
     370         !                                                   ! stresses at the ocean surface 
     371         utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice 
     372         vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 
     373      END_2D 
    380374      CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition 
    381375      ! 
  • NEMO/branches/2020/temporary_r4_trunk/src/ICE/icevar.F90

    r13466 r13469  
    263263      zlay_i   = REAL( nlay_i , wp )    ! number of layers 
    264264      DO jl = 1, jpl 
    265          DO jk = 1, nlay_i 
    266             DO jj = 1, jpj 
    267                DO ji = 1, jpi 
    268                   IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
    269                      ! 
    270                      ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3] 
    271                      ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C] 
    272                      ! Conversion q(S,T) -> T (second order equation) 
    273                      zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 
    274                      zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 
    275                      t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts 
    276                      ! 
    277                   ELSE                                   !--- no ice 
    278                      t_i(ji,jj,jk,jl) = rt0 
    279                   ENDIF 
    280                END DO 
    281             END DO 
    282          END DO 
     265         DO_3D_11_11( 1, nlay_i ) 
     266            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
     267               ! 
     268               ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3] 
     269               ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C] 
     270               ! Conversion q(S,T) -> T (second order equation) 
     271               zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 
     272               zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 
     273               t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts 
     274               ! 
     275            ELSE                                   !--- no ice 
     276               t_i(ji,jj,jk,jl) = rt0 
     277            ENDIF 
     278         END_3D 
    283279      END DO 
    284280 
     
    372368         z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    373369         DO jl = 1, jpl 
    374             DO jj = 1, jpj 
    375                DO ji = 1, jpi 
    376                   zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
    377                   !                             ! force a constant profile when SSS too low (Baltic Sea) 
    378                   IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp   
    379                END DO 
    380             END DO 
     370            DO_2D_11_11 
     371               zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
     372               !                             ! force a constant profile when SSS too low (Baltic Sea) 
     373               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp   
     374            END_2D 
    381375         END DO 
    382376         ! 
    383377         ! Computation of the profile 
    384378         DO jl = 1, jpl 
    385             DO jk = 1, nlay_i 
    386                DO jj = 1, jpj 
    387                   DO ji = 1, jpi 
    388                      !                          ! linear profile with 0 surface value 
    389                      zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
    390                      zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)  &nb