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_do.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_do.F90

    r11536 r12377  
    4444   REAL(wp) ::   rn_Cfraz      ! squeezing coefficient for collection of bottom frazil ice 
    4545 
     46   !! * Substitutions 
     47#  include "do_loop_substitute.h90" 
    4648   !!---------------------------------------------------------------------- 
    4749   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
     
    143145         zgamafr = 0.03 
    144146         ! 
    145          DO jj = 2, jpjm1 
    146             DO ji = 2, jpim1 
    147                IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast 
    148                   ! -- Wind stress -- ! 
    149                   ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   & 
    150                      &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp 
    151                   ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   & 
    152                      &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp 
    153                   ! Square root of wind stress 
    154                   ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
    155  
    156                   ! -- Frazil ice velocity -- ! 
    157                   rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 
    158                   zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 
    159                   zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 
    160  
    161                   ! -- Pack ice velocity -- ! 
    162                   zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 
    163                   zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 
    164  
    165                   ! -- Relative frazil/pack ice velocity -- ! 
    166                   rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
    167                   zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   & 
    168                      &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch 
    169                   zvrel(ji,jj) = SQRT( zvrel2 ) 
    170  
    171                   ! -- new ice thickness (iterative loop) -- ! 
    172                   ht_i_new(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    & 
    173                      &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2 
    174  
    175                   iter = 1 
    176                   DO WHILE ( iter < 20 )  
    177                      zf  = ( ht_i_new(ji,jj) - zhicrit ) * ( ht_i_new(ji,jj) * ht_i_new(ji,jj) - zhicrit * zhicrit ) -   & 
    178                         &    ht_i_new(ji,jj) * zhicrit * ztwogp * zvrel2 
    179                      zfp = ( ht_i_new(ji,jj) - zhicrit ) * ( 3.0 * ht_i_new(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 
    180  
    181                      ht_i_new(ji,jj) = ht_i_new(ji,jj) - zf / MAX( zfp, epsi20 ) 
    182                      iter = iter + 1 
    183                   END DO 
    184                   ! 
    185                   ! bound ht_i_new (though I don't see why it should be necessary) 
    186                   ht_i_new(ji,jj) = MAX( 0.01_wp, MIN( ht_i_new(ji,jj), hi_max(jpl) ) ) 
    187                   ! 
    188                ENDIF 
     147         DO_2D_00_00 
     148            IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast 
     149               ! -- Wind stress -- ! 
     150               ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   & 
     151                  &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp 
     152               ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   & 
     153                  &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp 
     154               ! Square root of wind stress 
     155               ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
     156 
     157               ! -- Frazil ice velocity -- ! 
     158               rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 
     159               zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 
     160               zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 
     161 
     162               ! -- Pack ice velocity -- ! 
     163               zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 
     164               zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 
     165 
     166               ! -- Relative frazil/pack ice velocity -- ! 
     167               rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
     168               zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   & 
     169                  &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch 
     170               zvrel(ji,jj) = SQRT( zvrel2 ) 
     171 
     172               ! -- new ice thickness (iterative loop) -- ! 
     173               ht_i_new(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    & 
     174                  &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2 
     175 
     176               iter = 1 
     177               DO WHILE ( iter < 20 )  
     178                  zf  = ( ht_i_new(ji,jj) - zhicrit ) * ( ht_i_new(ji,jj) * ht_i_new(ji,jj) - zhicrit * zhicrit ) -   & 
     179                     &    ht_i_new(ji,jj) * zhicrit * ztwogp * zvrel2 
     180                  zfp = ( ht_i_new(ji,jj) - zhicrit ) * ( 3.0 * ht_i_new(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 
     181 
     182                  ht_i_new(ji,jj) = ht_i_new(ji,jj) - zf / MAX( zfp, epsi20 ) 
     183                  iter = iter + 1 
     184               END DO 
    189185               ! 
    190             END DO  
    191          END DO  
     186               ! bound ht_i_new (though I don't see why it should be necessary) 
     187               ht_i_new(ji,jj) = MAX( 0.01_wp, MIN( ht_i_new(ji,jj), hi_max(jpl) ) ) 
     188               ! 
     189            ENDIF 
     190            ! 
     191         END_2D 
    192192         !  
    193193         CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1., ht_i_new, 'T', 1.  ) 
     
    202202      ! Identify grid points where new ice forms 
    203203      npti = 0   ;   nptidx(:) = 0 
    204       DO jj = 1, jpj 
    205          DO ji = 1, jpi 
    206             IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN 
    207                npti = npti + 1 
    208                nptidx( npti ) = (jj - 1) * jpi + ji 
    209             ENDIF 
    210          END DO 
    211       END DO 
     204      DO_2D_11_11 
     205         IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN 
     206            npti = npti + 1 
     207            nptidx( npti ) = (jj - 1) * jpi + ji 
     208         ENDIF 
     209      END_2D 
    212210 
    213211      ! Move from 2-D to 1-D vectors 
     
    443441      !!------------------------------------------------------------------- 
    444442      ! 
    445       REWIND( numnam_ice_ref )              ! Namelist namthd_do in reference namelist : Ice thermodynamics 
    446443      READ  ( numnam_ice_ref, namthd_do, IOSTAT = ios, ERR = 901) 
    447444901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_do in reference namelist' ) 
    448       REWIND( numnam_ice_cfg )              ! Namelist namthd_do in configuration namelist : Ice thermodynamics 
    449445      READ  ( numnam_ice_cfg, namthd_do, IOSTAT = ios, ERR = 902 ) 
    450446902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_do in configuration namelist' ) 
Note: See TracChangeset for help on using the changeset viewer.