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 12377 for NEMO/trunk/src/ICE/icethd.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/ICE/icethd.F90

    r11536 r12377  
    5353 
    5454   !! * Substitutions 
    55 #  include "vectopt_loop_substitute.h90" 
     55#  include "do_loop_substitute.h90" 
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    109109         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
    110110         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    111          DO jj = 2, jpjm1  
    112             DO ji = fs_2, fs_jpim1 
    113                zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
    114                   &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    115                   &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
    116             END DO 
    117          END DO 
     111         DO_2D_00_00 
     112            zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
     113               &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
     114               &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
     115         END_2D 
    118116      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
    119          DO jj = 2, jpjm1 
    120             DO ji = fs_2, fs_jpim1 
    121                zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
    122                   &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    123                   &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
    124             END DO 
    125          END DO 
     117         DO_2D_00_00 
     118            zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp *  & 
     119               &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     120               &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
     121         END_2D 
    126122      ENDIF 
    127123      CALL lbc_lnk( 'icethd', zfric, 'T',  1. ) 
    … …  
    130126      ! Partial computation of forcing for the thermodynamic sea ice model 
    131127      !--------------------------------------------------------------------! 
    132       DO jj = 1, jpj 
    133          DO ji = 1, jpi 
    134             rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
    135             ! 
    136             !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    137             !           !  practically no "direct lateral ablation" 
    138             !            
    139             !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    140             !           !  temperature and turbulent mixing (McPhee, 1992) 
    141             ! 
    142             ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 
    143             zqld =  tmask(ji,jj,1) * rdt_ice *  & 
    144                &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  & 
    145                &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
    146  
    147             ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 
    148             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) 
    149             zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0 
    150  
    151             ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 
    152             zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    153             qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
    154  
    155             qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
    156             ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
    157             !                              the freezing point, so that we do not have SST < T_freeze 
    158             !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
    159  
    160             !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 
    161             qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
    162  
    163             ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting  
    164             ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 
    165             IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 
    166                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 
    167                qlead(ji,jj) = 0._wp 
    168             ELSE 
    169                fhld (ji,jj) = 0._wp 
    170             ENDIF 
    171             ! 
    172             ! Net heat flux on top of the ice-ocean [W.m-2] 
    173             ! --------------------------------------------- 
    174             qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
    175          END DO 
    176       END DO 
     128      DO_2D_11_11 
     129         rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
     130         ! 
     131         !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
     132         !           !  practically no "direct lateral ablation" 
     133         !            
     134         !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
     135         !           !  temperature and turbulent mixing (McPhee, 1992) 
     136         ! 
     137         ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 
     138         zqld =  tmask(ji,jj,1) * rdt_ice *  & 
     139            &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  & 
     140            &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
     141 
     142         ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 
     143         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) 
     144         zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0 
     145 
     146         ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 
     147         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
     148         qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
     149 
     150         qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     151         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
     152         !                              the freezing point, so that we do not have SST < T_freeze 
     153         !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
     154 
     155         !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 
     156         qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
     157 
     158         ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting  
     159         ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 
     160         IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 
     161            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 
     162            qlead(ji,jj) = 0._wp 
     163         ELSE 
     164            fhld (ji,jj) = 0._wp 
     165         ENDIF 
     166         ! 
     167         ! Net heat flux on top of the ice-ocean [W.m-2] 
     168         ! --------------------------------------------- 
     169         qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
     170      END_2D 
    177171       
    178172      ! In case we bypass open-water ice formation 
    … …  
    202196         ! select ice covered grid points 
    203197         npti = 0 ; nptidx(:) = 0 
    204          DO jj = 1, jpj 
    205             DO ji = 1, jpi 
    206                IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
    207                   npti         = npti  + 1 
    208                   nptidx(npti) = (jj - 1) * jpi + ji 
    209                ENDIF 
    210             END DO 
    211          END DO 
     198         DO_2D_11_11 
     199            IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
     200               npti         = npti  + 1 
     201               nptidx(npti) = (jj - 1) * jpi + ji 
     202            ENDIF 
     203         END_2D 
    212204 
    213205         IF( npti > 0 ) THEN  ! If there is no ice, do nothing. 
    … …  
    252244      ! controls 
    253245      IF( ln_icectl )   CALL ice_prt    (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints 
    254       IF( ln_ctl    )   CALL ice_prt3D  ('icethd')                                        ! prints 
     246      IF( sn_cfctl%l_prtctl )   & 
     247        &               CALL ice_prt3D  ('icethd')                                        ! prints 
    255248      IF( ln_timing )   CALL timing_stop('icethd')                                        ! timing 
    256249      ! 
    … …  
    539532      !!------------------------------------------------------------------- 
    540533      ! 
    541       REWIND( numnam_ice_ref )              ! Namelist namthd in reference namelist : Ice thermodynamics 
    542534      READ  ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901) 
    543535901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd in reference namelist' ) 
    544       REWIND( numnam_ice_cfg )              ! Namelist namthd in configuration namelist : Ice thermodynamics 
    545536      READ  ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 ) 
    546537902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd in configuration namelist' ) 
Note: See TracChangeset for help on using the changeset viewer.