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 8565 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90 – NEMO

Ignore:
Timestamp:
2017-09-27T12:09:10+02:00 (7 years ago)
Author:
clem
Message:

trying to respect naming convention

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icethd_do.F90

    r8564 r8565  
    222222      !------------------------------------- 
    223223      ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice 
    224       nidx = 0 ; idxice(:) = 0 
     224      npti = 0 ; nptidx(:) = 0 
    225225      DO jj = 1, jpj 
    226226         DO ji = 1, jpi 
    227227            IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN 
    228                nidx = nidx + 1 
    229                idxice( nidx ) = (jj - 1) * jpi + ji 
     228               npti = npti + 1 
     229               nptidx( npti ) = (jj - 1) * jpi + ji 
    230230            ENDIF 
    231231         END DO 
     
    237237      ! If ocean gains heat do nothing. Otherwise compute new ice formation 
    238238 
    239       IF ( nidx > 0 ) THEN 
    240  
    241          CALL tab_2d_1d( nidx, idxice(1:nidx), at_i_1d(1:nidx)      , at_i        ) 
    242          CALL tab_3d_2d( nidx, idxice(1:nidx), a_i_2d (1:nidx,1:jpl), a_i (:,:,:) ) 
    243          CALL tab_3d_2d( nidx, idxice(1:nidx), v_i_2d (1:nidx,1:jpl), v_i (:,:,:) ) 
    244          CALL tab_3d_2d( nidx, idxice(1:nidx), sv_i_2d(1:nidx,1:jpl), sv_i(:,:,:) ) 
     239      IF ( npti > 0 ) THEN 
     240 
     241         CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti)      , at_i        ) 
     242         CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i (:,:,:) ) 
     243         CALL tab_3d_2d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i (:,:,:) ) 
     244         CALL tab_3d_2d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i(:,:,:) ) 
    245245         DO jl = 1, jpl 
    246246            DO jk = 1, nlay_i 
    247                CALL tab_2d_1d( nidx, idxice(1:nidx), ze_i_2d(1:nidx,jk,jl), e_i(:,:,jk,jl) ) 
    248             END DO 
    249          END DO 
    250          CALL tab_2d_1d( nidx, idxice(1:nidx), qlead_1d  (1:nidx) , qlead       ) 
    251          CALL tab_2d_1d( nidx, idxice(1:nidx), t_bo_1d   (1:nidx) , t_bo        ) 
    252          CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_opw_1d(1:nidx) , sfx_opw     ) 
    253          CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_opw_1d(1:nidx) , wfx_opw     ) 
    254          CALL tab_2d_1d( nidx, idxice(1:nidx), zh_newice (1:nidx) , ht_i_new    ) 
    255          CALL tab_2d_1d( nidx, idxice(1:nidx), zvrel_1d  (1:nidx) , zvrel       ) 
    256  
    257          CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx) , hfx_thd     ) 
    258          CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_opw_1d(1:nidx) , hfx_opw     ) 
    259          CALL tab_2d_1d( nidx, idxice(1:nidx), rn_amax_1d(1:nidx) , rn_amax_2d  ) 
    260          CALL tab_2d_1d( nidx, idxice(1:nidx), sss_1d    (1:nidx) , sss_m       ) 
     247               CALL tab_2d_1d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) ) 
     248            END DO 
     249         END DO 
     250         CALL tab_2d_1d( npti, nptidx(1:npti), qlead_1d  (1:npti) , qlead       ) 
     251         CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d   (1:npti) , t_bo        ) 
     252         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_opw_1d(1:npti) , sfx_opw     ) 
     253         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_opw_1d(1:npti) , wfx_opw     ) 
     254         CALL tab_2d_1d( npti, nptidx(1:npti), zh_newice (1:npti) , ht_i_new    ) 
     255         CALL tab_2d_1d( npti, nptidx(1:npti), zvrel_1d  (1:npti) , zvrel       ) 
     256 
     257         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d(1:npti) , hfx_thd     ) 
     258         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d(1:npti) , hfx_opw     ) 
     259         CALL tab_2d_1d( npti, nptidx(1:npti), rn_amax_1d(1:npti) , rn_amax_2d  ) 
     260         CALL tab_2d_1d( npti, nptidx(1:npti), sss_1d    (1:npti) , sss_m       ) 
    261261 
    262262         !------------------------------------------------------------------------------| 
     
    265265         DO jl = 1, jpl 
    266266            DO jk = 1, nlay_i                
    267                WHERE( v_i_2d(1:nidx,jl) > 0._wp ) 
    268                   ze_i_2d(1:nidx,jk,jl) = ze_i_2d(1:nidx,jk,jl) / v_i_2d(1:nidx,jl) * REAL( nlay_i ) 
     267               WHERE( v_i_2d(1:npti,jl) > 0._wp ) 
     268                  ze_i_2d(1:npti,jk,jl) = ze_i_2d(1:npti,jk,jl) / v_i_2d(1:npti,jl) * REAL( nlay_i ) 
    269269               ELSEWHERE 
    270                   ze_i_2d(1:nidx,jk,jl) = 0._wp 
     270                  ze_i_2d(1:npti,jk,jl) = 0._wp 
    271271               END WHERE 
    272272            END DO 
     
    279279         ! Keep old ice areas and volume in memory 
    280280         !----------------------------------------- 
    281          zv_b(1:nidx,:) = v_i_2d(1:nidx,:)  
    282          za_b(1:nidx,:) = a_i_2d(1:nidx,:) 
     281         zv_b(1:npti,:) = v_i_2d(1:npti,:)  
     282         za_b(1:npti,:) = a_i_2d(1:npti,:) 
    283283 
    284284         !---------------------- 
     
    287287         SELECT CASE ( nn_icesal ) 
    288288         CASE ( 1 )                    ! Sice = constant  
    289             zs_newice(1:nidx) = rn_icesal 
     289            zs_newice(1:npti) = rn_icesal 
    290290         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
    291             DO ji = 1, nidx 
     291            DO ji = 1, npti 
    292292               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_1d(ji) ) 
    293293            END DO 
    294294         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
    295             zs_newice(1:nidx) =   2.3 
     295            zs_newice(1:npti) =   2.3 
    296296         END SELECT 
    297297 
     
    300300         !------------------------- 
    301301         ! We assume that new ice is formed at the seawater freezing point 
    302          DO ji = 1, nidx 
     302         DO ji = 1, npti 
    303303            ztmelts       = - tmut * zs_newice(ji)                  ! Melting point (C) 
    304304            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - ( t_bo_1d(ji) - rt0 ) )                     & 
     
    310310         ! Age of new ice 
    311311         !---------------- 
    312          zo_newice(1:nidx) = 0._wp 
     312         zo_newice(1:npti) = 0._wp 
    313313 
    314314         !------------------- 
    315315         ! Volume of new ice 
    316316         !------------------- 
    317          DO ji = 1, nidx 
     317         DO ji = 1, npti 
    318318 
    319319            zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg] 
     
    340340         END DO 
    341341          
    342          zv_frazb(1:nidx) = 0._wp 
     342         zv_frazb(1:npti) = 0._wp 
    343343         IF( ln_frazil ) THEN 
    344344            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    345             DO ji = 1, nidx 
     345            DO ji = 1, npti 
    346346               rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - at_i_1d(ji) ) ) 
    347347               zfrazb        = rswitch * ( TANH( rn_Cfraz * ( zvrel_1d(ji) - rn_vfraz ) ) + 1.0 ) * 0.5 * rn_maxfraz 
     
    354354         ! Area of new ice 
    355355         !----------------- 
    356          DO ji = 1, nidx 
     356         DO ji = 1, npti 
    357357            za_newice(ji) = zv_newice(ji) / zh_newice(ji) 
    358358         END DO 
     
    367367         ! If lateral ice growth gives an ice concentration gt 1, then 
    368368         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
    369          DO ji = 1, nidx 
     369         DO ji = 1, npti 
    370370            IF ( za_newice(ji) >  ( rn_amax_1d(ji) - at_i_1d(ji) ) ) THEN 
    371371               zda_res(ji)   = za_newice(ji) - ( rn_amax_1d(ji) - at_i_1d(ji) ) 
     
    381381         ! find which category to fill 
    382382         DO jl = 1, jpl 
    383             DO ji = 1, nidx 
     383            DO ji = 1, npti 
    384384               IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN 
    385385                  a_i_2d(ji,jl) = a_i_2d(ji,jl) + za_newice(ji) 
     
    389389            END DO 
    390390         END DO 
    391          at_i_1d(1:nidx) = SUM( a_i_2d(1:nidx,:), dim=2 ) 
     391         at_i_1d(1:npti) = SUM( a_i_2d(1:npti,:), dim=2 ) 
    392392 
    393393         ! Heat content 
    394          DO ji = 1, nidx 
     394         DO ji = 1, npti 
    395395            jl = jcat(ji)                                                    ! categroy in which new ice is put 
    396396            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice 
     
    398398 
    399399         DO jk = 1, nlay_i 
    400             DO ji = 1, nidx 
     400            DO ji = 1, npti 
    401401               jl = jcat(ji) 
    402402               rswitch = MAX( 0._wp, SIGN( 1._wp , v_i_2d(ji,jl) - epsi20 ) ) 
     
    413413 
    414414            ! for remapping 
    415             h_i_old (1:nidx,0:nlay_i+1) = 0._wp 
    416             eh_i_old(1:nidx,0:nlay_i+1) = 0._wp 
     415            h_i_old (1:npti,0:nlay_i+1) = 0._wp 
     416            eh_i_old(1:npti,0:nlay_i+1) = 0._wp 
    417417            DO jk = 1, nlay_i 
    418                DO ji = 1, nidx 
     418               DO ji = 1, npti 
    419419                  h_i_old (ji,jk) = v_i_2d(ji,jl) * r1_nlay_i 
    420420                  eh_i_old(ji,jk) = ze_i_2d(ji,jk,jl) * h_i_old(ji,jk) 
     
    423423 
    424424            ! new volumes including lateral/bottom accretion + residual 
    425             DO ji = 1, nidx 
     425            DO ji = 1, npti 
    426426               rswitch        = MAX( 0._wp, SIGN( 1._wp , at_i_1d(ji) - epsi20 ) ) 
    427427               zv_newfra     = rswitch * ( zdv_res(ji) + zv_frazb(ji) ) * a_i_2d(ji,jl) / MAX( at_i_1d(ji) , epsi20 ) 
     
    433433            ENDDO 
    434434            ! --- Ice enthalpy remapping --- ! 
    435             CALL ice_thd_ent( ze_i_2d(1:nidx,:,jl) )  
     435            CALL ice_thd_ent( ze_i_2d(1:npti,:,jl) )  
    436436         ENDDO 
    437437 
     
    440440         !----------------- 
    441441         DO jl = 1, jpl 
    442             DO ji = 1, nidx 
     442            DO ji = 1, npti 
    443443               sv_i_2d(ji,jl) = sv_i_2d(ji,jl) + zs_newice(ji) * ( v_i_2d(ji,jl) - zv_b(ji,jl) ) 
    444444            END DO 
     
    450450         DO jl = 1, jpl 
    451451            DO jk = 1, nlay_i 
    452                ze_i_2d(1:nidx,jk,jl) = ze_i_2d(1:nidx,jk,jl) * v_i_2d(1:nidx,jl) * r1_nlay_i  
     452               ze_i_2d(1:npti,jk,jl) = ze_i_2d(1:npti,jk,jl) * v_i_2d(1:npti,jl) * r1_nlay_i  
    453453            END DO 
    454454         END DO 
     
    456456         ! 7) Change 2D vectors to 1D vectors  
    457457         !------------------------------------------------------------------------------! 
    458          CALL tab_2d_3d( nidx, idxice(1:nidx), a_i_2d (1:nidx,1:jpl), a_i (:,:,:) ) 
    459          CALL tab_2d_3d( nidx, idxice(1:nidx), v_i_2d (1:nidx,1:jpl), v_i (:,:,:) ) 
    460          CALL tab_2d_3d( nidx, idxice(1:nidx), sv_i_2d(1:nidx,1:jpl), sv_i(:,:,:) ) 
     458         CALL tab_2d_3d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i (:,:,:) ) 
     459         CALL tab_2d_3d( npti, nptidx(1:npti), v_i_2d (1:npti,1:jpl), v_i (:,:,:) ) 
     460         CALL tab_2d_3d( npti, nptidx(1:npti), sv_i_2d(1:npti,1:jpl), sv_i(:,:,:) ) 
    461461          DO jl = 1, jpl 
    462462            DO jk = 1, nlay_i 
    463                CALL tab_1d_2d( nidx, idxice(1:nidx), ze_i_2d(1:nidx,jk,jl), e_i(:,:,jk,jl) ) 
    464             END DO 
    465          END DO 
    466          CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_opw_1d(1:nidx), sfx_opw ) 
    467          CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_opw_1d(1:nidx), wfx_opw ) 
    468          CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx), hfx_thd ) 
    469          CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_opw_1d(1:nidx), hfx_opw ) 
     463               CALL tab_1d_2d( npti, nptidx(1:npti), ze_i_2d(1:npti,jk,jl), e_i(:,:,jk,jl) ) 
     464            END DO 
     465         END DO 
     466         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_opw_1d(1:npti), sfx_opw ) 
     467         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_opw_1d(1:npti), wfx_opw ) 
     468         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d(1:npti), hfx_thd ) 
     469         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_opw_1d(1:npti), hfx_opw ) 
    470470         ! 
    471       ENDIF ! nidx > 0 
     471      ENDIF ! npti > 0 
    472472      ! 
    473473      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icethd_do', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
Note: See TracChangeset for help on using the changeset viewer.