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 8752 for branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90 – NEMO

Ignore:
Timestamp:
2017-11-20T13:54:32+01:00 (6 years ago)
Author:
dancopsey
Message:

Merged in main ICEMODEL branch (branches/2017/dev_r8183_ICEMODEL) from revision 8587 to 8726.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/iceitd.F90

    r8738 r8752  
    3636   PUBLIC   ice_itd_reb   ! called in icecor 
    3737 
     38   INTEGER ::              nice_catbnd   ! choice of the type of ice category function 
     39   !                                       ! associated indices: 
     40   INTEGER, PARAMETER ::   np_cathfn = 1   ! categories defined by a function 
     41   INTEGER, PARAMETER ::   np_catusr = 2   ! categories defined by the user 
     42   ! 
    3843   ! ** namelist (namitd) ** 
     44   LOGICAL  ::   ln_cat_hfn  ! ice categories are defined by function like rn_himean**(-0.05) 
    3945   REAL(wp) ::   rn_himean   ! mean thickness of the domain 
    40  
     46   LOGICAL  ::   ln_cat_usr  ! ice categories are defined by rn_catbnd 
     47   REAL(wp), DIMENSION(0:100) ::   rn_catbnd   ! ice categories bounds 
     48   ! 
    4149   !!---------------------------------------------------------------------- 
    4250   !! NEMO/ICE 4.0 , NEMO Consortium (2017) 
     
    293301            IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 
    294302               a_i_1d (ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin  
    295                ! MV MP 2016 
    296                IF ( nn_pnd_scheme > 0 ) THEN 
    297                   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
    298                ENDIF 
    299                ! END MV MP 2016 
     303               IF ( ln_pnd_H12 )    a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
    300304               h_i_1d(ji) = rn_himin 
    301305            ENDIF 
     
    457461               zaTsfn(ji,jl2)  = zaTsfn(ji,jl2) + ztrans 
    458462               !   
    459                ! MV MP 2016  
    460                IF ( nn_pnd_scheme > 0 ) THEN 
     463               IF ( ln_pnd_H12 ) THEN 
    461464                  !                                                  ! Pond fraction 
    462465                  ztrans          = a_ip_2d(ji,jl1) * pdaice(ji,jl) !!clem: should be * zworka(ji) but it does not work 
     
    468471                  v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 
    469472               ENDIF 
    470                ! END MV MP 2016 
    471473               ! 
    472474            ENDIF   ! jl1 >0 
     
    643645      !! ** input   :   Namelist namitd 
    644646      !!------------------------------------------------------------------- 
    645       INTEGER  ::   jl    ! dummy loop index 
    646       INTEGER  ::   ios   ! Local integer output status for namelist read 
     647      INTEGER  ::   jl            ! dummy loop index 
     648      INTEGER  ::   ios, ioptio   ! Local integer output status for namelist read 
    647649      REAL(wp) ::   zhmax, znum, zden, zalpha   !   -      - 
    648       !! 
    649       NAMELIST/namitd/ rn_himean, rn_himin 
     650      ! 
     651      NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin 
    650652      !!------------------------------------------------------------------ 
    651653      ! 
     
    664666         WRITE(numout,*) '~~~~~~~~~~~~' 
    665667         WRITE(numout,*) '   Namelist namitd: ' 
    666          WRITE(numout,*) '      mean ice thickness in the domain               rn_himean = ', rn_himean 
    667          WRITE(numout,*) '      minimum ice thickness                          rn_himin  = ', rn_himin  
     668         WRITE(numout,*) '      Ice categories are defined by a function of rn_himean**(-0.05)    ln_cat_hfn = ', ln_cat_hfn 
     669         WRITE(numout,*) '         mean ice thickness in the domain                               rn_himean  = ', rn_himean 
     670         WRITE(numout,*) '      Ice categories are defined by rn_catbnd                           ln_cat_usr = ', ln_cat_usr 
     671         WRITE(numout,*) '         ice categories boundaries (m)                                  rn_catbnd  = ', rn_catbnd  
     672         WRITE(numout,*) '      minimum ice thickness                                             rn_himin   = ', rn_himin  
    668673      ENDIF 
    669674      ! 
     
    671676      !  Thickness categories boundaries  ! 
    672677      !-----------------------------------! 
    673       ! 
    674       zalpha = 0.05_wp              ! max of each category (from h^(-alpha) function) 
    675       zhmax  = 3._wp * rn_himean 
    676       DO jl = 1, jpl 
    677          znum = jpl * ( zhmax+1 )**zalpha 
    678          zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) 
    679          hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 
    680       END DO 
     678      !                             !== set the choice of ice categories ==! 
     679      ioptio = 0  
     680      IF( ln_cat_hfn ) THEN   ;   ioptio = ioptio + 1   ;   nice_catbnd = np_cathfn    ;   ENDIF 
     681      IF( ln_cat_usr ) THEN   ;   ioptio = ioptio + 1   ;   nice_catbnd = np_catusr    ;   ENDIF 
     682      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_itd_init: choose one and only one ice categories boundaries' ) 
     683      ! 
     684      SELECT CASE( nice_catbnd ) 
     685      !                                !------------------------! 
     686      CASE( np_cathfn )                ! h^(-alpha) function 
     687         !                             !------------------------! 
     688         zalpha = 0.05_wp 
     689         zhmax  = 3._wp * rn_himean 
     690         DO jl = 1, jpl 
     691            znum = jpl * ( zhmax+1 )**zalpha 
     692            zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) 
     693            hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 
     694         END DO 
     695         !                             !------------------------! 
     696      CASE( np_catusr )                ! user defined 
     697         !                             !------------------------! 
     698         DO jl = 0, jpl 
     699            hi_max(jl) = rn_catbnd(jl) 
     700         END DO 
     701         ! 
     702      END SELECT 
    681703      ! 
    682704      DO jl = 1, jpl                ! mean thickness by category 
Note: See TracChangeset for help on using the changeset viewer.