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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13469 for NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90 – NEMO

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

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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. 
Note: See TracChangeset for help on using the changeset viewer.