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

Ignore:
Timestamp:
2017-07-10T16:56:45+02:00 (7 years ago)
Author:
clem
Message:

STEP2 (1): remove obsolete features (ice diffusion)

Location:
branches/2017/dev_r8183_ICEMODEL/NEMOGCM
Files:
2 deleted
7 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg

    r7823 r8312  
    66!!              4 - Ice discretization                 (namiceitd) 
    77!!              5 - Ice dynamics and transport         (namicedyn) 
    8 !!              6 - Ice diffusion                      (namicehdf) 
    9 !!              7 - Ice thermodynamics                 (namicethd) 
    10 !!              8 - Ice salinity                       (namicesal) 
    11 !!              9 - Ice mechanical redistribution      (namiceitdme) 
     8!!              6 - Ice thermodynamics                 (namicethd) 
     9!!              7 - Ice salinity                       (namicesal) 
     10!!              8 - Ice mechanical redistribution      (namiceitdme) 
    1211!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    1312!------------------------------------------------------------------------------ 
     
    3231/ 
    3332!------------------------------------------------------------------------------ 
    34 &namicehdf     !   Ice horizontal diffusion 
    35 !------------------------------------------------------------------------------ 
    36 / 
    37 !------------------------------------------------------------------------------ 
    3833&namicethd     !   Ice thermodynamics 
    3934!------------------------------------------------------------------------------ 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg

    r7404 r8312  
    66!!              4 - Ice discretization                 (namiceitd) 
    77!!              5 - Ice dynamics and transport         (namicedyn) 
    8 !!              6 - Ice diffusion                      (namicehdf) 
    9 !!              7 - Ice thermodynamics                 (namicethd) 
    10 !!              8 - Ice salinity                       (namicesal) 
    11 !!              9 - Ice mechanical redistribution      (namiceitdme) 
     8!!              6 - Ice thermodynamics                 (namicethd) 
     9!!              7 - Ice salinity                       (namicesal) 
     10!!              8 - Ice mechanical redistribution      (namiceitdme) 
    1211!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    1312!------------------------------------------------------------------------------ 
     
    3231/ 
    3332!------------------------------------------------------------------------------ 
    34 &namicehdf     !   Ice horizontal diffusion 
    35 !------------------------------------------------------------------------------ 
    36 / 
    37 !------------------------------------------------------------------------------ 
    3833&namicethd     !   Ice thermodynamics 
    3934!------------------------------------------------------------------------------ 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r8294 r8312  
    66!!              4 - Ice discretization                 (namiceitd) 
    77!!              5 - Ice dynamics and transport         (namicedyn) 
    8 !!              6 - Ice diffusion                      (namicehdf) 
    9 !!              7 - Ice thermodynamics                 (namicethd) 
    10 !!              8 - Ice salinity                       (namicesal) 
    11 !!              9 - Ice mechanical redistribution      (namiceitdme) 
     8!!              6 - Ice thermodynamics                 (namicethd) 
     9!!              7 - Ice salinity                       (namicesal) 
     10!!              8 - Ice mechanical redistribution      (namiceitdme) 
    1211!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    1312! 
     
    107106/ 
    108107!------------------------------------------------------------------------------ 
    109 &namicehdf     !   Ice horizontal diffusion 
    110 !------------------------------------------------------------------------------ 
    111                      ! -- limhdf -- ! 
    112    nn_ahi0        =    -1           !  horizontal diffusivity computation 
    113                                     !    -1: no diffusion (bypass limhdf) 
    114                                     !     0: use rn_ahi0_ref 
    115                                     !     1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length ) 
    116                                     !     2: use rn_ahi0_ref x grid cell length      / ( 2deg mean grid cell length ) 
    117    rn_ahi0_ref    = 350.0           !  horizontal sea ice diffusivity (m2/s)  
    118                                     !     if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution 
    119 / 
    120 !------------------------------------------------------------------------------ 
    121108&namicethd     !   Ice thermodynamics 
    122109!------------------------------------------------------------------------------ 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg

    r7820 r8312  
    66!!              4 - Ice discretization                 (namiceitd) 
    77!!              5 - Ice dynamics and transport         (namicedyn) 
    8 !!              6 - Ice diffusion                      (namicehdf) 
    9 !!              7 - Ice thermodynamics                 (namicethd) 
    10 !!              8 - Ice salinity                       (namicesal) 
    11 !!              9 - Ice mechanical redistribution      (namiceitdme) 
     8!!              6 - Ice thermodynamics                 (namicethd) 
     9!!              7 - Ice salinity                       (namicesal) 
     10!!              8 - Ice mechanical redistribution      (namiceitdme) 
    1211!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    1312! 
     
    5655/ 
    5756!------------------------------------------------------------------------------ 
    58 &namicehdf     !   Ice horizontal diffusion 
    59 !------------------------------------------------------------------------------ 
    60 / 
    61 !------------------------------------------------------------------------------ 
    6257&namicethd     !   Ice thermodynamics 
    6358!------------------------------------------------------------------------------ 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r8291 r8312  
    220220   REAL(wp), PUBLIC ::   rn_lfrelax       !: relaxation time scale (s-1) to reach static friction (landfast ice)  
    221221 
    222    !                                     !!** ice-diffusion namelist (namicehdf) ** 
    223    INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 
    224    REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    225  
    226222   !                                     !!** ice-thermodynamics namelist (namicethd) ** 
    227223                                          ! -- limthd_dif -- ! 
     
    306302   !                                     !!** define arrays 
    307303   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce !: surface ocean velocity used in ice dynamics 
    308    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 
    309304   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicol       !: ice collection thickness accreted in leads 
    310305   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength 
     
    384379   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
    385380   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice        !: transmitted solar radiation under ice 
    386    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points 
    387381 
    388382   !!-------------------------------------------------------------------------- 
     
    535529      ! stay within Fortran's max-line length limit. 
    536530      ii = 1 
    537       ALLOCATE( u_oce   (jpi,jpj) , v_oce    (jpi,jpj) ,                                             & 
    538          &      ahiu    (jpi,jpj) , ahiv     (jpi,jpj) , hicol    (jpi,jpj) ,                        & 
     531      ALLOCATE( u_oce   (jpi,jpj) , v_oce    (jpi,jpj) , hicol    (jpi,jpj) ,                        & 
    539532         &      strength(jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,  & 
    540533         &      delta_i (jpi,jpj) , divu_i   (jpi,jpj) , shear_i  (jpi,jpj) , STAT=ierr(ii) ) 
     
    561554      ! * Ice global state variables 
    562555      ii = ii + 1 
    563       ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl+1) , pahv3D(jpi,jpj,jpl+1) , & 
     556      ALLOCATE( ftr_ice(jpi,jpj,jpl) ,                                                 & 
    564557         &      ht_i   (jpi,jpj,jpl) , a_i   (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,     & 
    565558         &      v_s    (jpi,jpj,jpl) , ht_s  (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,     & 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r8234 r8312  
    1818   USE sbc_oce        ! ocean surface boundary condition 
    1919   USE ice            ! ice variables 
    20    USE limhdf         ! ice horizontal diffusion 
    2120   USE limvar         !  
    2221   USE limadv_prather ! advection scheme (Prather) 
     
    6564      INTEGER, INTENT(in) ::   kt   ! number of iteration 
    6665      ! 
    67       INTEGER  ::   ji, jj, jk, jm, jl, jt  ! dummy loop indices 
     66      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices 
    6867      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    6968      REAL(wp) ::   zcfl , zusnit           !   -      - 
     
    7473      REAL(wp), POINTER, DIMENSION(:,:)      ::   zatold, zeiold, zesold, zsmvold  
    7574      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhimax, zviold, zvsold 
    76       ! --- diffusion --- ! 
    77       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zhdfptab 
    78       ! MV MP 2016 
    79       ! With melt ponds, we have to diffuse them 
    80       ! We hard code the number of variables to diffuse 
    81       ! since we can't put an IF ( nn_pnd_scheme ) for a declaration 
    82       ! ideally, the ihdf_vars should probably be passed as an argument and 
    83       ! defined somewhere depending on nn_pnd_scheme 
    84       ! END MV MP 2016 
    85       INTEGER , PARAMETER                    ::   ihdf_vars  = 8 ! Number of variables in which we apply horizontal diffusion 
    86                                                                  !  inside limtrp for each ice category , not counting the  
    87                                                                  !  variables corresponding to ice_layers  
    8875      ! --- ultimate macho only --- ! 
    8976      REAL(wp)                               ::   zdt 
     
    10491      CALL wrk_alloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold ) 
    10592      CALL wrk_alloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold ) 
    106       CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 
    10793  
    10894      IF( kt == nit000 .AND. lwp ) THEN 
     
    417403      END SELECT 
    418404       
    419       !------------------------------! 
    420       ! Diffusion of Ice fields                   
    421       !------------------------------! 
    422       IF( nn_ahi0 /= -1 .AND. nn_limdyn == 2 ) THEN 
    423          ! 
    424          ! --- Prepare diffusion for variables with categories --- ! 
    425          !     mask eddy diffusivity coefficient at ocean U- and V-points 
    426          jm=1 
    427          DO jl = 1, jpl 
    428             DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    429                DO ji = 1 , fs_jpim1 
    430                   pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji  ,jj,  jl ) ) ) )   & 
    431                   &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,  jl ) ) ) ) * ahiu(ji,jj) 
    432                   pahv3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,  jj,  jl ) ) ) )   & 
    433                   &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,  jj+1,jl ) ) ) ) * ahiv(ji,jj) 
    434                END DO 
    435             END DO 
    436  
    437             zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1 
    438             zhdfptab(:,:,jm)= v_i  (:,:,  jl); jm = jm + 1 
    439             zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1 
    440             zhdfptab(:,:,jm)= smv_i(:,:,  jl); jm = jm + 1 
    441             zhdfptab(:,:,jm)= oa_i (:,:,  jl); jm = jm + 1 
    442             zhdfptab(:,:,jm)= e_s  (:,:,1,jl); jm = jm + 1 
    443             ! MV MP 2016 
    444             IF ( nn_pnd_scheme > 0 ) THEN 
    445                zhdfptab(:,:,jm)= a_ip  (:,:,  jl); jm = jm + 1 
    446                zhdfptab(:,:,jm)= v_ip  (:,:,  jl); jm = jm + 1 
    447             ENDIF 
    448             ! END MV MP 2016 
    449             ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 
    450             !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1   
    451             !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1  
    452             DO jk = 1, nlay_i 
    453               zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 
    454             END DO 
    455          END DO 
    456  
    457          ! --- Prepare diffusion for open water area --- ! 
    458          !     mask eddy diffusivity coefficient at ocean U- and V-points 
    459          DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    460             DO ji = 1 , fs_jpim1 
    461                pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji  ,jj) ) ) )   & 
    462                   &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    463                pahv3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj  ) ) ) )   & 
    464                   &                * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 
    465             END DO 
    466          END DO 
    467          ! 
    468          zhdfptab(:,:,jm)= ato_i  (:,:); 
    469  
    470          ! --- Apply diffusion --- ! 
    471          CALL lim_hdf( zhdfptab, ihdf_vars ) 
    472  
    473          ! --- Recover properties --- ! 
    474          jm=1 
    475          DO jl = 1, jpl 
    476             a_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
    477             v_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
    478             v_s  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
    479             smv_i(:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
    480             oa_i (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
    481             e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 
    482             ! MV MP 2016 
    483             IF ( nn_pnd_scheme > 0 ) THEN 
    484                a_ip (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
    485                v_ip (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
    486             ENDIF 
    487             ! Sample of adding more variables to apply lim_hdf 
    488             !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1  
    489             !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
    490             DO jk = 1, nlay_i 
    491                e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 
    492             END DO 
    493          END DO 
    494          ato_i  (:,:) = zhdfptab(:,:,jm) 
    495                
    496       ENDIF 
    497  
    498405      ! --- diags --- 
    499406      DO jj = 1, jpj 
     
    618525      CALL wrk_dealloc( jpi,jpj,                            zatold, zeiold, zesold, zsmvold ) 
    619526      CALL wrk_dealloc( jpi,jpj,jpl,                        zhimax, zviold, zvsold ) 
    620       CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1, zhdfptab) 
    621527      ! 
    622528      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r8291 r8312  
    3737   USE limdyn          ! Ice dynamics 
    3838   USE limtrp          ! Ice transport 
    39    USE limhdf          ! Ice horizontal diffusion 
    4039   USE limthd          ! Ice thermodynamics 
    4140   USE limitd_me       ! Mechanics on ice thickness distribution 
     
    317316      ! 
    318317      CALL lim_itd_init                ! ice thickness distribution initialization 
    319       ! 
    320       CALL lim_hdf_init                ! set ice horizontal diffusion computation parameters 
    321318      ! 
    322319      CALL lim_thd_init                ! set ice thermodynics parameters 
Note: See TracChangeset for help on using the changeset viewer.