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 3625 – NEMO

Changeset 3625


Ignore:
Timestamp:
2012-11-21T14:19:18+01:00 (11 years ago)
Author:
acc
Message:

Branch dev_NOC_2012_r3555. #1006. Step 7. Check in code now merged with dev_r3385_NOCS04_HAMF

Location:
branches/2012/dev_NOC_2012_rev3555
Files:
106 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_NOC_2012_rev3555/DOC/TexFiles/Chapters/Chap_SBC.tex

    r3609 r3625  
    11461146\label{SBC_cice} 
    11471147 
    1148 It is now possible to couple a global NEMO configuration (without AGRIF) to the CICE sea-ice 
     1148It is now possible to couple a regional or global NEMO configuration (without AGRIF) to the CICE sea-ice 
    11491149model by using \key{cice}.  The CICE code can be obtained from  
    11501150\href{http://oceans11.lanl.gov/trac/CICE/}{LANL} and the additional 'hadgem3' drivers will be required,  
  • branches/2012/dev_NOC_2012_rev3555/DOC/TexFiles/Chapters/Introduction.tex

    r3308 r3625  
    6363\citep{OASIS2006}. Two-way nesting is also available through an interface to the 
    6464AGRIF package (Adaptative Grid Refinement in \textsc{Fortran}) \citep{Debreu_al_CG2008}. 
    65 The interface code for coupling to an alternative sea ice model (CICE, \citet{Hunke2008}) is now  
    66 available although this is currently only designed for global domains, without the use of AGRIF. 
     65The interface code for coupling to an alternative sea ice model (CICE, \citet{Hunke2008}) 
     66has now been upgraded so that it works for both global and regional domains, although AGRIF  
     67is still not available. 
    6768 
    6869Other model characteristics are the lateral boundary conditions (chapter~\ref{LBC}).   
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/AMM12/EXP00/namelist

    r3609 r3625  
    137137                           !  =1 use observed ice-cover      , 
    138138                           !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     139   nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
     140                           !  =1 levitating ice with mass and salt exchange but no presure effect 
     141                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    139142   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    140143   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist

    r3609 r3625  
    137137                           !  =1 use observed ice-cover      , 
    138138                           !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     139   nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
     140                           !  =1 levitating ice with mass and salt exchange but no presure effect 
     141                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    139142   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    140143   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r3614 r3625  
    137137                           !  =1 use observed ice-cover      , 
    138138                           !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     139   nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
     140                           !  =1 levitating ice with mass and salt exchange but no presure effect 
     141                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    139142   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    140143   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml

    r3294 r3625  
    124124 
    125125   <field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  /> 
    126    <field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s" /> 
     126   <field id="saltflx"      description="Downward Salt Flux"                                           unit="PSU/m2/s" /> 
    127127   <field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  /> 
    128128   <field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  /> 
     
    145145   <field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     /> 
    146146   <field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     /> 
     147   <field id="qhc_oce"      description="Downward Heat Content of E-P over open ocean"                 unit="W/m2"     /> 
    147148   <field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     /> 
    148149 
     
    173174   <field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     /> 
    174175 
     176   <!-- available if not defined key_vvl --> 
     177   <field id="emp_x_sst"      description="Concentration/Dilution term on SST"                         unit="kgC/m2/s" /> 
     178   <field id="emp_x_sss"      description="Concentration/Dilution term on SSS"                       unit="kgPSU/m2/s" /> 
    175179   <!-- available key_coupled --> 
    176180   <field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  /> 
     
    10161020     <field ref="empmr"        name="sowaflup"  /> 
    10171021     <field ref="qsr"          name="soshfldo"  /> 
    1018      <field ref="empsmr"       name="sowaflcd"  /> 
     1022     <field ref="saltflx"      name="sosfldow"  /> 
    10191023     <field ref="qt"           name="sohefldo"  /> 
    10201024     <field ref="mldr10_1"     name="somxl010"  /> 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r3609 r3625  
    137137                           !  =1 use observed ice-cover      , 
    138138                           !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     139   nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
     140                           !  =1 levitating ice with mass and salt exchange but no presure effect 
     141                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    139142   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    140143   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r3614 r3625  
    137137                           !  =1 use observed ice-cover      , 
    138138                           !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     139   nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
     140                           !  =1 levitating ice with mass and salt exchange but no presure effect 
     141                           !  =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    139142   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave 
    140143   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
     
    650653   sn_mld  = 'dyna_grid_T' ,    120            , 'somixhgt' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
    651654   sn_emp  = 'dyna_grid_T' ,    120            , 'sowaflcd' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
     655!  sn_emp  = 'dyna_grid_T' ,    120            , 'sowaflup' ,  .true.    , .true. ,   'yearly'  , ''       , '' ! v3.5+ 
     656!  sn_sfx  = 'dyna_grid_T' ,    120            , 'sosfldow' ,  .true.    , .true. ,   'yearly'  , ''       , '' ! v3.5+ 
    652657   sn_ice  = 'dyna_grid_T' ,    120            , 'soicecov' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
    653658   sn_qsr  = 'dyna_grid_T' ,    120            , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , '' 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r2715 r3625  
    1919   PUBLIC    ice_alloc_2  !  Called in iceini_2.F90 
    2020 
    21    INTEGER , PUBLIC ::   numit     !: ice iteration index 
    22    REAL(wp), PUBLIC ::   rdt_ice   !: ice time step 
     21   INTEGER , PUBLIC ::   numit        !: ice iteration index 
     22   REAL(wp), PUBLIC ::   rdt_ice      !: ice time step 
    2323 
    2424   !                                                                     !!* namicerun read in iceini  * 
     
    9898   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qstoif        !: Energy stored in the brine pockets 
    9999   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif          !: Heat flux at the ice base 
    100    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmsnif       !: Variation of snow mass 
    101    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmicif       !: Variation of ice mass 
     100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_snw       !: Variation of snow mass over 1 time step           [Kg/m2] 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_snw       !: Heat content associated with rdm_snw              [J/m2] 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_ice       !: Variation of ice  mass over 1 time step           [Kg/m2] 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_ice       !: Heat content associated with rdm_ice              [J/m2] 
    102104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif         !: heat balance of the lead (or of the open ocean) 
    103105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif         !: Energy needed to freeze the ocean surface layer 
     
    153155 
    154156      ALLOCATE(phicif(jpi,jpj) , pfrld  (jpi,jpj) , qstoif (jpi,jpj) ,     & 
    155          &     fbif  (jpi,jpj) , rdmsnif(jpi,jpj) , rdmicif(jpi,jpj) ,     & 
     157         &     fbif  (jpi,jpj) , rdm_snw(jpi,jpj) , rdq_snw(jpi,jpj) ,     & 
     158         &                       rdm_ice(jpi,jpj) , rdq_ice(jpi,jpj) ,     & 
    156159         &     qldif (jpi,jpj) , qcmif  (jpi,jpj) , fdtcn  (jpi,jpj) ,     & 
    157160         &     qdtcn (jpi,jpj) , thcm   (jpi,jpj)                    , STAT=ierr(4) ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

    r3294 r3625  
    1313   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    1414   !!---------------------------------------------------------------------- 
    15    !!   ice_init_2       : sea-ice model initialization 
    16    !!   ice_run_2        : Definition some run parameter for ice model 
     15   !!   ice_init_2    : sea-ice model initialization 
     16   !!   ice_run_2     : Definition some run parameter for ice model 
    1717   !!---------------------------------------------------------------------- 
    18    USE phycst           ! physical constants 
    19    USE dom_oce          ! ocean domain 
    20    USE sbc_oce          ! surface boundary condition: ocean 
    21    USE sbc_ice          ! LIM2 surface boundary condition 
    22    USE dom_ice_2        ! LIM2 ice domain 
    23    USE par_ice_2        ! LIM2 parameters 
    24    USE thd_ice_2        ! LIM2 thermodynamical variables 
    25    USE ice_2            ! LIM2 ice variable 
    26    USE limmsh_2         ! LIM2 mesh 
    27    USE limistate_2      ! LIM2 initial state 
    28    USE limrst_2         ! LIM2 restart 
    29    USE limsbc_2         ! LIM2 surface boundary condition 
    30    USE in_out_manager   ! I/O manager 
    31    USE lib_mpp          ! MPP library 
     18   USE phycst         ! physical constants 
     19   USE dom_oce        ! ocean domain 
     20   USE sbc_oce        ! surface boundary condition: ocean 
     21   USE sbc_ice        ! LIM2 surface boundary condition 
     22   USE dom_ice_2      ! LIM2 ice domain 
     23   USE par_ice_2      ! LIM2 parameters 
     24   USE thd_ice_2      ! LIM2 thermodynamical variables 
     25   USE ice_2          ! LIM2 ice variable 
     26   USE limmsh_2       ! LIM2 mesh 
     27   USE limistate_2    ! LIM2 initial state 
     28   USE limrst_2       ! LIM2 restart 
     29   USE limsbc_2       ! LIM2 surface boundary condition 
     30   USE in_out_manager ! I/O manager 
     31   USE lib_mpp        ! MPP library 
     32   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3233 
    3334   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90

    r3294 r3625  
    1414   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    1515   !!---------------------------------------------------------------------- 
    16    !!   lim_adv_x_2  : advection of sea ice on x axis 
    17    !!   lim_adv_y_2  : advection of sea ice on y axis 
     16   !!   lim_adv_x_2   : advection of sea ice on x axis 
     17   !!   lim_adv_y_2   : advection of sea ice on y axis 
    1818   !!---------------------------------------------------------------------- 
    1919   USE dom_oce 
     
    2121   USE ice_2 
    2222   USE lbclnk 
    23    USE in_out_manager     ! I/O manager 
    24    USE lib_mpp            ! MPP library 
    25    USE wrk_nemo           ! work arrays 
    26    USE prtctl             ! Print control 
     23   USE in_out_manager ! I/O manager 
     24   USE lib_mpp        ! MPP library 
     25   USE wrk_nemo       ! work arrays 
     26   USE prtctl         ! Print control 
     27   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2728 
    2829   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90

    r2715 r3625  
    2424   USE in_out_manager  ! I/O manager 
    2525   USE lib_mpp         ! MPP library 
     26   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2627 
    2728   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90

    r2715 r3625  
    1919   USE in_out_manager  ! I/O manager 
    2020   USE lib_mpp         ! MPP library 
     21   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2122 
    2223   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

    r3294 r3625  
    3131   USE in_out_manager   ! I/O manager 
    3232   USE prtctl           ! Print control 
     33   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3334 
    3435   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

    r3294 r3625  
    2121   USE prtctl           ! Print control 
    2222   USE in_out_manager   ! I/O manager 
     23   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2324 
    2425   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90

    r3294 r3625  
    2727   USE iom 
    2828   USE in_out_manager 
     29   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2930 
    3031   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90

    r3294 r3625  
    2323   USE wrk_nemo         ! work arrays 
    2424#endif 
     25   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2526 
    2627   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    r3294 r3625  
    3030   USE in_out_manager ! I/O manager 
    3131   USE prtctl         ! Print control 
     32   USE oce     , ONLY : snwice_mass, snwice_mass_b 
     33   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3234 
    3335   IMPLICIT NONE 
     
    8082      REAL(wp) ::   zs21_11, zs21_12, zs21_21, zs21_22 
    8183      REAL(wp) ::   zs22_11, zs22_12, zs22_21, zs22_22 
     84      REAL(wp) ::   zintb, zintn 
    8285      REAL(wp), POINTER, DIMENSION(:,:) ::   zfrld, zmass, zcorl 
    8386      REAL(wp), POINTER, DIMENSION(:,:) ::   za1ct, za2ct, zresr 
    8487      REAL(wp), POINTER, DIMENSION(:,:) ::   zc1u, zc1v, zc2u, zc2v 
    85       REAL(wp), POINTER, DIMENSION(:,:) ::   zsang 
     88      REAL(wp), POINTER, DIMENSION(:,:) ::   zsang, zpice 
    8689      REAL(wp), POINTER, DIMENSION(:,:) ::   zu0, zv0 
    8790      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_n, zv_n 
     
    9396       
    9497      CALL wrk_alloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr ) 
    95       CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang ) 
     98      CALL wrk_alloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice ) 
    9699      CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 ) 
    97100      CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 ) 
     
    129132!i    zviszeta(:,jpj+1) = 0._wp    ;    zviseta(:,jpj+1) = 0._wp 
    130133 
     134      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
     135          ! 
     136          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     137          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
     138         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     139          ! 
     140          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
     141          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
     142         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     143          ! 
     144         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
     145          ! 
     146         ! 
     147      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
     148         zpice(:,:) = ssh_m(:,:) 
     149      ENDIF 
    131150 
    132151      ! Ice mass, ice strength, and wind stress at the center            | 
     
    196215 
    197216            ! Gradient of the sea surface height 
    198             zgsshx =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji-1,jj  ))/e1u(ji-1,jj  )   & 
    199                &       +  (ssh_m(ji  ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp 
    200             zgsshy =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji  ,jj-1))/e2v(ji  ,jj-1)   & 
    201                &       +  (ssh_m(ji-1,jj  ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp 
     217            zgsshx =  (   (zpice(ji  ,jj  ) - zpice(ji-1,jj  ))/e1u(ji-1,jj  )   & 
     218               &       +  (zpice(ji  ,jj-1) - zpice(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp 
     219            zgsshy =  (   (zpice(ji  ,jj  ) - zpice(ji  ,jj-1))/e2v(ji  ,jj-1)   & 
     220               &       +  (zpice(ji-1,jj  ) - zpice(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp 
    202221 
    203222            ! Computation of the velocity field taking into account the ice-ice interaction.                                  
     
    575594 
    576595      CALL wrk_dealloc( jpi,jpj, zfrld, zmass, zcorl, za1ct, za2ct, zresr ) 
    577       CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang ) 
     596      CALL wrk_dealloc( jpi,jpj, zc1u , zc1v , zc2u , zc2v , zsang, zpice ) 
    578597      CALL wrk_dealloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 ) 
    579598      CALL wrk_dealloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r3294 r3625  
    99   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 
    1010   !!             -   ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step 
    11    !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     11   !!           3.3.1 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 
     12   !!            3.5  ! 2012-11 ((G. Madec, Y. Aksenov, A. Coward) salt and heat fluxes associated with e-p 
    1213   !!---------------------------------------------------------------------- 
    1314#if defined key_lim2 
     
    2829   USE sbc_oce          ! surface boundary condition: ocean 
    2930   USE sbccpl 
    30  
     31   USE cpl_oasis3, ONLY : lk_cpl 
     32   USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    3133   USE albedo           ! albedo parameters 
    3234   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
     
    3739   USE iom              ! I/O library 
    3840   USE prtctl           ! Print control 
    39    USE cpl_oasis3, ONLY : lk_cpl 
     41   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4042 
    4143   IMPLICIT NONE 
     
    8890      !!              - Update the fluxes provided to the ocean 
    8991      !!      
    90       !! ** Outputs : - qsr     : sea heat flux:    solar  
    91       !!              - qns     : sea heat flux: non solar 
    92       !!              - emp     : freshwater budget: volume flux  
    93       !!              - emps    : freshwater budget: concentration/dillution  
     92      !! ** Outputs : - qsr     : sea heat flux    : solar  
     93      !!              - qns     : sea heat flux    : non solar (including heat content of the mass flux) 
     94      !!              - emp     : freshwater budget: mass flux  
     95      !!              - sfx     : freshwater budget: salt flux due to Freezing/Melting 
    9496      !!              - utau    : sea surface i-stress (ocean referential) 
    9597      !!              - vtau    : sea surface j-stress (ocean referential) 
     
    107109      INTEGER  ::   ifvt, i1mfr, idfr, iflt    !   -       - 
    108110      INTEGER  ::   ial, iadv, ifral, ifrdv    !   -       - 
    109       REAL(wp) ::   zqsr, zqns, zfm            ! local scalars 
    110       REAL(wp) ::   zinda, zfons, zemp         !   -      - 
     111      REAL(wp) ::   zqsr,     zqns,   zfmm     ! local scalars 
     112      REAL(wp) ::   zinda,    zfsalt, zemp     !   -      - 
     113      REAL(wp) ::   zemp_snw, zqhc,   zcd      !   -      - 
     114      REAL(wp) ::   zswitch                    !   -      - 
    111115      REAL(wp), POINTER, DIMENSION(:,:)   ::   zqnsoce       ! 2D workspace 
    112116      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace 
     
    115119      CALL wrk_alloc( jpi, jpj, zqnsoce ) 
    116120      CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 
     121 
     122      SELECT CASE( nn_ice_embd )                 ! levitating or embedded sea-ice option 
     123        CASE( 0    )   ;   zswitch = 1           ! (0) standard levitating sea-ice : salt exchange only 
     124        CASE( 1, 2 )   ;   zswitch = 0           ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 
     125                                                 ! (2) embedded sea-ice : salt and volume fluxes and pressure 
     126      END SELECT                                 !     
    117127 
    118128      !------------------------------------------! 
     
    133143            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv  
    134144 
    135 !!$            zinda   = 1.0 - AINT( pfrld(ji,jj) )                   !   = 0. if pure ocean else 1. (at previous time) 
    136 !!$ 
    137 !!$            i1mfr   = 1.0 - AINT(  frld(ji,jj) )                   !   = 0. if pure ocean else 1. (at current  time) 
    138 !!$ 
    139 !!$            IF( phicif(ji,jj) <= 0. ) THEN   ;   ifvt = zinda      !   = 1. if (snow and no ice at previous time) else 0. ??? 
    140 !!$            ELSE                             ;   ifvt = 0. 
     145!!$            attempt to explain the tricky flags set above.... 
     146!!$            zinda   = 1.0 - AINT( pfrld(ji,jj) )                   ! = 0. if ice-free ocean else 1. (after ice adv, but before ice thermo) 
     147!!$            i1mfr   = 1.0 - AINT(  frld(ji,jj) )                   ! = 0. if ice-free ocean else 1. (after ice thermo) 
     148!!$ 
     149!!$            IF( phicif(ji,jj) <= 0. ) THEN   ;   ifvt = zinda      ! = zinda if previous thermodynamic step overmelted the ice??? 
     150!!$            ELSE                             ;   ifvt = 0.         !  
    141151!!$            ENDIF 
    142152!!$ 
    143 !!$            IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN   ;   idfr = 0.  !   = 0. if lead fraction increases from previous to current 
     153!!$            IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN   ;   idfr = 0.  !   = 0. if lead fraction increases due to ice thermodynamics 
    144154!!$            ELSE                                     ;   idfr = 1.    
    145155!!$            ENDIF 
    146156!!$ 
    147 !!$            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )    !   = 1. if ice (not only snow) at previous and pure ocean at current 
     157!!$            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )    !   = 1. if ice (not only snow) at previous time and ice-free ocean currently 
    148158!!$ 
    149159!!$            ial     = ifvt   * i1mfr    +    ( 1 - ifvt ) * idfr 
     160!!$                    = i1mfr if ifvt = 1 i.e.  
     161!!$                    = idfr  if ifvt = 0 
    150162!!$!                 snow no ice   ice         ice or nothing  lead fraction increases 
    151163!!$!                 at previous   now           at previous 
    152 !!$!                -> ice aera increases  ???         -> ice aera decreases ??? 
     164!!$!                -> ice area increases  ???         -> ice area decreases ??? 
    153165!!$ 
    154166!!$            iadv    = ( 1  - i1mfr ) * zinda 
     
    174186#endif             
    175187            !  computation the non solar heat flux at ocean surface 
    176             zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr   &   ! part of the solar energy used in leads 
    177                &       + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                            & 
    178                &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice    & 
    179                &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) )                   * r1_rdtice  
    180  
    181             fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! ??? 
    182             ! 
     188            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr                                              &   ! part of the solar energy used in leads 
     189               &       + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                             & 
     190               &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice  & 
     191               &       + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice  
     192 
     193            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! store residual heat flux (to put into the ocean at the next time-step) 
     194            zqhc = ( rdq_snw(ji,jj)                                     & 
     195                 & + rdq_ice(ji,jj) * ( 1.- zswitch) ) * r1_rdtice       ! heat flux due to snow ( & ice heat content,  
     196            !                                                            !           if ice/ocean mass exchange active)  
    183197            qsr  (ji,jj) = zqsr                                          ! solar heat flux  
    184             qns  (ji,jj) = zqns - fdtcn(ji,jj)                           ! non solar heat flux 
     198            qns  (ji,jj) = zqns - fdtcn(ji,jj) + zqhc                    ! non solar heat flux  
     199            ! 
     200            !                          !------------------------------------------! 
     201            !                          !  mass and salt flux at the ocean surface ! 
     202            !                          !------------------------------------------! 
     203            ! 
     204            ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 
     205#if defined key_coupled 
     206            !                                                  ! coupled mode:  
     207            zemp = + emp_tot(ji,jj)                            &     ! net mass flux over the grid cell (ice+ocean area) 
     208               &   - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )          ! minus the mass flux intercepted by sea-ice 
     209#else 
     210            !                                                  ! forced  mode:  
     211            zemp = + emp(ji,jj)     *         frld(ji,jj)      &     ! mass flux over open ocean fraction  
     212               &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &     ! liquid precip. over ice reaches directly the ocean 
     213               &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )          ! snow is intercepted by sea-ice (previous frld) 
     214#endif             
     215            ! 
     216            ! mass flux at the ocean/ice interface (sea ice fraction) 
     217            zemp_snw = rdm_snw(ji,jj) * r1_rdtice                    ! snow melting = pure water that enters the ocean 
     218            zfmm     = rdm_ice(ji,jj) * r1_rdtice                    ! Freezing minus Melting (F-M) 
     219 
     220            ! salt flux at the ice/ocean interface (sea ice fraction) [PSU*kg/m2/s] 
     221            zfsalt = - sice_0(ji,jj) * zfmm                          ! F-M salt exchange 
     222            zcd    =   soce_0(ji,jj) * zfmm                          ! concentration/dilution term due to F-M 
     223            ! 
     224            ! salt flux only       : add concentration dilution term in salt flux  and no  F-M term in volume flux 
     225            ! salt and mass fluxes : non concentration dilution term in salt flux  and add F-M term in volume flux 
     226            sfx (ji,jj) = zfsalt +                  zswitch  * zcd   ! salt flux (+ C/D if no ice/ocean mass exchange) 
     227            emp (ji,jj) = zemp   + zemp_snw + ( 1.- zswitch) * zfmm  ! mass flux (+ F/M mass flux if ice/ocean mass exchange) 
     228            ! 
    185229         END DO 
    186230      END DO 
     231      !                                !------------------------------------------! 
     232      !                                !    mass of snow and ice per unit area    ! 
     233      !                                !------------------------------------------! 
     234      IF( nn_ice_embd /= 0 ) THEN      ! embedded sea-ice (mass required) 
     235         snwice_mass_b(:,:) = snwice_mass(:,:)                  ! save mass from the previous ice time step 
     236         !                                                      ! new mass per unit area 
     237         snwice_mass  (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:)  ) * ( 1.0 - frld(:,:) ) 
     238         !                                                      ! time evolution of snow+ice mass 
     239         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / rdt_ice 
     240      ENDIF 
    187241 
    188242      CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )       
     
    190244      CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 
    191245 
    192       !------------------------------------------! 
    193       !      mass flux at the ocean surface      ! 
    194       !------------------------------------------! 
    195       DO jj = 1, jpj 
    196          DO ji = 1, jpi 
    197             ! 
    198 #if defined key_coupled 
    199             ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode) 
    200             zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  
    201                &   + rdmsnif(ji,jj) * r1_rdtice                                   !  freshwaterflux due to snow melting  
    202 #else 
    203             !  computing freshwater exchanges at the ice/ocean interface 
    204             zemp = + emp(ji,jj)     *         frld(ji,jj)      &   !  e-p budget over open ocean fraction  
    205                &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &   !  liquid precipitation reaches directly the ocean 
    206                &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  change in ice cover within the time step 
    207                &   + rdmsnif(ji,jj) * r1_rdtice                    !  freshwater flux due to snow melting  
    208 #endif             
    209             ! 
    210             !  computing salt exchanges at the ice/ocean interface 
    211             zfons = ( soce_0(ji,jj) - sice_0(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice )  
    212             ! 
    213             !  converting the salt flux from ice to a freshwater flux from ocean 
    214             zfm  = zfons / ( sss_m(ji,jj) + epsi16 ) 
    215             ! 
    216             emps(ji,jj) = zemp + zfm      ! surface ocean concentration/dilution effect (use on SSS evolution) 
    217             emp (ji,jj) = zemp            ! surface ocean volume flux (use on sea-surface height evolution) 
    218             ! 
    219          END DO 
    220       END DO 
    221  
    222246      IF( lk_diaar5 ) THEN       ! AR5 diagnostics 
    223          CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * r1_rdtice ) 
    224          CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdmicif(:,:) * r1_rdtice ) 
    225          CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdmicif(:,:) * r1_rdtice ) 
     247         CALL iom_put( 'isnwmlt_cea'  ,                 rdm_snw(:,:) * r1_rdtice ) 
     248         CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 
     249         CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 
    226250      ENDIF 
    227251 
     
    243267      IF(ln_ctl) THEN            ! control print 
    244268         CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ') 
    245          CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=emps  , clinfo2=' emps    : ') 
     269         CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx   , clinfo2=' sfx     : ') 
    246270         CALL prt_ctl(tab2d_1=utau  , clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
    247271            &         tab2d_2=vtau  , clinfo2=' vtau    : '        , mask2=vmask ) 
     
    439463         END WHERE 
    440464      ENDIF 
     465      !                                      ! embedded sea ice 
     466      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     467         snwice_mass  (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:)  ) * ( 1.0 - frld(:,:) ) 
     468         snwice_mass_b(:,:) = snwice_mass(:,:) 
     469      ELSE 
     470         snwice_mass  (:,:) = 0.e0           ! no mass exchanges 
     471         snwice_mass_b(:,:) = 0.e0           ! no mass exchanges 
     472      ENDIF 
     473      IF( nn_ice_embd == 2 .AND.          &  ! full embedment (case 2) & no restart :  
     474         &   .NOT.ln_rstart ) THEN           ! deplete the initial ssh below sea-ice area 
     475         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
     476         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     477      ENDIF 
    441478      ! 
    442479   END SUBROUTINE lim_sbc_init_2 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r3294 r3625  
    1313   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    1414   !!---------------------------------------------------------------------- 
    15    !!   lim_thd_2      : thermodynamic of sea ice 
    16    !!   lim_thd_init_2 : initialisation of sea-ice thermodynamic 
     15   !!   lim_thd_2       : thermodynamic of sea ice 
     16   !!   lim_thd_init_2  : initialisation of sea-ice thermodynamic 
    1717   !!---------------------------------------------------------------------- 
    18    USE phycst          ! physical constants 
    19    USE dom_oce         ! ocean space and time domain variables 
     18   USE phycst           ! physical constants 
     19   USE dom_oce          ! ocean space and time domain variables 
    2020   USE domvvl 
    2121   USE lbclnk 
    22    USE in_out_manager  ! I/O manager 
     22   USE in_out_manager   ! I/O manager 
    2323   USE lib_mpp 
    24    USE wrk_nemo        ! work arrays 
    25    USE iom             ! IOM library 
    26    USE ice_2           ! LIM sea-ice variables 
    27    USE sbc_oce         !  
    28    USE sbc_ice         !  
    29    USE thd_ice_2       ! LIM thermodynamic sea-ice variables 
    30    USE dom_ice_2       ! LIM sea-ice domain 
     24   USE wrk_nemo         ! work arrays 
     25   USE iom              ! IOM library 
     26   USE ice_2            ! LIM sea-ice variables 
     27   USE sbc_oce          !  
     28   USE sbc_ice          !  
     29   USE thd_ice_2        ! LIM thermodynamic sea-ice variables 
     30   USE dom_ice_2        ! LIM sea-ice domain 
    3131   USE limthd_zdf_2 
    3232   USE limthd_lac_2 
    3333   USE limtab_2 
    34    USE prtctl          ! Print control 
    35    USE cpl_oasis3, ONLY : lk_cpl 
    36    USE diaar5, ONLY :   lk_diaar5 
    37        
     34   USE prtctl           ! Print control 
     35   USE cpl_oasis3, ONLY :   lk_cpl 
     36   USE diaar5    , ONLY :   lk_diaar5 
     37   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     38    
    3839   IMPLICIT NONE 
    3940   PRIVATE 
     
    5556   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5657   !!---------------------------------------------------------------------- 
    57  
    5858CONTAINS 
    5959 
     
    8989      REAL(wp) ::   za , zh, zthsnice    ! 
    9090      REAL(wp) ::   zfric_u              ! friction velocity  
    91       REAL(wp) ::   zfnsol               ! total non solar heat 
    92       REAL(wp) ::   zfontn               ! heat flux from snow thickness 
    9391      REAL(wp) ::   zfntlat, zpareff     ! test. the val. of lead heat budget 
    9492 
     
    129127      zdvolif(:,:) = 0.e0   ! total variation of ice volume 
    130128      zdvonif(:,:) = 0.e0   ! transformation of snow to sea-ice volume 
    131 !      zdvonif(:,:) = 0.e0   ! lateral variation of ice volume 
    132129      zlicegr(:,:) = 0.e0   ! lateral variation of ice volume 
    133130      zdvomif(:,:) = 0.e0   ! variation of ice volume at bottom due to melting only 
     
    137134      ffltbif(:,:) = 0.e0   ! linked with fstric 
    138135      qfvbq  (:,:) = 0.e0   ! linked with fstric 
    139       rdmsnif(:,:) = 0.e0   ! variation of snow mass per unit area 
    140       rdmicif(:,:) = 0.e0   ! variation of ice mass per unit area 
     136      rdm_snw(:,:) = 0.e0   ! variation of snow mass over 1 time step 
     137      rdq_snw(:,:) = 0.e0   ! heat content associated with rdm_snw 
     138      rdm_ice(:,:) = 0.e0   ! variation of ice mass over 1 time step 
     139      rdq_ice(:,:) = 0.e0   ! heat content associated with rdm_ice 
    141140      zmsk (:,:,:) = 0.e0 
    142141 
     
    199198      !-------------------------------------------------------------------------- 
    200199 
    201       sst_m(:,:) = sst_m(:,:) + rt0 
    202  
    203 !CDIR NOVERRCHK 
    204       DO jj = 1, jpj 
    205 !CDIR NOVERRCHK 
     200      !CDIR NOVERRCHK 
     201      DO jj = 1, jpj 
     202         !CDIR NOVERRCHK 
    206203         DO ji = 1, jpi 
    207204            zthsnice       = hsnif(ji,jj) + hicif(ji,jj) 
     
    217214            !  temperature and turbulent mixing (McPhee, 1992) 
    218215            zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  ! friction velocity 
    219             fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_m(ji,jj) - tfu(ji,jj) )  
     216            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_m(ji,jj) + rt0 - tfu(ji,jj) )  
    220217            qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice 
    221218                         
    222219            !  partial computation of the lead energy budget (qldif) 
    223220#if defined key_coupled  
    224             qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                             & 
     221            qldif(ji,jj)   = tms(ji,jj) * rdt_ice                                                  & 
    225222               &    * (   ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) )   & 
    226223               &        + ( qns_tot(ji,jj) - qns_ice(ji,jj,1) * zfricp )                           & 
    227224               &        + frld(ji,jj) * ( fdtcn(ji,jj) + ( 1.0 - zindb ) * fsbbq(ji,jj) )   ) 
    228225#else 
    229             zfontn         = ( sprecip(ji,jj) / rhosn ) * xlsn  !   energy for melting solid precipitation 
    230             zfnsol         = qns(ji,jj)                         !  total non solar flux over the ocean 
    231             qldif(ji,jj)   = tms(ji,jj) * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )   & 
    232                &                               + zfnsol + fdtcn(ji,jj) - zfontn     & 
    233                &                               + ( 1.0 - zindb ) * fsbbq(ji,jj) )   & 
    234                &                        * frld(ji,jj) * rdt_ice     
    235 !!$            qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)  
    236 !!$               &           * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )      & 
    237 !!$               &             + qns(ji,jj)  + fdtcn(ji,jj) - zfontn     & 
    238 !!$               &             + ( 1.0 - zindb ) * fsbbq(ji,jj)      )   & 
     226            qldif(ji,jj)   = tms(ji,jj) * rdt_ice * frld(ji,jj)                    & 
     227               &                        * (  qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )    & 
     228               &                           + qns(ji,jj)  +  fdtcn(ji,jj)           & 
     229               &                           + ( 1.0 - zindb ) * fsbbq(ji,jj)      ) 
    239230#endif 
    240231            !  parlat : percentage of energy used for lateral ablation (0.0)  
     
    246237             
    247238            !  energy needed to bring ocean surface layer until its freezing 
    248             qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj,1)   & 
    249                 &          * ( tfu(ji,jj) - sst_m(ji,jj) ) * ( 1 - zinda ) 
     239            qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj,1) * ( tfu(ji,jj) - sst_m(ji,jj) - rt0 ) * ( 1 - zinda ) 
    250240             
    251241            !  calculate oceanic heat flux. 
     
    257247      END DO 
    258248       
    259       sst_m(:,:) = sst_m(:,:) - rt0 
    260                 
    261249      !         Select icy points and fulfill arrays for the vectorial grid. 
    262250      !---------------------------------------------------------------------- 
     
    312300         CALL tab_2d_1d_2( nbpb, qldif_1d   (1:nbpb)     , qldif      , jpi, jpj, npb(1:nbpb) ) 
    313301         CALL tab_2d_1d_2( nbpb, qstbif_1d  (1:nbpb)     , qstoif     , jpi, jpj, npb(1:nbpb) ) 
    314          CALL tab_2d_1d_2( nbpb, rdmicif_1d (1:nbpb)     , rdmicif    , jpi, jpj, npb(1:nbpb) ) 
     302         CALL tab_2d_1d_2( nbpb, rdm_ice_1d (1:nbpb)     , rdm_ice    , jpi, jpj, npb(1:nbpb) ) 
     303         CALL tab_2d_1d_2( nbpb, rdq_ice_1d (1:nbpb)     , rdq_ice    , jpi, jpj, npb(1:nbpb) ) 
    315304         CALL tab_2d_1d_2( nbpb, dmgwi_1d   (1:nbpb)     , dmgwi      , jpi, jpj, npb(1:nbpb) ) 
     305         CALL tab_2d_1d_2( nbpb, rdm_snw_1d (1:nbpb)     , rdm_snw    , jpi, jpj, npb(1:nbpb) ) 
     306         CALL tab_2d_1d_2( nbpb, rdq_snw_1d (1:nbpb)     , rdq_snw    , jpi, jpj, npb(1:nbpb) ) 
    316307         CALL tab_2d_1d_2( nbpb, qlbbq_1d   (1:nbpb)     , zqlbsbq    , jpi, jpj, npb(1:nbpb) ) 
    317308         ! 
     
    332323         CALL tab_1d_2d_2( nbpb, qfvbq      , npb, qfvbq_1d  (1:nbpb)     , jpi, jpj ) 
    333324         CALL tab_1d_2d_2( nbpb, qstoif     , npb, qstbif_1d (1:nbpb)     , jpi, jpj ) 
    334          CALL tab_1d_2d_2( nbpb, rdmicif    , npb, rdmicif_1d(1:nbpb)     , jpi, jpj ) 
     325         CALL tab_1d_2d_2( nbpb, rdm_ice    , npb, rdm_ice_1d(1:nbpb)     , jpi, jpj ) 
     326         CALL tab_1d_2d_2( nbpb, rdq_ice    , npb, rdq_ice_1d(1:nbpb)     , jpi, jpj ) 
    335327         CALL tab_1d_2d_2( nbpb, dmgwi      , npb, dmgwi_1d  (1:nbpb)     , jpi, jpj ) 
    336          CALL tab_1d_2d_2( nbpb, rdmsnif    , npb, rdmsnif_1d(1:nbpb)     , jpi, jpj ) 
     328         CALL tab_1d_2d_2( nbpb, rdm_snw    , npb, rdm_snw_1d(1:nbpb)     , jpi, jpj ) 
     329         CALL tab_1d_2d_2( nbpb, rdq_snw    , npb, rdq_snw_1d(1:nbpb)     , jpi, jpj ) 
    337330         CALL tab_1d_2d_2( nbpb, zdvosif    , npb, dvsbq_1d  (1:nbpb)     , jpi, jpj ) 
    338331         CALL tab_1d_2d_2( nbpb, zdvobif    , npb, dvbbq_1d  (1:nbpb)     , jpi, jpj ) 
     
    393386      IF( nbpac > 0 ) THEN 
    394387         ! 
    395          zlicegr(:,:) = rdmicif(:,:)      ! to output the lateral sea-ice growth  
     388         zlicegr(:,:) = rdm_ice(:,:)      ! to output the lateral sea-ice growth  
    396389         !...Put the variable in a 1-D array for lateral accretion 
    397390         CALL tab_2d_1d_2( nbpac, frld_1d   (1:nbpac)     , frld       , jpi, jpj, npac(1:nbpac) ) 
     
    404397         CALL tab_2d_1d_2( nbpac, qcmif_1d  (1:nbpac)     , qcmif      , jpi, jpj, npac(1:nbpac) ) 
    405398         CALL tab_2d_1d_2( nbpac, qstbif_1d (1:nbpac)     , qstoif     , jpi, jpj, npac(1:nbpac) ) 
    406          CALL tab_2d_1d_2( nbpac, rdmicif_1d(1:nbpac)     , rdmicif    , jpi, jpj, npac(1:nbpac) ) 
     399         CALL tab_2d_1d_2( nbpac, rdm_ice_1d(1:nbpac)     , rdm_ice    , jpi, jpj, npac(1:nbpac) ) 
     400         CALL tab_2d_1d_2( nbpac, rdq_ice_1d(1:nbpac)     , rdq_ice    , jpi, jpj, npac(1:nbpac) ) 
    407401         CALL tab_2d_1d_2( nbpac, dvlbq_1d  (1:nbpac)     , zdvolif    , jpi, jpj, npac(1:nbpac) ) 
    408402         CALL tab_2d_1d_2( nbpac, tfu_1d    (1:nbpac)     , tfu        , jpi, jpj, npac(1:nbpac) ) 
     
    418412         CALL tab_1d_2d_2( nbpac, tbif(:,:,3), npac(1:nbpac), tbif_1d   (1:nbpac , 3 ), jpi, jpj ) 
    419413         CALL tab_1d_2d_2( nbpac, qstoif     , npac(1:nbpac), qstbif_1d (1:nbpac)     , jpi, jpj ) 
    420          CALL tab_1d_2d_2( nbpac, rdmicif    , npac(1:nbpac), rdmicif_1d(1:nbpac)     , jpi, jpj ) 
     414         CALL tab_1d_2d_2( nbpac, rdm_ice    , npac(1:nbpac), rdm_ice_1d(1:nbpac)     , jpi, jpj ) 
     415         CALL tab_1d_2d_2( nbpac, rdq_ice    , npac(1:nbpac), rdq_ice_1d(1:nbpac)     , jpi, jpj ) 
    421416         CALL tab_1d_2d_2( nbpac, zdvolif    , npac(1:nbpac), dvlbq_1d  (1:nbpac)     , jpi, jpj ) 
    422417         ! 
     
    449444      CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp     )   ! Ice produced               [m/s] 
    450445      IF( lk_diaar5 ) THEN 
    451          CALL iom_put( 'snowmel_cea' , rdmsnif(:,:) * zztmp     )   ! Snow melt                  [kg/m2/s] 
     446         CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp     )   ! Snow melt                  [kg/m2/s] 
    452447         zztmp = rhoic / rdt_ice 
    453448         CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp     )   ! Snow to Ice transformation [kg/m2/s] 
    454449         CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp     )   ! Melt at Sea Ice top        [kg/m2/s] 
    455450         CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp     )   ! Melt at Sea Ice bottom     [kg/m2/s] 
    456          zlicegr(:,:) = MAX( 0.e0, rdmicif(:,:)-zlicegr(:,:) ) 
    457          CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp     )   ! Latereal sea ice growth    [kg/m2/s] 
     451         zlicegr(:,:) = MAX( 0.e0, rdm_ice(:,:)-zlicegr(:,:) ) 
     452         CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp     )   ! Lateral sea ice growth     [kg/m2/s] 
    458453      ENDIF 
    459454      ! 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90

    r3294 r3625  
    77 
    88   !!---------------------------------------------------------------------- 
    9    !!   lim_lat_acr_2   : lateral accretion of ice 
    10    !!---------------------------------------------------------------------- 
    11    USE par_oce          ! ocean parameters 
     9   !!   lim_lat_acr_2 : lateral accretion of ice 
     10   !!---------------------------------------------------------------------- 
     11   USE par_oce        ! ocean parameters 
    1212   USE phycst 
    1313   USE thd_ice_2 
    1414   USE ice_2 
    1515   USE limistate_2  
    16    USE lib_mpp          ! MPP library 
    17    USE wrk_nemo         ! work arrays 
     16   USE lib_mpp        ! MPP library 
     17   USE wrk_nemo       ! work arrays 
     18   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    1819 
    1920   IMPLICIT NONE 
     
    145146         frld_1d   (ji) = MAX( zfrlnew , zfrlmin(ji) ) 
    146147         !--computation of the remaining part of ice thickness which has been already used 
    147          zdhicbot(ji) =  ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) ) &  
    148                       -  (  ( 1.0 - zfrrate ) / ( 1.0 - frld_1d(ji) ) )  * ( zqbgow(ji) / xlic )  
     148         zdhicbot(ji) =  ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) )   &  
     149            &         -  (  ( 1.0 - zfrrate ) / ( 1.0 - frld_1d(ji) ) )  * ( zqbgow(ji) / xlic )  
    149150      END DO 
    150151  
     
    196197            &          ) / zah 
    197198          
    198          tbif_1d(ji,3) =     (  iiceform * ( zhnews2 - zdh3 )                                          * zta1  & 
     199         tbif_1d(ji,3) =     ( iiceform * ( zhnews2 - zdh3 )                                           * zta1  & 
    199200            &              + ( iiceform * zdh3 + ( 1 - iiceform ) * zdh1 )                             * zta2  & 
    200201            &              + ( iiceform * ( zhnews2 - zdh5 ) + ( 1 - iiceform ) * ( zhnews2 - zdh1 ) ) * zta3  &  
     
    217218      DO ji = kideb , kiut 
    218219         dvlbq_1d  (ji) = ( 1. - frld_1d(ji) ) * h_ice_1d(ji) - ( 1. - zfrl_old(ji) ) * zhice_old(ji) 
    219          rdmicif_1d(ji) = rdmicif_1d(ji) + rhoic * dvlbq_1d(ji) 
     220         rdm_ice_1d(ji) = rdm_ice_1d(ji) + rhoic * dvlbq_1d(ji) 
     221         rdq_ice_1d(ji) = rdq_ice_1d(ji) + rcpic * dvlbq_1d(ji) * ( tfu_1d(ji) - rt0 )      ! heat content relative to rt0 
    220222      END DO 
    221223       
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r3294 r3625  
    1818   USE ice_2 
    1919   USE limistate_2 
     20   USE cpl_oasis3, ONLY : lk_cpl 
    2021   USE in_out_manager 
    2122   USE lib_mpp          ! MPP library 
    2223   USE wrk_nemo         ! work arrays 
    23    USE cpl_oasis3, ONLY : lk_cpl 
    24        
     24   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     25     
    2526   IMPLICIT NONE 
    2627   PRIVATE 
     
    8687      REAL(wp), POINTER, DIMENSION(:) ::   zrcpdt         ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer) 
    8788      REAL(wp), POINTER, DIMENSION(:) ::   zts_old        ! previous surface temperature 
    88       REAL(wp), POINTER, DIMENSION(:) ::   zidsn , z1midsn , zidsnic ! tempory variables 
     89      REAL(wp), POINTER, DIMENSION(:) ::   zidsn , z1midsn , zidsnic ! temporary variables 
    8990      REAL(wp), POINTER, DIMENSION(:) ::   zfnet          ! net heat flux at the top surface( incl. conductive heat flux) 
    9091      REAL(wp), POINTER, DIMENSION(:) ::   zsprecip       ! snow accumulation 
     
    9899      REAL(wp), POINTER, DIMENSION(:) ::   zep            ! internal temperature of the 2nd layer of the snow/ice system 
    99100      REAL(wp), DIMENSION(3) :: &  
    100           zplediag  &    ! principle diagonal, subdiag. and supdiag. of the  
     101            zplediag  &    ! principle diagonal, subdiag. and supdiag. of the  
    101102          , zsubdiag  &    ! tri-diagonal matrix coming from the computation 
    102103          , zsupdiag  &    ! of the temperatures inside the snow-ice system 
    103104          , zsmbr          ! second member 
    104        REAL(wp) :: &  
    105           zhsu     &     ! thickness of surface layer 
    106           , zhe      &     ! effective thickness for compu. of equ. thermal conductivity 
    107           , zheshth  &     ! = zhe / thth 
    108           , zghe     &     ! correction factor of the thermal conductivity 
    109           , zumsb    &     ! parameter for numerical method to solve heat-diffusion eq. 
    110           , zkhsn    &     ! conductivity at the snow layer 
    111           , zkhic    &     ! conductivity at the ice layers 
    112           , zkint    &     ! equivalent conductivity at the snow-ice interface 
    113           , zkhsnint &     ! = zkint*dt / (hsn*rhosn*cpsn)   
    114           , zkhicint &     ! = 2*zkint*dt / (hic*rhoic*cpic) 
    115           , zpiv1 , zpiv2  &       ! tempory scalars used to solve the tri-diagonal system 
    116           , zb2 , zd2 , zb3 , zd3 & 
     105       REAL(wp) ::    & 
     106            zhsu      &    ! thickness of surface layer 
     107          , zhe       &    ! effective thickness for compu. of equ. thermal conductivity 
     108          , zheshth   &    ! = zhe / thth 
     109          , zghe      &    ! correction factor of the thermal conductivity 
     110          , zumsb     &    ! parameter for numerical method to solve heat-diffusion eq. 
     111          , zkhsn     &    ! conductivity at the snow layer 
     112          , zkhic     &    ! conductivity at the ice layers 
     113          , zkint     &    ! equivalent conductivity at the snow-ice interface 
     114          , zkhsnint  &    ! = zkint*dt / (hsn*rhosn*cpsn)   
     115          , zkhicint  &    ! = 2*zkint*dt / (hic*rhoic*cpic) 
     116          , zpiv1, zpiv2 & ! temporary scalars used to solve the tri-diagonal system 
     117          , zb2, zd2  &    ! temporary scalars used to solve the tri-diagonal system 
     118          , zb3, zd3  &    ! temporary scalars used to solve the tri-diagonal system 
    117119          , ztint          ! equivalent temperature at the snow-ice interface 
    118        REAL(wp) :: &  
    119           zexp      &     ! exponential function of the ice thickness 
    120           , zfsab     &     ! part of solar radiation stored in brine pockets 
    121           , zfts      &     ! value of energy balance function when the temp. equal surf. temp. 
    122           , zdfts     &     ! value of derivative of ztfs when the temp. equal surf. temp. 
    123           , zdts      &     ! surface temperature increment 
    124           , zqsnw_mlt &     ! energy needed to melt snow 
    125           , zdhsmlt   &     ! change in snow thickness due to melt 
    126           , zhsn      &     ! snow thickness (previous+accumulation-melt) 
    127           , zqsn_mlt_rem &  ! remaining heat coming from snow melting 
    128           , zqice_top_mlt & ! energy used to melt ice at top surface 
    129           , zdhssub      &  ! change in snow thick. due to sublimation or evaporation 
    130           , zdhisub      &  ! change in ice thick. due to sublimation or evaporation     
    131           , zdhsn        &  ! snow ice thickness increment 
    132           , zdtsn        &  ! snow internal temp. increment 
    133           , zdtic        &  ! ice internal temp. increment 
     120       REAL(wp) ::    &  
     121            zexp      &    ! exponential function of the ice thickness 
     122          , zfsab     &    ! part of solar radiation stored in brine pockets 
     123          , zfts      &    ! value of energy balance function when the temp. equal surf. temp. 
     124          , zdfts     &    ! value of derivative of ztfs when the temp. equal surf. temp. 
     125          , zdts      &    ! surface temperature increment 
     126          , zqsnw_mlt &    ! energy needed to melt snow 
     127          , zdhsmlt   &    ! change in snow thickness due to melt 
     128          , zhsn      &    ! snow thickness (previous+accumulation-melt) 
     129          , zqsn_mlt_rem & ! remaining heat coming from snow melting 
     130          , zqice_top_mlt &! energy used to melt ice at top surface 
     131          , zdhssub     ! change in snow thick. due to sublimation or evaporation 
     132          , zdhisub     ! change in ice thick. due to sublimation or evaporation     
     133          , zdhsn       ! snow ice thickness increment 
     134          , zdtsn       ! snow internal temp. increment 
     135          , zdtic       ! ice internal temp. increment 
    134136          , zqnes          ! conductive energy due to ice melting in the first ice layer 
    135        REAL(wp) :: &  
    136           ztbot     &      ! temperature at the bottom surface 
    137           , zfcbot    &      ! conductive heat flux at bottom surface 
    138           , zqice_bot &      ! energy used for bottom melting/growing 
    139           , zqice_bot_mlt &  ! energy used for bottom melting 
    140           , zqstbif_bot  &  ! part of energy stored in brine pockets used for bottom melting 
    141           , zqstbif_old  &  ! tempory var. for zqstbif_bot 
    142           , zdhicmlt      &  ! change in ice thickness due to bottom melting 
    143           , zdhicm        &  ! change in ice thickness var.  
    144           , zdhsnm        &  ! change in snow thickness var.  
    145           , zhsnfi        &  ! snow thickness var.  
    146           , zc1, zpc1, zc2, zpc2, zp1, zp2 & ! tempory variables 
    147           , ztb2, ztb3 
    148        REAL(wp) :: &  
    149           zdrmh         &   ! change in snow/ice thick. after snow-ice formation 
    150           , zhicnew       &   ! new ice thickness 
    151           , zhsnnew       &   ! new snow thickness 
    152           , zquot , ztneq &   ! tempory temp. variables 
    153           , zqice, zqicetot & ! total heat inside the snow/ice system 
    154           , zdfrl         &   ! change in ice concentration 
    155           , zdvsnvol      &   ! change in snow volume 
    156           , zdrfrl1, zdrfrl2 &  ! tempory scalars 
    157           , zihsn, zidhb, zihic, zihe, zihq, ziexp, ziqf, zihnf, zibmlt, ziqr, zihgnew, zind 
     137       REAL(wp) ::    &  
     138            ztbot     &    ! temperature at the bottom surface 
     139          , zfcbot    &    ! conductive heat flux at bottom surface 
     140          , zqice_bot &    ! energy used for bottom melting/growing 
     141          , zqice_bot_mlt &! energy used for bottom melting 
     142          , zqstbif_bot  & ! part of energy stored in brine pockets used for bottom melting 
     143          , zqstbif_old  & ! temporary var. for zqstbif_bot 
     144          , zdhicmlt  &    ! change in ice thickness due to bottom melting 
     145          , zdhicm    &    ! change in ice thickness var.  
     146          , zdhsnm    &    ! change in snow thickness var.  
     147          , zhsnfi    &    ! snow thickness var.  
     148          , zc1, zpc1 &    ! temporary variables 
     149          , zc2, zpc2 &    ! temporary variables 
     150          , zp1, zp2  &    ! temporary variables 
     151          , ztb2, ztb3     ! temporary variables 
     152       REAL(wp) ::    &  
     153            zdrmh     &    ! change in snow/ice thick. after snow-ice formation 
     154          , zhicnew   &    ! new ice thickness 
     155          , zhsnnew   &    ! new snow thickness 
     156          , zquot     & 
     157          , ztneq     &    ! temporary temp. variables 
     158          , zqice     & 
     159          , zqicetot  &    ! total heat inside the snow/ice system 
     160          , zdfrl     &    ! change in ice concentration 
     161          , zdvsnvol  &    ! change in snow volume 
     162          , zdrfrl1, zdrfrl2, zihsn, zidhb, zihic &  ! temporary scalars 
     163          , zihe, zihq, ziexp, ziqf, zihnf        &  ! temporary scalars 
     164          , zibmlt, ziqr, zihgnew, zind, ztmp        ! temporary scalars 
    158165       !!---------------------------------------------------------------------- 
    159166       CALL wrk_alloc( jpij, ztsmlt, ztbif  , zksn    , zkic    , zksndh , zfcsu  , zfcsudt , zi0      , z1mi0   , zqmax    ) 
     
    169176        
    170177       DO ji = kideb , kiut 
     178          ! do nothing if the snow (ice) thickness falls below its minimum thickness 
    171179          zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) ) 
    172180          zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) ) 
    173           !--computation of energy due to surface melting 
    174           zqcmlts(ji) = ( MAX ( zzero ,  & 
    175              &                   rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 
    176           !--computation of energy due to bottom melting 
    177           zqcmltb(ji) = ( MAX( zzero , & 
    178              &                  rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 
    179              &           + MAX( zzero , & 
    180              &                  rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 
    181              &           ) * ( 1.0 - zihic  ) 
    182           !--limitation of  snow/ice system internal temperature 
     181          !--energy required to bring snow to its melting point (rt0_snow) 
     182          zqcmlts(ji) = ( MAX ( zzero , rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 
     183          !--energy required to bring ice to its melting point (rt0_ice) 
     184          zqcmltb(ji) = ( MAX( zzero , rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) )  & 
     185             &          + MAX( zzero , rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) )  & 
     186             &          ) * ( 1.0 - zihic  ) 
     187          !--limitation of snow/ice system internal temperature 
    183188          tbif_1d(ji,1)   = MIN( rt0_snow, tbif_1d(ji,1) ) 
    184189          tbif_1d(ji,2)   = MIN( rt0_ice , tbif_1d(ji,2) ) 
     
    480485          dvsbq_1d(ji) =  ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnw_old(ji) - zsprecip(ji) ) 
    481486          dvsbq_1d(ji) =  MIN( zzero , dvsbq_1d(ji) ) 
    482           rdmsnif_1d(ji) =  rhosn * dvsbq_1d(ji) 
     487          ztmp = rhosn * dvsbq_1d(ji) 
     488          rdm_snw_1d(ji) =  ztmp 
     489          !--heat content of the water provided to the ocean (referenced to rt0) 
     490          rdq_snw_1d(ji) =  cpic * ztmp * ( rt0_snow - rt0 ) 
    483491          !-- If the snow is completely melted the remaining heat is used to melt ice 
    484492          zqsn_mlt_rem  = MAX( zzero , -zhsn ) * xlsn 
     
    623631          !---updating new ice thickness and computing the newly formed ice mass 
    624632          zhicnew   =  zihgnew * zhicnew 
    625           rdmicif_1d(ji) =  rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic 
     633          ztmp    =  ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic 
     634          rdm_ice_1d(ji) =  rdm_ice_1d(ji) + ztmp 
     635          !---heat content of the water provided to the ocean (referenced to rt0) 
     636          !   use of rt0_ice is OK for melting ice; in the case of freezing, tfu_1d should be used.  
     637          !   This is done in 9.5 section (see below) 
     638          rdq_ice_1d(ji) =  cpic * ztmp * ( rt0_ice - rt0 ) 
    626639          !---updating new snow thickness and computing the newly formed snow mass 
    627640          zhsnfi   = zhsn + zdhsnm 
    628641          h_snow_1d(ji) = MAX( zzero , zhsnfi ) 
    629           rdmsnif_1d(ji) =  rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn 
     642          ztmp = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn 
     643          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 
     644          !---updating the heat content of the water provided to the ocean (referenced to rt0) 
     645          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 ) 
    630646          !--remaining energy in case of total ablation 
    631647          zqocea(ji) = - ( zihsn * xlic * zdhicm + xlsn * ( zhsnfi - h_snow_1d(ji) ) ) * ( 1.0 - frld_1d(ji) ) 
     
    659675          tbif_1d(ji,3) =  zihgnew * ztb3 + ( 1.0 - zihgnew ) * tfu_1d(ji) 
    660676          h_ice_1d(ji)  =  zhicnew 
     677          ! update the ice heat content given to the ocean in freezing case  
     678          ! (part due to difference between rt0_ice and tfu_1d) 
     679          ztmp = ( 1. - zidhb ) * rhoic * dvbbq_1d(ji) 
     680          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0_ice ) 
    661681       END DO 
    662682 
     
    700720          dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn 
    701721          !---  volume change of ice and snow (used for ocean-ice freshwater flux computation) 
    702           rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhicnew - h_ice_1d (ji) ) * rhoic 
    703           rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn 
     722          ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d (ji) ) * rhoic 
     723          rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp 
     724          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0 ) 
     725          !!gm BUG ??   snow ==>  only needed for nn_ice_embd == 0  (standard levitating sea-ice) 
     726          ztmp = ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn 
     727          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 
     728          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 ) 
    704729 
    705730          !---  Actualize new snow and ice thickness. 
     
    748773          !--variation of ice volume and ice mass  
    749774          dvlbq_1d(ji)   = zihic * ( zfrl_old(ji) - frld_1d(ji) ) * h_ice_1d(ji) 
    750           rdmicif_1d(ji) = rdmicif_1d(ji) + dvlbq_1d(ji) * rhoic 
     775          ztmp = dvlbq_1d(ji) * rhoic 
     776          rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp 
     777!!gm 
     778!!gm   This should be split in two parts: 
     779!!gm         1-  heat required to bring sea-ice to tfu  : this part should be added to the heat flux taken from the ocean 
     780!!gm                 cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0_ice ) 
     781!!gm         2-  heat content of lateral ablation referenced to rt0 : this part only put in rdq_ice_1d 
     782!!gm                 cpic * ztmp * ( rt0_ice - rt0 ) 
     783!!gm   Currently we put all the heat in rdq_ice_1d 
     784          rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0 ) 
     785          ! 
    751786          !--variation of snow volume and snow mass  
    752           zdvsnvol    = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji) 
    753           rdmsnif_1d(ji) = rdmsnif_1d(ji) + zdvsnvol * rhosn 
     787          zdvsnvol = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji) 
     788          ztmp     = zdvsnvol * rhosn 
     789          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp 
     790!!gm 
     791!!gm   This should be split in two parts: 
     792!!gm         1-  heat required to bring snow to tfu  : this part should be added to the heat flux taken from the ocean 
     793!!gm                 cpic * ztmp * ( tbif_1d(ji,1) - rt0_snow ) 
     794!!gm         2-  heat content of lateral ablation referenced to rt0 : this part only put in rdq_snw_1d 
     795!!gm                 cpic * ztmp * ( rt0_snow - rt0 ) 
     796!!gm   Currently we put all the heat in rdq_snw_1d 
     797          rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( tbif_1d(ji,1) - rt0 ) 
     798 
    754799          h_snow_1d(ji)  = ziqf * h_snow_1d(ji) 
    755800 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

    r3294 r3625  
    1313   !!---------------------------------------------------------------------- 
    1414   !!---------------------------------------------------------------------- 
    15    !!   lim_wri_2      : write of the diagnostics variables in ouput file  
    16    !!   lim_wri_init_2 : initialization and namelist read 
     15   !!   lim_wri_2       : write of the diagnostics variables in ouput file  
     16   !!   lim_wri_init_2  : initialization and namelist read 
    1717   !!   lim_wri_state_2 : write for initial state or/and abandon: 
    1818   !!                     > output.init.nc (if ninist = 1 in namelist) 
     
    2626   USE ice_2 
    2727 
    28    USE dianam          ! build name of file (routine) 
     28   USE dianam           ! build name of file (routine) 
    2929   USE lbclnk 
    3030   USE in_out_manager 
    31    USE lib_mpp         ! MPP library 
    32    USE wrk_nemo        ! work arrays 
     31   USE lib_mpp          ! MPP library 
     32   USE wrk_nemo         ! work arrays 
    3333   USE iom 
    3434   USE ioipsl 
     35   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3536 
    3637   IMPLICIT NONE 
     
    173174            zcmo(ji,jj,13) = qns(ji,jj) 
    174175            ! See thersf for the coefficient 
    175             zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ??? 
     176            zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ??? 
    176177            zcmo(ji,jj,15) = utau_ice(ji,jj) 
    177178            zcmo(ji,jj,16) = vtau_ice(ji,jj) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    r3294 r3625  
    118118          zcmo(ji,jj,13) = qns(ji,jj) 
    119119          ! See thersf for the coefficient 
    120           zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     120          zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
    121121          zcmo(ji,jj,15) = utau_ice(ji,jj) 
    122122          zcmo(ji,jj,16) = vtau_ice(ji,jj) 
     
    161161                rcmoy(ji,jj,13) = qns(ji,jj) 
    162162                ! See thersf for the coefficient 
    163                 rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     163                rcmoy(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
    164164                rcmoy(ji,jj,15) = utau_ice(ji,jj) 
    165165                rcmoy(ji,jj,16) = vtau_ice(ji,jj) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90

    r2715 r3625  
    6868      qstbif_1d   ,     &  !:    "                  "      qstoif 
    6969      fbif_1d     ,     &  !:    "                  "      fbif 
    70       rdmicif_1d  ,     &  !:    "                  "      rdmicif 
    71       rdmsnif_1d  ,     &  !:    "                  "      rdmsnif 
     70      rdm_ice_1d  ,     &  !:    "                  "      rdm_ice 
     71      rdq_ice_1d  ,     &  !:    "                  "      rdq_ice 
     72      rdm_snw_1d  ,     &  !:    "                  "      rdm_snw 
     73      rdq_snw_1d  ,     &  !:    "                  "      rdq_snw 
    7274      qlbbq_1d    ,     &  !:    "                  "      qlbsbq 
    7375      dmgwi_1d    ,     &  !:    "                  "      dmgwi 
     
    108110         &      qstbif_1d(jpij),  fbif_1d(jpij),  Stat=ierr(2)) 
    109111         ! 
    110       ALLOCATE( rdmicif_1d(jpij), rdmsnif_1d(jpij), qlbbq_1d(jpij),   & 
     112      ALLOCATE( rdm_ice_1d(jpij), rdq_ice_1d(jpij)                  , & 
     113         &      rdm_snw_1d(jpij), rdq_snw_1d(jpij), qlbbq_1d(jpij)  , & 
    111114         &      dmgwi_1d(jpij)  , dvsbq_1d(jpij)  , rdvomif_1d(jpij), & 
    112115         &      dvbbq_1d(jpij)  , dvlbq_1d(jpij)  , dvnbq_1d(jpij)  , & 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r2777 r3625  
    99   USE par_ice        ! LIM-3 parameter 
    1010   USE in_out_manager ! I/O manager 
    11    USE lib_mpp         ! MPP library 
     11   USE lib_mpp        ! MPP library 
     12   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    1213 
    1314   IMPLICIT NONE 
     
    3031 
    3132   !!---------------------------------------------------------------------- 
    32    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     33   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    3334   !! $Id$ 
    3435   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r2777 r3625  
    99#if defined key_lim3 
    1010   !!---------------------------------------------------------------------- 
    11    !!   'key_lim3' :                                   LIM3 sea-ice model 
    12    !!---------------------------------------------------------------------- 
    13    USE par_ice          ! LIM sea-ice parameters 
    14    USE in_out_manager   ! I/O manager 
    15    USE lib_mpp         ! MPP library 
     11   !!   'key_lim3'                                      LIM-3 sea-ice model 
     12   !!---------------------------------------------------------------------- 
     13   USE par_ice        ! LIM sea-ice parameters 
     14   USE in_out_manager ! I/O manager 
     15   USE lib_mpp        ! MPP library 
    1616 
    1717   IMPLICIT NONE 
     
    158158   !! * Share Module variables 
    159159   !!-------------------------------------------------------------------------- 
    160    INTEGER , PUBLIC ::   nstart    !: iteration number of the begining of the run  
    161    INTEGER , PUBLIC ::   nlast     !: iteration number of the end of the run  
    162    INTEGER , PUBLIC ::   nitrun    !: number of iteration 
    163    INTEGER , PUBLIC ::   numit     !: iteration number 
    164    REAL(wp), PUBLIC ::   rdt_ice   !: ice time step 
     160   INTEGER , PUBLIC ::   nstart      !: iteration number of the begining of the run  
     161   INTEGER , PUBLIC ::   nlast       !: iteration number of the end of the run  
     162   INTEGER , PUBLIC ::   nitrun      !: number of iteration 
     163   INTEGER , PUBLIC ::   numit       !: iteration number 
     164   REAL(wp), PUBLIC ::   rdt_ice     !: ice time step 
     165   REAL(wp), PUBLIC ::   r1_rdtice   !: = 1. / rdt_ice 
    165166 
    166167   !                                          !!** ice-dynamic namelist (namicedyn) ** 
     
    201202   !                                              !!** ice-salinity namelist (namicesal) ** 
    202203   INTEGER , PUBLIC ::   num_sal     = 1           !: salinity configuration used in the model 
    203    !                                               ! 1 - s constant in space and time 
     204   !                                               ! 1 - constant salinity in both space and time 
    204205   !                                               ! 2 - prognostic salinity (s(z,t)) 
    205206   !                                               ! 3 - salinity profile, constant in time 
    206    !                                               ! 4 - salinity variations affect only ice thermodynamics 
    207207   INTEGER , PUBLIC ::   sal_prof    = 1           !: salinity profile or not  
    208208   INTEGER , PUBLIC ::   thcon_i_swi = 1           !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007) 
     
    264264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness 
    265265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif        !: Heat flux at the ice base 
    266    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmsnif     !: Variation of snow mass 
    267    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmicif     !: Variation of ice mass 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_snw     !: Variation of snow mass over 1 time step     [Kg/m2] 
     267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_snw     !: Heat content associated with rdm_snw        [J/m2] 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_ice     !: Variation of ice mass over 1 time step      [Kg/m2] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_ice     !: Heat content associated with rdm_ice        [J/m2] 
    268270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif       !: heat balance of the lead (or of the open ocean) 
    269271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif       !: Energy needed to bring the ocean to freezing  
     
    276278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq       !: store energy in case of total lateral ablation (?) 
    277279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi       !: Variation of the mass of snow ice 
    278    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsalt_res   !: Residual salt flux due to correction of ice thickness 
    279    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbri       !: Salt flux due to brine rejection 
    280    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsalt_rpo   !: Salt flux associated with porous ridged ice formation 
    281    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_rpo   !: Heat flux associated with porous ridged ice formation 
     280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_thd     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bri     !: salt flux due to brine rejection                      [PSU/m2/s] 
     282   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_mec     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
     283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: residual salt flux due to correction of ice thickness [PSU/m2/s] 
    282284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhbri       !: heat flux due to brine rejection 
    283    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmec       !: Mass flux due to snow loss during compression 
    284    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fseqv       !: Equivalent salt flux due to ice growth/melt 
    285    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhmec       !: Heat flux due to snow loss during compression 
    286    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_res   !: Residual heat flux due to correction of ice thickness 
     285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_mec   !: heat flux associated with porous ridged ice formation [???] 
     286   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_res   !: residual heat flux due to correction of ice thickness 
     287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmec       !: mass flux due to snow loss during compression         [Kg/m2/s] 
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhmec       !: heat flux due to snow loss during compression 
    287289 
    288290   ! temporary arrays for dummy version of the code 
     
    415417 
    416418   !!---------------------------------------------------------------------- 
    417    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
     419   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 
    418420   !! $Id$ 
    419421   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    444446 
    445447      ii = ii + 1 
    446       ALLOCATE( firic    (jpi,jpj) , fcsic  (jpi,jpj) , fleic    (jpi,jpj) , qlatic   (jpi,jpj) ,     & 
    447          &      rdvosif  (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif  (jpi,jpj) , rdvonif  (jpi,jpj) ,     & 
    448          &      sist     (jpi,jpj) , icethi (jpi,jpj) , t_bo     (jpi,jpj) , hicifp   (jpi,jpj) ,     & 
    449          &      frld     (jpi,jpj) , pfrld  (jpi,jpj) , phicif   (jpi,jpj) , fbif     (jpi,jpj) ,     & 
    450          &      rdmsnif  (jpi,jpj) , rdmicif(jpi,jpj) , qldif    (jpi,jpj) , qcmif    (jpi,jpj) ,     & 
    451          &      fdtcn    (jpi,jpj) , qdtcn  (jpi,jpj) , fstric   (jpi,jpj) , fscmbq   (jpi,jpj) ,     & 
    452          &      ffltbif  (jpi,jpj) , fsbbq  (jpi,jpj) , qfvbq    (jpi,jpj) , dmgwi    (jpi,jpj) ,     & 
    453          &      fsalt_res(jpi,jpj) , fsbri  (jpi,jpj) , fsalt_rpo(jpi,jpj) , fheat_rpo(jpi,jpj) ,     & 
    454          &      fhbri    (jpi,jpj) , fmmec  (jpi,jpj) , fseqv    (jpi,jpj) , fhmec    (jpi,jpj) ,     & 
    455          &      fheat_res(jpi,jpj)                                                              , STAT=ierr(ii) ) 
     448      ALLOCATE( firic    (jpi,jpj) , fcsic  (jpi,jpj) , fleic  (jpi,jpj) , qlatic   (jpi,jpj) ,     & 
     449         &      rdvosif  (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif(jpi,jpj) , rdvonif  (jpi,jpj) ,     & 
     450         &      sist     (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) , hicifp   (jpi,jpj) ,     & 
     451         &      frld     (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) , fbif     (jpi,jpj) ,     & 
     452         &      rdm_snw  (jpi,jpj) , rdq_snw(jpi,jpj) , rdm_ice(jpi,jpj) , rdq_ice  (jpi,jpj) ,     & 
     453         &                                              qldif  (jpi,jpj) , qcmif    (jpi,jpj) ,     & 
     454         &      fdtcn    (jpi,jpj) , qdtcn  (jpi,jpj) , fstric (jpi,jpj) , fscmbq   (jpi,jpj) ,     & 
     455         &      ffltbif  (jpi,jpj) , fsbbq  (jpi,jpj) , qfvbq  (jpi,jpj) , dmgwi    (jpi,jpj) ,     & 
     456         &      sfx_res  (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_mec(jpi,jpj) , fheat_mec(jpi,jpj) ,     & 
     457         &      fhbri    (jpi,jpj) , fmmec  (jpi,jpj) , sfx_thd(jpi,jpj) , fhmec    (jpi,jpj) ,     & 
     458         &      fheat_res(jpi,jpj)                                                            , STAT=ierr(ii) ) 
    456459 
    457460      ii = ii + 1 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

    r3294 r3625  
    1010#if defined key_lim3 
    1111   !!---------------------------------------------------------------------- 
    12    !!   'key_lim3' :                                   LIM sea-ice model 
    13    !!---------------------------------------------------------------------- 
    14    !!   ice_init       : sea-ice model initialization 
    15    !!---------------------------------------------------------------------- 
    16    USE phycst           ! physical constants 
    17    USE dom_oce          ! ocean domain 
    18    USE sbc_oce          ! Surface boundary condition: ocean fields 
    19    USE sbc_ice          ! Surface boundary condition: ice   fields 
    20    USE ice              ! LIM variables 
    21    USE par_ice          ! LIM parameters 
    22    USE dom_ice          ! LIM domain 
    23    USE thd_ice          ! LIM thermodynamical variables 
    24    USE limitd_me        ! LIM ice thickness distribution 
    25    USE limmsh           ! LIM mesh 
    26    USE limistate        ! LIM initial state 
    27    USE limrst           ! LIM restart 
    28    USE limthd           ! LIM ice thermodynamics 
    29    USE limthd_sal       ! LIM ice thermodynamics: salinity 
    30    USE limvar           ! LIM variables 
    31    USE limsbc           ! LIM surface boundary condition 
    32    USE in_out_manager   ! I/O manager 
    33    USE lib_mpp          ! MPP library 
     12   !!   'key_lim3'                                     LIM sea-ice model 
     13   !!---------------------------------------------------------------------- 
     14   !!   ice_init      : sea-ice model initialization 
     15   !!---------------------------------------------------------------------- 
     16   USE phycst         ! physical constants 
     17   USE dom_oce        ! ocean domain 
     18   USE sbc_oce        ! Surface boundary condition: ocean fields 
     19   USE sbc_ice        ! Surface boundary condition: ice   fields 
     20   USE ice            ! LIM variables 
     21   USE par_ice        ! LIM parameters 
     22   USE dom_ice        ! LIM domain 
     23   USE thd_ice        ! LIM thermodynamical variables 
     24   USE limitd_me      ! LIM ice thickness distribution 
     25   USE limmsh         ! LIM mesh 
     26   USE limistate      ! LIM initial state 
     27   USE limrst         ! LIM restart 
     28   USE limthd         ! LIM ice thermodynamics 
     29   USE limthd_sal     ! LIM ice thermodynamics: salinity 
     30   USE limvar         ! LIM variables 
     31   USE limsbc         ! LIM surface boundary condition 
     32   USE in_out_manager ! I/O manager 
     33   USE lib_mpp        ! MPP library 
     34   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3435 
    3536   IMPLICIT NONE 
     
    3940 
    4041   !!---------------------------------------------------------------------- 
    41    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     42   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    4243   !! $Id$ 
    4344   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    7980      CALL lim_thd_sal_init            ! set ice salinity parameters 
    8081      ! 
    81       rdt_ice = nn_fsbc * rdttra(1)    ! sea-ice timestep 
     82      rdt_ice   = nn_fsbc * rdttra(1)  ! sea-ice timestep 
     83      r1_rdtice = 1._wp / rdt_ice      ! sea-ice timestep inverse 
    8284      ! 
    8385      CALL lim_msh                     ! ice mesh initialization 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r3294 r3625  
    1515   !!   lim_adv_y  : advection of sea ice on y axis 
    1616   !!---------------------------------------------------------------------- 
    17    USE dom_oce          ! ocean domain 
    18    USE dom_ice          ! LIM-3 domain 
    19    USE ice              ! LIM-3 variables 
    20    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    21    USE in_out_manager   ! I/O manager 
    22    USE prtctl           ! Print control 
    23    USE lib_mpp          ! MPP library 
    24    USE wrk_nemo         ! work arrays 
     17   USE dom_oce        ! ocean domain 
     18   USE ice            ! LIM-3 variables 
     19   USE dom_ice        ! LIM-3 domain 
     20   USE lbclnk         ! lateral boundary condition - MPP exchanges 
     21   USE in_out_manager ! I/O manager 
     22   USE prtctl         ! Print control 
     23   USE lib_mpp        ! MPP library 
     24   USE wrk_nemo       ! work arrays 
     25   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2526 
    2627   IMPLICIT NONE 
     
    3738#  include "vectopt_loop_substitute.h90" 
    3839   !!---------------------------------------------------------------------- 
    39    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     40   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    4041   !! $Id$ 
    4142   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    8889            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    8990               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    90             zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     91            zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    9192 
    9293            ps0 (ji,jj) = zslpmax   
     
    273274            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    274275               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    275             zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     276            zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    276277            ! 
    277278            ps0 (ji,jj) = zslpmax   
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r2777 r3625  
    1010#if defined key_lim3 
    1111   !!---------------------------------------------------------------------- 
    12    !!   'key_lim3' :                                   LIM3 sea-ice model 
     12   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!    lim_cons   :   checks whether energy, mass and salt are conserved  
     14   !!    lim_cons     :   checks whether energy, mass and salt are conserved  
    1515   !!---------------------------------------------------------------------- 
    16    USE par_ice          ! LIM-3 parameter 
    17    USE ice              ! LIM-3 variables 
    18    USE dom_ice          ! LIM-3 domain 
    19    USE dom_oce          ! ocean domain 
    20    USE in_out_manager   ! I/O manager 
    21    USE lib_mpp          ! MPP library 
     16   USE par_ice        ! LIM-3 parameter 
     17   USE ice            ! LIM-3 variables 
     18   USE dom_ice        ! LIM-3 domain 
     19   USE dom_oce        ! ocean domain 
     20   USE in_out_manager ! I/O manager 
     21   USE lib_mpp        ! MPP library 
     22   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2223 
    2324   IMPLICIT NONE 
     
    2930 
    3031   !!---------------------------------------------------------------------- 
    31    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     32   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    3233   !! $Id$ 
    3334   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90

    r2715 r3625  
    1111   !!   'key_lim3'                                       LIM3 sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    13    !!   lim_dia        : computation and output of the time evolution of keys variables 
    14    !!   lim_dia_init   : initialization and namelist read 
    15    !!---------------------------------------------------------------------- 
    16    USE ice             ! LIM-3: sea-ice variable 
    17    USE par_ice         ! LIM-3: ice parameters 
    18    USE dom_ice         ! LIM-3: sea-ice domain 
    19    USE dom_oce         ! ocean domain 
    20    USE sbc_oce         ! surface boundary condition: ocean fields 
    21    USE daymod          ! model calendar 
    22    USE phycst          ! physical constant 
    23    USE in_out_manager  ! I/O manager 
    24    USE lib_mpp         ! MPP library 
    25     
     13   !!   lim_dia       : computation and output of the time evolution of keys variables 
     14   !!   lim_dia_init  : initialization and namelist read 
     15   !!---------------------------------------------------------------------- 
     16   USE ice            ! LIM-3: sea-ice variable 
     17   USE par_ice        ! LIM-3: ice parameters 
     18   USE dom_ice        ! LIM-3: sea-ice domain 
     19   USE dom_oce        ! ocean domain 
     20   USE sbc_oce        ! surface boundary condition: ocean fields 
     21   USE daymod         ! model calendar 
     22   USE phycst         ! physical constant 
     23   USE in_out_manager ! I/O manager 
     24   USE lib_mpp        ! MPP library 
     25   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     26 
    2627   IMPLICIT NONE 
    2728   PRIVATE 
     
    7071      !!              the temporal evolution of some key variables 
    7172      !!------------------------------------------------------------------- 
    72       INTEGER  ::   jv, ji, jj, jl   ! dummy loop indices 
    73       REAL(wp) ::   zshift_date      ! date from the minimum ice extent 
    74       REAL(wp) ::   zday, zday_min   ! current day, day of minimum extent 
    75       REAL(wp) ::   zafy, zamy       ! temporary area of fy and my ice 
     73      INTEGER  ::   jv, ji, jj, jl       ! dummy loop indices 
     74      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integer 
     75      REAL(wp) ::   zshift_date          ! date from the minimum ice extent 
     76      REAL(wp) ::   zday, zday_min       ! current day, day of minimum extent 
     77      REAL(wp) ::   zafy, zamy           ! temporary area of fy and my ice 
    7678      REAL(wp) ::   zindb 
    77       REAL(wp), DIMENSION(jpinfmx) ::   vinfor           ! temporary working space  
     79      REAL(wp), DIMENSION(jpinfmx) ::   vinfor   ! 1D workspace  
    7880      !!------------------------------------------------------------------- 
    7981 
     
    105107            IF( tms(ji,jj) == 1 ) THEN 
    106108               vinfor(3)  = vinfor(3)  + at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice area 
    107                IF (at_i(ji,jj).GT.0.15) vinfor(5) = vinfor(5) + aire(ji,jj) * 1.e-12_wp !ice extent 
     109               IF ( at_i(ji,jj) > 0.15 )  vinfor(5) = vinfor(5) + aire(ji,jj) * 1.e-12_wp !ice extent 
    108110               vinfor(7)  = vinfor(7)  + vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice volume 
    109111               vinfor(9)  = vinfor(9)  + vt_s(ji,jj)*aire(ji,jj) * 1.e-12_wp !snow volume 
     
    111113               vinfor(29) = vinfor(29) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean salinity 
    112114               ! the computation of this diagnostic is not reliable 
    113                vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    114                   v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12  
    115                vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) * 1.e-12_wp !salt flux 
    116                vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp !brine drainage flux 
    117                vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp !equivalent salt flux 
     115               vinfor(31) = vinfor(31) + vt_i(ji,jj) * (  u_ice(ji,jj)*u_ice(ji,jj)  &  
     116                  &                                     + v_ice(ji,jj)*v_ice(ji,jj) ) * aire(ji,jj) * 1.e-12  
     117               vinfor(53) = vinfor(53) + sfx (ji,jj)*aire(ji,jj) * 1.e-12_wp !salt flux 
     118               vinfor(55) = vinfor(55) + sfx_bri(ji,jj)*aire(ji,jj) * 1.e-12_wp !brine drainage flux 
     119               vinfor(57) = vinfor(57) + sfx_thd(ji,jj)*aire(ji,jj) * 1.e-12_wp !equivalent salt flux 
    118120               vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SST 
    119121               vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SSS 
     
    180182               vinfor(43) = vinfor(43) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp  
    181183               vinfor(45) = vinfor(45) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12_wp 
    182                vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp / rdt_ice ! volume acc in OW 
     184               vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp * r1_rdtice  ! volume acc in OW 
    183185            ENDIF 
    184186         END DO 
     
    231233      vinfor(51) = zindb*vinfor(51) / MAX(vinfor(27),epsi06) 
    232234 
    233       !! Fram Strait Export 
    234       !! 83 = area export 
    235       !! 84 = volume export 
    236       !! Fram strait in ORCA2 = 5 points 
    237       !! export = -v_ice*e1t*ddtb*at_i or -v_ice*e1t*ddtb*at_i*h_i 
    238       jj = 136 ! C grid 
    239       vinfor(83) = 0.0 
    240       vinfor(84) = 0.0 
    241       DO ji = 134, 138 
    242          vinfor(83) = vinfor(83) - v_ice(ji,jj) * &  
    243             e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12_wp 
    244          vinfor(84) = vinfor(84) - v_ice(ji,jj) * &  
    245             e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12_wp 
    246       END DO 
     235      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : Fram Strait Export 
     236         SELECT CASE ( jp_cfg ) 
     237         CASE ( 2 )                          ! ORCA_R2 
     238            ij0 = 136   ;   ij1 = 136              ! Fram strait : 83 = area export 
     239            ii0 = 134   ;   ii1 = 138              !               84 = volume export 
     240            DO jj = mj0(ij0),mj1(ij1) 
     241               DO ji = mi0(ii0),mi1(ii1) 
     242                  vinfor(83) = vinfor(83) - v_ice(ji,jj) * e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12_wp 
     243                  vinfor(84) = vinfor(84) - v_ice(ji,jj) * e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12_wp 
     244               END DO 
     245            END DO 
     246         END SELECT 
     247!!gm   just above, this is NOT the correct way of evaluating the transport ! 
     248!!gm        mass of snow is missing and v_ice should be the mean between jj and jj+1 
     249!!gm   Other ORCA configurations should be added 
     250      ENDIF 
    247251 
    248252      !!------------------------------------------------------------------- 
     
    264268               vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    265269                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel 
    266                vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Total salt flux 
    267                vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Brine drainage salt flux 
    268                vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Equivalent salt flux 
     270               vinfor(54) = vinfor(54) + sfx (ji,jj)*aire(ji,jj) * 1.e-12_wp ! Total salt flux 
     271               vinfor(56) = vinfor(56) + sfx_bri(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Brine drainage salt flux 
     272               vinfor(58) = vinfor(58) + sfx_thd(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Equivalent salt flux 
    269273               vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SST 
    270274               vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SSS 
     
    331335               vinfor(44) = vinfor(44) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp  
    332336               vinfor(46) = vinfor(46) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12_wp 
    333                vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp / rdt_ice ! volume acc in OW 
     337               vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp * r1_rdtice  ! volume acc in OW 
    334338            ENDIF 
    335339         END DO 
     
    345349         END DO 
    346350      END DO 
    347       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) ! 
    348       vinfor(64) = zindb * vinfor(64) / MAX(vinfor(4),epsi06) ! divide by ice extt 
     351      zindb      = 1._wp - MAX(  0._wp , SIGN( 1._wp , -vinfor(4) )  )  ! 
     352      vinfor(64) = zindb * vinfor(64) / MAX( vinfor(4) , epsi06 )  ! divide by ice extt 
    349353      !! 2.2) Diagnostics dependent on age 
    350354      !!------------------------------------ 
     
    368372                  ENDIF 
    369373               END DO ! jl 
    370                IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN 
     374               IF ( at_i(ji,jj)  >  0.15  .AND. zafy  >  zamy ) THEN 
    371375                  vinfor(22) = vinfor(22) + aire(ji,jj) * 1.e-12_wp ! Seasonal ice extent 
    372376               ENDIF 
    373                IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN 
     377               IF ( at_i(ji,jj)  >  0.15  .AND. zafy <= zamy ) THEN 
    374378                  vinfor(24) = vinfor(24) + aire(ji,jj) * 1.e-12_wp ! Perennial ice extent 
    375379               ENDIF 
     
    377381         END DO ! jj 
    378382      END DO ! ji 
    379       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(26))) !=0 if no multiyear ice 1 if yes 
    380       vinfor(50) = zindb*vinfor(50) / MAX(vinfor(26),epsi06) 
    381       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(28))) !=0 if no multiyear ice 1 if yes 
    382       vinfor(52) = zindb*vinfor(52) / MAX(vinfor(28),epsi06) 
     383      zindb      = 1.0 - MAX(  0.0,SIGN( 1._wp , -vinfor(26) )  )    !=0 if no multiyear ice 1 if yes 
     384      vinfor(50) = zindb * vinfor(50) / MAX( vinfor(26) , epsi06 ) 
     385      zindb      = 1.0 - MAX(  0._wp , SIGN( 1._wp , -vinfor(28) )  ) !=0 if no multiyear ice 1 if yes 
     386      vinfor(52) = zindb * vinfor(52) / MAX( vinfor(28) , epsi06 ) 
    383387 
    384388      !  Accumulation before averaging  
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r3294 r3625  
    1515   !!    lim_dyn_init : initialization and namelist read 
    1616   !!---------------------------------------------------------------------- 
    17    USE phycst           ! physical constants 
    18    USE dom_oce          ! ocean space and time domain 
    19    USE sbc_oce          ! Surface boundary condition: ocean fields 
    20    USE sbc_ice          ! Surface boundary condition: ice   fields 
    21    USE ice              ! LIM-3 variables 
    22    USE par_ice          ! LIM-3 parameters 
    23    USE dom_ice          ! LIM-3 domain 
    24    USE limrhg           ! LIM-3 rheology 
    25    USE lbclnk           ! lateral boundary conditions - MPP exchanges 
    26    USE lib_mpp          ! MPP library 
    27    USE wrk_nemo         ! work arrays 
    28    USE in_out_manager   ! I/O manager 
    29    USE prtctl           ! Print control 
     17   USE phycst         ! physical constants 
     18   USE dom_oce        ! ocean space and time domain 
     19   USE sbc_oce        ! Surface boundary condition: ocean fields 
     20   USE sbc_ice        ! Surface boundary condition: ice   fields 
     21   USE ice            ! LIM-3 variables 
     22   USE par_ice        ! LIM-3 parameters 
     23   USE dom_ice        ! LIM-3 domain 
     24   USE limrhg         ! LIM-3 rheology 
     25   USE lbclnk         ! lateral boundary conditions - MPP exchanges 
     26   USE lib_mpp        ! MPP library 
     27   USE wrk_nemo       ! work arrays 
     28   USE in_out_manager ! I/O manager 
     29   USE prtctl         ! Print control 
     30   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3031 
    3132   IMPLICIT NONE 
     
    3738#  include "vectopt_loop_substitute.h90" 
    3839   !!---------------------------------------------------------------------- 
    39    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     40   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    4041   !! $Id$ 
    4142   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r3294 r3625  
    1212   !!   'key_lim3'                                      LIM3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!   lim_hdf  : diffusion trend on sea-ice variable 
     14   !!   lim_hdf       : diffusion trend on sea-ice variable 
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce          ! ocean domain 
    17    USE ice              ! LIM-3: ice variables 
    18    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    19    USE lib_mpp          ! MPP library 
    20    USE wrk_nemo         ! work arrays 
    21    USE prtctl           ! Print control 
    22    USE in_out_manager   ! I/O manager 
     16   USE dom_oce        ! ocean domain 
     17   USE ice            ! LIM-3: ice variables 
     18   USE lbclnk         ! lateral boundary condition - MPP exchanges 
     19   USE lib_mpp        ! MPP library 
     20   USE wrk_nemo       ! work arrays 
     21   USE prtctl         ! Print control 
     22   USE in_out_manager ! I/O manager 
     23   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2324 
    2425   IMPLICIT NONE 
     
    3435#  include "vectopt_loop_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    36    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
     37   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 
    3738   !! $Id$ 
    3839   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r3610 r3625  
    2626   USE lib_mpp          ! MPP library 
    2727   USE wrk_nemo         ! work arrays 
     28   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2829 
    2930   IMPLICIT NONE 
     
    4849 
    4950   !!---------------------------------------------------------------------- 
    50    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     51   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    5152   !! $Id$ 
    5253   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r3294 r3625  
    1010#if defined key_lim3 
    1111   !!---------------------------------------------------------------------- 
    12    !!   'key_lim3' :                                    LIM3 sea-ice model 
     12   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    USE par_oce          ! ocean parameters 
    15    USE dom_oce          ! ocean domain 
    16    USE phycst           ! physical constants (ocean directory)  
    17    USE sbc_oce          ! surface boundary condition: ocean fields 
    18    USE thd_ice          ! LIM thermodynamics 
    19    USE ice              ! LIM variables 
    20    USE par_ice          ! LIM parameters 
    21    USE dom_ice          ! LIM domain 
    22    USE limthd_lac       ! LIM 
    23    USE limvar           ! LIM 
    24    USE limcons          ! LIM 
    25    USE in_out_manager   ! I/O manager 
    26    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    27    USE lib_mpp          ! MPP library 
    28    USE wrk_nemo         ! work arrays 
    29    USE prtctl           ! Print control 
     14   USE par_oce        ! ocean parameters 
     15   USE dom_oce        ! ocean domain 
     16   USE phycst         ! physical constants (ocean directory)  
     17   USE sbc_oce        ! surface boundary condition: ocean fields 
     18   USE thd_ice        ! LIM thermodynamics 
     19   USE ice            ! LIM variables 
     20   USE par_ice        ! LIM parameters 
     21   USE dom_ice        ! LIM domain 
     22   USE limthd_lac     ! LIM 
     23   USE limvar         ! LIM 
     24   USE limcons        ! LIM 
     25   USE in_out_manager ! I/O manager 
     26   USE lbclnk         ! lateral boundary condition - MPP exchanges 
     27   USE lib_mpp        ! MPP library 
     28   USE wrk_nemo       ! work arrays 
     29   USE prtctl         ! Print control 
     30   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3031 
    3132   IMPLICIT NONE 
     
    3839   PUBLIC   lim_itd_me_alloc        ! called by iceini.F90 
    3940 
    40    REAL(wp)  ::   epsi11 = 1.e-11_wp   ! constant values 
    41    REAL(wp)  ::   epsi10 = 1.e-10_wp   ! constant values 
    42    REAL(wp)  ::   epsi06 = 1.e-06_wp   ! constant values 
     41   REAL(wp) ::   epsi11 = 1.e-11_wp   ! constant values 
     42   REAL(wp) ::   epsi10 = 1.e-10_wp   ! constant values 
     43   REAL(wp) ::   epsi06 = 1.e-06_wp   ! constant values 
    4344 
    4445   !----------------------------------------------------------------------- 
     
    4748   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   asum     ! sum of total ice and open water area 
    4849   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aksum    ! ratio of area removed to area ridged 
    49  
     50   ! 
    5051   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/ 
    5152   !                                                           !  closing associated w/ category n 
    52  
     53   ! 
    5354   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hrmin    ! minimum ridge thickness 
    5455   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hrmax    ! maximum ridge thickness 
     
    7071   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dvirdgdt   ! rate of ice volume ridged (m/s) 
    7172   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   opening    ! rate of opening due to divergence/shear (1/s) 
     73   ! 
    7274   !!---------------------------------------------------------------------- 
    7375   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010) 
     
    126128      INTEGER ::   ji, jj, jk, jl   ! dummy loop index 
    127129      INTEGER ::   niter, nitermax = 20   ! local integer  
    128       LOGICAL  ::   asum_error              ! flag for asum .ne. 1 
    129       INTEGER  ::   iterate_ridging         ! if true, repeat the ridging 
    130       REAL(wp) ::   w1, tmpfac, dti         ! local scalar 
     130      LOGICAL  ::   asum_error            ! flag for asum .ne. 1 
     131      INTEGER  ::   iterate_ridging       ! if true, repeat the ridging 
     132      REAL(wp) ::   w1, tmpfac            ! local scalar 
    131133      CHARACTER (len = 15) ::   fieldid 
    132134      REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s) 
     
    152154      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons 
    153155      !-----------------------------------------------------------------------------! 
    154       ! Set hi_max(ncat) to a big value to ensure that all ridged ice  
    155       ! is thinner than hi_max(ncat). 
     156      ! Set hi_max(ncat) to a big value to ensure that all ridged ice is thinner than hi_max(ncat). 
    156157 
    157158      hi_max(jpl) = 999.99 
    158159 
    159       Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0      ! proport const for PE 
    160       CALL lim_itd_me_ridgeprep ! prepare ridging 
    161  
     160      Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0                ! proport const for PE 
     161      ! 
     162      CALL lim_itd_me_ridgeprep                                    ! prepare ridging 
     163      ! 
    162164      IF( con_i)   CALL lim_column_sum( jpl, v_i, vt_i_init )      ! conservation check 
    163165 
     
    166168            msnow_mlt(ji,jj) = 0._wp 
    167169            esnow_mlt(ji,jj) = 0._wp 
    168             dardg1dt (ji,jj)  = 0._wp 
    169             dardg2dt (ji,jj)  = 0._wp 
    170             dvirdgdt (ji,jj)  = 0._wp 
    171             opening  (ji,jj)  = 0._wp 
     170            dardg1dt (ji,jj) = 0._wp 
     171            dardg2dt (ji,jj) = 0._wp 
     172            dvirdgdt (ji,jj) = 0._wp 
     173            opening  (ji,jj) = 0._wp 
    172174 
    173175            !-----------------------------------------------------------------------------! 
     
    201203            ! to give asum = 1.0 after ridging. 
    202204 
    203             divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) / rdt_ice  ! asum found in ridgeprep 
     205            divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) * r1_rdtice  ! asum found in ridgeprep 
    204206 
    205207            IF( divu_adv(ji,jj) < 0._wp )   closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) ) 
     
    207209            ! 2.3 opning 
    208210            !------------ 
    209             ! Compute the (non-negative) opening rate that will give  
    210             ! asum = 1.0 after ridging. 
     211            ! Compute the (non-negative) opening rate that will give asum = 1.0 after ridging. 
    211212            opning(ji,jj) = closing_net(ji,jj) + divu_adv(ji,jj) 
    212213         END DO 
     
    257258                  IF ( a_i(ji,jj,jl) > epsi11 .AND. athorn(ji,jj,jl) > 0._wp )THEN 
    258259                     w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 
    259                      IF ( w1 > a_i(ji,jj,jl) ) THEN 
     260                     IF ( w1  > a_i(ji,jj,jl) ) THEN 
    260261                        tmpfac = a_i(ji,jj,jl) / w1 
    261262                        closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac 
     
    291292               ELSE 
    292293                  iterate_ridging    = 1 
    293                   divu_adv   (ji,jj) = (1._wp - asum(ji,jj)) / rdt_ice 
     294                  divu_adv   (ji,jj) = (1._wp - asum(ji,jj)) * r1_rdtice 
    294295                  closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) ) 
    295296                  opning     (ji,jj) = MAX( 0._wp,  divu_adv(ji,jj) ) 
     
    308309 
    309310         IF( iterate_ridging == 1 ) THEN 
    310             IF( niter .GT. nitermax ) THEN 
     311            IF( niter  > nitermax ) THEN 
    311312               WRITE(numout,*) ' ALERTE : non-converging ridging scheme ' 
    312313               WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging 
     
    323324      ! Update fresh water and heat fluxes due to snow melt. 
    324325 
    325       dti = 1._wp / rdt_ice 
    326  
    327326      asum_error = .false.  
    328327 
     
    330329         DO ji = 1, jpi 
    331330 
    332             IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) asum_error = .true. 
    333  
    334             dardg1dt(ji,jj) = dardg1dt(ji,jj) * dti 
    335             dardg2dt(ji,jj) = dardg2dt(ji,jj) * dti 
    336             dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * dti 
    337             opening (ji,jj) = opening (ji,jj) * dti 
     331            IF( ABS( asum(ji,jj) - 1.0 ) > epsi11 )  asum_error = .true. 
     332 
     333            dardg1dt(ji,jj) = dardg1dt(ji,jj) * r1_rdtice 
     334            dardg2dt(ji,jj) = dardg2dt(ji,jj) * r1_rdtice 
     335            dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * r1_rdtice 
     336            opening (ji,jj) = opening (ji,jj) * r1_rdtice 
    338337 
    339338            !-----------------------------------------------------------------------------! 
    340339            ! 5) Heat, salt and freshwater fluxes 
    341340            !-----------------------------------------------------------------------------! 
    342             fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * dti     ! fresh water source for ocean 
    343             fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * dti     ! heat sink for ocean 
     341            fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
     342            fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean 
    344343 
    345344         END DO 
     
    349348      DO jj = 1, jpj 
    350349         DO ji = 1, jpi 
    351             IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) THEN ! there is a bug 
     350            IF( ABS( asum(ji,jj) - 1._wp )  >  epsi11 ) THEN  ! there is a bug 
    352351               WRITE(numout,*) ' ' 
    353352               WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) 
     
    391390      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - old_oa_i (:,:,:) 
    392391      d_smv_i_trp(:,:,:)   = 0._wp 
    393       IF(  num_sal == 2  .OR.  num_sal == 4  )   d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
     392      IF(  num_sal == 2  )   d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
    394393 
    395394      IF(ln_ctl) THEN     ! Control print 
     
    430429 
    431430      ! update of fields will be made later in lim update 
    432       u_ice(:,:)    = old_u_ice(:,:) 
    433       v_ice(:,:)    = old_v_ice(:,:) 
    434       a_i(:,:,:)    = old_a_i(:,:,:) 
    435       v_s(:,:,:)    = old_v_s(:,:,:) 
    436       v_i(:,:,:)    = old_v_i(:,:,:) 
    437       e_s(:,:,:,:)  = old_e_s(:,:,:,:) 
    438       e_i(:,:,:,:)  = old_e_i(:,:,:,:) 
    439       oa_i(:,:,:)   = old_oa_i(:,:,:) 
    440       IF(  num_sal == 2  .OR.  num_sal == 4  )   smv_i(:,:,:) = old_smv_i(:,:,:) 
     431      u_ice(:,:)   = old_u_ice(:,:) 
     432      v_ice(:,:)   = old_v_ice(:,:) 
     433      a_i(:,:,:)   = old_a_i(:,:,:) 
     434      v_s(:,:,:)   = old_v_s(:,:,:) 
     435      v_i(:,:,:)   = old_v_i(:,:,:) 
     436      e_s(:,:,:,:) = old_e_s(:,:,:,:) 
     437      e_i(:,:,:,:) = old_e_i(:,:,:,:) 
     438      oa_i(:,:,:)  = old_oa_i(:,:,:) 
     439      IF(  num_sal == 2  )   smv_i(:,:,:) = old_smv_i(:,:,:) 
    441440 
    442441      !----------------------------------------------------! 
     
    465464         DO jj = 1, jpj 
    466465            DO ji = 1, jpi 
    467                IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 
    468                   ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 
    469                   old_v_i(ji,jj,jl)     = d_v_i_trp(ji,jj,jl) 
    470                   d_v_i_trp(ji,jj,jl)   = 0._wp 
    471                   old_a_i(ji,jj,jl)     = d_a_i_trp(ji,jj,jl) 
    472                   d_a_i_trp(ji,jj,jl)   = 0._wp 
    473                   old_v_s(ji,jj,jl)     = d_v_s_trp(ji,jj,jl) 
    474                   d_v_s_trp(ji,jj,jl)   = 0._wp 
    475                   old_e_s(ji,jj,1,jl)  = d_e_s_trp(ji,jj,1,jl) 
    476                   d_e_s_trp(ji,jj,1,jl) = 0._wp 
    477                   old_oa_i(ji,jj,jl)    = d_oa_i_trp(ji,jj,jl) 
    478                   d_oa_i_trp(ji,jj,jl)  = 0._wp 
    479                   IF(  num_sal == 2  .OR.  num_sal == 4  )   old_smv_i(ji,jj,jl)  = d_smv_i_trp(ji,jj,jl) 
    480                   d_smv_i_trp(ji,jj,jl) = 0._wp 
     466               IF(  old_v_i  (ji,jj,jl) < epsi06 .AND. & 
     467                    d_v_i_trp(ji,jj,jl) > epsi06    ) THEN 
     468                  old_v_i   (ji,jj,jl)   = d_v_i_trp(ji,jj,jl) 
     469                  d_v_i_trp (ji,jj,jl)   = 0._wp 
     470                  old_a_i   (ji,jj,jl)   = d_a_i_trp(ji,jj,jl) 
     471                  d_a_i_trp (ji,jj,jl)   = 0._wp 
     472                  old_v_s   (ji,jj,jl)   = d_v_s_trp(ji,jj,jl) 
     473                  d_v_s_trp (ji,jj,jl)   = 0._wp 
     474                  old_e_s   (ji,jj,1,jl) = d_e_s_trp(ji,jj,1,jl) 
     475                  d_e_s_trp (ji,jj,1,jl) = 0._wp 
     476                  old_oa_i  (ji,jj,jl)   = d_oa_i_trp(ji,jj,jl) 
     477                  d_oa_i_trp(ji,jj,jl)   = 0._wp 
     478                  IF(  num_sal == 2  )   old_smv_i(ji,jj,jl) = d_smv_i_trp(ji,jj,jl) 
     479                  d_smv_i_trp(ji,jj,jl)  = 0._wp 
    481480               ENDIF 
    482481            END DO 
    483482         END DO 
    484483      END DO 
    485  
     484      ! 
    486485      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    487486      ! 
     
    612611                  ! present 
    613612                  zworka(ji,jj) = 4.0 * strength(ji,jj)              & 
    614                      + strength(ji-1,jj) * tms(ji-1,jj) &   
    615                      + strength(ji+1,jj) * tms(ji+1,jj) &   
    616                      + strength(ji,jj-1) * tms(ji,jj-1) &   
    617                      + strength(ji,jj+1) * tms(ji,jj+1)     
     613                     &          + strength(ji-1,jj) * tms(ji-1,jj) &   
     614                     &          + strength(ji+1,jj) * tms(ji+1,jj) &   
     615                     &          + strength(ji,jj-1) * tms(ji,jj-1) &   
     616                     &          + strength(ji,jj+1) * tms(ji,jj+1)     
    618617 
    619618                  zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1) 
    620619                  zworka(ji,jj) = zworka(ji,jj) / zw1 
    621620               ELSE 
    622                   zworka(ji,jj) = 0.0 
     621                  zworka(ji,jj) = 0._wp 
    623622               ENDIF 
    624623            END DO 
     
    10481047         DO jj = 1, jpj 
    10491048            DO ji = 1, jpi 
    1050                IF (aicen_init(ji,jj,jl1) .GT. epsi11 .AND. athorn(ji,jj,jl1) .GT. 0.0       & 
    1051                   .AND. closing_gross(ji,jj) > 0.0) THEN 
     1049               IF( aicen_init(ji,jj,jl1)  >  epsi11  .AND.  athorn(ji,jj,jl1)  >  0._wp       & 
     1050                  .AND. closing_gross(ji,jj) > 0._wp ) THEN 
    10521051                  icells = icells + 1 
    10531052                  indxi(icells) = ji 
     
    11301129            ! Salinity 
    11311130            !------------- 
    1132             smsw(ji,jj)  = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0       ! salt content of water frozen in voids 
     1131            smsw(ji,jj)  = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0       ! salt content of seawater frozen in voids 
    11331132 
    11341133            zsrdg2       = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
     
    11371136             
    11381137            !                                                             ! excess of salt is flushed into the ocean 
    1139             fsalt_rpo(ji,jj) = fsalt_rpo(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic / rdt_ice 
    1140  
     1138            sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 
     1139 
     1140            rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic / rau0   ! increase in ice volume du to seawater frozen in voids 
     1141             
    11411142            !------------------------------------             
    11421143            ! 3.6 Increment ridging diagnostics 
     
    11481149            dardg1dt   (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj) 
    11491150            dardg2dt   (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj) 
    1150             diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) / rdt_ice 
    1151             opening    (ji,jj) = opening (ji,jj) + opning(ji,jj)*rdt_ice 
     1151            diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) * r1_rdtice 
     1152            opening    (ji,jj) = opening (ji,jj) + opning(ji,jj) * rdt_ice 
    11521153 
    11531154            IF( con_i )   vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj) 
     
    11561157            ! 3.7 Put the snow somewhere in the ocean 
    11571158            !------------------------------------------             
    1158  
    11591159            !  Place part of the snow lost by ridging into the ocean.  
    11601160            !  Note that esnow_mlt < 0; the ocean must cool to melt snow. 
     
    11791179            !           ij looping 1-icells 
    11801180 
    1181             dhr(ji,jj) = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) 
     1181            dhr (ji,jj) = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) 
    11821182            dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1) 
    1183  
    11841183 
    11851184         END DO                 ! ij 
     
    12111210 
    12121211               ! heat flux 
    1213                fheat_rpo(ji,jj) = fheat_rpo(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) / rdt_ice 
     1212               fheat_mec(ji,jj) = fheat_mec(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) * r1_rdtice 
    12141213 
    12151214               ! Correct dimensions to avoid big values 
     
    12751274               ! Transfer area, volume, and energy accordingly. 
    12761275 
    1277                IF (hrmin(ji,jj,jl1) .GE. hi_max(jl2) .OR.        & 
    1278                   hrmax(ji,jj,jl1) .LE. hi_max(jl2-1)) THEN 
    1279                   hL = 0.0 
    1280                   hR = 0.0 
     1276               IF( hrmin(ji,jj,jl1) >= hi_max(jl2) .OR.        & 
     1277                   hrmax(ji,jj,jl1) <= hi_max(jl2-1) ) THEN 
     1278                  hL = 0._wp 
     1279                  hR = 0._wp 
    12811280               ELSE 
    1282                   hL = MAX (hrmin(ji,jj,jl1), hi_max(jl2-1)) 
    1283                   hR = MIN (hrmax(ji,jj,jl1), hi_max(jl2)) 
     1281                  hL = MAX( hrmin(ji,jj,jl1), hi_max(jl2-1) ) 
     1282                  hR = MIN( hrmax(ji,jj,jl1), hi_max(jl2)   ) 
    12841283               ENDIF 
    12851284 
    12861285               ! fraction of ridged ice area and volume going to n2 
    1287                farea = (hR-hL) / dhr(ji,jj)  
    1288                fvol(ji,jj) = (hR*hR - hL*hL) / dhr2(ji,jj) 
    1289  
    1290                a_i  (ji,jj,jl2)   = a_i  (ji,jj,jl2)  + ardg2 (ji,jj) * farea 
    1291                v_i  (ji,jj,jl2)   = v_i  (ji,jj,jl2)  + vrdg2 (ji,jj) * fvol(ji,jj) 
    1292                v_s  (ji,jj,jl2)   = v_s  (ji,jj,jl2)  + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 
     1286               farea = ( hR - hL ) / dhr(ji,jj)  
     1287               fvol(ji,jj) = ( hR*hR - hL*hL ) / dhr2(ji,jj) 
     1288 
     1289               a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + ardg2 (ji,jj) * farea 
     1290               v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + vrdg2 (ji,jj) * fvol(ji,jj) 
     1291               v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 
    12931292               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg 
    1294                smv_i(ji,jj,jl2)   = smv_i(ji,jj,jl2)  + srdg2 (ji,jj) * fvol(ji,jj) 
    1295                oa_i (ji,jj,jl2)   = oa_i (ji,jj,jl2)  + oirdg2(ji,jj) * farea 
     1293               smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + srdg2 (ji,jj) * fvol(ji,jj) 
     1294               oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirdg2(ji,jj) * farea 
    12961295 
    12971296            END DO ! ij 
     
    13171316               ! Compute the fraction of rafted ice area and volume going to  
    13181317               ! thickness category jl2, transfer area, volume, and energy accordingly. 
    1319  
    1320                IF (hraft(ji,jj,jl1) .LE. hi_max(jl2) .AND.        & 
    1321                   hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN 
    1322                   a_i(ji,jj,jl2) = a_i(ji,jj,jl2) + arft2(ji,jj) 
    1323                   v_i(ji,jj,jl2) = v_i(ji,jj,jl2) + virft(ji,jj) 
    1324                   v_s(ji,jj,jl2) = v_s(ji,jj,jl2) + vsrft(ji,jj)*fsnowrft 
    1325                   e_s(ji,jj,1,jl2) = e_s(ji,jj,1,jl2) + esrft(ji,jj)*fsnowrft 
    1326                   smv_i(ji,jj,jl2) = smv_i(ji,jj,jl2) + smrft(ji,jj)     
    1327                   oa_i(ji,jj,jl2)  = oa_i(ji,jj,jl2) + oirft2(ji,jj)     
     1318               ! 
     1319               IF( hraft(ji,jj,jl1) <= hi_max(jl2) .AND.        & 
     1320                   hraft(ji,jj,jl1) >  hi_max(jl2-1) ) THEN 
     1321                  a_i  (ji,jj  ,jl2) = a_i  (ji,jj  ,jl2) + arft2 (ji,jj) 
     1322                  v_i  (ji,jj  ,jl2) = v_i  (ji,jj  ,jl2) + virft (ji,jj) 
     1323                  v_s  (ji,jj  ,jl2) = v_s  (ji,jj  ,jl2) + vsrft (ji,jj) * fsnowrft 
     1324                  e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrft (ji,jj) * fsnowrft 
     1325                  smv_i(ji,jj  ,jl2) = smv_i(ji,jj  ,jl2) + smrft (ji,jj)     
     1326                  oa_i (ji,jj  ,jl2) = oa_i (ji,jj  ,jl2) + oirft2(ji,jj)     
    13281327               ENDIF ! hraft 
    1329  
     1328               ! 
    13301329            END DO ! ij 
    13311330 
     
    13361335                  ji = indxi(ij) 
    13371336                  jj = indxj(ij) 
    1338                   IF (hraft(ji,jj,jl1) .LE. hi_max(jl2) .AND.        & 
    1339                      hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN 
     1337                  IF(  hraft(ji,jj,jl1)  <=  hi_max(jl2)  .AND.        & 
     1338                       hraft(ji,jj,jl1)  >   hi_max(jl2-1)  ) THEN 
    13401339                     e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk) 
    13411340                  ENDIF 
     
    15041503            DO jj = 1 , jpj 
    15051504               DO ji = 1 , jpi 
    1506 !!gm                  xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) / rdt_ice 
     1505!!gm                  xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) * r1_rdtice 
    15071506!!gm                  xtmp = xtmp * unit_fac 
    15081507                  ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
     
    15241523               ! fluxes are positive to the ocean 
    15251524               ! here the flux has to be negative for the ocean 
    1526 !!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice 
     1525!!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice 
    15271526               !           fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
    15281527 
    1529 !!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice !RB   ??????? 
     1528!!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB   ??????? 
    15301529 
    15311530               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1 - zmask(ji,jj) ) 
     
    15361535 
    15371536               !           xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt 
    1538                !           fresh(i,j)      = fresh(i,j)      + xtmp 
    1539                !           fresh_hist(i,j) = fresh_hist(i,j) + xtmp 
    1540  
    1541                !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj)                  ) * &  
    1542                !                               rhosn * v_s(ji,jj,jl) / rdt_ice 
    1543  
    1544                !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
    1545                !                               rhoic * v_i(ji,jj,jl) / rdt_ice 
    1546  
    1547                !           emps(i,j)      = emps(i,j)      + xtmp 
    1548                !           fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 
     1537               !           sfx_res(ji,jj)  = sfx_res(ji,jj) + ( sss_m(ji,jj)                  )   & 
     1538               !                                            * rhosn * v_s(ji,jj,jl) * r1_rdtice 
     1539               !           sfx_res(ji,jj)  = sfx_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) )   &  
     1540               !                                            * rhoic * v_i(ji,jj,jl) * r1_rdtice 
     1541               !           sfx (i,j)      = sfx (i,j)      + xtmp 
    15491542 
    15501543               ato_i(ji,jj)    = a_i  (ji,jj,jl) *       zmask(ji,jj)   + ato_i(ji,jj) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r3294 r3625  
    22   !!====================================================================== 
    33   !!                       ***  MODULE limitd_th *** 
    4    !!              Thermodynamics of ice thickness distribution 
    5    !!                   computation of changes in g(h)       
     4   !!   LIM3 ice model : ice thickness distribution: Thermodynamics 
    65   !!====================================================================== 
    76   !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code 
     
    2019   !!   lim_itd_shiftice : 
    2120   !!---------------------------------------------------------------------- 
    22    USE dom_ice          ! LIM-3 domain 
    23    USE par_oce          ! ocean parameters 
    24    USE dom_oce          ! ocean domain 
    25    USE phycst           ! physical constants (ocean directory)  
    26    USE thd_ice          ! LIM-3 thermodynamic variables 
    27    USE ice              ! LIM-3 variables 
    28    USE par_ice          ! LIM-3 parameters 
    29    USE limthd_lac       ! LIM-3 lateral accretion 
    30    USE limvar           ! LIM-3 variables 
    31    USE limcons          ! LIM-3 conservation 
    32    USE prtctl           ! Print control 
    33    USE in_out_manager   ! I/O manager 
    34    USE lib_mpp          ! MPP library 
    35    USE wrk_nemo         ! work arrays 
     21   USE par_oce        ! ocean parameters 
     22   USE dom_oce        ! ocean domain 
     23   USE phycst         ! physical constants (ocean directory)  
     24   USE ice            ! LIM-3 variables 
     25   USE par_ice        ! LIM-3 parameters 
     26   USE dom_ice        ! LIM-3 domain 
     27   USE thd_ice        ! LIM-3 thermodynamic variables 
     28   USE limthd_lac     ! LIM-3 lateral accretion 
     29   USE limvar         ! LIM-3 variables 
     30   USE limcons        ! LIM-3 conservation 
     31   USE prtctl         ! Print control 
     32   USE in_out_manager ! I/O manager 
     33   USE lib_mpp        ! MPP library 
     34   USE wrk_nemo       ! work arrays 
     35   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3636 
    3737   IMPLICIT NONE 
     
    4949 
    5050   !!---------------------------------------------------------------------- 
    51    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
     51   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 
    5252   !! $Id$ 
    5353   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    101101 
    102102      !- Trend terms 
    103       d_a_i_thd (:,:,:)  = a_i(:,:,:)   - old_a_i(:,:,:)  
    104       d_v_s_thd (:,:,:)  = v_s(:,:,:)   - old_v_s(:,:,:) 
    105       d_v_i_thd (:,:,:)  = v_i(:,:,:)   - old_v_i(:,:,:)   
     103      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - old_a_i(:,:,:)  
     104      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - old_v_s(:,:,:) 
     105      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - old_v_i(:,:,:)   
    106106      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
    107107      d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 
    108108 
    109109      d_smv_i_thd(:,:,:) = 0._wp 
    110       IF( num_sal == 2 .OR. num_sal == 4 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
     110      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
    111111 
    112112      IF(ln_ctl) THEN   ! Control print 
     
    143143 
    144144      !- Recover Old values 
    145       a_i(:,:,:)   = old_a_i (:,:,:) 
    146       v_s(:,:,:)   = old_v_s (:,:,:) 
    147       v_i(:,:,:)   = old_v_i (:,:,:) 
    148       e_s(:,:,:,:) = old_e_s (:,:,:,:) 
    149       e_i(:,:,:,:) = old_e_i (:,:,:,:) 
    150       ! 
    151       IF( num_sal == 2 .OR. num_sal == 4 )   smv_i(:,:,:)       = old_smv_i (:,:,:) 
     145      a_i(:,:,:)   = old_a_i(:,:,:) 
     146      v_s(:,:,:)   = old_v_s(:,:,:) 
     147      v_i(:,:,:)   = old_v_i(:,:,:) 
     148      e_s(:,:,:,:) = old_e_s(:,:,:,:) 
     149      e_i(:,:,:,:) = old_e_i(:,:,:,:) 
     150      ! 
     151      IF( num_sal == 2 )   smv_i(:,:,:) = old_smv_i(:,:,:) 
    152152      ! 
    153153   END SUBROUTINE lim_itd_th 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90

    r2715 r3625  
    1010   !!   'key_lim3'                                      LIM3 sea-ice model 
    1111   !!---------------------------------------------------------------------- 
    12    !!   lim_msh   : definition of the ice mesh 
     12   !!   lim_msh       : definition of the ice mesh 
    1313   !!---------------------------------------------------------------------- 
    1414   USE phycst         ! physical constants 
     
    1818   USE lbclnk         ! lateral boundary condition - MPP exchanges 
    1919   USE lib_mpp        ! MPP library 
     20   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2021 
    2122   IMPLICIT NONE 
     
    2526 
    2627   !!---------------------------------------------------------------------- 
    27    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     28   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    2829   !! $Id$ 
    2930   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r3294 r3625  
    1515   !!   'key_lim2' AND NOT 'key_lim2_vp'            EVP LIM-2 sea-ice model 
    1616   !!---------------------------------------------------------------------- 
    17    !!   lim_rhg   : computes ice velocities 
     17   !!   lim_rhg       : computes ice velocities 
    1818   !!---------------------------------------------------------------------- 
    19    USE phycst           ! Physical constant 
    20    USE par_oce          ! Ocean parameters 
    21    USE dom_oce          ! Ocean domain 
    22    USE sbc_oce          ! Surface boundary condition: ocean fields 
    23    USE sbc_ice          ! Surface boundary condition: ice fields 
    24    USE lbclnk           ! Lateral Boundary Condition / MPP link 
    25    USE lib_mpp          ! MPP library 
    26    USE wrk_nemo         ! work arrays 
    27    USE in_out_manager   ! I/O manager 
    28    USE prtctl           ! Print control 
     19   USE phycst         ! Physical constant 
     20   USE oce     , ONLY :  snwice_mass, snwice_mass_b 
     21   USE par_oce        ! Ocean parameters 
     22   USE dom_oce        ! Ocean domain 
     23   USE sbc_oce        ! Surface boundary condition: ocean fields 
     24   USE sbc_ice        ! Surface boundary condition: ice fields 
    2925#if defined key_lim3 
    30    USE ice              ! LIM-3: ice variables 
    31    USE dom_ice          ! LIM-3: ice domain 
    32    USE limitd_me        ! LIM-3:  
     26   USE ice            ! LIM-3: ice variables 
     27   USE dom_ice        ! LIM-3: ice domain 
     28   USE limitd_me      ! LIM-3:  
    3329#else 
    34    USE ice_2            ! LIM2: ice variables 
    35    USE dom_ice_2        ! LIM2: ice domain 
     30   USE ice_2          ! LIM-2: ice variables 
     31   USE dom_ice_2      ! LIM-2: ice domain 
    3632#endif 
     33   USE lbclnk         ! Lateral Boundary Condition / MPP link 
     34   USE lib_mpp        ! MPP library 
     35   USE wrk_nemo       ! work arrays 
     36   USE in_out_manager ! I/O manager 
     37   USE prtctl         ! Print control 
     38   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3739 
    3840   IMPLICIT NONE 
     
    4749#  include "vectopt_loop_substitute.h90" 
    4850   !!---------------------------------------------------------------------- 
    49    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     51   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    5052   !! $Id$ 
    5153   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    124126      REAL(wp) ::   zindb         ! ice (1) or not (0)       
    125127      REAL(wp) ::   zdummy        ! dummy argument 
     128      REAL(wp) ::   zintb, zintn  ! dummy argument 
    126129 
    127130      REAL(wp), POINTER, DIMENSION(:,:) ::   zpresh           ! temporary array for ice strength 
     
    144147      REAL(wp), POINTER, DIMENSION(:,:) ::   zs12             ! Non-diagonal stress tensor component zs12 
    145148      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity 
     149      REAL(wp), POINTER, DIMENSION(:,:) ::   zpice            ! array used for the calculation of ice surface slope: 
     150                                                              !   ocean surface (ssh_m) if ice is not embedded 
     151                                                              !   ice top surface if ice is embedded 
    146152       
    147153      !!------------------------------------------------------------------- 
     
    150156      CALL wrk_alloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                ) 
    151157      CALL wrk_alloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds          ) 
    152       CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         ) 
     158      CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
    153159 
    154160#if  defined key_lim2 && ! defined key_lim2_vp 
     
    231237      !  v_oce2: ocean v component on v points                         
    232238 
     239      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
     240          !                                             
     241          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     242          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
     243         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp      
     244          ! 
     245          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
     246          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
     247         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     248          ! 
     249         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
     250          ! 
     251      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
     252         zpice(:,:) = ssh_m(:,:) 
     253      ENDIF 
     254 
    233255      DO jj = k_j1+1, k_jpj-1 
    234256         DO ji = fs_2, fs_jpim1 
     
    273295            ! include it later 
    274296 
    275             zdsshx =  ( ssh_m(ji+1,jj) - ssh_m(ji,jj) ) / e1u(ji,jj) 
    276             zdsshy =  ( ssh_m(ji,jj+1) - ssh_m(ji,jj) ) / e2v(ji,jj) 
     297            zdsshx =  ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 
     298            zdsshy =  ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 
    277299 
    278300            za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx 
     
    746768      CALL wrk_dealloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                ) 
    747769      CALL wrk_dealloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds          ) 
    748       CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         ) 
     770      CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr , zpice                 ) 
    749771 
    750772   END SUBROUTINE lim_rhg 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r3294 r3625  
    1212   !!   'key_lim3' :                                   LIM sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!   lim_rst_opn     : open ice restart file 
    15    !!   lim_rst_write   : write of the restart file  
    16    !!   lim_rst_read    : read  the restart file  
    17    !!---------------------------------------------------------------------- 
    18    USE ice              ! sea-ice variables 
    19    USE par_ice          ! sea-ice parameters 
    20    USE dom_oce          ! ocean domain 
    21    USE sbc_oce          ! Surface boundary condition: ocean fields 
    22    USE sbc_ice          ! Surface boundary condition: ice fields 
    23    USE in_out_manager   ! I/O manager 
    24    USE iom              ! I/O library 
    25    USE lib_mpp          ! MPP library 
    26    USE wrk_nemo         ! work arrays 
     14   !!   lim_rst_opn   : open ice restart file 
     15   !!   lim_rst_write : write of the restart file  
     16   !!   lim_rst_read  : read  the restart file  
     17   !!---------------------------------------------------------------------- 
     18   USE ice            ! sea-ice variables 
     19   USE par_ice        ! sea-ice parameters 
     20   USE dom_oce        ! ocean domain 
     21   USE sbc_oce        ! Surface boundary condition: ocean fields 
     22   USE sbc_ice        ! Surface boundary condition: ice fields 
     23   USE in_out_manager ! I/O manager 
     24   USE iom            ! I/O library 
     25   USE lib_mpp        ! MPP library 
     26   USE wrk_nemo       ! work arrays 
     27   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2728 
    2829   IMPLICIT NONE 
     
    3738 
    3839   !!---------------------------------------------------------------------- 
    39    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     40   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    4041   !! $Id$ 
    4142   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    402403                     zsmax = 4.5_wp 
    403404                     zsmin = 3.5_wp 
    404                      IF( sm_i(ji,jj,jl) .LT. zsmin ) THEN 
     405                     IF(     sm_i(ji,jj,jl) < zsmin ) THEN 
    405406                        zalpha = 1._wp 
    406                      ELSEIF( sm_i(ji,jj,jl) .LT.zsmax ) THEN 
     407                     ELSEIF( sm_i(ji,jj,jl) < zsmax ) THEN 
    407408                        zalpha = sm_i(ji,jj,jl) / ( zsmin - zsmax ) + zsmax / ( zsmax - zsmin ) 
    408409                     ELSE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r3294 r3625  
    99   !!            3.3  ! 2010-05 (G. Madec) decrease ocean & ice reference salinities in the Baltic sea 
    1010   !!                 !                  + simplification of the ice-ocean stress calculation 
    11    !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     11   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
     12   !!            3.5  ! 2012-10 (A. Coward, G. Madec) salt fluxes ; ice+snow mass 
    1213   !!---------------------------------------------------------------------- 
    1314#if defined key_lim3 
     
    3435   USE prtctl           ! Print control 
    3536   USE cpl_oasis3, ONLY : lk_cpl 
     37   USE oce,        ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass, sshu_b, sshv_b, sshu_n, sshv_n, sshf_n 
     38   USE dom_ice,    ONLY : tms 
     39   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3640 
    3741   IMPLICIT NONE 
     
    4246   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
    4347 
    44    REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice  
    4548   REAL(wp)  ::   epsi16 = 1.e-16_wp   ! constant values 
    4649   REAL(wp)  ::   rzero  = 0._wp     
     
    5457#  include "vectopt_loop_substitute.h90" 
    5558   !!---------------------------------------------------------------------- 
    56    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     59   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    5760   !! $Id$ 
    5861   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    8689      !!              - qns     : sea heat flux: non solar 
    8790      !!              - emp     : freshwater budget: volume flux  
    88       !!              - emps    : freshwater budget: concentration/dillution  
     91      !!              - sfx     : salt flux  
    8992      !!              - fr_i    : ice fraction 
    9093      !!              - tn_ice  : sea-ice surface temperature 
     
    97100      ! 
    98101      INTEGER  ::   ji, jj           ! dummy loop indices 
    99       INTEGER  ::   ierr             ! local integer 
    100       INTEGER  ::   ifvt, i1mfr, idfr               ! some switches 
    101       INTEGER  ::   iflt, ial, iadv, ifral, ifrdv 
    102       REAL(wp) ::   zinda, zfons, zpme              ! local scalars 
    103       REAL(wp), POINTER, DIMENSION(:,:) ::   zfcm1 , zfcm2    ! solar/non solar heat fluxes 
    104       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace 
     102      INTEGER  ::   ierr, ifvt, i1mfr, idfr           ! local integer 
     103      INTEGER  ::   iflt, ial , iadv , ifral, ifrdv   !   -      - 
     104      REAL(wp) ::   zinda, zemp, zemp_snow, zfmm      ! local scalars 
     105      REAL(wp) ::   zemp_snw                          !   -      - 
     106      REAL(wp) ::   zfcm1 , zfcm2                     !   -      - 
     107      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
    105108      !!--------------------------------------------------------------------- 
    106109       
    107       CALL wrk_alloc( jpi, jpj, zfcm1 , zfcm2 ) 
    108110      IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    109111 
     
    139141 
    140142            !   computation the solar flux at ocean surface 
    141             zfcm1(ji,jj)   = pfrld(ji,jj) * qsr(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 
     143            zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) 
    142144            ! fstric     Solar flux transmitted trough the ice 
    143145            ! qsr        Net short wave heat flux on free ocean 
     
    146148 
    147149            !  computation the non solar heat flux at ocean surface 
    148             zfcm2(ji,jj) = - zfcm1(ji,jj)                  & 
    149                &           + iflt    * ( fscmbq(ji,jj) )   & ! total abl -> fscmbq is given to the ocean 
    150                ! fscmbq and ffltbif are obsolete 
    151                !              &           + iflt * ffltbif(ji,jj) !!! only if one category is used 
    152                &           + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   & 
    153                &           + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) )                   * r1_rdtice   & 
    154                &           + fhmec(ji,jj)     & ! new contribution due to snow melt in ridging!! 
    155                &           + fheat_rpo(ji,jj) & ! contribution from ridge formation 
    156                &           + fheat_res(ji,jj) 
    157             ! fscmbq  Part of the solar radiation transmitted through the ice and going to the ocean 
    158             !         computed in limthd_zdf.F90 
    159             ! ffltbif Total heat content of the ice (brine pockets+ice) / delta_t 
     150            zfcm2 = - zfcm1                                                                     & ! ??? 
     151               &    + iflt    * fscmbq(ji,jj)                                                   & ! total ablation: heat given to the ocean 
     152               &    + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   & 
     153               &    + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice   & 
     154               &    + fhmec(ji,jj)                                                              & ! snow melt when ridging 
     155               &    + fheat_mec(ji,jj)                                                          & ! ridge formation 
     156               &    + fheat_res(ji,jj)                                                            ! residual heat flux 
    160157            ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok) 
    161158            ! qldif   heat balance of the lead (or of the open ocean) 
    162             ! qfvbq   i think this is wrong! 
    163             ! ---> Array used to store energy in case of total lateral ablation 
    164             ! qfvbq latent heat uptake/release after accretion/ablation 
    165             ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 
    166  
    167             IF ( num_sal == 2 ) zfcm2(ji,jj) = zfcm2(ji,jj) + & 
    168                fhbri(ji,jj) ! new contribution due to brine drainage  
    169  
    170             ! bottom radiative component is sent to the computation of the 
    171             ! oceanic heat flux 
    172             fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)      
     159            ! qfvbq   latent heat uptake/release after accretion/ablation 
     160            ! qdtcn   Energy from the turbulent oceanic heat flux heat flux coming in the lead 
     161 
     162            IF( num_sal == 2 )   zfcm2 = zfcm2 + fhbri(ji,jj)    ! add contribution due to brine drainage  
     163 
     164            ! bottom radiative component is sent to the computation of the oceanic heat flux 
     165            fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj)      
    173166 
    174167            ! used to compute the oceanic heat flux at the next time step 
    175             qsr(ji,jj) = zfcm1(ji,jj)                                       ! solar heat flux  
    176             qns(ji,jj) = zfcm2(ji,jj) - fdtcn(ji,jj)                        ! non solar heat flux 
     168            qsr(ji,jj) = zfcm1                                       ! solar heat flux  
     169            qns(ji,jj) = zfcm2 - fdtcn(ji,jj)                        ! non solar heat flux 
    177170            !                           ! fdtcn : turbulent oceanic heat flux 
    178171 
    179             !!gm   this IF prevents the vertorisation of the whole loop 
     172!!gm   this IF prevents the vertorisation of the whole loop 
    180173            IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 
    181174               WRITE(numout,*) ' lim_sbc : heat fluxes ' 
    182175               WRITE(numout,*) ' qsr       : ', qsr(jiindx,jjindx) 
    183                WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindx,jjindx) 
    184176               WRITE(numout,*) ' pfrld     : ', pfrld(jiindx,jjindx) 
    185177               WRITE(numout,*) ' fstric    : ', fstric (jiindx,jjindx) 
    186178               WRITE(numout,*) 
    187179               WRITE(numout,*) ' qns       : ', qns(jiindx,jjindx) 
    188                WRITE(numout,*) ' zfcm2     : ', zfcm2(jiindx,jjindx) 
    189                WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindx,jjindx) 
     180               WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
    190181               WRITE(numout,*) ' ifral     : ', ifral 
    191182               WRITE(numout,*) ' ial       : ', ial   
     
    202193               WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
    203194               WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx) 
    204                WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(jiindx,jjindx) 
     195               WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx) 
    205196               WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx) 
    206197               WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 
    207198            ENDIF 
    208             !!gm   end 
     199!!gm   end 
    209200         END DO 
    210201      END DO 
     
    227218 
    228219            !  computing freshwater exchanges at the ice/ocean interface 
    229             zpme = - emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
    230                &   + tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
    231                &   - sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
    232                &   - rdmsnif(ji,jj) * r1_rdtice                       &   ! freshwaterflux due to snow melting  
    233                &   + fmmec(ji,jj)                                         ! snow falling when ridging 
    234  
    235  
    236             !  computing salt exchanges at the ice/ocean interface 
    237             !  sice should be the same as computed with the ice model 
    238             zfons =  ( soce_0(ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice  
    239             ! SOCE 
    240             zfons =  ( sss_m (ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice 
    241  
    242             !CT useless            !  salt flux for constant salinity 
    243             !CT useless            fsalt(ji,jj)      =  zfons / ( sss_m(ji,jj) + epsi16 ) + fsalt_res(ji,jj) 
    244             !  salt flux for variable salinity 
    245             zinda             = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    246             !  correcting brine and salt fluxes 
    247             fsbri(ji,jj)      =  zinda*fsbri(ji,jj) 
    248             !  converting the salt fluxes from ice to a freshwater flux from ocean 
    249             fsalt_res(ji,jj)  =  fsalt_res(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 
    250             fseqv(ji,jj)      =  fseqv(ji,jj)     / ( sss_m(ji,jj) + epsi16 ) 
    251             fsbri(ji,jj)      =  fsbri(ji,jj)     / ( sss_m(ji,jj) + epsi16 ) 
    252             fsalt_rpo(ji,jj)  =  fsalt_rpo(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 
    253  
    254             !  freshwater mass exchange (positive to the ice, negative for the ocean ?) 
    255             !  actually it's a salt flux (so it's minus freshwater flux) 
    256             !  if sea ice grows, zfons is positive, fsalt also 
    257             !  POSITIVE SALT FLUX FROM THE ICE TO THE OCEAN 
    258             !  POSITIVE FRESHWATER FLUX FROM THE OCEAN TO THE ICE [kg.m-2.s-1] 
    259  
    260             emp(ji,jj) = - zpme  
     220            zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
     221               &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
     222               &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
     223               &   - fmmec(ji,jj)                                         ! snow falling when ridging 
     224 
     225            ! mass flux at the ocean/ice interface (sea ice fraction) 
     226            zemp_snw = rdm_snw(ji,jj) * r1_rdtice                         ! snow melting = pure water that enters the ocean 
     227            zfmm     = rdm_ice(ji,jj) * r1_rdtice                         ! Freezing minus mesting   
     228 
     229            emp(ji,jj) = zemp + zemp_snw + zfmm  ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     230             
     231            !  correcting brine salt fluxes   (zinda = 1  if pfrld=1 , =0 otherwise) 
     232            zinda        = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
     233            sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj) 
    261234         END DO 
    262235      END DO 
    263236 
     237      !------------------------------------------! 
     238      !      salt flux at the ocean surface      ! 
     239      !------------------------------------------! 
     240 
    264241      IF( num_sal == 2 ) THEN      ! variable ice salinity: brine drainage included in the salt flux 
    265          emps(:,:) = fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:) 
     242         sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 
    266243      ELSE                         ! constant ice salinity: 
    267          emps(:,:) =              fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:) 
     244         sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 
     245      ENDIF 
     246      !-----------------------------------------------! 
     247      !   mass of snow and ice per unit area          ! 
     248      !-----------------------------------------------! 
     249      IF( nn_ice_embd /= 0 ) THEN                               ! embedded sea-ice (mass required) 
     250         snwice_mass_b(:,:) = snwice_mass(:,:)                  ! save mass from the previous ice time step 
     251         !                                                      ! new mass per unit area 
     252         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
     253         !                                                      ! time evolution of snow+ice mass 
     254         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    268255      ENDIF 
    269256 
     
    285272      IF(ln_ctl) THEN 
    286273         CALL prt_ctl( tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns , clinfo2=' qns     : ' ) 
    287          CALL prt_ctl( tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=emps, clinfo2=' emps    : ' ) 
     274         CALL prt_ctl( tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=sfx , clinfo2=' sfx     : ' ) 
    288275         CALL prt_ctl( tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ' ) 
    289276         CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 
    290277      ENDIF 
    291278      ! 
    292       CALL wrk_dealloc( jpi, jpj, zfcm1 , zfcm2 ) 
    293279      IF( lk_cpl )   CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 
    294280      !  
     
    383369      !!------------------------------------------------------------------- 
    384370      ! 
     371      INTEGER  ::   ji, jj                          ! dummy loop indices 
     372      REAL(wp) ::   zcoefu, zcoefv, zcoeff          ! local scalar 
    385373      IF(lwp) WRITE(numout,*) 
    386374      IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition' 
     
    389377      !                                      ! allocate lim_sbc array 
    390378      IF( lim_sbc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 
    391       ! 
    392       r1_rdtice = 1. / rdt_ice 
    393379      ! 
    394380      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
     
    402388         END WHERE 
    403389      ENDIF 
     390      !                                      ! embedded sea ice 
     391      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     392         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
     393         snwice_mass_b(:,:) = snwice_mass(:,:) 
     394      ELSE 
     395         snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
     396         snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     397      ENDIF 
     398      IF( nn_ice_embd == 2  .AND.         &  ! full embedment (case 2) & no restart 
     399         &  .NOT. ln_rstart ) THEN           ! deplete the initial ssh below sea-ice area 
     400         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
     401         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     402         ! 
     403         ! Note: Changed the initial values of sshb and sshn=>  need to recompute ssh[u,v,f]_[b,n]  
     404         !       which were previously set in domvvl 
     405         IF ( lk_vvl ) THEN            ! Is this necessary? embd 2 should be restricted to vvl only??? 
     406            DO jj = 1, jpjm1 
     407               DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible 
     408                  zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
     409                  zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
     410                  zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
     411                  sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
     412                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 
     413                  sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
     414                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 
     415                  sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
     416                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 
     417                  sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
     418                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 
     419               END DO 
     420            END DO 
     421            CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. ) 
     422            CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. ) 
     423            DO jj = 1, jpjm1 
     424               DO ji = 1, jpim1      ! NO Vector Opt. 
     425                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
     426                       &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     427                       &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     428                       &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     429               END DO 
     430            END DO 
     431            CALL lbc_lnk( sshf_n, 'F', 1. ) 
     432          ENDIF 
     433      ENDIF 
    404434      ! 
    405435   END SUBROUTINE lim_sbc_init 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90

    r2715 r3625  
    22   !!====================================================================== 
    33   !!                       ***  MODULE limtab   *** 
    4    !!   LIM : transform 1D (2D) array to a 2D (1D) table 
     4   !!   LIM ice model : transform 1D (2D) array to a 2D (1D) table 
    55   !!====================================================================== 
    66#if defined key_lim3 
     
    2020 
    2121   !!---------------------------------------------------------------------- 
    22    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
     22   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2010) 
    2323   !! $Id$ 
    2424   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r3294 r3625  
    88   !!            3.0  ! 2005-11 (M. Vancoppenolle)  LIM-3 : Multi-layer thermodynamics + salinity variations 
    99   !!             -   ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 
    10    !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdmsnif 
     10   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw 
    1111   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 
    1212   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     
    1616   !!   'key_lim3'                                      LIM3 sea-ice model 
    1717   !!---------------------------------------------------------------------- 
    18    !!   lim_thd        : thermodynamic of sea ice 
    19    !!   lim_thd_init   : initialisation of sea-ice thermodynamic 
     18   !!   lim_thd       : thermodynamic of sea ice 
     19   !!   lim_thd_init  : initialisation of sea-ice thermodynamic 
    2020   !!---------------------------------------------------------------------- 
    21    USE phycst          ! physical constants 
    22    USE dom_oce         ! ocean space and time domain variables 
    23    USE ice             ! LIM: sea-ice variables 
    24    USE par_ice         ! LIM: sea-ice parameters 
    25    USE sbc_oce         ! Surface boundary condition: ocean fields 
    26    USE sbc_ice         ! Surface boundary condition: ice fields 
    27    USE thd_ice         ! LIM thermodynamic sea-ice variables 
    28    USE dom_ice         ! LIM sea-ice domain 
    29    USE domvvl          ! domain: variable volume level 
    30    USE limthd_dif      ! LIM: thermodynamics, vertical diffusion 
    31    USE limthd_dh       ! LIM: thermodynamics, ice and snow thickness variation 
    32    USE limthd_sal      ! LIM: thermodynamics, ice salinity 
    33    USE limthd_ent      ! LIM: thermodynamics, ice enthalpy redistribution 
    34    USE limtab          ! LIM: 1D <==> 2D transformation 
    35    USE limvar          ! LIM: sea-ice variables 
    36    USE lbclnk          ! lateral boundary condition - MPP links 
    37    USE lib_mpp         ! MPP library 
    38    USE wrk_nemo        ! work arrays 
    39    USE in_out_manager  ! I/O manager 
    40    USE prtctl          ! Print control 
     21   USE phycst         ! physical constants 
     22   USE dom_oce        ! ocean space and time domain variables 
     23   USE ice            ! LIM: sea-ice variables 
     24   USE par_ice        ! LIM: sea-ice parameters 
     25   USE sbc_oce        ! Surface boundary condition: ocean fields 
     26   USE sbc_ice        ! Surface boundary condition: ice fields 
     27   USE thd_ice        ! LIM thermodynamic sea-ice variables 
     28   USE dom_ice        ! LIM sea-ice domain 
     29   USE domvvl         ! domain: variable volume level 
     30   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
     31   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
     32   USE limthd_sal     ! LIM: thermodynamics, ice salinity 
     33   USE limthd_ent     ! LIM: thermodynamics, ice enthalpy redistribution 
     34   USE limtab         ! LIM: 1D <==> 2D transformation 
     35   USE limvar         ! LIM: sea-ice variables 
     36   USE lbclnk         ! lateral boundary condition - MPP links 
     37   USE lib_mpp        ! MPP library 
     38   USE wrk_nemo       ! work arrays 
     39   USE in_out_manager ! I/O manager 
     40   USE prtctl         ! Print control 
     41   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4142 
    4243   IMPLICIT NONE 
     
    110111                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi06 ) ) * nlay_i 
    111112                  !0 if no ice and 1 if yes 
    112                   zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i(ji,jj,jl) ) )  
     113                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - ht_i(ji,jj,jl) ) )  
    113114                  !convert units ! very important that this line is here 
    114115                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb  
     
    122123                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * nlay_s 
    123124                  !0 if no ice and 1 if yes 
    124                   zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s(ji,jj,jl) ) )  
     125                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - ht_s(ji,jj,jl) ) )  
    125126                  !convert units ! very important that this line is here 
    126127                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb  
     
    140141      ffltbif(:,:) = 0.e0   ! linked with fstric 
    141142      qfvbq  (:,:) = 0.e0   ! linked with fstric 
    142       rdmsnif(:,:) = 0.e0   ! variation of snow mass per unit area 
    143       rdmicif(:,:) = 0.e0   ! variation of ice mass per unit area 
     143      rdm_snw(:,:) = 0.e0   ! variation of snow mass per unit area 
     144      rdm_ice(:,:) = 0.e0   ! variation of ice mass per unit area 
    144145      hicifp (:,:) = 0.e0   ! daily thermodynamic ice production.  
    145       fsbri  (:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
     146      sfx_bri(:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
    146147      fhbri  (:,:) = 0.e0   ! brine flux contribution to heat flux to the ocean 
    147       fseqv  (:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
     148      sfx_thd(:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
    148149 
    149150      !----------------------------------- 
     
    273274            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
    274275            CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    275  
    276276#if ! defined key_coupled 
    277             CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    278             CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) ) 
     277            CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     278            CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    279279#endif 
    280  
    281             CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) ) 
    282             CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo       , jpi, jpj, npb(1:nbpb) ) 
    283             CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip    , jpi, jpj, npb(1:nbpb) )  
    284             CALL tab_2d_1d( nbpb, fbif_1d    (1:nbpb), fbif       , jpi, jpj, npb(1:nbpb) ) 
    285             CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb), qldif      , jpi, jpj, npb(1:nbpb) ) 
    286             CALL tab_2d_1d( nbpb, rdmicif_1d (1:nbpb), rdmicif    , jpi, jpj, npb(1:nbpb) ) 
    287             CALL tab_2d_1d( nbpb, rdmsnif_1d (1:nbpb), rdmsnif    , jpi, jpj, npb(1:nbpb) ) 
    288             CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb), dmgwi      , jpi, jpj, npb(1:nbpb) ) 
    289             CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb), zqlbsbq    , jpi, jpj, npb(1:nbpb) ) 
    290  
    291             CALL tab_2d_1d( nbpb, fseqv_1d   (1:nbpb), fseqv      , jpi, jpj, npb(1:nbpb) ) 
    292             CALL tab_2d_1d( nbpb, fsbri_1d   (1:nbpb), fsbri      , jpi, jpj, npb(1:nbpb) ) 
    293             CALL tab_2d_1d( nbpb, fhbri_1d   (1:nbpb), fhbri      , jpi, jpj, npb(1:nbpb) ) 
    294             CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric     , jpi, jpj, npb(1:nbpb) ) 
    295             CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq      , jpi, jpj, npb(1:nbpb) ) 
     280            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     281            CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
     282            CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
     283            CALL tab_2d_1d( nbpb, fbif_1d    (1:nbpb), fbif            , jpi, jpj, npb(1:nbpb) ) 
     284            CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb), qldif           , jpi, jpj, npb(1:nbpb) ) 
     285            CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice         , jpi, jpj, npb(1:nbpb) ) 
     286            CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw         , jpi, jpj, npb(1:nbpb) ) 
     287            CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb), dmgwi           , jpi, jpj, npb(1:nbpb) ) 
     288            CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb), zqlbsbq         , jpi, jpj, npb(1:nbpb) ) 
     289 
     290            CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     291            CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
     292            CALL tab_2d_1d( nbpb, fhbri_1d   (1:nbpb), fhbri           , jpi, jpj, npb(1:nbpb) ) 
     293            CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric          , jpi, jpj, npb(1:nbpb) ) 
     294            CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq           , jpi, jpj, npb(1:nbpb) ) 
    296295 
    297296            !-------------------------------- 
     
    331330            !-------------------------------- 
    332331 
    333             CALL tab_1d_2d( nbpb, at_i        , npb, at_i_b(1:nbpb), jpi, jpj ) 
    334             CALL tab_1d_2d( nbpb, ht_i(:,:,jl), npb, ht_i_b(1:nbpb), jpi, jpj ) 
    335             CALL tab_1d_2d( nbpb, ht_s(:,:,jl), npb, ht_s_b(1:nbpb), jpi, jpj ) 
    336             CALL tab_1d_2d( nbpb, a_i (:,:,jl), npb, a_i_b(1:nbpb) , jpi, jpj ) 
    337             CALL tab_1d_2d( nbpb, t_su(:,:,jl), npb, t_su_b(1:nbpb), jpi, jpj ) 
    338             CALL tab_1d_2d( nbpb, sm_i(:,:,jl), npb, sm_i_b(1:nbpb), jpi, jpj ) 
    339  
     332               CALL tab_1d_2d( nbpb, at_i          , npb, at_i_b    (1:nbpb)   , jpi, jpj ) 
     333               CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_b    (1:nbpb)   , jpi, jpj ) 
     334               CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_b    (1:nbpb)   , jpi, jpj ) 
     335               CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_b     (1:nbpb)   , jpi, jpj ) 
     336               CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_b    (1:nbpb)   , jpi, jpj ) 
     337               CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_b    (1:nbpb)   , jpi, jpj ) 
    340338            DO jk = 1, nlay_s 
    341                CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b(1:nbpb,jk), jpi, jpj) 
    342                CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b(1:nbpb,jk), jpi, jpj) 
     339               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b     (1:nbpb,jk), jpi, jpj) 
     340               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b     (1:nbpb,jk), jpi, jpj) 
    343341            END DO 
    344  
    345342            DO jk = 1, nlay_i 
    346                CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b(1:nbpb,jk), jpi, jpj) 
    347                CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b(1:nbpb,jk), jpi, jpj) 
    348                CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b(1:nbpb,jk), jpi, jpj) 
     343               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b     (1:nbpb,jk), jpi, jpj) 
     344               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b     (1:nbpb,jk), jpi, jpj) 
     345               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b     (1:nbpb,jk), jpi, jpj) 
    349346            END DO 
    350  
    351             CALL tab_1d_2d( nbpb, fstric , npb, fstbif_1d (1:nbpb), jpi, jpj ) 
    352             CALL tab_1d_2d( nbpb, qldif  , npb, qldif_1d  (1:nbpb), jpi, jpj ) 
    353             CALL tab_1d_2d( nbpb, qfvbq  , npb, qfvbq_1d  (1:nbpb), jpi, jpj ) 
    354             CALL tab_1d_2d( nbpb, rdmicif, npb, rdmicif_1d(1:nbpb), jpi, jpj ) 
    355             CALL tab_1d_2d( nbpb, rdmsnif, npb, rdmsnif_1d(1:nbpb), jpi, jpj ) 
    356             CALL tab_1d_2d( nbpb, dmgwi  , npb, dmgwi_1d  (1:nbpb), jpi, jpj ) 
    357             CALL tab_1d_2d( nbpb, rdvosif, npb, dvsbq_1d  (1:nbpb), jpi, jpj ) 
    358             CALL tab_1d_2d( nbpb, rdvobif, npb, dvbbq_1d  (1:nbpb), jpi, jpj ) 
    359             CALL tab_1d_2d( nbpb, fdvolif, npb, dvlbq_1d  (1:nbpb), jpi, jpj ) 
    360             CALL tab_1d_2d( nbpb, rdvonif, npb, dvnbq_1d  (1:nbpb), jpi, jpj )  
    361             CALL tab_1d_2d( nbpb, fseqv  , npb, fseqv_1d  (1:nbpb), jpi, jpj ) 
     347               CALL tab_1d_2d( nbpb, fstric        , npb, fstbif_1d (1:nbpb)   , jpi, jpj ) 
     348               CALL tab_1d_2d( nbpb, qldif         , npb, qldif_1d  (1:nbpb)   , jpi, jpj ) 
     349               CALL tab_1d_2d( nbpb, qfvbq         , npb, qfvbq_1d  (1:nbpb)   , jpi, jpj ) 
     350               CALL tab_1d_2d( nbpb, rdm_ice       , npb, rdm_ice_1d(1:nbpb)   , jpi, jpj ) 
     351               CALL tab_1d_2d( nbpb, rdm_snw       , npb, rdm_snw_1d(1:nbpb)   , jpi, jpj ) 
     352               CALL tab_1d_2d( nbpb, dmgwi         , npb, dmgwi_1d  (1:nbpb)   , jpi, jpj ) 
     353               CALL tab_1d_2d( nbpb, rdvosif       , npb, dvsbq_1d  (1:nbpb)   , jpi, jpj ) 
     354               CALL tab_1d_2d( nbpb, rdvobif       , npb, dvbbq_1d  (1:nbpb)   , jpi, jpj ) 
     355               CALL tab_1d_2d( nbpb, fdvolif       , npb, dvlbq_1d  (1:nbpb)   , jpi, jpj ) 
     356               CALL tab_1d_2d( nbpb, rdvonif       , npb, dvnbq_1d  (1:nbpb)   , jpi, jpj )  
     357               CALL tab_1d_2d( nbpb, sfx_thd       , npb, sfx_thd_1d(1:nbpb)   , jpi, jpj ) 
    362358            ! 
    363359            IF( num_sal == 2 ) THEN 
    364                CALL tab_1d_2d( nbpb, fsbri, npb, fsbri_1d(1:nbpb), jpi, jpj ) 
    365                CALL tab_1d_2d( nbpb, fhbri, npb, fhbri_1d(1:nbpb), jpi, jpj ) 
     360               CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
     361               CALL tab_1d_2d( nbpb, fhbri         , npb, fhbri_1d  (1:nbpb)   , jpi, jpj ) 
    366362            ENDIF 
    367363            ! 
    368             !+++++ 
    369             !temporary stuff for a dummy version 
     364            !+++++       temporary stuff for a dummy version 
    370365            CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
    371366            CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
     
    389384      ! 5.1) Ice heat content               
    390385      !------------------------ 
    391       ! Enthalpies are global variables we have to readjust the units 
     386      ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    392387      zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 
    393388      DO jl = 1, jpl 
    394389         DO jk = 1, nlay_i 
    395             ! Multiply by volume, divide by nlayers so that heat content in 10^9 Joules 
    396390            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef 
    397391         END DO 
     
    401395      ! 5.2) Snow heat content               
    402396      !------------------------ 
    403       ! Enthalpies are global variables we have to readjust the units 
     397      ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    404398      zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 
    405399      DO jl = 1, jpl 
    406400         DO jk = 1, nlay_s 
    407             ! Multiply by volume, so that heat content in 10^9 Joules 
    408401            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef 
    409402         END DO 
     
    419412      !-------------------------------------------- 
    420413      d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes  
    421       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) / rdt_ice * 86400.0 
     414      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    422415 
    423416      IF( con_i )   fbif(:,:) = fbif(:,:) + zqlbsbq(:,:) 
     
    488481      ! 
    489482      IF(lwp) WRITE(numout,*) ' lim_thd_glohec ' 
    490       IF(lwp) WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) / rdt_ice 
    491       IF(lwp) WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) / rdt_ice 
    492       IF(lwp) WRITE(numout,*) ' qt_in   : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) / rdt_ice 
     483      IF(lwp) WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) * r1_rdtice 
     484      IF(lwp) WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) * r1_rdtice 
     485      IF(lwp) WRITE(numout,*) ' qt_in   : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) * r1_rdtice 
    493486      ! 
    494487   END SUBROUTINE lim_thd_glohec 
     
    538531      !-------------------- 
    539532      DO ji = kideb, kiut 
    540          cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
     533         cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    541534      END DO 
    542535 
     
    597590            WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    598591            WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 
    599             WRITE(numout,*) ' dq_i       : ', - dq_i(ji,jl) / rdt_ice 
     592            WRITE(numout,*) ' dq_i       : ', - dq_i(ji,jl) * r1_rdtice 
    600593            WRITE(numout,*) ' Fdt        : ', sum_fluxq(ji,jl) 
    601594            WRITE(numout,*) 
     
    631624            WRITE(numout,*) 
    632625            WRITE(numout,*) ' Layer by layer ... ' 
    633             WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice 
     626            WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 
    634627            WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) - fc_s(ji,0) 
    635628            DO jk = 1, nlay_i 
    636629               WRITE(numout,*) ' layer  : ', jk 
    637                WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) / rdt_ice   
     630               WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) * r1_rdtice   
    638631               WRITE(numout,*) ' radab  : ', radab(ji,jk) 
    639632               WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) - fc_i(ji,jk-1) 
     
    681674         fatm      (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji)                       ! total heat flux 
    682675         sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(zji,zjj,jl)  
    683          cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
     676         cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    684677      END DO 
    685678 
     
    688681      !-------------------- 
    689682      DO ji = kideb, kiut 
    690          cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) ) 
     683         cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    691684      END DO 
    692685 
     
    722715            WRITE(numout,*) ' * ' 
    723716            WRITE(numout,*) ' Ftotal     : ', sum_fluxq(ji,jl) 
    724             WRITE(numout,*) ' dq_t       : ', - dq_i(ji,jl) / rdt_ice 
    725             WRITE(numout,*) ' dq_i       : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) / rdt_ice 
    726             WRITE(numout,*) ' dq_s       : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice 
     717            WRITE(numout,*) ' dq_t       : ', - dq_i(ji,jl) * r1_rdtice 
     718            WRITE(numout,*) ' dq_i       : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) * r1_rdtice 
     719            WRITE(numout,*) ' dq_s       : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 
    727720            WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    728721            WRITE(numout,*) ' * ' 
     
    734727            WRITE(numout,*) ' * ' 
    735728            WRITE(numout,*) ' Heat contents --- : ' 
    736             WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) / rdt_ice 
    737             WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) / rdt_ice 
    738             WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) / rdt_ice 
    739             WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) / rdt_ice 
    740             WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) / rdt_ice 
    741             WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) / rdt_ice 
     729            WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) * r1_rdtice 
     730            WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) * r1_rdtice 
     731            WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) * r1_rdtice 
     732            WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) * r1_rdtice 
     733            WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) * r1_rdtice 
     734            WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) * r1_rdtice 
    742735            WRITE(numout,*) ' * ' 
    743736            WRITE(numout,*) ' Ice variables --- : ' 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r3294 r3625  
    77   !!                 ! 2005-06 (M. Vancoppenolle) 3D version  
    88   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdmsnif & rdmicif 
    9    !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     9   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
     10   !!            3.5  ! 2012-10 (G. Madec & co) salt flux + bug fixes  
    1011   !!---------------------------------------------------------------------- 
    1112#if defined key_lim3 
     
    1314   !!   'key_lim3'                                      LIM3 sea-ice model 
    1415   !!---------------------------------------------------------------------- 
    15    !!   lim_thd_dh  : vertical accr./abl. and lateral ablation of sea ice 
    16    !!---------------------------------------------------------------------- 
    17    USE par_oce          ! ocean parameters 
    18    USE phycst           ! physical constants (OCE directory)  
    19    USE sbc_oce          ! Surface boundary condition: ocean fields 
    20    USE ice              ! LIM variables 
    21    USE par_ice          ! LIM parameters 
    22    USE thd_ice          ! LIM thermodynamics 
    23    USE in_out_manager   ! I/O manager 
    24    USE lib_mpp          ! MPP library 
    25    USE wrk_nemo         ! work arrays 
     16   !!   lim_thd_dh    : vertical accr./abl. and lateral ablation of sea ice 
     17   !!---------------------------------------------------------------------- 
     18   USE par_oce        ! ocean parameters 
     19   USE phycst         ! physical constants (OCE directory)  
     20   USE sbc_oce        ! Surface boundary condition: ocean fields 
     21   USE ice            ! LIM variables 
     22   USE par_ice        ! LIM parameters 
     23   USE thd_ice        ! LIM thermodynamics 
     24   USE in_out_manager ! I/O manager 
     25   USE lib_mpp        ! MPP library 
     26   USE wrk_nemo       ! work arrays 
     27   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2628 
    2729   IMPLICIT NONE 
     
    3739 
    3840   !!---------------------------------------------------------------------- 
    39    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
     41   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    4042   !! $Id$ 
    4143   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    7173      !!  
    7274      INTEGER  ::   ji , jk        ! dummy loop indices 
    73       INTEGER  ::   zji, zjj       ! 2D corresponding indices to ji 
     75      INTEGER  ::   ii, ij       ! 2D corresponding indices to ji 
    7476      INTEGER  ::   isnow          ! switch for presence (1) or absence (0) of snow 
    7577      INTEGER  ::   isnowic        ! snow ice formation not 
     
    102104      REAL(wp), POINTER, DIMENSION(:) ::   zfmass_i    !  
    103105 
    104       REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel     ! snow melt  
    105       REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_pre     ! snow precipitation  
    106       REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_sub     ! snow sublimation 
    107       REAL(wp), POINTER, DIMENSION(:) ::   zfsalt_melt   ! salt flux due to ice melt 
     106      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt  
     107      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_pre   ! snow precipitation  
     108      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_sub   ! snow sublimation 
     109      REAL(wp), POINTER, DIMENSION(:) ::   zsfx_melt   ! salt flux due to ice melt 
    108110 
    109111      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah 
     
    126128 
    127129      CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 
    128       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
     130      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zsfx_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
    129131      CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 
    130132      CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
    131133 
    132       zfsalt_melt(:) = 0._wp 
    133       ftotal_fin(:)   = 0._wp 
    134       zfdt_init(:)    = 0._wp 
    135       zfdt_final(:)   = 0._wp 
     134      zsfx_melt (:) = 0._wp 
     135      ftotal_fin(:) = 0._wp 
     136      zfdt_init (:) = 0._wp 
     137      zfdt_final(:) = 0._wp 
    136138 
    137139      DO ji = kideb, kiut 
     
    145147      ! 
    146148      DO ji = kideb, kiut 
    147          isnow         = INT( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ) ) 
    148          ztfs(ji)      = isnow * rtt + ( 1.0 - isnow ) * rtt 
    149          z_f_surf(ji) = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
    150          z_f_surf(ji)  = MAX( zzero , z_f_surf(ji) ) * MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) ) 
     149         isnow         = INT(  1.0 - MAX(  0.0 , SIGN( 1.0 , - ht_s_b(ji) )  ) ) 
     150         ztfs     (ji) = isnow * rtt + ( 1.0 - isnow ) * rtt 
     151         z_f_surf (ji) = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
     152         z_f_surf (ji) = MAX(  zzero , z_f_surf(ji)  ) * MAX(  zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) ) 
    151153         zfdt_init(ji) = ( z_f_surf(ji) + MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) ) * rdt_ice 
    152154      END DO ! ji 
     
    240242         zhsnew         =  ht_s_b(ji) + dh_s_tot(ji) 
    241243         ! If snow is still present zhn = 1, else zhn = 0 
    242          zhn            =  1.0 - MAX( zzero , SIGN( zone , - zhsnew ) ) 
     244         zhn            =  1.0 - MAX(  zzero , SIGN( zone , - zhsnew ) ) 
    243245         ht_s_b(ji)     =  MAX( zzero , zhsnew ) 
    244246         ! Volume and mass variations of snow 
    245          dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_mel(ji) ) 
     247         dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) ) 
    246248         dvsbq_1d  (ji) =  MIN( zzero, dvsbq_1d(ji) ) 
    247          rdmsnif_1d(ji) =  rdmsnif_1d(ji) + rhosn * dvsbq_1d(ji) 
     249         rdm_snw_1d(ji) =  rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 
    248250      END DO ! ji 
    249251 
     
    253255      DO ji = kideb, kiut  
    254256         dh_i_surf(ji) =  0._wp 
    255          z_f_surf (ji) =  zqfont_su(ji) / rdt_ice ! heat conservation test 
     257         z_f_surf (ji) =  zqfont_su(ji) * r1_rdtice  ! heat conservation test 
    256258         zdq_i    (ji) =  0._wp 
    257259      END DO ! ji 
     
    262264            zdeltah  (ji,jk) = - zqfont_su(ji) / q_i_b(ji,jk) 
    263265            !                                                    ! recompute heat available 
    264             zqfont_su(ji)    = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk)  
     266            zqfont_su(ji   ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk)  
    265267            !                                                    ! melt of layer jk cannot be higher than its thickness 
    266268            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_i(ji) ) 
    267269            !                                                    ! update surface melt 
    268             dh_i_surf(ji)    = dh_i_surf(ji) + zdeltah(ji,jk)  
     270            dh_i_surf(ji   ) = dh_i_surf(ji) + zdeltah(ji,jk)  
    269271            !                                                    ! for energy conservation 
    270             zdq_i    (ji)    = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) / rdt_ice 
     272            zdq_i    (ji   ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 
    271273            ! 
    272             ! contribution to ice-ocean salt flux  
    273             zji = MOD( npb(ji) - 1 , jpi ) + 1 
    274             zjj =    ( npb(ji) - 1 ) / jpi + 1 
    275             zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji) ) * a_i_b(ji)    & 
    276                &                              * MIN( zdeltah(ji,jk) , 0.e0 ) * rhoic / rdt_ice  
     274            !                                                    ! contribution to ice-ocean salt flux  
     275            zsfx_melt(ji)  = zsfx_melt(ji) - sm_i_b(ji) * a_i_b(ji) * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice  
    277276         END DO 
    278277      END DO 
     
    290289            IF( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN! 
    291290               WRITE(numout,*) ' ALERTE heat loss for surface melt ' 
    292                WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl 
     291               WRITE(numout,*) ' ii, ij, jl :', ii, ij, jl 
    293292               WRITE(numout,*) ' ht_i_b       : ', ht_i_b(ji) 
    294293               WRITE(numout,*) ' z_f_surf     : ', z_f_surf(ji) 
     
    299298               WRITE(numout,*) ' qlbbq_1d     : ', qlbbq_1d(ji) 
    300299               WRITE(numout,*) ' s_i_new      : ', s_i_new(ji) 
    301                WRITE(numout,*) ' sss_m        : ', sss_m(zji,zjj) 
     300               WRITE(numout,*) ' sss_m        : ', sss_m(ii,ij) 
    302301            ENDIF 
    303302         END DO 
     
    338337         DO ji = kideb, kiut 
    339338            ! In case of disparition of the snow, we have to update the snow temperatures 
    340             zhisn  =  MAX( zzero , SIGN( zone, - ht_s_b(ji) ) ) 
     339            zhisn  =  MAX(  zzero , SIGN( zone, - ht_s_b(ji) ) ) 
    341340            t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt 
    342341            q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk) 
     
    358357      ! 4.1 Basal growth - (a) salinity not varying in time  
    359358      !----------------------------------------------------- 
    360       IF(  num_sal /= 2  .AND.  num_sal /= 4  ) THEN 
    361          DO ji = kideb, kiut 
    362             IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0.0  ) THEN 
     359      IF(  num_sal /= 2  ) THEN   ! ice salinity constant in time 
     360         DO ji = kideb, kiut 
     361            IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0._wp  ) THEN 
    363362               s_i_new(ji)         =  sm_i_b(ji) 
    364363               ! Melting point in K 
     
    371370                  &                           - rcp  * ( ztmelts - rtt )                                 ) 
    372371               ! Basal growth rate = - F*dt / q 
    373                dh_i_bott(ji)       =  - rdt_ice*( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
     372               dh_i_bott(ji)       =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
    374373            ENDIF 
    375374         END DO 
     
    379378      ! 4.1 Basal growth - (b) salinity varying in time  
    380379      !------------------------------------------------- 
    381       IF(  num_sal == 2 .OR.  num_sal == 4  ) THEN 
    382          ! the growth rate (dh_i_bott) is function of the new ice 
    383          ! heat content (q_i_b(nlay_i+1)). q_i_b depends on the new ice  
    384          ! salinity (snewice). snewice depends on dh_i_bott 
    385          ! it converges quickly, so, no problem 
     380      IF(  num_sal == 2  ) THEN 
     381         ! the growth rate (dh_i_bott) is function of the new ice heat content (q_i_b(nlay_i+1)).  
     382         ! q_i_b depends on the new ice salinity (snewice).  
     383         ! snewice depends on dh_i_bott ; it converges quickly, so, no problem 
    386384         ! See Vancoppenolle et al., OM08 for more info on this 
    387385 
     
    394392            DO ji = kideb, kiut 
    395393               IF(  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0.e0  ) THEN 
    396                   zji = MOD( npb(ji) - 1, jpi ) + 1 
    397                   zjj = ( npb(ji) - 1 ) / jpi + 1 
     394                  ii = MOD( npb(ji) - 1, jpi ) + 1 
     395                  ij = ( npb(ji) - 1 ) / jpi + 1 
    398396                  ! Melting point in K 
    399397                  ztmelts             =   - tmut * s_i_new(ji) + rtt  
     
    408406                  ! zswi12 (1) if dh_i_bott/rdt .LT. 3.6e-7 and .GT. 2.0e-8 
    409407                  ! zswi1  (1) if dh_i_bott/rdt .LT. 2.0e-8 
    410                   zgrr   = MIN( 1.0e-3, MAX ( dh_i_bott(ji) / rdt_ice , epsi13 ) ) 
     408                  zgrr   = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi13 ) ) 
    411409                  zswi2  = MAX( zzero , SIGN( zone , zgrr - 3.6e-7 ) )  
    412410                  zswi12 = MAX( zzero , SIGN( zone , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 
     
    414412                  zfracs = zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   & 
    415413                     &                   + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  
    416                   zds         = zfracs * sss_m(zji,zjj) - s_i_new(ji) 
    417                   s_i_new(ji) = zfracs * sss_m(zji,zjj) 
     414                  zds         = zfracs * sss_m(ii,ij) - s_i_new(ji) 
     415                  s_i_new(ji) = zfracs * sss_m(ii,ij) 
    418416               ENDIF ! fc_bo_i 
    419417            END DO ! ji 
     
    432430                  &                            - rcp * ( ztmelts - rtt )                                    ) 
    433431               ! Basal growth rate = - F*dt / q 
    434                dh_i_bott(ji)       =  - rdt_ice*( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
     432               dh_i_bott(ji)       =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
    435433               ! Salinity update 
    436434               ! entrapment during bottom growth 
     
    453451            s_i_new(ji)   =  s_i_b(ji,nlay_i) 
    454452            zqfont_bo(ji) =  rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 
    455             zfbase(ji)    =  zqfont_bo(ji) / rdt_ice     ! heat conservation test 
     453            zfbase(ji)    =  zqfont_bo(ji) * r1_rdtice     ! heat conservation test 
    456454            zdq_i(ji)     =  0._wp 
    457455            dh_i_bott(ji) =  0._wp 
     
    461459      DO jk = nlay_i, 1, -1 
    462460         DO ji = kideb, kiut 
    463             IF (  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .GE. 0.0  ) THEN 
    464                ztmelts            =   - tmut * s_i_b(ji,jk) + rtt  
    465                IF( t_i_b(ji,jk) >= ztmelts ) THEN 
    466                   zdeltah(ji,jk)  = - zh_i(ji) 
    467                   dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk) 
    468                   zinnermelt(ji)   = 1._wp 
    469                ELSE  ! normal ablation 
    470                   zdeltah(ji,jk)  = - zqfont_bo(ji) / q_i_b(ji,jk) 
    471                   zqfont_bo(ji)   = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 
    472                   zdeltah(ji,jk)  = MAX(zdeltah(ji,jk), - zh_i(ji) ) 
    473                   dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk) 
    474                   zdq_i(ji)       = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) / rdt_ice 
    475                   ! contribution to salt flux 
    476                   zji             = MOD( npb(ji) - 1, jpi ) + 1 
    477                   zjj             = ( npb(ji) - 1 ) / jpi + 1 
    478                   zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji)   ) * a_i_b(ji)   & 
    479                      &                              * MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
     461            IF(  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji)  >=  0._wp  ) THEN 
     462               ztmelts = - tmut * s_i_b(ji,jk) + rtt  
     463               IF( t_i_b(ji,jk) >= ztmelts ) THEN   !!gm : a comment is needed 
     464                  zdeltah   (ji,jk) = - zh_i(ji) 
     465                  dh_i_bott (ji   ) = dh_i_bott(ji) + zdeltah(ji,jk) 
     466                  zinnermelt(ji   ) = 1._wp 
     467               ELSE                                  ! normal ablation 
     468                  zdeltah  (ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) 
     469                  zqfont_bo(ji   ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 
     470                  zdeltah  (ji,jk) = MAX(zdeltah(ji,jk), - zh_i(ji) ) 
     471                  dh_i_bott(ji   ) = dh_i_bott(ji) + zdeltah(ji,jk) 
     472                  zdq_i    (ji   ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 
    480473               ENDIF 
     474               ! contribution to salt flux 
     475               zsfx_melt(ji) = zsfx_melt(ji) - sm_i_b(ji) * a_i_b(ji) * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice  
    481476            ENDIF 
    482477         END DO ! ji 
     
    493488               ENDIF 
    494489               IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN 
    495                   WRITE(numout,*) ' ALERTE heat loss for basal melt : zji, zjj, jl :', zji, zjj, jl 
     490                  WRITE(numout,*) ' ALERTE heat loss for basal melt : ii, ij, jl :', ii, ij, jl 
    496491                  WRITE(numout,*) ' ht_i_b    : ', ht_i_b(ji) 
    497492                  WRITE(numout,*) ' zfbase    : ', zfbase(ji) 
     
    502497                  WRITE(numout,*) ' qlbbq_1d  : ', qlbbq_1d(ji) 
    503498                  WRITE(numout,*) ' s_i_new   : ', s_i_new(ji) 
    504                   WRITE(numout,*) ' sss_m     : ', sss_m(zji,zjj) 
     499                  WRITE(numout,*) ' sss_m     : ', sss_m(ii,ij) 
    505500                  WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    506501                  WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) ) 
     
    531526         !                     ! excessive energy is sent to lateral ablation 
    532527         fsup     (ji) =  rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi13 )   & 
    533             &                          * ( zdhbf - dh_i_bott(ji) ) / rdt_ice 
     528            &                          * ( zdhbf - dh_i_bott(ji) ) * r1_rdtice 
    534529         dh_i_bott(ji)  = zdhbf 
    535530         !                     !since ice volume is only used for outputs, we keep it global for all categories 
     
    538533         zhgnew   (ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 
    539534         !                     ! diagnostic ( bottom ice growth ) 
    540          zji = MOD( npb(ji) - 1, jpi ) + 1 
    541          zjj = ( npb(ji) - 1 ) / jpi + 1 
    542          diag_bot_gr(zji,zjj) = diag_bot_gr(zji,zjj) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice 
    543          diag_sur_me(zji,zjj) = diag_sur_me(zji,zjj) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) / rdt_ice 
    544          diag_bot_me(zji,zjj) = diag_bot_me(zji,zjj) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice 
     535         ii = MOD( npb(ji) - 1, jpi ) + 1 
     536         ij = ( npb(ji) - 1 ) / jpi + 1 
     537         diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
     538         diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 
     539         diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
    545540      END DO 
    546541 
     
    548543      ! 5.2 More than available ice melts 
    549544      !----------------------------------- 
    550       ! then heat applied minus heat content at previous time step 
    551       ! should equal heat remaining  
     545      ! then heat applied minus heat content at previous time step should equal heat remaining  
    552546      ! 
    553547      DO ji = kideb, kiut 
    554548         ! Adapt the remaining energy if too much ice melts 
    555549         !-------------------------------------------------- 
    556          zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice 
     550         zihgnew =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )   ! =1 if ice 
    557551         ! 0 if no more ice 
    558552         zhgnew    (ji) =         zihgnew   * zhgnew(ji)      ! ice thickness is put to 0 
     
    562556         ! If snow remains, energy is used to melt snow 
    563557         zhni =  ht_s_b(ji)      ! snow depth at previous time step 
    564          zihg =  MAX( zzero , SIGN ( zone , - ht_s_b(ji) ) ) ! 0 if snow  
     558         zihg =  MAX(  zzero , SIGN ( zone , - ht_s_b(ji) )  )   ! =0 if snow  
    565559 
    566560         ! energy of melting of remaining snow 
    567561         zqt_s(ji) =    ( 1. - zihg ) * zqt_s(ji) / MAX( zhni, epsi13 ) 
    568562         zdhnm     =  - ( 1. - zihg ) * ( 1. - zihgnew ) * zfdt_final(ji) / MAX( zqt_s(ji) , epsi13 ) 
    569          zhnfi          =  zhni + zdhnm 
     563         zhnfi     =  zhni + zdhnm 
    570564         zfdt_final(ji) =  MAX( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 ) 
    571565         ht_s_b(ji)     =  MAX( zzero , zhnfi ) 
     
    581575         ! 
    582576         !                                              ! mass variation cumulated over category 
    583          rdmsnif_1d(ji) = rdmsnif_1d(ji) + zzfmass_s                     ! snow  
    584          rdmicif_1d(ji) = rdmicif_1d(ji) + zzfmass_i                     ! ice  
     577         rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s                     ! snow  
     578         rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i                     ! ice  
    585579 
    586580         ! Remaining heat to the ocean  
    587581         !--------------------------------- 
    588          focea(ji)  = - zfdt_final(ji) / rdt_ice         ! focea is in W.m-2 * dt 
    589  
    590       END DO 
    591  
    592       ftotal_fin (:) = zfdt_final(:)  / rdt_ice 
     582         focea(ji)  = - zfdt_final(ji) * r1_rdtice         ! focea is in W.m-2 * dt 
     583 
     584      END DO 
     585 
     586      ftotal_fin (:) = zfdt_final(:)  * r1_rdtice 
    593587 
    594588      !--------------------------- 
     
    596590      !--------------------------- 
    597591      DO ji = kideb, kiut 
    598          zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )   !1 if ice 
    599  
     592         zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )   ! =1 if ice 
     593         ! 
    600594         ! Salt flux 
    601          zji = MOD( npb(ji) - 1, jpi ) + 1 
    602          zjj = ( npb(ji) - 1 ) / jpi + 1 
    603          ! new lines 
    604          IF( num_sal == 4 ) THEN 
    605             fseqv_1d(ji) = fseqv_1d(ji) +        zihgnew  * zfsalt_melt(ji)                                & 
    606                &                        + (1.0 - zihgnew) * zfmass_i(ji) * ( sss_m(zji,zjj) - bulk_sal   ) / rdt_ice 
    607          ELSE 
    608             fseqv_1d(ji) = fseqv_1d(ji) +        zihgnew  * zfsalt_melt(ji)                                & 
    609                &                        + (1.0 - zihgnew) * zfmass_i(ji) * ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice 
    610          ENDIF 
     595         sfx_thd_1d(ji) = sfx_thd_1d(ji) +        zihgnew  * zsfx_melt(ji)               & 
     596            &                            - (1.0 - zihgnew) * zfmass_i (ji) * sm_i_b(ji)  * r1_rdtice 
     597         ! 
    611598         ! Heat flux 
    612599         ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 
    613          ! excessive total ablation energy (focea) sent to the ocean 
     600         ! excessive total  ablation energy (focea) sent to the ocean 
    614601         qfvbq_1d(ji)  = qfvbq_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) * rdt_ice 
    615602 
    616          zihic   = 1.0 - MAX( zzero , SIGN( zone , -ht_i_b(ji) ) ) 
    617          ! equals 0 if ht_i = 0, 1 if ht_i gt 0 
     603         zihic   = 1.0 - MAX(  zzero , SIGN( zone , -ht_i_b(ji) )  )      ! equals 0 if ht_i = 0, 1 if ht_i gt 0 
    618604         fscbq_1d(ji) =  a_i_b(ji) * fstbif_1d(ji) 
    619          qldif_1d(ji)  = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji)    * a_i_b(ji) * rdt_ice   & 
     605         qldif_1d(ji)  = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea   (ji) * a_i_b(ji) * rdt_ice   & 
    620606            &                                    + ( 1.0 - zihic   ) * fscbq_1d(ji)             * rdt_ice 
    621607      END DO  ! ji 
     
    656642         dmgwi_1d  (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 
    657643 
    658          rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic  
    659          rdmsnif_1d(ji) = rdmsnif_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn 
     644         ! All snow is thrown in the ocean, and seawater is taken to replace the volume 
     645         rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic * ( 1. - rhosn / rhoic ) 
     646         rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn 
    660647 
    661648         !        Equivalent salt flux (1) Snow-ice formation component 
    662649         !        ----------------------------------------------------- 
    663          zji = MOD( npb(ji) - 1, jpi ) + 1 
    664          zjj =    ( npb(ji) - 1 ) / jpi + 1 
    665  
    666          IF( num_sal /= 2 ) THEN   ;   zsm_snowice = sm_i_b(ji) 
    667          ELSE                      ;   zsm_snowice = ( rhoic - rhosn ) / rhoic * sss_m(zji,zjj)  
     650         ii = MOD( npb(ji) - 1, jpi ) + 1 
     651         ij =    ( npb(ji) - 1 ) / jpi + 1 
     652 
     653         IF( num_sal == 2 ) THEN   ;   zsm_snowice = sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic 
     654         ELSE                      ;   zsm_snowice = sm_i_b(ji)   
    668655         ENDIF 
    669          IF( num_sal == 4 ) THEN 
    670             fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal    ) * a_i_b(ji)   & 
    671                &                        * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    672          ELSE 
    673             fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - zsm_snowice ) * a_i_b(ji)   & 
    674                &                        * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    675          ENDIF 
     656         sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
     657         ! 
    676658         ! entrapment during snow ice formation 
    677659         i_ice_switch = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - ht_i_b(ji) + 1.0e-6 ) ) 
    678660         isnowic      = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - dh_snowice(ji)      ) ) * i_ice_switch 
    679          IF(  num_sal == 2  .OR.  num_sal == 4  )   & 
    680             dsm_i_si_1d(ji) = ( zsm_snowice*dh_snowice(ji) & 
    681             &               + sm_i_b(ji) * ht_i_b(ji) / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13)   & 
    682             &               - sm_i_b(ji) ) * isnowic      
     661         IF(  num_sal == 2  )   & 
     662            dsm_i_si_1d(ji) = (  zsm_snowice * dh_snowice(ji)    & 
     663            &                  + sm_i_b(ji) * ht_i_b(ji) / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13 )   & 
     664            &                  - sm_i_b(ji) ) * isnowic      
    683665 
    684666         !  Actualize new snow and ice thickness. 
     
    690672 
    691673         ! diagnostic ( snow ice growth ) 
    692          zji = MOD( npb(ji) - 1, jpi ) + 1 
    693          zjj =    ( npb(ji) - 1 ) / jpi + 1 
    694          diag_sni_gr(zji,zjj)  = diag_sni_gr(zji,zjj) + dh_snowice(ji)*a_i_b(ji) / rdt_ice 
     674         ii = MOD( npb(ji) - 1, jpi ) + 1 
     675         ij =    ( npb(ji) - 1 ) / jpi + 1 
     676         diag_sni_gr(ii,ij)  = diag_sni_gr(ii,ij) + dh_snowice(ji)*a_i_b(ji) * r1_rdtice 
    695677         ! 
    696678      END DO !ji 
    697679      ! 
    698680      CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 
    699       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
     681      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zsfx_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
    700682      CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 
    701683      CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r3610 r3625  
    1515   !!   'key_lim3'                                      LIM3 sea-ice model 
    1616   !!---------------------------------------------------------------------- 
    17    USE par_oce          ! ocean parameters 
    18    USE phycst           ! physical constants (ocean directory)  
    19    USE ice              ! LIM-3 variables 
    20    USE par_ice          ! LIM-3 parameters 
    21    USE thd_ice          ! LIM-3: thermodynamics 
    22    USE in_out_manager   ! I/O manager 
    23    USE lib_mpp          ! MPP library 
    24    USE wrk_nemo         ! work arrays 
     17   USE par_oce        ! ocean parameters 
     18   USE phycst         ! physical constants (ocean directory)  
     19   USE ice            ! LIM-3 variables 
     20   USE par_ice        ! LIM-3 parameters 
     21   USE thd_ice        ! LIM-3: thermodynamics 
     22   USE in_out_manager ! I/O manager 
     23   USE lib_mpp        ! MPP library 
     24   USE wrk_nemo       ! work arrays 
     25   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2526 
    2627   IMPLICIT NONE 
     
    3334 
    3435   !!---------------------------------------------------------------------- 
    35    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     36   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    3637   !! $Id$ 
    3738   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    147148      REAL(wp), DIMENSION(kiut,jkmax+2) ::   zdiagbis 
    148149      REAL(wp), DIMENSION(kiut,jkmax+2,3) ::   ztrid   ! tridiagonal system terms 
    149       !!------------------------------------------------------------------ 
    150        
     150      !!------------------------------------------------------------------      
    151151      !  
    152152      !------------------------------------------------------------------------------! 
     
    156156      DO ji = kideb , kiut 
    157157         ! is there snow or not 
    158          isnow(ji)= INT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
     158         isnow(ji)= INT(  1._wp - MAX(  0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
    159159         ! surface temperature of fusion 
    160160!!gm ???  ztfs(ji) = rtt !!!???? 
     
    201201      DO ji = kideb , kiut 
    202202         ! switches 
    203          isnow(ji) = INT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  )  
     203         isnow(ji) = INT(  1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  )  
    204204         ! hs > 0, isnow = 1 
    205205         zhsu (ji) = hnzst  ! threshold for the computation of i0 
     
    262262      ! just to check energy conservation 
    263263      DO ji = kideb, kiut 
    264          ii                = MOD( npb(ji) - 1, jpi ) + 1 
    265          ij                = ( npb(ji) - 1 ) / jpi + 1 
     264         ii = MOD( npb(ji) - 1 , jpi ) + 1 
     265         ij =    ( npb(ji) - 1 ) / jpi + 1 
    266266         fstroc(ii,ij,jl) = zradtr_i(ji,nlay_i) 
    267267      END DO 
     
    273273         END DO 
    274274      END DO 
    275  
    276275 
    277276      ! 
     
    662661 
    663662            ! surface temperature 
    664             isnow(ji)     = INT(1.0-max(0.0,sign(1.0,-ht_s_b(ji)))) 
     663            isnow(ji)     = INT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) )  )  ) 
    665664            ztsuoldit(ji) = t_su_b(ji) 
    666             IF (t_su_b(ji) .LT. ztfs(ji)) & 
     665            IF( t_su_b(ji) < ztfs(ji) )  & 
    667666               t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( isnow(ji)*t_s_b(ji,1)   & 
    668667               &          + (1.0-isnow(ji))*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

    r3294 r3625  
    1616   !!   'key_lim3'                                      LIM3 sea-ice model 
    1717   !!---------------------------------------------------------------------- 
    18    !!   lim_thd_ent : ice redistribution of enthalpy 
     18   !!   lim_thd_ent   : ice redistribution of enthalpy 
    1919   !!---------------------------------------------------------------------- 
    20    USE par_oce          ! ocean parameters 
    21    USE dom_oce          ! domain variables 
    22    USE domain           ! 
    23    USE phycst           ! physical constants 
    24    USE ice              ! LIM variables 
    25    USE par_ice          ! LIM parameters 
    26    USE thd_ice          ! LIM thermodynamics 
    27    USE limvar           ! LIM variables 
    28    USE in_out_manager   ! I/O manager 
    29    USE lib_mpp          ! MPP library 
    30    USE wrk_nemo         ! work arrays 
     20   USE par_oce        ! ocean parameters 
     21   USE dom_oce        ! domain variables 
     22   USE domain         ! 
     23   USE phycst         ! physical constants 
     24   USE ice            ! LIM variables 
     25   USE par_ice        ! LIM parameters 
     26   USE thd_ice        ! LIM thermodynamics 
     27   USE limvar         ! LIM variables 
     28   USE in_out_manager ! I/O manager 
     29   USE lib_mpp        ! MPP library 
     30   USE wrk_nemo       ! work arrays 
     31   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3132 
    3233   IMPLICIT NONE 
     
    4344 
    4445   !!---------------------------------------------------------------------- 
    45    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     46   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    4647   !! $Id$ 
    4748   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    408409      IF ( con_i ) THEN 
    409410         DO ji = kideb, kiut 
    410             IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice .GT. 1.0e-6 ) THEN 
     411            IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice  > 1.0e-6 ) THEN 
    411412               zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    412413               zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    413414               WRITE(numout,*) ' violation of heat conservation : ',             & 
    414                   ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice 
     415                  ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 
    415416               WRITE(numout,*) ' ji, jj   : ', zji, zjj 
    416417               WRITE(numout,*) ' ht_s_b   : ', ht_s_b(ji) 
    417                WRITE(numout,*) ' zqts_in  : ', zqts_in(ji) / rdt_ice 
    418                WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) / rdt_ice 
     418               WRITE(numout,*) ' zqts_in  : ', zqts_in (ji) * r1_rdtice 
     419               WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) * r1_rdtice 
    419420               WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 
    420421               WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 
     
    526527         ! bottom formation temperature 
    527528         ztform = t_i_b(ji,nlay_i) 
    528          IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) ztform = t_bo_b(ji) 
     529         IF(  num_sal == 2  )  ztform = t_bo_b(ji) 
    529530         qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji))             &   ! case of melting ice 
    530531            &              + icboswi(ji) * rhoic * ( cpic*(ztmelts-ztform)       &   ! case of forming ice 
     
    622623      ! 
    623624      DO ji = kideb, kiut 
    624          IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice .GT. 1.0e-6 ) THEN 
     625         IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice  > 1.0e-6 ) THEN 
    625626            zji                 = MOD( npb(ji) - 1, jpi ) + 1 
    626627            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    627             WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice 
     628            WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 
    628629            WRITE(numout,*) ' ji, jj   : ', zji, zjj 
    629630            WRITE(numout,*) ' ht_i_b   : ', ht_i_b(ji) 
    630             WRITE(numout,*) ' zqti_in  : ', zqti_in(ji) / rdt_ice 
    631             WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) / rdt_ice 
     631            WRITE(numout,*) ' zqti_in  : ', zqti_in (ji) * r1_rdtice 
     632            WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 
    632633            WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 
    633634            WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r3294 r3625  
    1313   !!   'key_lim3'                                      LIM3 sea-ice model 
    1414   !!---------------------------------------------------------------------- 
    15    !!   lim_lat_acr    : lateral accretion of ice 
    16    !!---------------------------------------------------------------------- 
    17    USE par_oce          ! ocean parameters 
    18    USE dom_oce          ! domain variables 
    19    USE phycst           ! physical constants 
    20    USE sbc_oce          ! Surface boundary condition: ocean fields 
    21    USE sbc_ice          ! Surface boundary condition: ice fields 
    22    USE thd_ice          ! LIM thermodynamics 
    23    USE dom_ice          ! LIM domain 
    24    USE par_ice          ! LIM parameters 
    25    USE ice              ! LIM variables 
    26    USE limtab           ! LIM 2D <==> 1D 
    27    USE limcons          ! LIM conservation 
    28    USE in_out_manager   ! I/O manager 
    29    USE lib_mpp          ! MPP library 
    30    USE wrk_nemo         ! work arrays 
     15   !!   lim_lat_acr   : lateral accretion of ice 
     16   !!---------------------------------------------------------------------- 
     17   USE par_oce        ! ocean parameters 
     18   USE dom_oce        ! domain variables 
     19   USE phycst         ! physical constants 
     20   USE sbc_oce        ! Surface boundary condition: ocean fields 
     21   USE sbc_ice        ! Surface boundary condition: ice fields 
     22   USE thd_ice        ! LIM thermodynamics 
     23   USE dom_ice        ! LIM domain 
     24   USE par_ice        ! LIM parameters 
     25   USE ice            ! LIM variables 
     26   USE limtab         ! LIM 2D <==> 1D 
     27   USE limcons        ! LIM conservation 
     28   USE in_out_manager ! I/O manager 
     29   USE lib_mpp        ! MPP library 
     30   USE wrk_nemo       ! work arrays 
     31   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3132 
    3233   IMPLICIT NONE 
     
    4546 
    4647   !!---------------------------------------------------------------------- 
    47    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     48   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    4849   !! $Id$ 
    4950   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    7778      !!               update ht_s_b, ht_i_b and tbif_1d(:,:)       
    7879      !!------------------------------------------------------------------------ 
    79       INTEGER ::   ji,jj,jk,jl,jm   ! dummy loop indices 
    80       INTEGER ::   layer, nbpac     ! local integers  
    81       INTEGER ::   zji, zjj, iter   !   -       - 
    82       REAL(wp)  ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zde  ! local scalars 
     80      INTEGER  ::   ji,jj,jk,jl,jm   ! dummy loop indices 
     81      INTEGER  ::   layer, nbpac     ! local integers  
     82      INTEGER  ::   zji, zjj, iter   !   -       - 
     83      REAL(wp) ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zde   ! local scalars 
    8384      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      - 
    8485      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
     86      REAL(wp) ::   zcoef                                                       !   -      - 
    8587      LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness 
    8688      CHARACTER (len = 15) :: fieldid 
     
    143145      ! 1) Conservation check and changes in each ice category 
    144146      !------------------------------------------------------------------------------! 
    145       IF ( con_i ) THEN 
    146          CALL lim_column_sum (jpl, v_i, vt_i_init) 
    147          CALL lim_column_sum (jpl, v_s, vt_s_init) 
    148          CALL lim_column_sum_energy (jpl, nlay_i, e_i, et_i_init) 
    149          CALL lim_column_sum (jpl,  e_s(:,:,1,:) , et_s_init) 
     147      IF( con_i ) THEN 
     148         CALL lim_column_sum        ( jpl, v_i          , vt_i_init) 
     149         CALL lim_column_sum        ( jpl, v_s          , vt_s_init) 
     150         CALL lim_column_sum_energy ( jpl, nlay_i , e_i , et_i_init) 
     151         CALL lim_column_sum        ( jpl, e_s(:,:,1,:) , et_s_init) 
    150152      ENDIF 
    151153 
     
    158160               DO ji = 1, jpi 
    159161                  !Energy of melting q(S,T) [J.m-3] 
    160                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / & 
    161                      MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * & 
    162                      nlay_i 
    163                   zindb      = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) !0 if no ice and 1 if yes 
    164                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl)*unit_fac*zindb 
     162                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * nlay_i 
     163                  zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) )  )   !0 if no ice and 1 if yes 
     164                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 
    165165               END DO 
    166166            END DO 
     
    182182      !  
    183183 
    184       zvrel(:,:) = 0.0 
     184      zvrel(:,:) = 0._wp 
    185185 
    186186      ! Default new ice thickness  
    187       DO jj = 1, jpj 
    188          DO ji = 1, jpi 
    189             hicol(ji,jj) = hiccrit(1) 
    190          END DO 
    191       END DO 
    192  
    193       IF (fraz_swi.eq.1.0) THEN 
     187      hicol(:,:) = hiccrit(1) 
     188 
     189      IF( fraz_swi == 1._wp ) THEN 
    194190 
    195191         !-------------------- 
    196192         ! Physical constants 
    197193         !-------------------- 
    198          hicol(:,:) = 0.0 
     194         hicol(:,:) = 0._wp 
    199195 
    200196         zhicrit = 0.04 ! frazil ice thickness 
     
    211207                  !------------- 
    212208                  ! C-grid wind stress components 
    213                   ztaux         = ( utau_ice(ji-1,jj  ) * tmu(ji-1,jj  ) & 
    214                      &          +   utau_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) / 2.0 
    215                   ztauy         = ( vtau_ice(ji  ,jj-1) * tmv(ji  ,jj-1) & 
    216                      &          +   vtau_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) / 2.0 
     209                  ztaux         = ( utau_ice(ji-1,jj  ) * tmu(ji-1,jj  )   & 
     210                     &          +   utau_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) * 0.5_wp 
     211                  ztauy         = ( vtau_ice(ji  ,jj-1) * tmv(ji  ,jj-1)   & 
     212                     &          +   vtau_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) * 0.5_wp 
    217213                  ! Square root of wind stress 
    218214                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
     
    228224                  !------------------- 
    229225                  ! C-grid ice velocity 
    230                   zindb = MAX(0.0, SIGN(1.0, at_i(ji,jj) )) 
    231                   zvgx  = zindb * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  ) & 
    232                      + u_ice(ji,jj    ) * tmu(ji  ,jj  ) ) / 2.0 
    233                   zvgy  = zindb * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1) & 
    234                      + v_ice(ji,jj    ) * tmv(ji  ,jj  ) ) / 2.0 
     226                  zindb = MAX(  0._wp, SIGN( 1._wp , at_i(ji,jj) )  ) 
     227                  zvgx  = zindb * (  u_ice(ji-1,jj  ) * tmu(ji-1,jj  )    & 
     228                     &             + u_ice(ji,jj    ) * tmu(ji  ,jj  )  ) * 0.5_wp 
     229                  zvgy  = zindb * (  v_ice(ji  ,jj-1) * tmv(ji  ,jj-1)    & 
     230                     &             + v_ice(ji,jj    ) * tmv(ji  ,jj  )  ) * 0.5_wp 
    235231 
    236232                  !----------------------------------- 
     
    238234                  !----------------------------------- 
    239235                  ! absolute relative velocity 
    240                   zvrel2        = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) + & 
    241                      ( zvfry - zvgy ) * ( zvfry - zvgy )   & 
    242                      , 0.15 * 0.15 ) 
    243                   zvrel(ji,jj)  = SQRT(zvrel2) 
     236                  zvrel2 = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   & 
     237                     &         + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) 
     238                  zvrel(ji,jj)  = SQRT( zvrel2 ) 
    244239 
    245240                  !--------------------- 
     
    247242                  !--------------------- 
    248243                  hicol(ji,jj) = zhicrit + 0.1  
    249                   hicol(ji,jj) = zhicrit + hicol(ji,jj) /      &  
    250                      ( hicol(ji,jj) * hicol(ji,jj) - & 
    251                      zhicrit * zhicrit ) * ztwogp * zvrel2 
     244                  hicol(ji,jj) = zhicrit +   hicol(ji,jj)    & 
     245                     &                   / ( hicol(ji,jj) * hicol(ji,jj) -  zhicrit * zhicrit ) * ztwogp * zvrel2 
     246 
     247!!gm better coding: above: hicol(ji,jj) * hicol(ji,jj) = (zhicrit + 0.1)*(zhicrit + 0.1) 
     248!!gm                                                   = zhicrit**2 + 0.2*zhicrit +0.01 
     249!!gm                therefore the 2 lines with hicol can be replaced by 1 line: 
     250!!gm              hicol(ji,jj) = zhicrit + (zhicrit + 0.1) / ( 0.2 * zhicrit + 0.01 ) * ztwogp * zvrel2 
     251!!gm further more (zhicrit + 0.1)/(0.2 * zhicrit + 0.01 )*ztwogp can be computed one for all outside the DO loop 
    252252 
    253253                  iter = 1 
     
    284284      DO jj = 1, jpj 
    285285         DO ji = 1, jpi 
    286             IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 
     286            IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
    287287               nbpac = nbpac + 1 
    288288               npac( nbpac ) = (jj - 1) * jpi + ji 
    289                IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 
    290                   jiindex_1d = nbpac 
    291                ENDIF 
     289               IF( ji == jiindx .AND. jj == jjindx )   jiindex_1d = nbpac 
    292290            ENDIF 
    293291         END DO 
    294292      END DO 
    295293 
    296       IF( ln_nicep ) THEN 
    297          WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
    298       ENDIF 
     294      IF( ln_nicep )   WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac 
    299295 
    300296      !------------------------------ 
     
    306302      IF ( nbpac > 0 ) THEN 
    307303 
    308          CALL tab_2d_1d( nbpac, zat_i_ac  (1:nbpac)     , at_i         ,       & 
    309             jpi, jpj, npac(1:nbpac) ) 
     304         CALL tab_2d_1d( nbpac, zat_i_ac  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) ) 
    310305         DO jl = 1, jpl 
    311             CALL tab_2d_1d( nbpac, za_i_ac(1:nbpac,jl)  , a_i(:,:,jl)  ,       & 
    312                jpi, jpj, npac(1:nbpac) ) 
    313             CALL tab_2d_1d( nbpac, zv_i_ac(1:nbpac,jl)  , v_i(:,:,jl)  ,       & 
    314                jpi, jpj, npac(1:nbpac) ) 
    315             CALL tab_2d_1d( nbpac, zoa_i_ac(1:nbpac,jl) , oa_i(:,:,jl) ,       & 
    316                jpi, jpj, npac(1:nbpac) ) 
    317             CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl),       & 
    318                jpi, jpj, npac(1:nbpac) ) 
     306            CALL tab_2d_1d( nbpac, za_i_ac  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     307            CALL tab_2d_1d( nbpac, zv_i_ac  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     308            CALL tab_2d_1d( nbpac, zoa_i_ac (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     309            CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    319310            DO jk = 1, nlay_i 
    320                CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , & 
    321                   jpi, jpj, npac(1:nbpac) ) 
     311               CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
    322312            END DO ! jk 
    323313         END DO ! jl 
    324314 
    325          CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif ,              & 
    326             jpi, jpj, npac(1:nbpac) ) 
    327          CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif ,              & 
    328             jpi, jpj, npac(1:nbpac) ) 
    329          CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo  ,              & 
    330             jpi, jpj, npac(1:nbpac) ) 
    331          CALL tab_2d_1d( nbpac, fseqv_1d  (1:nbpac)     , fseqv ,              & 
    332             jpi, jpj, npac(1:nbpac) ) 
    333          CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol ,              & 
    334             jpi, jpj, npac(1:nbpac) ) 
    335          CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel ,              & 
    336             jpi, jpj, npac(1:nbpac) ) 
     315         CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif  , jpi, jpj, npac(1:nbpac) ) 
     316         CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif  , jpi, jpj, npac(1:nbpac) ) 
     317         CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
     318         CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac)     , sfx_thd, jpi, jpj, npac(1:nbpac) ) 
     319         CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac)     , rdm_ice, jpi, jpj, npac(1:nbpac) ) 
     320         CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
     321         CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
    337322 
    338323         !------------------------------------------------------------------------------! 
     
    344329         !---------------------- 
    345330         DO ji = 1, nbpac 
    346             zh_newice(ji)     = hiccrit(1) 
    347          END DO 
    348          IF ( fraz_swi .EQ. 1.0 ) zh_newice(:) = hicol_b(:) 
     331            zh_newice(ji) = hiccrit(1) 
     332         END DO 
     333         IF( fraz_swi == 1.0 )  zh_newice(:) = hicol_b(:) 
    349334 
    350335         !---------------------- 
     
    352337         !---------------------- 
    353338 
    354          IF ( num_sal .EQ. 1 ) THEN 
    355             zs_newice(:)      =   bulk_sal 
    356          ENDIF ! num_sal 
    357  
    358          IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 
    359  
    360             DO ji = 1, nbpac 
    361                zs_newice(ji)  =   MIN( 4.606 + 0.91 / zh_newice(ji) , s_i_max ) 
    362                zji            =   MOD( npac(ji) - 1, jpi ) + 1 
    363                zjj            =   ( npac(ji) - 1 ) / jpi + 1 
    364                zs_newice(ji)  =   MIN( 0.5*sss_m(zji,zjj) , zs_newice(ji) ) 
    365             END DO ! jl 
    366  
    367          ENDIF ! num_sal 
    368  
    369          IF ( num_sal .EQ. 3 ) THEN 
    370             zs_newice(:)      =   2.3 
    371          ENDIF ! num_sal 
     339         SELECT CASE ( num_sal ) 
     340         CASE ( 1 )                    ! Sice = constant  
     341            zs_newice(:) = bulk_sal 
     342         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
     343            DO ji = 1, nbpac 
     344               zji =   MOD( npac(ji) - 1 , jpi ) + 1 
     345               zjj =      ( npac(ji) - 1 ) / jpi + 1 
     346               zs_newice(ji) = MIN(  4.606 + 0.91 / zh_newice(ji) , s_i_max , 0.5 * sss_m(zji,zjj)  ) 
     347            END DO 
     348         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
     349            zs_newice(:) =   2.3 
     350         END SELECT 
     351 
    372352 
    373353         !------------------------- 
     
    376356         ! We assume that new ice is formed at the seawater freezing point 
    377357         DO ji = 1, nbpac 
    378             ztmelts           = - tmut * zs_newice(ji) + rtt ! Melting point (K) 
    379             ze_newice(ji)     =   rhoic * ( cpic * ( ztmelts - t_bo_b(ji) )    & 
    380                + lfus * ( 1.0 - ( ztmelts - rtt )   & 
    381                / ( t_bo_b(ji) - rtt ) )           & 
    382                - rcp * ( ztmelts-rtt ) ) 
    383             ze_newice(ji)     =   MAX( ze_newice(ji) , 0.0 ) +                 & 
    384                MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) )   &  
    385                * rhoic * lfus 
     358            ztmelts       = - tmut * zs_newice(ji) + rtt                  ! Melting point (K) 
     359            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                             & 
     360               &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )   & 
     361               &                       - rcp  *         ( ztmelts - rtt )  ) 
     362            ze_newice(ji) =   MAX( ze_newice(ji) , 0._wp )    & 
     363               &          +   MAX(  0.0 , SIGN( 1.0 , - ze_newice(ji) )  ) * rhoic * lfus 
    386364         END DO ! ji 
    387365         !---------------- 
     
    389367         !---------------- 
    390368         DO ji = 1, nbpac 
    391             zo_newice(ji)     = 0.0 
     369            zo_newice(ji) = 0._wp 
    392370         END DO ! ji 
    393371 
     
    396374         !-------------------------- 
    397375         DO ji = 1, nbpac 
    398             zqbgow(ji)        = qldif_1d(ji) - qcmif_1d(ji) !<0 
     376            zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji)    !<0 
    399377         END DO ! ji 
    400378 
     
    403381         !------------------- 
    404382         DO ji = 1, nbpac 
    405             zv_newice(ji)     = - zqbgow(ji) / ze_newice(ji) 
     383            zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 
    406384 
    407385            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    408             zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) )     &  
    409                + 1.0 ) / 2.0 * maxfrazb 
    410             zdh_frazb(ji) = zfrazb*zv_newice(ji) 
     386            zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 
     387            zdh_frazb(ji) =         zfrazb   * zv_newice(ji) 
    411388            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    412389         END DO 
     
    415392         ! Salt flux due to new ice growth 
    416393         !--------------------------------- 
    417          IF ( ( num_sal .EQ. 4 ) ) THEN  
    418             DO ji = 1, nbpac 
    419                zji            = MOD( npac(ji) - 1, jpi ) + 1 
    420                zjj            = ( npac(ji) - 1 ) / jpi + 1 
    421                fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    422                   ( sss_m(zji,zjj) - bulk_sal      ) * rhoic *       & 
    423                   zv_newice(ji) / rdt_ice 
    424             END DO 
    425          ELSE 
    426             DO ji = 1, nbpac 
    427                zji            = MOD( npac(ji) - 1, jpi ) + 1 
    428                zjj            = ( npac(ji) - 1 ) / jpi + 1 
    429                fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    430                   ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic *       & 
    431                   zv_newice(ji) / rdt_ice 
    432             END DO ! ji 
    433          ENDIF 
     394         ! note that for constant salinity zs_newice() = bulk_sal (see top of the subroutine) 
     395         DO ji = 1, nbpac 
     396            sfx_thd_1d(ji) = sfx_thd_1d(ji) - zs_newice(ji) * rhoic * zv_newice(ji) * r1_rdtice 
     397            rdm_ice_1d(ji) = rdm_ice_1d(ji) +                 rhoic * zv_newice(ji) 
     398         END DO ! ji 
    434399 
    435400         !------------------------------------ 
     
    437402         !------------------------------------ 
    438403         DO ji = 1, nbpac 
    439             ! Volume 
    440             zji                  = MOD( npac(ji) - 1, jpi ) + 1 
    441             zjj                  = ( npac(ji) - 1 ) / jpi + 1 
    442             vt_i_init(zji,zjj)   = vt_i_init(zji,zjj) + zv_newice(ji) 
    443             ! Energy 
    444             zde                  = ze_newice(ji) / unit_fac 
    445             zde                  = zde * area(zji,zjj) * zv_newice(ji) 
    446             et_i_init(zji,zjj)   = et_i_init(zji,zjj) + zde 
     404            zji = MOD( npac(ji) - 1 , jpi ) + 1 
     405            zjj =    ( npac(ji) - 1 ) / jpi + 1 
     406            ! 
     407            zde = ze_newice(ji) / unit_fac * area(zji,zjj) * zv_newice(ji) 
     408            ! 
     409            vt_i_init(zji,zjj) = vt_i_init(zji,zjj) + zv_newice(ji)             ! volume 
     410            et_i_init(zji,zjj) = et_i_init(zji,zjj) + zde                       ! Energy 
     411 
    447412         END DO 
    448413 
    449414         ! keep new ice volume in memory 
    450          CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , & 
    451             jpi, jpj ) 
     415         CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj ) 
    452416 
    453417         !----------------- 
     
    455419         !----------------- 
    456420         DO ji = 1, nbpac 
    457             za_newice(ji)     = zv_newice(ji) / zh_newice(ji) 
    458             ! diagnostic 
    459             zji                  = MOD( npac(ji) - 1, jpi ) + 1 
    460             zjj                  = ( npac(ji) - 1 ) / jpi + 1 
    461             diag_lat_gr(zji,zjj) = zv_newice(ji) / rdt_ice 
     421            zji = MOD( npac(ji) - 1 , jpi ) + 1 
     422            zjj =    ( npac(ji) - 1 ) / jpi + 1 
     423            za_newice(ji) = zv_newice(ji) / zh_newice(ji) 
     424            diag_lat_gr(zji,zjj) = zv_newice(ji) * r1_rdtice 
    462425         END DO !ji 
    463426 
     
    476439         !------------------------------------------- 
    477440         ! If lateral ice growth gives an ice concentration gt 1, then 
    478          ! we keep the excessive volume in memory and attribute it later 
    479          ! to bottom accretion 
    480          DO ji = 1, nbpac 
    481             ! vectorize 
    482             IF ( za_newice(ji) .GT. ( 1.0 - zat_i_ac(ji) ) ) THEN 
    483                zda_res(ji)    = za_newice(ji) - (1.0 - zat_i_ac(ji) ) 
    484                zdv_res(ji)    = zda_res(ji) * zh_newice(ji)  
    485                za_newice(ji)  = za_newice(ji) - zda_res(ji) 
    486                zv_newice(ji)  = zv_newice(ji) - zdv_res(ji) 
     441         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
     442         DO ji = 1, nbpac 
     443            IF ( za_newice(ji)  >  ( 1._wp - zat_i_ac(ji) ) ) THEN 
     444               zda_res(ji)   = za_newice(ji) - (1.0 - zat_i_ac(ji) ) 
     445               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji)  
     446               za_newice(ji) = za_newice(ji) - zda_res  (ji) 
     447               zv_newice(ji) = zv_newice(ji) - zdv_res  (ji) 
    487448            ELSE 
    488                zda_res(ji) = 0.0 
    489                zdv_res(ji) = 0.0 
     449               zda_res(ji) = 0._wp 
     450               zdv_res(ji) = 0._wp 
    490451            ENDIF 
    491452         END DO ! ji 
     
    497458         DO jl = 1, jpl 
    498459            DO ji = 1, nbpac 
    499                IF(  hi_max   (jl-1)  <  zh_newice(ji)   .AND.   & 
    500                   & zh_newice(ji)    <= hi_max   (jl)         ) THEN 
     460               IF(  hi_max   (jl-1)  <   zh_newice(ji)   .AND.   & 
     461                  & zh_newice(ji)    <=  hi_max   (jl)         ) THEN 
    501462                  za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 
    502463                  zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 
     
    504465                  zcatac  (ji)    = jl 
    505466               ENDIF 
    506             END DO ! ji 
    507          END DO ! jl 
     467            END DO 
     468         END DO 
    508469 
    509470         !---------------------------------- 
     
    521482            DO ji = 1, nbpac 
    522483               jl = zcatac(ji) 
    523                zqold   = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
     484               zqold   = ze_i_ac(ji,jk,jl)      ! [ J.m-3 ] 
    524485               zalphai = MIN( zhice_old(ji,jl) *   jk       / nlay_i , zh_newice(ji) )   & 
    525486                  &    - MIN( zhice_old(ji,jl) * ( jk - 1 ) / nlay_i , zh_newice(ji) ) 
     
    527488                  + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / nlay_i   & 
    528489                  + za_newice(ji)  * ze_newice(ji) * zalphai                                       & 
    529                   + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / nlay_i ) / ( ( zv_i_ac(ji,jl) ) / nlay_i ) 
     490                  + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / nlay_i ) / ( zv_i_ac(ji,jl) / nlay_i ) 
    530491            END DO 
    531492         END DO 
     
    567528               zdhicbot (ji,jl) = zdv_res(ji)    / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    & 
    568529                  &             +  zindb * zdh_frazb(ji)                               ! frazil ice may coalesce 
    569                zdummy(ji,jl)    = zv_i_ac(ji,jl)/MAX(za_i_ac(ji,jl),epsi10)*zindb      ! thickness of residual ice 
     530               zdummy(ji,jl)    = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb      ! thickness of residual ice 
    570531            END DO 
    571532         END DO 
     
    628589         ! Update salinity 
    629590         !----------------- 
    630          IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN 
     591         IF(  num_sal == 2  ) THEN      ! Sice = F(z,t) 
    631592            DO jl = 1, jpl 
    632593               DO ji = 1, nbpac 
    633                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes 
     594                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) )   ! 0 if no ice and 1 if yes 
    634595                  zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    635596                  zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * zindb 
     
    645606            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 
    646607            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 
    647             IF (  num_sal == 2  .OR.  num_sal == 4  )   & 
     608            IF (  num_sal == 2  )   & 
    648609               CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
    649610            DO jk = 1, nlay_i 
     
    651612            END DO 
    652613         END DO 
    653          CALL tab_1d_2d( nbpac, fseqv , npac(1:nbpac), fseqv_1d  (1:nbpac) , jpi, jpj ) 
     614         CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 
     615         CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 
    654616         ! 
    655617      ENDIF ! nbpac > 0 
     
    660622      DO jl = 1, jpl 
    661623         DO jk = 1, nlay_i          ! heat content in 10^9 Joules 
    662             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / nlay_i  / unit_fac  
     624            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / nlay_i / unit_fac  
    663625         END DO 
    664626      END DO 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r3294 r3625  
    1212   !!   'key_lim3'                                      LIM-3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!   lim_thd_sal : salinity variations in the ice 
    15    !!---------------------------------------------------------------------- 
    16    USE par_oce          ! ocean parameters 
    17    USE phycst           ! physical constants (ocean directory) 
    18    USE sbc_oce          ! Surface boundary condition: ocean fields 
    19    USE ice              ! LIM variables 
    20    USE par_ice          ! LIM parameters 
    21    USE thd_ice          ! LIM thermodynamics 
    22    USE limvar           ! LIM variables 
    23    USE in_out_manager   ! I/O manager 
    24    USE lib_mpp          ! MPP library 
    25    USE wrk_nemo         ! work arrays 
     14   !!   lim_thd_sal   : salinity variations in the ice 
     15   !!---------------------------------------------------------------------- 
     16   USE par_oce        ! ocean parameters 
     17   USE phycst         ! physical constants (ocean directory) 
     18   USE sbc_oce        ! Surface boundary condition: ocean fields 
     19   USE ice            ! LIM variables 
     20   USE par_ice        ! LIM parameters 
     21   USE thd_ice        ! LIM thermodynamics 
     22   USE limvar         ! LIM variables 
     23   USE in_out_manager ! I/O manager 
     24   USE lib_mpp        ! MPP library 
     25   USE wrk_nemo       ! work arrays 
     26   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2627 
    2728   IMPLICIT NONE 
     
    3233 
    3334   !!---------------------------------------------------------------------- 
    34    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     35   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    3536   !! $Id$ 
    3637   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    4445      !! ** Purpose :   computes new salinities in the ice 
    4546      !! 
    46       !! ** Method  :  4 possibilities 
    47       !!               -> num_sal = 1 -> constant salinity for z,t 
    48       !!               -> num_sal = 2 -> S = S(z,t) [simple Vancoppenolle et al 2005] 
    49       !!               -> num_sal = 3 -> S = S(z)   [multiyear ice] 
    50       !!               -> num_sal = 4 -> S = S(h)   [Cox and Weeks 74] 
     47      !! ** Method  :  3 possibilities 
     48      !!               -> num_sal = 1 -> Sice = cst    [ice salinity constant in both time & space]  
     49      !!               -> num_sal = 2 -> Sice = S(z,t) [Vancoppenolle et al. 2005] 
     50      !!               -> num_sal = 3 -> Sice = S(z)   [multiyear ice] 
    5151      !!--------------------------------------------------------------------- 
    52       INTEGER, INTENT(in) ::  kideb, kiut   ! thickness category index 
     52      INTEGER, INTENT(in) ::   kideb, kiut   ! thickness category index 
    5353      ! 
    5454      INTEGER  ::   ji, jk     ! dummy loop indices  
    55       INTEGER  ::   zji, zjj   ! local integers 
    5655      REAL(wp) ::   zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch,  ztmelts   ! local scalars 
    5756      REAL(wp) ::   zaaa, zbbb, zccc, zdiscrim   ! local scalars 
     
    6463      ! 1) Constant salinity, constant in time                                       | 
    6564      !------------------------------------------------------------------------------| 
    66 !!gm comment: if num_sal = 1 s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 
    67       IF( num_sal == 1 ) THEN 
    68          ! 
    69          DO jk = 1, nlay_i 
    70             DO ji = kideb, kiut 
    71                s_i_b(ji,jk) =  bulk_sal 
    72             END DO ! ji 
    73          END DO ! jk 
    74          ! 
    75          DO ji = kideb, kiut 
    76             sm_i_b(ji)      =  bulk_sal  
    77          END DO ! ji 
    78          ! 
     65!!gm comment: if num_sal = 1 s_i_new, s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 
     66!!gm           ===>>>   simplification of almost all test on num_sal value 
     67      IF(  num_sal == 1  ) THEN 
     68            s_i_b  (kideb:kiut,1:nlay_i) =  bulk_sal 
     69            sm_i_b (kideb:kiut)          =  bulk_sal  
     70            s_i_new(kideb:kiut)          =  bulk_sal 
    7971      ENDIF 
    8072 
     
    8375      !------------------------------------------------------------------------------| 
    8476 
    85       IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN 
     77      IF(  num_sal == 2  ) THEN 
    8678 
    8779         !--------------------------------- 
     
    118110            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice  
    119111            !                                   ! drainage by flushing   
    120             dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
     112            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
    121113 
    122114            !----------------- 
     
    133125         END DO ! ji 
    134126 
    135          ! Salinity profile 
    136          CALL lim_var_salprof1d( kideb, kiut ) 
     127         CALL lim_var_salprof1d( kideb, kiut )         ! Salinity profile 
     128 
    137129 
    138130         !---------------------------- 
     
    143135!!gm useless 
    144136            ! iflush  : 1 if summer  
    145             iflush  =  MAX( 0._wp , SIGN ( 1._wp , t_su_b(ji) - rtt ) )  
     137            iflush  =  MAX( 0._wp , SIGN( 1._wp , t_su_b(ji) - rtt        ) )  
    146138            ! igravdr : 1 if t_su lt t_bo 
    147             igravdr =  MAX( 0._wp , SIGN ( 1._wp , t_bo_b(ji) - t_su_b(ji) ) )  
     139            igravdr =  MAX( 0._wp , SIGN( 1._wp , t_bo_b(ji) - t_su_b(ji) ) )  
    148140            ! iaccrbo : 1 if bottom accretion 
    149             iaccrbo =  MAX( 0._wp , SIGN ( 1._wp , dh_i_bott(ji) ) ) 
     141            iaccrbo =  MAX( 0._wp , SIGN( 1._wp , dh_i_bott(ji)           ) ) 
    150142!!gm end useless 
    151143            ! 
     
    157149         !---------------------------- 
    158150         DO ji = kideb, kiut 
    159             i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 
    160             fsbri_1d(ji) = fsbri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji)         & 
    161                &         * ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice 
    162             IF( num_sal == 4 ) fsbri_1d(ji) = 0._wp 
    163          END DO ! ji 
     151            i_ice_switch = 1._wp - MAX(  0._wp, SIGN( 1._wp , - ht_i_b(ji) )  ) 
     152            sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji)         & 
     153               &           * ( MAX( dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji) , sm_i_b(ji) - zsiold(ji) ) ) * r1_rdtice 
     154         END DO 
    164155 
    165156         ! Only necessary for conservation check since salinity is modified 
     
    179170         END DO 
    180171         ! 
    181       ENDIF ! num_sal .EQ. 2 
     172      ENDIF  
    182173 
    183174      !------------------------------------------------------------------------------| 
     
    185176      !------------------------------------------------------------------------------| 
    186177 
    187       IF( num_sal == 3 )   CALL lim_var_salprof1d( kideb, kiut ) 
    188  
    189       !------------------------------------------------------------------------------| 
    190       !  Module 4 : Constant salinity varying in time                                | 
    191       !------------------------------------------------------------------------------| 
    192  
    193       IF( num_sal == 5 ) THEN      ! Cox and Weeks, 1974 
    194          ! 
    195          DO ji = kideb, kiut 
    196             zsold = sm_i_b(ji) 
    197             IF( ht_i_b(ji) < 0.4 ) THEN 
    198                sm_i_b(ji) = 14.24 - 19.39 * ht_i_b(ji)  
    199             ELSE 
    200                sm_i_b(ji) =  7.88 - 1.59 * ht_i_b(ji) 
    201                sm_i_b(ji) = MIN( sm_i_b(ji) , zsold )   
    202             ENDIF 
    203             IF( ht_i_b(ji) > 3.06918239 ) THEN  
    204                sm_i_b(ji) = 3._wp 
    205             ENDIF 
    206             DO jk = 1, nlay_i 
    207                s_i_b(ji,jk)   = sm_i_b(ji) 
    208             END DO 
    209          END DO 
    210          ! 
    211       ENDIF ! num_sal 
     178      IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
     179 
    212180 
    213181      !------------------------------------------------------------------------------| 
    214182      ! 5) Computation of salt flux due to Bottom growth 
    215183      !------------------------------------------------------------------------------| 
    216  
    217       IF ( num_sal == 4 ) THEN 
    218          DO ji = kideb, kiut 
    219             zji = MOD( npb(ji) - 1 , jpi ) + 1 
    220             zjj =    ( npb(ji) - 1 ) / jpi + 1 
    221             fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal    )               & 
    222                &                        * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
    223          END DO 
    224       ELSE 
    225          DO ji = kideb, kiut 
    226             zji = MOD( npb(ji) - 1 , jpi ) + 1 
    227             zjj =    ( npb(ji) - 1 ) / jpi + 1 
    228             fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - s_i_new(ji) )               & 
    229                &                        * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
    230          END DO 
    231       ENDIF 
     184      ! note: s_i_new = bulk_sal in constant salinity case 
     185      DO ji = kideb, kiut 
     186         sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0._wp ) * r1_rdtice 
     187      END DO 
    232188      ! 
    233189      CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r3294 r3625  
    1414   !!   lim_trp      : advection/diffusion process of sea ice 
    1515   !!---------------------------------------------------------------------- 
    16    USE phycst          ! physical constant 
    17    USE dom_oce         ! ocean domain 
    18    USE sbc_oce         ! ocean surface boundary condition 
    19    USE par_ice         ! LIM-3 parameter 
    20    USE dom_ice         ! LIM-3 domain 
    21    USE ice             ! LIM-3 variables 
    22    USE limadv          ! LIM-3 advection 
    23    USE limhdf          ! LIM-3 horizontal diffusion 
    24    USE in_out_manager  ! I/O manager 
    25    USE lbclnk          ! lateral boundary conditions -- MPP exchanges 
    26    USE lib_mpp         ! MPP library 
    27    USE wrk_nemo        ! work arrays 
    28    USE prtctl          ! Print control 
     16   USE phycst         ! physical constant 
     17   USE dom_oce        ! ocean domain 
     18   USE sbc_oce        ! ocean surface boundary condition 
     19   USE par_ice        ! ice parameter 
     20   USE dom_ice        ! ice domain 
     21   USE ice            ! ice variables 
     22   USE limadv         ! ice advection 
     23   USE limhdf         ! ice horizontal diffusion 
     24   USE in_out_manager ! I/O manager 
     25   USE lbclnk         ! lateral boundary conditions -- MPP exchanges 
     26   USE lib_mpp        ! MPP library 
     27   USE wrk_nemo       ! work arrays 
     28   USE prtctl         ! Print control 
     29   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2930 
    3031   IMPLICIT NONE 
     
    4546#  include "vectopt_loop_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    47    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     48   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    4849   !! $Id$ 
    4950   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    128129         zusnit = 1.0 / REAL( initad )  
    129130         IF( zcfl > 0.5 .AND. lwp )   & 
    130             WRITE(numout,*) 'lim_trp_2 : CFL violation at day ', nday, ', cfl = ', zcfl,   & 
     131            WRITE(numout,*) 'lim_trp  : CFL violation at day ', nday, ', cfl = ', zcfl,   & 
    131132               &                        ': the ice time stepping is split in two' 
    132133 
     
    174175         ELSE 
    175176            DO jk = 1, initad 
    176                CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
     177               CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    177178                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    178                CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   & 
     179               CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
    179180                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    180181               DO jl = 1, jpl 
    181                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     182                  CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    182183                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    183                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     184                  CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
    184185                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    185                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     186                  CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    186187                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    187                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     188                  CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
    188189                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    189                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     190                  CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    190191                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    191                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     192                  CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
    192193                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    193194 
    194                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     195                  CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    195196                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    196                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     197                  CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
    197198                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    198                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     199                  CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    199200                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    200                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
     201                  CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
    201202                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    202                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     203                  CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    203204                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    204                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     205                  CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
    205206                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    206207                  DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    207                      CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
     208                     CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    208209                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    209210                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    210                      CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
     211                     CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    211212                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    212213                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
     
    392393 
    393394                  ! Ice salinity and age 
    394                   zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj)  , & 
    395                      zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 
    396                   IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) &  
    397                      smv_i(ji,jj,jl) = zindic*zsal + (1.0-zindic)*0.0 
    398  
    399                   zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / &  
    400                      MAX( a_i(ji,jj,jl), epsi16 )  ), 0.0 ) * a_i(ji,jj,jl) 
    401                   oa_i (ji,jj,jl)  = zindic*zage  
     395                  zsal = MAX( MIN(  (rhoic-rhosn)/rhoic*sss_m(ji,jj) ,   & 
     396                     &              zusvoic * zs0sm(ji,jj,jl)         ) , s_i_min ) * v_i(ji,jj,jl) 
     397                  IF(  num_sal == 2  )   smv_i(ji,jj,jl) = zindic * zsal + (1.0-zindic) * 0._wp 
     398 
     399                  zage = MAX(  MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi16 ) ), 0._wp  ) * a_i(ji,jj,jl) 
     400                  oa_i (ji,jj,jl)  = zindic * zage  
    402401 
    403402                  ! Snow heat content 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90

    r3294 r3625  
    1212   !!    lim_update   : computes update of sea-ice global variables from trend terms 
    1313   !!---------------------------------------------------------------------- 
    14    USE limrhg          ! ice rheology 
    15  
    16    USE dom_oce 
    17    USE oce             ! dynamics and tracers variables 
    18    USE in_out_manager 
    19    USE sbc_oce         ! Surface boundary condition: ocean fields 
    20    USE sbc_ice         ! Surface boundary condition: ice fields 
    21    USE dom_ice 
    22    USE phycst          ! physical constants 
    23    USE ice 
    24    USE limdyn 
    25    USE limtrp 
    26    USE limthd 
    27    USE limsbc 
    28    USE limdia 
    29    USE limwri 
    30    USE limrst 
    31    USE thd_ice         ! LIM thermodynamic sea-ice variables 
    32    USE par_ice 
    33    USE limitd_th 
    34    USE limvar 
    35    USE prtctl           ! Print control 
    36    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    37    USE wrk_nemo         ! work arrays 
     14   USE dom_oce        ! ocean domain 
     15   USE oce            ! dynamics and tracers variables 
     16   USE sbc_oce        ! Surface boundary condition: ocean fields 
     17   USE sbc_ice        ! Surface boundary condition: ice fields 
     18   USE phycst         ! physical constants 
     19   USE ice            ! ice variables  
     20   USE par_ice        ! ice parameters 
     21   USE thd_ice        ! ice thermodynamic variables 
     22   USE dom_ice        ! ice domain 
     23   USE limrhg         ! ice rheology 
     24   USE limdyn         ! ice dynamics 
     25   USE limtrp         ! ice transport 
     26   USE limthd         ! ice thermodynamics 
     27   USE limsbc         ! ice-oce surface boundary conditions 
     28   USE limdia         ! ice diagnostics 
     29   USE limwri         ! ice outputs 
     30   USE limrst         ! ice restart 
     31   USE limitd_th      ! ice thickness distribution (thermodynamics) 
     32   USE limvar         ! ice variables 
     33   USE prtctl         ! Print control 
     34   USE in_out_manager ! I/O manager 
     35   USE lbclnk         ! lateral boundary condition - MPP exchanges 
     36   USE wrk_nemo       ! work arrays 
     37   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3838 
    3939   IMPLICIT NONE 
     
    5454#  include "vectopt_loop_substitute.h90" 
    5555   !!---------------------------------------------------------------------- 
    56    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     56   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    5757   !! $Id$ 
    5858   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    190190 
    191191                  ! is there any ice left ? 
    192                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
     192                  zindic = MAX( rzero , SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    193193                  !=1 if hi > 1e-3 and 0 if not 
    194                   zdvres        = MAX(0.0,-v_i(ji,jj,jl)) !residual volume if too much ice was molten 
     194                  zdvres = MAX( 0.0 , -v_i(ji,jj,jl) ) !residual volume if too much ice was molten 
    195195                  !this quantity is positive 
    196                   v_i(ji,jj,jl) = zindic*v_i(ji,jj,jl)    !ice volume cannot be negative 
     196                  v_i(ji,jj,jl) = zindic * v_i(ji,jj,jl)    !ice volume cannot be negative 
    197197                  !correct thermodynamic ablation 
    198                   d_v_i_thd(ji,jj,jl)  = zindic  *  d_v_i_thd(ji,jj,jl) + (1.0-zindic) * (-zviold - d_v_i_trp(ji,jj,jl))  
     198                  d_v_i_thd(ji,jj,jl) = zindic  *  d_v_i_thd(ji,jj,jl) + (1.0-zindic) * (-zviold - d_v_i_trp(ji,jj,jl))  
    199199                  ! THIS IS NEW 
    200                   d_a_i_thd(ji,jj,jl)  = zindic  *  d_a_i_thd(ji,jj,jl) + &  
    201                      (1.0-zindic) * (-old_a_i(ji,jj,jl))  
     200                  d_a_i_thd(ji,jj,jl) = zindic  *  d_a_i_thd(ji,jj,jl) + (1.0-zindic) * (-old_a_i(ji,jj,jl))  
    202201 
    203202                  !residual salt flux if ice is over-molten 
    204                   fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
    205                      ( rhoic * zdvres / rdt_ice ) 
    206                   !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhoic * lfus * zdvres / rdt_ice 
     203                  sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres * r1_rdtice ) 
     204                  !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhoic * lfus * zdvres * r1_rdtice 
    207205 
    208206                  ! is there any snow left ? 
    209                   zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) )  
    210                   zvsold        = v_s(ji,jj,jl) 
    211                   zdvres        = MAX(0.0,-v_s(ji,jj,jl)) !residual volume if too much ice was molten 
     207                  zindsn = MAX(  rzero, SIGN( rone , v_s(ji,jj,jl) - epsi10 ) )  
     208                  zvsold = v_s(ji,jj,jl) 
     209                  zdvres = MAX( 0.0 , -v_s(ji,jj,jl) )  !residual volume if too much ice was molten 
    212210                  !this quantity is positive 
    213211                  v_s(ji,jj,jl) = zindsn*v_s(ji,jj,jl)    !snow volume cannot be negative 
     
    215213                  d_v_s_thd(ji,jj,jl)  = zindsn  *  d_v_s_thd(ji,jj,jl) + &  
    216214                     (1.0-zindsn) * (-zvsold - d_v_s_trp(ji,jj,jl))  
    217                   !unsure correction on salt flux.... maybe future will tell it was not that right 
    218  
    219                   !residual salt flux if snow is over-molten 
    220                   fsalt_res(ji,jj)  = fsalt_res(ji,jj) + sss_m(ji,jj) * ( rhosn * zdvres / rdt_ice ) 
    221                   !this flux will be positive if snow was over-molten 
    222                   !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhosn * lfus * zdvres / rdt_ice 
     215 
     216                  !no salt flux when snow is over-molten 
     217                  !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhosn * lfus * zdvres * r1_rdtice 
    223218               ENDIF 
    224219            END DO !ji 
     
    229224         DO jj = 1, jpj 
    230225            DO ji = 1, jpi 
    231                IF ( ABS(fsalt_res(ji,jj)) .GT. 1.0 ) THEN  
    232                   WRITE(numout,*) ' ALERTE 1000 : residual salt flux of -> ', & 
    233                      fsalt_res(ji,jj) 
    234                   WRITE(numout,*) ' ji, jj : ', ji, jj, ' gphit, glamt : ', & 
    235                      gphit(ji,jj), glamt(ji,jj) 
     226               IF(  ABS( sfx_res(ji,jj) )  >  1._wp  ) THEN  
     227                  WRITE(numout,*) ' ALERTE 1000 : residual salt flux of -> ', sfx_res(ji,jj) 
     228                  WRITE(numout,*) ' ji, jj : ', ji, jj, ' gphit, glamt : ', gphit(ji,jj), glamt(ji,jj) 
    236229               ENDIF 
    237230            END DO 
     
    277270      ENDIF 
    278271 
    279       at_i(:,:) = 0._wp 
    280       DO jl = 1, jpl 
    281          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     272      at_i(:,:) = a_i(:,:,1) 
     273      DO jl = 2, jpl 
     274         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    282275      END DO 
    283276 
     
    306299      !-------------- 
    307300 
    308       IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN      ! general case 
     301      IF(  num_sal == 2  ) THEN      ! Prognostic salinity [Sice=F(z,t)] 
    309302         ! 
    310303         IF( ln_nicep ) THEN   
     
    317310            WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    318311         ENDIF 
    319  
     312         ! 
    320313         smv_i(:,:,:) = smv_i(:,:,:) + d_smv_i_thd(:,:,:) + d_smv_i_trp(:,:,:) 
    321314         ! 
     
    352345               .AND.( ( v_i(ji,jj,1)/MAX(a_i(ji,jj,1),epsi10)*zindb).GT.zhimax ) & 
    353346               .AND.( zat_i_old.LT.zacrith ) )  THEN ! new line 
    354                z_prescr_hi      = hi_max(1) / 2.0 
    355                a_i(ji,jj,1)     = v_i(ji,jj,1) / z_prescr_hi 
     347               z_prescr_hi  = hi_max(1) * 0.5_wp 
     348               a_i(ji,jj,1) = v_i(ji,jj,1) / z_prescr_hi 
    356349            ENDIF 
    357350         END DO 
     
    412405      ENDIF 
    413406 
    414       at_i(:,:) = 0._wp 
    415       DO jl = 1, jpl 
    416          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     407      at_i(:,:) = a_i(:,:,1) 
     408      DO jl = 2, jpl 
     409         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    417410      END DO 
    418411 
     
    452445      ENDIF 
    453446 
    454       at_i(:,:) = 0._wp 
    455       DO jl = 1, jpl 
    456          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     447      at_i(:,:) = a_i(:,:,1) 
     448      DO jl = 2, jpl 
     449         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    457450      END DO 
    458451 
     
    616609            DO ji = 1, jpi 
    617610               IF ( internal_melt(ji,jj,jl) == 1 ) THEN 
    618                   v_s(ji,jj,jl)   = 0.0 
    619                   e_s(ji,jj,1,jl) = 0.0 
     611                  v_s(ji,jj,jl)   = 0._wp 
     612                  e_s(ji,jj,1,jl) = 0._wp 
    620613                  !   ! release heat 
    621                   fheat_res(ji,jj) = fheat_res(ji,jj)  & 
    622                      + ze_s * v_s(ji,jj,jl) / rdt_ice 
     614                  fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s  * v_s(ji,jj,jl) * r1_rdtice 
    623615                  ! release mass 
    624                   rdmsnif(ji,jj) =  rdmsnif(ji,jj) + rhosn * v_s(ji,jj,jl) 
     616                  rdm_snw  (ji,jj) = rdm_snw  (ji,jj) + rhosn * v_s(ji,jj,jl) 
    625617               ENDIF 
    626618            END DO 
     
    648640               !                ENDIF 
    649641               IF ((oa_i(ji,jj,jl)-1.0)*86400.0.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    650                   oa_i(ji,jj,jl) = rdt_ice*numit/86400.0*a_i(ji,jj,jl) 
     642                  oa_i(ji,jj,jl) = rdt_ice * numit / 86400.0 * a_i(ji,jj,jl) 
    651643               ENDIF 
    652644               oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
     
    657649               !             v_s(ji,jj,jl)  = MAX( zindb * v_s(ji,jj,jl), 0.0)  
    658650               ! snow thickness cannot be smaller than 1e-6 
    659                v_s(ji,jj,jl)  = zindsn*v_s(ji,jj,jl)*zindb 
     651               v_s(ji,jj,jl)  = zindsn * v_s(ji,jj,jl) * zindb 
    660652               v_s(ji,jj,jl)  = v_s(ji,jj,jl) *  MAX( 0.0 , SIGN( 1.0 , v_s(ji,jj,jl) - epsi06 ) ) 
    661653 
     
    737729      !--------------------- 
    738730 
    739       IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN ! general case 
    740  
     731      IF(  num_sal == 2  ) THEN      ! Prognostic salinity [Sice=F(z,t)] 
     732         ! 
    741733         DO jl = 1, jpl 
    742734            DO jk = 1, nlay_i 
    743735               DO jj = 1, jpj  
    744                   DO ji = 1, jpi 
    745                      ! salinity stays in bounds 
    746                      smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), & 
    747                         0.1 * v_i(ji,jj,jl) ) 
     736                  DO ji = 1, jpi           ! salinity stays in bounds 
     737                     smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), 0.1 * v_i(ji,jj,jl) ) 
    748738                     i_ice_switch    =  1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) 
    749                      smv_i(ji,jj,jl)  = i_ice_switch*smv_i(ji,jj,jl) + & 
    750                         0.1*(1.0-i_ice_switch)*v_i(ji,jj,jl) 
     739                     smv_i(ji,jj,jl)  = i_ice_switch*smv_i(ji,jj,jl) + 0.1*(1.0-i_ice_switch)*v_i(ji,jj,jl) 
    751740                  END DO ! ji 
    752741               END DO ! jj 
    753742            END DO !jk 
    754743         END DO !jl 
    755  
     744         ! 
    756745      ENDIF 
    757746 
     
    796785      !----------------------------------------------------- 
    797786      zamax = amax 
    798       ! 2.13.1) individual concentrations cannot exceed zamax 
    799       !------------------------------------------------------ 
    800  
    801       at_i(:,:) = 0.0 
    802       DO jl = 1, jpl 
    803          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    804       END DO 
    805  
    806       ! 2.13.2) Total ice concentration cannot exceed zamax 
    807       !---------------------------------------------------- 
     787      ! 2.13.1) total (and thus individual) concentrations cannot exceed zamax 
     788      !----------------------------------------------------------------------- 
     789 
    808790      at_i(:,:) = a_i(:,:,1) 
    809791      DO jl = 2, jpl 
    810          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     792         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    811793      END DO 
    812794 
     
    815797 
    816798            ! 0) Excessive area ? 
    817             z_da_ex =  MAX( at_i(ji,jj) - zamax , 0.0 )         
     799            z_da_ex =  MAX( at_i(ji,jj) - zamax , 0._wp )         
    818800 
    819801            ! 1) Count the number of existing categories 
    820802            DO jl  = 1, jpl 
     803!!cr : comment the second line of zindb definition, and use epsi04 in the 1st one 
    821804               zindb   =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi03 ) )  
    822805               zindb   =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) ) )  
     
    839822      at_i(:,:) = a_i(:,:,1) 
    840823      DO jl = 2, jpl 
    841          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     824         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    842825      END DO 
    843826 
     
    894877      at_i(:,:) = a_i(:,:,1) 
    895878      DO jl = 2, jpl 
    896          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     879         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    897880      END DO 
    898881 
     
    902885      ! Ice drift 
    903886      !------------ 
     887!!gm  BUG ? I don't understand this : it may have a wrong impact on the ice edge advection 
     888!!gm  and any way there is much faster way to code that... 
    904889      DO jj = 2, jpjm1 
    905890         DO ji = fs_2, fs_jpim1 
     
    913898      END DO 
    914899      !mask velocities 
     900!!gm BUG ?  here the mask are the one of the beginning of the time step, no?  
     901!!gm        whereas at this level they should have been updated... To be checked  
    915902      u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    916903      v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
     
    10211008         CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    10221009         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    1023          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update : fhbri : ', tab2d_2=fheat_rpo , clinfo2= ' fheat_rpo : ') 
     1010         CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    10241011 
    10251012         CALL prt_ctl_info(' ') 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r3294 r3625  
    4343   !!   lim_var_bv        : 
    4444   !!---------------------------------------------------------------------- 
    45    USE par_oce          ! ocean parameters 
    46    USE phycst           ! physical constants (ocean directory)  
    47    USE sbc_oce          ! Surface boundary condition: ocean fields 
    48    USE ice              ! LIM variables 
    49    USE par_ice          ! LIM parameters 
    50    USE dom_ice          ! LIM domain 
    51    USE thd_ice          ! LIM thermodynamics 
    52    USE in_out_manager   ! I/O manager 
    53    USE lib_mpp          ! MPP library 
    54    USE wrk_nemo         ! work arrays 
     45   USE par_oce        ! ocean parameters 
     46   USE phycst         ! physical constants (ocean directory)  
     47   USE sbc_oce        ! Surface boundary condition: ocean fields 
     48   USE ice            ! ice variables 
     49   USE par_ice        ! ice parameters 
     50   USE thd_ice        ! ice variables (thermodynamics) 
     51   USE dom_ice        ! ice domain 
     52   USE in_out_manager ! I/O manager 
     53   USE lib_mpp        ! MPP library 
     54   USE wrk_nemo       ! work arrays 
     55   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    5556 
    5657   IMPLICIT NONE 
     
    7374 
    7475   !!---------------------------------------------------------------------- 
    75    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     76   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    7677   !! $Id$ 
    7778   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    182183      END DO 
    183184 
    184       IF(  num_sal == 2  .OR.  num_sal == 4  )THEN 
     185      IF(  num_sal == 2  )THEN 
    185186         DO jl = 1, jpl 
    186187            DO jj = 1, jpj 
     
    309310      ! Vertically constant, constant in time 
    310311      !--------------------------------------- 
    311       IF( num_sal == 1 )   s_i(:,:,:,:) = bulk_sal 
     312      IF(  num_sal == 1 )   s_i(:,:,:,:) = bulk_sal 
    312313 
    313314      !----------------------------------- 
    314315      ! Salinity profile, varying in time 
    315316      !----------------------------------- 
    316  
    317       IF(   num_sal == 2  .OR.   num_sal == 4   ) THEN 
     317      IF(  num_sal == 2  ) THEN 
    318318         ! 
    319319         DO jk = 1, nlay_i 
     
    331331         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )       ! Weighting factor between zs_zero and zs_inf 
    332332         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 ) 
    333  
     333         ! 
    334334         zalpha(:,:,:) = 0._wp 
    335335         DO jl = 1, jpl 
     
    347347            END DO 
    348348         END DO 
    349  
     349         ! 
    350350         dummy_fac = 1._wp / nlay_i                   ! Computation of the profile 
    351351         DO jl = 1, jpl 
     
    361361            END DO ! jk 
    362362         END DO ! jl 
    363  
     363         ! 
    364364      ENDIF ! num_sal 
    365365 
     
    368368      !------------------------------------------------------- 
    369369 
    370       IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
     370      IF(  num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    371371         ! 
    372372         sm_i(:,:,:) = 2.30_wp 
     
    380380            END DO 
    381381         END DO 
    382  
     382         ! 
    383383      ENDIF ! num_sal 
    384384      ! 
     
    447447      !------------------------------------------------------ 
    448448 
    449       IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN 
     449      IF(  num_sal == 2  ) THEN 
    450450         ! 
    451451         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r3294 r3625  
    2525   USE wrk_nemo        ! work arrays 
    2626   USE par_ice 
     27   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2728 
    2829   IMPLICIT NONE 
     
    5152   REAL(wp)  ::   zone   = 1._wp       
    5253   !!---------------------------------------------------------------------- 
    53    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     54   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    5455   !! $Id$ 
    5556   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    245246            zcmo(ji,jj,25) = et_i(ji,jj) 
    246247            zcmo(ji,jj,26) = et_s(ji,jj) 
    247             zcmo(ji,jj,28) = fsbri(ji,jj) 
    248             zcmo(ji,jj,29) = fseqv(ji,jj) 
     248            zcmo(ji,jj,28) = sfx_bri(ji,jj) 
     249            zcmo(ji,jj,29) = sfx_thd(ji,jj) 
    249250 
    250251            zcmo(ji,jj,30) = bv_i(ji,jj) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90

    r2715 r3625  
    111111         zcmo(ji,jj,13) = qns(ji,jj) 
    112112         ! See thersf for the coefficient 
    113          zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     113         zcmo(ji,jj,14) = - sfx (ji,jj) * rday      ! converted in Kg/m2/day = mm/day 
    114114         zcmo(ji,jj,15) = utau_ice(ji,jj) 
    115115         zcmo(ji,jj,16) = vtau_ice(ji,jj) 
     
    154154               rcmoy(ji,jj,13) = qns(ji,jj) 
    155155               ! See thersf for the coefficient 
    156                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     156               rcmoy(ji,jj,14) = - sfx (ji,jj) * rday      ! converted in mm/day 
    157157               rcmoy(ji,jj,15) = utau_ice(ji,jj) 
    158158               rcmoy(ji,jj,16) = vtau_ice(ji,jj) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r2715 r3625  
    88   USE par_ice        ! LIM-3 parameters 
    99   USE in_out_manager ! I/O manager 
    10    USE lib_mpp         ! MPP library 
     10   USE lib_mpp        ! MPP library 
    1111 
    1212   IMPLICIT NONE 
     
    6666   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_b        !: <==> the 2D  frld 
    6767   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fbif_1d       !: <==> the 2D  fbif 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdmicif_1d    !: <==> the 2D  rdmicif 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdmsnif_1d    !: <==> the 2D  rdmsnif 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_ice_1d    !: <==> the 2D  rdm_ice 
     69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_snw_1d    !: <==> the 2D  rdm_snw 
    7070   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlbbq_1d      !: <==> the 2D  qlbsbq 
    7171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dmgwi_1d      !: <==> the 2D  dmgwi 
     
    8383   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
    8484   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m] 
    85     REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::  old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
    86    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsbri_1d      !: Salt flux due to brine drainage 
     85   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d    !: <==> the 2D sfx_bri 
    8787   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage 
    88    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fseqv_1d      !: Equivalent Salt flux due to ice growth/decay 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_thd_1d    !: <==> the 2D sfx_thd 
    8989   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing 
    9090   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage 
     
    138138 
    139139   !!---------------------------------------------------------------------- 
    140    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
     140   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
    141141   !! $Id$ 
    142142   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    160160      ! 
    161161      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     & 
    162          &      fbif_1d    (jpij) , rdmicif_1d (jpij) , rdmsnif_1d (jpij) ,     & 
     162         &      fbif_1d    (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) ,     & 
    163163         &      qlbbq_1d   (jpij) , dmgwi_1d   (jpij) , dvsbq_1d   (jpij) ,     & 
    164164         &      dvbbq_1d   (jpij) , dvlbq_1d   (jpij) , dvnbq_1d   (jpij) ,     & 
     
    166166         &      tatm_ice_1d(jpij) , fsup       (jpij) , focea      (jpij) ,     &    
    167167         &      i0         (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,     &   
    168          &      fsbri_1d   (jpij) , fhbri_1d   (jpij) , fseqv_1d  (jpij) ,     & 
     168         &      sfx_bri_1d (jpij) , fhbri_1d   (jpij) , sfx_thd_1d (jpij) ,     & 
    169169         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &      
    170170         &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r3294 r3625  
    5252   LOGICAL            ::   ln_degrad  = .false. !: degradation option enabled or not  
    5353 
    54    INTEGER  , PARAMETER ::   jpfld = 19     ! maximum number of files to read 
     54   INTEGER  , PARAMETER ::   jpfld = 20     ! maximum number of fields to read 
    5555   INTEGER  , SAVE      ::   jf_tem         ! index of temperature 
    5656   INTEGER  , SAVE      ::   jf_sal         ! index of salinity 
     
    7272   INTEGER  , SAVE      ::   jf_eiv         ! index of v-eiv 
    7373   INTEGER  , SAVE      ::   jf_eiw         ! index of w-eiv 
     74   INTEGER  , SAVE      ::   jf_sfx         ! index of downward salt flux 
    7475 
    7576   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn  ! structure of input fields (file informations, fields read) 
     
    250251      un (:,:,:)       = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! u-velocity 
    251252      vn (:,:,:)       = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! v-velocity  
    252       IF( .NOT.ln_dynwzv ) &                                           ! w-velocity read in file  
     253      IF( .NOT.ln_dynwzv ) &                                          ! w-velocity read in file  
    253254         wn (:,:,:)    = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)     
    254255      hmld(:,:)        = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht 
    255256      wndm(:,:)        = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1)    ! wind speed - needed for gas exchange 
    256257      emp (:,:)        = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
    257       emps(:,:)        = emp(:,:)  
    258       fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)     ! Sea-ice fraction 
     258      sfx (:,:)        = 0.0_wp      ! enable testing with old inputs ! downward salt flux  
     259!     sfx (:,:)        = sf_dyn(jf_sfx)%fnow(:,:,1) * tmask(:,:,1)    ! downward salt flux (v3.5+) 
     260      fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)    ! Sea-ice fraction 
    259261      qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation 
    260262 
     
    302304         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 ) 
    303305         CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 ) 
    304          CALL prt_ctl(tab2d_1=emps             , clinfo1=' emps    - : ', mask1=tmask, ovlap=1 ) 
     306         CALL prt_ctl(tab2d_1=sfx              , clinfo1=' sfx     - : ', mask1=tmask, ovlap=1 ) 
    305307         CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 ) 
    306308         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask, ovlap=1 ) 
     
    330332      TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd  ! informations about the fields to be read 
    331333      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl          !   "                                 " 
    332       TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw          !   "                                 " 
     334      TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_sfx  !   "                                 " 
    333335      ! 
    334336      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad,    & 
    335337         &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd,  & 
    336338         &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl,          & 
    337          &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw 
     339         &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_sfx 
    338340 
    339341      !!---------------------------------------------------------------------- 
     
    348350      sn_mld  = FLD_N( 'dyna_grid_T' ,    120    , 'somixght' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
    349351      sn_emp  = FLD_N( 'dyna_grid_T' ,    120    , 'sowaflcd' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     352!!    sn_emp  = FLD_N( 'dyna_grid_T' ,    120    , 'sowaflup' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) ! v3.5+ 
     353      sn_sfx  = FLD_N( 'dyna_grid_T' ,    120    , 'sosfldow' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) ! v3.5+ 
    350354      sn_ice  = FLD_N( 'dyna_grid_T' ,    120    , 'soicecov' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
    351355      sn_qsr  = FLD_N( 'dyna_grid_T' ,    120    , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , ''         ) 
     
    426430        ENDIF 
    427431      ENDIF 
     432      ! Salt flux and concntration/dilution terms (new from v3.5) !! disabled to allow testing with old input files 
     433!!    jf_sfx = jfld + 1    ;    jfld = jfld + 1 
     434!!    slf_d(jf_sfx) = sn_sfx 
    428435   
    429436      ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90

    r3294 r3625  
    213213         !                                   ! Output trajectory fields 
    214214         CALL iom_rstput( it, it, inum, 'emp'   , emp    ) 
    215          CALL iom_rstput( it, it, inum, 'emps'  , emps   ) 
     215         CALL iom_rstput( it, it, inum, 'sfx'   , sfx    ) 
    216216         CALL iom_rstput( it, it, inum, 'un'    , un     ) 
    217217         CALL iom_rstput( it, it, inum, 'vn'    , vn     ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r3294 r3625  
    8383      z_frc_trd_s =           SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) )     ! salt fluxes 
    8484      ! Add penetrative solar radiation 
    85       IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qsr     (:,:) * surf(:,:) ) 
     85      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qsr     (:,:) * surf(:,:) ) 
    8686      ! Add geothermal heat flux 
    87       IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qgh_trd0(:,:) * surf(:,:) ) 
     87      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qgh_trd0(:,:) * surf(:,:) ) 
    8888      IF( lk_mpp ) THEN 
    8989         CALL mpp_sum( z_frc_trd_v ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r3609 r3625  
    400400         CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh 
    401401            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    402 !!$#if defined key_lim3 || defined key_lim2  
    403 !!$         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to 
    404 !!$         !    internal damping to Levitus that can be diagnosed from others 
    405 !!$         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup 
    406 !!$         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt 
    407 !!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    408 !!$         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass 
    409 !!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    410 !!$#endif 
    411402         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf) 
    412403            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    413 !!$         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs 
    414 !!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    415          CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! (emps-rnf) 
    416             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    417          CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! (emps-rnf) * sn 
    418             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     404         CALL histdef( nid_T, "sosfldow", "downward salt flux"                 , "PSU/m2/s",  &  ! sfx 
     405            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     406#if ! defined key_vvl 
     407         CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature"        &  ! emp * tsn(:,:,1,jp_tem) 
     408            &                                                                  , "KgC/m2/s",  &  ! sosst_cd 
     409            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     410         CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity"           &  ! emp * tsn(:,:,1,jp_sal) 
     411            &                                                                  , "KgPSU/m2/s",&  ! sosss_cd 
     412            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     413#endif 
    419414         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr 
    420415            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     
    602597      CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal), ndim_hT, ndex_hT )   ! sea surface salinity 
    603598      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height 
    604 !!$#if  defined key_lim3 || defined key_lim2  
    605 !!$      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux 
    606 !!$      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux 
    607 !!$#endif 
    608599      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux 
    609 !!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff 
    610       CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux 
    611       zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    612       CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux 
     600      CALL histwrite( nid_T, "sosfldow", it, sfx           , ndim_hT, ndex_hT )   ! downward salt flux  
     601                                                                                  ! (includes virtual salt flux beneath ice  
     602                                                                                  ! in linear free surface case) 
     603#if ! defined key_vvl 
     604      zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 
     605      CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )             ! c/d term on sst 
     606      zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 
     607      CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )             ! c/d term on sss 
     608#endif 
    613609      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux 
    614610      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux 
     
    782778      !!---------------------------------------------------------------------- 
    783779      !  
    784       IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') 
     780!     IF( nn_timing == 1 )   CALL timing_start('dia_wri_state') ! not sure this works for routines not called in first timestep 
    785781 
    786782      ! 0. Initialisation 
     
    879875#endif 
    880876        
    881       IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') 
     877!     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 
    882878      !  
    883879 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r3294 r3625  
    5454    !!  level 14: qct(:,:)                 equivalent flux due to treshold SST 
    5555    !!  level 15: fbt(:,:)                 feedback term . 
    56     !!  level 16: ( emps(:,:) - rnf(:,:) ) concentration/dilution water flux 
     56    !!  level 16: ( emp * sss )            concentration/dilution term on salinity 
     57    !!  level 17: ( emp * sst )            concentration/dilution term on temperature 
    5758    !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater 
    5859    !!  level 18: gps(:,:)                 the surface pressure (m). 
     
    107108 
    108109 
    109     inbsel = 17 
     110    inbsel = 18 
    110111 
    111112    IF( inbsel >  jpk ) THEN 
     
    172173       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:) 
    173174       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:) 
    174        fsel(:,:,16) = fsel(:,:,16) + ( emps(:,:)-rnf(:,:) )  
     175       fsel(:,:,16) = fsel(:,:,16) + ( emp(:,:)*tsn(:,:,1,jp_sal) )  
     176       fsel(:,:,17) = fsel(:,:,17) + ( emp(:,:)*tsn(:,:,1,jp_tem) )  
    175177       ! 
    176178       ! Output of dynamics and tracer fields and selected fields 
     
    240242          !         fsel(:,:,14) =  qct(:,:) 
    241243          !         fsel(:,:,15) =  fbt(:,:) 
    242           fsel(:,:,16) = ( emps(:,:)-rnf(:,:) ) * tmask(:,:,1)  
     244          fsel(:,:,16) = ( emp(:,:)-tsn(:,:,1,jp_sal) ) * tmask(:,:,1)  
     245          fsel(:,:,17) = ( emp(:,:)-tsn(:,:,1,jp_tem) ) * tmask(:,:,1)  
    243246          ! 
    244247          !         qct(:,:) = 0._wp 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r2715 r3625  
    1818   USE oce             ! dynamics and tracers 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE phycst 
    2021   USE in_out_manager  ! I/O manager 
    2122   USE sbc_oce         ! ocean surface boundary conditions 
     
    173174      !!      put as run-off in open ocean. 
    174175      !! 
    175       !! ** Action  :   emp, emps   updated surface freshwater fluxes at kt 
     176      !! ** Action  :   emp   updated surface freshwater flux at kt 
    176177      !!---------------------------------------------------------------------- 
    177178      INTEGER, INTENT(in) ::   kt   ! ocean model time step 
    178179      ! 
    179180      INTEGER                     ::   ji, jj, jc, jn   ! dummy loop indices 
    180       REAL(wp)                    ::   zze2 
     181      REAL(wp)                    ::   zze2, zcoef, zcoef1 
    181182      REAL(wp), DIMENSION (jpncs) ::   zfwf  
    182183      !!---------------------------------------------------------------------- 
     
    214215      ENDIF 
    215216      !                                                   !--------------------! 
    216       !                                                   !  update emp, emps  ! 
     217      !                                                   !  update emp        ! 
    217218      zfwf = 0.e0                                         !--------------------! 
    218219      DO jc = 1, jpncs 
     
    235236         IF( ncstt(jc) == 0 ) THEN  
    236237            ! water/evap excess is shared by all open ocean 
    237             emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 
    238             emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 
     238            zcoef  = zfwf(jc) / surf(jpncs+1) 
     239            zcoef1 = rcp * zcoef 
     240            emp(:,:) = emp(:,:) + zcoef 
     241            qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
    239242         ELSEIF( ncstt(jc) == 1 ) THEN  
    240243            ! Excess water in open sea, at outflow location, excess evap shared 
     
    245248                  IF (      ji > 1 .AND. ji < jpi   & 
    246249                      .AND. jj > 1 .AND. jj < jpj ) THEN  
    247                       emp (ji,jj) = emp (ji,jj) + zfwf(jc) /   & 
    248                          (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj)) 
    249                       emps(ji,jj) = emps(ji,jj) + zfwf(jc) /   & 
    250                           (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj)) 
     250                      zcoef  = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) ) 
     251                      zcoef1 = rcp * zcoef 
     252                      emp(ji,jj) = emp(ji,jj) + zcoef 
     253                      qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 
    251254                  END IF  
    252255                END DO  
    253256            ELSE  
    254                 emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1) 
    255                 emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1) 
     257                zcoef  = zfwf(jc) / surf(jpncs+1) 
     258                zcoef1 = rcp * zcoef 
     259                emp(:,:) = emp(:,:) + zcoef 
     260                qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:) 
    256261            ENDIF 
    257262         ELSEIF( ncstt(jc) == 2 ) THEN  
     
    262267                  ji = mi0(ncsir(jc,jn)) 
    263268                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean 
    264                   emp (ji,jj) = emp (ji,jj) + zfwf(jc)   & 
    265                       / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) ) 
    266                   emps(ji,jj) = emps(ji,jj) + zfwf(jc)   & 
    267                       / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) ) 
     269                  zcoef  = zfwf(jc) / ( REAL(ncsnr(jc), wp) * e1t(ji,jj) * e2t(ji,jj) ) 
     270                  zcoef1 = rcp * zcoef 
     271                  emp(ji,jj) = emp(ji,jj) + zcoef 
     272                  qns(ji,jj) = qns(ji,jj) - zcoef1 * sst_m(ji,jj) 
    268273                END DO  
    269274            ENDIF  
     
    272277         DO jj = ncsj1(jc), ncsj2(jc) 
    273278            DO ji = ncsi1(jc), ncsi2(jc) 
    274                emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc) 
    275                emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc) 
     279               zcoef  = zfwf(jc) / surf(jc) 
     280               zcoef1 = rcp * zcoef 
     281               emp(ji,jj) = emp(ji,jj) - zcoef 
     282               qns(ji,jj) = qns(ji,jj) + zcoef1 * sst_m(ji,jj) 
    276283            END DO   
    277284         END DO  
     
    280287      ! 
    281288      CALL lbc_lnk( emp , 'T', 1. ) 
    282       CALL lbc_lnk( emps, 'T', 1. ) 
    283289      ! 
    284290   END SUBROUTINE sbc_clo 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r3294 r3625  
    2727   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value 
    2828    
    29    REAL(wp), PUBLIC ::   rday = 24.*60.*60.       !: day (s) 
    30    REAL(wp), PUBLIC ::   rsiyea                   !: sideral year (s) 
    31    REAL(wp), PUBLIC ::   rsiday                   !: sideral day (s) 
    32    REAL(wp), PUBLIC ::   raamo =  12._wp          !: number of months in one year 
    33    REAL(wp), PUBLIC ::   rjjhh =  24._wp          !: number of hours in one day 
    34    REAL(wp), PUBLIC ::   rhhmm =  60._wp          !: number of minutes in one hour 
    35    REAL(wp), PUBLIC ::   rmmss =  60._wp          !: number of seconds in one minute 
    36 !! REAL(wp), PUBLIC ::   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit! 
    37    REAL(wp), PUBLIC ::   omega                    !: earth rotation parameter 
    38    REAL(wp), PUBLIC ::   ra    = 6371229._wp      !: earth radius (meter) 
    39    REAL(wp), PUBLIC ::   grav  = 9.80665_wp       !: gravity (m/s2) 
    40     
    41    REAL(wp), PUBLIC ::   rtt      = 273.16_wp     !: triple point of temperature (Kelvin) 
    42    REAL(wp), PUBLIC ::   rt0      = 273.15_wp     !: freezing point of water (Kelvin) 
     29   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s] 
     30   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s] 
     31   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s] 
     32   REAL(wp), PUBLIC ::   raamo =  12._wp        !: number of months in one year 
     33   REAL(wp), PUBLIC ::   rjjhh =  24._wp        !: number of hours in one day 
     34   REAL(wp), PUBLIC ::   rhhmm =  60._wp        !: number of minutes in one hour 
     35   REAL(wp), PUBLIC ::   rmmss =  60._wp        !: number of seconds in one minute 
     36   REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter           [s-1] 
     37   REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                       [m] 
     38   REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                            [m/s2] 
     39    
     40   REAL(wp), PUBLIC ::   rtt      = 273.16_wp        !: triple point of temperature   [Kelvin] 
     41   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin] 
    4342#if defined key_lim3 
    44    REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp     !: melting point of snow  (Kelvin) 
    45    REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp     !: melting point of ice   (Kelvin) 
    46 #else 
    47    REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp     !: melting point of snow  (Kelvin) 
    48    REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp     !: melting point of ice   (Kelvin) 
    49 #endif 
    50  
     43   REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp        !: melting point of snow         [Kelvin] 
     44   REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp        !: melting point of ice          [Kelvin] 
     45#else 
     46   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin] 
     47   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin] 
     48#endif 
    5149#if defined key_cice 
    52    REAL(wp), PUBLIC ::   rau0     = 1026._wp      !: reference volumic mass (density)  (kg/m3) 
    53 #else 
    54    REAL(wp), PUBLIC ::   rau0     = 1035._wp      !: reference volumic mass (density)  (kg/m3) 
    55 #endif 
    56    REAL(wp), PUBLIC ::   rau0r                    !: reference specific volume         (m3/kg) 
    57    REAL(wp), PUBLIC ::   rcp      =    4.e+3_wp   !: ocean specific heat 
    58    REAL(wp), PUBLIC ::   ro0cpr                   !: = 1. / ( rau0 * rcp ) 
     50   REAL(wp), PUBLIC ::   rau0     = 1026._wp         !: volumic mass of reference     [kg/m3] 
     51#else 
     52   REAL(wp), PUBLIC ::   rau0     = 1035._wp         !: volumic mass of reference     [kg/m3] 
     53#endif 
     54   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg] 
     55   REAL(wp), PUBLIC ::   rauw     = 1000._wp         !: volumic mass of pure water    [m3/kg] 
     56   REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/Kelvin] 
     57   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
     58   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
     59 
     60   REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3] 
     61   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice 
     62   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu] 
     63   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea               [psu] 
     64   REAL(wp), PUBLIC ::   cevap    =    2.5e+6_wp     !: latent heat of evaporation (water) 
     65   REAL(wp), PUBLIC ::   srgamma  =    0.9_wp        !: correction factor for solar radiation (Oberhuber, 1974) 
     66   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant 
     67   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant  
    5968 
    6069#if defined key_lim3 || defined key_cice 
    61    REAL(wp), PUBLIC ::   rcdsn   =   0.31_wp      !: thermal conductivity of snow 
    62    REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: thermal conductivity of fresh ice 
    63    REAL(wp), PUBLIC ::   cpic    = 2067.0         !: specific heat of sea ice 
    64    REAL(wp), PUBLIC ::   lsub    = 2.834e+6       !: pure ice latent heat of sublimation (J.kg-1) 
    65    REAL(wp), PUBLIC ::   lfus    = 0.334e+6       !: latent heat of fusion of fresh ice   (J.kg-1) 
    66    REAL(wp), PUBLIC ::   rhoic   = 917._wp        !: volumic mass of sea ice (kg/m3) 
    67    REAL(wp), PUBLIC ::   tmut    =   0.054        !: decrease of seawater meltpoint with salinity 
    68 #else 
    69    REAL(wp), PUBLIC ::   rcdsn   =   0.22_wp      !: conductivity of the snow 
    70    REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: conductivity of the ice 
    71    REAL(wp), PUBLIC ::   rcpsn   =   6.9069e+5_wp !: density times specific heat for snow 
    72    REAL(wp), PUBLIC ::   rcpic   =   1.8837e+6_wp !: volumetric latent heat fusion of sea ice 
    73    REAL(wp), PUBLIC ::   lfus    =   0.3337e+6    !: latent heat of fusion of fresh ice   (J.kg-1)     
    74    REAL(wp), PUBLIC ::   xlsn    = 110.121e+6_wp  !: volumetric latent heat fusion of snow 
    75    REAL(wp), PUBLIC ::   xlic    = 300.33e+6_wp   !: volumetric latent heat fusion of ice 
    76    REAL(wp), PUBLIC ::   xsn     =   2.8e+6       !: latent heat of sublimation of snow 
    77    REAL(wp), PUBLIC ::   rhoic   = 900._wp        !: volumic mass of sea ice (kg/m3) 
    78 #endif 
    79    REAL(wp), PUBLIC ::   rhosn   = 330._wp        !: volumic mass of snow (kg/m3) 
    80    REAL(wp), PUBLIC ::   emic    =   0.97_wp      !: emissivity of snow or ice 
    81    REAL(wp), PUBLIC ::   sice    =   6.0_wp       !: reference salinity of ice (psu) 
    82    REAL(wp), PUBLIC ::   soce    =  34.7_wp       !: reference salinity of sea (psu) 
    83    REAL(wp), PUBLIC ::   cevap   =   2.5e+6_wp    !: latent heat of evaporation (water) 
    84    REAL(wp), PUBLIC ::   srgamma =   0.9_wp       !: correction factor for solar radiation (Oberhuber, 1974) 
    85    REAL(wp), PUBLIC ::   vkarmn  =   0.4_wp       !: von Karman constant 
    86    REAL(wp), PUBLIC ::   stefan  =   5.67e-8_wp   !: Stefan-Boltzmann constant  
     70   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
     71   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
     72   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
     73   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     74   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
     75   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
     76   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
     77   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3] 
     78#else 
     79   REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3] 
     80   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K] 
     81   REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K] 
     82   REAL(wp), PUBLIC ::   cpic                        !: = rcpic / rhoic  (specific heat for ice)              [J/Kg/K] 
     83   REAL(wp), PUBLIC ::   rcdsn    =    0.22_wp       !: conductivity of the snow                              [W/m/K] 
     84   REAL(wp), PUBLIC ::   rcpsn    =    6.9069e+5_wp  !: volumetric specific heat for snow                     [J/m3/K] 
     85   REAL(wp), PUBLIC ::   xlsn     =  110.121e+6_wp   !: volumetric latent heat fusion of snow                 [J/m3] 
     86   REAL(wp), PUBLIC ::   lfus                        !: = xlsn / rhosn   (latent heat of fusion of fresh ice) [J/Kg] 
     87   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3] 
     88   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3] 
     89#endif 
    8790   !!---------------------------------------------------------------------- 
    8891   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    102105      !!---------------------------------------------------------------------- 
    103106 
    104       !                                   ! Define additional parameters 
    105       rsiyea = 365.25 * rday * 2. * rpi / 6.283076 
    106       rsiday = rday / ( 1. + rday / rsiyea ) 
    107 #if defined key_cice 
    108       omega =  7.292116e-05 
    109 #else 
    110       omega  = 2. * rpi / rsiday  
    111 #endif 
    112  
    113       rau0r  = 1. /   rau0   
    114       ro0cpr = 1. / ( rau0 * rcp ) 
    115  
    116  
    117       IF(lwp) THEN                        ! control print 
    118          WRITE(numout,*) 
    119          WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
    120          WRITE(numout,*) ' ~~~~~~~' 
     107      IF(lwp) WRITE(numout,*) 
     108      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
     109      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     110 
     111      ! Ocean Parameters 
     112      ! ---------------- 
     113      IF(lwp) THEN 
    121114         WRITE(numout,*) '       Domain info' 
    122115         WRITE(numout,*) '          dimension of model' 
     
    131124         WRITE(numout,*) '             jpnij   : ', jpnij 
    132125         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio 
    133          WRITE(numout,*) 
    134          WRITE(numout,*) '       Constants' 
    135          WRITE(numout,*) 
    136          WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
    137          WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
    138          WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
    139          WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
    140          WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1' 
    141          WRITE(numout,*) 
    142          WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
    143          WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
    144          WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
    145          WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
    146          WRITE(numout,*) 
    147          WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
    148          WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
    149          WRITE(numout,*) 
    150          WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
    151          WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
    152          WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
    153          WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
    154          WRITE(numout,*) 
    155          WRITE(numout,*) '          ocean reference volumic mass       rau0   = ', rau0 , ' kg/m^3' 
    156          WRITE(numout,*) '          ocean reference specific volume    rau0r  = ', rau0r, ' m^3/Kg' 
    157          WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp 
    158          WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 
     126      ENDIF 
     127 
     128      ! Define constants 
     129      ! ---------------- 
     130      IF(lwp) WRITE(numout,*) 
     131      IF(lwp) WRITE(numout,*) '       Constants' 
     132 
     133      IF(lwp) WRITE(numout,*) 
     134      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
     135 
     136      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp 
     137      rsiday = rday / ( 1._wp + rday / rsiyea ) 
     138#if defined key_cice 
     139      omega  = 7.292116e-05 
     140#else 
     141      omega  = 2._wp * rpi / rsiday  
     142#endif 
     143      IF(lwp) WRITE(numout,*) 
     144      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
     145      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
     146      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
     147      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s^-1' 
     148 
     149      IF(lwp) WRITE(numout,*) 
     150      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
     151      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
     152      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
     153      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
     154 
     155      IF(lwp) WRITE(numout,*) 
     156      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
     157      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
     158 
     159      IF(lwp) WRITE(numout,*) 
     160      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
     161      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
     162      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
     163      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
     164 
     165      r1_rau0     = 1._wp / rau0 
     166      r1_rcp      = 1._wp / rcp 
     167      r1_rau0_rcp = 1._wp / ( rau0 * rcp ) 
     168      IF(lwp) WRITE(numout,*) 
     169      IF(lwp) WRITE(numout,*) '          volumic mass of pure water          rauw  = ', rauw   , ' kg/m^3' 
     170      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3' 
     171      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg' 
     172      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin' 
     173      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp 
     174 
     175 
     176#if defined key_lim3 || defined key_cice 
     177      xlsn = lfus * rhosn        ! volumetric latent heat fusion of snow [J/m3] 
     178#else 
     179      cpic = rcpic / rhoic       ! specific heat for ice   [J/Kg/K] 
     180      lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice 
     181#endif 
     182 
     183      IF(lwp) THEN 
    159184         WRITE(numout,*) 
    160185         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    161186         WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K' 
    162 #if defined key_lim3 
    163187         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    164188         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
     189#if defined key_lim3 || defined key_cice 
    165190         WRITE(numout,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg' 
    166 #elif defined key_cice 
    167          WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
    168191#else 
    169192         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K'  
    170193         WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K' 
    171194         WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m'  
    172          WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m'  
    173195         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg'  
    174196#endif 
     197         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3'  
    175198         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3' 
    176199         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3' 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r3322 r3625  
    8181      ! 
    8282      INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    83       REAL(wp) ::   z2dt, zg_2                             ! temporary scalar 
     83      REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r             ! temporary scalar 
    8484      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     85      REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice 
    8586      !!---------------------------------------------------------------------- 
    8687      ! 
     
    117118            END DO 
    118119         END DO 
     120      ENDIF 
     121 
     122      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 
     123         CALL wrk_alloc( jpi, jpj, zpice ) 
     124         !                                             
     125         zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
     126         zgrau0r     = - grav * r1_rau0 
     127         zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
     128         DO jj = 2, jpjm1 
     129            DO ji = fs_2, fs_jpim1   ! vector opt. 
     130               spgu(ji,jj) = ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 
     131               spgv(ji,jj) = ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 
     132            END DO 
     133         END DO 
     134         DO jk = 1, jpkm1                             ! Add the surface pressure trend to the general trend 
     135            DO jj = 2, jpjm1 
     136               DO ji = fs_2, fs_jpim1   ! vector opt. 
     137                  ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) 
     138                  va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) 
     139               END DO 
     140            END DO 
     141         END DO 
     142         ! 
     143         CALL wrk_dealloc( jpi, jpj, zpice ) 
    119144      ENDIF 
    120145 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r3294 r3625  
    6161      ! 
    6262      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    63       REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars 
     63      REAL(wp) ::   zlavmr, zua, zva   ! local scalars 
    6464      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy, zwz, zww 
    6565      !!---------------------------------------------------------------------- 
     
    7575      ENDIF 
    7676 
    77       zrau0r = 1. / rau0               ! Local constant initialization 
    7877      zlavmr = 1. / REAL( nn_zdfexp ) 
    7978 
     
    8180      DO jj = 2, jpjm1                 ! Surface boundary condition 
    8281         DO ji = 2, jpim1 
    83             zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * zrau0r 
    84             zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r 
     82            zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0 
     83            zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_rau0 
    8584         END DO   
    8685      END DO   
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r3294 r3625  
    161161         DO ji = fs_2, fs_jpim1   ! vector opt. 
    162162            ua(ji,jj,1) = ub(ji,jj,1) + p2dt * (  ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    163                &                                                       / ( fse3u(ji,jj,1) * rau0       )  ) 
     163               &                                                       * r1_rau0 / fse3u(ji,jj,1)       ) 
    164164         END DO 
    165165      END DO 
     
    247247         DO ji = fs_2, fs_jpim1   ! vector opt. 
    248248            va(ji,jj,1) = vb(ji,jj,1) + p2dt * (  va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    249                &                                                       / ( fse3v(ji,jj,1) * rau0       )  ) 
     249               &                                                       * r1_rau0 / fse3v(ji,jj,1)       ) 
    250250         END DO 
    251251      END DO 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r3608 r3625  
    88   !!---------------------------------------------------------------------- 
    99   USE dom_oce          ! ocean space and time domain variables 
     10#if defined key_nemocice_decomp 
     11   USE ice_domain_size, only: nx_global, ny_global 
     12#endif 
    1013   USE in_out_manager   ! I/O manager 
    1114   USE lib_mpp          ! distributed memory computing 
     
    431434      !  array (cf. par_oce.F90). 
    432435 
     436#if defined key_nemocice_decomp 
     437      ijpi = ( nx_global+2-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 
     438      ijpj = ( ny_global+2-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj  
     439#else 
    433440      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 
    434 #if defined key_nemocice_decomp 
    435       ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj  
    436 #else 
    437441      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
    438442#endif 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3609 r3625  
    120120 
    121121   ! variables used in case of sea-ice 
    122    INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice 
     122   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd) 
     123   INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology) 
    123124   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology) 
    124125   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors 
     
    19781979      !!      ndim_rank_ice = number of processors with ice 
    19791980      !!      nrank_ice (ndim_rank_ice) = ice processors 
    1980       !!      ngrp_world = group ID for the world processors 
     1981      !!      ngrp_iworld = group ID for the world processors 
    19811982      !!      ngrp_ice = group ID for the ice processors 
    19821983      !!      ncomm_ice = communicator for the ice procs. 
     
    20272028 
    20282029      ! Create the world group 
    2029       CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr ) 
     2030      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_iworld, ierr ) 
    20302031 
    20312032      ! Create the ice group from the world group 
    2032       CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr ) 
     2033      CALL MPI_GROUP_INCL( ngrp_iworld, ndim_rank_ice, nrank_ice, ngrp_ice, ierr ) 
    20332034 
    20342035      ! Create the ice communicator , ie the pool of procs with sea-ice 
     
    20372038      ! Find proc number in the world of proc 0 in the north 
    20382039      ! The following line seems to be useless, we just comment & keep it as reminder 
    2039       ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr) 
    2040       ! 
     2040      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_iworld,n_ice_root,ierr) 
     2041      ! 
     2042      CALL MPI_GROUP_FREE(ngrp_ice, ierr) 
     2043      CALL MPI_GROUP_FREE(ngrp_iworld, ierr) 
     2044 
    20412045      DEALLOCATE(kice, zwork) 
    20422046      ! 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r3294 r3625  
    1616   !!   'key_ldfslp'                      Rotation of lateral mixing tensor 
    1717   !!---------------------------------------------------------------------- 
    18    !!   ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator) 
    19    !!   ldf_slp      : calculates the slopes of neutral surface   (Madec operator) 
    20    !!   ldf_slp_mxl  : calculates the slopes at the base of the mixed layer (Madec operator) 
    21    !!   ldf_slp_init : initialization of the slopes computation 
     18   !!   ldf_slp_grif  : calculates the triads of isoneutral slopes (Griffies operator) 
     19   !!   ldf_slp       : calculates the slopes of neutral surface   (Madec operator) 
     20   !!   ldf_slp_mxl   : calculates the slopes at the base of the mixed layer (Madec operator) 
     21   !!   ldf_slp_init  : initialization of the slopes computation 
    2222   !!---------------------------------------------------------------------- 
    23    USE oce             ! ocean dynamics and tracers 
    24    USE dom_oce         ! ocean space and time domain 
    25    USE ldftra_oce      ! lateral diffusion: traceur 
    26    USE ldfdyn_oce      ! lateral diffusion: dynamics 
    27    USE phycst          ! physical constants 
    28    USE zdfmxl          ! mixed layer depth 
    29    USE eosbn2          ! equation of states 
    30    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    31    USE in_out_manager  ! I/O manager 
    32    USE prtctl          ! Print control 
    33    USE wrk_nemo        ! work arrays 
    34    USE timing          ! Timing 
     23   USE oce            ! ocean dynamics and tracers 
     24   USE dom_oce        ! ocean space and time domain 
     25   USE ldftra_oce     ! lateral diffusion: traceur 
     26   USE ldfdyn_oce     ! lateral diffusion: dynamics 
     27   USE phycst         ! physical constants 
     28   USE zdfmxl         ! mixed layer depth 
     29   USE eosbn2         ! equation of states 
     30   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     31   USE in_out_manager ! I/O manager 
     32   USE prtctl         ! Print control 
     33   USE wrk_nemo       ! work arrays 
     34   USE timing         ! Timing 
     35   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3536 
    3637   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r3294 r3625  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   albedo_ice  : albedo for   ice (clear and overcast skies) 
    15    !!   albedo_oce  : albedo for ocean (clear and overcast skies) 
    16    !!   albedo_init : initialisation of albedo computation 
    17    !!---------------------------------------------------------------------- 
    18    USE phycst          ! physical constants 
    19    USE in_out_manager  ! I/O manager 
    20    USE lib_mpp         ! MPP library 
    21    USE wrk_nemo        ! work arrays 
     14   !!   albedo_ice    : albedo for   ice (clear and overcast skies) 
     15   !!   albedo_oce    : albedo for ocean (clear and overcast skies) 
     16   !!   albedo_init   : initialisation of albedo computation 
     17   !!---------------------------------------------------------------------- 
     18   USE phycst         ! physical constants 
     19   USE in_out_manager ! I/O manager 
     20   USE lib_mpp        ! MPP library 
     21   USE wrk_nemo       ! work arrays 
     22   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2223 
    2324   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r3294 r3625  
    9494   ! finally, arrays corresponding to different ice categories 
    9595   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i                !: category ice fraction 
    96    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt           !: category topmelt 
    97    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt           !: category botmelt 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt            !: category topmelt 
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt            !: category botmelt 
    9898#endif 
    9999 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r3609 r3625  
    4040   LOGICAL , PUBLIC ::   ln_apr_dyn  = .FALSE.   !: Atmospheric pressure forcing used on dynamics (ocean & ice) 
    4141   LOGICAL , PUBLIC ::   ln_icebergs = .FALSE.   !: Icebergs 
    42    INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2/3) 
     42   INTEGER , PUBLIC ::   nn_ice      = 0         !: flag for ice in the surface boundary condition (=0/1/2/3) 
     43   INTEGER , PUBLIC ::   nn_ice_embd = 0         !: flag for levitating/embedding sea-ice in the ocean 
     44   !                                             !: =0 levitating ice (no mass exchange, concentration/dilution effect) 
     45   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
     46   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
    4347   INTEGER , PUBLIC ::   nn_fwb      = 0         !: FreshWater Budget:  
    4448   !                                             !:  = 0 unchecked  
     
    6266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2] 
    6367   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s] 
    64    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s] 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx    , sfx_b    !: salt flux                                    [PSU/m2/s] 
    6569   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s] 
    6670   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]   
     
    106110         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) )  
    107111         ! 
    108       ALLOCATE( qns_tot(jpi,jpj) , qns   (jpi,jpj) , qns_b(jpi,jpj),        & 
    109          &      qsr_tot(jpi,jpj) , qsr   (jpi,jpj) ,                        & 
    110          &      emp    (jpi,jpj) , emp_b (jpi,jpj) ,                        & 
    111          &      emps   (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) ) 
     112      ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        & 
     113         &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        & 
     114         &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        & 
     115         &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) ) 
    112116         ! 
    113117      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r3294 r3625  
    6060      !! 
    6161      !! ** Action  : - set the ocean surface boundary condition, i.e.   
    62       !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps 
     62      !!                   utau, vtau, taum, wndm, qns, qsr, emp 
    6363      !!---------------------------------------------------------------------- 
    6464      INTEGER, INTENT(in) ::   kt       ! ocean time step 
     
    8989         nn_tau000 = MAX( nn_tau000, 1 )     ! must be >= 1 
    9090         ! 
    91          qns (:,:) = rn_qns0 
     91         emp (:,:) = rn_emp0 
     92         sfx (:,:) = 0.0_wp 
     93         qns (:,:) = rn_qns0 - emp(:,:) * sst_m(:,:) * rcp      ! including heat content associated with mass flux at SST 
    9294         qsr (:,:) = rn_qsr0 
    93          emp (:,:) = rn_emp0 
    94          emps(:,:) = rn_emp0 
    9595         ! 
    9696         utau(:,:) = rn_utau0 
     
    130130      !! 
    131131      !! ** Action  : - set the ocean surface boundary condition, i.e.    
    132       !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps 
     132      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx 
    133133      !! 
    134134      !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000. 
     
    211211         END DO 
    212212      END DO 
    213       emps(:,:) = emp(:,:) 
    214213 
    215214      ! Compute the emp flux such as its integration on the whole domain at each time is zero 
     
    224223      ENDIF 
    225224 
    226       !salinity terms 
    227       emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1) 
    228       emps(:,:) = emp(:,:) 
     225      ! freshwater (mass flux) and update of qns with heat content of emp 
     226      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average) 
     227      sfx (:,:) = 0.0_wp                                   ! no salt flux 
     228      qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST 
    229229 
    230230 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r3294 r3625  
    1212 
    1313   !!---------------------------------------------------------------------- 
    14    !!   sbc_blk_clio   : CLIO bulk formulation: read and update required input fields 
    15    !!   blk_clio_oce   : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean 
    16    !!   blk_ice_clio   : ice   CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice 
     14   !!   sbc_blk_clio     : CLIO bulk formulation: read and update required input fields 
     15   !!   blk_clio_oce     : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean 
     16   !!   blk_ice_clio     : ice   CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice 
    1717   !!   blk_clio_qsr_oce : shortwave radiation for ocean computed from the cloud cover 
    1818   !!   blk_clio_qsr_ice : shortwave radiation for ice   computed from the cloud cover 
    19    !!   flx_blk_declin : solar declinaison 
     19   !!   flx_blk_declin   : solar declination 
    2020   !!---------------------------------------------------------------------- 
    21    USE oce             ! ocean dynamics and tracers 
    22    USE dom_oce         ! ocean space and time domain 
    23    USE phycst          ! physical constants 
    24    USE fldread         ! read input fields 
    25    USE sbc_oce         ! Surface boundary condition: ocean fields 
    26    USE iom             ! I/O manager library 
    27    USE in_out_manager  ! I/O manager 
    28    USE lib_mpp         ! distribued memory computing library 
    29    USE wrk_nemo        ! work arrays 
    30    USE timing          ! Timing 
    31    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     21   USE oce            ! ocean dynamics and tracers 
     22   USE dom_oce        ! ocean space and time domain 
     23   USE phycst         ! physical constants 
     24   USE fldread        ! read input fields 
     25   USE sbc_oce        ! Surface boundary condition: ocean fields 
     26   USE iom            ! I/O manager library 
     27   USE in_out_manager ! I/O manager 
     28   USE lib_mpp        ! distribued memory computing library 
     29   USE wrk_nemo       ! work arrays 
     30   USE timing         ! Timing 
     31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     32   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3233 
    3334   USE albedo 
     
    5051   INTEGER , PARAMETER ::   jp_vtau = 2           ! index of wind stress (j-component)      (N/m2)    at V-point 
    5152   INTEGER , PARAMETER ::   jp_wndm = 3           ! index of 10m wind module                 (m/s)    at T-point 
    52    INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( - ) 
    53    INTEGER , PARAMETER ::   jp_ccov = 5           ! index of cloud cover                     ( - ) 
     53   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( % ) 
     54   INTEGER , PARAMETER ::   jp_ccov = 5           ! index of cloud cover                     ( % ) 
    5455   INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin) 
    5556   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
     
    100101      !!      the i-component of the stress                (N/m2) 
    101102      !!      the j-component of the stress                (N/m2) 
    102       !!      the 10m wind pseed module                    (m/s) 
     103      !!      the 10m wind speed module                    (m/s) 
    103104      !!      the 10m air temperature                      (Kelvin) 
    104       !!      the 10m specific humidity                    (-) 
    105       !!      the cloud cover                              (-) 
     105      !!      the 10m specific humidity                    (%) 
     106      !!      the cloud cover                              (%) 
    106107      !!      the total precipitation (rain+snow)          (Kg/m2/s) 
    107108      !!              (2) CALL blk_oce_clio 
    108109      !! 
    109110      !!      C A U T I O N : never mask the surface stress fields 
    110       !!                      the stress is assumed to be in the mesh referential 
    111       !!                      i.e. the (i,j) referential 
     111      !!                      the stress is assumed to be in the (i,j) mesh referential 
    112112      !! 
    113113      !! ** Action  :   defined at each time-step at the air-sea interface 
     
    115115      !!              - taum        wind stress module at T-point 
    116116      !!              - wndm        10m wind module at T-point 
    117       !!              - qns, qsr    non-slor and solar heat flux 
    118       !!              - emp, emps   evaporation minus precipitation 
     117      !!              - qns         non-solar heat flux including latent heat of solid  
     118      !!                            precip. melting and emp heat content 
     119      !!              - qsr         solar heat flux 
     120      !!              - emp         upward mass flux (evap. - precip) 
     121      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero 
     122      !!                            if ice is present (computed in limsbc(_2).F90) 
    119123      !!---------------------------------------------------------------------- 
    120       INTEGER, INTENT(in) ::   kt   ! ocean time step 
     124      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    121125      !! 
    122126      INTEGER  ::   ifpr, jfpr   ! dummy indices 
     
    171175         ALLOCATE( sbudyko(jpi,jpj) , stauc(jpi,jpj), STAT=ierr3 ) 
    172176         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate arrays' ) 
     177         ! 
     178         sfx(:,:) = 0._wp                       ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 
    173179         ! 
    174180      ENDIF 
     
    205211      !!               - taum        wind stress module at T-point 
    206212      !!               - wndm        10m wind module at T-point 
    207       !!               - qns, qsr    non-slor and solar heat flux 
    208       !!               - emp, emps   evaporation minus precipitation 
     213      !!               - qns         non-solar heat flux including latent heat of solid  
     214      !!                             precip. melting and emp heat content 
     215      !!               - qsr         solar heat flux 
     216      !!               - emp         suface mass flux (evap.-precip.) 
    209217      !!  ** Nota    :   sf has to be a dummy argument for AGRIF on NEC 
    210218      !!---------------------------------------------------------------------- 
     
    223231      REAL(wp) ::   zsst, ztatm, zcco1, zpatm, zcmax, zrmax     !    -         - 
    224232      REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         - 
    225       REAL(wp) ::   ztx2, zty2                                  !    -         - 
     233      REAL(wp) ::   ztx2, zty2, zcevap, zcprec                  !    -         - 
    226234      REAL(wp), POINTER, DIMENSION(:,:) ::   zqlw        ! long-wave heat flux over ocean 
    227235      REAL(wp), POINTER, DIMENSION(:,:) ::   zqla        ! latent heat flux over ocean 
     
    363371      !     III    Total FLUXES                                                       ! 
    364372      ! ----------------------------------------------------------------------------- ! 
    365  
    366 !CDIR COLLAPSE 
    367       emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 
    368       qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)         ! Downward Non Solar flux 
    369       emps(:,:) = emp(:,:) 
    370       ! 
     373      zcevap = rcp /  cevap    ! convert zqla ==> evap (Kg/m2/s) ==> m/s ==> W/m2 
     374      zcprec = rcp /  rday     ! convert prec ( mm/day ==> m/s)  ==> W/m2 
     375 
     376!CDIR COLLAPSE 
     377      emp(:,:) = zqla(:,:) / cevap                                        &   ! freshwater flux 
     378         &     - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 
     379      ! 
     380!CDIR COLLAPSE 
     381      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                        &   ! Downward Non Solar flux 
     382         &     - zqla(:,:)             * pst(:,:) * zcevap                &   ! remove evap.   heat content at SST in Celcius 
     383         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius 
     384      ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 
     385 
    371386      CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean 
    372387      CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean 
     
    407422      !! 
    408423      !!  ** Action  :   call albedo_oce/albedo_ice to compute ocean/ice albedo  
    409       !!          computation of snow precipitation 
    410       !!          computation of solar flux at the ocean and ice surfaces 
    411       !!          computation of the long-wave radiation for the ocean and sea/ice 
    412       !!          computation of turbulent heat fluxes over water and ice 
    413       !!          computation of evaporation over water 
    414       !!          computation of total heat fluxes sensitivity over ice (dQ/dT) 
    415       !!          computation of latent heat flux sensitivity over ice (dQla/dT) 
    416       !! 
     424      !!               - snow precipitation 
     425      !!               - solar flux at the ocean and ice surfaces 
     426      !!               - the long-wave radiation for the ocean and sea/ice 
     427      !!               - turbulent heat fluxes over water and ice 
     428      !!               - evaporation over water 
     429      !!               - total heat fluxes sensitivity over ice (dQ/dT) 
     430      !!               - latent heat flux sensitivity over ice (dQla/dT) 
     431      !!               - qns  :  modified the non solar heat flux over the ocean 
     432      !!                         to take into account solid precip latent heat flux 
    417433      !!---------------------------------------------------------------------- 
    418434      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
     
    594610      ! 
    595611      ! ----------------------------------------------------------------------------- ! 
    596       !    Total FLUXES                                                       ! 
     612      !    Total FLUXES                                                               ! 
    597613      ! ----------------------------------------------------------------------------- ! 
    598614      ! 
     
    601617!CDIR COLLAPSE 
    602618      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
     619      ! 
     620      ! ----------------------------------------------------------------------------- ! 
     621      !    Correct the OCEAN non solar flux with the existence of solid precipitation ! 
     622      ! ---------------=====--------------------------------------------------------- ! 
     623!CDIR COLLAPSE 
     624      qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with: 
     625         &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip 
     626         &     + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic &   ! add solid P at least below melting 
     627         &     - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1)                        * rcp      ! remove solid precip. at Tair 
    603628      ! 
    604629!!gm : not necessary as all input data are lbc_lnk... 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3294 r3625  
    5252   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    5353   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    54    INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( - ) 
     54   INTEGER , PARAMETER ::   jp_humi = 3           ! index of specific humidity               ( % ) 
    5555   INTEGER , PARAMETER ::   jp_qsr  = 4           ! index of solar heat                      (W/m2) 
    5656   INTEGER , PARAMETER ::   jp_qlw  = 5           ! index of Long wave                       (W/m2) 
     
    6969   REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant 
    7070   REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice 
    71    REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be contant 
     71   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be constant 
    7272 
    7373   !                                  !!* Namelist namsbc_core : CORE bulk parameters 
     
    9696      !!      the 10m wind velocity (i-component) (m/s)    at T-point 
    9797      !!      the 10m wind velocity (j-component) (m/s)    at T-point 
    98       !!      the specific humidity               ( - ) 
     98      !!      the 10m or 2m specific humidity     ( % ) 
    9999      !!      the solar heat                      (W/m2) 
    100100      !!      the Long wave                       (W/m2) 
    101       !!      the 10m air temperature             (Kelvin) 
     101      !!      the 10m or 2m air temperature       (Kelvin) 
    102102      !!      the total precipitation (rain+snow) (Kg/m2/s) 
    103103      !!      the snow (solid prcipitation)       (kg/m2/s) 
    104       !!   OPTIONAL parameter (see ln_taudif namelist flag): 
    105       !!      the tau diff associated to HF tau   (N/m2)   at T-point  
     104      !!      the tau diff associated to HF tau   (N/m2)   at T-point   (ln_taudif=T) 
    106105      !!              (2) CALL blk_oce_core 
    107106      !! 
    108107      !!      C A U T I O N : never mask the surface stress fields 
    109       !!                      the stress is assumed to be in the mesh referential 
    110       !!                      i.e. the (i,j) referential 
     108      !!                      the stress is assumed to be in the (i,j) mesh referential 
    111109      !! 
    112110      !! ** Action  :   defined at each time-step at the air-sea interface 
    113111      !!              - utau, vtau  i- and j-component of the wind stress 
    114       !!              - taum        wind stress module at T-point 
    115       !!              - wndm        10m wind module at T-point 
    116       !!              - qns, qsr    non-slor and solar heat flux 
    117       !!              - emp, emps   evaporation minus precipitation 
     112      !!              - taum, wndm  wind stress and 10m wind modules at T-point 
     113      !!              - qns, qsr    non-solar and solar heat fluxes 
     114      !!              - emp         upward mass flux (evapo. - precip.) 
     115      !!              - sfx         salt flux due to freezing/melting (non-zero only if ice is present) 
     116      !!                            (set in limsbc(_2).F90) 
    118117      !!---------------------------------------------------------------------- 
    119118      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     
    125124      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core files 
    126125      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i     ! array of namelist informations on the fields to read 
    127       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    128       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
    129       TYPE(FLD_N) ::   sn_tdif                                 !   "                                 " 
     126      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr             ! informations about the fields to be read 
     127      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif   !       -                       - 
    130128      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           & 
    131129         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
     
    181179         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' ) 
    182180         ! 
    183       ENDIF 
    184  
    185       CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step 
    186  
    187       !                                                        ! surface ocean fluxes computed with CLIO bulk formulea 
     181         sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 
     182         ! 
     183      ENDIF 
     184 
     185      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
     186 
     187      !                                            ! compute the surface ocean fluxes using CORE bulk formulea 
    188188      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 
    189189 
     
    221221      !!              - qns     : Non Solar heat flux over the ocean    (W/m2) 
    222222      !!              - evap    : Evaporation over the ocean            (kg/m2/s) 
    223       !!              - emp(s)  : evaporation minus precipitation       (kg/m2/s) 
     223      !!              - emp     : evaporation minus precipitation       (kg/m2/s) 
    224224      !! 
    225225      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
     
    252252      zcoef_qsatw = 0.98 * 640380. / rhoa 
    253253       
    254       zst(:,:) = pst(:,:) + rt0      ! converte Celcius to Kelvin (and set minimum value far above 0 K) 
     254      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
    255255 
    256256      ! ----------------------------------------------------------------------------- ! 
     
    378378      
    379379!CDIR COLLAPSE 
    380       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux 
    381 !CDIR COLLAPSE 
    382       emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 
    383 !CDIR COLLAPSE 
    384       emps(:,:) = emp(:,:) 
     380      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
     381         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
     382!CDIR COLLAPSE 
     383      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                       &   ! Downward Non Solar flux 
     384         &     - sf(jp_snow)%fnow(:,:,1) * lfus                          &   ! remove latent melting heat for solid precip 
     385         &     - zevap(:,:) * pst(:,:) * rcp                             &   ! remove evap heat content at SST 
     386         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) )   &   ! add liquid precip heat content at Tair 
     387         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                 &    
     388         &     + sf(jp_snow)%fnow(:,:,1)                                 &   ! add solid  precip heat content at min(Tair,Tsnow) 
     389         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic  
    385390      ! 
    386391      CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean 
    387392      CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean 
    388393      CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean 
     394      CALL iom_put( "qhc_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
    389395      CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean 
    390396      ! 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r3294 r3625  
    8484      !!              - wndm        10m wind module at T-point 
    8585      !!              - qns, qsr    non-slor and solar heat flux 
    86       !!              - emp, emps   evaporation minus precipitation 
     86      !!              - emp         evaporation minus precipitation 
    8787      !!---------------------------------------------------------------------- 
    8888      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  sh_now   ! specific humidity at T-point  
     
    258258           emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1) 
    259259!CDIR COLLAPSE 
    260            emps(:,:) = emp(:,:) 
    261260 
    262261         CALL iom_put( "qlw_oce",   qbw  )                 ! output downward longwave heat over the ocean 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r3294 r3625  
    664664      !! ** Action  :   update  utau, vtau   ocean stress at U,V grid  
    665665      !!                        taum, wndm   wind stres and wind speed module at T-point 
    666       !!                        qns , qsr    non solar and solar ocean heat fluxes   ('ocean only case) 
    667       !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case) 
     666      !!                        qns          non solar heat fluxes including emp heat content    (ocean only case) 
     667      !!                                     and the latent heat flux of solid precip. melting 
     668      !!                        qsr          solar ocean heat fluxes   (ocean only case) 
     669      !!                        emp          upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 
    668670      !!---------------------------------------------------------------------- 
    669671      INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
     
    777779         ! Stress module can be negative when received (interpolation problem) 
    778780         IF( llnewtau ) THEN  
    779             frcv(jpr_taum)%z3(:,:,1) = MAX( 0.0e0, frcv(jpr_taum)%z3(:,:,1) ) 
     781            frcv(jpr_taum)%z3(:,:,1) = MAX( 0._wp, frcv(jpr_taum)%z3(:,:,1) ) 
    780782         ENDIF 
    781783      ENDIF 
     
    821823         !                                                   ! ========================= ! 
    822824         ! 
    823          !                                                       ! non solar heat flux over the ocean (qns) 
    824          IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
    825          IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    826          ! add the latent heat of solid precip. melting 
    827          IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus               
    828  
    829          !                                                       ! solar flux over the ocean          (qsr) 
    830          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
    831          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
    832          IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
    833          ! 
    834          !                                                       ! total freshwater fluxes over the ocean (emp, emps) 
     825         !                                                       ! total freshwater fluxes over the ocean (emp) 
    835826         SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation 
    836827         CASE( 'conservative' ) 
     
    863854!!gm  end of internal cooking 
    864855         ! 
    865          emps(:,:) = emp(:,:)                                        ! concentration/dilution = emp 
     856         !                                                       ! non solar heat flux over the ocean (qns) 
     857         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     858         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     859         ! add the latent heat of solid precip. melting 
     860         IF( srcv(jpr_snow  )%laction )   THEN                         ! update qns over the free ocean with: 
     861              qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus  & ! energy for melting solid precipitation over the free ocean 
     862           &           - emp(:,:) * sst_m(:,:) * rcp                   ! remove heat content due to mass flux (assumed to be at SST) 
     863         ENDIF 
     864 
     865         !                                                       ! solar flux over the ocean          (qsr) 
     866         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 
     867         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 
     868         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle 
     869         ! 
    866870   
    867871      ENDIF 
     
    11411145 
    11421146      zicefr(:,:) = 1.- p_frld(:,:) 
    1143       IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 
     1147      zcptn(:,:) = rcp * sst_m(:,:) 
    11441148      ! 
    11451149      !                                                      ! ========================= ! 
     
    12331237            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    12341238      END SELECT 
    1235       ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus               ! add the latent heat of solid precip. melting 
    1236       qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)                     ! over free ocean  
     1239      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus 
     1240      qns_tot(:,:) = qns_tot(:,:)                         &            ! qns_tot update over free ocean with: 
     1241         &          - ztmp(:,:)                           &            ! remove the latent heat flux of solid precip. melting 
     1242         &          - (  emp_tot(:,:)                     &            ! remove the heat content of mass flux (assumed to be at SST) 
     1243         &             - emp_ice(:,:) * zicefr(:,:)  ) * zcptn(:,:)  
    12371244      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    12381245!!gm 
     
    12541261      !                                                      ! ========================= ! 
    12551262      CASE( 'oce only' ) 
    1256          qsr_tot(:,:  ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 
     1263         qsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
    12571264      CASE( 'conservative' ) 
    12581265         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     
    13571364            ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    13581365         CASE( 'no' ) 
    1359             ztmp3(:,:,:) = 0.0 
     1366            ztmp3(:,:,:) = 0._wp 
    13601367            DO jl=1,jpl 
    13611368               ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 
     
    14091416            ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
    14101417         CASE( 'no' ) 
    1411             ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0 
     1418            ztmp3(:,:,:) = 0._wp   ;  ztmp4(:,:,:) = 0._wp 
    14121419            DO jl=1,jpl 
    14131420               ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r2715 r3625  
    6161      !! 
    6262      !!      CAUTION :  - never mask the surface stress fields 
    63       !!                 - the stress is assumed to be in the mesh referential 
    64       !!                   i.e. the (i,j) referential 
     63      !!                 - the stress is assumed to be in the (i,j) mesh referential 
    6564      !! 
    6665      !! ** Action  :   update at each time-step 
     
    6867      !!              - taum        wind stress module at T-point 
    6968      !!              - wndm        10m wind module at T-point 
    70       !!              - qns, qsr    non-slor and solar heat flux 
    71       !!              - emp, emps   evaporation minus precipitation 
     69      !!              - qns         non solar heat flux including heat flux due to emp 
     70      !!              - qsr         solar heat flux 
     71      !!              - emp         upward mass flux (evap. - precip.) 
     72      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero 
     73      !!                            if ice is present (computed in limsbc(_2).F90) 
    7274      !!---------------------------------------------------------------------- 
    7375      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     
    121123         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 
    122124         ! 
     125         sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90) 
     126         ! 
    123127      ENDIF 
    124128 
     
    139143            END DO 
    140144         END DO 
     145         !                                                        ! add to qns the heat due to e-p 
     146         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
     147         ! 
    141148         !                                                        ! module of wind stress and wind speed at T-point 
    142149         zcoef = 1. / ( zrhoa * zcdrag ) 
     
    154161         CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
    155162 
    156          emps(:,:) = emp (:,:)                                    ! Initialization of emps (needed when no ice model) 
    157                    
    158163         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
    159164            WRITE(numout,*)  
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r3294 r3625  
    5959      !!                =3 global mean of emp set to zero at each nn_fsbc time step 
    6060      !!                   & spread out over erp area depending its sign 
     61      !! Note: if sea ice is embedded it is taken into account when computing the budget  
    6162      !!---------------------------------------------------------------------- 
    6263      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
     
    6465      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index 
    6566      ! 
    66       INTEGER  ::   inum, ikty, iyear   ! local integers 
    67       REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp   ! local scalars 
    68       REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread    !   -      - 
    69       REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, zerp_cor 
     67      INTEGER  ::   inum, ikty, iyear     ! local integers 
     68      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars 
     69      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      - 
     70      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces 
     71      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      - 
    7072      !!---------------------------------------------------------------------- 
    7173      ! 
     
    8789         ! 
    8890         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
     91         ! 
     92#if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice  
     93         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass 
     94         snwice_mass  (:,:) = 0.e0 
     95#endif 
     96         ! 
    8997      ENDIF 
    9098       
     
    95103         ! 
    96104         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
    97             z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain 
    98             emp (:,:) = emp (:,:) - z_fwf  
    99             emps(:,:) = emps(:,:) - z_fwf  
     105            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) -  snwice_fmass(:,:) ) ) / area   ! sum over the global domain 
     106            zcoef = z_fwf * rcp 
     107            emp(:,:) = emp(:,:) - z_fwf  
     108            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
    100109         ENDIF 
    101110         ! 
    102111      CASE ( 2 )                             !==  fwf budget adjusted from the previous year  ==! 
    103112         ! 
    104          IF( kt == nit000 ) THEN                   ! initialisation 
     113         IF( kt == nit000 ) THEN                      ! initialisation 
    105114            !                                         ! Read the corrective factor on precipitations (fwfold) 
    106115            CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     
    117126         ikty = 365 * 86400 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!! 
    118127         IF( MOD( kt, ikty ) == 0 ) THEN 
    119             a_fwb_b = a_fwb 
    120             a_fwb   = glob_sum( e1e2t(:,:) * sshn(:,:) )   ! sum over the global domain 
     128            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow 
     129                                                      ! sum over the global domain 
     130            a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 
    121131            a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s 
    122132!!gm        !                                                      !!bug 365d year  
     
    125135         ENDIF 
    126136         !  
    127          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN      ! correct the freshwater fluxes 
    128             emp (:,:) = emp (:,:) + fwfold 
    129             emps(:,:) = emps(:,:) + fwfold 
    130          ENDIF 
    131          ! 
    132          IF( kt == nitend .AND. lwp ) THEN         ! save fwfold value in a file 
     137         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! correct the freshwater fluxes 
     138            zcoef = fwfold * rcp 
     139            emp(:,:) = emp(:,:) + fwfold 
     140            qns(:,:) = qns(:,:) - zcoef * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
     141         ENDIF 
     142         ! 
     143         IF( kt == nitend .AND. lwp ) THEN            ! save fwfold value in a file 
    133144            CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    134145            WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb 
     
    143154            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 
    144155            ! 
    145             zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )   ! Area filled by <0 and >0 erp  
     156            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp  
    146157            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 
    147             !                                                  ! fwf global mean  
    148             z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area 
     158            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)  
     159            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area 
    149160            !             
    150161            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation 
     
    160171            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall ) 
    161172            !                                                  ! weight to respect erp field 2D structure  
    162             zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
     173            zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
    163174            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
    164175            !                                                  ! final correction term to apply 
     
    168179            CALL lbc_lnk( zerp_cor, 'T', 1. ) 
    169180            ! 
    170             emp (:,:) = emp (:,:) + zerp_cor(:,:) 
    171             emps(:,:) = emps(:,:) + zerp_cor(:,:) 
    172             erp (:,:) = erp (:,:) + zerp_cor(:,:) 
     181            emp(:,:) = emp(:,:) + zerp_cor(:,:) 
     182            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
     183            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
    173184            ! 
    174185            IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r3294 r3625  
    1515   USE dom_oce         ! ocean space and time domain 
    1616   USE domvvl 
    17    USE phycst, only : rcp, rau0 
     17   USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 
    1818   USE in_out_manager  ! I/O manager 
    1919   USE lib_mpp         ! distributed memory computing library 
     
    3737   USE ice_gather_scatter 
    3838   USE ice_calendar, only: dt 
    39    USE ice_state, only: aice,aicen,uvel,vvel,vsnon,vicen 
     39   USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 
    4040   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  & 
    4141                sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm,     & 
     
    5959   PUBLIC cice_sbc_final  ! routine called by sbc_final 
    6060   PUBLIC sbc_ice_cice    ! routine called by sbc 
     61 
     62   INTEGER , PARAMETER ::   ji_off = INT ( (jpiglo - nx_global) / 2 ) 
     63   INTEGER , PARAMETER ::   jj_off = INT ( (jpjglo - ny_global) / 2 ) 
    6164 
    6265   INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read  
     
    107110      !! ** Action  : - time evolution of the CICE sea-ice model 
    108111      !!              - update all sbc variables below sea-ice: 
    109       !!                utau, vtau, qns , qsr, emp , emps 
     112      !!                utau, vtau, qns , qsr, emp , sfx 
    110113      !!--------------------------------------------------------------------- 
    111114      INTEGER, INTENT(in) ::   kt      ! ocean time step 
     
    143146      !! ** Purpose: Initialise ice related fields for NEMO and coupling 
    144147      !! 
    145       INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
    146       !!--------------------------------------------------------------------- 
    147  
    148       INTEGER  ::   ji, jj, jpl                        ! dummy loop indices 
     148      INTEGER, INTENT( in  ) ::   nsbc                ! surface forcing type 
     149      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
     150      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
     151      INTEGER  ::   ji, jj, jl                        ! dummy loop indices 
     152      !!--------------------------------------------------------------------- 
    149153 
    150154      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_init') 
     155      ! 
     156      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 
    151157      ! 
    152158      IF(lwp) WRITE(numout,*)'cice_sbc_init' 
     
    182188      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    183189      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
    184          DO jpl=1,ncat 
    185             CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. ) 
     190         DO jl=1,ncat 
     191            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    186192         ENDDO 
    187193      ENDIF 
     
    198204      CALL lbc_lnk ( fr_iu , 'U', 1. ) 
    199205      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
     206 
     207      !                                      ! embedded sea ice 
     208      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     209         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
     210         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     211         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     212         snwice_mass_b(:,:) = snwice_mass(:,:) 
     213      ELSE 
     214         snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
     215         snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     216      ENDIF 
     217      IF( nn_ice_embd == 2 .AND.          &  ! full embedment (case 2) & no restart :  
     218         &   .NOT.ln_rstart ) THEN           ! deplete the initial ssh belew sea-ice area 
     219         sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
     220         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     221         ! 
     222         ! Note: Changed the initial values of sshb and sshn=>  need to recompute ssh[u,v,f]_[b,n]  
     223         !       which were previously set in domvvl 
     224         IF ( lk_vvl ) THEN            ! Is this necessary? embd 2 should be restricted to vvl only??? 
     225            DO jj = 1, jpjm1 
     226               DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible 
     227                  zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
     228                  zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
     229                  zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
     230                  sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
     231                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 
     232                  sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
     233                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 
     234                  sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
     235                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 
     236                  sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
     237                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 
     238               END DO 
     239            END DO 
     240            CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. ) 
     241            CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. ) 
     242            DO jj = 1, jpjm1 
     243               DO ji = 1, jpim1      ! NO Vector Opt. 
     244                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
     245                       &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
     246                       &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
     247                       &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
     248               END DO 
     249            END DO 
     250            CALL lbc_lnk( sshf_n, 'F', 1. ) 
     251          ENDIF 
     252      ENDIF 
     253  
     254      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    200255      ! 
    201256      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init') 
     
    212267      INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type 
    213268 
    214       INTEGER  ::   ji, jj, jpl                   ! dummy loop indices       
    215       REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
     269      INTEGER  ::   ji, jj, jl                   ! dummy loop indices       
     270      REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice 
    216271      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 
     272      REAL(wp) ::   zintb, zintn  ! dummy argument 
    217273      !!--------------------------------------------------------------------- 
    218274 
    219275      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_in') 
    220276      ! 
    221       CALL wrk_alloc( jpi,jpj, ztmp ) 
     277      CALL wrk_alloc( jpi,jpj, ztmp, zpice ) 
    222278      CALL wrk_alloc( jpi,jpj,ncat, ztmpn ) 
    223279 
     
    259315! Surface downward latent heat flux (CI_5) 
    260316         IF (nsbc == 2) THEN 
    261             DO jpl=1,ncat 
    262                ztmpn(:,:,jpl)=qla_ice(:,:,1)*a_i(:,:,jpl) 
     317            DO jl=1,ncat 
     318               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    263319            ENDDO 
    264320         ELSE 
     
    269325               DO ji=1,jpi 
    270326                  IF (fr_i(ji,jj).eq.0.0) THEN 
    271                      DO jpl=1,ncat 
    272                         ztmpn(ji,jj,jpl)=0.0 
     327                     DO jl=1,ncat 
     328                        ztmpn(ji,jj,jl)=0.0 
    273329                     ENDDO 
    274330                     ! This will then be conserved in CICE 
    275331                     ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 
    276332                  ELSE 
    277                      DO jpl=1,ncat 
    278                         ztmpn(ji,jj,jpl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj) 
     333                     DO jl=1,ncat 
     334                        ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 
    279335                     ENDDO 
    280336                  ENDIF 
     
    282338            ENDDO 
    283339         ENDIF 
    284          DO jpl=1,ncat 
    285             CALL nemo2cice(ztmpn(:,:,jpl),flatn_f(:,:,jpl,:),'T', 1. ) 
     340         DO jl=1,ncat 
     341            CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 
    286342 
    287343! GBM conductive flux through ice (CI_6) 
    288344!  Convert to GBM 
    289345            IF (nsbc == 2) THEN 
    290                ztmp(:,:) = botmelt(:,:,jpl)*a_i(:,:,jpl) 
     346               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    291347            ELSE 
    292                ztmp(:,:) = botmelt(:,:,jpl) 
     348               ztmp(:,:) = botmelt(:,:,jl) 
    293349            ENDIF 
    294             CALL nemo2cice(ztmp,fcondtopn_f(:,:,jpl,:),'T', 1. ) 
     350            CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. ) 
    295351 
    296352! GBM surface heat flux (CI_7) 
    297353!  Convert to GBM 
    298354            IF (nsbc == 2) THEN 
    299                ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))*a_i(:,:,jpl)  
     355               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    300356            ELSE 
    301                ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl)) 
     357               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl)) 
    302358            ENDIF 
    303             CALL nemo2cice(ztmp,fsurfn_f(:,:,jpl,:),'T', 1. ) 
     359            CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. ) 
    304360         ENDDO 
    305361 
     
    383439      CALL nemo2cice(ztmp,vocn,'F', -1. ) 
    384440 
     441      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
     442          ! 
     443          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     444          !                                               = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1} 
     445         zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     446          ! 
     447          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1} 
     448          !                                               = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1}) 
     449         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
     450          ! 
     451         zpice(:,:) = ssh_m(:,:) + (  zintn * snwice_mass(:,:) +  zintb * snwice_mass_b(:,:)  ) * r1_rau0 
     452          ! 
     453         ! 
     454      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
     455         zpice(:,:) = ssh_m(:,:) 
     456      ENDIF 
     457 
    385458! x comp and y comp of sea surface slope (on F points) 
    386459! T point to F point 
    387460      DO jj=1,jpjm1 
    388461         DO ji=1,jpim1 
    389             ztmp(ji,jj)=0.5 * (  (ssh_m(ji+1,jj  )-ssh_m(ji,jj  ))/e1u(ji,jj  )   & 
    390                                + (ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) &  
     462            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   & 
     463                               + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) &  
    391464                            *  fmask(ji,jj,1) 
    392465         ENDDO 
     
    397470      DO jj=1,jpjm1 
    398471         DO ji=1,jpim1 
    399             ztmp(ji,jj)=0.5 * (  (ssh_m(ji  ,jj+1)-ssh_m(ji  ,jj))/e2v(ji  ,jj)   & 
    400                                + (ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) & 
     472            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   & 
     473                               + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 
    401474                            *  fmask(ji,jj,1) 
    402475         ENDDO 
     
    420493      INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type 
    421494       
    422       INTEGER  ::   ji, jj, jpl                 ! dummy loop indices 
    423       REAL(wp), DIMENSION(:,:), POINTER :: ztmp 
     495      INTEGER  ::   ji, jj, jl                 ! dummy loop indices 
     496      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
    424497      !!--------------------------------------------------------------------- 
    425498 
    426499      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_out') 
    427500      ! 
    428       CALL wrk_alloc( jpi,jpj, ztmp ) 
     501      CALL wrk_alloc( jpi,jpj, ztmp1, ztmp2 ) 
    429502       
    430503      IF( kt == nit000 )  THEN 
     
    433506       
    434507! x comp of ocean-ice stress  
    435       CALL cice2nemo(strocnx,ztmp,'F', -1. ) 
     508      CALL cice2nemo(strocnx,ztmp1,'F', -1. ) 
    436509      ss_iou(:,:)=0.0 
    437510! F point to U point 
    438511      DO jj=2,jpjm1 
    439512         DO ji=2,jpim1 
    440             ss_iou(ji,jj) = 0.5 * ( ztmp(ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1) 
     513            ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 
    441514         ENDDO 
    442515      ENDDO 
     
    444517 
    445518! y comp of ocean-ice stress  
    446       CALL cice2nemo(strocny,ztmp,'F', -1. ) 
     519      CALL cice2nemo(strocny,ztmp1,'F', -1. ) 
    447520      ss_iov(:,:)=0.0 
    448521! F point to V point 
     
    450523      DO jj=1,jpjm1 
    451524         DO ji=2,jpim1 
    452             ss_iov(ji,jj) = 0.5 * ( ztmp(ji-1,jj) + ztmp(ji,jj) ) * vmask(ji,jj,1) 
     525            ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 
    453526         ENDDO 
    454527      ENDDO 
     
    473546         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    474547      ELSE IF (nsbc ==5) THEN 
    475 ! emp_tot is set in sbc_cpl_ice_flx (call from cice_sbc_in above)  
     548! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
     549! This is currently as required with the coupling fields from the UM atmosphere 
    476550         emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:)  
    477551      ENDIF 
    478552 
    479 ! Subtract fluxes from CICE to get freshwater equivalent flux used in  
    480 ! salinity calculation 
    481       CALL cice2nemo(fresh_gbm,ztmp,'T', 1. ) 
    482       emps(:,:)=emp(:,:)-ztmp(:,:) 
    483 ! Note the 1000.0 is to convert from kg salt to g salt (needed for PSU) 
    484       CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. ) 
    485       DO jj=1,jpj 
    486          DO ji=1,jpi 
    487             IF (sss_m(ji,jj).gt.0.0) THEN 
    488                emps(ji,jj)=emps(ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj) 
    489             ENDIF 
    490          ENDDO 
    491       ENDDO 
    492  
    493 ! No longer remove precip over ice from free surface calculation on basis that the 
    494 ! weight of the precip will affect the free surface even if it falls on the ice 
    495 ! (same to the argument that freezing / melting of ice doesn't change the free surface)  
    496 ! Sublimation from the ice is treated in a similar way (included in emp but not emps)   
    497 ! 
    498 ! This should not be done in the variable volume case 
    499  
    500       IF (.NOT. lk_vvl) THEN 
    501  
    502          emp(:,:)  = emp(:,:) - tprecip(:,:)*fr_i(:,:) 
    503  
    504 ! Take sublimation into account 
    505          IF (nsbc == 5 ) THEN  
    506             emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) ) 
    507          ELSE IF (nsbc == 2 ) THEN 
    508             emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub 
    509          ENDIF 
    510  
    511       ENDIF 
    512  
     553      CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 
     554      CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 
     555 
     556! Check to avoid unphysical expression when ice is forming (ztmp1 negative) 
     557! Otherwise we are effectively allowing ice of higher salinity than the ocean to form 
     558! which has to be compensated for by the ocean salinity potentially going negative 
     559! This check breaks conservation but seems reasonable until we have prognostic ice salinity 
     560! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU) 
     561      WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0) 
     562      sfx(:,:)=ztmp2(:,:)*1000.0 
     563      emp(:,:)=emp(:,:)-ztmp1(:,:) 
     564  
    513565      CALL lbc_lnk( emp , 'T', 1. ) 
    514       CALL lbc_lnk( emps , 'T', 1. ) 
     566      CALL lbc_lnk( sfx , 'T', 1. ) 
    515567 
    516568! Solar penetrative radiation and non solar surface heat flux 
     
    532584! Now add in ice / snow related terms 
    533585! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 
    534       CALL cice2nemo(fswthru_gbm,ztmp,'T', 1. ) 
    535       qsr(:,:)=qsr(:,:)+ztmp(:,:) 
     586      CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 
     587      qsr(:,:)=qsr(:,:)+ztmp1(:,:) 
    536588      CALL lbc_lnk( qsr , 'T', 1. ) 
    537589 
     
    542594      ENDDO 
    543595 
    544       CALL cice2nemo(fhocn_gbm,ztmp,'T', 1. ) 
    545       qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp(:,:) 
     596      CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 
     597      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 
    546598 
    547599      CALL lbc_lnk( qns , 'T', 1. ) 
     
    551603      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    552604      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN 
    553          DO jpl=1,ncat 
    554             CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), 'T', 1. ) 
     605         DO jl=1,ncat 
     606            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    555607         ENDDO 
    556608      ENDIF 
     
    568620      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
    569621 
     622      !                                      ! embedded sea ice 
     623      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     624         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
     625         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     626         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     627         snwice_mass_b(:,:) = snwice_mass(:,:) 
     628         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 
     629      ENDIF 
     630 
    570631! Release work space 
    571632 
    572       CALL wrk_dealloc( jpi,jpj, ztmp ) 
     633      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    573634      ! 
    574635      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_out') 
     
    587648      !!--------------------------------------------------------------------- 
    588649 
    589       INTEGER  ::   jpl                        ! dummy loop index 
     650      INTEGER  ::   jl                        ! dummy loop index 
    590651      INTEGER  ::   ierror 
    591652 
     
    610671! Snow and ice thicknesses (CO_2 and CO_3) 
    611672 
    612       DO jpl = 1,ncat 
    613          CALL cice2nemo(vsnon(:,:,jpl,:),ht_s(:,:,jpl),'T', 1. ) 
    614          CALL cice2nemo(vicen(:,:,jpl,:),ht_i(:,:,jpl),'T', 1. ) 
     673      DO jl = 1,ncat 
     674         CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 
     675         CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 
    615676      ENDDO 
    616677      ! 
     
    780841      REAL(wp), DIMENSION(jpi,jpj) :: pn 
    781842#if !defined key_nemocice_decomp 
     843      REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 
    782844      REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 
    783845#endif 
     
    798860      ! Copy local domain data from NEMO to CICE field 
    799861      pc(:,:,1)=0.0 
    800       DO jj=2,ny_block 
    801          DO ji=2,nx_block 
    802             pc(ji,jj,1)=pn(ji,jj-1) 
     862      DO jj=2,ny_block-1 
     863         DO ji=2,nx_block-1 
     864            pc(ji,jj,1)=pn(ji-1+ji_off,jj-1+jj_off) 
    803865         ENDDO 
    804866      ENDDO 
     
    824886!        pcg(:,:)=0.0 
    825887         DO jn=1,jpnij 
    826             DO jj=1,nlcjt(jn)-1 
    827                DO ji=2,nlcit(jn)-1 
    828                   pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn)        
     888            DO jj=nldjt(jn),nlejt(jn) 
     889               DO ji=nldit(jn),nleit(jn) 
     890                  png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 
    829891               ENDDO 
     892            ENDDO 
     893         ENDDO 
     894         DO jj=1,ny_global 
     895            DO ji=1,nx_global 
     896               pcg(ji,jj)=png2(ji+ji_off,jj+jj_off) 
    830897            ENDDO 
    831898         ENDDO 
     
    922989      DO jj=1,jpjm1 
    923990         DO ji=1,jpim1 
    924             pn(ji,jj)=pc(ji,jj+1,1) 
     991            pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 
    925992         ENDDO 
    926993      ENDDO 
     
    9361003! Need to make sure this is robust to changes in NEMO halo rows.... 
    9371004! (may be OK but not spent much time thinking about it) 
     1005! Note that non-existent pcg elements may be used below, but 
     1006! the lbclnk call on pn will replace these with sensible values 
    9381007 
    9391008      IF (nproc==0) THEN 
    9401009         png(:,:,:)=0.0 
    9411010         DO jn=1,jpnij 
    942             DO jj=1,nlcjt(jn)-1 
    943                DO ji=2,nlcit(jn)-1 
    944                   png(ji,jj,jn)=pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)       
     1011            DO jj=nldjt(jn),nlejt(jn) 
     1012               DO ji=nldit(jn),nleit(jn) 
     1013                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 
    9451014               ENDDO 
    9461015            ENDDO 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r3294 r3625  
    55   !!                   covered area using ice-if model 
    66   !!====================================================================== 
    7    !! History :  3.0   !  2006-06  (G. Madec)  Original code 
     7   !! History :  3.0  !  2006-06  (G. Madec)  Original code 
    88   !!---------------------------------------------------------------------- 
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   sbc_ice_if     : update sbc in ice-covered area 
     11   !!   sbc_ice_if    : update sbc in ice-covered area 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers 
    14    USE dom_oce         ! ocean space and time domain 
    15    USE phycst          ! physical constants 
    16    USE eosbn2          ! equation of state 
    17    USE sbc_oce         ! surface boundary condition: ocean fields 
     13   USE oce            ! ocean dynamics and tracers 
     14   USE dom_oce        ! ocean space and time domain 
     15   USE phycst         ! physical constants 
     16   USE eosbn2         ! equation of state 
     17   USE sbc_oce        ! surface boundary condition: ocean fields 
    1818   USE sbccpl 
    19    USE fldread         ! read input field 
    20    USE iom             ! I/O manager library 
    21    USE in_out_manager  ! I/O manager 
    22    USE lib_mpp         ! MPP library 
     19   USE fldread        ! read input field 
     20   USE iom            ! I/O manager library 
     21   USE in_out_manager ! I/O manager 
     22   USE lib_mpp        ! MPP library 
     23   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2324 
    2425   IMPLICIT NONE 
     
    5152      !!                taum, wndm : remain unchanged 
    5253      !!                qns, qsr   : update heat flux below sea-ice 
    53       !!                emp, emps  : update freshwater flux below sea-ice 
     54      !!                emp, sfx   : update freshwater flux below sea-ice 
    5455      !!                fr_i       : update the ice fraction 
    5556      !!--------------------------------------------------------------------- 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r3294 r3625  
    1010   !!             -   ! 2008-04  (G. Madec)  sltyle and lim_ctl routine 
    1111   !!            3.3  ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step 
    12    !!            4.0  ! 2011-01  (A Porter)  dynamical allocation 
     12   !!            3.4  ! 2011-01  (A Porter)  dynamical allocation 
    1313   !!---------------------------------------------------------------------- 
    1414#if defined key_lim3 
     
    8888      !! ** Action  : - time evolution of the LIM sea-ice model 
    8989      !!              - update all sbc variables below sea-ice: 
    90       !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
     90      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx  
    9191      !!--------------------------------------------------------------------- 
    9292      INTEGER, INTENT(in) ::   kt      ! ocean time step 
     
    170170 
    171171         !                                           ! intialisation to zero    !!gm is it truly necessary ??? 
    172          d_a_i_thd  (:,:,:)   = 0.e0   ;   d_a_i_trp  (:,:,:)   = 0.e0 
    173          d_v_i_thd  (:,:,:)   = 0.e0   ;   d_v_i_trp  (:,:,:)   = 0.e0 
    174          d_e_i_thd  (:,:,:,:) = 0.e0   ;   d_e_i_trp  (:,:,:,:) = 0.e0 
    175          d_v_s_thd  (:,:,:)   = 0.e0   ;   d_v_s_trp  (:,:,:)   = 0.e0 
    176          d_e_s_thd  (:,:,:,:) = 0.e0   ;   d_e_s_trp  (:,:,:,:) = 0.e0 
    177          d_smv_i_thd(:,:,:)   = 0.e0   ;   d_smv_i_trp(:,:,:)   = 0.e0 
    178          d_oa_i_thd (:,:,:)   = 0.e0   ;   d_oa_i_trp (:,:,:)   = 0.e0 
    179          ! 
    180          fseqv    (:,:) = 0.e0 
    181          fsbri    (:,:) = 0.e0     ;   fsalt_res(:,:) = 0.e0 
    182          fsalt_rpo(:,:) = 0.e0 
    183          fhmec    (:,:) = 0.e0     ;   fhbri    (:,:) = 0.e0 
    184          fmmec    (:,:) = 0.e0     ;   fheat_res(:,:) = 0.e0 
    185          fheat_rpo(:,:) = 0.e0     ;   focea2D  (:,:) = 0.e0 
    186          fsup2D   (:,:) = 0.e0 
     172         d_a_i_thd  (:,:,:)   = 0._wp   ;   d_a_i_trp  (:,:,:)   = 0._wp 
     173         d_v_i_thd  (:,:,:)   = 0._wp   ;   d_v_i_trp  (:,:,:)   = 0._wp 
     174         d_e_i_thd  (:,:,:,:) = 0._wp   ;   d_e_i_trp  (:,:,:,:) = 0._wp 
     175         d_v_s_thd  (:,:,:)   = 0._wp   ;   d_v_s_trp  (:,:,:)   = 0._wp 
     176         d_e_s_thd  (:,:,:,:) = 0._wp   ;   d_e_s_trp  (:,:,:,:) = 0._wp 
     177         d_smv_i_thd(:,:,:)   = 0._wp   ;   d_smv_i_trp(:,:,:)   = 0._wp 
     178         d_oa_i_thd (:,:,:)   = 0._wp   ;   d_oa_i_trp (:,:,:)   = 0._wp 
     179         ! 
     180         sfx    (:,:) = 0._wp 
     181         sfx_bri(:,:) = 0._wp   ;   sfx_mec  (:,:) = 0._wp   ;   sfx_res  (:,:) = 0._wp 
     182         fhbri  (:,:) = 0._wp   ;   fheat_mec(:,:) = 0._wp   ;   fheat_res(:,:) = 0._wp 
     183         fhmec  (:,:) = 0._wp   ;    
     184         fmmec  (:,:) = 0._wp      
     185         focea2D(:,:) = 0._wp 
     186         fsup2D (:,:) = 0._wp 
    187187         !  
    188          diag_sni_gr(:,:) = 0.e0   ;   diag_lat_gr(:,:) = 0.e0 
    189          diag_bot_gr(:,:) = 0.e0   ;   diag_dyn_gr(:,:) = 0.e0 
    190          diag_bot_me(:,:) = 0.e0   ;   diag_sur_me(:,:) = 0.e0 
     188         diag_sni_gr(:,:) = 0._wp   ;   diag_lat_gr(:,:) = 0._wp 
     189         diag_bot_gr(:,:) = 0._wp   ;   diag_dyn_gr(:,:) = 0._wp 
     190         diag_bot_me(:,:) = 0._wp   ;   diag_sur_me(:,:) = 0._wp 
    191191         ! dynamical invariants 
    192          delta_i(:,:) = 0.e0       ;   divu_i(:,:) = 0.e0       ;   shear_i(:,:) = 0.e0 
     192         delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp 
    193193 
    194194                          CALL lim_rst_opn( kt )     ! Open Ice restart file 
     
    196196         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print 
    197197         ! 
    198          IF( .NOT. lk_c1d ) THEN 
    199                                                      ! Ice dynamics & transport (not in 1D case) 
     198         IF( .NOT. lk_c1d ) THEN                     ! Ice dynamics & transport (except in 1D case) 
    200199                          CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
    201200                          CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
     
    210209                          CALL lim_var_bv                 ! bulk brine volume (diag) 
    211210                          CALL lim_thd( kt )              ! Ice thermodynamics  
    212                           zcoef = rdt_ice / 86400.e0      !  Ice natural aging 
     211                          zcoef = rdt_ice /rday           !  Ice natural aging 
    213212                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 
    214213                          CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin) 
     
    268267 
    269268      inb_altests = 10 
    270       inb_alp(:)  = 0 
     269      inb_alp(:)  =  0 
    271270 
    272271      ! Alert if incompatible volume and concentration 
     
    277276         DO jj = 1, jpj 
    278277            DO ji = 1, jpi 
    279                IF(  v_i(ji,jj,jl) /= 0.e0   .AND.   a_i(ji,jj,jl) == 0.e0   ) THEN 
     278               IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN 
    280279                  WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    281280                  WRITE(numout,*) ' at_i     ', at_i(ji,jj) 
     
    297296      DO jj = 1, jpj 
    298297         DO ji = 1, jpi 
    299             IF(   ht_i(ji,jj,jl) .GT. 50.0   ) THEN 
     298            IF(   ht_i(ji,jj,jl)  >  50._wp   ) THEN 
    300299               CALL lim_prt_state( ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
    301300               inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     
    309308      DO jj = 1, jpj 
    310309         DO ji = 1, jpi 
    311             IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) .GT. 0.5  .AND.  & 
    312                &  at_i(ji,jj) .GT. 0.e0   ) THEN 
     310            IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 0.5  .AND.  & 
     311               &  at_i(ji,jj) > 0._wp   ) THEN 
    313312               CALL lim_prt_state( ji, jj, 1, ' ALERTE 4 :   Very fast ice ' ) 
    314313               WRITE(numout,*) ' ice strength             : ', strength(ji,jj) 
     
    332331      DO jj = 1, jpj 
    333332         DO ji = 1, jpi 
    334             IF(   tms(ji,jj) .LE. 0.0   .AND.   at_i(ji,jj) .GT. 0.e0   ) THEN  
     333            IF(   tms(ji,jj) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN  
    335334               CALL lim_prt_state( ji, jj, 1, ' ALERTE 6 :   Ice on continents ' ) 
    336335               WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj)  
     
    356355            DO ji = 1, jpi 
    357356!!gm  test twice sm_i ...  ????  bug? 
    358                IF( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR. & 
    359                      ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. & 
    360                              ( a_i(ji,jj,jl) .GT. 0.e0 ) ) THEN 
     357               IF( ( ( ABS( sm_i(ji,jj,jl) ) < 0.5 )   .OR. & 
     358                     ( ABS( sm_i(ji,jj,jl) ) < 0.5 ) ) .AND. & 
     359                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
    361360!                 CALL lim_prt_state(ji,jj,1, ' ALERTE 7 :   Very fresh ice ' ) 
    362361!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
     
    377376         DO jj = 1, jpj 
    378377            DO ji = 1, jpi 
    379                IF ( ( ( ABS( o_i(ji,jj,jl) ) .GT. rdt_ice ) .OR. & 
    380                       ( ABS( o_i(ji,jj,jl) ) .LT. 0.00) ) .AND. & 
    381                              ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
     378               IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 
     379                      ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 
     380                             ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
    382381                  CALL lim_prt_state( ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
    383382                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     
    392391      DO jj = 1, jpj 
    393392         DO ji = 1, jpi 
    394             IF( ABS( emps(ji,jj) ) .GT. 1.0e-2 ) THEN 
     393            IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN 
    395394               CALL lim_prt_state( ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    396395               DO jl = 1, jpl 
     
    412411      DO jj = 1, jpj 
    413412         DO ji = 1, jpi 
    414             IF(   ABS( qns(ji,jj) ) .GT. 1500.0   .AND.  ( at_i(ji,jj) .GT. 0.0 ) )  THEN 
     413            IF(   ABS( qns(ji,jj) ) > 1500._wp  .AND.  at_i(ji,jj) > 0._wp )  THEN 
    415414               ! 
    416415               WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
     
    429428               WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)  
    430429               WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj)  
    431                WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(ji,jj)  
     430               WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)  
    432431               WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)  
    433432               WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj)  
     
    450449               DO ji = 1, jpi 
    451450                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rtt 
    452                   IF( t_i(ji,jj,jk,jl) .GE. ztmelts  .AND.  v_i(ji,jj,jl) .GT. 1.e-6   & 
    453                      &                               .AND.  a_i(ji,jj,jl) .GT. 0.e0    ) THEN 
     451                  IF( t_i(ji,jj,jk,jl) >= ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-6   & 
     452                     &                             .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
    454453                     WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
    455454                     WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl 
     
    606605        WRITE(numout,*) ' - Heat / FW fluxes ' 
    607606        WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ ' 
    608 !       WRITE(numout,*) ' fsbri      : ', fsbri(ki,kj) 
    609 !       WRITE(numout,*) ' fseqv      : ', fseqv(ki,kj) 
     607!       WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ki,kj) 
     608!       WRITE(numout,*) ' sfx        : ', sfx      (ki,kj) 
    610609!       WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj) 
    611         WRITE(numout,*) ' fmmec      : ', fmmec(ki,kj) 
    612         WRITE(numout,*) ' fhmec      : ', fhmec(ki,kj) 
    613         WRITE(numout,*) ' fhbri      : ', fhbri(ki,kj) 
    614         WRITE(numout,*) ' fheat_rpo  : ', fheat_rpo(ki,kj) 
     610        WRITE(numout,*) ' fmmec      : ', fmmec    (ki,kj) 
     611        WRITE(numout,*) ' fhmec      : ', fhmec    (ki,kj) 
     612        WRITE(numout,*) ' fhbri      : ', fhbri    (ki,kj) 
     613        WRITE(numout,*) ' fheat_mec  : ', fheat_mec(ki,kj) 
    615614        WRITE(numout,*)  
    616615        WRITE(numout,*) ' sst        : ', sst_m(ki,kj)   
     
    621620        WRITE(numout,*) ' utau_ice   : ', utau_ice(ki,kj)  
    622621        WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ki,kj) 
    623         WRITE(numout,*) ' utau       : ', utau(ki,kj)  
    624         WRITE(numout,*) ' vtau       : ', vtau(ki,kj) 
    625         WRITE(numout,*) ' oc. vel. u : ', u_oce(ki,kj) 
    626         WRITE(numout,*) ' oc. vel. v : ', v_oce(ki,kj) 
     622        WRITE(numout,*) ' utau       : ', utau    (ki,kj)  
     623        WRITE(numout,*) ' vtau       : ', vtau    (ki,kj) 
     624        WRITE(numout,*) ' oc. vel. u : ', u_oce   (ki,kj) 
     625        WRITE(numout,*) ' oc. vel. v : ', v_oce   (ki,kj) 
    627626     ENDIF 
    628627 
     
    640639        WRITE(numout,*) 
    641640        WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    642         WRITE(numout,*) ' qsr        : ', qsr(ki,kj) 
    643         WRITE(numout,*) ' qns        : ', qns(ki,kj) 
     641        WRITE(numout,*) ' qsr       : ', qsr(ki,kj) 
     642        WRITE(numout,*) ' qns       : ', qns(ki,kj) 
    644643        WRITE(numout,*) 
    645644        WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 
    646         WRITE(numout,*) ' emps       : ', emps(ki,kj) 
    647         WRITE(numout,*) ' emp        : ', emp(ki,kj) 
    648         WRITE(numout,*) ' fsbri      : ', fsbri(ki,kj) 
    649         WRITE(numout,*) ' fseqv      : ', fseqv(ki,kj) 
    650         WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj) 
    651         WRITE(numout,*) ' fsalt_rpo  : ', fsalt_rpo(ki,kj) 
     645        WRITE(numout,*) ' emp       : ', emp    (ki,kj) 
     646        WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ki,kj) 
     647        WRITE(numout,*) ' sfx       : ', sfx    (ki,kj) 
     648        WRITE(numout,*) ' sfx_res   : ', sfx_res(ki,kj) 
     649        WRITE(numout,*) ' sfx_mec   : ', sfx_mec(ki,kj) 
    652650        WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    653         WRITE(numout,*) ' fheat_res  : ', fheat_res(ki,kj) 
     651        WRITE(numout,*) ' fheat_res : ', fheat_res(ki,kj) 
    654652        WRITE(numout,*) 
    655653        WRITE(numout,*) ' - Momentum fluxes ' 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r3294 r3625  
    8282      !! ** Action  : - time evolution of the LIM sea-ice model 
    8383      !!              - update all sbc variables below sea-ice: 
    84       !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
     84      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx  
    8585      !!--------------------------------------------------------------------- 
    8686      INTEGER, INTENT(in) ::   kt      ! ocean time step 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3609 r3625  
    1212   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing 
    1313   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
     14   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes 
    1415   !!---------------------------------------------------------------------- 
    1516 
     
    8485      INTEGER ::   icpt   ! local integer 
    8586      !! 
    86       NAMELIST/namsbc/ nn_fsbc   , ln_ana , ln_flx  , ln_blk_clio, ln_blk_core, ln_cpl,   & 
    87          &             ln_blk_mfs, ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf, ln_ssr     , nn_fwb, ln_cdgw 
     87      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx,  ln_blk_clio, ln_blk_core, ln_cpl,   & 
     88         &             ln_blk_mfs, ln_apr_dyn, nn_ice,  nn_ice_embd, ln_dm2dc   , ln_rnf,   & 
     89         &             ln_ssr    , nn_fwb    , ln_cdgw 
    8890      !!---------------------------------------------------------------------- 
    8991 
     
    121123         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn 
    122124         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice  
     125         WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd = ', nn_ice_embd 
    123126         WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc  
    124127         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf 
     
    136139         IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' ) 
    137140         nkrnf         = 0 
    138          rnf     (:,:) = 0.e0 
    139          rnfmsk  (:,:) = 0.e0 
    140          rnfmsk_z(:)   = 0.e0 
     141         rnf     (:,:) = 0.0_wp 
     142         rnfmsk  (:,:) = 0.0_wp 
     143         rnfmsk_z(:)   = 0.0_wp 
    141144      ENDIF 
    142145      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero 
     146 
     147      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
     148                                                   ! only if sea-ice is present 
    143149 
    144150      !                                            ! restartability    
     
    157163      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   & 
    158164         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' ) 
    159       IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) )   & 
    160          &   CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' ) 
     165      IF( nn_ice == 4 .AND. lk_agrif )   & 
     166         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) 
     167      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   & 
     168         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 2 or 3' ) 
    161169       
    162170      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag 
     
    226234      !! ** Action  : - set the ocean surface boundary condition at before and now  
    227235      !!                time step, i.e.   
    228       !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, emps_b, qrp_b, erp_b 
    229       !!                utau  , vtau  , qns  , qsr  , emp  , emps  , qrp  , erp 
     236      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b 
     237      !!                utau  , vtau  , qns  , qsr  , emp  , sfx  , qrp  , erp 
    230238      !!              - updte the ice fraction : fr_i 
    231239      !!---------------------------------------------------------------------- 
     
    243251         ! The 3D heat content due to qsr forcing is treated in traqsr 
    244252         ! qsr_b (:,:) = qsr (:,:) 
    245          emp_b (:,:) = emp (:,:) 
    246          emps_b(:,:) = emps(:,:) 
     253         emp_b(:,:) = emp(:,:) 
     254         sfx_b(:,:) = sfx(:,:) 
    247255      ENDIF 
    248256      !                                            ! ---------------------------------------- ! 
     
    262270                                                             
    263271      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    264       !                                                  ! (i.e. utau,vtau, qns, qsr, emp, emps) 
     272      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    265273      CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
    266274      CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
     
    314322            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b  )   ! before non solar heat flux (T-point) 
    315323            ! The 3D heat content due to qsr forcing is treated in traqsr 
    316             ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  )   ! before     solar heat flux (T-point) 
    317             CALL iom_get( numror, jpdom_autoglo, 'emp_b' , emp_b  )   ! before     freshwater flux (T-point) 
    318             CALL iom_get( numror, jpdom_autoglo, 'emps_b', emps_b )   ! before C/D freshwater flux (T-point) 
     324            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  ) ! before     solar heat flux (T-point) 
     325            CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b  )    ! before     freshwater flux (T-point) 
     326            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6 
     327            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 
     328               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point) 
     329            ELSE 
     330               sfx_b (:,:) = sfx(:,:) 
     331            ENDIF 
    319332         ELSE                                                   !* no restart: set from nit000 values 
    320333            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000' 
     
    322335            vtau_b(:,:) = vtau(:,:) 
    323336            qns_b (:,:) = qns (:,:) 
    324             ! qsr_b (:,:) = qsr (:,:) 
    325             emp_b (:,:) = emp (:,:) 
    326             emps_b(:,:) = emps(:,:) 
     337            emp_b (:,:) = emp(:,:) 
     338            sfx_b (:,:) = sfx(:,:) 
    327339         ENDIF 
    328340      ENDIF 
     
    340352         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    341353         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
    342          CALL iom_rstput( kt, nitrst, numrow, 'emps_b' , emps ) 
     354         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 
    343355      ENDIF 
    344356 
     
    348360      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    349361         CALL iom_put( "empmr" , emp  - rnf )                   ! upward water flux 
    350          CALL iom_put( "empsmr", emps - rnf )                   ! c/d water flux 
     362         CALL iom_put( "saltflx", sfx  )                        ! downward salt flux   
     363                                                                ! (includes virtual salt flux beneath ice  
     364                                                                ! in linear free surface case) 
    351365         CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux  
    352366         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 
     
    365379         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
    366380         CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
    367          CALL prt_ctl(tab2d_1=(emps-rnf)       , clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 
     381         CALL prt_ctl(tab2d_1=(sfx-rnf)        , clinfo1=' sfx-rnf - : ', mask1=tmask, ovlap=1 ) 
    368382         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
    369383         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r3294 r3625  
    5656   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rnf_tsc_b, rnf_tsc  !: before and now T & S runoff contents   [K.m/s & PSU.m/s] 
    5757    
    58    REAL(wp) ::   r1_rau0   ! = 1 / rau0  
    5958 
    6059   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read) 
     
    8382   END FUNCTION sbc_rnf_alloc 
    8483 
     84 
    8585   SUBROUTINE sbc_rnf( kt ) 
    8686      !!---------------------------------------------------------------------- 
     
    9696      !!---------------------------------------------------------------------- 
    9797      INTEGER, INTENT(in) ::   kt          ! ocean time step 
    98       !! 
     98      ! 
    9999      INTEGER  ::   ji, jj   ! dummy loop indices 
    100100      !!---------------------------------------------------------------------- 
     
    127127         ! 
    128128         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    129             rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )   
    130129            ! 
    131             r1_rau0 = 1._wp / rau0 
     130            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
     131            ! 
    132132            !                                                     ! set temperature & salinity content of runoffs 
    133133            IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
     
    199199      !! 
    200200      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    201       REAL(wp) ::   r1_rau0   ! local scalar 
    202201      REAL(wp) ::   zfact     ! local scalar 
    203202      !!---------------------------------------------------------------------- 
     
    205204      zfact = 0.5_wp 
    206205      ! 
    207       r1_rau0 = 1._wp / rau0 
    208206      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==! 
    209207         IF( lk_vvl ) THEN             ! variable volume case  
     
    252250      INTEGER           ::   ji, jj, jk    ! dummy loop indices 
    253251      INTEGER           ::   ierror, inum  ! temporary integer 
    254       !!  
     252      ! 
    255253      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   & 
    256254         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &   
    257255         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact   
    258256      !!---------------------------------------------------------------------- 
    259  
     257      ! 
    260258      !                                   ! ============ 
    261259      !                                   !   Namelist 
     
    273271      REWIND ( numnam )                         ! Read Namelist namsbc_rnf 
    274272      READ   ( numnam, namsbc_rnf ) 
    275  
     273      ! 
    276274      !                                         ! Control print 
    277275      IF(lwp) THEN 
     
    286284         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact     
    287285      ENDIF 
    288  
     286      ! 
    289287      !                                   ! ================== 
    290288      !                                   !   Type of runoff 
     
    395393            nkrnf = 2 
    396394            DO WHILE( nkrnf /= jpkm1 .AND. gdepw_0(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO 
    397             IF( ln_sco )   & 
    398                CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 
     395            IF( ln_sco )   CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 
    399396         ENDIF 
    400397         IF(lwp) WRITE(numout,*) 
     
    414411         nkrnf = 0 
    415412      ENDIF 
    416  
     413      ! 
    417414   END SUBROUTINE sbc_rnf_init 
    418415 
     
    438435      !!                rnfmsk_z vertical structure 
    439436      !!---------------------------------------------------------------------- 
    440       ! 
    441437      INTEGER            ::   inum        ! temporary integers 
    442438      CHARACTER(len=140) ::   cl_rnfile   ! runoff file name 
     
    446442      IF(lwp) WRITE(numout,*) 'rnf_mouth : river mouth mask' 
    447443      IF(lwp) WRITE(numout,*) '~~~~~~~~~ ' 
    448  
     444      ! 
    449445      cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname ) 
    450446      IF( .NOT. sn_cnf%ln_clim ) THEN   ;   WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear    ! add year 
    451447         IF( sn_cnf%cltype == 'monthly' )   WRITE(cl_rnfile, '(a,"m",i2)'  ) TRIM( cl_rnfile ), nmonth   ! add month 
    452448      ENDIF 
    453    
     449      ! 
    454450      ! horizontal mask (read in NetCDF file) 
    455451      CALL iom_open ( cl_rnfile, inum )                           ! open file 
    456452      CALL iom_get  ( inum, jpdom_data, sn_cnf%clvar, rnfmsk )    ! read the river mouth array 
    457453      CALL iom_close( inum )                                      ! close file 
    458        
     454      ! 
    459455      IF( nclosea == 1 )    CALL clo_rnf( rnfmsk )                ! closed sea inflow set as ruver mouth 
    460  
     456      ! 
    461457      rnfmsk_z(:)   = 0._wp                                        ! vertical structure  
    462458      rnfmsk_z(1)   = 1.0 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r3294 r3625  
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   sbc_ssr        : add to sbc a restoring term toward SST/SSS climatology 
    12    !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers 
    14    USE dom_oce         ! ocean space and time domain 
    15    USE sbc_oce         ! surface boundary condition 
    16    USE phycst          ! physical constants 
    17    USE sbcrnf          ! surface boundary condition : runoffs 
    18    USE fldread         ! read input fields 
    19    USE iom             ! I/O manager 
    20    USE in_out_manager  ! I/O manager 
    21    USE lib_mpp         ! distribued memory computing library 
    22    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    23    USE timing          ! Timing 
     11   !!   sbc_ssr       : add to sbc a restoring term toward SST/SSS climatology 
     12   !!---------------------------------------------------------------------- 
     13   USE oce            ! ocean dynamics and tracers 
     14   USE dom_oce        ! ocean space and time domain 
     15   USE sbc_oce        ! surface boundary condition 
     16   USE phycst         ! physical constants 
     17   USE sbcrnf         ! surface boundary condition : runoffs 
     18   USE fldread        ! read input fields 
     19   USE iom            ! I/O manager 
     20   USE in_out_manager ! I/O manager 
     21   USE lib_mpp        ! distribued memory computing library 
     22   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     23   USE timing         ! Timing 
     24   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2425 
    2526   IMPLICIT NONE 
     
    6364      !!              - at each nscb time step 
    6465      !!                   add a retroaction term on qns    (nn_sstr = 1) 
    65       !!                   add a damping term on emps       (nn_sssr = 1) 
    66       !!                   add a damping term on emp & emps (nn_sssr = 2) 
     66      !!                   add a damping term on sfx        (nn_sssr = 1) 
     67      !!                   add a damping term on emp       (nn_sssr = 2) 
    6768      !!--------------------------------------------------------------------- 
    6869      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
     
    156157            !                                      ! ========================= ! 
    157158            ! 
    158             IF( nn_sstr == 1 ) THEN                   !* Temperature restoring term 
     159            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    159160!CDIR COLLAPSE 
    160161               DO jj = 1, jpj 
     
    168169            ENDIF 
    169170            ! 
    170             IF( nn_sssr == 1 ) THEN                   !* Salinity damping term (salt flux, emps only) 
     171            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    171172               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    172173!CDIR COLLAPSE 
     
    174175                  DO ji = 1, jpi 
    175176                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    176                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    177                         &        / ( sss_m(ji,jj) + 1.e-20   ) 
    178                      emps(ji,jj) = emps(ji,jj) + zerp 
    179                      erp( ji,jj) = zerp 
     177                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )  
     178                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux 
     179                     erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only) 
    180180                  END DO 
    181181               END DO 
    182182               CALL iom_put( "erp", erp )                             ! freshwater flux damping 
    183183               ! 
    184             ELSEIF( nn_sssr == 2 ) THEN               !* Salinity damping term (volume flux, emp and emps) 
     184            ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 
    185185               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    186186               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
     
    190190                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    191191                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    192                         &        / ( sss_m(ji,jj) + 1.e-20   ) 
     192                        &        / MAX(  sss_m(ji,jj), 1.e-20   ) 
    193193                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 
    194                      emp (ji,jj) = emp (ji,jj) + zerp 
    195                      emps(ji,jj) = emps(ji,jj) + zerp 
    196                      erp (ji,jj) = zerp 
     194                     emp(ji,jj) = emp (ji,jj) + zerp 
     195                     qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 
     196                     erp(ji,jj) = zerp 
    197197                  END DO 
    198198               END DO 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r3294 r3625  
    121121      REAL(wp) ::   zd , zc , zaw, za    !   -      - 
    122122      REAL(wp) ::   zb1, za1, zkw, zk0   !   -      - 
    123       REAL(wp) ::   zrau0r               !   -      - 
    124123      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    125124      !!---------------------------------------------------------------------- 
     
    133132      ! 
    134133      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    135          zrau0r = 1.e0 / rau0 
    136134!CDIR NOVERRCHK 
    137135         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     
    174172                  ! masked in situ density anomaly 
    175173                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    176                      &             - rau0  ) * zrau0r * tmask(ji,jj,jk) 
     174                     &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk) 
    177175               END DO 
    178176            END DO 
     
    254252      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    255253      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars 
    256       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      - 
     254      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0               !   -      - 
    257255      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws 
    258256      !!---------------------------------------------------------------------- 
     
    265263      ! 
    266264      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    267          zrau0r = 1.e0 / rau0 
    268265!CDIR NOVERRCHK 
    269266         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
     
    309306                  ! masked in situ density anomaly 
    310307                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    & 
    311                      &             - rau0  ) * zrau0r * tmask(ji,jj,jk) 
     308                     &             - rau0  ) * r1_rau0 * tmask(ji,jj,jk) 
    312309               END DO 
    313310            END DO 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r3294 r3625  
    1414   !!                   and vertical advection trends using MUSCL scheme 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and active tracers 
    17    USE dom_oce         ! ocean space and time domain 
    18    USE trdmod_oce      ! tracers trends  
    19    USE trdtra      ! tracers trends  
    20    USE in_out_manager  ! I/O manager 
    21    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    22    USE trabbl          ! tracers: bottom boundary layer 
    23    USE lib_mpp         ! distribued memory computing 
    24    USE lbclnk          ! ocean lateral boundary condition (or mpp link)  
    25    USE diaptr          ! poleward transport diagnostics 
    26    USE trc_oce         ! share passive tracers/Ocean variables 
    27    USE wrk_nemo        ! Memory Allocation 
    28    USE timing          ! Timing 
     16   USE oce            ! ocean dynamics and active tracers 
     17   USE dom_oce        ! ocean space and time domain 
     18   USE trdmod_oce     ! tracers trends  
     19   USE trdtra         ! tracers trends  
     20   USE in_out_manager ! I/O manager 
     21   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
     22   USE trabbl         ! tracers: bottom boundary layer 
     23   USE lib_mpp        ! distribued memory computing 
     24   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
     25   USE diaptr         ! poleward transport diagnostics 
     26   USE trc_oce        ! share passive tracers/Ocean variables 
     27   USE wrk_nemo       ! Memory Allocation 
     28   USE timing         ! Timing 
     29   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2930 
    3031   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r3294 r3625  
    2525   USE wrk_nemo        ! Memory Allocation 
    2626   USE timing          ! Timing 
    27  
     27   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2828 
    2929   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r3301 r3625  
    2828   USE wrk_nemo        ! Memory Allocation 
    2929   USE timing          ! Timing 
     30   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3031 
    3132   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r3294 r3625  
    1717 
    1818   !!---------------------------------------------------------------------- 
    19    !!   tra_adv_tvd  : update the tracer trend with the horizontal 
    20    !!                  and vertical advection trends using a TVD scheme 
    21    !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory 
    22    !!                  algorithm  
    23    !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean dynamics and active tracers 
    25    USE dom_oce         ! ocean space and time domain 
    26    USE trdmod_oce      ! tracers trends 
    27    USE trdtra          ! tracers trends 
    28    USE in_out_manager  ! I/O manager 
    29    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    30    USE lib_mpp         ! MPP library 
    31    USE lbclnk          ! ocean lateral boundary condition (or mpp link)  
    32    USE diaptr          ! poleward transport diagnostics 
    33    USE trc_oce         ! share passive tracers/Ocean variables 
    34    USE wrk_nemo        ! Memory Allocation 
    35    USE timing          ! Timing 
     19   !!   tra_adv_tvd   : update the tracer trend with the 3D advection trends using a TVD scheme 
     20   !!   nonosc        : compute monotonic tracer fluxes by a non-oscillatory algorithm  
     21   !!---------------------------------------------------------------------- 
     22   USE oce            ! ocean dynamics and active tracers 
     23   USE dom_oce        ! ocean space and time domain 
     24   USE trdmod_oce     ! tracers trends 
     25   USE trdtra         ! tracers trends 
     26   USE in_out_manager ! I/O manager 
     27   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
     28   USE lib_mpp        ! MPP library 
     29   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
     30   USE diaptr         ! poleward transport diagnostics 
     31   USE trc_oce        ! share passive tracers/Ocean variables 
     32   USE wrk_nemo       ! Memory Allocation 
     33   USE timing         ! Timing 
     34   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3635 
    3736   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r3294 r3625  
    1212   !!                 advection trends using a third order biaised scheme   
    1313   !!---------------------------------------------------------------------- 
    14    USE oce             ! ocean dynamics and active tracers 
    15    USE dom_oce         ! ocean space and time domain 
    16    USE trdmod_oce         ! ocean space and time domain 
     14   USE oce            ! ocean dynamics and active tracers 
     15   USE dom_oce        ! ocean space and time domain 
     16   USE trdmod_oce     ! ocean space and time domain 
    1717   USE trdtra 
    1818   USE lib_mpp 
    19    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    20    USE in_out_manager  ! I/O manager 
    21    USE diaptr          ! poleward transport diagnostics 
    22    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    23    USE trc_oce         ! share passive tracers/Ocean variables 
    24    USE wrk_nemo        ! Memory Allocation 
    25    USE timing          ! Timing 
     19   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     20   USE in_out_manager ! I/O manager 
     21   USE diaptr         ! poleward transport diagnostics 
     22   USE dynspg_oce     ! choice/control of key cpp for surface pressure gradient 
     23   USE trc_oce        ! share passive tracers/Ocean variables 
     24   USE wrk_nemo       ! Memory Allocation 
     25   USE timing         ! Timing 
     26   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2627 
    2728   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r3294 r3625  
    155155         CASE ( 1 )                          !* constant flux 
    156156            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst 
    157             qgh_trd0(:,:) = ro0cpr * rn_geoflx_cst 
     157            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 
    158158            ! 
    159159         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 
     
    162162            CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 
    163163            CALL iom_close( inum ) 
    164             qgh_trd0(:,:) = ro0cpr * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2 
     164            qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2 
    165165            ! 
    166166         CASE DEFAULT 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r3294 r3625  
    147147         !                                        ! ============================================== ! 
    148148         DO jk = 1, jpkm1 
    149             qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
     149            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
    150150         END DO 
    151151         !                                        Add to the general trend 
     
    219219               ! 
    220220               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
    221                   qsr_hc(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
     221                  qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
    222222               END DO 
    223223               zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero 
     
    236236            ! 
    237237            IF( lk_vvl ) THEN                                  !* variable volume 
    238                zz0   =        rn_abs   * ro0cpr 
    239                zz1   = ( 1. - rn_abs ) * ro0cpr 
     238               zz0   =        rn_abs   * r1_rau0_rcp 
     239               zz1   = ( 1. - rn_abs ) * r1_rau0_rcp 
    240240               DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m  
    241241                  DO jj = 1, jpj 
     
    463463                  ! 
    464464                  DO jk = 1, nksr 
    465                      etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )  
     465                     etot3(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) )  
    466466                  END DO 
    467467                  etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero 
     
    484484               IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step' 
    485485            ELSE                                ! constant volume: computes one for all 
    486                zz0 =        rn_abs   * ro0cpr 
    487                zz1 = ( 1. - rn_abs ) * ro0cpr 
     486               zz0 =        rn_abs   * r1_rau0_rcp 
     487               zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 
    488488               DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all 
    489489                  DO jj = 1, jpj                              ! top 400 meters 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r3294 r3625  
    6060      !!         at the surface by evaporation, precipitations and runoff (E-P-R);  
    6161      !!      (3) Fwe, tracer carried with the water that is exchanged.  
     62      !!            - salinity    : salt flux only due to freezing/melting 
     63      !!            sa = sa +  sfx / rau0 / e3t  for k=1 
    6264      !! 
    6365      !!      Fext, flux through the air-sea interface for temperature and salt:  
     
    8486      !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST 
    8587      !!            - salinity    : evaporation, precipitation and runoff 
    86       !!         water has a zero salinity (Fwe=0), thus only Fwi remains: 
    87       !!            sa = sa + emp * sn / e3t   for k=1 
     88      !!         water has a zero salinity  but there is a salt flux due to  
     89      !!         freezing/melting, thus: 
     90      !!            sa = sa + emp * sn / rau0 / e3t   for k=1 
     91      !!                    + sfx    / rau0 / e3t 
    8892      !!         where emp, the surface freshwater budget (evaporation minus 
    8993      !!         precipitation minus runoff) given in kg/m2/s is divided 
    90       !!         by 1035 kg/m3 (density of ocena water) to obtain m/s.     
     94      !!         by rau0 = 1020 kg/m3 (density of sea water) to obtain m/s.     
    9195      !!         Note: even though Fwe does not appear explicitly for  
    9296      !!         temperature in this routine, the heat carried by the water 
     
    109113      !! 
    110114      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices   
    111       REAL(wp) ::   zfact, z1_e3t, zsrau, zdep 
     115      REAL(wp) ::   zfact, z1_e3t, zdep 
    112116      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    113117      !!---------------------------------------------------------------------- 
     
    120124         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    121125      ENDIF 
    122  
    123       zsrau = 1. / rau0             ! initialization 
    124126 
    125127      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     
    163165                                                   ! evaporation, precipitation and qns, but not river runoff  
    164166                                                
    165       IF( lk_vvl ) THEN                            ! Variable Volume case 
     167      IF( lk_vvl ) THEN                            ! Variable Volume case  ==>> heat content of mass flux is in qns 
    166168         DO jj = 1, jpj 
    167169            DO ji = 1, jpi  
    168                ! temperature : heat flux + cooling/heating effet of EMP flux 
    169                sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem) 
    170                ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration 
    171                sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal) 
     170               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                              ! non solar heat flux 
     171               sbc_tsc(ji,jj,jp_sal) = r1_rau0     * sfx(ji,jj)                              ! salt flux due to freezing/melting 
    172172            END DO 
    173173         END DO 
    174       ELSE                                         ! Constant Volume case 
     174      ELSE                                         ! Constant Volume case ==>> Concentration dilution effect 
    175175         DO jj = 2, jpj 
    176176            DO ji = fs_2, fs_jpim1   ! vector opt. 
    177177               ! temperature : heat flux 
    178                sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) 
    179                ! salinity    : salt flux + concent./dilut. effect (both in emps) 
    180                sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal) 
     178               sbc_tsc(ji,jj,jp_tem) = r1_rau0_rcp * qns(ji,jj)                          &   ! non solar heat flux 
     179                  &                  + r1_rau0     * emp(ji,jj)  * tsn(ji,jj,1,jp_tem)       ! concent./dilut. effect 
     180               ! salinity    : salt flux + concent./dilut. effect (both in sfx) 
     181               sbc_tsc(ji,jj,jp_sal) = r1_rau0  * (  sfx(ji,jj)                          &   ! salt flux (freezing/melting) 
     182                  &                                + emp(ji,jj) * tsn(ji,jj,1,jp_sal) )      ! concent./dilut. effect 
    181183            END DO 
    182184         END DO 
     185         CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )                          ! c/d term on sst 
     186         CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )                          ! c/d term on sss 
    183187      ENDIF 
    184188      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff   
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r3294 r3625  
    1212   !!   'key_zdfgls'                 Generic Length Scale vertical physics 
    1313   !!---------------------------------------------------------------------- 
    14    !!   zdf_gls      : update momentum and tracer Kz from a gls scheme 
    15    !!   zdf_gls_init : initialization, namelist read, and parameters control 
    16    !!   gls_rst      : read/write gls restart in ocean restart file 
     14   !!   zdf_gls       : update momentum and tracer Kz from a gls scheme 
     15   !!   zdf_gls_init  : initialization, namelist read, and parameters control 
     16   !!   gls_rst       : read/write gls restart in ocean restart file 
    1717   !!---------------------------------------------------------------------- 
    1818   USE oce            ! ocean dynamics and active tracers  
     
    3131   USE iom            ! I/O manager library 
    3232   USE timing         ! Timing 
     33   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3334 
    3435   IMPLICIT NONE 
     
    167168            !  
    168169            ! surface friction  
    169             ustars2(ji,jj) = rau0r * taum(ji,jj) * tmask(ji,jj,1) 
     170            ustars2(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 
    170171            ! 
    171172            ! bottom friction (explicit before friction) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r3294 r3625  
    1515   !!   'key_zdfkpp'                                             KPP scheme 
    1616   !!---------------------------------------------------------------------- 
    17    !!   zdf_kpp      : update momentum and tracer Kz from a kpp scheme 
    18    !!   zdf_kpp_init : initialization, namelist read, and parameters control 
    19    !!   tra_kpp      : compute and add to the T & S trend the non-local flux 
    20    !!   trc_kpp      : compute and add to the passive tracer trend the non-local flux (lk_top=T) 
     17   !!   zdf_kpp       : update momentum and tracer Kz from a kpp scheme 
     18   !!   zdf_kpp_init  : initialization, namelist read, and parameters control 
     19   !!   tra_kpp       : compute and add to the T & S trend the non-local flux 
     20   !!   trc_kpp       : compute and add to the passive tracer trend the non-local flux (lk_top=T) 
    2121   !!---------------------------------------------------------------------- 
    22    USE oce             ! ocean dynamics and active tracers  
    23    USE dom_oce         ! ocean space and time domain 
    24    USE zdf_oce         ! ocean vertical physics 
    25    USE sbc_oce         ! surface boundary condition: ocean 
    26    USE phycst          ! physical constants 
    27    USE eosbn2          ! equation of state 
    28    USE zdfddm          ! double diffusion mixing 
    29    USE in_out_manager  ! I/O manager 
    30    USE lib_mpp         ! MPP library 
    31    USE wrk_nemo        ! work arrays 
    32    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    33    USE prtctl          ! Print control 
    34    USE trdmod_oce      ! ocean trends definition 
    35    USE trdtra          ! tracers trends 
    36    USE timing          ! Timing 
     22   USE oce            ! ocean dynamics and active tracers  
     23   USE dom_oce        ! ocean space and time domain 
     24   USE zdf_oce        ! ocean vertical physics 
     25   USE sbc_oce        ! surface boundary condition: ocean 
     26   USE phycst         ! physical constants 
     27   USE eosbn2         ! equation of state 
     28   USE zdfddm         ! double diffusion mixing 
     29   USE in_out_manager ! I/O manager 
     30   USE lib_mpp        ! MPP library 
     31   USE wrk_nemo       ! work arrays 
     32   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     33   USE prtctl         ! Print control 
     34   USE trdmod_oce     ! ocean trends definition 
     35   USE trdtra         ! tracers trends 
     36   USE timing         ! Timing 
     37   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3738 
    3839   IMPLICIT NONE 
     
    426427            zBosol(ji,jj) = grav * zthermal * qsr(ji,jj) 
    427428            ! Non radiative surface buoyancy force 
    428             zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emps(ji,jj)-rnf(ji,jj) )  
     429            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emp(ji,jj)-rnf(ji,jj) )  & 
     430               &                                         -  grav * rbeta * rcs * sfx(ji,jj) 
    429431            ! Surface Temperature flux for non-local term 
    430             wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1) 
     432            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* r1_rau0_rcp * tmask(ji,jj,1) 
    431433            ! Surface salinity flux for non-local term 
    432             ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) * rcs ) * tmask(ji,jj,1)  
     434            ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)                          & 
     435               &             + sfx(ji,jj)                                     ) * rcs * tmask(ji,jj,1)  
    433436         ENDDO 
    434437      ENDDO 
     
    13241327               DO ji = fs_2, fs_jpim1 
    13251328                  ! Surface tracer flux for non-local term  
    1326                   zflx = - ( emps(ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1) 
     1329                  zflx = - ( sfx (ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1) 
    13271330                  ! compute the trend 
    13281331                  ztra = - ( ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   & 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r3294 r3625  
    1717   !!   'key_zdfric'                                             Kz = f(Ri) 
    1818   !!---------------------------------------------------------------------- 
    19    !!   zdf_ric      : update momentum and tracer Kz from the Richardson 
     19   !!   zdf_ric       : update momentum and tracer Kz from the Richardson 
    2020   !!                  number computation 
    21    !!   zdf_ric_init : initialization, namelist read, & parameters control 
    22    !!---------------------------------------------------------------------- 
    23    USE oce                   ! ocean dynamics and tracers variables 
    24    USE dom_oce               ! ocean space and time domain variables 
    25    USE zdf_oce               ! ocean vertical physics 
    26    USE in_out_manager        ! I/O manager 
    27    USE lbclnk                ! ocean lateral boundary condition (or mpp link) 
    28    USE lib_mpp               ! MPP library 
    29    USE wrk_nemo              ! work arrays 
    30    USE timing                ! Timing 
     21   !!   zdf_ric_init  : initialization, namelist read, & parameters control 
     22   !!---------------------------------------------------------------------- 
     23   USE oce            ! ocean dynamics and tracers variables 
     24   USE dom_oce        ! ocean space and time domain variables 
     25   USE zdf_oce        ! ocean vertical physics 
     26   USE in_out_manager ! I/O manager 
     27   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     28   USE lib_mpp        ! MPP library 
     29   USE wrk_nemo       ! work arrays 
     30   USE timing         ! Timing 
     31   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3132 
    3233   USE eosbn2, ONLY : nn_eos 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r3294 r3625  
    3131   !!   'key_zdftke'                                   TKE vertical physics 
    3232   !!---------------------------------------------------------------------- 
    33    !!   zdf_tke      : update momentum and tracer Kz from a tke scheme 
    34    !!   tke_tke      : tke time stepping: update tke at now time step (en) 
    35    !!   tke_avn      : compute mixing length scale and deduce avm and avt 
    36    !!   zdf_tke_init : initialization, namelist read, and parameters control 
    37    !!   tke_rst      : read/write tke restart in ocean restart file 
     33   !!   zdf_tke       : update momentum and tracer Kz from a tke scheme 
     34   !!   tke_tke       : tke time stepping: update tke at now time step (en) 
     35   !!   tke_avn       : compute mixing length scale and deduce avm and avt 
     36   !!   zdf_tke_init  : initialization, namelist read, and parameters control 
     37   !!   tke_rst       : read/write tke restart in ocean restart file 
    3838   !!---------------------------------------------------------------------- 
    3939   USE oce            ! ocean: dynamics and active tracers variables 
     
    5252   USE wrk_nemo       ! work arrays 
    5353   USE timing         ! Timing 
     54   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    5455 
    5556   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r3294 r3625  
    1212   !!   'key_zdftmx'                                  Tidal vertical mixing 
    1313   !!---------------------------------------------------------------------- 
    14    !!   zdf_tmx      : global     momentum & tracer Kz with tidal induced Kz 
    15    !!   tmx_itf      : Indonesian momentum & tracer Kz with tidal induced Kz  
    16    !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and tracers variables 
    18    USE dom_oce         ! ocean space and time domain variables 
    19    USE zdf_oce         ! ocean vertical physics variables 
    20    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    21    USE eosbn2          ! ocean equation of state 
    22    USE phycst          ! physical constants 
    23    USE prtctl          ! Print control 
    24    USE in_out_manager  ! I/O manager 
    25    USE iom             ! I/O Manager 
    26    USE lib_mpp         ! MPP library 
    27    USE wrk_nemo        ! work arrays 
    28    USE timing          ! Timing 
     14   !!   zdf_tmx       : global     momentum & tracer Kz with tidal induced Kz 
     15   !!   tmx_itf       : Indonesian momentum & tracer Kz with tidal induced Kz  
     16   !!---------------------------------------------------------------------- 
     17   USE oce            ! ocean dynamics and tracers variables 
     18   USE dom_oce        ! ocean space and time domain variables 
     19   USE zdf_oce        ! ocean vertical physics variables 
     20   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     21   USE eosbn2         ! ocean equation of state 
     22   USE phycst         ! physical constants 
     23   USE prtctl         ! Print control 
     24   USE in_out_manager ! I/O manager 
     25   USE iom            ! I/O Manager 
     26   USE lib_mpp        ! MPP library 
     27   USE wrk_nemo       ! work arrays 
     28   USE timing         ! Timing 
     29   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2930 
    3031   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r3610 r3625  
    4646   USE mppini          ! shared/distributed memory setting (mpp_init routine) 
    4747   USE domain          ! domain initialization             (dom_init routine) 
     48#if defined key_nemocice_decomp 
     49   USE ice_domain_size, only: nx_global, ny_global 
     50#endif 
    4851   USE obcini          ! open boundary cond. initialization (obc_ini routine) 
    4952   USE bdyini          ! open boundary cond. initialization (bdy_init routine) 
     
    259262      ! than variables 
    260263      IF( Agrif_Root() ) THEN 
     264#if defined key_nemocice_decomp 
     265         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
     266         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     267#else 
    261268         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    262 #if defined key_nemocice_decomp 
    263          jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
    264 #else 
    265269         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    266270#endif 
     
    322326      IF( lk_bdy        )   CALL     tide_init      ! Open boundaries initialisation of tidal harmonic forcing 
    323327 
    324                             CALL flush(numout) 
    325328                            CALL dyn_nept_init  ! simplified form of Neptune effect 
    326                             CALL flush(numout) 
    327329 
    328330                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r3294 r3625  
    4747   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point 
    4848 
     49   !! arrays relating to embedding ice in the ocean. These arrays need to be declared  
     50   !! even if no ice model is required. In the no ice model or traditional levitating  
     51   !! ice cases they contain only zeros 
     52   !! --------------------- 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2] 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2] 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
     56 
    4957   !!---------------------------------------------------------------------- 
    5058   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     
    5866      !!                   ***  FUNCTION oce_alloc  *** 
    5967      !!---------------------------------------------------------------------- 
    60       INTEGER :: ierr(2) 
     68      INTEGER :: ierr(3) 
    6169      !!---------------------------------------------------------------------- 
    6270      ! 
     
    6977         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) ) 
    7078         ! 
    71       ALLOCATE(rhd (jpi,jpj,jpk) ,                                         & 
    72          &     rhop(jpi,jpj,jpk) ,                                         & 
    73          &     sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     & 
    74          &     sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     & 
    75          &     sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     & 
    76          &                         sshf_n(jpi,jpj) ,                       & 
    77          &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       & 
    78          &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     & 
    79          &     gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) ) 
     79      ALLOCATE( rhd (jpi,jpj,jpk) ,                                         & 
     80         &      rhop(jpi,jpj,jpk) ,                                         & 
     81         &      sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     & 
     82         &      sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     & 
     83         &      sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     & 
     84         &                          sshf_n(jpi,jpj) ,                       & 
     85         &      spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       & 
     86         &      gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     & 
     87         &      gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) ) 
     88         ! 
     89      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
     90         &      snwice_fmass(jpi,jpj), STAT= ierr(3) ) 
    8091         ! 
    8192      oce_alloc = MAXVAL( ierr ) 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r3295 r3625  
    44   !! TOP :   PISCES Compute remineralization/scavenging of organic compounds 
    55   !!====================================================================== 
    6    !! History :   1.0  !  2004     (O. Aumont) Original code 
    7    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    8    !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
     6   !! History :  1.0  !  2004     (O. Aumont) Original code 
     7   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!            3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_pisces 
     
    1717   !!   p4z_rem_alloc :  Allocate remineralisation variables 
    1818   !!---------------------------------------------------------------------- 
    19    USE oce_trc         !  shared variables between ocean and passive tracers 
    20    USE trc             !  passive tracers common variables  
    21    USE sms_pisces      !  PISCES Source Minus Sink variables 
    22    USE p4zopt          !  optical model 
    23    USE p4zche          !  chemical model 
    24    USE p4zprod         !  Growth rate of the 2 phyto groups 
    25    USE p4zmeso         !  Sources and sinks of mesozooplankton 
    26    USE p4zint          !  interpolation and computation of various fields 
    27    USE prtctl_trc      !  print control for debugging 
     19   USE oce_trc        !  shared variables between ocean and passive tracers 
     20   USE trc            !  passive tracers common variables  
     21   USE sms_pisces     !  PISCES Source Minus Sink variables 
     22   USE p4zopt         !  optical model 
     23   USE p4zche         !  chemical model 
     24   USE p4zprod        !  Growth rate of the 2 phyto groups 
     25   USE p4zmeso        !  Sources and sinks of mesozooplankton 
     26   USE p4zint         !  interpolation and computation of various fields 
     27   USE prtctl_trc     !  print control for debugging 
     28   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2829 
    2930   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r3295 r3625  
    1919   USE prtctl_trc      !  print control for debugging 
    2020   USE iom             !  I/O manager 
     21   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2122 
    2223   IMPLICIT NONE 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90

    r2761 r3625  
    11MODULE sedchem 
    2  
     2   ! 
    33#if defined key_sed  
    44   !!====================================================================== 
     
    66   !! sediment :   Variable for chemistry of the CO2 cycle 
    77   !!====================================================================== 
    8    !!   modules used 
    9    USE sed     ! sediment global variable 
     8   USE sed            ! sediment global variable 
    109   USE sedarr 
    11  
    12    !! * Accessibility 
     10   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     11 
    1312   PUBLIC sed_chem    
    1413 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r3294 r3625  
    6363      REAL(wp) ::   zsrau, zse3t   ! temporary scalars 
    6464      CHARACTER (len=22) :: charout 
    65       REAL(wp), POINTER, DIMENSION(:,:  ) :: zemps 
     65      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx 
    6666      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 
    6767      !!--------------------------------------------------------------------- 
     
    7070      ! 
    7171      ! Allocate temporary workspace 
    72                       CALL wrk_alloc( jpi, jpj,      zemps  ) 
     72                      CALL wrk_alloc( jpi, jpj,      zsfx   ) 
    7373      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 
    7474 
     
    8080 
    8181 
    82       IF( lk_offline ) THEN          ! emps in dynamical files contains emps - rnf 
    83          zemps(:,:) = emps(:,:)   
     82      IF( lk_offline ) THEN          ! sfx in dynamical files contains sfx - rnf 
     83         zsfx(:,:) = sfx(:,:)   
    8484      ELSE                           ! Concentration dilution effect on tracer due to evaporation, precipitation, and river runoff 
    8585         IF( lk_vvl ) THEN                      ! volume variable 
    86             zemps(:,:) = emps(:,:) - emp(:,:)    
    87 !!ch         zemps(:,:) = 0. 
     86            zsfx(:,:) = sfx(:,:) - emp(:,:)    
     87!!ch         zsfx(:,:) = 0. 
    8888         ELSE                                   ! linear free surface 
    89             IF( ln_rnf ) THEN  ;  zemps(:,:) = emps(:,:) - rnf(:,:)   !  E-P-R 
    90             ELSE               ;  zemps(:,:) = emps(:,:) 
     89            IF( ln_rnf ) THEN  ;  zsfx(:,:) = sfx(:,:) - rnf(:,:)   !  E-P-R 
     90            ELSE               ;  zsfx(:,:) = sfx(:,:) 
    9191            ENDIF  
    9292         ENDIF  
     
    102102            DO ji = fs_2, fs_jpim1   ! vector opt. 
    103103               zse3t = 1. / fse3t(ji,jj,1) 
    104                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zemps(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t 
     104               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t 
    105105            END DO 
    106106         END DO 
     
    117117                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    118118      ENDIF 
    119                       CALL wrk_dealloc( jpi, jpj,      zemps  ) 
     119                      CALL wrk_dealloc( jpi, jpj,      zsfx   ) 
    120120      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
    121121      ! 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r3294 r3625  
    227227   USE sbc_oce , ONLY :   emp        =>    emp        !: freshwater budget: volume flux               [Kg/m2/s] 
    228228   USE sbc_oce , ONLY :   emp_b      =>    emp_b      !: freshwater budget: volume flux               [Kg/m2/s] 
    229    USE sbc_oce , ONLY :   emps       =>    emps       !: freshwater budget: concentration/dillution   [Kg/m2/s] 
     229   USE sbc_oce , ONLY :   sfx        =>    sfx        !: downward salt flux                          [PSU/m2/s] 
    230230   USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s] 
    231231   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Daily mean to Diurnal Cycle short wave (qsr)  
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r3294 r3625  
    133133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fr_i_tm    !: average ice fraction     [m/s] 
    134134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_tm     !: freshwater budget: volume flux [Kg/m2/s] 
    135    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emps_tm    !: freshwater budget:concentration/dilution [Kg/m2/s] 
     135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sfx_tm     !: downward salt flux [PSU/m2/s] 
    136136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_b_hold !: hold emp from the beginning of each sub-stepping[m]   
    137137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  qsr_tm     !: solar radiation average [m] 
     
    173173   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivb_temp, rotb_temp 
    174174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_temp, qsr_temp, fr_i_temp,wndm_temp 
    175    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_temp, emps_temp, emp_b_temp 
     175   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_temp, sfx_temp, emp_b_temp 
    176176   ! 
    177177#if defined key_trabbl 
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r3294 r3625  
    121121          fr_i_tm  (:,:)         = fr_i_tm  (:,:)         + fr_i  (:,:) 
    122122          emp_tm   (:,:)         = emp_tm   (:,:)         + emp   (:,:)  
    123           emps_tm  (:,:)         = emps_tm  (:,:)         + emps  (:,:) 
     123          sfx_tm   (:,:)         = sfx_tm   (:,:)         + sfx   (:,:) 
    124124          qsr_tm   (:,:)         = qsr_tm   (:,:)         + qsr   (:,:) 
    125125          wndm_tm  (:,:)         = wndm_tm  (:,:)         + wndm  (:,:) 
     
    209209         emp_temp   (:,:)        = emp   (:,:) 
    210210         emp_b_temp (:,:)        = emp_b (:,:) 
    211          emps_temp  (:,:)        = emps  (:,:) 
     211         sfx_temp   (:,:)        = sfx   (:,:) 
    212212         qsr_temp   (:,:)        = qsr   (:,:) 
    213213         wndm_temp  (:,:)        = wndm  (:,:) 
     
    313313         fr_i_tm  (:,:)          = fr_i_tm    (:,:)       + fr_i  (:,:) 
    314314         emp_tm   (:,:)          = emp_tm     (:,:)       + emp   (:,:)  
    315          emps_tm  (:,:)          = emps_tm    (:,:)       + emps  (:,:) 
     315         sfx_tm   (:,:)          = sfx_tm     (:,:)       + sfx   (:,:) 
    316316         qsr_tm   (:,:)          = qsr_tm     (:,:)       + qsr   (:,:) 
    317317         wndm_tm  (:,:)          = wndm_tm    (:,:)       + wndm  (:,:) 
     
    332332            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrc  
    333333            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrc  
    334             emps  (:,:)          = emps_tm    (:,:) * r1_ndttrc  
     334            sfx   (:,:)          = sfx_tm     (:,:) * r1_ndttrc  
    335335            fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrc 
    336336# if defined key_trabbl 
     
    348348            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrcp1  
    349349            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrcp1  
    350             emps  (:,:)          = emps_tm    (:,:) * r1_ndttrcp1  
     350            sfx   (:,:)          = sfx_tm     (:,:) * r1_ndttrcp1  
    351351            fr_i  (:,:)          = fr_i_tm    (:,:) * r1_ndttrcp1  
    352352# if defined key_trabbl 
     
    498498         CALL lbc_lnk( emp   (:,:)         , 'T', 1. )  
    499499         CALL lbc_lnk( emp_b (:,:)         , 'T', 1. )  
    500          CALL lbc_lnk( emps  (:,:)         , 'T', 1. )  
     500         CALL lbc_lnk( sfx   (:,:)         , 'T', 1. )  
    501501         CALL lbc_lnk( qsr   (:,:)         , 'T', 1. )  
    502502         CALL lbc_lnk( wndm  (:,:)         , 'T', 1. )  
     
    598598      fr_i_tm(:,:) = 0._wp 
    599599      emp_tm (:,:) = 0._wp 
    600       emps_tm(:,:) = 0._wp 
     600      sfx_tm(:,:) = 0._wp 
    601601      qsr_tm (:,:) = 0._wp 
    602602      wndm_tm(:,:) = 0._wp 
     
    705705      fr_i  (:,:)     =  fr_i_temp  (:,:) 
    706706      emp   (:,:)     =  emp_temp   (:,:) 
    707       emps  (:,:)     =  emps_temp  (:,:) 
     707      sfx   (:,:)     =  sfx_temp   (:,:) 
    708708      emp_b (:,:)     =  emp_b_temp (:,:) 
    709709      qsr   (:,:)     =  qsr_temp   (:,:) 
     
    824824      fr_i_tm    (:,:) = fr_i  (:,:) 
    825825      emp_tm     (:,:) = emp   (:,:) 
    826       emps_tm    (:,:) = emps  (:,:) 
     826      sfx_tm     (:,:) = sfx   (:,:) 
    827827      qsr_tm     (:,:) = qsr   (:,:) 
    828828      wndm_tm    (:,:) = wndm  (:,:) 
     
    10531053         &      rnf_temp(jpi,jpj)           ,  h_rnf_temp(jpi,jpj) ,     & 
    10541054         &      tsn_temp(jpi,jpj,jpk,2)     ,  emp_b_temp(jpi,jpj),      & 
    1055          &      emp_temp(jpi,jpj)           ,  emps_temp(jpi,jpj) ,      & 
     1055         &      emp_temp(jpi,jpj)           ,  sfx_temp(jpi,jpj) ,      & 
    10561056         &      hmld_temp(jpi,jpj)          ,  qsr_temp(jpi,jpj) ,       & 
    10571057         &      fr_i_temp(jpi,jpj)          ,  fr_i_tm(jpi,jpj) ,        & 
     
    11011101         &      sshv_n_tm(jpi,jpj)          ,  sshv_b_hold(jpi,jpj),     & 
    11021102         &      tsn_tm(jpi,jpj,jpk,2)       ,                            & 
    1103          &      emp_tm(jpi,jpj)             ,  emps_tm(jpi,jpj) ,        & 
     1103         &      emp_tm(jpi,jpj)             ,  sfx_tm(jpi,jpj) ,        & 
    11041104         &      emp_b_hold(jpi,jpj)         ,                            & 
    11051105         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         & 
Note: See TracChangeset for help on using the changeset viewer.