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 12143 for NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn_rdgrft.F90 – NEMO

Ignore:
Timestamp:
2019-12-10T12:57:49+01:00 (4 years ago)
Author:
mathiot
Message:

update ENHANCE-02_ISF_nemo to 12072 (sette in progress)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/ICE/icedyn_rdgrft.F90

    r10994 r12143  
    8686      !!                ***  ROUTINE ice_dyn_rdgrft_alloc *** 
    8787      !!------------------------------------------------------------------- 
    88       ALLOCATE( closing_net(jpij), opning(jpij)   , closing_gross(jpij),   & 
    89          &      apartf(jpij,0:jpl), hrmin(jpij,jpl), hraft(jpij,jpl)    , aridge(jpij,jpl),  & 
    90          &      hrmax(jpij,jpl), hi_hrdg(jpij,jpl)  , araft (jpij,jpl),  & 
     88      ALLOCATE( closing_net(jpij)  , opning(jpij)      , closing_gross(jpij) ,               & 
     89         &      apartf(jpij,0:jpl) , hrmin  (jpij,jpl) , hraft(jpij,jpl) , aridge(jpij,jpl), & 
     90         &      hrmax (jpij,jpl)   , hi_hrdg(jpij,jpl) , araft(jpij,jpl) ,                   & 
    9191         &      ze_i_2d(jpij,nlay_i,jpl), ze_s_2d(jpij,nlay_s,jpl), STAT=ice_dyn_rdgrft_alloc ) 
    9292 
     
    137137      REAL(wp) ::   zfac                       ! local scalar 
    138138      INTEGER , DIMENSION(jpij) ::   iptidx        ! compute ridge/raft or not 
    139       REAL(wp), DIMENSION(jpij) ::   zdivu_adv     ! divu as implied by transport scheme  (1/s) 
    140139      REAL(wp), DIMENSION(jpij) ::   zdivu, zdelt  ! 1D divu_i & delta_i 
    141140      ! 
     
    145144      IF( ln_timing    )   CALL timing_start('icedyn_rdgrft')                                                             ! timing 
    146145      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     146      IF( ln_icediachk )   CALL ice_cons2D  (0, 'icedyn_rdgrft',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    147147 
    148148      IF( kt == nit000 ) THEN 
     
    174174         
    175175         ! just needed here 
    176          CALL tab_2d_1d( npti, nptidx(1:npti), zdivu   (1:npti)      , divu_i  ) 
    177176         CALL tab_2d_1d( npti, nptidx(1:npti), zdelt   (1:npti)      , delta_i ) 
    178177         ! needed here and in the iteration loop 
     178         CALL tab_2d_1d( npti, nptidx(1:npti), zdivu   (1:npti)      , divu_i) ! zdivu is used as a work array here (no change in divu_i) 
    179179         CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d  (1:npti,1:jpl), a_i   ) 
    180180         CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d  (1:npti,1:jpl), v_i   ) 
     
    186186            closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 
    187187            ! 
    188             ! divergence given by the advection scheme 
    189             !   (which may not be equal to divu as computed from the velocity field) 
    190             IF    ( ln_adv_Pra ) THEN 
    191                zdivu_adv(ji) = ( 1._wp - ato_i_1d(ji) - SUM( a_i_2d(ji,:) ) ) * r1_rdtice 
    192             ELSEIF( ln_adv_UMx ) THEN 
    193                zdivu_adv(ji) = zdivu(ji) 
    194             ENDIF 
    195             ! 
    196             IF( zdivu_adv(ji) < 0._wp )   closing_net(ji) = MAX( closing_net(ji), -zdivu_adv(ji) )   ! make sure the closing rate is large enough 
    197             !                                                                                        ! to give asum = 1.0 after ridging 
     188            IF( zdivu(ji) < 0._wp )   closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) )   ! make sure the closing rate is large enough 
     189            !                                                                                ! to give asum = 1.0 after ridging 
    198190            ! Opening rate (non-negative) that will give asum = 1.0 after ridging. 
    199             opning(ji) = closing_net(ji) + zdivu_adv(ji) 
     191            opning(ji) = closing_net(ji) + zdivu(ji) 
    200192         END DO 
    201193         ! 
     
    214206               ato_i_1d   (ipti)   = ato_i_1d   (ji) 
    215207               closing_net(ipti)   = closing_net(ji) 
    216                zdivu_adv  (ipti)   = zdivu_adv  (ji) 
     208               zdivu      (ipti)   = zdivu      (ji) 
    217209               opning     (ipti)   = opning     (ji) 
    218210            ENDIF 
     
    258250               ELSE 
    259251                  iterate_ridging  = 1 
    260                   zdivu_adv  (ji) = zfac * r1_rdtice 
    261                   closing_net(ji) = MAX( 0._wp, -zdivu_adv(ji) ) 
    262                   opning     (ji) = MAX( 0._wp,  zdivu_adv(ji) ) 
     252                  zdivu      (ji) = zfac * r1_rdtice 
     253                  closing_net(ji) = MAX( 0._wp, -zdivu(ji) ) 
     254                  opning     (ji) = MAX( 0._wp,  zdivu(ji) ) 
    263255               ENDIF 
    264256            END DO 
     
    276268 
    277269      ! controls 
     270      IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rdgrft')                                                             ! prints 
     271      IF( ln_icectl    )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn rdgrft - ')                             ! prints 
    278272      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    279       IF( ln_ctl       )   CALL ice_prt3D   ('icedyn_rdgrft')                                                             ! prints 
     273      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icedyn_rdgrft',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) ! conservation 
    280274      IF( ln_timing    )   CALL timing_stop ('icedyn_rdgrft')                                                             ! timing 
    281275      ! 
     
    306300 
    307301      !                       ! Ice thickness needed for rafting 
    308       WHERE( pa_i(1:npti,:) > epsi20 )   ;   zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 
     302      WHERE( pa_i(1:npti,:) > epsi10 )   ;   zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 
    309303      ELSEWHERE                          ;   zhi(1:npti,:) = 0._wp 
    310304      END WHERE 
     
    325319      zasum(1:npti) = pato_i(1:npti) + SUM( pa_i(1:npti,:), dim=2 ) 
    326320      ! 
    327       WHERE( zasum(1:npti) > epsi20 )   ;   z1_asum(1:npti) = 1._wp / zasum(1:npti) 
     321      WHERE( zasum(1:npti) > epsi10 )   ;   z1_asum(1:npti) = 1._wp / zasum(1:npti) 
    328322      ELSEWHERE                         ;   z1_asum(1:npti) = 0._wp 
    329323      END WHERE 
     
    451445      ! Based on the ITD of ridging and ridged ice, convert the net closing rate to a gross closing rate.   
    452446      ! NOTE: 0 < aksum <= 1 
    453       WHERE( zaksum(1:npti) > epsi20 )   ;   closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti) 
     447      WHERE( zaksum(1:npti) > epsi10 )   ;   closing_gross(1:npti) = pclosing_net(1:npti) / zaksum(1:npti) 
    454448      ELSEWHERE                          ;   closing_gross(1:npti) = 0._wp 
    455449      END WHERE 
     
    534528            IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN   ! only if ice is ridging 
    535529 
    536                IF( a_i_2d(ji,jl1) > epsi20 ) THEN   ;   z1_ai(ji) = 1._wp / a_i_2d(ji,jl1) 
     530               IF( a_i_2d(ji,jl1) > epsi10 ) THEN   ;   z1_ai(ji) = 1._wp / a_i_2d(ji,jl1) 
    537531               ELSE                                 ;   z1_ai(ji) = 0._wp 
    538532               ENDIF 
     
    592586               ! virtual salt flux to keep salinity constant 
    593587               IF( nn_icesal /= 2 )  THEN 
    594                   sirdg2(ji)     = sirdg2(ji)     - vsw * ( sss_1d(ji) - s_i_1d(ji) )        ! ridge salinity = s_i 
     588                  sirdg2(ji)     = sirdg2(ji)     - vsw * ( sss_1d(ji) - s_i_1d(ji) )       ! ridge salinity = s_i 
    595589                  sfx_bri_1d(ji) = sfx_bri_1d(ji) + sss_1d(ji) * vsw * rhoi * r1_rdtice  &  ! put back sss_m into the ocean 
    596590                     &                            - s_i_1d(ji) * vsw * rhoi * r1_rdtice     ! and get  s_i  from the ocean  
     
    916910      REWIND( numnam_ice_ref )              ! Namelist namicetdme in reference namelist : Ice mechanical ice redistribution 
    917911      READ  ( numnam_ice_ref, namdyn_rdgrft, IOSTAT = ios, ERR = 901) 
    918 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist', lwp ) 
     912901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in reference namelist' ) 
    919913      REWIND( numnam_ice_cfg )              ! Namelist namdyn_rdgrft in configuration namelist : Ice mechanical ice redistribution 
    920914      READ  ( numnam_ice_cfg, namdyn_rdgrft, IOSTAT = ios, ERR = 902 ) 
    921 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist', lwp ) 
     915902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_rdgrft in configuration namelist' ) 
    922916      IF(lwm) WRITE ( numoni, namdyn_rdgrft ) 
    923917      ! 
Note: See TracChangeset for help on using the changeset viewer.