Ignore:
Timestamp:
2015-02-02T11:28:50+01:00 (6 years ago)
Author:
vancop
Message:

new itd boundaries, namelist changes, mono-category and comments

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5047 r5048  
    8383      !! 
    8484      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    85       INTEGER  :: nbpb             ! nb of icy pts for thermo. cal. 
     85      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations 
     86      INTEGER  :: nbplm            ! nb of icy pts for lateral melting calculations (mono-cat) 
    8687      INTEGER  :: ii, ij           ! temporary dummy loop index 
    8788      REAL(wp) :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04) 
     
    434435              CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
    435436              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj ) 
     437 
     438            IF ( ( ( nn_monocat .EQ. 1 ) .OR. ( nn_monocat .EQ. 4 ) ) .AND. ( jpl == 1 ) ) THEN 
     439              CALL tab_1d_2d( nbpb, dh_i_melt(:,:,jl) , npb, dh_i_melt_1d(1:nbpb) , jpi, jpj ) 
     440            ENDIF 
    436441            ! 
    437442              CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
     
    471476      !---------------------------------- 
    472477      CALL lim_var_eqv2glo 
     478 
     479      !---------------------------------- 
     480      ! 5.X) Lateral melting 
     481      !---------------------------------- 
     482      !!! declare dh_i_melt (ok), dh_i_melt_1d (ok), nbplm (ok), nplm (ok), zda(ok) 
     483 
     484      IF ( ( ( nn_monocat .EQ. 1 ) .OR. ( nn_monocat .EQ. 4 ) ) .AND. ( jpl == 1 ) ) THEN 
     485 
     486         WRITE(numout,*) ' Lateral melting ON ' 
     487 
     488         ! select points where lateral melting occurs 
     489         jl = 1 
     490 
     491         nbplm = 0 
     492         DO jj = 1, jpj 
     493            DO ji = 1, jpi 
     494               IF ( ( dh_i_melt(ji,jj,jl)                  .LT.-epsi10 ) .AND.    & 
     495     &              ( ht_i(ji,jj,jl) - dh_i_melt(ji,jj,jl) .GT. epsi10 ) .AND.    &  
     496     &              ( ht_i(ji,jj,jl)                       .GT. epsi10 ) ) THEN      
     497                  nbplm   = nbplm  + 1 
     498                  nplm(nbplm) = (jj - 1) * jpi + ji 
     499               ENDIF 
     500            END DO 
     501         END DO 
     502 
     503         IF( nbplm > 0 ) THEN  ! If there is no net melting, do nothing 
     504 
     505            ! Move to 1D arrays 
     506            !------------------------- 
     507 
     508            CALL tab_2d_1d( nbplm, a_i_1d      (1:nbplm), a_i(:,:,jl)       , jpi, jpj, nplm(1:nbplm) ) 
     509            CALL tab_2d_1d( nbplm, ht_i_1d     (1:nbplm), ht_i(:,:,jl)      , jpi, jpj, nplm(1:nbplm) ) 
     510            CALL tab_2d_1d( nbplm, dh_i_melt_1d(1:nbplm), dh_i_melt(:,:,jl) , jpi, jpj, nplm(1:nbplm) ) 
     511 
     512            ! Compute lateral melting (dA = A/2h dh ) 
     513            DO ji = 1, nbplm 
     514               zda        = a_i_1d(ji) * dh_i_melt_1d(ji) / ( 2._wp * ht_i_1d(ji) ) 
     515               a_i_1d(ji) = a_i_1d(ji) + zda 
     516            END DO 
     517 
     518            ! Move back to 2D arrays 
     519            !------------------------- 
     520            CALL tab_1d_2d( nbplm, a_i (:,:,jl)  , nplm, a_i_1d     (1:nbplm)   , jpi, jpj ) 
     521            at_i(:,:) = a_i(:,:,jl) 
     522 
     523         ENDIF 
     524 
     525      ENDIF 
    473526 
    474527      !-------------------------------------------- 
     
    563616      !!------------------------------------------------------------------- 
    564617      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    565       NAMELIST/namicethd/ hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   & 
     618      NAMELIST/namicethd/ hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,    & 
    566619         &                hiclim, parsub, betas,                          &  
    567          &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi 
     620         &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi, & 
     621         &                nn_monocat 
    568622      !!------------------------------------------------------------------- 
    569623      ! 
     
    582636902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 
    583637      IF(lwm) WRITE ( numoni, namicethd ) 
     638      ! 
     639      IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN  
     640         nn_monocat = 0 
     641         WRITE(numout, *) ' nn_monocat must be 0 in multi-category case ' 
     642      ENDIF 
    584643 
    585644      IF( lk_cpl .AND. parsub /= 0.0 )   CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 
     
    597656         WRITE(numout,*)'      switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub   
    598657         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas 
    599          WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i 
     658         WRITE(numout,*)'      extinction radiation parameter in sea ice               kappa_i      = ', kappa_i 
    600659         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nconv_i_thd  = ', nconv_i_thd 
    601660         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd 
    602661         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi 
    603662         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
     663         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
    604664      ENDIF 
    605665      ! 
Note: See TracChangeset for help on using the changeset viewer.