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 8327 for branches/2017 – NEMO

Changeset 8327 for branches/2017


Ignore:
Timestamp:
2017-07-13T11:29:29+02:00 (7 years ago)
Author:
clem
Message:

STEP4 (3): put all thermodynamics in 1D (limthd_da OK)

Location:
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
Files:
5 edited

Legend:

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

    r8326 r8327  
    8383      ! 
    8484      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    85       INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations 
     85      INTEGER  :: nidx             ! nb of icy pts for vertical thermo calculations 
    8686      REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg 
    8787      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     
    213213 
    214214         ! select ice covered grid points 
    215          nbpb = 0 
    216          DO jj = 1, jpj 
    217             DO ji = 1, jpi 
     215         nidx = 0 ; idxice(:) = 0 
     216         DO jj = 2, jpjm1 
     217            DO ji = 2, jpim1 
    218218               IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
    219                   nbpb      = nbpb  + 1 
    220                   npb(nbpb) = (jj - 1) * jpi + ji 
     219                  nidx         = nidx  + 1 
     220                  idxice(nidx) = (jj - 1) * jpi + ji 
    221221               ENDIF 
    222222            END DO 
     
    234234         ENDIF 
    235235 
    236          IF( lk_mpp )         CALL mpp_ini_ice( nbpb , numout ) 
    237  
    238          IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing. 
     236         IF( lk_mpp )         CALL mpp_ini_ice( nidx , numout ) 
     237 
     238         IF( nidx > 0 ) THEN  ! If there is no ice, do nothing. 
    239239            !                                                                 
    240240            s_i_new   (:) = 0._wp ; dh_s_tot (:) = 0._wp                     ! --- some init --- ! 
     
    242242            dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp 
    243243 
    244                               CALL lim_thd_1d2d( nbpb, jl, 1 )               ! --- Move to 1D arrays --- ! 
     244                              CALL lim_thd_1d2d( nidx, jl, 1 )               ! --- Move to 1D arrays --- ! 
    245245            ! 
    246246            DO jk = 1, nlay_i                                                ! --- Change units from J/m2 to J/m3 --- ! 
     
    251251            ENDDO 
    252252            ! 
    253             IF( ln_limdH )    CALL lim_thd_dif( 1, nbpb )                    ! --- Ice/Snow Temperature profile --- ! 
    254             ! 
    255             IF( ln_limdH )    CALL lim_thd_dh( 1, nbpb )                     ! --- Ice/Snow thickness --- !     
    256             ! 
    257             IF( ln_limdH )    CALL lim_thd_ent( 1, nbpb, e_i_1d(1:nbpb,:) )  ! --- Ice enthalpy remapping --- ! 
    258             ! 
    259                               CALL lim_thd_sal( 1, nbpb )                    ! --- Ice salinity --- !     
    260             ! 
    261                               CALL lim_thd_temp( 1, nbpb )                   ! --- temperature update --- ! 
     253            IF( ln_limdH )    CALL lim_thd_dif( 1, nidx )                    ! --- Ice/Snow Temperature profile --- ! 
     254            ! 
     255            IF( ln_limdH )    CALL lim_thd_dh( 1, nidx )                     ! --- Ice/Snow thickness --- !     
     256            ! 
     257            IF( ln_limdH )    CALL lim_thd_ent( 1, nidx, e_i_1d(1:nidx,:) )  ! --- Ice enthalpy remapping --- ! 
     258            ! 
     259                              CALL lim_thd_sal( 1, nidx )                    ! --- Ice salinity --- !     
     260            ! 
     261                              CALL lim_thd_temp( 1, nidx )                   ! --- temperature update --- ! 
    262262            ! 
    263263            IF( ln_limdH ) THEN 
    264264               IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
    265                               CALL lim_thd_lam( 1, nbpb )                    ! --- extra lateral melting if monocat --- ! 
     265                              CALL lim_thd_lam( 1, nidx )                    ! --- extra lateral melting if monocat --- ! 
    266266               END IF 
    267267            END IF 
     
    274274            ENDDO 
    275275            ! 
    276                               CALL lim_thd_1d2d( nbpb, jl, 2 )               ! --- Move to 2D arrays --- ! 
     276                              CALL lim_thd_1d2d( nidx, jl, 2 )               ! --- Move to 2D arrays --- ! 
    277277            ! 
    278278            IF( lk_mpp )      CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
     
    282282 
    283283      IF( ln_limdA)           CALL lim_thd_da                                ! --- lateral melting --- ! 
     284 
     285      at_i(:,:)    = SUM( a_i(:,:,:), dim=3 ) 
    284286 
    285287      ! Change thickness to volume 
     
    404406 
    405407 
    406    SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) 
     408   SUBROUTINE lim_thd_1d2d( nidx, jl, kn ) 
    407409      !!----------------------------------------------------------------------- 
    408410      !!                   ***  ROUTINE lim_thd_1d2d ***  
     
    411413      !!----------------------------------------------------------------------- 
    412414      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D   ;   2= from 1D to 2D 
    413       INTEGER, INTENT(in) ::   nbpb     ! size of 1D arrays 
     415      INTEGER, INTENT(in) ::   nidx     ! size of 1D arrays 
    414416      INTEGER, INTENT(in) ::   jl       ! ice cat 
    415417      ! 
     
    421423      CASE( 1 )            ! from 2D to 1D 
    422424         ! 
    423          CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
    424          CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
    425          CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    426          CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    427          ! 
    428          CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    429          CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     425         CALL tab_2d_1d( nidx, at_i_1d     (1:nidx), at_i            , jpi, jpj, idxice(1:nidx) ) 
     426         CALL tab_2d_1d( nidx, a_i_1d      (1:nidx), a_i(:,:,jl)     , jpi, jpj, idxice(1:nidx) ) 
     427         CALL tab_2d_1d( nidx, ht_i_1d     (1:nidx), ht_i(:,:,jl)    , jpi, jpj, idxice(1:nidx) ) 
     428         CALL tab_2d_1d( nidx, ht_s_1d     (1:nidx), ht_s(:,:,jl)    , jpi, jpj, idxice(1:nidx) ) 
     429         ! 
     430         CALL tab_2d_1d( nidx, t_su_1d     (1:nidx), t_su(:,:,jl)    , jpi, jpj, idxice(1:nidx) ) 
     431         CALL tab_2d_1d( nidx, sm_i_1d     (1:nidx), sm_i(:,:,jl)    , jpi, jpj, idxice(1:nidx) ) 
    430432         DO jk = 1, nlay_s 
    431             CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    432             CALL tab_2d_1d( nbpb, e_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     433            CALL tab_2d_1d( nidx, t_s_1d(1:nidx,jk), t_s(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
     434            CALL tab_2d_1d( nidx, e_s_1d(1:nidx,jk), e_s(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
    433435         END DO 
    434436         DO jk = 1, nlay_i 
    435             CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    436             CALL tab_2d_1d( nbpb, e_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    437             CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    438          END DO 
    439          ! 
    440          CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 
    441          CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    442          CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    443          CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
    444          CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
    445          CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    446          CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    447          CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    448          CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    449          CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
    450          CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
    451          CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) ) 
    452          CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
    453          CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
    454          ! 
    455          CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
    456          CALL tab_2d_1d( nbpb, wfx_snw_sum_1d(1:nbpb), wfx_snw_sum  , jpi, jpj, npb(1:nbpb) ) 
    457          CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
    458          CALL tab_2d_1d( nbpb, wfx_snw_sub_1d(1:nbpb), wfx_snw_sub  , jpi, jpj, npb(1:nbpb) ) 
    459          CALL tab_2d_1d( nbpb, wfx_ice_sub_1d(1:nbpb), wfx_ice_sub  , jpi, jpj, npb(1:nbpb) ) 
    460          CALL tab_2d_1d( nbpb, wfx_err_sub_1d(1:nbpb), wfx_err_sub  , jpi, jpj, npb(1:nbpb) ) 
    461          ! 
    462          CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    463          CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
    464          CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) ) 
    465          CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) ) 
    466          CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
    467          CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
    468          ! 
    469          CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    470          CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
    471          CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) ) 
    472          CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) ) 
    473          CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    474          CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
    475          CALL tab_2d_1d( nbpb, sfx_sub_1d (1:nbpb), sfx_sub         , jpi, jpj,npb(1:nbpb) ) 
    476          ! 
    477          CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
    478          CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
    479          CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) ) 
    480          CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) ) 
    481          CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) ) 
    482          CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) ) 
    483          CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) ) 
    484          CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) ) 
    485          CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) ) 
    486          CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
    487          CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
    488          CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 
    489          CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
    490          CALL tab_2d_1d( nbpb, hfx_out_1d (1:nbpb), hfx_out         , jpi, jpj, npb(1:nbpb) ) 
     437            CALL tab_2d_1d( nidx, t_i_1d(1:nidx,jk), t_i(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
     438            CALL tab_2d_1d( nidx, e_i_1d(1:nidx,jk), e_i(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
     439            CALL tab_2d_1d( nidx, s_i_1d(1:nidx,jk), s_i(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
     440         END DO 
     441         ! 
     442         CALL tab_2d_1d( nidx, qprec_ice_1d(1:nidx), qprec_ice(:,:) , jpi, jpj, idxice(1:nidx) ) 
     443         CALL tab_2d_1d( nidx, qevap_ice_1d(1:nidx), qevap_ice(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
     444         CALL tab_2d_1d( nidx, qsr_ice_1d (1:nidx), qsr_ice(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
     445         CALL tab_2d_1d( nidx, fr1_i0_1d  (1:nidx), fr1_i0          , jpi, jpj, idxice(1:nidx) ) 
     446         CALL tab_2d_1d( nidx, fr2_i0_1d  (1:nidx), fr2_i0          , jpi, jpj, idxice(1:nidx) ) 
     447         CALL tab_2d_1d( nidx, qns_ice_1d (1:nidx), qns_ice(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
     448         CALL tab_2d_1d( nidx, ftr_ice_1d (1:nidx), ftr_ice(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
     449         CALL tab_2d_1d( nidx, evap_ice_1d (1:nidx), evap_ice(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
     450         CALL tab_2d_1d( nidx, dqns_ice_1d(1:nidx), dqns_ice(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
     451         CALL tab_2d_1d( nidx, t_bo_1d     (1:nidx), t_bo            , jpi, jpj, idxice(1:nidx) ) 
     452         CALL tab_2d_1d( nidx, sprecip_1d (1:nidx), sprecip         , jpi, jpj, idxice(1:nidx) )  
     453         CALL tab_2d_1d( nidx, fhtur_1d   (1:nidx), fhtur           , jpi, jpj, idxice(1:nidx) ) 
     454         CALL tab_2d_1d( nidx, fhld_1d    (1:nidx), fhld            , jpi, jpj, idxice(1:nidx) ) 
     455         ! 
     456         CALL tab_2d_1d( nidx, wfx_snw_1d (1:nidx), wfx_snw         , jpi, jpj, idxice(1:nidx) ) 
     457         CALL tab_2d_1d( nidx, wfx_snw_sum_1d(1:nidx), wfx_snw_sum  , jpi, jpj, idxice(1:nidx) ) 
     458         CALL tab_2d_1d( nidx, wfx_sub_1d (1:nidx), wfx_sub         , jpi, jpj, idxice(1:nidx) ) 
     459         CALL tab_2d_1d( nidx, wfx_snw_sub_1d(1:nidx), wfx_snw_sub  , jpi, jpj, idxice(1:nidx) ) 
     460         CALL tab_2d_1d( nidx, wfx_ice_sub_1d(1:nidx), wfx_ice_sub  , jpi, jpj, idxice(1:nidx) ) 
     461         CALL tab_2d_1d( nidx, wfx_err_sub_1d(1:nidx), wfx_err_sub  , jpi, jpj, idxice(1:nidx) ) 
     462         ! 
     463         CALL tab_2d_1d( nidx, wfx_bog_1d (1:nidx), wfx_bog         , jpi, jpj, idxice(1:nidx) ) 
     464         CALL tab_2d_1d( nidx, wfx_bom_1d (1:nidx), wfx_bom         , jpi, jpj, idxice(1:nidx) ) 
     465         CALL tab_2d_1d( nidx, wfx_sum_1d (1:nidx), wfx_sum         , jpi, jpj, idxice(1:nidx) ) 
     466         CALL tab_2d_1d( nidx, wfx_sni_1d (1:nidx), wfx_sni         , jpi, jpj, idxice(1:nidx) ) 
     467         CALL tab_2d_1d( nidx, wfx_res_1d (1:nidx), wfx_res         , jpi, jpj, idxice(1:nidx) ) 
     468         CALL tab_2d_1d( nidx, wfx_spr_1d (1:nidx), wfx_spr         , jpi, jpj, idxice(1:nidx) ) 
     469         ! 
     470         CALL tab_2d_1d( nidx, sfx_bog_1d (1:nidx), sfx_bog         , jpi, jpj, idxice(1:nidx) ) 
     471         CALL tab_2d_1d( nidx, sfx_bom_1d (1:nidx), sfx_bom         , jpi, jpj, idxice(1:nidx) ) 
     472         CALL tab_2d_1d( nidx, sfx_sum_1d (1:nidx), sfx_sum         , jpi, jpj, idxice(1:nidx) ) 
     473         CALL tab_2d_1d( nidx, sfx_sni_1d (1:nidx), sfx_sni         , jpi, jpj, idxice(1:nidx) ) 
     474         CALL tab_2d_1d( nidx, sfx_bri_1d (1:nidx), sfx_bri         , jpi, jpj, idxice(1:nidx) ) 
     475         CALL tab_2d_1d( nidx, sfx_res_1d (1:nidx), sfx_res         , jpi, jpj, idxice(1:nidx) ) 
     476         CALL tab_2d_1d( nidx, sfx_sub_1d (1:nidx), sfx_sub         , jpi, jpj,idxice(1:nidx) ) 
     477         ! 
     478         CALL tab_2d_1d( nidx, hfx_thd_1d (1:nidx), hfx_thd         , jpi, jpj, idxice(1:nidx) ) 
     479         CALL tab_2d_1d( nidx, hfx_spr_1d (1:nidx), hfx_spr         , jpi, jpj, idxice(1:nidx) ) 
     480         CALL tab_2d_1d( nidx, hfx_sum_1d (1:nidx), hfx_sum         , jpi, jpj, idxice(1:nidx) ) 
     481         CALL tab_2d_1d( nidx, hfx_bom_1d (1:nidx), hfx_bom         , jpi, jpj, idxice(1:nidx) ) 
     482         CALL tab_2d_1d( nidx, hfx_bog_1d (1:nidx), hfx_bog         , jpi, jpj, idxice(1:nidx) ) 
     483         CALL tab_2d_1d( nidx, hfx_dif_1d (1:nidx), hfx_dif         , jpi, jpj, idxice(1:nidx) ) 
     484         CALL tab_2d_1d( nidx, hfx_opw_1d (1:nidx), hfx_opw         , jpi, jpj, idxice(1:nidx) ) 
     485         CALL tab_2d_1d( nidx, hfx_snw_1d (1:nidx), hfx_snw         , jpi, jpj, idxice(1:nidx) ) 
     486         CALL tab_2d_1d( nidx, hfx_sub_1d (1:nidx), hfx_sub         , jpi, jpj, idxice(1:nidx) ) 
     487         CALL tab_2d_1d( nidx, hfx_err_1d (1:nidx), hfx_err         , jpi, jpj, idxice(1:nidx) ) 
     488         CALL tab_2d_1d( nidx, hfx_res_1d (1:nidx), hfx_res         , jpi, jpj, idxice(1:nidx) ) 
     489         CALL tab_2d_1d( nidx, hfx_err_dif_1d (1:nidx), hfx_err_dif , jpi, jpj, idxice(1:nidx) ) 
     490         CALL tab_2d_1d( nidx, hfx_err_rem_1d (1:nidx), hfx_err_rem , jpi, jpj, idxice(1:nidx) ) 
     491         CALL tab_2d_1d( nidx, hfx_out_1d (1:nidx), hfx_out         , jpi, jpj, idxice(1:nidx) ) 
    491492         ! 
    492493         ! SIMIP diagnostics 
    493          CALL tab_2d_1d( nbpb, diag_fc_bo_1d   (1:nbpb), diag_fc_bo  , jpi, jpj, npb(1:nbpb) ) 
    494          CALL tab_2d_1d( nbpb, diag_fc_su_1d   (1:nbpb), diag_fc_su  , jpi, jpj, npb(1:nbpb) ) 
     494         CALL tab_2d_1d( nidx, diag_fc_bo_1d   (1:nidx), diag_fc_bo  , jpi, jpj, idxice(1:nidx) ) 
     495         CALL tab_2d_1d( nidx, diag_fc_su_1d   (1:nidx), diag_fc_su  , jpi, jpj, idxice(1:nidx) ) 
    495496         ! ocean surface fields 
    496          CALL tab_2d_1d( nbpb, sst_1d(1:nbpb), sst_m, jpi, jpj, npb(1:nbpb) ) 
    497          CALL tab_2d_1d( nbpb, sss_1d(1:nbpb), sss_m, jpi, jpj, npb(1:nbpb) ) 
     497         CALL tab_2d_1d( nidx, sst_1d(1:nidx), sst_m, jpi, jpj, idxice(1:nidx) ) 
     498         CALL tab_2d_1d( nidx, sss_1d(1:nidx), sss_m, jpi, jpj, idxice(1:nidx) ) 
    498499         ! 
    499500      CASE( 2 )            ! from 1D to 2D 
    500501         ! 
    501          CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj ) 
    502          CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj ) 
    503          CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj ) 
    504          CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj ) 
    505          CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj ) 
    506          CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj ) 
     502         CALL tab_1d_2d( nidx, at_i          , idxice, at_i_1d    (1:nidx)   , jpi, jpj ) 
     503         CALL tab_1d_2d( nidx, ht_i(:,:,jl)  , idxice, ht_i_1d    (1:nidx)   , jpi, jpj ) 
     504         CALL tab_1d_2d( nidx, ht_s(:,:,jl)  , idxice, ht_s_1d    (1:nidx)   , jpi, jpj ) 
     505         CALL tab_1d_2d( nidx, a_i (:,:,jl)  , idxice, a_i_1d     (1:nidx)   , jpi, jpj ) 
     506         CALL tab_1d_2d( nidx, t_su(:,:,jl)  , idxice, t_su_1d    (1:nidx)   , jpi, jpj ) 
     507         CALL tab_1d_2d( nidx, sm_i(:,:,jl)  , idxice, sm_i_1d    (1:nidx)   , jpi, jpj ) 
    507508         DO jk = 1, nlay_s 
    508             CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj) 
    509             CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, e_s_1d     (1:nbpb,jk), jpi, jpj) 
     509            CALL tab_1d_2d( nidx, t_s(:,:,jk,jl), idxice, t_s_1d     (1:nidx,jk), jpi, jpj) 
     510            CALL tab_1d_2d( nidx, e_s(:,:,jk,jl), idxice, e_s_1d     (1:nidx,jk), jpi, jpj) 
    510511         END DO 
    511512         DO jk = 1, nlay_i 
    512             CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj) 
    513             CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, e_i_1d     (1:nbpb,jk), jpi, jpj) 
    514             CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj) 
    515          END DO 
    516          CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
    517          ! 
    518          CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
    519          CALL tab_1d_2d( nbpb, wfx_snw_sum   , npb, wfx_snw_sum_1d(1:nbpb),jpi, jpj ) 
    520          CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
    521          CALL tab_1d_2d( nbpb, wfx_snw_sub   , npb, wfx_snw_sub_1d(1:nbpb), jpi, jpj ) 
    522          CALL tab_1d_2d( nbpb, wfx_ice_sub   , npb, wfx_ice_sub_1d(1:nbpb), jpi, jpj ) 
    523          CALL tab_1d_2d( nbpb, wfx_err_sub   , npb, wfx_err_sub_1d(1:nbpb), jpi, jpj ) 
    524          ! 
    525          CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    526          CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
    527          CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj ) 
    528          CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj ) 
    529          CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
    530          CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
    531          ! 
    532          CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    533          CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
    534          CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj ) 
    535          CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj ) 
    536          CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
    537          CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    538          CALL tab_1d_2d( nbpb, sfx_sub       , npb, sfx_sub_1d(1:nbpb)   , jpi, jpj )         
    539          ! 
    540          CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
    541          CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
    542          CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj ) 
    543          CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj ) 
    544          CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj ) 
    545          CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj ) 
    546          CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj ) 
    547          CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj ) 
    548          CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj ) 
    549          CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj ) 
    550          CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
    551          CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 
    552          CALL tab_1d_2d( nbpb, hfx_err_dif   , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj ) 
    553          CALL tab_1d_2d( nbpb, hfx_out       , npb, hfx_out_1d(1:nbpb)   , jpi, jpj ) 
    554          ! 
    555          CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
    556          CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
     513            CALL tab_1d_2d( nidx, t_i(:,:,jk,jl), idxice, t_i_1d     (1:nidx,jk), jpi, jpj) 
     514            CALL tab_1d_2d( nidx, e_i(:,:,jk,jl), idxice, e_i_1d     (1:nidx,jk), jpi, jpj) 
     515            CALL tab_1d_2d( nidx, s_i(:,:,jk,jl), idxice, s_i_1d     (1:nidx,jk), jpi, jpj) 
     516         END DO 
     517         ! 
     518         CALL tab_1d_2d( nidx, wfx_snw       , idxice, wfx_snw_1d(1:nidx)   , jpi, jpj ) 
     519         CALL tab_1d_2d( nidx, wfx_snw_sum   , idxice, wfx_snw_sum_1d(1:nidx),jpi, jpj ) 
     520         CALL tab_1d_2d( nidx, wfx_sub       , idxice, wfx_sub_1d(1:nidx)   , jpi, jpj ) 
     521         CALL tab_1d_2d( nidx, wfx_snw_sub   , idxice, wfx_snw_sub_1d(1:nidx), jpi, jpj ) 
     522         CALL tab_1d_2d( nidx, wfx_ice_sub   , idxice, wfx_ice_sub_1d(1:nidx), jpi, jpj ) 
     523         CALL tab_1d_2d( nidx, wfx_err_sub   , idxice, wfx_err_sub_1d(1:nidx), jpi, jpj ) 
     524         ! 
     525         CALL tab_1d_2d( nidx, wfx_bog       , idxice, wfx_bog_1d(1:nidx)   , jpi, jpj ) 
     526         CALL tab_1d_2d( nidx, wfx_bom       , idxice, wfx_bom_1d(1:nidx)   , jpi, jpj ) 
     527         CALL tab_1d_2d( nidx, wfx_sum       , idxice, wfx_sum_1d(1:nidx)   , jpi, jpj ) 
     528         CALL tab_1d_2d( nidx, wfx_sni       , idxice, wfx_sni_1d(1:nidx)   , jpi, jpj ) 
     529         CALL tab_1d_2d( nidx, wfx_res       , idxice, wfx_res_1d(1:nidx)   , jpi, jpj ) 
     530         CALL tab_1d_2d( nidx, wfx_spr       , idxice, wfx_spr_1d(1:nidx)   , jpi, jpj ) 
     531         ! 
     532         CALL tab_1d_2d( nidx, sfx_bog       , idxice, sfx_bog_1d(1:nidx)   , jpi, jpj ) 
     533         CALL tab_1d_2d( nidx, sfx_bom       , idxice, sfx_bom_1d(1:nidx)   , jpi, jpj ) 
     534         CALL tab_1d_2d( nidx, sfx_sum       , idxice, sfx_sum_1d(1:nidx)   , jpi, jpj ) 
     535         CALL tab_1d_2d( nidx, sfx_sni       , idxice, sfx_sni_1d(1:nidx)   , jpi, jpj ) 
     536         CALL tab_1d_2d( nidx, sfx_res       , idxice, sfx_res_1d(1:nidx)   , jpi, jpj ) 
     537         CALL tab_1d_2d( nidx, sfx_bri       , idxice, sfx_bri_1d(1:nidx)   , jpi, jpj ) 
     538         CALL tab_1d_2d( nidx, sfx_sub       , idxice, sfx_sub_1d(1:nidx)   , jpi, jpj )         
     539         ! 
     540         CALL tab_1d_2d( nidx, hfx_thd       , idxice, hfx_thd_1d(1:nidx)   , jpi, jpj ) 
     541         CALL tab_1d_2d( nidx, hfx_spr       , idxice, hfx_spr_1d(1:nidx)   , jpi, jpj ) 
     542         CALL tab_1d_2d( nidx, hfx_sum       , idxice, hfx_sum_1d(1:nidx)   , jpi, jpj ) 
     543         CALL tab_1d_2d( nidx, hfx_bom       , idxice, hfx_bom_1d(1:nidx)   , jpi, jpj ) 
     544         CALL tab_1d_2d( nidx, hfx_bog       , idxice, hfx_bog_1d(1:nidx)   , jpi, jpj ) 
     545         CALL tab_1d_2d( nidx, hfx_dif       , idxice, hfx_dif_1d(1:nidx)   , jpi, jpj ) 
     546         CALL tab_1d_2d( nidx, hfx_opw       , idxice, hfx_opw_1d(1:nidx)   , jpi, jpj ) 
     547         CALL tab_1d_2d( nidx, hfx_snw       , idxice, hfx_snw_1d(1:nidx)   , jpi, jpj ) 
     548         CALL tab_1d_2d( nidx, hfx_sub       , idxice, hfx_sub_1d(1:nidx)   , jpi, jpj ) 
     549         CALL tab_1d_2d( nidx, hfx_err       , idxice, hfx_err_1d(1:nidx)   , jpi, jpj ) 
     550         CALL tab_1d_2d( nidx, hfx_res       , idxice, hfx_res_1d(1:nidx)   , jpi, jpj ) 
     551         CALL tab_1d_2d( nidx, hfx_err_rem   , idxice, hfx_err_rem_1d(1:nidx), jpi, jpj ) 
     552         CALL tab_1d_2d( nidx, hfx_err_dif   , idxice, hfx_err_dif_1d(1:nidx), jpi, jpj ) 
     553         CALL tab_1d_2d( nidx, hfx_out       , idxice, hfx_out_1d(1:nidx)   , jpi, jpj ) 
     554         ! 
     555         CALL tab_1d_2d( nidx, qns_ice(:,:,jl), idxice, qns_ice_1d(1:nidx) , jpi, jpj) 
     556         CALL tab_1d_2d( nidx, ftr_ice(:,:,jl), idxice, ftr_ice_1d(1:nidx) , jpi, jpj ) 
    557557         ! 
    558558         ! SIMIP diagnostics          
    559          CALL tab_1d_2d( nbpb, t_si(:,:,jl)   , npb, t_si_1d    (1:nbpb)     , jpi, jpj ) 
    560          CALL tab_1d_2d( nbpb, diag_fc_bo     , npb, diag_fc_bo_1d(1:nbpb)   , jpi, jpj ) 
    561          CALL tab_1d_2d( nbpb, diag_fc_su     , npb, diag_fc_su_1d(1:nbpb)   , jpi, jpj ) 
     559         CALL tab_1d_2d( nidx, t_si(:,:,jl)   , idxice, t_si_1d    (1:nidx)     , jpi, jpj ) 
     560         CALL tab_1d_2d( nidx, diag_fc_bo     , idxice, diag_fc_bo_1d(1:nidx)   , jpi, jpj ) 
     561         CALL tab_1d_2d( nidx, diag_fc_su     , idxice, diag_fc_su_1d(1:nidx)   , jpi, jpj ) 
    562562      END SELECT 
    563563      ! 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90

    r8325 r8327  
    1212   !!   lim_thd_da   : sea ice lateral melting 
    1313   !!---------------------------------------------------------------------- 
    14    USE par_oce                ! ocean parameters 
    15    USE phycst                 ! physical constants (ocean directory) 
    16    USE sbc_oce, ONLY: sst_m   ! Surface boundary condition: ocean fields 
    17    USE ice                    ! LIM variables 
    18    USE lib_mpp                ! MPP library 
    19    USE wrk_nemo               ! work arrays 
    20    USE lib_fortran            ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     14   USE par_oce        ! ocean parameters 
     15   USE phycst         ! physical constants (ocean directory) 
     16   USE sbc_oce , ONLY : sst_m 
     17   USE ice            ! LIM variables 
     18   USE thd_ice        ! thermodynamic sea-ice variables 
     19   USE limtab         ! 1D <==> 2D transformation 
     20   ! 
     21   USE lib_mpp        ! MPP library 
     22   USE wrk_nemo       ! work arrays 
     23   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2124 
    2225   IMPLICIT NONE 
     
    97100      !!              Phil. Trans. R. Soc. A, 373(2052), 20140167. 
    98101      !!--------------------------------------------------------------------- 
    99       INTEGER             ::   ji, jj, jl      ! dummy loop indices 
     102      INTEGER             ::   ji, jj, jk, jl     ! dummy loop indices 
     103      INTEGER             ::   nidx 
    100104      REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda 
    101105      REAL(wp), PARAMETER ::   zdmax = 300._wp 
     
    104108      REAL(wp), PARAMETER ::   zm2   = 1.36_wp 
    105109      ! 
    106       REAL(wp), POINTER, DIMENSION(:,:) ::   zda_tot 
     110      REAL(wp), DIMENSION(jpij) ::   zda_tot 
    107111      !!--------------------------------------------------------------------- 
    108       CALL wrk_alloc( jpi,jpj, zda_tot ) 
     112 
     113      ! select ice covered grid points 
     114      nidx = 0 ; idxice(:) = 0 
     115      DO jj = 2, jpjm1 
     116         DO ji = 2, jpim1 
     117            IF ( at_i(ji,jj) > epsi10 ) THEN 
     118               nidx         = nidx  + 1 
     119               idxice(nidx) = (jj - 1) * jpi + ji 
     120            ENDIF 
     121         END DO 
     122      END DO 
    109123 
    110124      !------------------------------------------------------------! 
     
    112126      !------------------------------------------------------------! 
    113127      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 
    114        
    115       DO jj = 1, jpj 
    116          DO ji = 1, jpi 
    117              
    118             ! Mean floe caliper diameter [m] 
    119             zdfloe = rn_dmin * ( zastar / ( zastar - at_i(ji,jj) ) )**rn_beta 
    120              
    121             ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2] 
    122             zperi = at_i(ji,jj) * rpi / ( zcs * zdfloe ) 
    123              
    124             ! Melt speed rate [m/s] 
    125             zwlat = zm1 * ( MAX( 0._wp, sst_m(ji,jj) - ( t_bo(ji,jj) - rt0 ) ) )**zm2 
    126              
    127             ! sea ice concentration decrease 
    128             zda_tot(ji,jj) = - MIN( zwlat * zperi * rdt_ice, at_i(ji,jj) ) 
    129              
    130          END DO 
     128 
     129      CALL tab_2d_1d( nidx, at_i_1d(1:nidx), at_i , jpi, jpj, idxice(1:nidx) ) 
     130      CALL tab_2d_1d( nidx, t_bo_1d(1:nidx), t_bo , jpi, jpj, idxice(1:nidx) ) 
     131      CALL tab_2d_1d( nidx, sst_1d (1:nidx), sst_m, jpi, jpj, idxice(1:nidx) ) 
     132      DO ji = 1, nidx    
     133         zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta         ! Mean floe caliper diameter [m] 
     134         zperi  = at_i_1d(ji) * rpi / ( zcs * zdfloe )                             ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2] 
     135         zwlat  = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2  ! Melt speed rate [m/s] 
     136          
     137         zda_tot(ji) = - MIN( zwlat * zperi * rdt_ice, at_i_1d(ji) )               ! sea ice concentration decrease 
    131138      END DO 
    132139       
     
    134141      ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- ! 
    135142      !---------------------------------------------------------------------------------------------! 
    136       DO jl = jpl, 1, -1 
    137          DO jj = 1, jpj 
    138             DO ji = 1, jpi 
    139                 
    140                ! decrease of concentration for the category jl 
    141                !    1st option: each category contributes to melting in proportion to its concentration 
    142                rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj) - epsi10 ) ) 
    143                zda     = rswitch * zda_tot(ji,jj) * a_i(ji,jj,jl) / MAX( at_i(ji,jj), epsi10 ) 
    144                !    2d option: melting of the upper cat first 
    145                !!zda = MAX( zda_tot(ji,jj), - a_i(ji,jj,jl) ) 
    146                !!zda_tot(ji,jj) = zda_tot(ji,jj) + zda 
    147                 
    148                ! Contribution to salt flux 
    149                sfx_lam(ji,jj) = sfx_lam(ji,jj) - rhoic *  ht_i(ji,jj,jl) * zda * sm_i(ji,jj,jl) * r1_rdtice 
    150                 
    151                ! Contribution to heat flux into the ocean [W.m-2], <0   
    152 !clemX               hfx_thd(ji,jj) = hfx_thd(ji,jj) + zda * r1_rdtice * ( ht_i(ji,jj,jl) * SUM( e_i(ji,jj,:,jl) ) * r1_nlay_i  & 
    153 !                  &                                                + ht_s(ji,jj,jl) *      e_s(ji,jj,1,jl)   * r1_nlay_s ) 
    154                hfx_thd(ji,jj) = hfx_thd(ji,jj) + rswitch * zda_tot(ji,jj) / MAX( at_i(ji,jj), epsi10 )  & 
    155                   &                                      * r1_rdtice * ( SUM( e_i(ji,jj,:,jl) ) + e_s(ji,jj,1,jl) ) 
    156                 
    157                ! Contribution to mass flux 
    158                wfx_lam(ji,jj) =  wfx_lam(ji,jj) - zda * r1_rdtice * ( rhoic * ht_i(ji,jj,jl) + rhosn * ht_s(ji,jj,jl) ) 
    159                 
    160                ! new concentration 
    161                a_i(ji,jj,jl) = a_i(ji,jj,jl) + zda 
    162             END DO 
    163          END DO 
     143      DO jl = 1, jpl 
     144         CALL tab_2d_1d( nidx, a_i_1d    (1:nidx), a_i(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
     145         CALL tab_2d_1d( nidx, ht_i_1d   (1:nidx), ht_i(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
     146         CALL tab_2d_1d( nidx, sm_i_1d   (1:nidx), sm_i(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
     147         CALL tab_2d_1d( nidx, sfx_lam_1d(1:nidx), sfx_lam     , jpi, jpj, idxice(1:nidx) ) 
     148         CALL tab_2d_1d( nidx, hfx_thd_1d(1:nidx), hfx_thd     , jpi, jpj, idxice(1:nidx) ) 
     149         CALL tab_2d_1d( nidx, wfx_lam_1d(1:nidx), wfx_lam     , jpi, jpj, idxice(1:nidx) ) 
     150         DO jk = 1, nlay_i 
     151            CALL tab_2d_1d( nidx, e_i_1d(1:nidx,jk), e_i(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
     152         END DO 
     153         DO jk = 1, nlay_s 
     154            CALL tab_2d_1d( nidx, e_s_1d(1:nidx,jk), e_s(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
     155         END DO 
     156 
     157         DO ji = 1, nidx 
     158            ! decrease of concentration for the category jl 
     159            !    each category contributes to melting in proportion to its concentration 
     160            zda     = zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji) 
     161             
     162            ! Contribution to salt flux 
     163            sfx_lam_1d(ji) = sfx_lam_1d(ji) - rhoic *  ht_i_1d(ji) * zda * sm_i_1d(ji) * r1_rdtice 
     164             
     165            ! Contribution to heat flux into the ocean [W.m-2], <0   
     166            !clemX               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zda * r1_rdtice * ( ht_i_1d(ji) * SUM( e_i_1d(ji,:) ) * r1_nlay_i  & 
     167            !                  &                                                     + ht_s_1d(ji) *      e_s_1d(ji,1)   * r1_nlay_s ) 
     168            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zda_tot(ji) / at_i_1d(ji) * r1_rdtice * ( SUM( e_i_1d(ji,:) ) + e_s_1d(ji,1) ) 
     169             
     170            ! Contribution to mass flux 
     171            wfx_lam_1d(ji) =  wfx_lam_1d(ji) - zda * r1_rdtice * ( rhoic * ht_i_1d(ji) + rhosn * ht_s_1d(ji) ) 
     172             
     173            ! new concentration 
     174            a_i_1d(ji) = a_i_1d(ji) + zda 
     175 
     176            ! ensure that ht_i = 0 where a_i = 0 
     177            IF( a_i_1d(ji) == 0._wp )   ht_i_1d(ji) = 0._wp   
     178         END DO 
     179 
     180         CALL tab_1d_2d( nidx, a_i (:,:,jl), idxice, a_i_1d     (1:nidx), jpi, jpj ) 
     181         CALL tab_1d_2d( nidx, ht_i(:,:,jl), idxice, ht_i_1d    (1:nidx), jpi, jpj ) 
     182         CALL tab_1d_2d( nidx, sfx_lam     , idxice, sfx_lam_1d(1:nidx) , jpi, jpj ) 
     183         CALL tab_1d_2d( nidx, hfx_thd     , idxice, hfx_thd_1d(1:nidx) , jpi, jpj ) 
     184         CALL tab_1d_2d( nidx, wfx_lam     , idxice, wfx_lam_1d(1:nidx) , jpi, jpj ) 
     185 
    164186      END DO 
    165        
    166       ! total concentration 
    167       at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    168        
    169       ! --- ensure that ht_i = 0 where a_i = 0 --- 
    170       WHERE( a_i == 0._wp ) ht_i = 0._wp 
    171       ! 
    172       CALL wrk_dealloc( jpi,jpj, zda_tot ) 
     187             
    173188      ! 
    174189   END SUBROUTINE lim_thd_da 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r8325 r8327  
    7171      !!------------------------------------------------------------------------ 
    7272      INTEGER  ::   ji,jj,jk,jl      ! dummy loop indices 
    73       INTEGER  ::   nbpac            ! local integers  
    74       INTEGER  ::   ii, ij, iter     !   -       - 
     73      INTEGER  ::   nidx            ! local integers  
     74      INTEGER  ::   iter     !   -       - 
    7575      REAL(wp) ::   ztmelts, zdv, zfrazb, zweight, zde                          ! local scalars 
    7676      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      - 
    7777      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    78       CHARACTER (len = 15) :: fieldid 
    7978 
    8079      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 
     
    122121      CALL lim_var_agg(1) 
    123122      CALL lim_var_glo2eqv 
    124       !------------------------------------------------------------------------------| 
    125       ! 2) Convert units for ice internal energy 
    126       !------------------------------------------------------------------------------| 
    127       DO jl = 1, jpl 
    128          DO jk = 1, nlay_i 
    129             DO jj = 1, jpj 
    130                DO ji = 1, jpi 
    131                   !Energy of melting q(S,T) [J.m-3] 
    132                   rswitch          = MAX(  0._wp , SIGN( 1._wp , v_i(ji,jj,jl) - epsi20 )  )   !0 if no ice 
    133                   e_i(ji,jj,jk,jl) = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl), epsi20 ) * REAL( nlay_i, wp ) 
    134                END DO 
    135             END DO 
    136          END DO 
    137       END DO 
    138123 
    139124      !------------------------------------------------------------------------------! 
     
    240225      !------------------------------------- 
    241226      ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice 
    242       nbpac = 0 
    243       npac(:) = 0 
    244       ! 
    245       DO jj = 1, jpj 
    246          DO ji = 1, jpi 
     227      nidx = 0 ; idxice(:) = 0 
     228      DO jj = 2, jpjm1 
     229         DO ji = 2, jpim1 
    247230            IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN 
    248                nbpac = nbpac + 1 
    249                npac( nbpac ) = (jj - 1) * jpi + ji 
     231               nidx = nidx + 1 
     232               idxice( nidx ) = (jj - 1) * jpi + ji 
    250233            ENDIF 
    251234         END DO 
     
    264247      ENDIF 
    265248    
    266       IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
     249      IF( ln_limctl ) WRITE(numout,*) 'lim_thd_lac : nidx = ', nidx 
    267250 
    268251      !------------------------------ 
     
    271254      ! If ocean gains heat do nothing. Otherwise compute new ice formation 
    272255 
    273       IF ( nbpac > 0 ) THEN 
    274  
    275          CALL tab_2d_1d( nbpac, zat_i_1d  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) ) 
    276          DO jl = 1, jpl 
    277             CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    278             CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    279             CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     256      IF ( nidx > 0 ) THEN 
     257 
     258         CALL tab_2d_1d( nidx, zat_i_1d  (1:nidx)     , at_i         , jpi, jpj, idxice(1:nidx) ) 
     259         DO jl = 1, jpl 
     260            CALL tab_2d_1d( nidx, za_i_1d  (1:nidx,jl), a_i  (:,:,jl), jpi, jpj, idxice(1:nidx) ) 
     261            CALL tab_2d_1d( nidx, zv_i_1d  (1:nidx,jl), v_i  (:,:,jl), jpi, jpj, idxice(1:nidx) ) 
     262            CALL tab_2d_1d( nidx, zsmv_i_1d(1:nidx,jl), smv_i(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
    280263            DO jk = 1, nlay_i 
    281                CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
    282             END DO 
    283          END DO 
    284  
    285          CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead     , jpi, jpj, npac(1:nbpac) ) 
    286          CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo      , jpi, jpj, npac(1:nbpac) ) 
    287          CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw   , jpi, jpj, npac(1:nbpac) ) 
    288          CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw   , jpi, jpj, npac(1:nbpac) ) 
    289          CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol     , jpi, jpj, npac(1:nbpac) ) 
    290          CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel     , jpi, jpj, npac(1:nbpac) ) 
    291  
    292          CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd   , jpi, jpj, npac(1:nbpac) ) 
    293          CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw   , jpi, jpj, npac(1:nbpac) ) 
    294          CALL tab_2d_1d( nbpac, rn_amax_1d(1:nbpac)     , rn_amax_2d, jpi, jpj, npac(1:nbpac) ) 
    295  
     264               CALL tab_2d_1d( nidx, ze_i_1d(1:nidx,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, idxice(1:nidx) ) 
     265            END DO 
     266         END DO 
     267 
     268         CALL tab_2d_1d( nidx, qlead_1d  (1:nidx)     , qlead     , jpi, jpj, idxice(1:nidx) ) 
     269         CALL tab_2d_1d( nidx, t_bo_1d   (1:nidx)     , t_bo      , jpi, jpj, idxice(1:nidx) ) 
     270         CALL tab_2d_1d( nidx, sfx_opw_1d(1:nidx)     , sfx_opw   , jpi, jpj, idxice(1:nidx) ) 
     271         CALL tab_2d_1d( nidx, wfx_opw_1d(1:nidx)     , wfx_opw   , jpi, jpj, idxice(1:nidx) ) 
     272         CALL tab_2d_1d( nidx, hicol_1d  (1:nidx)     , hicol     , jpi, jpj, idxice(1:nidx) ) 
     273         CALL tab_2d_1d( nidx, zvrel_1d  (1:nidx)     , zvrel     , jpi, jpj, idxice(1:nidx) ) 
     274 
     275         CALL tab_2d_1d( nidx, hfx_thd_1d(1:nidx)     , hfx_thd   , jpi, jpj, idxice(1:nidx) ) 
     276         CALL tab_2d_1d( nidx, hfx_opw_1d(1:nidx)     , hfx_opw   , jpi, jpj, idxice(1:nidx) ) 
     277         CALL tab_2d_1d( nidx, rn_amax_1d(1:nidx)     , rn_amax_2d, jpi, jpj, idxice(1:nidx) ) 
     278         CALL tab_2d_1d( nidx, sss_1d    (1:nidx)     , sss_m     , jpi, jpj, idxice(1:nidx) ) 
     279 
     280         !------------------------------------------------------------------------------| 
     281         ! 2) Convert units for ice internal energy 
     282         !------------------------------------------------------------------------------| 
     283         DO jl = 1, jpl 
     284            DO jk = 1, nlay_i 
     285               DO ji = 1, nidx 
     286                  IF( zv_i_1d(ji,jl) > 0._wp )   ze_i_1d(ji,jk,jl) = ze_i_1d(ji,jk,jl) / zv_i_1d(ji,jl) * REAL( nlay_i ) 
     287               END DO 
     288            END DO 
     289         END DO 
    296290         !------------------------------------------------------------------------------! 
    297291         ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice 
     
    301295         ! Keep old ice areas and volume in memory 
    302296         !----------------------------------------- 
    303          zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:)  
    304          za_b(1:nbpac,:) = za_i_1d(1:nbpac,:) 
     297         zv_b(1:nidx,:) = zv_i_1d(1:nidx,:)  
     298         za_b(1:nidx,:) = za_i_1d(1:nidx,:) 
    305299 
    306300         !---------------------- 
    307301         ! Thickness of new ice 
    308302         !---------------------- 
    309          zh_newice(1:nbpac) = hicol_1d(1:nbpac) 
     303         zh_newice(1:nidx) = hicol_1d(1:nidx) 
    310304 
    311305         !---------------------- 
     
    314308         SELECT CASE ( nn_icesal ) 
    315309         CASE ( 1 )                    ! Sice = constant  
    316             zs_newice(1:nbpac) = rn_icesal 
     310            zs_newice(1:nidx) = rn_icesal 
    317311         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
    318             DO ji = 1, nbpac 
    319                ii =   MOD( npac(ji) - 1 , jpi ) + 1 
    320                ij =      ( npac(ji) - 1 ) / jpi + 1 
    321                zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_m(ii,ij)  ) 
     312            DO ji = 1, nidx 
     313               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , rn_simax , 0.5 * sss_1d(ji) ) 
    322314            END DO 
    323315         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
    324             zs_newice(1:nbpac) =   2.3 
     316            zs_newice(1:nidx) =   2.3 
    325317         END SELECT 
    326318 
     
    329321         !------------------------- 
    330322         ! We assume that new ice is formed at the seawater freezing point 
    331          DO ji = 1, nbpac 
     323         DO ji = 1, nidx 
    332324            ztmelts       = - tmut * zs_newice(ji) + rt0                  ! Melting point (K) 
    333325            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                                         & 
     
    339331         ! Age of new ice 
    340332         !---------------- 
    341          DO ji = 1, nbpac 
     333         DO ji = 1, nidx 
    342334            zo_newice(ji) = 0._wp 
    343335         END DO 
     
    346338         ! Volume of new ice 
    347339         !------------------- 
    348          DO ji = 1, nbpac 
     340         DO ji = 1, nidx 
    349341 
    350342            zEi           = - ze_newice(ji) * r1_rhoic             ! specific enthalpy of forming ice [J/kg] 
     
    374366         IF( ln_frazil ) THEN 
    375367            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    376             DO ji = 1, nbpac 
     368            DO ji = 1, nidx 
    377369               rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 
    378370               zfrazb        = rswitch * ( TANH( rn_Cfrazb * ( zvrel_1d(ji) - rn_vfrazb ) ) + 1.0 ) * 0.5 * rn_maxfrazb 
     
    385377         ! Area of new ice 
    386378         !----------------- 
    387          DO ji = 1, nbpac 
     379         DO ji = 1, nidx 
    388380            za_newice(ji) = zv_newice(ji) / zh_newice(ji) 
    389381         END DO 
     
    398390         ! If lateral ice growth gives an ice concentration gt 1, then 
    399391         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
    400          DO ji = 1, nbpac 
     392         DO ji = 1, nidx 
    401393            IF ( za_newice(ji) >  ( rn_amax_1d(ji) - zat_i_1d(ji) ) ) THEN 
    402394               zda_res(ji)   = za_newice(ji) - ( rn_amax_1d(ji) - zat_i_1d(ji) ) 
     
    413405         zat_i_1d(:) = 0._wp 
    414406         DO jl = 1, jpl 
    415             DO ji = 1, nbpac 
     407            DO ji = 1, nidx 
    416408               IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN 
    417409                  za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji) 
     
    424416 
    425417         ! Heat content 
    426          DO ji = 1, nbpac 
     418         DO ji = 1, nidx 
    427419            jl = jcat(ji)                                                    ! categroy in which new ice is put 
    428420            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice 
     
    430422 
    431423         DO jk = 1, nlay_i 
    432             DO ji = 1, nbpac 
     424            DO ji = 1, nidx 
    433425               jl = jcat(ji) 
    434426               rswitch = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 
     
    445437 
    446438            ! for remapping 
    447             h_i_old (1:nbpac,0:nlay_i+1) = 0._wp 
    448             eh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 
     439            h_i_old (1:nidx,0:nlay_i+1) = 0._wp 
     440            eh_i_old(1:nidx,0:nlay_i+1) = 0._wp 
    449441            DO jk = 1, nlay_i 
    450                DO ji = 1, nbpac 
     442               DO ji = 1, nidx 
    451443                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i 
    452444                  eh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk) 
     
    455447 
    456448            ! new volumes including lateral/bottom accretion + residual 
    457             DO ji = 1, nbpac 
     449            DO ji = 1, nidx 
    458450               rswitch        = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 
    459451               zv_newfra      = rswitch * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 ) 
     
    465457            ENDDO 
    466458            ! --- Ice enthalpy remapping --- ! 
    467             CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) )  
     459            CALL lim_thd_ent( 1, nidx, ze_i_1d(1:nidx,:,jl) )  
    468460         ENDDO 
    469461 
     
    472464         !----------------- 
    473465         DO jl = 1, jpl 
    474             DO ji = 1, nbpac 
     466            DO ji = 1, nidx 
    475467               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl) 
    476468               zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 
     
    479471 
    480472         !------------------------------------------------------------------------------! 
     473         ! 8) Change units for e_i 
     474         !------------------------------------------------------------------------------!     
     475         DO jl = 1, jpl 
     476            DO jk = 1, nlay_i 
     477               DO ji = 1, nidx 
     478                  ze_i_1d(ji,jk,jl) = ze_i_1d(ji,jk,jl) * zv_i_1d(ji,jl) * r1_nlay_i  
     479               END DO 
     480            END DO 
     481         END DO 
     482         !------------------------------------------------------------------------------! 
    481483         ! 7) Change 2D vectors to 1D vectors  
    482484         !------------------------------------------------------------------------------! 
    483485         DO jl = 1, jpl 
    484             CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 
    485             CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 
    486             CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 
     486            CALL tab_1d_2d( nidx, a_i (:,:,jl), idxice(1:nidx), za_i_1d (1:nidx,jl), jpi, jpj ) 
     487            CALL tab_1d_2d( nidx, v_i (:,:,jl), idxice(1:nidx), zv_i_1d (1:nidx,jl), jpi, jpj ) 
     488            CALL tab_1d_2d( nidx, smv_i (:,:,jl), idxice(1:nidx), zsmv_i_1d(1:nidx,jl) , jpi, jpj ) 
    487489            DO jk = 1, nlay_i 
    488                CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_1d(1:nbpac,jk,jl), jpi, jpj ) 
    489             END DO 
    490          END DO 
    491          CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 
    492          CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 
    493  
    494          CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) 
    495          CALL tab_1d_2d( nbpac, hfx_opw, npac(1:nbpac), hfx_opw_1d(1:nbpac), jpi, jpj ) 
     490               CALL tab_1d_2d( nidx, e_i(:,:,jk,jl), idxice(1:nidx), ze_i_1d(1:nidx,jk,jl), jpi, jpj ) 
     491            END DO 
     492         END DO 
     493         CALL tab_1d_2d( nidx, sfx_opw, idxice(1:nidx), sfx_opw_1d(1:nidx), jpi, jpj ) 
     494         CALL tab_1d_2d( nidx, wfx_opw, idxice(1:nidx), wfx_opw_1d(1:nidx), jpi, jpj ) 
     495         CALL tab_1d_2d( nidx, hfx_thd, idxice(1:nidx), hfx_thd_1d(1:nidx), jpi, jpj ) 
     496         CALL tab_1d_2d( nidx, hfx_opw, idxice(1:nidx), hfx_opw_1d(1:nidx), jpi, jpj ) 
    496497         ! 
    497       ENDIF ! nbpac > 0 
    498  
    499       !------------------------------------------------------------------------------! 
    500       ! 8) Change units for e_i 
    501       !------------------------------------------------------------------------------!     
    502       DO jl = 1, jpl 
    503          DO jk = 1, nlay_i 
    504             DO jj = 1, jpj 
    505                DO ji = 1, jpi 
    506                   ! heat content in J/m2 
    507                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i  
    508                END DO 
    509             END DO 
    510          END DO 
    511       END DO 
    512  
     498      ENDIF ! nidx > 0 
    513499      ! 
    514500      CALL wrk_dealloc( jpij, jcat )   ! integer 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r8325 r8327  
    476476         DO jk = 1, nlay_i 
    477477            DO ji = kideb, kiut 
    478                ii =  MOD( npb(ji) - 1 , jpi ) + 1 
    479                ij =     ( npb(ji) - 1 ) / jpi + 1 
     478               ii =  MOD( idxice(ji) - 1 , jpi ) + 1 
     479               ij =     ( idxice(ji) - 1 ) / jpi + 1 
    480480               ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise 
    481481               zswi0  = MAX( 0._wp , SIGN( 1._wp  , zsi0 - sm_i_1d(ji) ) )  
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r8326 r8327  
    2626   !: are the variables corresponding to 2d vectors 
    2727 
    28    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: address vector for 1d vertical thermo computations 
    29    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nplm   !: address vector for mono-category lateral melting 
    30    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: address vector for new ice formation 
     28   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   idxice !: selected points for ice thermo 
    3129 
    3230   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      
     
    6462   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_ice_sub_1d  
    6563   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_err_sub_1d  
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_lam_1d  
    6665 
    6766   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d     
     
    8079   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d    
    8180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d   
    82  
    8381   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sub_1d 
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_lam_1d 
    8483 
    8584   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip 
     
    146145 
    147146      ii = 1 
    148       ALLOCATE( npb      (jpij) , nplm      (jpij) , npac       (jpij) ,   & 
     147      ALLOCATE( idxice   (jpij) ,   & 
    149148         &      qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) ,   & 
    150149         &      fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij)  ,   & 
     
    163162         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) ,  & 
    164163         &      wfx_snw_sub_1d(jpij), wfx_ice_sub_1d(jpij), wfx_err_sub_1d(jpij) ,              & 
    165          &      dqns_ice_1d(jpij) , evap_ice_1d (jpij),                                         & 
     164         &      wfx_lam_1d(jpij)  , dqns_ice_1d(jpij) , evap_ice_1d (jpij),                     & 
    166165         &      qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0         (jpij) ,                     &   
    167166         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij),  & 
    168167         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij),  & 
    169          &      hicol_1d   (jpij)                     , STAT=ierr(ii) ) 
     168         &      sfx_lam_1d (jpij) , hicol_1d   (jpij)                     , STAT=ierr(ii) ) 
    170169      ! 
    171170      ii = ii + 1 
Note: See TracChangeset for help on using the changeset viewer.