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

Ignore:
Timestamp:
2017-07-10T12:18:03+02:00 (7 years ago)
Author:
clem
Message:

step1: remove LIM2 from the code

Location:
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO
Files:
3 deleted
24 edited

Legend:

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

    r8289 r8306  
    77   !!            3.0  !  2008-03  (M. Vancoppenolle) LIM3 
    88   !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy  
    9    !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas 
     9   !!            3.3  !  2009-05  (G.Garric) addition of the evp cas 
    1010   !!            3.4  !  2011-01  (A. Porter)  dynamical allocation  
    1111   !!            3.5  !  2012-08  (R. Benshila)  AGRIF 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90

    r7646 r8306  
    77   !!            3.6  ! 2016-05  (C. Rousset)   Add LIM3 compatibility 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_agrif && defined key_lim2 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_agrif'                                              AGRIF zoom 
    12    !!---------------------------------------------------------------------- 
    13    USE par_oce      ! ocean parameters 
    14     
    15    IMPLICIT NONE 
    16    PRIVATE  
    17  
    18    PUBLIC agrif_ice_alloc ! routine called by nemo_init in nemogcm.F90 
    19  
    20    INTEGER, PUBLIC :: u_ice_id, v_ice_id, adv_ice_id 
    21    REAL(wp), PUBLIC :: lim_nbstep = 0.    ! child time position in sea-ice model 
    22 #if defined key_lim2_vp 
    23    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)     :: u_ice_nst, v_ice_nst    
    24 #else 
    25    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: u_ice_oe, u_ice_sn     !: boundaries arrays 
    26    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: v_ice_oe, v_ice_sn     !:  "          "  
    27 #endif 
    28    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !:  "          " 
    29  
    30    !!---------------------------------------------------------------------- 
    31    !! NEMO/NST 3.3.4 , NEMO Consortium (2012) 
    32    !! $Id$ 
    33    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    35  
    36 CONTAINS  
    37  
    38    INTEGER FUNCTION agrif_ice_alloc() 
    39       !!---------------------------------------------------------------------- 
    40       !!                ***  FUNCTION agrif_ice_alloc  *** 
    41       !!---------------------------------------------------------------------- 
    42 #if defined key_lim2_vp 
    43       ALLOCATE( u_ice_nst(jpi,jpj), v_ice_nst(jpi,jpj) ,   & 
    44 #else 
    45       ALLOCATE( u_ice_oe(4,jpj,2) , v_ice_oe(4,jpj,2) ,    & 
    46          &      u_ice_sn(jpi,4,2) , v_ice_sn(jpi,4,2) ,    & 
    47 #endif 
    48          &      adv_ice_oe (4,jpj,7,2) , adv_ice_sn (jpi,4,7,2) ,   & 
    49          &      STAT = agrif_ice_alloc) 
    50  
    51 #if ! defined key_lim2_vp 
    52       u_ice_oe(:,:,:) =  0.e0 
    53       v_ice_oe(:,:,:) =  0.e0 
    54       u_ice_sn(:,:,:) =  0.e0 
    55       v_ice_sn(:,:,:) =  0.e0 
    56 #endif 
    57       adv_ice_oe (:,:,:,:) = 0.e0  
    58       adv_ice_sn (:,:,:,:) = 0.e0  
    59       ! 
    60    END FUNCTION agrif_ice_alloc 
    61  
    62 #elif defined key_agrif && defined key_lim3 
     9#if defined key_agrif && defined key_lim3 
    6310   !!---------------------------------------------------------------------- 
    6411   !!   'key_agrif'                                              AGRIF zoom 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r8226 r8306  
    481481END SUBROUTINE agrif_declare_var 
    482482 
    483 #  if defined key_lim2 
    484 SUBROUTINE Agrif_InitValues_cont_lim2 
    485    !!---------------------------------------------------------------------- 
    486    !!                 *** ROUTINE Agrif_InitValues_cont_lim2 *** 
    487    !! 
    488    !! ** Purpose :: Initialisation of variables to be interpolated for LIM2 
    489    !!---------------------------------------------------------------------- 
    490    USE Agrif_Util 
    491    USE ice_2 
    492    USE agrif_ice 
    493    USE in_out_manager 
    494    USE agrif_lim2_update 
    495    USE agrif_lim2_interp 
    496    USE lib_mpp 
    497    !! 
    498    IMPLICIT NONE 
    499    !!---------------------------------------------------------------------- 
    500  
    501    ! 1. Declaration of the type of variable which have to be interpolated 
    502    !--------------------------------------------------------------------- 
    503    CALL agrif_declare_var_lim2 
    504  
    505    ! 2. First interpolations of potentially non zero fields 
    506    !------------------------------------------------------- 
    507    Agrif_SpecialValue=-9999. 
    508    Agrif_UseSpecialValue = .TRUE. 
    509    !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice ) 
    510    !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   ) 
    511    !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   ) 
    512    Agrif_SpecialValue=0. 
    513    Agrif_UseSpecialValue = .FALSE. 
    514  
    515    ! 3. Some controls 
    516    !----------------- 
    517  
    518 #   if ! defined key_lim2_vp 
    519    lim_nbstep = 1. 
    520    CALL agrif_rhg_lim2_load 
    521    CALL agrif_trp_lim2_load 
    522    lim_nbstep = 0. 
    523 #   endif 
    524    !RB mandatory but why ??? 
    525    !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN 
    526    !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc') 
    527    !         nbclineupdate = nn_fsbc 
    528    !       ENDIF 
    529    CALL Agrif_Update_lim2(0) 
    530    ! 
    531 END SUBROUTINE Agrif_InitValues_cont_lim2 
    532  
    533  
    534 SUBROUTINE agrif_declare_var_lim2 
    535    !!---------------------------------------------------------------------- 
    536    !!                 *** ROUTINE agrif_declare_var_lim2 *** 
    537    !! 
    538    !! ** Purpose :: Declaration of variables to be interpolated for LIM2 
    539    !!---------------------------------------------------------------------- 
    540    USE agrif_util 
    541    USE ice_2 
    542    !! 
    543    IMPLICIT NONE 
    544    !!---------------------------------------------------------------------- 
    545  
    546    ! 1. Declaration of the type of variable which have to be interpolated 
    547    !--------------------------------------------------------------------- 
    548    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id ) 
    549 #   if defined key_lim2_vp 
    550    CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
    551    CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
    552 #   else 
    553    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
    554    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
    555 #   endif 
    556  
    557    ! 2. Type of interpolation 
    558    !------------------------- 
    559    CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear) 
    560    CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    561    CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    562  
    563    ! 3. Location of interpolation 
    564    !----------------------------- 
    565    CALL Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
    566    CALL Agrif_Set_bc(u_ice_id,(/0,1/)) 
    567    CALL Agrif_Set_bc(v_ice_id,(/0,1/)) 
    568  
    569    ! 5. Update type 
    570    !--------------- 
    571    CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
    572    CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    573    CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    574    !  
    575 END SUBROUTINE agrif_declare_var_lim2 
    576 #  endif 
    577  
    578483#if defined key_lim3 
    579484SUBROUTINE Agrif_InitValues_cont_lim3 
     
    902807   ! 
    903808   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
    904 # if defined key_lim2 
    905    IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') ! only for LIM2 (not LIM3) 
    906 # endif 
    907809   ! 
    908810END SUBROUTINE agrif_nemo_init 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r6140 r8306  
    3838   USE asmpar             ! Parameters for the assmilation interface 
    3939   USE zdfmxl             ! mixed layer depth 
    40 #if defined key_lim2 
    41    USE ice_2 
    42 #endif 
    4340#if defined key_lim3 
    4441   USE ice 
     
    148145            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
    149146            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              ) 
    150 #if defined key_lim2 || defined key_lim3 
     147#if defined key_lim3 
    151148            IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN 
    152149               IF( ALLOCATED(frld) ) THEN 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r8030 r8306  
    3535   USE in_out_manager   ! I/O manager 
    3636   USE lib_mpp          ! MPP library 
    37 #if defined key_lim2 
    38    USE ice_2            ! LIM2 
     37#if defined key_lim3 
     38   USE ice,   ONLY: htm_i, at_i, pfrld, phicif 
    3939#endif 
    4040   USE sbc_oce          ! Surface boundary condition variables. 
     
    809809      INTEGER  ::   it 
    810810      REAL(wp) ::   zincwgt   ! IAU weight for current time step 
    811 #if defined key_lim2 
     811#if defined key_lim3 
    812812      REAL(wp), DIMENSION(jpi,jpj) ::   zofrld, zohicif, zseaicendg, zhicifinc  ! LIM 
    813813      REAL(wp) ::   zhicifmin = 0.5_wp      ! ice minimum depth in metres 
     
    831831            ENDIF 
    832832            ! 
    833             ! Sea-ice : LIM-3 case (to add) 
    834             ! 
    835 #if defined key_lim2 
    836             ! Sea-ice : LIM-2 case 
    837             zofrld (:,:) = frld(:,:) 
    838             zohicif(:,:) = hicif(:,:) 
    839             ! 
    840             frld  = MIN( MAX( frld (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
    841             pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
    842             fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction 
    843             ! 
    844             zseaicendg(:,:) = zofrld(:,:) - frld(:,:)   ! find out actual sea ice nudge applied 
     833            ! Sea-ice : LIM-3 case 
     834            ! 
     835#if defined key_lim3 
     836            zofrld (:,:) = 1._wp - at_i(:,:) 
     837            zohicif(:,:) = htm_i(:,:) 
     838            ! 
     839            at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
     840            pfrld     =      MIN( MAX( pfrld(:,:)   - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
     841            fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
     842            ! 
     843            zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied 
    845844            ! 
    846845            ! Nudge sea ice depth to bring it up to a required minimum depth 
    847             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )  
    848                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
     846            WHERE( zseaicendg(:,:) > 0.0_wp .AND. htm_i(:,:) < zhicifmin )  
     847               zhicifinc(:,:) = (zhicifmin - htm_i(:,:)) * zincwgt     
    849848            ELSEWHERE 
    850849               zhicifinc(:,:) = 0.0_wp 
     
    852851            ! 
    853852            ! nudge ice depth 
    854             hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 
     853            htm_i (:,:) = htm_i (:,:) + zhicifinc(:,:) 
    855854            phicif(:,:) = phicif(:,:) + zhicifinc(:,:)        
    856855            ! 
     
    882881            neuler = 0                    ! Force Euler forward step 
    883882            ! 
    884             ! Sea-ice : LIM-3 case (to add) 
    885             ! 
    886 #if defined key_lim2 
    887             ! Sea-ice : LIM-2 case. 
    888             zofrld(:,:)=frld(:,:) 
    889             zohicif(:,:)=hicif(:,:) 
     883            ! Sea-ice : LIM-3 case 
     884            ! 
     885#if defined key_lim3 
     886            zofrld (:,:) = 1._wp - at_i(:,:) 
     887            zohicif(:,:) = htm_i(:,:) 
    890888            !  
    891889            ! Initialize the now fields the background + increment 
    892             frld (:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
    893             pfrld(:,:) = frld(:,:)  
    894             fr_i (:,:) = 1.0_wp - frld(:,:)                ! adjust ice fraction 
    895             zseaicendg(:,:) = zofrld(:,:) - frld(:,:)      ! find out actual sea ice nudge applied 
     890            at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
     891            pfrld(:,:) = 1.-at_i(:,:)  
     892            fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
     893            ! 
     894            zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied 
    896895            ! 
    897896            ! Nudge sea ice depth to bring it up to a required minimum depth 
    898             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )  
    899                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
     897            WHERE( zseaicendg(:,:) > 0.0_wp .AND. htm_i(:,:) < zhicifmin )  
     898               zhicifinc(:,:) = (zhicifmin - htm_i(:,:)) * zincwgt     
    900899            ELSEWHERE 
    901                zhicifinc(:,:) = 0._wp 
     900               zhicifinc(:,:) = 0.0_wp 
    902901            END WHERE 
    903902            ! 
    904903            ! nudge ice depth 
    905             hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 
     904            htm_i (:,:) = htm_i (:,:) + zhicifinc(:,:) 
    906905            phicif(:,:) = phicif(:,:)        
    907906            ! 
     
    926925         ENDIF 
    927926 
    928 !#if defined defined key_lim2 || defined key_cice 
     927!#if defined defined key_lim3 || defined key_cice 
    929928! 
    930929!            IF (ln_seaicebal ) THEN        
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r7753 r8306  
    5555      REAL(wp), POINTER, DIMENSION(:,:) ::  tem 
    5656      REAL(wp), POINTER, DIMENSION(:,:) ::  sal 
    57 #if defined key_lim2 
    58       LOGICAL                           ::   ll_frld 
    59       LOGICAL                           ::   ll_hicif 
    60       LOGICAL                           ::   ll_hsnif 
    61       REAL(wp), POINTER, DIMENSION(:)   ::   frld 
    62       REAL(wp), POINTER, DIMENSION(:)   ::   hicif 
    63       REAL(wp), POINTER, DIMENSION(:)   ::   hsnif 
    64 #elif defined key_lim3 
     57#if defined key_lim3 
    6558      LOGICAL                           ::   ll_a_i 
    6659      LOGICAL                           ::   ll_ht_i 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r7861 r8306  
    2525   USE iom             ! IOM library 
    2626   USE in_out_manager  ! I/O logical units 
    27 #if defined key_lim2 
    28    USE ice_2 
    29 #elif defined key_lim3 
     27#if defined key_lim3 
    3028   USE ice 
    3129   USE limvar          ! redistribute ice input into categories 
     
    5048 
    5149#if defined key_lim3 
    52    LOGICAL :: ll_bdylim3                  ! determine whether ice input is lim2 (F) or lim3 (T) type 
     50   LOGICAL :: ll_bdylim3                  ! determine whether ice input is 1cat (F) or Xcat (T) type 
    5351   INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure 
    5452#endif 
     
    176174            ENDIF 
    177175 
    178 #if defined key_lim2 
    179             IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN  
    180                ilen1(:) = nblen(:) 
    181                IF( dta%ll_frld ) THEN 
    182                   igrd = 1  
    183                   DO ib = 1, ilen1(igrd) 
    184                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    185                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    186                      dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
    187                   END DO  
    188                END IF 
    189                IF( dta%ll_hicif ) THEN 
    190                   igrd = 1  
    191                   DO ib = 1, ilen1(igrd) 
    192                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    193                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    194                      dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
    195                   END DO  
    196                END IF 
    197                IF( dta%ll_hsnif ) THEN 
    198                   igrd = 1  
    199                   DO ib = 1, ilen1(igrd) 
    200                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    201                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    202                      dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
    203                   END DO  
    204                END IF 
    205             ENDIF 
    206 #elif defined key_lim3 
     176#if defined key_lim3 
    207177            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN  
    208178               ilen1(:) = nblen(:) 
     
    373343               ENDIF 
    374344#if defined key_lim3 
    375                IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type) 
     345               IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is 1cat) 
    376346                CALL lim_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 
    377347                                  & dta_bdy(ib_bdy)%ht_i,     dta_bdy(ib_bdy)%ht_s,     dta_bdy(ib_bdy)%a_i     ) 
     
    449419      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
    450420      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    451 #if defined key_lim2 
    452       TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      ! 
    453 #elif defined key_lim3 
     421#if defined key_lim3 
    454422      TYPE(FLD_N) ::   bn_a_i, bn_ht_i, bn_ht_s       
    455 #endif 
    456423      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
    457 #if defined key_lim2 
    458       NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif 
    459 #elif defined key_lim3 
    460424      NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s 
    461425#endif 
     
    475439                               ,nn_dyn3d_dta(ib_bdy)       & 
    476440                               ,nn_tra_dta(ib_bdy)         & 
    477 #if ( defined key_lim2 || defined key_lim3 ) 
     441#if defined key_lim3 
    478442                              ,nn_ice_lim_dta(ib_bdy)    & 
    479443#endif 
     
    496460            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    497461         ENDIF 
    498 #if ( defined key_lim2 || defined key_lim3 ) 
     462#if defined key_lim3 
    499463         IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1  ) THEN 
    500464            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
     
    637601            ENDIF 
    638602 
    639 #if defined key_lim2 
     603#if defined key_lim3 
    640604            ! sea ice 
    641605            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 
    642  
    643                IF( dta%ll_frld ) THEN 
    644                   jfld = jfld + 1 
    645                   blf_i(jfld) = bn_frld 
    646                   ibdy(jfld) = ib_bdy 
    647                   igrid(jfld) = 1 
    648                   ilen1(jfld) = nblen(igrid(jfld)) 
    649                   ilen3(jfld) = 1 
    650                ENDIF 
    651  
    652                IF( dta%ll_hicif ) THEN 
    653                   jfld = jfld + 1 
    654                   blf_i(jfld) = bn_hicif 
    655                   ibdy(jfld) = ib_bdy 
    656                   igrid(jfld) = 1 
    657                   ilen1(jfld) = nblen(igrid(jfld)) 
    658                   ilen3(jfld) = 1 
    659                ENDIF 
    660  
    661                IF( dta%ll_hsnif ) THEN 
    662                   jfld = jfld + 1 
    663                   blf_i(jfld) = bn_hsnif 
    664                   ibdy(jfld) = ib_bdy 
    665                   igrid(jfld) = 1 
    666                   ilen1(jfld) = nblen(igrid(jfld)) 
    667                   ilen3(jfld) = 1 
    668                ENDIF 
    669  
    670             ENDIF 
    671 #elif defined key_lim3 
    672             ! sea ice 
    673             IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 
    674                ! Test for types of ice input (lim2 or lim3)  
     606               ! Test for types of ice input (1cat or Xcat)  
    675607               ! Build file name to find dimensions  
    676608               clname=TRIM( cn_dir )//TRIM(bn_a_i%clname) 
     
    689621 
    690622                IF ( zndims == 4 ) THEN 
    691                  ll_bdylim3 = .TRUE.   ! lim3 input 
     623                 ll_bdylim3 = .TRUE.   ! Xcat input 
    692624               ELSE 
    693                  ll_bdylim3 = .FALSE.  ! lim2 input       
     625                 ll_bdylim3 = .FALSE.  ! 1cat input       
    694626               ENDIF 
    695627               ! End test 
     
    848780         ENDIF 
    849781 
    850 #if defined key_lim2 
    851          IF (cn_ice_lim(ib_bdy) /= 'none') THEN 
    852             IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
    853                ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 
    854                ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 
    855                ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) ) 
    856             ELSE 
    857                jfld = jfld + 1 
    858                dta_bdy(ib_bdy)%frld  => bf(jfld)%fnow(:,1,1) 
    859                jfld = jfld + 1 
    860                dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1) 
    861                jfld = jfld + 1 
    862                dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1) 
    863             ENDIF 
    864          ENDIF 
    865 #elif defined key_lim3 
     782#if defined key_lim3 
    866783         IF (cn_ice_lim(ib_bdy) /= 'none') THEN 
    867784            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
     
    870787               ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) ) 
    871788            ELSE 
    872                IF ( ll_bdylim3 ) THEN ! case input is lim3 type 
     789               IF ( ll_bdylim3 ) THEN ! case input is Xcat 
    873790                  jfld = jfld + 1 
    874791                  dta_bdy(ib_bdy)%a_i  => bf(jfld)%fnow(:,1,:) 
     
    877794                  jfld = jfld + 1 
    878795                  dta_bdy(ib_bdy)%ht_s => bf(jfld)%fnow(:,1,:) 
    879                ELSE ! case input is lim2 type 
     796               ELSE ! case input is 1cat 
    880797                  jfld_ai  = jfld + 1 
    881798                  jfld_hti = jfld + 2 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r7646 r8306  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  bdyice_lim  *** 
    4    !! Unstructured Open Boundary Cond. :  Open boundary conditions for sea-ice (LIM2 and LIM3) 
     4   !! Unstructured Open Boundary Cond. :  Open boundary conditions for sea-ice (LIM3) 
    55   !!====================================================================== 
    66   !!  History :  3.3  !  2010-09 (D. Storkey)  Original code 
     
    88   !!              -   !  2012-01 (C. Rousset)  add lim3 and remove useless jk loop  
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_lim2 || defined key_lim3 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_lim2'                                                 LIM-2 sea ice model 
     10#if defined key_lim3 
     11   !!---------------------------------------------------------------------- 
    1312   !!   'key_lim3'                                                 LIM-3 sea ice model 
    1413   !!---------------------------------------------------------------------- 
     
    2019   USE eosbn2          ! equation of state 
    2120   USE oce             ! ocean dynamics and tracers variables 
    22 #if defined key_lim2 
    23    USE par_ice_2 
    24    USE ice_2           ! LIM_2 ice variables 
    25    USE dom_ice_2       ! sea-ice domain 
    26 #elif defined key_lim3 
     21#if defined key_lim3 
    2722   USE ice             ! LIM_3 ice variables 
    2823   USE limvar 
     
    5550      !!                  ***  SUBROUTINE bdy_ice_lim  *** 
    5651      !! 
    57       !! ** Purpose : - Apply open boundary conditions for ice (LIM2 and LIM3) 
     52      !! ** Purpose : - Apply open boundary conditions for ice (LIM3) 
    5853      !! 
    5954      !!---------------------------------------------------------------------- 
     
    110105      REAL(wp) ::   zwgt, zwgt1        ! local scalar 
    111106      REAL(wp) ::   ztmelts, zdh 
    112 #if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif 
    113      USE ice_2, vt_s => hsnm 
    114      USE ice_2, vt_i => hicm 
    115 #endif 
    116107      !!------------------------------------------------------------------------------ 
    117108      ! 
     
    120111      jgrd = 1      ! Everything is at T-points here 
    121112      ! 
    122 #if defined key_lim2 
    123       DO jb = 1, idx%nblenrim(jgrd) 
    124          ji    = idx%nbi(jb,jgrd) 
    125          jj    = idx%nbj(jb,jgrd) 
    126          zwgt  = idx%nbw(jb,jgrd) 
    127          zwgt1 = 1.e0 - idx%nbw(jb,jgrd) 
    128          frld (ji,jj) = ( frld (ji,jj) * zwgt1 + dta%frld (jb) * zwgt ) * tmask(ji,jj,1)     ! Leads fraction  
    129          hicif(ji,jj) = ( hicif(ji,jj) * zwgt1 + dta%hicif(jb) * zwgt ) * tmask(ji,jj,1)     ! Ice depth  
    130          hsnif(ji,jj) = ( hsnif(ji,jj) * zwgt1 + dta%hsnif(jb) * zwgt ) * tmask(ji,jj,1)     ! Snow depth 
    131       END DO  
    132  
    133       CALL lbc_bdy_lnk( frld,  'T', 1., ib_bdy )                                         ! lateral boundary conditions 
    134       CALL lbc_bdy_lnk( hicif, 'T', 1., ib_bdy ) 
    135       CALL lbc_bdy_lnk( hsnif, 'T', 1., ib_bdy ) 
    136  
    137       vt_i(:,:) = hicif(:,:) * frld(:,:) 
    138       vt_s(:,:) = hsnif(:,:) * frld(:,:) 
    139       ! 
    140 #elif defined key_lim3 
     113#if defined key_lim3 
    141114 
    142115      DO jl = 1, jpl 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r7646 r8306  
    351351        IF(lwp) WRITE(numout,*) 
    352352 
    353 #if defined key_lim2 
    354         IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    355         SELECT CASE( cn_ice_lim(ib_bdy) )                   
    356           CASE('none') 
    357              IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    358              dta_bdy(ib_bdy)%ll_frld  = .false. 
    359              dta_bdy(ib_bdy)%ll_hicif = .false. 
    360              dta_bdy(ib_bdy)%ll_hsnif = .false. 
    361           CASE('frs') 
    362              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    363              dta_bdy(ib_bdy)%ll_frld  = .true. 
    364              dta_bdy(ib_bdy)%ll_hicif = .true. 
    365              dta_bdy(ib_bdy)%ll_hsnif = .true. 
    366           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 
    367         END SELECT 
    368         IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN  
    369            SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   !  
    370               CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    371               CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    372               CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' ) 
    373            END SELECT 
    374         ENDIF 
    375         IF(lwp) WRITE(numout,*) 
    376 #elif defined key_lim3 
     353#if defined key_lim3 
    377354        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    378355        SELECT CASE( cn_ice_lim(ib_bdy) )                   
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r7753 r8306  
    148148         rmxln_25h(:,:,:) = mxln(:,:,:) 
    149149#endif 
    150 #if defined key_lim3 || defined key_lim2 
     150#if defined key_lim3 
    151151         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
    152152#endif  
     
    207207      ENDIF 
    208208 
    209 #if defined key_lim3 || defined key_lim2 
     209#if defined key_lim3 
    210210      CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice') 
    211211#endif 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r8126 r8306  
    3232   USE dianam          ! build name of file 
    3333   USE lib_mpp         ! distributed memory computing library 
    34 #if defined key_lim2 
    35    USE ice_2 
    36 #endif 
    3734#if defined key_lim3 
    3835   USE ice 
     
    747744           END DO !end of loop on the level 
    748745 
    749 #if defined key_lim2 || defined key_lim3 
     746#if defined key_lim3 
    750747 
    751748           !ICE CASE     
     
    769766              zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J) 
    770767 
    771 #if defined key_lim2    
    772               transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*   &  
    773                                    (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &  
    774                                   *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) +  &  
    775                                     hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) 
    776               transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   &  
    777                                     (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) 
    778 #endif 
    779768#if defined key_lim3 
    780769              DO jl=1,jpl 
     
    960949           ENDDO ! loop over jk  
    961950  
    962 #if defined key_lim2 || defined key_lim3  
     951#if defined key_lim3  
    963952  
    964953           !ICE CASE      
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r8226 r8306  
    5151   USE ioipsl 
    5252 
    53 #if defined key_lim2 
    54    USE limwri_2  
    55 #elif defined key_lim3 
     53#if defined key_lim3 
    5654   USE limwri  
    5755#endif 
     
    707705#endif 
    708706 
    709          IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    710             CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    711                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    712             CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    713                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    714          ENDIF 
    715  
    716707         CALL histend( nid_T, snc4chunks=snc4set ) 
    717708 
     
    861852#endif 
    862853 
    863       IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    864          CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    865          CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
    866       ENDIF 
    867  
    868854      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    869855      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
     
    1009995      ENDIF 
    1010996 
    1011 #if defined key_lim2 
    1012       CALL lim_wri_state_2( kt, id_i, nh_i ) 
    1013 #elif defined key_lim3 
     997#if defined key_lim3 
    1014998      IF( nn_ice == 3 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid 
    1015999         CALL lim_wri_state( kt, id_i, nh_i ) 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90

    r6140 r8306  
    9090   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e 
    9191   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e 
    92 #if defined key_lim2 || defined key_lim3 || defined key_cice 
     92#if defined key_lim3 || defined key_cice 
    9393   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ui_e, vi_e 
    9494#endif 
     
    170170      ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,   & 
    171171         &      vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,   & 
    172 #if defined key_lim2 || defined key_lim3 || defined key_cice 
     172#if defined key_lim3 || defined key_cice 
    173173         &      ui_e(0:jpi+1,0:jpj+1) ,                            & 
    174174         &      vi_e(0:jpi+1,0:jpj+1) ,                            & 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    r7646 r8306  
    2121   USE icb_oce                             ! define iceberg arrays 
    2222   USE sbc_oce                             ! ocean surface boundary conditions 
    23 #if defined key_lim2 
    24    USE ice_2,         ONLY: u_ice, v_ice   ! LIM-2 ice velocities  (CAUTION in C-grid do not use key_vp option) 
    25    USE ice_2,         ONLY: hicif          ! LIM-2 ice thickness 
    26 #elif defined key_lim3 
    27    USE ice,           ONLY: u_ice, v_ice   ! LIM-3 variables  (always in C-grid) 
    28                                            ! gm  LIM3 case the mean ice thickness (i.e. averaged over categories) 
    29                                            ! gm            has to be computed somewhere in the ice and accessed here 
     23#if defined key_lim3 
     24   USE ice,    ONLY: u_ice, v_ice, htm_i   ! LIM-3 variables 
    3025#endif 
    3126 
     
    8580      CALL lbc_lnk_icb( fr_e, 'T', +1._wp, 1, 1 ) 
    8681      CALL lbc_lnk_icb( tt_e, 'T', +1._wp, 1, 1 ) 
    87 #if defined key_lim2 
    88       hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = hicif(:,:)   
    89       CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 )   
    90 #endif 
    91  
    92 #if defined key_lim2 || defined key_lim3 
     82#if defined key_lim3 
     83      hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = htm_i(:,:)   
    9384      ui_e(:,:) = 0._wp ;   ui_e(1:jpi, 1:jpj) = u_ice(:,:) 
    9485      vi_e(:,:) = 0._wp ;   vi_e(1:jpi, 1:jpj) = v_ice(:,:) 
    95  
     86      CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 ) 
    9687      CALL lbc_lnk_icb( ui_e, 'U', -1._wp, 1, 1 ) 
    9788      CALL lbc_lnk_icb( vi_e, 'V', -1._wp, 1, 1 ) 
     
    157148      pva  = pva * zmod 
    158149 
    159 #if defined key_lim2 || defined key_lim3 
     150#if defined key_lim3 
    160151      pui = icb_utl_bilin_h( ui_e, pi, pj, 'U' )              ! sea-ice velocities 
    161152      pvi = icb_utl_bilin_h( vi_e, pi, pj, 'V' ) 
    162 # if defined key_lim3 
    163       phi = 0._wp                                             ! LIM-3 case (to do) 
    164 # else 
    165153      phi = icb_utl_bilin_h(hicth, pi, pj, 'T' )              ! ice thickness 
    166 # endif 
    167154#else 
    168155      pui = 0._wp 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r8239 r8306  
    3434#if defined key_lim3 
    3535   USE ice    , ONLY :   jpl 
    36 #elif defined key_lim2 
    37    USE par_ice_2 
    3836#endif 
    3937   USE domngb          ! ocean space and time domain 
     
    193191      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 
    194192# endif 
    195 #if defined key_lim3 || defined key_lim2 
     193#if defined key_lim3 
    196194      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
    197195      ! SIMIP diagnostics (4 main arctic straits) 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r6140 r8306  
    291291            END DO 
    292292         ENDIF 
    293 #if defined key_lim2 || defined key_lim3 
     293#if defined key_lim3 
    294294         IF (ln_sic) THEN 
    295295            jtype = jtype + 1 
     
    541541         & frld 
    542542#endif 
    543 #if defined key_lim2 
    544       USE ice_2, ONLY : &          ! LIM2 Ice model variables 
    545          & frld 
    546 #endif 
    547543      IMPLICIT NONE 
    548544 
     
    567563         & zgphi1,    &            ! Model latitudes for prof variable 1 
    568564         & zgphi2                  ! Model latitudes for prof variable 2 
    569 #if ! defined key_lim2 && ! defined key_lim3 
     565#if ! defined key_lim3 
    570566      REAL(wp), POINTER, DIMENSION(:,:) :: frld 
    571567#endif 
     
    582578      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
    583579      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
    584 #if ! defined key_lim2 && ! defined key_lim3 
     580#if ! defined key_lim3 
    585581      CALL wrk_alloc(jpi,jpj,frld)  
    586582#endif 
     
    597593      ! No LIM => frld == 0.0_wp 
    598594      !----------------------------------------------------------------------- 
    599 #if ! defined key_lim2 && ! defined key_lim3 
     595#if ! defined key_lim3 
    600596      frld(:,:) = 0.0_wp 
    601597#endif 
     
    665661               zsurfvar(:,:) = sshn(:,:) 
    666662               llnightav = .FALSE. 
    667 #if defined key_lim2 || defined key_lim3 
     663#if defined key_lim3 
    668664            CASE('sic') 
    669665               IF ( kstp == 0 ) THEN 
     
    702698      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
    703699      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
    704 #if ! defined key_lim2 && ! defined key_lim3 
     700#if ! defined key_lim3 
    705701      CALL wrk_dealloc(jpi,jpj,frld) 
    706702#endif 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r8237 r8306  
    99   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_lim3 || defined key_lim2 || defined key_cice 
     11#if defined key_lim3 || defined key_cice 
    1212   !!---------------------------------------------------------------------- 
    13    !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model 
     13   !!   'key_lim3' :            LIM-3 sea-ice model 
    1414   !!---------------------------------------------------------------------- 
    1515   USE par_oce          ! ocean parameters 
     
    1717# if defined key_lim3 
    1818   USE ice              ! LIM-3 parameters 
    19 # endif 
    20 # if defined key_lim2 
    21    USE par_ice_2        ! LIM-2 parameters 
    22    USE ice_2 
    2319# endif 
    2420# if defined key_cice 
     
    3329   PUBLIC sbc_ice_alloc ! called in iceini(_2).F90 
    3430 
    35 # if defined  key_lim2 
    36    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model 
    37    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
    38    LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
    39 #  if defined key_lim2_vp 
    40    CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'I'      !: VP : 'I'-grid ice-velocity (B-grid lower left corner) 
    41 #  else 
    42    CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: EVP: 'C'-grid ice-velocity 
    43 #  endif 
    44 # endif 
    4531# if defined  key_lim3 
    46    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
    4732   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .TRUE.   !: LIM-3 ice model 
    4833   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
     
    5035# endif 
    5136# if defined  key_cice 
    52    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
    5337   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
    5438   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .TRUE.   !: CICE ice model 
     
    8468   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
    8569#endif 
    86 #if defined key_lim3 || defined key_lim2 
     70#if defined key_lim3 
    8771   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s] 
    8872#endif 
     
    10892#endif 
    10993    
    110 #if defined key_lim2 || defined key_cice 
     94#if defined key_cice 
    11195   ! already defined in ice.F90 for LIM3 
    11296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     
    135119      ierr(:) = 0 
    136120 
    137 #if defined key_lim3 || defined key_lim2 
     121#if defined key_lim3 
    138122      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
    139123         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
     
    141125         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   & 
    142126         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    143 #if defined key_lim2 
    144          &      a_i(jpi,jpj,jpl)      ,                             & 
    145 #endif 
    146 #if defined key_lim3 
    147127         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,   & 
    148128         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) ,   & 
    149129         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce (jpi,jpj)  ,   & 
    150 #endif 
    151130         &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) ) 
    152131#endif 
     
    166145#endif 
    167146         ! 
    168 #if defined key_cice || defined key_lim2 
     147#if defined key_cice 
    169148      IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
    170149#endif 
     
    183162   PUBLIC sbc_ice_alloc 
    184163 
    185    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
    186164   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
    187165   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90

    r7753 r8306  
    4242   USE ice     , ONLY :   u_ice, v_ice, jpl, pfrld, a_i_b, at_i_b 
    4343   USE limthd_dh      ! for CALL lim_thd_snwblow 
    44 #elif defined key_lim2 
    45    USE ice_2   , ONLY :   u_ice, v_ice 
    46    USE par_ice_2      ! LIM-2 parameters 
    4744#endif 
    4845   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)  
     
    6461   PUBLIC   sbc_blk_init  ! called in sbcmod 
    6562   PUBLIC   sbc_blk       ! called in sbcmod 
    66 #if defined key_lim2 || defined key_lim3 
     63#if defined key_lim3 
    6764   PUBLIC   blk_ice_tau   ! routine called in sbc_ice_lim module 
    6865   PUBLIC   blk_ice_flx   ! routine called in sbc_ice_lim module 
     
    573570   END SUBROUTINE blk_oce 
    574571 
    575 #if defined key_lim2 || defined key_lim3 
     572#if defined key_lim3 
    576573 
    577574   SUBROUTINE blk_ice_tau 
     
    602599 
    603600      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 
    604 #if defined key_lim3 
    605601      IF( ln_Cd_L12 ) THEN 
    606602         CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 
    607603      ENDIF 
    608 #endif 
    609604 
    610605      ! local scalars ( place there for vector optimisation purposes) 
     
    717712 
    718713      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al.  2012) (clem) 
    719 #if defined key_lim3 
    720714      IF( ln_Cd_L12 ) THEN 
    721715         CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 
    722716      ENDIF 
    723 #endif 
    724717 
    725718      ! 
     
    786779      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation 
    787780 
    788 #if defined  key_lim3 
    789781      CALL wrk_alloc( jpi,jpj,   zevap, zsnw ) 
    790782 
     
    824816 
    825817      CALL wrk_dealloc( jpi,jpj,   zevap, zsnw ) 
    826 #endif 
    827818 
    828819      !-------------------------------------------------------------------- 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7968 r8306  
    2828#if defined key_lim3 
    2929   USE ice            ! ice variables 
    30 #endif 
    31 #if defined key_lim2 
    32    USE par_ice_2      ! ice parameters 
    33    USE ice_2          ! ice variables 
    3430#endif 
    3531   USE cpl_oasis3     ! OASIS3 coupling 
     
    207203      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    208204       
    209 #if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 
     205#if ! defined key_lim3 && ! defined key_cice 
    210206      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    211207#endif 
     
    19501946 
    19511947      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 
    1952       ! Used for LIM2 and LIM3 
     1948      ! Used for LIM3 
    19531949      ! Coupled case: since cloud cover is not received from atmosphere  
    19541950      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r6140 r8306  
    9494         ! and in case of no melt, it can generate HSSW. 
    9595         ! 
    96 #if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice 
     96#if ! defined key_lim3 && ! defined key_cice 
    9797         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass 
    9898         snwice_mass  (:,:) = 0.e0 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r8226 r8306  
    3434   USE sbcice_if      ! surface boundary condition: ice-if sea-ice model 
    3535   USE sbcice_lim     ! surface boundary condition: LIM 3.0 sea-ice model 
    36    USE sbcice_lim_2   ! surface boundary condition: LIM 2.0 sea-ice model 
    3736   USE sbcice_cice    ! surface boundary condition: CICE    sea-ice model 
    3837   USE sbcisf         ! surface boundary condition: ice-shelf 
     
    117116#if defined key_agrif 
    118117      IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 
    119          IF( lk_lim2 )   nn_ice      = 2 
    120118         IF( lk_lim3 )   nn_ice      = 3 
    121119         IF( lk_cice )   nn_ice      = 4 
    122120      ENDIF 
    123121#else 
    124       IF( lk_lim2 )   nn_ice      = 2 
    125122      IF( lk_lim3 )   nn_ice      = 3 
    126123      IF( lk_cice )   nn_ice      = 4 
     
    201198      CASE( 0 )                        !- no ice in the domain 
    202199      CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)   
    203       CASE( 2 )                        !- LIM2 ice model 
    204          IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : LIM2 sea-ice model requires ln_blk or ln_cpl = T' ) 
    205200      CASE( 3 )                        !- LIM3 ice model 
    206201         IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : LIM3 sea-ice models require nn_ice_embd = 1 or 2' ) 
     
    428423      SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas 
    429424      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model) 
    430       CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
    431425      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    432426      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r8226 r8306  
    140140      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    141141# endif 
    142 # if defined key_lim2 
    143       CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM2 
    144 # endif 
    145142# if defined key_lim3 
    146143      CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3 
     
    206203      ! 
    207204#if defined key_agrif 
    208 !!clem2017      IF( .NOT. Agrif_Root() ) THEN 
     205      IF( .NOT. Agrif_Root() ) THEN 
    209206                         CALL Agrif_ParentGrid_To_ChildGrid() 
    210207         IF( ln_diaobs ) CALL dia_obs_wri 
    211208         IF( nn_timing == 1 )   CALL timing_finalize 
    212209                                CALL Agrif_ChildGrid_To_ParentGrid() 
    213 !!clem2017      ENDIF 
     210      ENDIF 
    214211#endif 
    215212      IF( nn_timing == 1 )   CALL timing_finalize 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/SAS_SRC/diawri.F90

    r8226 r8306  
    3838   USE iom 
    3939   USE ioipsl 
    40 #if defined key_lim2 
    41    USE limwri_2  
    42 #elif defined key_lim3 
     40#if defined key_lim3 
    4341   USE limwri 
    4442#endif 
     
    397395         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    398396 
    399 #if defined key_lim2 
    400       CALL lim_wri_state_2( kt, id_i, nh_i ) 
    401 #elif defined key_lim3 
     397#if defined key_lim3 
    402398      IF( nn_ice == 3 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid 
    403399         CALL lim_wri_state( kt, id_i, nh_i ) 
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r8226 r8306  
    8585# if defined key_top 
    8686      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    87 # endif 
    88 # if defined key_lim2 
    89       CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
    9087# endif 
    9188# if defined key_lim3 
Note: See TracChangeset for help on using the changeset viewer.