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/icevar.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/icevar.F90

    r11732 r12377  
    8282   END INTERFACE 
    8383 
     84   !! * Substitutions 
     85#  include "do_loop_substitute.h90" 
    8486   !!---------------------------------------------------------------------- 
    8587   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    115117      ! 
    116118      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction   
    117  
     119      ! 
     120      !!GS: tm_su always needed by ABL over sea-ice 
     121      ALLOCATE( z1_at_i(jpi,jpj) ) 
     122      WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:) 
     123      ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp 
     124      END WHERE 
     125      tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
     126      WHERE( at_i(:,:)<=epsi20 ) tm_su(:,:) = rt0 
     127      ! 
    118128      ! The following fields are calculated for diagnostics and outputs only 
    119129      ! ==> Do not use them for other purposes 
    120130      IF( kn > 1 ) THEN 
    121131         ! 
    122          ALLOCATE( z1_at_i(jpi,jpj) , z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) 
    123          WHERE( at_i(:,:) > epsi20 )   ;   z1_at_i(:,:) = 1._wp / at_i(:,:) 
    124          ELSEWHERE                     ;   z1_at_i(:,:) = 0._wp 
    125          END WHERE 
     132         ALLOCATE( z1_vt_i(jpi,jpj) , z1_vt_s(jpi,jpj) ) 
    126133         WHERE( vt_i(:,:) > epsi20 )   ;   z1_vt_i(:,:) = 1._wp / vt_i(:,:) 
    127134         ELSEWHERE                     ;   z1_vt_i(:,:) = 0._wp 
    … …  
    136143         !          
    137144         !                          ! mean temperature (K), salinity and age 
    138          tm_su(:,:) = SUM( t_su(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    139145         tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    140146         om_i (:,:) = SUM( oa_i(:,:,:)              , dim=3 ) * z1_at_i(:,:) 
    … …  
    154160         !                           ! put rt0 where there is no ice 
    155161         WHERE( at_i(:,:)<=epsi20 ) 
    156             tm_su(:,:) = rt0 
    157162            tm_si(:,:) = rt0 
    158163            tm_i (:,:) = rt0 
    … …  
    165170         END WHERE          
    166171         ! 
    167          DEALLOCATE( z1_at_i , z1_vt_i , z1_vt_s ) 
     172         DEALLOCATE( z1_vt_i , z1_vt_s ) 
    168173         ! 
    169174      ENDIF 
     175      ! 
     176      DEALLOCATE( z1_at_i ) 
    170177      ! 
    171178   END SUBROUTINE ice_var_agg 
    … …  
    236243      zlay_i   = REAL( nlay_i , wp )    ! number of layers 
    237244      DO jl = 1, jpl 
    238          DO jk = 1, nlay_i 
    239             DO jj = 1, jpj 
    240                DO ji = 1, jpi 
    241                   IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
    242                      ! 
    243                      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] 
    244                      ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C] 
    245                      ! Conversion q(S,T) -> T (second order equation) 
    246                      zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 
    247                      zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 
    248                      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 
    249                      ! 
    250                   ELSE                                   !--- no ice 
    251                      t_i(ji,jj,jk,jl) = rt0 
    252                   ENDIF 
    253                END DO 
    254             END DO 
    255          END DO 
     245         DO_3D_11_11( 1, nlay_i ) 
     246            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
     247               ! 
     248               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] 
     249               ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C] 
     250               ! Conversion q(S,T) -> T (second order equation) 
     251               zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 
     252               zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 
     253               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 
     254               ! 
     255            ELSE                                   !--- no ice 
     256               t_i(ji,jj,jk,jl) = rt0 
     257            ENDIF 
     258         END_3D 
    256259      END DO 
    257260 
    … …  
    344347         z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    345348         DO jl = 1, jpl 
    346             DO jj = 1, jpj 
    347                DO ji = 1, jpi 
    348                   zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
    349                   !                             ! force a constant profile when SSS too low (Baltic Sea) 
    350                   IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp   
    351                END DO 
    352             END DO 
     349            DO_2D_11_11 
     350               zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
     351               !                             ! force a constant profile when SSS too low (Baltic Sea) 
     352               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp   
     353            END_2D 
    353354         END DO 
    354355         ! 
    355356         ! Computation of the profile 
    356357         DO jl = 1, jpl 
    357             DO jk = 1, nlay_i 
    358                DO jj = 1, jpj 
    359                   DO ji = 1, jpi 
    360                      !                          ! linear profile with 0 surface value 
    361                      zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
    362                      zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile 
    363                      sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) ) 
    364                   END DO 
    365                END DO 
    366             END DO 
     358            DO_3D_11_11( 1, nlay_i ) 
     359               !                          ! linear profile with 0 surface value 
     360               zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
     361               zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile 
     362               sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) ) 
     363            END_3D 
    367364         END DO 
    368365         ! 
    … …  
    489486         ! Zap ice energy and use ocean heat to melt ice 
    490487         !----------------------------------------------------------------- 
    491          DO jk = 1, nlay_i 
    492             DO jj = 1 , jpj 
    493                DO ji = 1 , jpi 
    494                   ! update exchanges with ocean 
    495                   hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
    496                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj) 
    497                   t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
    498                END DO 
    499             END DO 
    500          END DO 
    501          ! 
    502          DO jk = 1, nlay_s 
    503             DO jj = 1 , jpj 
    504                DO ji = 1 , jpi 
    505                   ! update exchanges with ocean 
    506                   hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
    507                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj) 
    508                   t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
    509                END DO 
    510             END DO 
    511          END DO 
     488         DO_3D_11_11( 1, nlay_i ) 
     489            ! update exchanges with ocean 
     490            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
     491            e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj) 
     492            t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
     493         END_3D 
     494         ! 
     495         DO_3D_11_11( 1, nlay_s ) 
     496            ! update exchanges with ocean 
     497            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
     498            e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj) 
     499            t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
     500         END_3D 
    512501         ! 
    513502         !----------------------------------------------------------------- 
    514503         ! zap ice and snow volume, add water and salt to ocean 
    515504         !----------------------------------------------------------------- 
    516          DO jj = 1 , jpj 
    517             DO ji = 1 , jpi 
    518                ! update exchanges with ocean 
    519                sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice 
    520                wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_rdtice 
    521                wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_rdtice 
    522                ! 
    523                a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 
    524                v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj) 
    525                v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj) 
    526                t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) ) 
    527                oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj) 
    528                sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj) 
    529                ! 
    530                h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj) 
    531                h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj) 
    532                ! 
    533                a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 
    534                v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
    535                ! 
    536             END DO 
    537          END DO 
     505         DO_2D_11_11 
     506            ! update exchanges with ocean 
     507            sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice 
     508            wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_rdtice 
     509            wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_rdtice 
     510            ! 
     511            a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 
     512            v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj) 
     513            v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj) 
     514            t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) ) 
     515            oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj) 
     516            sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj) 
     517            ! 
     518            h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj) 
     519            h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj) 
     520            ! 
     521            a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 
     522            v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
     523            ! 
     524         END_2D 
    538525         ! 
    539526      END DO  
    … …  
    587574         ! zap ice energy and send it to the ocean 
    588575         !---------------------------------------- 
    589          DO jk = 1, nlay_i 
    590             DO jj = 1 , jpj 
    591                DO ji = 1 , jpi 
    592                   IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    593                      hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 
    594                      pe_i(ji,jj,jk,jl) = 0._wp 
    595                   ENDIF 
    596                END DO 
    597             END DO 
    598          END DO 
    599          ! 
    600          DO jk = 1, nlay_s 
    601             DO jj = 1 , jpj 
    602                DO ji = 1 , jpi 
    603                   IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    604                      hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 
    605                      pe_s(ji,jj,jk,jl) = 0._wp 
    606                   ENDIF 
    607                END DO 
    608             END DO 
    609          END DO 
     576         DO_3D_11_11( 1, nlay_i ) 
     577            IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
     578               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 
     579               pe_i(ji,jj,jk,jl) = 0._wp 
     580            ENDIF 
     581         END_3D 
     582         ! 
     583         DO_3D_11_11( 1, nlay_s ) 
     584            IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
     585               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 
     586               pe_s(ji,jj,jk,jl) = 0._wp 
     587            ENDIF 
     588         END_3D 
    610589         ! 
    611590         !----------------------------------------------------- 
    612591         ! zap ice and snow volume, add water and salt to ocean 
    613592         !----------------------------------------------------- 
    614          DO jj = 1 , jpj 
    615             DO ji = 1 , jpi 
    616                IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    617                   wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 
    618                   pv_i   (ji,jj,jl) = 0._wp 
    619                ENDIF 
    620                IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    621                   wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt 
    622                   pv_s   (ji,jj,jl) = 0._wp 
    623                ENDIF 
    624                IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN 
    625                   sfx_res(ji,jj)    = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 
    626                   psv_i  (ji,jj,jl) = 0._wp 
    627                ENDIF 
    628             END DO 
    629          END DO 
     593         DO_2D_11_11 
     594            IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
     595               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 
     596               pv_i   (ji,jj,jl) = 0._wp 
     597            ENDIF 
     598            IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
     599               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt 
     600               pv_s   (ji,jj,jl) = 0._wp 
     601            ENDIF 
     602            IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN 
     603               sfx_res(ji,jj)    = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 
     604               psv_i  (ji,jj,jl) = 0._wp 
     605            ENDIF 
     606         END_2D 
    630607         ! 
    631608      END DO  
Note: See TracChangeset for help on using the changeset viewer.