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

    r11536 r12377  
    6161   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    6262   !    
     63   !! * Substitutions 
     64#  include "do_loop_substitute.h90" 
    6365   !!---------------------------------------------------------------------- 
    6466   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    6870CONTAINS 
    6971 
    70    SUBROUTINE ice_istate( kt ) 
     72   SUBROUTINE ice_istate( kt, Kbb, Kmm, Kaa ) 
    7173      !!------------------------------------------------------------------- 
    7274      !!                    ***  ROUTINE ice_istate  *** 
    … …  
    8991      !!              where there is no ice 
    9092      !!-------------------------------------------------------------------- 
    91       INTEGER, INTENT(in) ::   kt   ! time step  
    92       !! 
     93      INTEGER, INTENT(in) :: kt            ! time step  
     94      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 
     95      ! 
    9396      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
    9497      REAL(wp) ::   ztmelts 
    … …  
    268271         ! select ice covered grid points 
    269272         npti = 0 ; nptidx(:) = 0 
    270          DO jj = 1, jpj 
    271             DO ji = 1, jpi 
    272                IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
    273                   npti         = npti  + 1 
    274                   nptidx(npti) = (jj - 1) * jpi + ji 
    275                ENDIF 
    276             END DO 
    277          END DO 
     273         DO_2D_11_11 
     274            IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
     275               npti         = npti  + 1 
     276               nptidx(npti) = (jj - 1) * jpi + ji 
     277            ENDIF 
     278         END_2D 
    278279 
    279280         ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 
    … …  
    320321         CALL ice_var_salprof ! for sz_i 
    321322         DO jl = 1, jpl 
    322             DO jj = 1, jpj 
    323                DO ji = 1, jpi 
    324                   v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
    325                   v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
    326                   sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
    327                END DO 
    328             END DO 
     323            DO_2D_11_11 
     324               v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
     325               v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
     326               sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
     327            END_2D 
    329328         END DO 
    330329         ! 
    331330         DO jl = 1, jpl 
    332             DO jk = 1, nlay_s 
    333                DO jj = 1, jpj 
    334                   DO ji = 1, jpi 
    335                      t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
    336                      e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
    337                         &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
    338                   END DO 
    339                END DO 
    340             END DO 
     331            DO_3D_11_11( 1, nlay_s ) 
     332               t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
     333               e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
     334                  &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
     335            END_3D 
    341336         END DO 
    342337         ! 
    343338         DO jl = 1, jpl 
    344             DO jk = 1, nlay_i 
    345                DO jj = 1, jpj 
    346                   DO ji = 1, jpi 
    347                      t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
    348                      ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
    349                      e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
    350                         &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
    351                         &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
    352                         &                       - rcp   * ( ztmelts - rt0 ) ) 
    353                   END DO 
    354                END DO 
    355             END DO 
     339            DO_3D_11_11( 1, nlay_i ) 
     340               t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
     341               ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
     342               e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
     343                  &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
     344                  &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
     345                  &                       - rcp   * ( ztmelts - rt0 ) ) 
     346            END_3D 
    356347         END DO 
    357348 
    … …  
    380371      IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area 
    381372         ! 
    382          sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    383          sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     373         ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rau0 
     374         ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rau0 
    384375         ! 
    385376         IF( .NOT.ln_linssh ) THEN 
    386377            ! 
    387             WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + sshn(:,:)*tmask(:,:,1) / ht_0(:,:) 
     378            WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 
    388379            ELSEWHERE                ;   z2d(:,:) = 1._wp   ;   END WHERE 
    389380            ! 
    390381            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors                 
    391                e3t_n(:,:,jk) = e3t_0(:,:,jk) * z2d(:,:) 
    392                e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    393                e3t_a(:,:,jk) = e3t_n(:,:,jk) 
     382               e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 
     383               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
     384               e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 
    394385            END DO 
    395386            ! 
    … …  
    398389            ! Horizontal scale factor interpolations 
    399390            ! -------------------------------------- 
    400             CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
    401             CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
    402             CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
    403             CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
    404             CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
     391            CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 
     392            CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 
     393            CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
     394            CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
     395            CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 
    405396            ! Vertical scale factor interpolations 
    406397            ! ------------------------------------ 
    407             CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
    408             CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
    409             CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
    410             CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
    411             CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
     398            CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  ) 
     399            CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
     400            CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
     401            CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
     402            CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 
    412403            ! t- and w- points depth 
    413404            ! ---------------------- 
    414405            !!gm not sure of that.... 
    415             gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
    416             gdepw_n(:,:,1) = 0.0_wp 
    417             gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
     406            gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
     407            gdepw(:,:,1,Kmm) = 0.0_wp 
     408            gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    418409            DO jk = 2, jpk 
    419                gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk  ) 
    420                gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 
    421                gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn (:,:) 
     410               gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk  ,Kmm) 
     411               gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 
     412               gde3w(:,:,jk) = gdept(:,:,jk  ,Kmm) - ssh (:,:,Kmm) 
    422413            END DO 
    423414         ENDIF 
    … …  
    474465      !!----------------------------------------------------------------------------- 
    475466      ! 
    476       REWIND( numnam_ice_ref )              ! Namelist namini in reference namelist : Ice initial state 
    477467      READ  ( numnam_ice_ref, namini, IOSTAT = ios, ERR = 901) 
    478468901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namini in reference namelist' ) 
    479       REWIND( numnam_ice_cfg )              ! Namelist namini in configuration namelist : Ice initial state 
    480469      READ  ( numnam_ice_cfg, namini, IOSTAT = ios, ERR = 902 ) 
    481470902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namini in configuration namelist' ) 
Note: See TracChangeset for help on using the changeset viewer.