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

Ignore:
Timestamp:
2017-07-15T17:27:14+02:00 (7 years ago)
Author:
clem
Message:

simplify the code

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

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90

    r4161 r8342  
    1212   !!---------------------------------------------------------------------- 
    1313   USE par_kind 
    14  
     14   USE par_oce 
     15    
    1516   IMPLICIT NONE 
    1617   PRIVATE 
    … …  
    2627CONTAINS 
    2728 
    28    SUBROUTINE tab_2d_1d( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind ) 
     29   SUBROUTINE tab_2d_1d( ndim1d, tab_ind, tab1d, tab2d ) 
    2930      !!---------------------------------------------------------------------- 
    3031      !!                  ***  ROUTINE tab_2d_1d  *** 
    3132      !!---------------------------------------------------------------------- 
    32       INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes 
    33       REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(in   ) ::   tab2d                        ! input 2D field 
    34       INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index 
    35       REAL(wp), DIMENSION(ndim1d)           , INTENT(  out) ::   tab1d                        ! output 1D field 
     33      INTEGER                     , INTENT(in   ) ::   ndim1d   ! 1d size 
     34      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind  ! input index 
     35      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   tab2d    ! input 2D field 
     36      REAL(wp), DIMENSION(ndim1d) , INTENT(  out) ::   tab1d    ! output 1D field 
    3637      ! 
    3738      INTEGER ::   jn , jid, jjd 
    3839      !!---------------------------------------------------------------------- 
    3940      DO jn = 1, ndim1d 
    40          jid        = MOD( tab_ind(jn) - 1 , ndim2d_x ) + 1 
    41          jjd        =    ( tab_ind(jn) - 1 ) / ndim2d_x + 1 
     41         jid        = MOD( tab_ind(jn) - 1 , jpi ) + 1 
     42         jjd        =    ( tab_ind(jn) - 1 ) / jpi + 1 
    4243         tab1d( jn) = tab2d( jid, jjd) 
    4344      END DO 
    … …  
    4546 
    4647 
    47    SUBROUTINE tab_1d_2d( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y ) 
     48   SUBROUTINE tab_1d_2d( ndim1d, tab_ind, tab1d, tab2d ) 
    4849      !!---------------------------------------------------------------------- 
    4950      !!                  ***  ROUTINE tab_2d_1d  *** 
    5051      !!---------------------------------------------------------------------- 
    51       INTEGER                               , INTENT(in   ) ::   ndim1d, ndim2d_x, ndim2d_y   ! 1d & 2D sizes 
    52       REAL(wp), DIMENSION(ndim1d)           , INTENT(in   ) ::   tab1d                        ! input 1D field 
    53       INTEGER , DIMENSION(ndim1d)           , INTENT(in   ) ::   tab_ind                      ! input index 
    54       REAL(wp), DIMENSION(ndim2d_x,ndim2d_y), INTENT(  out) ::   tab2d                        ! output 2D field 
     52      INTEGER                     , INTENT(in   ) ::   ndim1d    ! 1D size 
     53      INTEGER , DIMENSION(ndim1d) , INTENT(in   ) ::   tab_ind   ! input index 
     54      REAL(wp), DIMENSION(ndim1d) , INTENT(in   ) ::   tab1d     ! input 1D field 
     55      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   tab2d     ! output 2D field 
    5556      ! 
    5657      INTEGER ::   jn , jid, jjd 
    5758      !!---------------------------------------------------------------------- 
    5859      DO jn = 1, ndim1d 
    59          jid             = MOD( tab_ind(jn) - 1 ,  ndim2d_x ) + 1 
    60          jjd             =    ( tab_ind(jn) - 1 ) / ndim2d_x  + 1 
     60         jid             = MOD( tab_ind(jn) - 1 ,  jpi ) + 1 
     61         jjd             =    ( tab_ind(jn) - 1 ) / jpi  + 1 
    6162         tab2d(jid, jjd) = tab1d( jn) 
    6263      END DO 

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r8341 r8342  
    8383      ! 
    8484      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    85       INTEGER  :: nidx             ! nb of icy pts for vertical thermo calculations 
    8685      REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg 
    8786      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    … …  
    242241            dh_snowice(:) = 0._wp ; dh_i_sub (:) = 0._wp 
    243242 
    244                               CALL lim_thd_1d2d( nidx, jl, 1 )               ! --- Move to 1D arrays --- ! 
     243                              CALL lim_thd_1d2d( jl, 1 )               ! --- Move to 1D arrays --- ! 
    245244            ! 
    246245            DO jk = 1, nlay_i                                                ! --- Change units from J/m2 to J/m3 --- ! 
    … …  
    251250            ENDDO 
    252251            ! 
    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 --- ! 
     252            IF( ln_limdH )    CALL lim_thd_dif                    ! --- Ice/Snow Temperature profile --- ! 
     253            ! 
     254            IF( ln_limdH )    CALL lim_thd_dh                     ! --- Ice/Snow thickness --- !     
     255            ! 
     256            IF( ln_limdH )    CALL lim_thd_ent( e_i_1d(1:nidx,:) )  ! --- Ice enthalpy remapping --- ! 
     257            ! 
     258                              CALL lim_thd_sal                    ! --- Ice salinity --- !     
     259            ! 
     260                              CALL lim_thd_temp                   ! --- temperature update --- ! 
    262261            ! 
    263262            IF( ln_limdH ) THEN 
    264263               IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 
    265                               CALL lim_thd_lam( 1, nidx )                    ! --- extra lateral melting if monocat --- ! 
     264                              CALL lim_thd_lam                    ! --- extra lateral melting if monocat --- ! 
    266265               END IF 
    267266            END IF 
    … …  
    274273            ENDDO 
    275274            ! 
    276                               CALL lim_thd_1d2d( nidx, jl, 2 )               ! --- Move to 2D arrays --- ! 
     275                              CALL lim_thd_1d2d( jl, 2 )               ! --- Move to 2D arrays --- ! 
    277276            ! 
    278277            IF( lk_mpp )      CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
    … …  
    344343 
    345344  
    346    SUBROUTINE lim_thd_temp( kideb, kiut ) 
     345   SUBROUTINE lim_thd_temp 
    347346      !!----------------------------------------------------------------------- 
    348347      !!                   ***  ROUTINE lim_thd_temp ***  
    … …  
    352351      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
    353352      !!------------------------------------------------------------------- 
    354       INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
    355       ! 
    356353      INTEGER  ::   ji, jk   ! dummy loop indices 
    357354      REAL(wp) ::   ztmelts, zaaa, zbbb, zccc, zdiscrim  ! local scalar  
    … …  
    359356      ! Recover ice temperature 
    360357      DO jk = 1, nlay_i 
    361          DO ji = kideb, kiut 
     358         DO ji = 1, nidx 
    362359            ztmelts       =  -tmut * s_i_1d(ji,jk) + rt0 
    363360            ! Conversion q(S,T) -> T (second order equation) 
    … …  
    377374 
    378375 
    379    SUBROUTINE lim_thd_lam( kideb, kiut ) 
     376   SUBROUTINE lim_thd_lam 
    380377      !!----------------------------------------------------------------------- 
    381378      !!                   ***  ROUTINE lim_thd_lam ***  
    … …  
    384381      !!                          ( dA = A/2h dh ) 
    385382      !!----------------------------------------------------------------------- 
    386       INTEGER, INTENT(in) ::   kideb, kiut        ! bounds for the spatial loop 
    387       ! 
    388383      INTEGER  ::   ji                 ! dummy loop indices 
    389384      REAL(wp) ::   zhi_bef            ! ice thickness before thermo 
    … …  
    392387      !!----------------------------------------------------------------------- 
    393388      ! 
    394       DO ji = kideb, kiut 
     389      DO ji = 1, nidx 
    395390         zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) ) 
    396391         IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp )  THEN 
    … …  
    413408 
    414409 
    415    SUBROUTINE lim_thd_1d2d( nidx, jl, kn ) 
     410   SUBROUTINE lim_thd_1d2d( jl, kn ) 
    416411      !!----------------------------------------------------------------------- 
    417412      !!                   ***  ROUTINE lim_thd_1d2d ***  
    … …  
    419414      !! ** Purpose :   move arrays from 1d to 2d and the reverse 
    420415      !!----------------------------------------------------------------------- 
     416      INTEGER, INTENT(in) ::   jl       ! ice cat 
    421417      INTEGER, INTENT(in) ::   kn       ! 1= from 2D to 1D   ;   2= from 1D to 2D 
    422       INTEGER, INTENT(in) ::   nidx     ! size of 1D arrays 
    423       INTEGER, INTENT(in) ::   jl       ! ice cat 
    424418      ! 
    425419      INTEGER             ::   jk       ! dummy loop indices 
    … …  
    430424      CASE( 1 )            ! from 2D to 1D 
    431425         ! 
    432          CALL tab_2d_1d( nidx, at_i_1d     (1:nidx), at_i            , jpi, jpj, idxice(1:nidx) ) 
    433          CALL tab_2d_1d( nidx, a_i_1d      (1:nidx), a_i(:,:,jl)     , jpi, jpj, idxice(1:nidx) ) 
    434          CALL tab_2d_1d( nidx, ht_i_1d     (1:nidx), ht_i(:,:,jl)    , jpi, jpj, idxice(1:nidx) ) 
    435          CALL tab_2d_1d( nidx, ht_s_1d     (1:nidx), ht_s(:,:,jl)    , jpi, jpj, idxice(1:nidx) ) 
    436          ! 
    437          CALL tab_2d_1d( nidx, t_su_1d     (1:nidx), t_su(:,:,jl)    , jpi, jpj, idxice(1:nidx) ) 
    438          CALL tab_2d_1d( nidx, sm_i_1d     (1:nidx), sm_i(:,:,jl)    , jpi, jpj, idxice(1:nidx) ) 
     426         CALL tab_2d_1d( nidx, idxice(1:nidx), at_i_1d(1:nidx), at_i             ) 
     427         CALL tab_2d_1d( nidx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl)      ) 
     428         CALL tab_2d_1d( nidx, idxice(1:nidx), ht_i_1d(1:nidx), ht_i(:,:,jl)     ) 
     429         CALL tab_2d_1d( nidx, idxice(1:nidx), ht_s_1d(1:nidx), ht_s(:,:,jl)     ) 
     430         CALL tab_2d_1d( nidx, idxice(1:nidx), t_su_1d(1:nidx), t_su(:,:,jl)     ) 
     431         CALL tab_2d_1d( nidx, idxice(1:nidx), sm_i_1d(1:nidx), sm_i(:,:,jl)     ) 
    439432         DO jk = 1, nlay_s 
    440             CALL tab_2d_1d( nidx, t_s_1d(1:nidx,jk), t_s(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
    441             CALL tab_2d_1d( nidx, e_s_1d(1:nidx,jk), e_s(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
     433            CALL tab_2d_1d( nidx, idxice(1:nidx), t_s_1d(1:nidx,jk), t_s(:,:,jk,jl)  ) 
     434            CALL tab_2d_1d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,jl)  ) 
    442435         END DO 
    443436         DO jk = 1, nlay_i 
    444             CALL tab_2d_1d( nidx, t_i_1d(1:nidx,jk), t_i(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
    445             CALL tab_2d_1d( nidx, e_i_1d(1:nidx,jk), e_i(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
    446             CALL tab_2d_1d( nidx, s_i_1d(1:nidx,jk), s_i(:,:,jk,jl)  , jpi, jpj, idxice(1:nidx) ) 
    447          END DO 
    448          ! 
    449          CALL tab_2d_1d( nidx, qprec_ice_1d(1:nidx), qprec_ice(:,:) , jpi, jpj, idxice(1:nidx) ) 
    450          CALL tab_2d_1d( nidx, qevap_ice_1d(1:nidx), qevap_ice(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
    451          CALL tab_2d_1d( nidx, qsr_ice_1d (1:nidx), qsr_ice(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
    452          CALL tab_2d_1d( nidx, fr1_i0_1d  (1:nidx), fr1_i0          , jpi, jpj, idxice(1:nidx) ) 
    453          CALL tab_2d_1d( nidx, fr2_i0_1d  (1:nidx), fr2_i0          , jpi, jpj, idxice(1:nidx) ) 
    454          CALL tab_2d_1d( nidx, qns_ice_1d (1:nidx), qns_ice(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
    455          CALL tab_2d_1d( nidx, ftr_ice_1d (1:nidx), ftr_ice(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
    456          CALL tab_2d_1d( nidx, evap_ice_1d (1:nidx), evap_ice(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
    457          CALL tab_2d_1d( nidx, dqns_ice_1d(1:nidx), dqns_ice(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
    458          CALL tab_2d_1d( nidx, t_bo_1d     (1:nidx), t_bo            , jpi, jpj, idxice(1:nidx) ) 
    459          CALL tab_2d_1d( nidx, sprecip_1d (1:nidx), sprecip         , jpi, jpj, idxice(1:nidx) )  
    460          CALL tab_2d_1d( nidx, fhtur_1d   (1:nidx), fhtur           , jpi, jpj, idxice(1:nidx) ) 
    461          CALL tab_2d_1d( nidx, fhld_1d    (1:nidx), fhld            , jpi, jpj, idxice(1:nidx) ) 
    462          ! 
    463          CALL tab_2d_1d( nidx, wfx_snw_sni_1d(1:nidx), wfx_snw_sni  , jpi, jpj, idxice(1:nidx) ) 
    464          CALL tab_2d_1d( nidx, wfx_snw_sum_1d(1:nidx), wfx_snw_sum  , jpi, jpj, idxice(1:nidx) ) 
    465          CALL tab_2d_1d( nidx, wfx_sub_1d (1:nidx), wfx_sub         , jpi, jpj, idxice(1:nidx) ) 
    466          CALL tab_2d_1d( nidx, wfx_snw_sub_1d(1:nidx), wfx_snw_sub  , jpi, jpj, idxice(1:nidx) ) 
    467          CALL tab_2d_1d( nidx, wfx_ice_sub_1d(1:nidx), wfx_ice_sub  , jpi, jpj, idxice(1:nidx) ) 
    468          CALL tab_2d_1d( nidx, wfx_err_sub_1d(1:nidx), wfx_err_sub  , jpi, jpj, idxice(1:nidx) ) 
    469          ! 
    470          CALL tab_2d_1d( nidx, wfx_bog_1d (1:nidx), wfx_bog         , jpi, jpj, idxice(1:nidx) ) 
    471          CALL tab_2d_1d( nidx, wfx_bom_1d (1:nidx), wfx_bom         , jpi, jpj, idxice(1:nidx) ) 
    472          CALL tab_2d_1d( nidx, wfx_sum_1d (1:nidx), wfx_sum         , jpi, jpj, idxice(1:nidx) ) 
    473          CALL tab_2d_1d( nidx, wfx_sni_1d (1:nidx), wfx_sni         , jpi, jpj, idxice(1:nidx) ) 
    474          CALL tab_2d_1d( nidx, wfx_res_1d (1:nidx), wfx_res         , jpi, jpj, idxice(1:nidx) ) 
    475          CALL tab_2d_1d( nidx, wfx_spr_1d (1:nidx), wfx_spr         , jpi, jpj, idxice(1:nidx) ) 
    476          ! 
    477          CALL tab_2d_1d( nidx, sfx_bog_1d (1:nidx), sfx_bog         , jpi, jpj, idxice(1:nidx) ) 
    478          CALL tab_2d_1d( nidx, sfx_bom_1d (1:nidx), sfx_bom         , jpi, jpj, idxice(1:nidx) ) 
    479          CALL tab_2d_1d( nidx, sfx_sum_1d (1:nidx), sfx_sum         , jpi, jpj, idxice(1:nidx) ) 
    480          CALL tab_2d_1d( nidx, sfx_sni_1d (1:nidx), sfx_sni         , jpi, jpj, idxice(1:nidx) ) 
    481          CALL tab_2d_1d( nidx, sfx_bri_1d (1:nidx), sfx_bri         , jpi, jpj, idxice(1:nidx) ) 
    482          CALL tab_2d_1d( nidx, sfx_res_1d (1:nidx), sfx_res         , jpi, jpj, idxice(1:nidx) ) 
    483          CALL tab_2d_1d( nidx, sfx_sub_1d (1:nidx), sfx_sub         , jpi, jpj,idxice(1:nidx) ) 
    484          ! 
    485          CALL tab_2d_1d( nidx, hfx_thd_1d (1:nidx), hfx_thd         , jpi, jpj, idxice(1:nidx) ) 
    486          CALL tab_2d_1d( nidx, hfx_spr_1d (1:nidx), hfx_spr         , jpi, jpj, idxice(1:nidx) ) 
    487          CALL tab_2d_1d( nidx, hfx_sum_1d (1:nidx), hfx_sum         , jpi, jpj, idxice(1:nidx) ) 
    488          CALL tab_2d_1d( nidx, hfx_bom_1d (1:nidx), hfx_bom         , jpi, jpj, idxice(1:nidx) ) 
    489          CALL tab_2d_1d( nidx, hfx_bog_1d (1:nidx), hfx_bog         , jpi, jpj, idxice(1:nidx) ) 
    490          CALL tab_2d_1d( nidx, hfx_dif_1d (1:nidx), hfx_dif         , jpi, jpj, idxice(1:nidx) ) 
    491          CALL tab_2d_1d( nidx, hfx_opw_1d (1:nidx), hfx_opw         , jpi, jpj, idxice(1:nidx) ) 
    492          CALL tab_2d_1d( nidx, hfx_snw_1d (1:nidx), hfx_snw         , jpi, jpj, idxice(1:nidx) ) 
    493          CALL tab_2d_1d( nidx, hfx_sub_1d (1:nidx), hfx_sub         , jpi, jpj, idxice(1:nidx) ) 
    494          CALL tab_2d_1d( nidx, hfx_err_1d (1:nidx), hfx_err         , jpi, jpj, idxice(1:nidx) ) 
    495          CALL tab_2d_1d( nidx, hfx_res_1d (1:nidx), hfx_res         , jpi, jpj, idxice(1:nidx) ) 
    496          CALL tab_2d_1d( nidx, hfx_err_dif_1d (1:nidx), hfx_err_dif , jpi, jpj, idxice(1:nidx) ) 
    497          CALL tab_2d_1d( nidx, hfx_err_rem_1d (1:nidx), hfx_err_rem , jpi, jpj, idxice(1:nidx) ) 
    498          CALL tab_2d_1d( nidx, hfx_out_1d (1:nidx), hfx_out         , jpi, jpj, idxice(1:nidx) ) 
     437            CALL tab_2d_1d( nidx, idxice(1:nidx), t_i_1d(1:nidx,jk), t_i(:,:,jk,jl)  ) 
     438            CALL tab_2d_1d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,jl)  ) 
     439            CALL tab_2d_1d( nidx, idxice(1:nidx), s_i_1d(1:nidx,jk), s_i(:,:,jk,jl)  ) 
     440         END DO 
     441         ! 
     442         CALL tab_2d_1d( nidx, idxice(1:nidx), qprec_ice_1d(1:nidx), qprec_ice        ) 
     443         CALL tab_2d_1d( nidx, idxice(1:nidx), qevap_ice_1d(1:nidx), qevap_ice(:,:,jl) ) 
     444         CALL tab_2d_1d( nidx, idxice(1:nidx), qsr_ice_1d  (1:nidx), qsr_ice(:,:,jl) ) 
     445         CALL tab_2d_1d( nidx, idxice(1:nidx), fr1_i0_1d   (1:nidx), fr1_i0          ) 
     446         CALL tab_2d_1d( nidx, idxice(1:nidx), fr2_i0_1d   (1:nidx), fr2_i0          ) 
     447         CALL tab_2d_1d( nidx, idxice(1:nidx), qns_ice_1d  (1:nidx), qns_ice(:,:,jl) ) 
     448         CALL tab_2d_1d( nidx, idxice(1:nidx), ftr_ice_1d  (1:nidx), ftr_ice(:,:,jl) ) 
     449         CALL tab_2d_1d( nidx, idxice(1:nidx), evap_ice_1d (1:nidx), evap_ice(:,:,jl) ) 
     450         CALL tab_2d_1d( nidx, idxice(1:nidx), dqns_ice_1d (1:nidx), dqns_ice(:,:,jl) ) 
     451         CALL tab_2d_1d( nidx, idxice(1:nidx), t_bo_1d     (1:nidx), t_bo            ) 
     452         CALL tab_2d_1d( nidx, idxice(1:nidx), sprecip_1d  (1:nidx), sprecip          )  
     453         CALL tab_2d_1d( nidx, idxice(1:nidx), fhtur_1d    (1:nidx), fhtur            ) 
     454         CALL tab_2d_1d( nidx, idxice(1:nidx), fhld_1d     (1:nidx), fhld            ) 
     455         ! 
     456         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_snw_sni_1d(1:nidx), wfx_snw_sni  ) 
     457         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_snw_sum_1d(1:nidx), wfx_snw_sum  ) 
     458         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_sub_1d    (1:nidx), wfx_sub      ) 
     459         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_snw_sub_1d(1:nidx), wfx_snw_sub  ) 
     460         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_ice_sub_1d(1:nidx), wfx_ice_sub  ) 
     461         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_err_sub_1d(1:nidx), wfx_err_sub  ) 
     462         ! 
     463         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_bog_1d (1:nidx), wfx_bog          ) 
     464         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_bom_1d (1:nidx), wfx_bom          ) 
     465         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_sum_1d (1:nidx), wfx_sum          ) 
     466         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_sni_1d (1:nidx), wfx_sni          ) 
     467         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_res_1d (1:nidx), wfx_res          ) 
     468         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_spr_1d (1:nidx), wfx_spr          ) 
     469         ! 
     470         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_bog_1d (1:nidx), sfx_bog          ) 
     471         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_bom_1d (1:nidx), sfx_bom          ) 
     472         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_sum_1d (1:nidx), sfx_sum          ) 
     473         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_sni_1d (1:nidx), sfx_sni          ) 
     474         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_bri_1d (1:nidx), sfx_bri          ) 
     475         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_res_1d (1:nidx), sfx_res          ) 
     476         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_sub_1d (1:nidx), sfx_sub          ) 
     477         ! 
     478         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d (1:nidx), hfx_thd          ) 
     479         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_spr_1d (1:nidx), hfx_spr          ) 
     480         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_sum_1d (1:nidx), hfx_sum          ) 
     481         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_bom_1d (1:nidx), hfx_bom          ) 
     482         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_bog_1d (1:nidx), hfx_bog          ) 
     483         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_dif_1d (1:nidx), hfx_dif          ) 
     484         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_opw_1d (1:nidx), hfx_opw          ) 
     485         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_snw_1d (1:nidx), hfx_snw          ) 
     486         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_sub_1d (1:nidx), hfx_sub          ) 
     487         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_err_1d (1:nidx), hfx_err          ) 
     488         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_res_1d (1:nidx), hfx_res          ) 
     489         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_err_dif_1d(1:nidx), hfx_err_dif  ) 
     490         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_err_rem_1d(1:nidx), hfx_err_rem  ) 
     491         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_out_1d (1:nidx), hfx_out          ) 
    499492         ! 
    500493         ! SIMIP diagnostics 
    501          CALL tab_2d_1d( nidx, diag_fc_bo_1d   (1:nidx), diag_fc_bo  , jpi, jpj, idxice(1:nidx) ) 
    502          CALL tab_2d_1d( nidx, diag_fc_su_1d   (1:nidx), diag_fc_su  , jpi, jpj, idxice(1:nidx) ) 
     494         CALL tab_2d_1d( nidx, idxice(1:nidx), diag_fc_bo_1d(1:nidx), diag_fc_bo  ) 
     495         CALL tab_2d_1d( nidx, idxice(1:nidx), diag_fc_su_1d(1:nidx), diag_fc_su  ) 
    503496         ! ocean surface fields 
    504          CALL tab_2d_1d( nidx, sst_1d(1:nidx), sst_m, jpi, jpj, idxice(1:nidx) ) 
    505          CALL tab_2d_1d( nidx, sss_1d(1:nidx), sss_m, jpi, jpj, idxice(1:nidx) ) 
     497         CALL tab_2d_1d( nidx, idxice(1:nidx), sst_1d(1:nidx), sst_m ) 
     498         CALL tab_2d_1d( nidx, idxice(1:nidx), sss_1d(1:nidx), sss_m ) 
    506499         ! 
    507500      CASE( 2 )            ! from 1D to 2D 
    508501         ! 
    509          CALL tab_1d_2d( nidx, at_i          , idxice, at_i_1d    (1:nidx)   , jpi, jpj ) 
    510          CALL tab_1d_2d( nidx, ht_i(:,:,jl)  , idxice, ht_i_1d    (1:nidx)   , jpi, jpj ) 
    511          CALL tab_1d_2d( nidx, ht_s(:,:,jl)  , idxice, ht_s_1d    (1:nidx)   , jpi, jpj ) 
    512          CALL tab_1d_2d( nidx, a_i (:,:,jl)  , idxice, a_i_1d     (1:nidx)   , jpi, jpj ) 
    513          CALL tab_1d_2d( nidx, t_su(:,:,jl)  , idxice, t_su_1d    (1:nidx)   , jpi, jpj ) 
    514          CALL tab_1d_2d( nidx, sm_i(:,:,jl)  , idxice, sm_i_1d    (1:nidx)   , jpi, jpj ) 
     502         CALL tab_1d_2d( nidx, idxice(1:nidx), at_i_1d(1:nidx), at_i            ) 
     503         CALL tab_1d_2d( nidx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl)      ) 
     504         CALL tab_1d_2d( nidx, idxice(1:nidx), ht_i_1d(1:nidx), ht_i(:,:,jl)    ) 
     505         CALL tab_1d_2d( nidx, idxice(1:nidx), ht_s_1d(1:nidx), ht_s(:,:,jl)    ) 
     506         CALL tab_1d_2d( nidx, idxice(1:nidx), t_su_1d(1:nidx), t_su(:,:,jl)    ) 
     507         CALL tab_1d_2d( nidx, idxice(1:nidx), sm_i_1d(1:nidx), sm_i(:,:,jl)    ) 
    515508         DO jk = 1, nlay_s 
    516             CALL tab_1d_2d( nidx, t_s(:,:,jk,jl), idxice, t_s_1d     (1:nidx,jk), jpi, jpj) 
    517             CALL tab_1d_2d( nidx, e_s(:,:,jk,jl), idxice, e_s_1d     (1:nidx,jk), jpi, jpj) 
     509            CALL tab_1d_2d( nidx, idxice(1:nidx), t_s_1d(1:nidx,jk), t_s(:,:,jk,jl)   ) 
     510            CALL tab_1d_2d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,jl)   ) 
    518511         END DO 
    519512         DO jk = 1, nlay_i 
    520             CALL tab_1d_2d( nidx, t_i(:,:,jk,jl), idxice, t_i_1d     (1:nidx,jk), jpi, jpj) 
    521             CALL tab_1d_2d( nidx, e_i(:,:,jk,jl), idxice, e_i_1d     (1:nidx,jk), jpi, jpj) 
    522             CALL tab_1d_2d( nidx, s_i(:,:,jk,jl), idxice, s_i_1d     (1:nidx,jk), jpi, jpj) 
    523          END DO 
    524          ! 
    525          CALL tab_1d_2d( nidx, wfx_snw_sni   , idxice, wfx_snw_sni_1d(1:nidx), jpi, jpj ) 
    526          CALL tab_1d_2d( nidx, wfx_snw_sum   , idxice, wfx_snw_sum_1d(1:nidx),jpi, jpj ) 
    527          CALL tab_1d_2d( nidx, wfx_sub       , idxice, wfx_sub_1d(1:nidx)   , jpi, jpj ) 
    528          CALL tab_1d_2d( nidx, wfx_snw_sub   , idxice, wfx_snw_sub_1d(1:nidx), jpi, jpj ) 
    529          CALL tab_1d_2d( nidx, wfx_ice_sub   , idxice, wfx_ice_sub_1d(1:nidx), jpi, jpj ) 
    530          CALL tab_1d_2d( nidx, wfx_err_sub   , idxice, wfx_err_sub_1d(1:nidx), jpi, jpj ) 
    531          ! 
    532          CALL tab_1d_2d( nidx, wfx_bog       , idxice, wfx_bog_1d(1:nidx)   , jpi, jpj ) 
    533          CALL tab_1d_2d( nidx, wfx_bom       , idxice, wfx_bom_1d(1:nidx)   , jpi, jpj ) 
    534          CALL tab_1d_2d( nidx, wfx_sum       , idxice, wfx_sum_1d(1:nidx)   , jpi, jpj ) 
    535          CALL tab_1d_2d( nidx, wfx_sni       , idxice, wfx_sni_1d(1:nidx)   , jpi, jpj ) 
    536          CALL tab_1d_2d( nidx, wfx_res       , idxice, wfx_res_1d(1:nidx)   , jpi, jpj ) 
    537          CALL tab_1d_2d( nidx, wfx_spr       , idxice, wfx_spr_1d(1:nidx)   , jpi, jpj ) 
    538          ! 
    539          CALL tab_1d_2d( nidx, sfx_bog       , idxice, sfx_bog_1d(1:nidx)   , jpi, jpj ) 
    540          CALL tab_1d_2d( nidx, sfx_bom       , idxice, sfx_bom_1d(1:nidx)   , jpi, jpj ) 
    541          CALL tab_1d_2d( nidx, sfx_sum       , idxice, sfx_sum_1d(1:nidx)   , jpi, jpj ) 
    542          CALL tab_1d_2d( nidx, sfx_sni       , idxice, sfx_sni_1d(1:nidx)   , jpi, jpj ) 
    543          CALL tab_1d_2d( nidx, sfx_res       , idxice, sfx_res_1d(1:nidx)   , jpi, jpj ) 
    544          CALL tab_1d_2d( nidx, sfx_bri       , idxice, sfx_bri_1d(1:nidx)   , jpi, jpj ) 
    545          CALL tab_1d_2d( nidx, sfx_sub       , idxice, sfx_sub_1d(1:nidx)   , jpi, jpj )         
    546          ! 
    547          CALL tab_1d_2d( nidx, hfx_thd       , idxice, hfx_thd_1d(1:nidx)   , jpi, jpj ) 
    548          CALL tab_1d_2d( nidx, hfx_spr       , idxice, hfx_spr_1d(1:nidx)   , jpi, jpj ) 
    549          CALL tab_1d_2d( nidx, hfx_sum       , idxice, hfx_sum_1d(1:nidx)   , jpi, jpj ) 
    550          CALL tab_1d_2d( nidx, hfx_bom       , idxice, hfx_bom_1d(1:nidx)   , jpi, jpj ) 
    551          CALL tab_1d_2d( nidx, hfx_bog       , idxice, hfx_bog_1d(1:nidx)   , jpi, jpj ) 
    552          CALL tab_1d_2d( nidx, hfx_dif       , idxice, hfx_dif_1d(1:nidx)   , jpi, jpj ) 
    553          CALL tab_1d_2d( nidx, hfx_opw       , idxice, hfx_opw_1d(1:nidx)   , jpi, jpj ) 
    554          CALL tab_1d_2d( nidx, hfx_snw       , idxice, hfx_snw_1d(1:nidx)   , jpi, jpj ) 
    555          CALL tab_1d_2d( nidx, hfx_sub       , idxice, hfx_sub_1d(1:nidx)   , jpi, jpj ) 
    556          CALL tab_1d_2d( nidx, hfx_err       , idxice, hfx_err_1d(1:nidx)   , jpi, jpj ) 
    557          CALL tab_1d_2d( nidx, hfx_res       , idxice, hfx_res_1d(1:nidx)   , jpi, jpj ) 
    558          CALL tab_1d_2d( nidx, hfx_err_rem   , idxice, hfx_err_rem_1d(1:nidx), jpi, jpj ) 
    559          CALL tab_1d_2d( nidx, hfx_err_dif   , idxice, hfx_err_dif_1d(1:nidx), jpi, jpj ) 
    560          CALL tab_1d_2d( nidx, hfx_out       , idxice, hfx_out_1d(1:nidx)   , jpi, jpj ) 
    561          ! 
    562          CALL tab_1d_2d( nidx, qns_ice(:,:,jl), idxice, qns_ice_1d(1:nidx) , jpi, jpj) 
    563          CALL tab_1d_2d( nidx, ftr_ice(:,:,jl), idxice, ftr_ice_1d(1:nidx) , jpi, jpj ) 
     513            CALL tab_1d_2d( nidx, idxice(1:nidx), t_i_1d(1:nidx,jk), t_i(:,:,jk,jl)   ) 
     514            CALL tab_1d_2d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,jl)   ) 
     515            CALL tab_1d_2d( nidx, idxice(1:nidx), s_i_1d(1:nidx,jk), s_i(:,:,jk,jl)   ) 
     516         END DO 
     517         ! 
     518         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_snw_sni_1d(1:nidx), wfx_snw_sni   ) 
     519         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_snw_sum_1d(1:nidx), wfx_snw_sum   ) 
     520         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_sub_1d    (1:nidx), wfx_sub       ) 
     521         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_snw_sub_1d(1:nidx), wfx_snw_sub   ) 
     522         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_ice_sub_1d(1:nidx), wfx_ice_sub   ) 
     523         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_err_sub_1d(1:nidx), wfx_err_sub   ) 
     524         ! 
     525         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_bog_1d (1:nidx), wfx_bog          ) 
     526         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_bom_1d (1:nidx), wfx_bom          ) 
     527         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_sum_1d (1:nidx), wfx_sum          ) 
     528         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_sni_1d (1:nidx), wfx_sni          ) 
     529         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_res_1d (1:nidx), wfx_res          ) 
     530         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_spr_1d (1:nidx), wfx_spr          ) 
     531         ! 
     532         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_bog_1d (1:nidx), sfx_bog          ) 
     533         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_bom_1d (1:nidx), sfx_bom          ) 
     534         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_sum_1d (1:nidx), sfx_sum          ) 
     535         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_sni_1d (1:nidx), sfx_sni          ) 
     536         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_bri_1d (1:nidx), sfx_bri          ) 
     537         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_res_1d (1:nidx), sfx_res          ) 
     538         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_sub_1d (1:nidx), sfx_sub          ) 
     539 
     540         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d (1:nidx), hfx_thd          ) 
     541         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_spr_1d (1:nidx), hfx_spr          ) 
     542         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_sum_1d (1:nidx), hfx_sum          ) 
     543         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_bom_1d (1:nidx), hfx_bom          ) 
     544         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_bog_1d (1:nidx), hfx_bog          ) 
     545         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_dif_1d (1:nidx), hfx_dif          ) 
     546         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_opw_1d (1:nidx), hfx_opw          ) 
     547         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_snw_1d (1:nidx), hfx_snw          ) 
     548         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_sub_1d (1:nidx), hfx_sub          ) 
     549         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_err_1d (1:nidx), hfx_err          ) 
     550         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_res_1d (1:nidx), hfx_res          ) 
     551         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_err_dif_1d(1:nidx), hfx_err_dif   ) 
     552         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_err_rem_1d(1:nidx), hfx_err_rem   ) 
     553         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_out_1d (1:nidx), hfx_out          ) 
     554 
     555         CALL tab_1d_2d( nidx, idxice(1:nidx), qns_ice_1d  (1:nidx), qns_ice(:,:,jl)  ) 
     556         CALL tab_1d_2d( nidx, idxice(1:nidx), ftr_ice_1d  (1:nidx), ftr_ice(:,:,jl)  ) 
     557         ! 
    564558         ! 
    565559         ! SIMIP diagnostics          
    566          CALL tab_1d_2d( nidx, t_si(:,:,jl)   , idxice, t_si_1d    (1:nidx)     , jpi, jpj ) 
    567          CALL tab_1d_2d( nidx, diag_fc_bo     , idxice, diag_fc_bo_1d(1:nidx)   , jpi, jpj ) 
    568          CALL tab_1d_2d( nidx, diag_fc_su     , idxice, diag_fc_su_1d(1:nidx)   , jpi, jpj ) 
     560         CALL tab_1d_2d( nidx, idxice(1:nidx), t_si_1d      (1:nidx), t_si(:,:,jl)      ) 
     561         CALL tab_1d_2d( nidx, idxice(1:nidx), diag_fc_bo_1d(1:nidx), diag_fc_bo        ) 
     562         CALL tab_1d_2d( nidx, idxice(1:nidx), diag_fc_su_1d(1:nidx), diag_fc_su        ) 
    569563      END SELECT 
    570564      ! 

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90

    r8341 r8342  
    101101      !!--------------------------------------------------------------------- 
    102102      INTEGER             ::   ji, jj, jk, jl     ! dummy loop indices 
    103       INTEGER             ::   nidx 
    104103      REAL(wp) ::   ztmelts             ! local scalar 
    105104      REAL(wp) ::   zEi          ! specific enthalpy of sea ice (J/kg) 
    … …  
    131130      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 
    132131 
    133       CALL tab_2d_1d( nidx, at_i_1d(1:nidx), at_i , jpi, jpj, idxice(1:nidx) ) 
    134       CALL tab_2d_1d( nidx, t_bo_1d(1:nidx), t_bo , jpi, jpj, idxice(1:nidx) ) 
    135       CALL tab_2d_1d( nidx, sst_1d (1:nidx), sst_m, jpi, jpj, idxice(1:nidx) ) 
     132      CALL tab_2d_1d( nidx, idxice(1:nidx), at_i_1d(1:nidx), at_i ) 
     133      CALL tab_2d_1d( nidx, idxice(1:nidx), t_bo_1d(1:nidx), t_bo ) 
     134      CALL tab_2d_1d( nidx, idxice(1:nidx), sst_1d (1:nidx), sst_m ) 
    136135 
    137136      DO ji = 1, nidx    
    … …  
    148147      DO jl = 1, jpl 
    149148 
    150          CALL tab_2d_1d( nidx, a_i_1d    (1:nidx), a_i(:,:,jl) , jpi, jpj, idxice(1:nidx) ) 
    151          CALL tab_2d_1d( nidx, ht_i_1d   (1:nidx), ht_i(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
    152          CALL tab_2d_1d( nidx, ht_s_1d   (1:nidx), ht_s(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
    153          CALL tab_2d_1d( nidx, sm_i_1d   (1:nidx), sm_i(:,:,jl), jpi, jpj, idxice(1:nidx) ) 
    154          CALL tab_2d_1d( nidx, sfx_lam_1d(1:nidx), sfx_lam     , jpi, jpj, idxice(1:nidx) ) 
    155          CALL tab_2d_1d( nidx, hfx_thd_1d(1:nidx), hfx_thd     , jpi, jpj, idxice(1:nidx) ) 
    156          CALL tab_2d_1d( nidx, wfx_lam_1d(1:nidx), wfx_lam     , jpi, jpj, idxice(1:nidx) ) 
     149         CALL tab_2d_1d( nidx, idxice(1:nidx), a_i_1d    (1:nidx), a_i(:,:,jl) ) 
     150         CALL tab_2d_1d( nidx, idxice(1:nidx), ht_i_1d   (1:nidx), ht_i(:,:,jl) ) 
     151         CALL tab_2d_1d( nidx, idxice(1:nidx), ht_s_1d   (1:nidx), ht_s(:,:,jl) ) 
     152         CALL tab_2d_1d( nidx, idxice(1:nidx), sm_i_1d   (1:nidx), sm_i(:,:,jl) ) 
     153         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_lam_1d(1:nidx), sfx_lam      ) 
     154         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx), hfx_thd      ) 
     155         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_lam_1d(1:nidx), wfx_lam      ) 
    157156         DO jk = 1, nlay_i 
    158             CALL tab_2d_1d( nidx, e_i_1d(1:nidx,jk), e_i(:,:,jk,jl), jpi, jpj, idxice(1:nidx) ) 
     157            CALL tab_2d_1d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,jl) ) 
    159158         END DO 
    160159         DO jk = 1, nlay_s 
    161             CALL tab_2d_1d( nidx, e_s_1d(1:nidx,jk), e_s(:,:,jk,jl), jpi, jpj, idxice(1:nidx) ) 
     160            CALL tab_2d_1d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,jl) ) 
    162161         END DO 
    163162 
    … …  
    196195!! je pense qu'il faut ajuster e_i mais je ne sais pas comment 
    197196         DO jk = 1, nlay_s 
    198             CALL tab_1d_2d( nidx, e_s(:,:,jk,jl), idxice, e_s_1d(1:nidx,jk), jpi, jpj) 
     197            CALL tab_1d_2d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,jl) ) 
    199198         END DO 
    200199         DO jk = 1, nlay_i 
    201             CALL tab_1d_2d( nidx, e_i(:,:,jk,jl), idxice, e_i_1d(1:nidx,jk), jpi, jpj) 
     200            CALL tab_1d_2d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,jl) ) 
    202201         END DO 
    203202          
    204          CALL tab_1d_2d( nidx, a_i (:,:,jl), idxice, a_i_1d    (1:nidx), jpi, jpj ) 
    205          CALL tab_1d_2d( nidx, ht_i(:,:,jl), idxice, ht_i_1d   (1:nidx), jpi, jpj ) 
    206          CALL tab_1d_2d( nidx, ht_s(:,:,jl), idxice, ht_s_1d   (1:nidx), jpi, jpj ) 
    207          CALL tab_1d_2d( nidx, sfx_lam     , idxice, sfx_lam_1d(1:nidx), jpi, jpj ) 
    208          CALL tab_1d_2d( nidx, hfx_thd     , idxice, hfx_thd_1d(1:nidx), jpi, jpj ) 
    209          CALL tab_1d_2d( nidx, wfx_lam     , idxice, wfx_lam_1d(1:nidx), jpi, jpj ) 
     203         CALL tab_1d_2d( nidx, idxice(1:nidx), a_i_1d    (1:nidx), a_i (:,:,jl) ) 
     204         CALL tab_1d_2d( nidx, idxice(1:nidx), ht_i_1d   (1:nidx), ht_i(:,:,jl) ) 
     205         CALL tab_1d_2d( nidx, idxice(1:nidx), ht_s_1d   (1:nidx), ht_s(:,:,jl) ) 
     206         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_lam_1d(1:nidx), sfx_lam      ) 
     207         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx), hfx_thd      ) 
     208         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_lam_1d(1:nidx), wfx_lam      ) 
    210209 
    211210      END DO 

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r8341 r8342  
    4242CONTAINS 
    4343 
    44    SUBROUTINE lim_thd_dh( kideb, kiut ) 
     44   SUBROUTINE lim_thd_dh 
    4545      !!------------------------------------------------------------------ 
    4646      !!                ***  ROUTINE lim_thd_dh  *** 
    … …  
    6666      !!              Vancoppenolle et al.,2009, Ocean Modelling 
    6767      !!------------------------------------------------------------------ 
    68       INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    69       !!  
    7068      INTEGER  ::   ji , jk        ! dummy loop indices 
    7169      INTEGER  ::   iter 
    … …  
    130128 
    131129      ! Initialize enthalpy at nlay_i+1 
    132       DO ji = kideb, kiut 
     130      DO ji = 1, nidx 
    133131         e_i_1d(ji,nlay_i+1) = 0._wp 
    134132      END DO 
    … …  
    138136      eh_i_old(:,0:nlay_i+1) = 0._wp 
    139137      DO jk = 1, nlay_i 
    140          DO ji = kideb, kiut 
     138         DO ji = 1, nidx 
    141139            h_i_old (ji,jk) = ht_i_1d(ji) * r1_nlay_i 
    142140            eh_i_old(ji,jk) = e_i_1d(ji,jk) * h_i_old(ji,jk) 
    … …  
    148146      !------------------------------------------------------------------------------! 
    149147      ! 
    150       DO ji = kideb, kiut 
     148      DO ji = 1, nidx 
    151149         zdum       = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
    152150         zf_tt(ji)  = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
    … …  
    161159      ! (should not happen but sometimes it does) 
    162160      !------------------------------------------------------------------------------! 
    163       DO ji = kideb, kiut 
     161      DO ji = 1, nidx 
    164162         IF( t_s_1d(ji,1) > rt0 ) THEN !!! Internal melting 
    165163            ! Contribution to heat flux to the ocean [W.m-2], < 0   
    … …  
    179177      ! 
    180178      DO jk = 1, nlay_i 
    181          DO ji = kideb, kiut 
     179         DO ji = 1, nidx 
    182180            zh_i(ji,jk) = ht_i_1d(ji) * r1_nlay_i 
    183181            zeh_i(ji)   = zeh_i(ji) + e_i_1d(ji,jk) * zh_i(ji,jk) 
    … …  
    203201      ! Martin Vancoppenolle, December 2006 
    204202 
    205       CALL lim_thd_snwblow( 1. - at_i_1d(kideb:kiut), zsnw(kideb:kiut) ) ! snow distribution over ice after wind blowing 
     203      CALL lim_thd_snwblow( 1. - at_i_1d(1:nidx), zsnw(1:nidx) ) ! snow distribution over ice after wind blowing 
    206204 
    207205      zdeltah(:,:) = 0._wp 
    208       DO ji = kideb, kiut 
     206      DO ji = 1, nidx 
    209207         !----------- 
    210208         ! Snow fall 
    … …  
    242240      zdeltah(:,:) = 0._wp 
    243241      DO jk = 1, nlay_s 
    244          DO ji = kideb, kiut 
     242         DO ji = 1, nidx 
    245243            ! thickness change 
    246244            rswitch          = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )  
    … …  
    265263      ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 
    266264      zdeltah(:,:) = 0._wp 
    267       DO ji = kideb, kiut 
     265      DO ji = 1, nidx 
    268266         zdh_s_sub(ji)  = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 
    269267         ! remaining evap in kg.m-2 (used for ice melting later on) 
    … …  
    284282       
    285283      ! --- Update snow diags --- ! 
    286       DO ji = kideb, kiut 
     284      DO ji = 1, nidx 
    287285         dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
    288286      END DO 
    … …  
    293291      ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 
    294292      DO jk = 1, nlay_s 
    295          DO ji = kideb,kiut 
     293         DO ji = 1,nidx 
    296294            rswitch       = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) ) 
    297295            e_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) *           & 
    … …  
    306304      zdeltah(:,:) = 0._wp ! important 
    307305      DO jk = 1, nlay_i 
    308          DO ji = kideb, kiut 
     306         DO ji = 1, nidx 
    309307            ztmelts           = - tmut * s_i_1d(ji,jk) + rt0          ! Melting point of layer k [K] 
    310308             
    … …  
    394392      END DO 
    395393      ! update ice thickness 
    396       DO ji = kideb, kiut 
     394      DO ji = 1, nidx 
    397395         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) + dh_i_sub(ji) ) 
    398396      END DO 
    399397 
    400398      ! remaining "potential" evap is sent to ocean 
    401       DO ji = kideb, kiut 
     399      DO ji = 1, nidx 
    402400         wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema(ji) * a_i_1d(ji) * r1_rdtice  ! <=0 (net evap for the ocean in kg.m-2.s-1) 
    403401      END DO 
    … …  
    426424 
    427425      ! Iterative procedure 
    428       DO ji = kideb, kiut 
     426      DO ji = 1, nidx 
    429427         IF(  zf_tt(ji) < 0._wp  ) THEN 
    430428            DO iter = 1, num_iter_max 
    … …  
    501499      zdeltah(:,:) = 0._wp ! important 
    502500      DO jk = nlay_i, 1, -1 
    503          DO ji = kideb, kiut 
     501         DO ji = 1, nidx 
    504502            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting  
    505503 
    … …  
    575573      ! Update temperature, energy 
    576574      !------------------------------------------- 
    577       DO ji = kideb, kiut 
     575      DO ji = 1, nidx 
    578576         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_bott(ji) ) 
    579577      END DO   
    … …  
    585583      !------------------------------------------- 
    586584      zdeltah(:,:) = 0._wp ! important 
    587       DO ji = kideb, kiut 
     585      DO ji = 1, nidx 
    588586         zq_rema(ji)     = zq_su(ji) + zq_bo(ji)  
    589587         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow 
    … …  
    612610      ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level,  
    613611      ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice 
    614       DO ji = kideb, kiut 
     612      DO ji = 1, nidx 
    615613         ! 
    616614         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  ) 
    … …  
    651649      ! Update temperature, energy 
    652650      !------------------------------------------- 
    653       DO ji = kideb, kiut 
     651      DO ji = 1, nidx 
    654652         rswitch     =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
    655653         t_su_1d(ji) =  rswitch * t_su_1d(ji) + ( 1.0 - rswitch ) * rt0 
    … …  
    657655 
    658656      DO jk = 1, nlay_s 
    659          DO ji = kideb,kiut 
     657         DO ji = 1,nidx 
    660658            ! mask enthalpy 
    661659            rswitch       = 1._wp - MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  ) 

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r8325 r8342  
    3737CONTAINS 
    3838 
    39    SUBROUTINE lim_thd_dif( kideb , kiut ) 
     39   SUBROUTINE lim_thd_dif 
    4040      !!------------------------------------------------------------------ 
    4141      !!                ***  ROUTINE lim_thd_dif  *** 
    … …  
    6767      !!           of temperature 
    6868      !! 
    69       !! ** Arguments : 
    70       !!           kideb , kiut : Starting and ending points on which the  
    71       !!                         the computation is applied 
    7269      !! 
    7370      !! ** Inputs / Ouputs : (global commons) 
    … …  
    8986      !!           (04-2007) Energy conservation tested by M. Vancoppenolle 
    9087      !!------------------------------------------------------------------ 
    91       INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    92  
    9388      !! * Local variables 
    9489      INTEGER ::   ji             ! spatial loop index 
    … …  
    180175      ! --- diag error on heat diffusion - PART 1 --- ! 
    181176      zdq(:) = 0._wp ; zq_ini(:) = 0._wp       
    182       DO ji = kideb, kiut 
     177      DO ji = 1, nidx 
    183178         zq_ini(ji) = ( SUM( e_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  & 
    184179            &           SUM( e_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s )  
    … …  
    188183      ! 1) Initialization                                                            ! 
    189184      !------------------------------------------------------------------------------! 
    190       DO ji = kideb , kiut 
     185      DO ji = 1 , nidx 
    191186         isnow(ji)= 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ! is there snow or not 
    192187         ! layer thickness 
    … …  
    203198 
    204199      DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
    205          DO ji = kideb , kiut 
     200         DO ji = 1 , nidx 
    206201            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) * r1_nlay_s 
    207202         END DO 
    … …  
    209204 
    210205      DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
    211          DO ji = kideb , kiut 
     206         DO ji = 1 , nidx 
    212207            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) * r1_nlay_i 
    213208         END DO 
    … …  
    230225      ! fr1_i0_1d = i0 for a thin ice cover, fr1_i0_2d = i0 for a thick ice cover 
    231226      zhsu = 0.1_wp ! threshold for the computation of i0 
    232       DO ji = kideb , kiut 
     227      DO ji = 1 , nidx 
    233228         ! switches 
    234229         isnow(ji) = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )  
    … …  
    243238      ! Derivative of the non solar flux 
    244239      !------------------------------------------------------- 
    245       DO ji = kideb , kiut 
     240      DO ji = 1 , nidx 
    246241         zfsw   (ji)    =  qsr_ice_1d(ji) * ( 1 - i0(ji) )   ! Shortwave radiation absorbed at surface 
    247242         zftrice(ji)    =  qsr_ice_1d(ji) *       i0(ji)     ! Solar radiation transmitted below the surface layer 
    … …  
    254249      !--------------------------------------------------------- 
    255250 
    256       DO ji = kideb, kiut           ! snow initialization 
     251      DO ji = 1, nidx           ! snow initialization 
    257252         zradtr_s(ji,0) = zftrice(ji)     ! radiation penetrating through snow 
    258253      END DO 
    259254 
    260255      DO jk = 1, nlay_s          ! Radiation through snow 
    261          DO ji = kideb, kiut 
     256         DO ji = 1, nidx 
    262257            !                             ! radiation transmitted below the layer-th snow layer 
    263258            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,jk) ) ) ) 
    … …  
    267262      END DO 
    268263 
    269       DO ji = kideb, kiut           ! ice initialization 
     264      DO ji = 1, nidx           ! ice initialization 
    270265         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) ) 
    271266      END DO 
    272267 
    273268      DO jk = 1, nlay_i          ! Radiation through ice 
    274          DO ji = kideb, kiut 
     269         DO ji = 1, nidx 
    275270            !                             ! radiation transmitted below the layer-th ice layer 
    276271            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) ) 
    … …  
    280275      END DO 
    281276 
    282       DO ji = kideb, kiut           ! Radiation transmitted below the ice 
     277      DO ji = 1, nidx           ! Radiation transmitted below the ice 
    283278         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i)  
    284279      END DO 
    … …  
    288283      !------------------------------------------------------------------------------| 
    289284      ! 
    290       DO ji = kideb, kiut        ! Old surface temperature 
     285      DO ji = 1, nidx        ! Old surface temperature 
    291286         ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr. 
    292287         ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter 
    … …  
    296291 
    297292      DO jk = 1, nlay_s       ! Old snow temperature 
    298          DO ji = kideb , kiut 
     293         DO ji = 1 , nidx 
    299294            ztsb(ji,jk) =  t_s_1d(ji,jk) 
    300295         END DO 
    … …  
    302297 
    303298      DO jk = 1, nlay_i       ! Old ice temperature 
    304          DO ji = kideb , kiut 
     299         DO ji = 1 , nidx 
    305300            ztib(ji,jk) =  t_i_1d(ji,jk) 
    306301         END DO 
    … …  
    319314         ! 
    320315         IF( nn_ice_thcon == 0 ) THEN      ! Untersteiner (1964) formula 
    321             DO ji = kideb , kiut 
     316            DO ji = 1 , nidx 
    322317               ztcond_i(ji,0) = rcdic + zbeta * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 ) 
    323318               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 
    324319            END DO 
    325320            DO jk = 1, nlay_i-1 
    326                DO ji = kideb , kiut 
     321               DO ji = 1 , nidx 
    327322                  ztcond_i(ji,jk) = rcdic + zbeta * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  & 
    328323                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0_wp * rt0) 
    … …  
    333328 
    334329         IF( nn_ice_thcon == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 
    335             DO ji = kideb , kiut 
     330            DO ji = 1 , nidx 
    336331               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1) - rt0 )   & 
    337332                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rt0 )   
    … …  
    339334            END DO 
    340335            DO jk = 1, nlay_i-1 
    341                DO ji = kideb , kiut 
     336               DO ji = 1 , nidx 
    342337                  ztcond_i(ji,jk) = rcdic +                                                                       &  
    343338                     &                 0.09_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                              & 
    … …  
    347342               END DO 
    348343            END DO 
    349             DO ji = kideb , kiut 
     344            DO ji = 1 , nidx 
    350345               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji) - rt0 )   & 
    351346                  &                        - 0.011_wp * ( t_bo_1d(ji) - rt0 )   
    … …  
    372367            zh_thres = EXP( 1._wp ) * zepsilon * 0.5_wp 
    373368 
    374             DO ji = kideb, kiut 
     369            DO ji = 1, nidx 
    375370    
    376371               ! Mean sea ice thermal conductivity 
    … …  
    400395         ! 
    401396         !--- Snow 
    402          DO ji = kideb, kiut 
     397         DO ji = 1, nidx 
    403398            zfac                  =  1. / MAX( epsi10 , zh_s(ji) ) 
    404399            zkappa_s(ji,0)        = zghe(ji) * rn_cdsn * zfac 
    … …  
    407402 
    408403         DO jk = 1, nlay_s-1 
    409             DO ji = kideb , kiut 
     404            DO ji = 1 , nidx 
    410405               zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rn_cdsn / MAX( epsi10, 2.0 * zh_s(ji) ) 
    411406            END DO 
    … …  
    414409         !--- Ice 
    415410         DO jk = 1, nlay_i-1 
    416             DO ji = kideb , kiut 
     411            DO ji = 1 , nidx 
    417412               zkappa_i(ji,jk)    = zghe(ji) * 2.0 * ztcond_i(ji,jk) / MAX( epsi10 , 2.0 * zh_i(ji) ) 
    418413            END DO 
    … …  
    420415 
    421416         !--- Snow-ice interface 
    422          DO ji = kideb , kiut 
     417         DO ji = 1 , nidx 
    423418            zfac                  = 1./ MAX( epsi10 , zh_i(ji) ) 
    424419            zkappa_i(ji,0)        = zghe(ji) * ztcond_i(ji,0) * zfac 
    … …  
    435430         ! 
    436431         DO jk = 1, nlay_i 
    437             DO ji = kideb , kiut 
     432            DO ji = 1 , nidx 
    438433               ztitemp(ji,jk)   = t_i_1d(ji,jk) 
    439434               zspeche_i(ji,jk) = cpic + zgamma * s_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztib(ji,jk) - rt0 ), epsi10 ) 
    … …  
    443438 
    444439         DO jk = 1, nlay_s 
    445             DO ji = kideb , kiut 
     440            DO ji = 1 , nidx 
    446441               ztstemp(ji,jk) = t_s_1d(ji,jk) 
    447442               zeta_s(ji,jk)  = rdt_ice / MAX( rhosn * cpic * zh_s(ji), epsi10 ) 
    … …  
    455450         ! 
    456451         IF ( ln_dqnsice ) THEN  
    457             DO ji = kideb , kiut 
     452            DO ji = 1 , nidx 
    458453               ! update of the non solar flux according to the update in T_su 
    459454               qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) ) 
    … …  
    462457 
    463458         ! Update incoming flux 
    464          DO ji = kideb , kiut 
     459         DO ji = 1 , nidx 
    465460            ! update incoming flux 
    466461            zf(ji)    =          zfsw(ji)              & ! net absorbed solar radiation 
    … …  
    481476 
    482477         DO numeq=1,nlay_i+3 
    483             DO ji = kideb , kiut 
     478            DO ji = 1 , nidx 
    484479               ztrid(ji,numeq,1) = 0. 
    485480               ztrid(ji,numeq,2) = 0. 
    … …  
    492487 
    493488         DO numeq = nlay_s + 2, nlay_s + nlay_i  
    494             DO ji = kideb , kiut 
     489            DO ji = 1 , nidx 
    495490               jk                 = numeq - nlay_s - 1 
    496491               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk) * zkappa_i(ji,jk-1) 
    … …  
    502497 
    503498         numeq =  nlay_s + nlay_i + 1 
    504          DO ji = kideb , kiut 
     499         DO ji = 1 , nidx 
    505500            !!ice bottom term 
    506501            ztrid(ji,numeq,1)  =  - zeta_i(ji,nlay_i)*zkappa_i(ji,nlay_i-1)    
    … …  
    512507 
    513508 
    514          DO ji = kideb , kiut 
     509         DO ji = 1 , nidx 
    515510            IF ( ht_s_1d(ji) > 0.0 ) THEN 
    516511               ! 
    … …  
    659654         minnumeqmin = nlay_i+5 
    660655 
    661          DO ji = kideb , kiut 
     656         DO ji = 1 , nidx 
    662657            zindtbis(ji,numeqmin(ji)) =  zindterm(ji,numeqmin(ji)) 
    663658            zdiagbis(ji,numeqmin(ji)) =  ztrid(ji,numeqmin(ji),2) 
    … …  
    667662 
    668663         DO jk = minnumeqmin+1, maxnumeqmax 
    669             DO ji = kideb , kiut 
     664            DO ji = 1 , nidx 
    670665               numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji)) 
    671666               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2)  - ztrid(ji,numeq,1) * ztrid(ji,numeq-1,3)  / zdiagbis(ji,numeq-1) 
    … …  
    674669         END DO 
    675670 
    676          DO ji = kideb , kiut 
     671         DO ji = 1 , nidx 
    677672            ! ice temperatures 
    678673            t_i_1d(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji)) / zdiagbis(ji,numeqmax(ji)) 
    … …  
    680675 
    681676         DO numeq = nlay_i + nlay_s, nlay_s + 2, -1 
    682             DO ji = kideb , kiut 
     677            DO ji = 1 , nidx 
    683678               jk    =  numeq - nlay_s - 1 
    684679               t_i_1d(ji,jk)  =  ( zindtbis(ji,numeq) - ztrid(ji,numeq,3) * t_i_1d(ji,jk+1) ) / zdiagbis(ji,numeq) 
    … …  
    686681         END DO 
    687682 
    688          DO ji = kideb , kiut 
     683         DO ji = 1 , nidx 
    689684            ! snow temperatures       
    690685            IF (ht_s_1d(ji) > 0._wp) & 
    … …  
    706701         ! check that nowhere it has started to melt 
    707702         ! zdti(ji) is a measure of error, it has to be under zdti_bnd 
    708          DO ji = kideb , kiut 
     703         DO ji = 1 , nidx 
    709704            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , rt0 ) , 190._wp  ) 
    710705            zdti   (ji) =  ABS( t_su_1d(ji) - ztsubit(ji) )      
    … …  
    712707 
    713708         DO jk  =  1, nlay_s 
    714             DO ji = kideb , kiut 
     709            DO ji = 1 , nidx 
    715710               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rt0 ), 190._wp  ) 
    716711               zdti  (ji)    = MAX( zdti(ji), ABS( t_s_1d(ji,jk) - ztstemp(ji,jk) ) ) 
    … …  
    719714 
    720715         DO jk  =  1, nlay_i 
    721             DO ji = kideb , kiut 
     716            DO ji = 1 , nidx 
    722717               ztmelt_i      = -tmut * s_i_1d(ji,jk) + rt0  
    723718               t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelt_i ), 190._wp ) 
    … …  
    729724         ! note that this could be optimized substantially by iterating only the non-converging points 
    730725         zdti_max = 0._wp 
    731          DO ji = kideb, kiut 
     726         DO ji = 1, nidx 
    732727            zdti_max = MAX( zdti_max, zdti(ji) )    
    733728         END DO 
    … …  
    738733      ! MV SIMIP 2016 
    739734      !--- Snow-ice interfacial temperature (diagnostic SIMIP) 
    740       DO ji = kideb, kiut 
     735      DO ji = 1, nidx 
    741736         zfac        = 1. / MAX( epsi10 , rn_cdsn * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji) ) 
    742737         t_si_1d(ji) = ( rn_cdsn        * zh_i(ji) * t_s_1d(ji,1) + & 
    … …  
    755750      !   12) Fluxes at the interfaces                                          ! 
    756751      !-------------------------------------------------------------------------! 
    757       DO ji = kideb, kiut 
     752      DO ji = 1, nidx 
    758753         !                                ! surface ice conduction flux 
    759754         isnow(ji)       = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) 
    … …  
    771766 
    772767      ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 
    773       CALL lim_thd_enmelt( kideb, kiut ) 
     768      CALL lim_thd_enmelt 
    774769 
    775770      ! --- diagnose the change in non-solar flux due to surface temperature change --- ! 
    776771      IF ( ln_dqnsice ) THEN 
    777          DO ji = kideb, kiut 
     772         DO ji = 1, nidx 
    778773            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji)  - zqns_ice_b(ji) ) * a_i_1d(ji)  
    779774         END DO 
    … …  
    781776 
    782777      ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 
    783       DO ji = kideb, kiut 
     778      DO ji = 1, nidx 
    784779         zdq(ji)        = - zq_ini(ji) + ( SUM( e_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) * r1_nlay_i +  & 
    785780            &                              SUM( e_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) * r1_nlay_s ) 
    … …  
    798793      ! Heat flux used to warm/cool ice in W.m-2 
    799794      !----------------------------------------- 
    800       DO ji = kideb, kiut 
     795      DO ji = 1, nidx 
    801796         IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC 
    802797            hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   & 
    … …  
    821816   END SUBROUTINE lim_thd_dif 
    822817 
    823    SUBROUTINE lim_thd_enmelt( kideb, kiut ) 
     818   SUBROUTINE lim_thd_enmelt 
    824819      !!----------------------------------------------------------------------- 
    825820      !!                   ***  ROUTINE lim_thd_enmelt ***  
    … …  
    829824      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
    830825      !!------------------------------------------------------------------- 
    831       INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
    832       ! 
    833826      INTEGER  ::   ji, jk   ! dummy loop indices 
    834827      REAL(wp) ::   ztmelts  ! local scalar  
    … …  
    836829      ! 
    837830      DO jk = 1, nlay_i             ! Sea ice energy of melting 
    838          DO ji = kideb, kiut 
     831         DO ji = 1, nidx 
    839832            ztmelts      = - tmut  * s_i_1d(ji,jk) + rt0 
    840833            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point 
    … …  
    846839      END DO 
    847840      DO jk = 1, nlay_s             ! Snow energy of melting 
    848          DO ji = kideb, kiut 
     841         DO ji = 1, nidx 
    849842            e_s_1d(ji,jk) = rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) 
    850843         END DO 

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

    r8325 r8342  
    4343CONTAINS 
    4444  
    45    SUBROUTINE lim_thd_ent( kideb, kiut, qnew ) 
     45   SUBROUTINE lim_thd_ent( qnew ) 
    4646      !!------------------------------------------------------------------- 
    4747      !!               ***   ROUTINE lim_thd_ent  *** 
    … …  
    6868      !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 
    6969      !!------------------------------------------------------------------- 
    70       INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    71  
    7270      REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew          ! new enthlapies (J.m-3, remapped) 
    7371 
    … …  
    9088      zh_cum0 (:,0:nlay_i+2) = 0._wp 
    9189      DO jk0 = 1, nlay_i+2 
    92          DO ji = kideb, kiut 
     90         DO ji = 1, nidx 
    9391            zeh_cum0(ji,jk0) = zeh_cum0(ji,jk0-1) + eh_i_old(ji,jk0-1) 
    9492            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1) 
    … …  
    10098      !------------------------------------ 
    10199      ! new layer thickesses 
    102       DO ji = kideb, kiut 
     100      DO ji = 1, nidx 
    103101         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) * r1_nlay_i   
    104102      ENDDO 
    … …  
    107105      zh_cum1(:,0:nlay_i) = 0._wp 
    108106      DO jk1 = 1, nlay_i 
    109          DO ji = kideb, kiut 
     107         DO ji = 1, nidx 
    110108            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji) 
    111109         ENDDO 
    … …  
    116114      DO jk0 = 1, nlay_i+1 
    117115         DO jk1 = 1, nlay_i-1 
    118             DO ji = kideb, kiut 
     116            DO ji = 1, nidx 
    119117               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 
    120118                  zeh_cum1(ji,jk1) = ( zeh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  & 
    … …  
    130128      ! new enthalpies 
    131129      DO jk1 = 1, nlay_i 
    132          DO ji = kideb, kiut 
     130         DO ji = 1, nidx 
    133131            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )  
    134132            qnew(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) 
    … …  
    139137      ! comment: if input h_i_old and eh_i_old are already multiplied by a_i (as in limthd_lac),  
    140138      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 
    141       DO ji = kideb, kiut 
     139      DO ji = 1, nidx 
    142140         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  & 
    143141            &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) )  

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r8332 r8342  
    7171      !!------------------------------------------------------------------------ 
    7272      INTEGER  ::   ji,jj,jk,jl      ! dummy loop indices 
    73       INTEGER  ::   nidx            ! local integers  
    7473      INTEGER  ::   iter     !   -       - 
    7574      REAL(wp) ::   ztmelts, zdv, zfrazb, zweight, zde                          ! local scalars 
    … …  
    256255      IF ( nidx > 0 ) THEN 
    257256 
    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) ) 
     257         CALL tab_2d_1d( nidx, idxice(1:nidx), zat_i_1d  (1:nidx)     , at_i          ) 
     258         DO jl = 1, jpl 
     259            CALL tab_2d_1d( nidx, idxice(1:nidx), za_i_1d  (1:nidx,jl), a_i  (:,:,jl) ) 
     260            CALL tab_2d_1d( nidx, idxice(1:nidx), zv_i_1d  (1:nidx,jl), v_i  (:,:,jl) ) 
     261            CALL tab_2d_1d( nidx, idxice(1:nidx), zsmv_i_1d(1:nidx,jl), smv_i(:,:,jl) ) 
    263262            DO jk = 1, nlay_i 
    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) ) 
     263               CALL tab_2d_1d( nidx, idxice(1:nidx), ze_i_1d(1:nidx,jk,jl), e_i(:,:,jk,jl)  ) 
     264            END DO 
     265         END DO 
     266 
     267         CALL tab_2d_1d( nidx, idxice(1:nidx), qlead_1d  (1:nidx)     , qlead      ) 
     268         CALL tab_2d_1d( nidx, idxice(1:nidx), t_bo_1d   (1:nidx)     , t_bo        ) 
     269         CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_opw_1d(1:nidx)     , sfx_opw    ) 
     270         CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_opw_1d(1:nidx)     , wfx_opw    ) 
     271         CALL tab_2d_1d( nidx, idxice(1:nidx), hicol_1d  (1:nidx)     , hicol      ) 
     272         CALL tab_2d_1d( nidx, idxice(1:nidx), zvrel_1d  (1:nidx)     , zvrel      ) 
     273 
     274         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx)     , hfx_thd    ) 
     275         CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_opw_1d(1:nidx)     , hfx_opw    ) 
     276         CALL tab_2d_1d( nidx, idxice(1:nidx), rn_amax_1d(1:nidx)     , rn_amax_2d ) 
     277         CALL tab_2d_1d( nidx, idxice(1:nidx), sss_1d    (1:nidx)     , sss_m      ) 
    279278 
    280279         !------------------------------------------------------------------------------| 
    … …  
    457456            ENDDO 
    458457            ! --- Ice enthalpy remapping --- ! 
    459             CALL lim_thd_ent( 1, nidx, ze_i_1d(1:nidx,:,jl) )  
     458            CALL lim_thd_ent( ze_i_1d(1:nidx,:,jl) )  
    460459         ENDDO 
    461460 
    … …  
    484483         !------------------------------------------------------------------------------! 
    485484         DO jl = 1, jpl 
    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 ) 
     485            CALL tab_1d_2d( nidx, idxice(1:nidx), za_i_1d (1:nidx,jl), a_i (:,:,jl) ) 
     486            CALL tab_1d_2d( nidx, idxice(1:nidx), zv_i_1d (1:nidx,jl), v_i (:,:,jl) ) 
     487            CALL tab_1d_2d( nidx, idxice(1:nidx), zsmv_i_1d(1:nidx,jl), smv_i (:,:,jl)  ) 
    489488            DO jk = 1, nlay_i 
    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 ) 
     489               CALL tab_1d_2d( nidx, idxice(1:nidx), ze_i_1d(1:nidx,jk,jl), e_i(:,:,jk,jl) ) 
     490            END DO 
     491         END DO 
     492         CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_opw_1d(1:nidx), sfx_opw ) 
     493         CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_opw_1d(1:nidx), wfx_opw ) 
     494         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx), hfx_thd ) 
     495         CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_opw_1d(1:nidx), hfx_opw ) 
    497496         ! 
    498497      ENDIF ! nidx > 0 

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r8326 r8342  
    3737CONTAINS 
    3838 
    39    SUBROUTINE lim_thd_sal( kideb, kiut ) 
     39   SUBROUTINE lim_thd_sal 
    4040      !!------------------------------------------------------------------- 
    4141      !!                ***  ROUTINE lim_thd_sal  ***     
    … …  
    4848      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice] 
    4949      !!--------------------------------------------------------------------- 
    50       INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index 
    51       ! 
    5250      INTEGER  ::   ji, jk                       ! dummy loop indices  
    5351      REAL(wp) ::   iflush, igravdr              ! local scalars 
    … …  
    6563      IF(  nn_icesal == 2  ) THEN 
    6664 
    67          DO ji = kideb, kiut 
     65         DO ji = 1, nidx 
    6866 
    6967            !--------------------------------------------------------- 
    … …  
    9694 
    9795         ! Salinity profile 
    98          CALL lim_var_salprof1d( kideb, kiut ) 
     96         CALL lim_var_salprof1d 
    9997         ! 
    10098      ENDIF  
    … …  
    103101      !  3) vertical profile of salinity, constant in time                           | 
    104102      !------------------------------------------------------------------------------| 
    105       IF(  nn_icesal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
     103      IF(  nn_icesal == 3  )   CALL lim_var_salprof1d 
    106104 
    107105      ! 

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r8341 r8342  
    433433 
    434434 
    435    SUBROUTINE lim_var_salprof1d( kideb, kiut ) 
     435   SUBROUTINE lim_var_salprof1d 
    436436      !!------------------------------------------------------------------- 
    437437      !!                  ***  ROUTINE lim_thd_salprof1d  *** 
    … …  
    440440      !!                Works with 1d vectors and is used by thermodynamic modules 
    441441      !!------------------------------------------------------------------- 
    442       INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index 
    443       ! 
    444442      INTEGER  ::   ji, jk    ! dummy loop indices 
    445443      INTEGER  ::   ii, ij    ! local integers 
    … …  
    465463      IF(  nn_icesal == 2  ) THEN 
    466464         ! 
    467          DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
     465         DO ji = 1, nidx          ! Slope of the linear profile zs_zero 
    468466            rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 
    469467            z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) ) 
    … …  
    475473         zfac1 = zsi1 / ( zsi1 - zsi0 ) 
    476474         DO jk = 1, nlay_i 
    477             DO ji = kideb, kiut 
     475            DO ji = 1, nidx 
    478476               ii =  MOD( idxice(ji) - 1 , jpi ) + 1 
    479477               ij =     ( idxice(ji) - 1 ) / jpi + 1 
    … …  
    509507            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    510508            zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) ) 
    511             DO ji = kideb, kiut 
     509            DO ji = 1, nidx 
    512510               s_i_1d(ji,jk) = zsal 
    513511            END DO 

  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r8341 r8342  
    2727 
    2828   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   idxice !: selected points for ice thermo 
     29   INTEGER , PUBLIC                                  ::   nidx   !  number of selected points 
    2930 
    3031   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      
Note: See TracChangeset for help on using the changeset viewer.