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

Changeset 888


Ignore:
Timestamp:
2008-04-11T19:05:03+02:00 (16 years ago)
Author:
ctlod
Message:

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113

Location:
trunk/NEMO
Files:
21 added
28 deleted
91 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/C1D_SRC/diawri1d.F90

    r833 r888  
    1313   USE dom_oce         ! ocean space and time domain 
    1414   USE zdf_oce         ! ocean vertical physics 
     15   USE sbc_oce         ! surface boundary condition: ocean 
     16   USE sbc_ice         ! surface boundary condition: ice 
    1517   USE zdftke          ! TKE vertical mixing 
    1618   USE zdfkpp          ! KPP vertical mixing 
    … …  
    1921   USE phycst          ! physical constants 
    2022   USE ocfzpt          ! ??? 
    21    USE ocesbc          ! surface thermohaline fluxes 
    22    USE taumod          ! surface stress 
    23    USE flxrnf          ! ??? 
    2423   USE zdfmxl          ! mixed layer 
    2524   USE daymod          ! calendar 
    … …  
    4948   !!---------------------------------------------------------------------- 
    5049   !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    51    !! $Header$  
     50   !! $Id$ 
    5251   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    5352   !!---------------------------------------------------------------------- 
    … …  
    194193            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    195194 
    196 #if ! defined key_dynspg_rl && defined key_lim3 
    197          ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to 
    198          !    internal damping to Levitus that can be diagnosed from others 
    199          ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup 
    200          CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt 
    201             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    202          CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass 
    203             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    204 #endif 
     195!!$#if ! defined key_dynspg_rl && ( defined key_lim2 || defined key_lim2 ) 
     196!!$         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to 
     197!!$         !    internal damping to Levitus that can be diagnosed from others 
     198!!$         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup 
     199!!$         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt 
     200!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     201!!$         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass 
     202!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     203!!$#endif 
    205204         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! emp 
    206205            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    211210         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! emps * sn 
    212211            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    213          CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qt 
     212         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qsr + qns 
    214213            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    215214         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr 
    … …  
    238237#endif 
    239238 
    240 #if ( defined key_coupled && ! defined key_lim3 )  
     239#if ( defined key_coupled && ! ( defined key_lim3 || defined key_lim2 ) )  
    241240         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    242241            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    260259#endif 
    261260 
    262 #if defined key_lim3 && defined key_coupled 
     261#if ( defined key_lim3 || defined key_lim2 ) && defined key_coupled 
    263262         CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    264263            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    275274#endif 
    276275         !                                                                                      !!! nid_U : 2D 
    277          CALL histdef( nid_T, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! taux 
     276         CALL histdef( nid_T, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau 
    278277            &          jpi, jpj, nh_T, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    279278 
    … …  
    286285#endif 
    287286         !                                                                                      !!! nid_V : 2D 
    288          CALL histdef( nid_T, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! tauy 
     287         CALL histdef( nid_T, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau 
    289288            &          jpi, jpj, nh_T, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    290289#if defined key_zdftke 
    … …  
    365364      CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface temperature 
    366365      CALL histwrite( nid_T, "sosaline", it, sn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface salinity 
    367 #if ! defined key_dynspg_rl && defined key_lim3 
     366#if ! defined key_dynspg_rl && ( defined key_lim3 || defined key_lim2 ) 
    368367      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux 
    369368      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux 
    … …  
    374373      zw2d(:,:) = emps(:,:) * sn(:,:,1) * tmask(:,:,1) 
    375374      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux 
    376       CALL histwrite( nid_T, "sohefldo", it, qt            , ndim_hT, ndex_hT )   ! total heat flux 
     375      CALL histwrite( nid_T, "sohefldo", it, qsr + qns     , ndim_hT, ndex_hT )   ! total heat flux 
    377376      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux 
    378377      CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth 
    … …  
    397396      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    398397#endif 
    399 #if ( defined key_coupled && ! defined key_lim3 )  
     398#if ( defined key_coupled && ! ( defined key_lim3 || defined key_lim2 ) )  
    400399      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    401400      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    … …  
    412411      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content 
    413412#endif 
    414 #if defined key_lim3 &&  defined key_coupled  
     413#if ( defined key_lim3 || defined key_lim2 ) &&  defined key_coupled  
    415414      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
    416415      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
    … …  
    418417 
    419418      CALL histwrite( nid_T, "vozocrtx", it, un            , ndim_T , ndex_T )    ! i-current 
    420       CALL histwrite( nid_T, "sozotaux", it, taux          , ndim_hT, ndex_hT )   ! i-wind stress 
     419      CALL histwrite( nid_T, "sozotaux", it, utau          , ndim_hT, ndex_hT )   ! i-wind stress 
    421420      CALL histwrite( nid_T, "vomecrty", it, vn            , ndim_T , ndex_T  )   ! j-current 
    422       CALL histwrite( nid_T, "sometauy", it, tauy          , ndim_hT, ndex_hT )   ! j-wind stress 
     421      CALL histwrite( nid_T, "sometauy", it, vtau          , ndim_hT, ndex_hT )   ! j-wind stress 
    423422#if defined key_zdftke 
    424423      CALL histwrite( nid_T, "votlsdis", it, e_dis         , ndim_T , ndex_T )    ! Diss. Turb. lenght scale 

  • trunk/NEMO/C1D_SRC/icestp1d.F90

    r833 r888  
    66   !! History :   9.0  !  04-10  (C. Ethe)  from icestp, 1D configuration 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_cfg_1d && defined key_lim3 
     8#if defined key_cfg_1d && ( defined key_lim3 || defined key_lim2 ) 
    99   !!---------------------------------------------------------------------- 
    1010   !!   'key_cfg_1d'  .AND.                                1D Configuration 
    11    !!   'key_lim3'                                     Lim sea-ice model 
     11   !!   'key_lim2' OR 'key_lim3' :             LIM 2.0 or 3.0 sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    1313   !!---------------------------------------------------------------------- 
    … …  
    1818   USE in_out_manager  ! I/O manager 
    1919   USE ice_oce         ! ice variables 
    20    USE flx_oce         ! forcings variables 
    21    USE dom_ice         ! LIM sea-ice domain 
    22    USE cpl_oce         ! coupled ocean-atmosphere variables 
    23    USE blk_oce         ! bulk variables 
     20   USE dom_ice_2       ! LIM sea-ice domain 
     21   USE sbc_oce         ! surface boundary condition: ocean 
     22   USE sbc_ice         ! surface boundary condition: ice 
    2423   USE daymod          ! calendar 
    2524   USE phycst          ! Define parameters for the routines 
    26    USE taumod          ! surface stress forcing 
    27    USE ice             ! ice variables 
     25   USE ice_2           ! ice variables 
    2826   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    29    USE limthd 
    30    USE limflx 
    31    USE limwri 
    32    USE limrst 
    33  
    34    USE ocesbc          ! thermohaline fluxes 
    35    USE flxmod          ! thermohaline forcing 
    36    USE flxrnf          ! runoffs forcing 
     27   USE limthd_2 
     28   USE limwri_2 
     29   USE limrst_2 
     30 
    3731   USE tradmp          ! damping salinity trend 
    3832   USE dtatem          ! ocean temperature data 
    … …  
    5246   !!---------------------------------------------------------------------- 
    5347   !!   LIM 2.0 , UCL-LOCEAN-IPSL (2006)  
    54    !! $Header$  
     48   !! $Id$ 
    5549   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5650   !!---------------------------------------------------------------------- 
    … …  
    109103         u_io  (:,:) = u_io  (:,:) / FLOAT( nfice ) 
    110104         v_io  (:,:) = v_io  (:,:) / FLOAT( nfice ) 
    111          gtaux (:,:) = taux  (:,:) 
    112          gtauy (:,:) = tauy  (:,:) 
     105         gtaux (:,:) = utau  (:,:) 
     106         gtauy (:,:) = vtau  (:,:) 
    113107 
    114108         zsss_io (:,:) = SQRT( sss_io(:,:) )  
    … …  
    220214      IF( kt == nit000 ) THEN      
    221215         qsr    (:,:) = 0.e0 
    222          qt     (:,:) = 0.e0 
     216         qns    (:,:) = 0.e0 
    223217         qrp    (:,:) = 0.e0 
    224218         emp    (:,:) = 0.e0 
    … …  
    238232      ! ----------------- 
    239233       
    240       qt  (:,:) = fnsolar(:,:) + fsolar(:,:)     ! non solar heat flux + solar flux 
     234      qns (:,:) = fnsolar(:,:)                    ! non solar heat flux 
    241235      qsr (:,:) = fsolar(:,:)                     ! solar flux 
    242236       
    … …  
    261255         DO ji = 1, fs_jpim1   ! vertor opt. 
    262256            ztxy        = freezn(ji,jj)             ! ice/ocean indicator at T-points 
    263             taux(ji,jj) = (1.-ztxy) * taux(ji,jj) + ztxy * ftaux(ji,jj)    ! stress at the ocean surface 
    264             tauy(ji,jj) = (1.-ztxy) * tauy(ji,jj) + ztxy * ftauy(ji,jj) 
    265          END DO 
    266       END DO 
    267        
    268       ! boundary condition on the stress (taux,tauy) 
    269       CALL lbc_lnk( taux, 'U', -1. ) 
    270       CALL lbc_lnk( tauy, 'V', -1. ) 
     257            utau(ji,jj) = (1.-ztxy) * utau(ji,jj) + ztxy * ftaux(ji,jj)    ! stress at the ocean surface 
     258            vtau(ji,jj) = (1.-ztxy) * vtau(ji,jj) + ztxy * ftauy(ji,jj) 
     259         END DO 
     260      END DO 
     261       
     262      ! boundary condition on the stress (utau,vtau) 
     263      CALL lbc_lnk( utau, 'U', -1. ) 
     264      CALL lbc_lnk( vtau, 'V', -1. ) 
    271265       
    272266      ! Re-initialization of fluxes 

  • trunk/NEMO/C1D_SRC/step1d.F90

    r719 r888  
    1515   USE dom_oce         ! ocean space and time domain variables  
    1616   USE zdf_oce         ! ocean vertical physics variables 
     17   USE sbc_oce         ! surface boundary condition: ocean 
    1718   USE ldftra_oce 
    1819   USE ldfdyn_oce 
    … …  
    2425   USE dtatem          ! ocean temperature data           (dta_tem routine) 
    2526   USE dtasal          ! ocean salinity    data           (dta_sal routine) 
    26    USE dtasst          ! ocean sea surface temerature     (dta_sst routine) 
    27    USE taumod          ! surface stress                   (tau     routine) 
    28    USE flxmod          ! thermohaline fluxes              (flx     routine) 
    29    USE ocesbc          ! thermohaline fluxes              (oce_sbc routine) 
    30    USE flxrnf          ! runoffs                          (flx_rnf routine) 
    31    USE flxfwb          ! freshwater budget correction     (flx_fwb routine) 
    3227   USE ocfzpt          ! surface ocean freezing point    (oc_fz_pt routine) 
    3328 
    … …  
    7570   !!---------------------------------------------------------------------- 
    7671   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    77    !! $Header$  
     72   !! $Id$ 
    7873   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    7974   !!---------------------------------------------------------------------- 
    … …  
    157152         CALL prt_ctl(tab2d_1=emp    , clinfo1=' emp  -   : ', mask1=tmask, ovlap=1) 
    158153         CALL prt_ctl(tab2d_1=emps   , clinfo1=' emps -   : ', mask1=tmask, ovlap=1) 
    159          CALL prt_ctl(tab2d_1=qt     , clinfo1=' qt   -   : ', mask1=tmask, ovlap=1) 
     154         CALL prt_ctl(tab2d_1=qns    , clinfo1=' qns  -   : ', mask1=tmask, ovlap=1) 
    160155         CALL prt_ctl(tab2d_1=qsr    , clinfo1=' qsr  -   : ', mask1=tmask, ovlap=1) 
    161          CALL prt_ctl(tab2d_1=runoff , clinfo1=' runoff   : ', mask1=tmask, ovlap=1) 
    162156         CALL prt_ctl(tab3d_1=tmask  , clinfo1=' tmask    : ', mask1=tmask, ovlap=1, kdim=jpk) 
    163157         CALL prt_ctl(tab3d_1=tn     , clinfo1=' sst  -   : ', mask1=tmask, ovlap=1, kdim=1) 
    164158         CALL prt_ctl(tab3d_1=sn     , clinfo1=' sss  -   : ', mask1=tmask, ovlap=1, kdim=1) 
    165          CALL prt_ctl(tab2d_1=taux   , clinfo1=' tau  - x : ', mask1=umask, & 
    166             &         tab2d_2=tauy   , clinfo2='      - y : ', mask2=vmask, ovlap=1) 
     159         CALL prt_ctl(tab2d_1=utau   , clinfo1=' tau  - u : ', mask1=umask, & 
     160            &         tab2d_2=vtau   , clinfo2='      - v : ', mask2=vmask, ovlap=1) 
    167161      ENDIF 
    168162 

  • trunk/NEMO/LIM_SRC_2/dom_ice_2.F90

    r823 r888  
    11MODULE dom_ice_2 
    2 #if defined key_lim2 
    32   !!====================================================================== 
    43   !!                   ***  MODULE  dom_ice  *** 
    … …  
    76   !! History :   2.0  !  03-08  (C. Ethe)  Free form and module 
    87   !!---------------------------------------------------------------------- 
    9  
     8#if defined key_lim2 
    109   !!---------------------------------------------------------------------- 
    1110   !!   LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    12    !! $Header$ 
     11   !! $ Id: $ 
    1312   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1413   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_2/ice_2.F90

    r823 r888  
    44   !! Sea Ice physics:  diagnostics variables of ice defined in memory 
    55   !!===================================================================== 
     6   !! History :  2.0  !  03-08  (C. Ethe)  F90: Free form and module 
     7   !!---------------------------------------------------------------------- 
    68#if defined key_lim2 
    79   !!---------------------------------------------------------------------- 
    810   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    911   !!---------------------------------------------------------------------- 
    10    !! History : 
    11    !!   2.0  !  03-08  (C. Ethe)  F90: Free form and module 
    12    !!---------------------------------------------------------------------- 
    13    !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    14    !! $Header$ 
    15    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     12   !!  LIM 2.0, UCL-LOCEAN-IPSL (2006) 
     13   !! $ Id: $ 
     14   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1615   !!---------------------------------------------------------------------- 
    1716   !! * Modules used 
    … …  
    2120   PRIVATE 
    2221 
    23    !! * Share Module variables 
    24    INTEGER , PUBLIC ::   & !!: ** ice-dynamic namelist (namicedyn) ** 
    25       nbiter = 1      ,  &  !: number of sub-time steps for relaxation 
    26       nbitdr = 250          !: maximum number of iterations for relaxation 
     22   !!* ice-dynamic namelist (namicedyn) * 
     23   INTEGER , PUBLIC ::   nbiter = 1         !: number of sub-time steps for relaxation 
     24   INTEGER , PUBLIC ::   nbitdr = 250       !: maximum number of iterations for relaxation 
     25   REAL(wp), PUBLIC ::   epsd   = 1.0e-20   !: tolerance parameter for dynamic 
     26   REAL(wp), PUBLIC ::   alpha  = 0.5       !: coefficient for semi-implicit coriolis 
     27   REAL(wp), PUBLIC ::   dm     = 0.6e+03   !: diffusion constant for dynamics 
     28   REAL(wp), PUBLIC ::   om     = 0.5       !: relaxation constant 
     29   REAL(wp), PUBLIC ::   resl   = 5.0e-05   !: maximum value for the residual of relaxation 
     30   REAL(wp), PUBLIC ::   cw     = 5.0e-03   !: drag coefficient for oceanic stress 
     31   REAL(wp), PUBLIC ::   angvg  = 0.e0      !: turning angle for oceanic stress 
     32   REAL(wp), PUBLIC ::   pstar  = 1.0e+04   !: first bulk-rheology parameter 
     33   REAL(wp), PUBLIC ::   c_rhg  = 20.e0     !: second bulk-rhelogy parameter 
     34   REAL(wp), PUBLIC ::   etamn  = 0.e+07    !: minimun value for viscosity 
     35   REAL(wp), PUBLIC ::   creepl = 2.e-08    !: creep limit 
     36   REAL(wp), PUBLIC ::   ecc    = 2.e0      !: eccentricity of the elliptical yield curve 
     37   REAL(wp), PUBLIC ::   ahi0   = 350.e0    !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    2738 
    28    REAL(wp), PUBLIC ::   & !!: ** ice-dynamic namelist (namicedyn) ** 
    29       epsd   = 1.0e-20,  &  !: tolerance parameter for dynamic 
    30       alpha  = 0.5    ,  &  !: coefficient for semi-implicit coriolis 
    31       dm     = 0.6e+03,  &  !: diffusion constant for dynamics 
    32       om     = 0.5    ,  &  !: relaxation constant 
    33       resl   = 5.0e-05,  &  !: maximum value for the residual of relaxation 
    34       cw     = 5.0e-03,  &  !: drag coefficient for oceanic stress 
    35       angvg  = 0.e0   ,  &  !: turning angle for oceanic stress 
    36       pstar  = 1.0e+04,  &  !: first bulk-rheology parameter 
    37       c_rhg  = 20.e0  ,  &  !: second bulk-rhelogy parameter 
    38       etamn  = 0.e+07,   &  !: minimun value for viscosity 
    39       creepl = 2.e-08,   &  !: creep limit 
    40       ecc    = 2.e0   ,  &  !: eccentricity of the elliptical yield curve 
    41       ahi0   = 350.e0       !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
     39   REAL(wp), PUBLIC ::   usecc2             !:  = 1.0 / ( ecc * ecc ) 
     40   REAL(wp), PUBLIC ::   rhoco              !: = rau0 * cw 
     41   REAL(wp), PUBLIC ::   sangvg, cangvg     !: sin and cos of the turning angle for ocean stress 
     42   REAL(wp), PUBLIC ::   pstarh             !: pstar / 2.0 
    4243 
    43    REAL(wp), PUBLIC ::   &  !: 
    44       usecc2          ,  &  !:  = 1.0 / ( ecc * ecc ) 
    45       rhoco           ,  &  !: = rau0 * cw 
    46       sangvg, cangvg  ,  &  !: sin and cos of the turning angle for ocean stress 
    47       pstarh                !: pstar / 2.0 
     44   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
     45   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
     46   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnm , hicm   !: mean snow and ice thicknesses 
     47   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s                 !: friction velocity 
    4848 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  &  !: 
    50       u_oce, v_oce,      &  !: surface ocean velocity used in ice dynamics 
    51       ahiu , ahiv ,      &  !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
    52       pahu , pahv ,      &  !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
    53       hsnm , hicm ,      &  !: mean snow and ice thicknesses 
    54       ust2s                 !: friction velocity 
     49   !!* diagnostic quantities 
     50!! REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   firic         !: IR flux over the ice (only used for outputs) 
     51!! REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fcsic         !: Sensible heat flux over the ice (only used for outputs) 
     52!! REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fleic         !: Latent heat flux over the ice (only used for outputs) 
     53!! REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qlatic        !: latent flux (only used for outputs) 
     54   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvosif       !: Variation of volume at surface (only used for outputs) 
     55   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvobif       !: Variation of ice volume at the bottom ice (only used for outputs) 
     56   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdvolif       !: Total variation of ice volume (only used for outputs) 
     57   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvonif       !: Lateral Variation of ice volume (only used for outputs) 
    5558 
    56    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  &  !: 
    57         sst_ini,         &  !: sst read from a file for ice model initialization  
    58         sss_ini             !: sss read from a file for ice model initialization  
     59   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sist          !: Sea-Ice Surface Temperature (Kelvin ??? degree ??? I don't know) 
     60   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS 
     61   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hicif         !: Ice thickness 
     62   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnif         !: Snow thickness 
     63   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hicifp        !: Ice production/melting 
     64   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   frld          !: Leads fraction = 1-a/totalarea 
     65   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   phicif        !: ice thickness  at previous time  
     66   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pfrld         !: Leads fraction at previous time   
     67   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qstoif        !: Energy stored in the brine pockets 
     68   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fbif          !: Heat flux at the ice base 
     69   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdmsnif       !: Variation of snow mass 
     70   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdmicif       !: Variation of ice mass 
     71   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qldif         !: heat balance of the lead (or of the open ocean) 
     72   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qcmif         !: Energy needed to bring the ocean surface layer until its freezing  
     73   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdtcn         !: net downward heat flux from the ice to the ocean 
     74   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2) 
     75   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   thcm          !: part of the solar energy used in the lead heat budget 
     76   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fstric        !: Solar flux transmitted trough the ice 
     77   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ffltbif       !: Array linked with the max heat contained in brine pockets (?) 
     78   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fscmbq        !: Linked with the solar flux below the ice (?) 
     79   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fsbbq         !: Also linked with the solar flux below the ice (?) 
     80   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qfvbq         !: Array used to store energy in case of toral lateral ablation (?) 
     81   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dmgwi         !: Variation of the mass of snow ice 
    5982 
    60    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    61       firic  ,   &  !: IR flux over the ice (only used for outputs) 
    62       fcsic  ,   &  !: Sensible heat flux over the ice (only used for outputs) 
    63       fleic  ,   &  !: Latent heat flux over the ice (only used for outputs) 
    64       qlatic ,   &  !: latent flux 
    65       rdvosif,   &  !: Variation of volume at surface (only used for outputs) 
    66       rdvobif,   &  !: Variation of ice volume at the bottom ice (only used for outputs) 
    67       fdvolif,   &  !: Total variation of ice volume (only used for outputs) 
    68       rdvonif,   &  !: Lateral Variation of ice volume (only used for outputs) 
    69       sist   ,   &  !: Sea-Ice Surface Temperature (Kelvin ??? degree ??? I don't know) 
    70       tfu    ,   &  !: Melting point temperature of sea water 
    71       hsnif  ,   &  !: Snow thickness 
    72       hicif  ,   &  !: Ice thickness 
    73       hicifp ,   &  !: Ice production/melting 
    74       frld   ,   &  !: Leads fraction = 1-a/totalarea 
    75       phicif ,   &  !: ice thickness  at previous time  
    76       pfrld  ,   &  !: Leads fraction at previous time   
    77       qstoif ,   &  !: Energy stored in the brine pockets 
    78       fbif   ,   &  !: Heat flux at the ice base 
    79       rdmsnif,   &  !: Variation of snow mass 
    80       rdmicif,   &  !: Variation of ice mass 
    81       qldif  ,   &  !: heat balance of the lead (or of the open ocean) 
    82       qcmif  ,   &  !: Energy needed to bring the ocean surface layer until its freezing  
    83       fdtcn  ,   &  !: net downward heat flux from the ice to the ocean 
    84       qdtcn  ,   &  !: energy from the ice to the ocean 
    85       !             !  point (at a factor 2) 
    86       thcm   ,   &  !: part of the solar energy used in the lead heat budget 
    87       fstric ,   &  !: Solar flux transmitted trough the ice 
    88       ffltbif,   &  !: Array linked with the max heat contained in brine pockets (?) 
    89       fscmbq ,   &  !: Linked with the solar flux below the ice (?) 
    90       fsbbq  ,   &  !: Also linked with the solar flux below the ice (?) 
    91       qfvbq  ,   &  !: Array used to store energy in case of toral lateral ablation (?) 
    92       dmgwi         !: Variation of the mass of snow ice 
     83   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   albege        !: Albedo of the snow or ice (only for outputs) 
     84   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   albecn        !: Albedo of the ocean (only for outputs) 
     85   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tauc          !: Cloud optical depth 
    9386 
    94    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    95       albege ,   &  !: Albedo of the snow or ice (only for outputs) 
    96       albecn ,   &  !: Albedo of the ocean (only for outputs) 
    97       tauc   ,   &  !: Cloud optical depth 
    98       sdvt          !: u*^2/(Stress/density) 
     87   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ui_ice, vi_ice   !: two components of the ice   velocity at I-point (m/s) 
     88   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ui_oce, vi_oce   !: two components of the ocean velocity at I-point (m/s) 
    9989 
     90   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpsmax)     ::   scal0   !: ??? 
     91   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) ::   tbif  !: Temperature inside the ice/snow layer 
    10092 
    101    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    102       u_ice, v_ice,   &  !: two components of the ice velocity (m/s) 
    103       tio_u, tio_v       !: two components of the ice-ocean stress (N/m2) 
     93!! REAL(wp), DIMENSION(jpi,jpj,0:jpkmax+1) ::   reslum        !: Relative absorption of solar radiation in each ocean level 
    10494 
    105    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpsmax) ::   &  !: 
    106       scal0              !: ??? 
    107  
    108    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) ::   &  !: 
    109       tbif          !: Temperature inside the ice/snow layer 
    110  
    111    REAL(wp), DIMENSION(jpi,jpj,0:jpkmax+1) ::    &  !: 
    112       reslum        !: Relative absorption of solar radiation in each ocean level 
    113  
    114    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    115          sxice, syice, sxxice, syyice, sxyice,      &  !: moments for advection 
    116          sxsn,  sysn,  sxxsn,  syysn,  sxysn,       &  !: 
    117          sxa,   sya,   sxxa,   syya,   sxya,        &  !: 
    118          sxc0,  syc0,  sxxc0,  syyc0,  sxyc0,       &  !: 
    119          sxc1,  syc1,  sxxc1,  syyc1,  sxyc1,       &  !: 
    120          sxc2,  syc2,  sxxc2,  syyc2,  sxyc2,       &  !: 
    121          sxst,  syst,  sxxst,  syyst,  sxyst           !: 
     95   !!* moment used in the advection scheme 
     96   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxice, syice, sxxice, syyice, sxyice   !: for ice  volume 
     97   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxsn,  sysn,  sxxsn,  syysn,  sxysn    !: for snow volume 
     98   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxa,   sya,   sxxa,   syya,   sxya     !: for ice cover area 
     99   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc0,  syc0,  sxxc0,  syyc0,  sxyc0    !: for heat content of snow 
     100   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc1,  syc1,  sxxc1,  syyc1,  sxyc1    !: for heat content of 1st ice layer 
     101   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer 
     102   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets 
    122103 
    123104#else 

  • trunk/NEMO/LIM_SRC_2/iceini_2.F90

    r823 r888  
    1717   USE dom_oce 
    1818   USE dom_ice_2 
    19    USE in_out_manager 
    2019   USE ice_oce         ! ice variables 
    21    USE flx_oce 
     20   USE sbc_oce         ! surface boundary condition: ocean 
     21   USE sbc_ice         ! surface boundary condition: ice 
    2222   USE phycst          ! Define parameters for the routines 
    2323   USE ocfzpt 
    … …  
    2727   USE limrst_2    
    2828   USE ini1d           ! initialization of the 1D configuration 
     29   USE in_out_manager 
    2930       
    3031   IMPLICIT NONE 
    … …  
    4041   !!---------------------------------------------------------------------- 
    4142   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    42    !! $Header$  
     43   !! $ Id: $  
    4344   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4445   !!---------------------------------------------------------------------- 
    … …  
    6263                  
    6364      ! Louvain la Neuve Ice model 
    64       IF( nacc == 1 ) THEN 
    65           dtsd2   = nfice * rdtmin * 0.5 
    66           rdt_ice = nfice * rdtmin 
    67       ELSE 
    68           dtsd2   = nfice * rdt * 0.5 
    69           rdt_ice = nfice * rdt 
    70       ENDIF 
     65      dtsd2   = nn_fsbc * rdttra(1) * 0.5 
     66      rdt_ice = nn_fsbc * rdttra(1) 
    7167 
    7268      CALL lim_msh_2                  ! ice mesh initialization 

  • trunk/NEMO/LIM_SRC_2/limadv_2.F90

    r823 r888  
    3333   !!---------------------------------------------------------------------- 
    3434   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    35    !! $Header$  
     35   !! $ Id: $  
    3636   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3737   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_2/limdia_2.F90

    r823 r888  
    1919   USE par_ice_2       ! ice parameters 
    2020   USE ice_oce         ! ice variables 
     21   USE sbc_oce         ! surface boundary condition variables 
    2122   USE daymod          ! 
    2223   USE dom_ice_2       ! 
    … …  
    2829   PRIVATE 
    2930 
    30    PUBLIC               lim_dia_2          ! called by ice_step 
     31   PUBLIC               lim_dia_2          ! called by sbc_ice_lim_2 
    3132   INTEGER, PUBLIC ::   ntmoy   = 1 ,   &  !: instantaneous values of ice evolution or averaging ntmoy 
    3233      &                 ninfo   = 1        !: frequency of ouputs on file ice_evolu in case of averaging 
    … …  
    5859   !!---------------------------------------------------------------------- 
    5960   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    60    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limdia.F90,v 1.9 2007/06/29 17:03:12 opalod Exp $  
     61   !! $ Id: $ 
    6162   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6263   !!---------------------------------------------------------------------- 
    … …  
    8788 
    8889      nv = 1  
    89       vinfor(nv) = REAL( kt + nfice - 1 ) 
     90      vinfor(nv) = REAL( kt + nn_fsbc - 1 ) 
    9091      nv = nv + 1 
    9192      vinfor(nv) = nyear 
    … …  
    107108               zicevol = zarea   * hicif(ji,jj) 
    108109               zsnwvol = zarea   * hsnif(ji,jj) 
    109                zicespd = zicevol * ( u_ice(ji,jj) * u_ice(ji,jj)   & 
    110                   &                + v_ice(ji,jj) * v_ice(ji,jj) ) 
     110               zicespd = zicevol * ( ui_ice(ji,jj) * ui_ice(ji,jj)   & 
     111                  &                + vi_ice(ji,jj) * vi_ice(ji,jj) ) 
    111112               vinfor(nv+ 1) = vinfor(nv+ 1) + zarea 
    112113               vinfor(nv+ 3) = vinfor(nv+ 3) + zextent15 
    … …  
    133134                zicevol = zarea   * hicif(ji,jj) 
    134135                zsnwvol = zarea   * hsnif(ji,jj) 
    135                 zicespd = zicevol * ( u_ice(ji,jj) * u_ice(ji,jj)   & 
    136                    &                + v_ice(ji,jj) * v_ice(ji,jj) ) 
     136                zicespd = zicevol * ( ui_ice(ji,jj) * ui_ice(ji,jj)   & 
     137                   &                + vi_ice(ji,jj) * vi_ice(ji,jj) ) 
    137138                vinfor(nv+ 1) = vinfor(nv+ 1) + zarea 
    138139                vinfor(nv+ 3) = vinfor(nv+ 3) + zextent15 
    … …  
    154155     
    155156       ! oututs on file ice_evolu     
    156        IF( MOD( kt + nfice - 1, ninfo ) == 0 ) THEN 
     157       IF( MOD( kt + nn_fsbc - 1, ninfo ) == 0 ) THEN 
    157158          WRITE(numevo_ice,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo ) 
    158159          naveg = 0 
    … …  
    227228 
    228229       ! Definition et Ecriture de l'entete : nombre d'enregistrements  
    229        ndeb   = ( nit000 - 1 + nfice - 1 ) / ninfo 
    230        IF( nit000 - 1 + nfice == 1 ) ndeb = -1 
    231  
    232        nferme = ( nitend + nfice - 1 ) / ninfo ! nit000 - 1 + nfice - 1 + nitend - nit000 + 1 
     230       ndeb   = ( nit000 - 1 + nn_fsbc - 1 ) / ninfo 
     231       IF( nit000 - 1 + nn_fsbc == 1 ) ndeb = -1 
     232 
     233       nferme = ( nitend + nn_fsbc - 1 ) / ninfo ! nit000 - 1 + nn_fsbc - 1 + nitend - nit000 + 1 
    233234       ntot   = nferme - ndeb 
    234235       ndeb   = ninfo * ( 1 + ndeb ) 

  • trunk/NEMO/LIM_SRC_2/limdmp_2.F90

    r823 r888  
    4040   !!---------------------------------------------------------------------- 
    4141   !!   LIM 2.0 , UCL-LOCEAN-IPSL  (2006) 
    42    !! $Header$ 
     42   !! $ Id: $ 
    4343   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_2/limdyn_2.F90

    r823 r888  
    44   !!   Sea-Ice dynamics :   
    55   !!====================================================================== 
     6   !! History :   1.0  !  01-04  (LIM)  Original code 
     7   !!             2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp 
     8   !!             2.0  !  03-08  (C. Ethe) add lim_dyn_init 
     9   !!             2.0  !  06-07  (G. Madec)  Surface module 
     10   !!--------------------------------------------------------------------- 
    611#if defined key_lim2 
    712   !!---------------------------------------------------------------------- 
    … …  
    1116   !!    lim_dyn_init_2 : initialization and namelist read 
    1217   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    14    USE phycst 
    15    USE in_out_manager  ! I/O manager 
    16    USE dom_ice_2 
    17    USE dom_oce         ! ocean space and time domain 
    18    USE ice_2 
    19    USE ice_oce 
    20    USE iceini_2 
    21    USE limistate_2 
    22    USE limrhg_2        ! ice rheology 
    23    USE lbclnk 
    24    USE lib_mpp 
    25    USE prtctl          ! Print control 
     18   USE dom_oce        ! ocean space and time domain 
     19   USE sbc_oce        ! 
     20   USE phycst         ! 
     21   USE ice_2          ! 
     22   USE ice_oce        ! 
     23   USE dom_ice_2      ! 
     24   USE iceini_2       ! 
     25   USE limistate_2    ! 
     26   USE limrhg_2       ! ice rheology 
     27 
     28   USE lbclnk         ! 
     29   USE lib_mpp        ! 
     30   USE in_out_manager ! I/O manager 
     31   USE prtctl         ! Print control 
    2632 
    2733   IMPLICIT NONE 
    2834   PRIVATE 
    2935 
    30    !! * Accessibility 
    31    PUBLIC lim_dyn_2  ! routine called by ice_step 
     36   PUBLIC   lim_dyn_2 ! routine called by sbc_ice_lim 
    3237 
    3338   !! * Module variables 
    3439   REAL(wp)  ::  rone    = 1.e0   ! constant value 
    3540 
    36    !!---------------------------------------------------------------------- 
    37    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    38    !! $Header$  
    39    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     41#  include "vectopt_loop_substitute.h90" 
     42   !!---------------------------------------------------------------------- 
     43   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
     44   !! $ Id: $ 
     45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4046   !!---------------------------------------------------------------------- 
    4147 
    … …  
    4652      !!               ***  ROUTINE lim_dyn_2  *** 
    4753      !!                
    48       !! ** Purpose :   compute ice velocity and ocean-ice stress 
     54      !! ** Purpose :   compute ice velocity and ocean-ice friction velocity 
    4955      !!                 
    5056      !! ** Method  :  
    … …  
    5258      !! ** Action  : - Initialisation 
    5359      !!              - Call of the dynamic routine for each hemisphere 
    54       !!              - computation of the stress at the ocean surface          
     60      !!              - computation of the friction velocity at the sea-ice base 
    5561      !!              - treatment of the case if no ice dynamic 
    56       !! History : 
    57       !!   1.0  !  01-04  (LIM)  Original code 
    58       !!   2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp 
    5962      !!--------------------------------------------------------------------- 
    6063      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    61  
    62       INTEGER ::   ji, jj             ! dummy loop indices 
    63       INTEGER ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
    64       REAL(wp) ::   & 
    65          ztairx, ztairy,           &  ! tempory scalars 
    66          zsang , zmod,             & 
    67          ztglx , ztgly ,           & 
    68          zt11, zt12, zt21, zt22 ,  & 
    69          zustm, zsfrld, zsfrldm4,  & 
    70          zu_ice, zv_ice, ztair2 
    71       REAL(wp),DIMENSION(jpj) ::   & 
    72          zind,                     &  ! i-averaged indicator of sea-ice 
    73          zmsk                         ! i-averaged of tmask 
     64      !! 
     65      INTEGER  ::   ji, jj             ! dummy loop indices 
     66      INTEGER  ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
     67      REAL(wp) ::   zcoef              ! temporary scalar 
     68      REAL(wp), DIMENSION(jpj)     ::   zind           ! i-averaged indicator of sea-ice 
     69      REAL(wp), DIMENSION(jpj)     ::   zmsk           ! i-averaged of tmask 
     70      REAL(wp), DIMENSION(jpi,jpj) ::   zu_io, zv_io   ! ice-ocean velocity 
    7471      !!--------------------------------------------------------------------- 
    7572 
    76       IF( kt == nit000  )   CALL lim_dyn_init_2   ! Initialization (first time-step only) 
     73      IF( kt == nit000 )   CALL lim_dyn_init_2   ! Initialization (first time-step only) 
    7774       
    78       IF ( ln_limdyn ) THEN 
    79  
     75      IF( ln_limdyn ) THEN 
     76         ! 
    8077         ! Mean ice and snow thicknesses.           
    8178         hsnm(:,:)  = ( 1.0 - frld(:,:) ) * hsnif(:,:) 
    8279         hicm(:,:)  = ( 1.0 - frld(:,:) ) * hicif(:,:) 
    83  
    84          u_oce(:,:)  = u_io(:,:) * tmu(:,:) 
    85          v_oce(:,:)  = v_io(:,:) * tmu(:,:) 
    86         
    87          !                                         ! Rheology (ice dynamics) 
    88          !                                         ! ======== 
     80         ! 
     81         !                                     ! Rheology (ice dynamics) 
     82         !                                     ! ======== 
    8983          
    9084         !  Define the j-limits where ice rheology is computed 
    … …  
    9488            i_j1 = 1    
    9589            i_jpj = jpj 
    96             IF(ln_ctl)    THEN 
    97                CALL prt_ctl_info('lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj) 
    98             ENDIF 
     90            IF(ln_ctl)   CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    9991            CALL lim_rhg_2( i_j1, i_jpj ) 
    100  
     92            ! 
    10193         ELSE                                 ! optimization of the computational area 
    102  
     94            ! 
    10395            DO jj = 1, jpj 
    10496               zind(jj) = SUM( frld (:,jj  ) )   ! = FLOAT(jpj) if ocean everywhere on a j-line 
    10597               zmsk(jj) = SUM( tmask(:,jj,1) )   ! = 0          if land  everywhere on a j-line 
    106    !!i         write(numout,*) narea, 'limdyn' , jj, zind(jj), zmsk(jj) 
    107             END DO 
    108  
     98            END DO 
     99            ! 
    109100            IF( l_jeq ) THEN                     ! local domain include both hemisphere 
    110101               !                                 ! Rheology is computed in each hemisphere 
    … …  
    118109               i_j1 = MAX( 1, i_j1-1 ) 
    119110               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    120      
     111               !  
    121112               CALL lim_rhg_2( i_j1, i_jpj ) 
    122      
     113               !  
    123114               ! Southern hemisphere 
    124115               i_j1  =  1  
    … …  
    129120               i_jpj = MIN( jpj, i_jpj+2 ) 
    130121               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    131      
     122               !  
    132123               CALL lim_rhg_2( i_j1, i_jpj ) 
    133      
     124               !  
    134125            ELSE                                 ! local domain extends over one hemisphere only 
    135126               !                                 ! Rheology is computed only over the ice cover 
    … …  
    148139     
    149140               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    150      
     141               !  
    151142               CALL lim_rhg_2( i_j1, i_jpj ) 
    152  
     143               ! 
    153144            ENDIF 
    154  
     145            ! 
    155146         ENDIF 
    156147 
    157          IF(ln_ctl)   THEN  
    158             CALL prt_ctl(tab2d_1=u_oce , clinfo1=' lim_dyn  : u_oce :', tab2d_2=v_oce , clinfo2=' v_oce :') 
    159             CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_dyn  : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :') 
    160          ENDIF 
    161           
    162          !                                         ! Ice-Ocean stress 
    163          !                                         ! ================ 
     148         IF(ln_ctl)   CALL prt_ctl(tab2d_1=ui_ice , clinfo1=' lim_dyn  : ui_ice :', tab2d_2=vi_ice , clinfo2=' vi_ice :') 
     149          
     150         ! computation of friction velocity 
     151         ! -------------------------------- 
     152         ! ice-ocean velocity at U & V-points (ui_ice vi_ice at I-point ; ssu_m, ssv_m at U- & V-points) 
     153          
     154         DO jj = 1, jpjm1 
     155            DO ji = 1, fs_jpim1   ! vector opt. 
     156               zu_io(ji,jj) = 0.5 * ( ui_ice(ji+1,jj+1) + ui_ice(ji+1,jj  ) ) - ssu_m(ji,jj) 
     157               zv_io(ji,jj) = 0.5 * ( vi_ice(ji+1,jj+1) + vi_ice(ji  ,jj+1) ) - ssv_m(ji,jj) 
     158            END DO 
     159         END DO 
     160         ! frictional velocity at T-point 
    164161         DO jj = 2, jpjm1 
    165             zsang  = SIGN(1.e0, gphif(1,jj-1) ) * sangvg 
    166             DO ji = 2, jpim1 
    167                ! computation of wind stress over ocean in X and Y direction 
    168 #if defined key_coupled && defined key_lim_cp1 
    169                ztairx =  frld(ji-1,jj  ) * gtaux(ji-1,jj  ) + frld(ji,jj  ) * gtaux(ji,jj  )      & 
    170                   &    + frld(ji-1,jj-1) * gtaux(ji-1,jj-1) + frld(ji,jj-1) * gtaux(ji,jj-1) 
    171  
    172                ztairy =  frld(ji-1,jj  ) * gtauy(ji-1,jj  ) + frld(ji,jj  ) * gtauy(ji,jj  )      & 
    173                   &    + frld(ji-1,jj-1) * gtauy(ji-1,jj-1) + frld(ji,jj-1) * gtauy(ji,jj-1) 
    174 #else 
    175                zsfrld  = frld(ji,jj) + frld(ji-1,jj) + frld(ji-1,jj-1) + frld(ji,jj-1) 
    176                ztairx  = zsfrld * gtaux(ji,jj) 
    177                ztairy  = zsfrld * gtauy(ji,jj) 
    178 #endif 
    179                zsfrldm4 = 4 - frld(ji,jj) - frld(ji-1,jj) - frld(ji-1,jj-1) - frld(ji,jj-1) 
    180                zu_ice   = u_ice(ji,jj) - u_oce(ji,jj) 
    181                zv_ice   = v_ice(ji,jj) - v_oce(ji,jj) 
    182                zmod     = SQRT( zu_ice * zu_ice + zv_ice * zv_ice )  
    183                ztglx   = zsfrldm4 * rhoco * zmod * ( cangvg * zu_ice - zsang * zv_ice )  
    184                ztgly   = zsfrldm4 * rhoco * zmod * ( cangvg * zv_ice + zsang * zu_ice )  
    185  
    186                tio_u(ji,jj) = - ( ztairx + 1.0 * ztglx ) / ( 4 * rau0 ) 
    187                tio_v(ji,jj) = - ( ztairy + 1.0 * ztgly ) / ( 4 * rau0 ) 
     162            DO ji = fs_2, fs_jpim1   ! vector opt. 
     163               ust2s(ji,jj) = 0.5 * cw                                                          & 
     164                  &         * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
     165                  &            + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj) 
    188166            END DO 
    189167         END DO 
    190           
    191          ! computation of friction velocity 
     168         ! 
     169      ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
     170         ! 
     171         zcoef = SQRT( 0.5 ) / rau0 
    192172         DO jj = 2, jpjm1 
    193             DO ji = 2, jpim1 
    194  
    195                zu_ice   = u_ice(ji-1,jj-1) - u_oce(ji-1,jj-1) 
    196                zv_ice   = v_ice(ji-1,jj-1) - v_oce(ji-1,jj-1) 
    197                zt11  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice ) 
    198  
    199                zu_ice   = u_ice(ji-1,jj) - u_oce(ji-1,jj) 
    200                zv_ice   = v_ice(ji-1,jj) - v_oce(ji-1,jj) 
    201                zt12  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice )  
    202  
    203                zu_ice   = u_ice(ji,jj-1) - u_oce(ji,jj-1) 
    204                zv_ice   = v_ice(ji,jj-1) - v_oce(ji,jj-1) 
    205                zt21  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice )  
    206  
    207                zu_ice   = u_ice(ji,jj) - u_oce(ji,jj) 
    208                zv_ice   = v_ice(ji,jj) - v_oce(ji,jj) 
    209                zt22  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice )  
    210  
    211                ztair2 = gtaux(ji,jj) * gtaux(ji,jj) + gtauy(ji,jj) * gtauy(ji,jj) 
    212  
    213                zustm =  ( 1 - frld(ji,jj) ) * 0.25 * ( zt11 + zt12 + zt21 + zt22 )        & 
    214                   &  +        frld(ji,jj)   * SQRT( ztair2 ) 
    215  
    216                ust2s(ji,jj) = ( zustm / rau0 ) * ( rone + sdvt(ji,jj) ) * tms(ji,jj) 
     173            DO ji = fs_2, fs_jpim1   ! vector opt. 
     174               ust2s(ji,jj) = zcoef * tms(ji,jj) * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     175                  &                                     + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) 
    217176            END DO 
    218177         END DO 
    219  
    220        ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
    221                      
    222           DO jj = 2, jpjm1 
    223              DO ji = 2, jpim1 
    224 #if defined key_coupled && defined key_lim_cp1 
    225                 tio_u(ji,jj) = - (  gtaux(ji  ,jj  ) + gtaux(ji-1,jj  )       & 
    226                    &              + gtaux(ji-1,jj-1) + gtaux(ji  ,jj-1) ) / ( 4 * rau0 ) 
    227  
    228                 tio_v(ji,jj) = - (  gtauy(ji  ,jj )  + gtauy(ji-1,jj  )       & 
    229                    &              + gtauy(ji-1,jj-1) + gtauy(ji  ,jj-1) ) / ( 4 * rau0 ) 
    230 #else 
    231                 tio_u(ji,jj) = - gtaux(ji,jj) / rau0 
    232                 tio_v(ji,jj) = - gtauy(ji,jj) / rau0  
    233 #endif 
    234                 ztair2       = gtaux(ji,jj) * gtaux(ji,jj) + gtauy(ji,jj) * gtauy(ji,jj) 
    235                 zustm        = SQRT( ztair2  ) 
    236  
    237                 ust2s(ji,jj) = ( zustm / rau0 ) * ( rone + sdvt(ji,jj) ) * tms(ji,jj) 
    238             END DO 
    239          END DO 
    240  
     178         ! 
    241179      ENDIF 
    242  
     180      ! 
    243181      CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point 
    244       CALL lbc_lnk( tio_u, 'I', -1. )   ! I-point (i.e. ice U-V point) 
    245       CALL lbc_lnk( tio_v, 'I', -1. )   ! I-point (i.e. ice U-V point) 
    246  
    247       IF(ln_ctl) THEN  
    248             CALL prt_ctl(tab2d_1=tio_u , clinfo1=' lim_dyn  : tio_u :', tab2d_2=tio_v , clinfo2=' tio_v :') 
    249             CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :') 
    250       ENDIF 
     182      ! 
     183      IF(ln_ctl)   CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :') 
    251184 
    252185   END SUBROUTINE lim_dyn_2 
    … …  
    257190      !!                  ***  ROUTINE lim_dyn_init_2  *** 
    258191      !! 
    259       !! ** Purpose : Physical constants and parameters linked to the ice 
    260       !!      dynamics 
    261       !! 
    262       !! ** Method  :  Read the namicedyn namelist and check the ice-dynamic 
    263       !!       parameter values called at the first timestep (nit000) 
     192      !! ** Purpose :   Physical constants and parameters linked to the ice 
     193      !!              dynamics 
     194      !! 
     195      !! ** Method  :   Read the namicedyn namelist and check the ice-dynamic 
     196      !!              parameter values 
    264197      !! 
    265198      !! ** input   :   Namelist namicedyn 
    266       !! 
    267       !! history : 
    268       !!  8.5  ! 03-08 (C. Ethe) original code 
    269199      !!------------------------------------------------------------------- 
    270200      NAMELIST/namicedyn/ epsd, alpha,     & 
    … …  
    273203      !!------------------------------------------------------------------- 
    274204 
    275       ! Define the initial parameters 
    276       ! ------------------------- 
    277  
    278       ! Read Namelist namicedyn 
    279       REWIND ( numnam_ice ) 
     205      REWIND ( numnam_ice )                       ! Read Namelist namicedyn 
    280206      READ   ( numnam_ice  , namicedyn ) 
    281       IF(lwp) THEN 
     207 
     208      IF(lwp) THEN                                ! Control print 
    282209         WRITE(numout,*) 
    283210         WRITE(numout,*) 'lim_dyn_init_2: ice parameters for ice dynamics ' 
    … …  
    291218         WRITE(numout,*) '       maximum value for the residual of relaxation     resl   = ', resl 
    292219         WRITE(numout,*) '       drag coefficient for oceanic stress              cw     = ', cw 
    293          WRITE(numout,*) '       turning angle for oceanic stress                 angvg  = ', angvg 
     220         WRITE(numout,*) '       turning angle for oceanic stress                 angvg  = ', angvg, ' degrees' 
    294221         WRITE(numout,*) '       first bulk-rheology parameter                    pstar  = ', pstar 
    295222         WRITE(numout,*) '       second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
    … …  
    303230      usecc2 = 1.0 / ( ecc * ecc ) 
    304231      rhoco  = rau0 * cw 
    305       angvg  = angvg * rad 
     232      angvg  = angvg * rad      ! convert angvg from degree to radian 
    306233      sangvg = SIN( angvg ) 
    307234      cangvg = COS( angvg ) 
    308235      pstarh = pstar / 2.0 
    309       sdvt(:,:) = 0.e0 
    310  
    311       !  Diffusion coefficients. 
    312       ahiu(:,:) = ahi0 * umask(:,:,1) 
     236      ! 
     237      ahiu(:,:) = ahi0 * umask(:,:,1)            ! Ice eddy Diffusivity coefficients. 
    313238      ahiv(:,:) = ahi0 * vmask(:,:,1) 
    314  
     239      ! 
    315240   END SUBROUTINE lim_dyn_init_2 
    316241 

  • trunk/NEMO/LIM_SRC_2/limhdf_2.F90

    r823 r888  
    66#if defined key_lim2 
    77   !!---------------------------------------------------------------------- 
    8    !!   'key_lim2'  i                                 LIM 2.0 sea-ice model 
     8   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    99   !!---------------------------------------------------------------------- 
    1010   !!   lim_hdf_2  : diffusion trend on sea-ice variable 
    … …  
    3434   !!---------------------------------------------------------------------- 
    3535   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    36    !! $Header$  
     36   !! $ Id: $ 
    3737   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3838   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_2/limistate_2.F90

    r823 r888  
    44   !!              Initialisation of diagnostics ice variables 
    55   !!====================================================================== 
    6    !! History :   2.0  !  01-04  (C. Ethe, G. Madec)  Original code 
     6   !! History :   1.0  !  01-04  (C. Ethe, G. Madec)  Original code 
     7   !!             2.0  !  03-08  (G. Madec)  add lim_istate_init 
    78   !!                  !  04-04  (S. Theetten) initialization from a file 
    89   !!                  !  06-07  (S. Masson)  IOM to read the restart 
     10   !!                  !  07-10  (G. Madec)  surface module 
    911   !!-------------------------------------------------------------------- 
    1012#if defined key_lim2 
    … …  
    1820   USE phycst 
    1921   USE ocfzpt 
    20    USE oce             ! dynamics and tracers variables      !!gm used??? 
    21    USE dom_oce                                                     !!gm used??? 
    2222   USE par_ice_2       ! ice parameters 
    2323   USE ice_oce         ! ice variables 
    2424   USE dom_ice_2 
    2525   USE lbclnk 
     26   USE oce 
    2627   USE ice_2 
    2728   USE iom 
    … …  
    4748   !!---------------------------------------------------------------------- 
    4849   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
    49    !! $Header$  
     50   !! $ Id: $ 
    5051   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5152   !!---------------------------------------------------------------------- 
    … …  
    6667      REAL(wp), DIMENSION(jpi,jpj) ::   ztn   ! workspace 
    6768      !-------------------------------------------------------------------- 
    68  
    69        CALL lim_istate_init_2   !  reading the initials parameters of the ice 
    70  
    71       !-- Initialisation of sst,sss,u,v do i=1,jpi 
    72       u_io(:,:)  = 0.e0       ! ice velocity in x direction 
    73       v_io(:,:)  = 0.e0       ! ice velocity in y direction 
    74  
    75       IF( ln_limini ) THEN    !  
    76          
    77          ! Initialisation at tn if no ice or sst_ini if ice 
    78          ! Idem for salinity 
    79  
    80       !--- Criterion for presence (zidto=1.) or absence (zidto=0.) of ice 
    81          DO jj = 1 , jpj 
    82             DO ji = 1 , jpi 
    83                 
    84                zidto = MAX(zzero, - SIGN(1.,frld(ji,jj) - 1.)) 
    85                 
    86                sst_io(ji,jj) = ( nfice - 1 ) * (zidto * sst_ini(ji,jj)  + &   ! use the ocean initial values 
    87                     &          (1.0 - zidto ) * ( tn(ji,jj,1) + rt0 ))        ! tricky trick *(nfice-1) ! 
    88                sss_io(ji,jj) = ( nfice - 1 ) * (zidto * sss_ini(ji,jj) + & 
    89                     &          (1.0 - zidto ) *  sn(ji,jj,1) ) 
    90  
    91                ! to avoid the the melting of ice, several layers (mixed layer) should be 
    92                ! set to sst_ini (sss_ini) if there is ice 
    93                ! example for one layer  
    94                ! tn(ji,jj,1) = zidto * ( sst_ini(ji,jj) - rt0 )  + (1.0 - zidto ) *  tn(ji,jj,1) 
    95                ! sn(ji,jj,1) = zidto * sss_ini(ji,jj)  + (1.0 - zidto ) *  sn(ji,jj,1) 
    96                ! tb(ji,jj,1) = tn(ji,jj,1) 
    97                ! sb(ji,jj,1) = sn(ji,jj,1) 
    98             END DO 
    99          END DO 
    100           
    101           
    102          !  tfu: Melting point of sea water 
    103          tfu(:,:)  = ztf    
    104           
    105          tfu(:,:)  = ABS ( rt0 - 0.0575       * sss_ini(:,:)                               & 
    106               &                    + 1.710523e-03 * sss_ini(:,:) * SQRT( sss_ini(:,:) )    & 
    107               &                    - 2.154996e-04 * sss_ini(:,:) * sss_ini(:,:) ) 
    108       ELSE                     ! 
    109  
     69  
     70      CALL lim_istate_init_2     !  reading the initials parameters of the ice 
     71 
     72      IF( .NOT. ln_limini ) THEN   
    11073          
    11174         ! Initialisation at tn or -2 if ice 
    … …  
    11679            END DO 
    11780         END DO 
    118           
    119          u_io  (:,:) = 0.e0 
    120          v_io  (:,:) = 0.e0 
    121          sst_io(:,:) = ( nfice - 1 ) * ( tn(:,:,1) + rt0 )   ! use the ocean initial values 
    122          sss_io(:,:) = ( nfice - 1 ) *   sn(:,:,1)           ! tricky trick *(nfice-1) ! 
    123           
    124          ! reference salinity 34psu 
     81                   
     82         !  tfu: Melting point of sea water [Kelvin] 
    12583         zs0 = 34.e0 
    126          ztf = ABS ( rt0 - 0.0575       * zs0                           & 
    127               &                    + 1.710523e-03 * zs0 * SQRT( zs0 )   & 
    128               &                    - 2.154996e-04 * zs0 *zs0          ) 
    129           
    130          !  tfu: Melting point of sea water 
    131          tfu(:,:)  = ztf    
     84         ztf = rt0 + ( - 0.0575 + 1.710523e-3 * SQRT( zs0 ) - 2.154996e-4 * zs0 ) * zs0 
     85         tfu(:,:) = ztf 
    13286          
    13387         DO jj = 1, jpj 
    … …  
    152106         tbif  (:,:,2) = tfu(:,:) 
    153107         tbif  (:,:,3) = tfu(:,:) 
    154        
     108 
    155109      ENDIF 
     110      
    156111      fsbbq (:,:)   = 0.e0 
    157112      qstoif(:,:)   = 0.e0 
    158       u_ice (:,:)   = 0.e0 
    159       v_ice (:,:)   = 0.e0 
     113      ui_ice(:,:)   = 0.e0 
     114      vi_ice(:,:)   = 0.e0 
    160115# if defined key_coupled 
    161116      albege(:,:)   = 0.8 * tms(:,:) 
    … …  
    191146 
    192147      CALL lbc_lnk( hsnif, 'T', 1. ) 
    193       CALL lbc_lnk( sist , 'T', 1. ) 
     148      CALL lbc_lnk( sist , 'T', 1. , pval = rt0 )      ! set rt0 on closed boundary (required by bulk formulation) 
    194149      DO jk = 1, jplayersp1 
    195150         CALL lbc_lnk(tbif(:,:,jk), 'T', 1. ) 
    … …  
    197152      CALL lbc_lnk( fsbbq  , 'T', 1. ) 
    198153      CALL lbc_lnk( qstoif , 'T', 1. ) 
    199       CALL lbc_lnk( sss_io , 'T', 1. ) 
    200       ! 
     154 
    201155   END SUBROUTINE lim_istate_2 
    202156 
    … …  
    209163      !! 
    210164      !! ** Method  :   Read the namiceini namelist and check the parameter  
    211       !!                values called at the first timestep (nit000) 
    212       !!                or 
    213       !!                Read 7 variables from a previous restart file 
    214       !!                sst, sst, hicif, hsnif, frld, ts & tbif 
     165      !!       values called at the first timestep (nit000) 
    215166      !! 
    216167      !! ** input   :   Namelist namiceini 
    … …  
    222173         &                hnins, hgins, alins 
    223174      !!------------------------------------------------------------------- 
    224        
    225       ! Read Namelist namiceini  
    226       REWIND ( numnam_ice ) 
     175      ! 
     176      REWIND ( numnam_ice )               ! Read Namelist namiceini  
    227177      READ   ( numnam_ice , namiceini ) 
    228        
    229       IF(.NOT. ln_limini) THEN  
    230          IF(lwp) THEN 
    231             WRITE(numout,*) 
    232             WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    233             WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    234             WRITE(numout,*) '         threshold water temp. for initial sea-ice    ttest      = ', ttest 
    235             WRITE(numout,*) '         initial snow thickness in the north          hninn      = ', hninn 
    236             WRITE(numout,*) '         initial ice thickness in the north           hginn      = ', hginn  
    237             WRITE(numout,*) '         initial leads area in the north              alinn      = ', alinn             
    238             WRITE(numout,*) '         initial snow thickness in the south          hnins      = ', hnins  
    239             WRITE(numout,*) '         initial ice thickness in the south           hgins      = ', hgins 
    240             WRITE(numout,*) '         initial leads area in the south              alins      = ', alins 
    241          ENDIF 
     178      ! 
     179      IF(lwp) THEN 
     180         WRITE(numout,*) 
     181         WRITE(numout,*) 'lim_istate_init_2 : ice parameters inititialisation ' 
     182         WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
     183         WRITE(numout,*) '         threshold water temp. for initial sea-ice    ttest      = ', ttest 
     184         WRITE(numout,*) '         initial snow thickness in the north          hninn      = ', hninn 
     185         WRITE(numout,*) '         initial ice thickness in the north           hginn      = ', hginn  
     186         WRITE(numout,*) '         initial leads area in the north              alinn      = ', alinn             
     187         WRITE(numout,*) '         initial snow thickness in the south          hnins      = ', hnins  
     188         WRITE(numout,*) '         initial ice thickness in the south           hgins      = ', hgins 
     189         WRITE(numout,*) '         initial leads area in the south              alins      = ', alins 
     190         WRITE(numout,*) '         Ice state initialization using input file    ln_limini  = ', ln_limini 
    242191      ENDIF 
    243192 
    244193      IF( ln_limini ) THEN                      ! Ice initialization using input file 
    245  
     194         ! 
    246195         CALL iom_open( 'Ice_initialization.nc', inum_ice ) 
    247  
     196         ! 
    248197         IF( inum_ice > 0 ) THEN 
    249             IF(lwp) THEN 
    250                WRITE(numout,*) ' ' 
    251                WRITE(numout,*) 'lim_istate_init : ice state initialization with : Ice_initialization.nc' 
    252                WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    253                WRITE(numout,*) '         Ice state initialization using input file    ln_limini  = ', ln_limini 
    254                WRITE(numout,*) ' ' 
    255             ENDIF 
     198            IF(lwp) WRITE(numout,*) 
     199            IF(lwp) WRITE(numout,*) '                  ice state initialization with : Ice_initialization.nc' 
    256200             
    257             CALL iom_get( inum_ice, jpdom_data, 'sst'  , sst_ini(:,:) )         
    258             CALL iom_get( inum_ice, jpdom_data, 'sss'  , sss_ini(:,:) )        
    259             CALL iom_get( inum_ice, jpdom_data, 'hicif', hicif  (:,:) )       
    260             CALL iom_get( inum_ice, jpdom_data, 'hsnif', hsnif  (:,:) )       
    261             CALL iom_get( inum_ice, jpdom_data, 'frld' , frld   (:,:) )      
    262             CALL iom_get( inum_ice, jpdom_data, 'ts'   , sist   (:,:) ) 
     201            CALL iom_get( inum_ice, jpdom_data, 'hicif', hicif )       
     202            CALL iom_get( inum_ice, jpdom_data, 'hsnif', hsnif )       
     203            CALL iom_get( inum_ice, jpdom_data, 'frld' , frld  )      
     204            CALL iom_get( inum_ice, jpdom_data, 'ts'   , sist  ) 
    263205            CALL iom_get( inum_ice, jpdom_unknown, 'tbif', tbif(1:nlci,1:nlcj,:),   & 
    264206                 &        kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,jplayersp1 /) ) 
    … …  
    268210 
    269211            CALL iom_close( inum_ice) 
    270              
     212            ! 
    271213         ENDIF 
    272214      ENDIF 
    273       ! 
     215      !      
    274216   END SUBROUTINE lim_istate_init_2 
    275217 

  • trunk/NEMO/LIM_SRC_2/limmsh_2.F90

    r823 r888  
    2525   !!---------------------------------------------------------------------- 
    2626   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    27    !! $Header$  
     27   !! $ Id: $ 
    2828   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    2929   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_2/limrhg_2.F90

    r823 r888  
    44   !!   Ice rheology :  performs sea ice rheology 
    55   !!====================================================================== 
     6   !! History :  0.0  !  93-12  (M.A. Morales Maqueda.)  Original code 
     7   !!            1.0  !  94-12  (H. Goosse)  
     8   !!            2.0  !  03-12  (C. Ethe, G. Madec)  F90, mpp 
     9   !!            " "  !  06-08  (G. Madec)  surface module, ice-stress at I-point 
     10   !!            " "  !  09-09  (G. Madec)  Huge verctor optimisation 
     11   !!---------------------------------------------------------------------- 
    612#if defined key_lim2 
    713   !!---------------------------------------------------------------------- 
    814   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    915   !!---------------------------------------------------------------------- 
     16   !!---------------------------------------------------------------------- 
    1017   !!   lim_rhg_2   : computes ice velocities 
    1118   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    13    USE phycst 
    14    USE par_oce 
    15    USE ice_oce         ! ice variables 
    16    USE dom_ice_2 
    17    USE ice_2 
    18    USE lbclnk 
    19    USE lib_mpp 
    20    USE in_out_manager  ! I/O manager 
    21    USE prtctl          ! Print control 
     19   USE par_oce        ! ocean parameter 
     20   USE ice_oce        ! ice variables 
     21   USE sbc_ice        ! surface boundary condition: ice variables 
     22   USE dom_ice_2      ! domaine: ice variables 
     23   USE phycst         ! physical constant 
     24   USE ice_2          ! ice variables 
     25   USE lbclnk         ! lateral boundary condition 
     26   USE lib_mpp        ! MPP library 
     27   USE in_out_manager ! I/O manager 
     28   USE prtctl         ! Print control 
    2229 
    2330   IMPLICIT NONE 
    2431   PRIVATE 
    2532 
    26    !! * Routine accessibility 
    27    PUBLIC lim_rhg_2  ! routine called by lim_dyn_2 
    28  
    29    !! * Module variables 
    30    REAL(wp)  ::           &  ! constant values 
    31       rzero   = 0.e0   ,  & 
    32       rone    = 1.e0 
    33    !!---------------------------------------------------------------------- 
    34    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    35    !! $Header$  
    36    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     33   PUBLIC   lim_rhg_2 ! routine called by lim_dyn 
     34 
     35   REAL(wp) ::   rzero   = 0.e0   ! constant value: zero 
     36   REAL(wp) ::   rone    = 1.e0   !            and  one 
     37 
     38   !! * Substitutions 
     39#  include "vectopt_loop_substitute.h90" 
     40   !!---------------------------------------------------------------------- 
     41   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
     42   !! $ Id: $ 
     43   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3744   !!---------------------------------------------------------------------- 
    3845 
    … …  
    4855      !!  viscous-plastic law including shear strength and a bulk rheology. 
    4956      !! 
    50       !! ** Action  : - compute u_ice, v_ice the sea-ice velocity 
     57      !! ** Action  : - compute ui_ice, vi_ice the sea-ice velocity defined 
     58      !!              at I-point 
     59      !!------------------------------------------------------------------- 
     60      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation 
     61      INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation 
    5162      !! 
    52       !! History : 
    53       !!   0.0  !  93-12  (M.A. Morales Maqueda.)  Original code 
    54       !!   1.0  !  94-12  (H. Goosse)  
    55       !!   2.0  !  03-12  (C. Ethe, G. Madec)  F90, mpp 
     63      INTEGER ::   ji, jj              ! dummy loop indices 
     64      INTEGER ::   iter, jter          ! temporary integers 
     65      CHARACTER (len=50) ::   charout 
     66      REAL(wp) ::   ze11  , ze12  , ze22  , ze21       ! temporary scalars 
     67      REAL(wp) ::   zt11  , zt12  , zt21  , zt22       !    "         " 
     68      REAL(wp) ::   zvis11, zvis21, zvis12, zvis22     !    "         " 
     69      REAL(wp) ::   zgphsx, ztagnx, zunw, zur, zusw    !    "         " 
     70      REAL(wp) ::   zgphsy, ztagny, zvnw, zvr          !    "         " 
     71      REAL(wp) ::   zresm,  za, zac, zmod 
     72      REAL(wp) ::   zmpzas, zstms, zindu, zusdtp, zmassdt, zcorlal 
     73      REAL(wp) ::   ztrace2, zdeter, zdelta, zmask, zdgp, zdgi, zdiag 
     74      REAL(wp) ::   za1, zb1, zc1, zd1 
     75      REAL(wp) ::   za2, zb2, zc2, zd2, zden 
     76      REAL(wp) ::   zs11_11, zs11_12, zs11_21, zs11_22 
     77      REAL(wp) ::   zs12_11, zs12_12, zs12_21, zs12_22 
     78      REAL(wp) ::   zs21_11, zs21_12, zs21_21, zs21_22 
     79      REAL(wp) ::   zs22_11, zs22_12, zs22_21, zs22_22 
     80      REAL(wp), DIMENSION(jpi,  jpj  ) ::   zfrld, zmass, zcorl 
     81      REAL(wp), DIMENSION(jpi,  jpj  ) ::   za1ct, za2ct, zresr 
     82      REAL(wp), DIMENSION(jpi,  jpj  ) ::   zc1u, zc1v, zc2u, zc2v 
     83      REAL(wp), DIMENSION(jpi,  jpj  ) ::   zsang 
     84      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu0, zv0 
     85      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu_n, zv_n 
     86      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu_a, zv_a 
     87      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zviszeta, zviseta 
     88      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zzfrld, zztms 
     89      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zi1, zi2, zmasst, zpresh 
     90 
    5691      !!------------------------------------------------------------------- 
    57       ! * Arguments 
    58       INTEGER, INTENT(in) ::   k_j1 ,  &  ! southern j-index for ice computation 
    59          &                     k_jpj      ! northern j-index for ice computation 
    60  
    61       ! * Local variables 
    62       INTEGER ::   ji, jj              ! dummy loop indices 
    63  
    64       INTEGER  :: & 
    65          iim1, ijm1, iip1 , ijp1   , & ! temporary integers 
    66          iter, jter                    !    "          " 
    67  
    68       CHARACTER (len=50) :: charout 
    69  
    70       REAL(wp) :: & 
    71          ze11  , ze12  , ze22  , ze21  ,   &  ! temporary scalars 
    72          zt11  , zt12  , zt21  , zt22  ,   &  !    "         " 
    73          zvis11, zvis21, zvis12, zvis22,   &  !    "         " 
    74          zgphsx, ztagnx, zusw  ,           &  !    "         " 
    75          zgphsy, ztagny                       !    "         " 
    76       REAL(wp) :: & 
    77          zresm, zunw, zvnw, zur, zvr, zmod, za, zac, & 
    78          zmpzas, zstms, zindu, zindu1, zusdtp, zmassdt, zcorlal,  & 
    79          ztrace2, zdeter, zdelta, zsang, zmask, zdgp, zdgi, zdiag 
    80       REAL(wp),DIMENSION(jpi,jpj) ::   & 
    81          zpresh, zfrld, zmass, zcorl,     & 
    82          zu0, zv0, zviszeta, zviseta,     & 
    83          zc1u, zc1v, zc2u, zc2v, za1ct, za2ct, za1, za2, zb1, zb2,  & 
    84          zc1, zc2, zd1, zd2, zden, zu_ice, zv_ice, zresr 
    85       REAL(wp),DIMENSION(jpi,jpj,2,2) :: & 
    86          zs11, zs12, zs22, zs21 
    87       !!------------------------------------------------------------------- 
     92 
     93!!bug 
     94!!    ui_oce(:,:) = 0.e0 
     95!!    vi_oce(:,:) = 0.e0 
     96!!    write(*,*) 'rhg min, max u & v', maxval(ui_oce), minval(ui_oce), maxval(vi_oce), minval(vi_oce) 
     97!!bug 
    8898       
    8999      !  Store initial velocities 
    90       !  ------------------------ 
    91       zu0(:,:) = u_ice(:,:) 
    92       zv0(:,:) = v_ice(:,:) 
     100      !  ---------------- 
     101      zztms(:,0    ) = 0.e0       ;    zzfrld(:,0    ) = 0.e0 
     102      zztms(:,jpj+1) = 0.e0       ;    zzfrld(:,jpj+1) = 0.e0 
     103      zu0(:,0    ) = 0.e0         ;    zv0(:,0    ) = 0.e0 
     104      zu0(:,jpj+1) = 0.e0         ;    zv0(:,jpj+1) = 0.e0 
     105      zztms(:,1:jpj) = tms(:,:)   ;    zzfrld(:,1:jpj) = frld(:,:) 
     106      zu0(:,1:jpj) = ui_ice(:,:)   ;    zv0(:,1:jpj) = vi_ice(:,:) 
     107 
     108      zu_a(:,:)    = zu0(:,:)     ;   zv_a(:,:) = zv0(:,:) 
     109      zu_n(:,:)    = zu0(:,:)     ;   zv_n(:,:) = zv0(:,:) 
     110 
     111!i 
     112      zi1   (:,:) = 0.e0 
     113      zi2   (:,:) = 0.e0 
     114      zpresh(:,:) = 0.e0 
     115      zmasst(:,:) = 0.e0 
     116!i 
     117!!gm violant 
     118      zfrld(:,:) =0.e0 
     119      zcorl(:,:) =0.e0 
     120      zmass(:,:) =0.e0 
     121      za1ct(:,:) =0.e0 
     122      za2ct(:,:) =0.e0 
     123!!gm end 
     124 
     125      zviszeta(:,:) = 0.e0 
     126      zviseta (:,:) = 0.e0 
     127 
     128!i    zviszeta(:,0    ) = 0.e0    ;    zviseta(:,0    ) = 0.e0 
     129!i    zviszeta(:,jpj  ) = 0.e0    ;    zviseta(:,jpj  ) = 0.e0 
     130!i    zviszeta(:,jpj+1) = 0.e0    ;    zviseta(:,jpj+1) = 0.e0 
     131 
    93132 
    94133      ! Ice mass, ice strength, and wind stress at the center            | 
    … …  
    96135      !------------------------------------------------------------------- 
    97136 
     137!CDIR NOVERRCHK 
    98138      DO jj = k_j1 , k_jpj-1 
     139!CDIR NOVERRCHK 
    99140         DO ji = 1 , jpi 
    100             za1(ji,jj)    = tms(ji,jj) * ( rhosn * hsnm(ji,jj) + rhoic * hicm(ji,jj) ) 
     141            ! only the sinus changes its sign with the hemisphere 
     142            zsang(ji,jj)  = SIGN( 1.e0, fcor(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere 
     143            ! 
     144            zmasst(ji,jj) = tms(ji,jj) * ( rhosn * hsnm(ji,jj) + rhoic * hicm(ji,jj) ) 
    101145            zpresh(ji,jj) = tms(ji,jj) *  pstarh * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) ) 
    102 #if defined key_lim_cp1 && defined key_coupled 
    103             zb1(ji,jj)    = tms(ji,jj) * gtaux(ji,jj) * ( 1.0 - frld(ji,jj) ) 
    104             zb2(ji,jj)    = tms(ji,jj) * gtauy(ji,jj) * ( 1.0 - frld(ji,jj) ) 
    105 #else 
    106             zb1(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) ) 
    107             zb2(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) ) 
    108 #endif 
     146!!gm  :: stress given at I-point (F-point for the ocean) only compute the ponderation with the ice fraction (1-frld) 
     147            zi1(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) ) 
     148            zi2(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) ) 
    109149         END DO 
    110150      END DO 
    … …  
    117157          
    118158      DO jj = k_j1+1, k_jpj-1 
    119          DO ji = 2, jpi 
    120             zstms = tms(ji,jj  ) * wght(ji,jj,2,2) + tms(ji-1,jj  ) * wght(ji,jj,1,2)   & 
    121                &  + tms(ji,jj-1) * wght(ji,jj,2,1) + tms(ji-1,jj-1) * wght(ji,jj,1,1) 
     159         DO ji = fs_2, jpi 
     160            zstms = zztms(ji,jj  ) * wght(ji,jj,2,2) + zztms(ji-1,jj  ) * wght(ji,jj,1,2)   & 
     161               &  + zztms(ji,jj-1) * wght(ji,jj,2,1) + zztms(ji-1,jj-1) * wght(ji,jj,1,1) 
    122162            zusw  = 1.0 / MAX( zstms, epsd ) 
    123163 
    124             zt11 = tms(ji  ,jj  ) * frld(ji  ,jj  )  
    125             zt12 = tms(ji-1,jj  ) * frld(ji-1,jj  )  
    126             zt21 = tms(ji  ,jj-1) * frld(ji  ,jj-1)  
    127             zt22 = tms(ji-1,jj-1) * frld(ji-1,jj-1) 
     164            zt11 = zztms(ji  ,jj  ) * zzfrld(ji  ,jj  )  
     165            zt12 = zztms(ji-1,jj  ) * zzfrld(ji-1,jj  )  
     166            zt21 = zztms(ji  ,jj-1) * zzfrld(ji  ,jj-1)  
     167            zt22 = zztms(ji-1,jj-1) * zzfrld(ji-1,jj-1) 
    128168 
    129169            ! Leads area. 
    … …  
    131171               &             + zt21 * wght(ji,jj,2,1) + zt22 * wght(ji,jj,1,1) ) * zusw 
    132172 
    133             ! Mass and coriolis coeff. 
    134             zmass(ji,jj) = ( za1(ji,jj  ) * wght(ji,jj,2,2) + za1(ji-1,jj  ) * wght(ji,jj,1,2)   & 
    135                &           + za1(ji,jj-1) * wght(ji,jj,2,1) + za1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw 
     173            ! Mass and coriolis coeff. at I-point 
     174            zmass(ji,jj) = ( zmasst(ji,jj  ) * wght(ji,jj,2,2) + zmasst(ji-1,jj  ) * wght(ji,jj,1,2)   & 
     175               &           + zmasst(ji,jj-1) * wght(ji,jj,2,1) + zmasst(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw 
    136176            zcorl(ji,jj) = zmass(ji,jj) * fcor(ji,jj) 
    137177 
    138178            ! Wind stress. 
    139 #if defined key_lim_cp1 && defined key_coupled 
    140             ztagnx = ( zb1(ji,jj  ) * wght(ji,jj,2,2) + zb1(ji-1,jj  ) * wght(ji,jj,1,2)   & 
    141                &     + zb1(ji,jj-1) * wght(ji,jj,2,1) + zb1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw 
    142             ztagny = ( zb2(ji,jj  ) * wght(ji,jj,2,2) + zb2(ji-1,jj  ) * wght(ji,jj,1,2)   & 
    143                &     + zb2(ji,jj-1) * wght(ji,jj,2,1) + zb2(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw 
    144 #else 
    145             ztagnx = ( zb1(ji,jj  ) * wght(ji,jj,2,2) + zb1(ji-1,jj  ) * wght(ji,jj,1,2)   & 
    146                &     + zb1(ji,jj-1) * wght(ji,jj,2,1) + zb1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * gtaux(ji,jj) 
    147             ztagny = ( zb2(ji,jj  ) * wght(ji,jj,2,2) + zb2(ji-1,jj  ) * wght(ji,jj,1,2)   & 
    148                &     + zb2(ji,jj-1) * wght(ji,jj,2,1) + zb2(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * gtauy(ji,jj) 
    149 #endif 
     179            ! always provide stress at I-point (ocean F-point) 
     180            ztagnx = ( zi1(ji,jj  ) * wght(ji,jj,2,2) + zi1(ji-1,jj  ) * wght(ji,jj,1,2)   & 
     181               &     + zi1(ji,jj-1) * wght(ji,jj,2,1) + zi1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * utaui_ice(ji,jj) 
     182            ztagny = ( zi2(ji,jj  ) * wght(ji,jj,2,2) + zi2(ji-1,jj  ) * wght(ji,jj,1,2)   & 
     183               &     + zi2(ji,jj-1) * wght(ji,jj,2,1) + zi2(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * vtaui_ice(ji,jj) 
    150184 
    151185            ! Gradient of ice strength 
    … …  
    161195 
    162196            ! Computation of the velocity field taking into account the ice-ice interaction.                                  
    163             ! Terms that are independent of the velocity field. 
    164             za1ct(ji,jj) = ztagnx - zcorl(ji,jj) * v_oce(ji,jj) - zgphsx 
    165             za2ct(ji,jj) = ztagny + zcorl(ji,jj) * u_oce(ji,jj) - zgphsy 
     197            ! Terms that are independent of the ice velocity field. 
     198            za1ct(ji,jj) = ztagnx - zcorl(ji,jj) * vi_oce(ji,jj) - zgphsx 
     199            za2ct(ji,jj) = ztagny + zcorl(ji,jj) * ui_oce(ji,jj) - zgphsy 
    166200         END DO 
    167201      END DO 
    168  
    169 !! inutile!! 
    170 !!??    CALL lbc_lnk( za1ct, 'I', -1. ) 
    171 !!??    CALL lbc_lnk( za2ct, 'I', -1. ) 
    172202 
    173203 
    … …  
    182212         ! Computation of free drift field for free slip boundary conditions. 
    183213 
    184            DO jj = k_j1, k_jpj-1 
    185               DO ji = 1, jpim1 
    186                  !- Rate of strain tensor. 
    187                  zt11 =   akappa(ji,jj,1,1) * ( u_ice(ji+1,jj) + u_ice(ji+1,jj+1) - u_ice(ji,jj  ) - u_ice(ji  ,jj+1) )  & 
    188                     &   + akappa(ji,jj,1,2) * ( v_ice(ji+1,jj) + v_ice(ji+1,jj+1) + v_ice(ji,jj  ) + v_ice(ji  ,jj+1) ) 
    189                  zt12 = - akappa(ji,jj,2,2) * ( u_ice(ji  ,jj) + u_ice(ji+1,jj  ) - u_ice(ji,jj+1) - u_ice(ji+1,jj+1) )  & 
    190                     &   - akappa(ji,jj,2,1) * ( v_ice(ji  ,jj) + v_ice(ji+1,jj  ) + v_ice(ji,jj+1) + v_ice(ji+1,jj+1) ) 
    191                  zt22 = - akappa(ji,jj,2,2) * ( v_ice(ji  ,jj) + v_ice(ji+1,jj  ) - v_ice(ji,jj+1) - v_ice(ji+1,jj+1) )  & 
    192                     &   + akappa(ji,jj,2,1) * ( u_ice(ji  ,jj) + u_ice(ji+1,jj  ) + u_ice(ji,jj+1) + u_ice(ji+1,jj+1) ) 
    193                  zt21 =   akappa(ji,jj,1,1) * ( v_ice(ji+1,jj) + v_ice(ji+1,jj+1) - v_ice(ji,jj  ) - v_ice(ji  ,jj+1) )  & 
    194                     &   - akappa(ji,jj,1,2) * ( u_ice(ji+1,jj) + u_ice(ji+1,jj+1) + u_ice(ji,jj  ) + u_ice(ji  ,jj+1) ) 
    195  
    196                  !- Rate of strain tensor.  
    197                  zdgp = zt11 + zt22 
    198                  zdgi = zt12 + zt21 
    199                  ztrace2 = zdgp * zdgp  
    200                  zdeter  = zt11 * zt22 - 0.25 * zdgi * zdgi 
    201  
    202                  !  Creep limit depends on the size of the grid. 
    203                  zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4.0 * zdeter ) * usecc2),  creepl) 
    204  
    205                  !-  Computation of viscosities. 
    206                  zviszeta(ji,jj) = MAX( zpresh(ji,jj) / zdelta, etamn ) 
    207                  zviseta (ji,jj) = zviszeta(ji,jj) * usecc2 
    208               END DO 
    209            END DO 
    210 !!??       CALL lbc_lnk( zviszeta, 'I', -1. )  ! or T point???   semble reellement inutile 
    211 !!??       CALL lbc_lnk( zviseta , 'I', -1. ) 
    212  
    213  
    214            !-  Determination of zc1u, zc2u, zc1v and zc2v. 
    215            DO jj = k_j1+1, k_jpj-1 
    216               DO ji = 2, jpim1 
    217                  ze11   =  akappa(ji-1,jj-1,1,1) 
    218                  ze12   = +akappa(ji-1,jj-1,2,2) 
    219                  ze22   =  akappa(ji-1,jj-1,2,1) 
    220                  ze21   = -akappa(ji-1,jj-1,1,2) 
    221                  zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm 
    222                  zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
    223                  zvis12 =       zviseta (ji-1,jj-1) + dm 
    224                  zvis21 =       zviseta (ji-1,jj-1) 
    225  
    226                  zdiag = zvis22 * ( ze11 + ze22 ) 
    227                  zs11(ji,jj,1,1) =  zvis11 * ze11 + zdiag 
    228                  zs12(ji,jj,1,1) =  zvis12 * ze12 + zvis21 * ze21 
    229                  zs22(ji,jj,1,1) =  zvis11 * ze22 + zdiag 
    230                  zs21(ji,jj,1,1) =  zvis12 * ze21 + zvis21 * ze12 
    231  
    232                  ze11   = -akappa(ji,jj-1,1,1) 
    233                  ze12   = +akappa(ji,jj-1,2,2) 
    234                  ze22   =  akappa(ji,jj-1,2,1) 
    235                  ze21   = -akappa(ji,jj-1,1,2) 
    236                  zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
    237                  zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
    238                  zvis12 =       zviseta (ji,jj-1) + dm 
    239                  zvis21 =       zviseta (ji,jj-1) 
    240  
    241                  zdiag = zvis22 * ( ze11 + ze22 ) 
    242                  zs11(ji,jj,2,1) =  zvis11 * ze11 + zdiag 
    243                  zs12(ji,jj,2,1) =  zvis12 * ze12 + zvis21 * ze21 
    244                  zs22(ji,jj,2,1) =  zvis11 * ze22 + zdiag 
    245                  zs21(ji,jj,2,1) =  zvis12 * ze21 + zvis21 * ze12 
    246  
    247                  ze11   =  akappa(ji-1,jj,1,1) 
    248                  ze12   = -akappa(ji-1,jj,2,2) 
    249                  ze22   =  akappa(ji-1,jj,2,1) 
    250                  ze21   = -akappa(ji-1,jj,1,2) 
    251                  zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
    252                  zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
    253                  zvis12 =       zviseta (ji-1,jj) + dm 
    254                  zvis21 =       zviseta (ji-1,jj) 
    255  
    256                  zdiag = zvis22 * ( ze11 + ze22 )  
    257                  zs11(ji,jj,1,2) =  zvis11 * ze11 + zdiag 
    258                  zs12(ji,jj,1,2) =  zvis12 * ze12 + zvis21 * ze21 
    259                  zs22(ji,jj,1,2) =  zvis11 * ze22 + zdiag 
    260                  zs21(ji,jj,1,2) =  zvis12 * ze21 + zvis21 * ze12 
    261  
    262                  ze11   = -akappa(ji,jj,1,1) 
    263                  ze12   = -akappa(ji,jj,2,2) 
    264                  ze22   =  akappa(ji,jj,2,1) 
    265                  ze21   = -akappa(ji,jj,1,2) 
    266                  zvis11 = 2.0 * zviseta (ji,jj) + dm 
    267                  zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj) 
    268                  zvis12 =       zviseta (ji,jj) + dm 
    269                  zvis21 =       zviseta (ji,jj) 
    270  
    271                  zdiag = zvis22 * ( ze11 + ze22 ) 
    272                  zs11(ji,jj,2,2) =  zvis11 * ze11 + zdiag 
    273                  zs12(ji,jj,2,2) =  zvis12 * ze12 + zvis21 * ze21 
    274                  zs22(ji,jj,2,2) =  zvis11 * ze22 + zdiag  
    275                  zs21(ji,jj,2,2) =  zvis12 * ze21 + zvis21 * ze12 
    276               END DO 
    277            END DO 
    278  
    279            DO jj = k_j1+1, k_jpj-1 
    280               DO ji = 2, jpim1 
    281                  zc1u(ji,jj) =   & 
    282                     + alambd(ji,jj,2,2,2,1) * zs11(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zs11(ji,jj,2,2)   & 
    283                     - alambd(ji,jj,2,2,1,1) * zs11(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zs11(ji,jj,1,2)   & 
    284                     - alambd(ji,jj,1,1,2,1) * zs12(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zs12(ji,jj,1,1)   & 
    285                     + alambd(ji,jj,1,1,2,2) * zs12(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zs12(ji,jj,1,2)   & 
    286                     + alambd(ji,jj,1,2,1,1) * zs21(ji,jj,1,1) + alambd(ji,jj,1,2,2,1) * zs21(ji,jj,2,1)   & 
    287                     + alambd(ji,jj,1,2,1,2) * zs21(ji,jj,1,2) + alambd(ji,jj,1,2,2,2) * zs21(ji,jj,2,2)   & 
    288                     - alambd(ji,jj,2,1,1,1) * zs22(ji,jj,1,1) - alambd(ji,jj,2,1,2,1) * zs22(ji,jj,2,1)   & 
    289                     - alambd(ji,jj,2,1,1,2) * zs22(ji,jj,1,2) - alambd(ji,jj,2,1,2,2) * zs22(ji,jj,2,2) 
    290                   
    291                  zc2u(ji,jj) =   & 
    292                     + alambd(ji,jj,2,2,2,1) * zs21(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zs21(ji,jj,2,2)   & 
    293                     - alambd(ji,jj,2,2,1,1) * zs21(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zs21(ji,jj,1,2)   & 
    294                     - alambd(ji,jj,1,1,2,1) * zs22(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zs22(ji,jj,1,1)   & 
    295                     + alambd(ji,jj,1,1,2,2) * zs22(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zs22(ji,jj,1,2)   & 
    296                     - alambd(ji,jj,1,2,1,1) * zs11(ji,jj,1,1) - alambd(ji,jj,1,2,2,1) * zs11(ji,jj,2,1)   & 
    297                     - alambd(ji,jj,1,2,1,2) * zs11(ji,jj,1,2) - alambd(ji,jj,1,2,2,2) * zs11(ji,jj,2,2)   & 
    298                     + alambd(ji,jj,2,1,1,1) * zs12(ji,jj,1,1) + alambd(ji,jj,2,1,2,1) * zs12(ji,jj,2,1)   & 
    299                     + alambd(ji,jj,2,1,1,2) * zs12(ji,jj,1,2) + alambd(ji,jj,2,1,2,2) * zs12(ji,jj,2,2) 
    300              END DO 
    301            END DO 
    302  
    303            DO jj = k_j1+1, k_jpj-1 
    304               DO ji = 2, jpim1 
    305                  !  zc1v , zc2v. 
    306                  ze11   =  akappa(ji-1,jj-1,1,2) 
    307                  ze12   = -akappa(ji-1,jj-1,2,1) 
    308                  ze22   = +akappa(ji-1,jj-1,2,2) 
    309                  ze21   =  akappa(ji-1,jj-1,1,1) 
    310                  zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm 
    311                  zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
    312                  zvis12 =       zviseta (ji-1,jj-1) + dm 
    313                  zvis21 =       zviseta (ji-1,jj-1) 
    314  
    315                  zdiag = zvis22 * ( ze11 + ze22 ) 
    316                  zs11(ji,jj,1,1) =  zvis11 * ze11 + zdiag 
    317                  zs12(ji,jj,1,1) =  zvis12 * ze12 + zvis21 * ze21 
    318                  zs22(ji,jj,1,1) =  zvis11 * ze22 + zdiag 
    319                  zs21(ji,jj,1,1) =  zvis12 * ze21 + zvis21 * ze12 
     214!CDIR NOVERRCHK 
     215         DO jj = k_j1, k_jpj-1 
     216!CDIR NOVERRCHK 
     217            DO ji = 1, fs_jpim1 
     218               !- Rate of strain tensor. 
     219               zt11 =   akappa(ji,jj,1,1) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) - zu_a(ji,jj  ) - zu_a(ji  ,jj+1) )  & 
     220                  &   + akappa(ji,jj,1,2) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) + zv_a(ji,jj  ) + zv_a(ji  ,jj+1) ) 
     221               zt12 = - akappa(ji,jj,2,2) * ( zu_a(ji  ,jj) + zu_a(ji+1,jj  ) - zu_a(ji,jj+1) - zu_a(ji+1,jj+1) )  & 
     222                  &   - akappa(ji,jj,2,1) * ( zv_a(ji  ,jj) + zv_a(ji+1,jj  ) + zv_a(ji,jj+1) + zv_a(ji+1,jj+1) ) 
     223               zt22 = - akappa(ji,jj,2,2) * ( zv_a(ji  ,jj) + zv_a(ji+1,jj  ) - zv_a(ji,jj+1) - zv_a(ji+1,jj+1) )  & 
     224                  &   + akappa(ji,jj,2,1) * ( zu_a(ji  ,jj) + zu_a(ji+1,jj  ) + zu_a(ji,jj+1) + zu_a(ji+1,jj+1) ) 
     225               zt21 =   akappa(ji,jj,1,1) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) - zv_a(ji,jj  ) - zv_a(ji  ,jj+1) )  & 
     226                  &   - akappa(ji,jj,1,2) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) + zu_a(ji,jj  ) + zu_a(ji  ,jj+1) ) 
     227 
     228               !- Rate of strain tensor.  
     229               zdgp = zt11 + zt22 
     230               zdgi = zt12 + zt21 
     231               ztrace2 = zdgp * zdgp  
     232               zdeter  = zt11 * zt22 - 0.25 * zdgi * zdgi 
     233 
     234               !  Creep limit depends on the size of the grid. 
     235               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4.0 * zdeter ) * usecc2 ),  creepl) 
     236 
     237               !-  Computation of viscosities. 
     238               zviszeta(ji,jj) = MAX( zpresh(ji,jj) / zdelta, etamn ) 
     239               zviseta (ji,jj) = zviszeta(ji,jj) * usecc2 
     240            END DO 
     241         END DO 
     242 
     243         !-  Determination of zc1u, zc2u, zc1v and zc2v. 
     244         DO jj = k_j1+1, k_jpj-1 
     245            DO ji = fs_2, fs_jpim1 
     246               !* zc1u , zc2v 
     247               zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm 
     248               zvis12 =       zviseta (ji-1,jj-1) + dm 
     249               zvis21 =       zviseta (ji-1,jj-1) 
     250               zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
     251               zdiag  = zvis22 * ( akappa(ji-1,jj-1,1,1) + akappa(ji-1,jj-1,2,1) ) 
     252               zs11_11 =  zvis11 * akappa(ji-1,jj-1,1,1) + zdiag 
     253               zs12_11 =  zvis12 * akappa(ji-1,jj-1,2,2) - zvis21 * akappa(ji-1,jj-1,1,2) 
     254               zs21_11 = -zvis12 * akappa(ji-1,jj-1,1,2) + zvis21 * akappa(ji-1,jj-1,2,2) 
     255               zs22_11 =  zvis11 * akappa(ji-1,jj-1,2,1) + zdiag 
     256 
     257               zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
     258               zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
     259               zvis12 =       zviseta (ji,jj-1) + dm 
     260               zvis21 =       zviseta (ji,jj-1) 
     261               zdiag = zvis22 * ( -akappa(ji,jj-1,1,1) + akappa(ji,jj-1,2,1) ) 
     262               zs11_21 = -zvis11 * akappa(ji,jj-1,1,1) + zdiag 
     263               zs12_21 =  zvis12 * akappa(ji,jj-1,2,2) - zvis21 * akappa(ji,jj-1,1,2) 
     264               zs22_21 =  zvis11 * akappa(ji,jj-1,2,1) + zdiag 
     265               zs21_21 = -zvis12 * akappa(ji,jj-1,1,2) + zvis21 * akappa(ji,jj-1,2,2) 
     266 
     267               zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
     268               zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
     269               zvis12 =       zviseta (ji-1,jj) + dm 
     270               zvis21 =       zviseta (ji-1,jj) 
     271               zdiag = zvis22 * ( akappa(ji-1,jj,1,1) + akappa(ji-1,jj,2,1) ) 
     272               zs11_12 =  zvis11 * akappa(ji-1,jj,1,1) + zdiag 
     273               zs12_12 = -zvis12 * akappa(ji-1,jj,2,2) - zvis21 * akappa(ji-1,jj,1,2) 
     274               zs22_12 =  zvis11 * akappa(ji-1,jj,2,1) + zdiag 
     275               zs21_12 = -zvis12 * akappa(ji-1,jj,1,2) - zvis21 * akappa(ji-1,jj,2,2) 
     276 
     277               zvis11 = 2.0 * zviseta (ji,jj) + dm 
     278               zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj) 
     279               zvis12 =       zviseta (ji,jj) + dm 
     280               zvis21 =       zviseta (ji,jj) 
     281               zdiag = zvis22 * ( -akappa(ji,jj,1,1) + akappa(ji,jj,2,1) ) 
     282               zs11_22 = -zvis11 * akappa(ji,jj,1,1) + zdiag 
     283               zs12_22 = -zvis12 * akappa(ji,jj,2,2) - zvis21 * akappa(ji,jj,1,2) 
     284               zs22_22 =  zvis11 * akappa(ji,jj,2,1) + zdiag 
     285               zs21_22 = -zvis12 * akappa(ji,jj,1,2) - zvis21 * akappa(ji,jj,2,2) 
     286 
     287               zc1u(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22   & 
     288                  &          - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12   & 
     289                  &          - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11   & 
     290                  &          + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12   & 
     291                  &          + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21   & 
     292                  &          + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22   & 
     293                  &          - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21   & 
     294                  &          - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22 
     295 
     296               zc2u(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22   & 
     297                  &          - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12   & 
     298                  &          - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11   & 
     299                  &          + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12   & 
     300                  &          - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21   & 
     301                  &          - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22   & 
     302                  &          + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21   & 
     303                  &          + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22 
     304 
     305               !* zc1v , zc2v. 
     306               zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm 
     307               zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
     308               zvis12 =       zviseta (ji-1,jj-1) + dm 
     309               zvis21 =       zviseta (ji-1,jj-1) 
     310               zdiag = zvis22 * ( akappa(ji-1,jj-1,1,2) + akappa(ji-1,jj-1,2,2) ) 
     311               zs11_11 =  zvis11 * akappa(ji-1,jj-1,1,2) + zdiag 
     312               zs12_11 = -zvis12 * akappa(ji-1,jj-1,2,1) + zvis21 * akappa(ji-1,jj-1,1,1) 
     313               zs22_11 =  zvis11 * akappa(ji-1,jj-1,2,2) + zdiag 
     314               zs21_11 =  zvis12 * akappa(ji-1,jj-1,1,1) - zvis21 * akappa(ji-1,jj-1,2,1) 
    320315  
    321                  ze11   =  akappa(ji,jj-1,1,2) 
    322                  ze12   = -akappa(ji,jj-1,2,1) 
    323                  ze22   = +akappa(ji,jj-1,2,2) 
    324                  ze21   = -akappa(ji,jj-1,1,1) 
    325                  zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
    326                  zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
    327                  zvis12 =       zviseta (ji,jj-1) + dm 
    328                  zvis21 =       zviseta (ji,jj-1) 
    329  
    330                  zdiag = zvis22 * ( ze11 + ze22 ) 
    331                  zs11(ji,jj,2,1) =  zvis11 * ze11 + zdiag 
    332                  zs12(ji,jj,2,1) =  zvis12 * ze12 + zvis21 * ze21 
    333                  zs22(ji,jj,2,1) =  zvis11 * ze22 + zdiag 
    334                  zs21(ji,jj,2,1) =  zvis12 * ze21 + zvis21 * ze12 
    335  
    336                  ze11   =  akappa(ji-1,jj,1,2) 
    337                  ze12   = -akappa(ji-1,jj,2,1) 
    338                  ze22   = -akappa(ji-1,jj,2,2) 
    339                  ze21   =  akappa(ji-1,jj,1,1) 
    340                  zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
    341                  zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
    342                  zvis12 =       zviseta (ji-1,jj) + dm 
    343                  zvis21 =       zviseta (ji-1,jj) 
    344  
    345                  zdiag = zvis22 * ( ze11 + ze22 ) 
    346                  zs11(ji,jj,1,2) =  zvis11 * ze11 + zdiag 
    347                  zs12(ji,jj,1,2) =  zvis12 * ze12 + zvis21 * ze21 
    348                  zs22(ji,jj,1,2) =  zvis11 * ze22 + zdiag 
    349                  zs21(ji,jj,1,2) =  zvis12 * ze21 + zvis21 * ze12 
    350  
    351                  ze11   =  akappa(ji,jj,1,2) 
    352                  ze12   = -akappa(ji,jj,2,1) 
    353                  ze22   = -akappa(ji,jj,2,2) 
    354                  ze21   = -akappa(ji,jj,1,1) 
    355                  zvis11 = 2.0 * zviseta (ji,jj) + dm 
    356                  zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj) 
    357                  zvis12 =       zviseta (ji,jj) + dm 
    358                  zvis21 =       zviseta (ji,jj) 
    359  
    360                  zdiag = zvis22 * ( ze11 + ze22 ) 
    361                  zs11(ji,jj,2,2) =  zvis11 * ze11 + zdiag 
    362                  zs12(ji,jj,2,2) =  zvis12 * ze12 + zvis21 * ze21 
    363                  zs22(ji,jj,2,2) =  zvis11 * ze22 + zdiag 
    364                  zs21(ji,jj,2,2) =  zvis12 * ze21 + zvis21 * ze12 
    365  
    366               END DO 
    367            END DO 
    368  
    369            DO jj = k_j1+1, k_jpj-1 
    370               DO ji = 2, jpim1 
    371                  zc1v(ji,jj) =   & 
    372                     + alambd(ji,jj,2,2,2,1) * zs11(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zs11(ji,jj,2,2)   & 
    373                     - alambd(ji,jj,2,2,1,1) * zs11(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zs11(ji,jj,1,2)   & 
    374                     - alambd(ji,jj,1,1,2,1) * zs12(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zs12(ji,jj,1,1)   & 
    375                     + alambd(ji,jj,1,1,2,2) * zs12(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zs12(ji,jj,1,2)   & 
    376                     + alambd(ji,jj,1,2,1,1) * zs21(ji,jj,1,1) + alambd(ji,jj,1,2,2,1) * zs21(ji,jj,2,1)   & 
    377                     + alambd(ji,jj,1,2,1,2) * zs21(ji,jj,1,2) + alambd(ji,jj,1,2,2,2) * zs21(ji,jj,2,2)   & 
    378                     - alambd(ji,jj,2,1,1,1) * zs22(ji,jj,1,1) - alambd(ji,jj,2,1,2,1) * zs22(ji,jj,2,1)   & 
    379                     - alambd(ji,jj,2,1,1,2) * zs22(ji,jj,1,2) - alambd(ji,jj,2,1,2,2) * zs22(ji,jj,2,2) 
    380                  zc2v(ji,jj) =   & 
    381                     + alambd(ji,jj,2,2,2,1) * zs21(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zs21(ji,jj,2,2)   & 
    382                     - alambd(ji,jj,2,2,1,1) * zs21(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zs21(ji,jj,1,2)   & 
    383                     - alambd(ji,jj,1,1,2,1) * zs22(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zs22(ji,jj,1,1)   & 
    384                     + alambd(ji,jj,1,1,2,2) * zs22(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zs22(ji,jj,1,2)   & 
    385                     - alambd(ji,jj,1,2,1,1) * zs11(ji,jj,1,1) - alambd(ji,jj,1,2,2,1) * zs11(ji,jj,2,1)   & 
    386                     - alambd(ji,jj,1,2,1,2) * zs11(ji,jj,1,2) - alambd(ji,jj,1,2,2,2) * zs11(ji,jj,2,2)   & 
    387                     + alambd(ji,jj,2,1,1,1) * zs12(ji,jj,1,1) + alambd(ji,jj,2,1,2,1) * zs12(ji,jj,2,1)   & 
    388                     + alambd(ji,jj,2,1,1,2) * zs12(ji,jj,1,2) + alambd(ji,jj,2,1,2,2) * zs12(ji,jj,2,2) 
    389               END DO 
    390            END DO 
    391  
    392          ! Relaxation. 
    393             
    394 iflag:   DO jter = 1 , nbitdr 
    395  
    396             !  Store previous drift field.    
    397             DO jj = k_j1, k_jpj-1 
    398                zu_ice(:,jj) = u_ice(:,jj) 
    399                zv_ice(:,jj) = v_ice(:,jj) 
     316               zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
     317               zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
     318               zvis12 =       zviseta (ji,jj-1) + dm 
     319               zvis21 =       zviseta (ji,jj-1) 
     320               zdiag = zvis22 * ( akappa(ji,jj-1,1,2) + akappa(ji,jj-1,2,2) ) 
     321               zs11_21 =  zvis11 * akappa(ji,jj-1,1,2) + zdiag 
     322               zs12_21 = -zvis12 * akappa(ji,jj-1,2,1) - zvis21 * akappa(ji,jj-1,1,1) 
     323               zs22_21 =  zvis11 * akappa(ji,jj-1,2,2) + zdiag 
     324               zs21_21 = -zvis12 * akappa(ji,jj-1,1,1) - zvis21 * akappa(ji,jj-1,2,1) 
     325 
     326               zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
     327               zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
     328               zvis12 =       zviseta (ji-1,jj) + dm 
     329               zvis21 =       zviseta (ji-1,jj) 
     330               zdiag = zvis22 * ( akappa(ji-1,jj,1,2) - akappa(ji-1,jj,2,2) ) 
     331               zs11_12 =  zvis11 * akappa(ji-1,jj,1,2) + zdiag 
     332               zs12_12 = -zvis12 * akappa(ji-1,jj,2,1) + zvis21 * akappa(ji-1,jj,1,1) 
     333               zs22_12 = -zvis11 * akappa(ji-1,jj,2,2) + zdiag 
     334               zs21_12 =  zvis12 * akappa(ji-1,jj,1,1) - zvis21 * akappa(ji-1,jj,2,1) 
     335 
     336               zvis11 = 2.0 * zviseta (ji,jj) + dm 
     337               zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj) 
     338               zvis12 =       zviseta (ji,jj) + dm 
     339               zvis21 =       zviseta (ji,jj) 
     340               zdiag = zvis22 * ( akappa(ji,jj,1,2) - akappa(ji,jj,2,2) ) 
     341               zs11_22 =  zvis11 * akappa(ji,jj,1,2) + zdiag 
     342               zs12_22 = -zvis12 * akappa(ji,jj,2,1) - zvis21 * akappa(ji,jj,1,1) 
     343               zs22_22 = -zvis11 * akappa(ji,jj,2,2) + zdiag 
     344               zs21_22 = -zvis12 * akappa(ji,jj,1,1) - zvis21 * akappa(ji,jj,2,1) 
     345 
     346               zc1v(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22   & 
     347                  &          - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12   & 
     348                  &          - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11   & 
     349                  &          + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12   & 
     350                  &          + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21   & 
     351                  &          + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22   & 
     352                  &          - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21   & 
     353                  &          - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22 
     354 
     355               zc2v(ji,jj) = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22   & 
     356                  &          - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12   & 
     357                  &          - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11   & 
     358                  &          + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12   & 
     359                  &          - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21   & 
     360                  &          - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22   & 
     361                  &          + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21   & 
     362                  &          + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22 
    400363            END DO 
    401  
     364         END DO 
     365 
     366         ! GAUSS-SEIDEL method 
     367         !                                                      ! ================ ! 
     368iflag:   DO jter = 1 , nbitdr                                   !    Relaxation    ! 
     369            !                                                   ! ================ ! 
     370!CDIR NOVERRCHK 
    402371            DO jj = k_j1+1, k_jpj-1 
    403                zsang  = SIGN( 1.e0, fcor(1,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere 
    404                DO ji = 2, jpim1 
    405                  zur     = u_ice(ji,jj) - u_oce(ji,jj) 
    406                  zvr     = v_ice(ji,jj) - v_oce(ji,jj) 
    407                  zmod    = SQRT( zur * zur + zvr * zvr) * ( 1.0 - zfrld(ji,jj) ) 
    408                  za      = rhoco * zmod 
    409                  zac     = za * cangvg 
    410                   zmpzas  = alpha * zcorl(ji,jj) + za * zsang 
     372!CDIR NOVERRCHK 
     373               DO ji = fs_2, fs_jpim1 
     374                  ! 
     375                  ze11 =   akappa(ji,jj-1,1,1) * zu_a(ji+1,jj) + akappa(ji,jj-1,1,2) * zv_a(ji+1,jj) 
     376                  ze12 = + akappa(ji,jj-1,2,2) * zu_a(ji+1,jj) - akappa(ji,jj-1,2,1) * zv_a(ji+1,jj) 
     377                  ze22 = + akappa(ji,jj-1,2,2) * zv_a(ji+1,jj) + akappa(ji,jj-1,2,1) * zu_a(ji+1,jj) 
     378                  ze21 =   akappa(ji,jj-1,1,1) * zv_a(ji+1,jj) - akappa(ji,jj-1,1,2) * zu_a(ji+1,jj) 
     379                  zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
     380                  zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
     381                  zvis12 =       zviseta (ji,jj-1) + dm 
     382                  zvis21 =       zviseta (ji,jj-1) 
     383                  zdiag = zvis22 * ( ze11 + ze22 ) 
     384                  zs11_21 =  zvis11 * ze11 + zdiag 
     385                  zs12_21 =  zvis12 * ze12 + zvis21 * ze21 
     386                  zs22_21 =  zvis11 * ze22 + zdiag 
     387                  zs21_21 =  zvis12 * ze21 + zvis21 * ze12 
     388 
     389                  ze11 =   akappa(ji-1,jj,1,1) * ( zu_a(ji  ,jj+1) - zu_a(ji-1,jj+1) )   & 
     390                     &   + akappa(ji-1,jj,1,2) * ( zv_a(ji  ,jj+1) + zv_a(ji-1,jj+1) ) 
     391                  ze12 = + akappa(ji-1,jj,2,2) * ( zu_a(ji-1,jj+1) + zu_a(ji  ,jj+1) )   & 
     392                     &   - akappa(ji-1,jj,2,1) * ( zv_a(ji-1,jj+1) + zv_a(ji  ,jj+1) ) 
     393                  ze22 = + akappa(ji-1,jj,2,2) * ( zv_a(ji-1,jj+1) + zv_a(ji  ,jj+1) )   & 
     394                     &   + akappa(ji-1,jj,2,1) * ( zu_a(ji-1,jj+1) + zu_a(ji  ,jj+1) ) 
     395                  ze21 =   akappa(ji-1,jj,1,1) * ( zv_a(ji  ,jj+1) - zv_a(ji-1,jj+1) )   & 
     396                     &   - akappa(ji-1,jj,1,2) * ( zu_a(ji  ,jj+1) + zu_a(ji-1,jj+1) ) 
     397                  zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
     398                  zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
     399                  zvis12 =       zviseta (ji-1,jj) + dm 
     400                  zvis21 =       zviseta (ji-1,jj) 
     401                  zdiag = zvis22 * ( ze11 + ze22 ) 
     402                  zs11_12 =  zvis11 * ze11 + zdiag 
     403                  zs12_12 =  zvis12 * ze12 + zvis21 * ze21 
     404                  zs22_12 =  zvis11 * ze22 + zdiag 
     405                  zs21_12 =  zvis12 * ze21 + zvis21 * ze12 
     406 
     407                  ze11 =   akappa(ji,jj,1,1) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) - zu_a(ji  ,jj+1) )   & 
     408                     &   + akappa(ji,jj,1,2) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) + zv_a(ji  ,jj+1) ) 
     409                  ze12 = - akappa(ji,jj,2,2) * ( zu_a(ji+1,jj) - zu_a(ji  ,jj+1) - zu_a(ji+1,jj+1) )   & 
     410                     &   - akappa(ji,jj,2,1) * ( zv_a(ji+1,jj) + zv_a(ji  ,jj+1) + zv_a(ji+1,jj+1) ) 
     411                  ze22 = - akappa(ji,jj,2,2) * ( zv_a(ji+1,jj) - zv_a(ji  ,jj+1) - zv_a(ji+1,jj+1) )   & 
     412                     &   + akappa(ji,jj,2,1) * ( zu_a(ji+1,jj) + zu_a(ji  ,jj+1) + zu_a(ji+1,jj+1) ) 
     413                  ze21 =   akappa(ji,jj,1,1) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) - zv_a(ji  ,jj+1) )   & 
     414                     &   - akappa(ji,jj,1,2) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) + zu_a(ji  ,jj+1) ) 
     415                  zvis11 = 2.0 * zviseta (ji,jj) + dm 
     416                  zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj) 
     417                  zvis12 =       zviseta (ji,jj) + dm 
     418                  zvis21 =       zviseta (ji,jj) 
     419                  zdiag = zvis22 * ( ze11 + ze22 ) 
     420                  zs11_22 =  zvis11 * ze11 + zdiag 
     421                  zs12_22 =  zvis12 * ze12 + zvis21 * ze21 
     422                  zs22_22 =  zvis11 * ze22 + zdiag 
     423                  zs21_22 =  zvis12 * ze21 + zvis21 * ze12 
     424 
     425            ! 2nd part 
     426                  ze11 =   akappa(ji-1,jj-1,1,1) * ( zu_a(ji  ,jj-1) - zu_a(ji-1,jj-1) - zu_a(ji-1,jj) )   & 
     427                     &   + akappa(ji-1,jj-1,1,2) * ( zv_a(ji  ,jj-1) + zv_a(ji-1,jj-1) + zv_a(ji-1,jj) ) 
     428                  ze12 = - akappa(ji-1,jj-1,2,2) * ( zu_a(ji-1,jj-1) + zu_a(ji  ,jj-1) - zu_a(ji-1,jj) )   & 
     429                     &   - akappa(ji-1,jj-1,2,1) * ( zv_a(ji-1,jj-1) + zv_a(ji  ,jj-1) + zv_a(ji-1,jj) ) 
     430                  ze22 = - akappa(ji-1,jj-1,2,2) * ( zv_a(ji-1,jj-1) + zv_a(ji  ,jj-1) - zv_a(ji-1,jj) )   & 
     431                     &   + akappa(ji-1,jj-1,2,1) * ( zu_a(ji-1,jj-1) + zu_a(ji  ,jj-1) + zu_a(ji-1,jj) ) 
     432                  ze21 =   akappa(ji-1,jj-1,1,1) * ( zv_a(ji  ,jj-1) - zv_a(ji-1,jj-1) - zv_a(ji-1,jj) )   & 
     433                     &  -  akappa(ji-1,jj-1,1,2) * ( zu_a(ji  ,jj-1) + zu_a(ji-1,jj-1) + zu_a(ji-1,jj) ) 
     434                  zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm 
     435                  zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
     436                  zvis12 =       zviseta (ji-1,jj-1) + dm 
     437                  zvis21 =       zviseta (ji-1,jj-1) 
     438                  zdiag = zvis22 * ( ze11 + ze22 ) 
     439                  zs11_11 =  zvis11 * ze11 + zdiag 
     440                  zs12_11 =  zvis12 * ze12 + zvis21 * ze21 
     441                  zs22_11 =  zvis11 * ze22 + zdiag 
     442                  zs21_11 =  zvis12 * ze21 + zvis21 * ze12 
     443 
     444                  ze11 =   akappa(ji,jj-1,1,1) * ( zu_a(ji+1,jj-1) - zu_a(ji  ,jj-1) )   & 
     445                     &   + akappa(ji,jj-1,1,2) * ( zv_a(ji+1,jj-1) + zv_a(ji  ,jj-1) ) 
     446                  ze12 = - akappa(ji,jj-1,2,2) * ( zu_a(ji  ,jj-1) + zu_a(ji+1,jj-1) )   & 
     447                     &   - akappa(ji,jj-1,2,1) * ( zv_a(ji  ,jj-1) + zv_a(ji+1,jj-1) ) 
     448                  ze22 = - akappa(ji,jj-1,2,2) * ( zv_a(ji  ,jj-1) + zv_a(ji+1,jj-1) )   & 
     449                     &   + akappa(ji,jj-1,2,1) * ( zu_a(ji  ,jj-1) + zu_a(ji+1,jj-1) ) 
     450                  ze21 =   akappa(ji,jj-1,1,1) * ( zv_a(ji+1,jj-1) - zv_a(ji  ,jj-1) )   & 
     451                     &   - akappa(ji,jj-1,1,2) * ( zu_a(ji+1,jj-1) + zu_a(ji  ,jj-1) ) 
     452                  zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
     453                  zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
     454                  zvis12 =       zviseta (ji,jj-1) + dm 
     455                  zvis21 =       zviseta (ji,jj-1) 
     456                  zdiag = zvis22 * ( ze11 + ze22 ) 
     457                  zs11_21 =  zs11_21 + zvis11 * ze11 + zdiag 
     458                  zs12_21 =  zs12_21 + zvis12 * ze12 + zvis21 * ze21 
     459                  zs22_21 =  zs22_21 + zvis11 * ze22 + zdiag 
     460                  zs21_21 =  zs21_21 + zvis12 * ze21 + zvis21 * ze12 
     461 
     462                  ze11 = - akappa(ji-1,jj,1,1) * zu_a(ji-1,jj) + akappa(ji-1,jj,1,2) * zv_a(ji-1,jj) 
     463                  ze12 = - akappa(ji-1,jj,2,2) * zu_a(ji-1,jj) - akappa(ji-1,jj,2,1) * zv_a(ji-1,jj) 
     464                  ze22 = - akappa(ji-1,jj,2,2) * zv_a(ji-1,jj) + akappa(ji-1,jj,2,1) * zu_a(ji-1,jj) 
     465                  ze21 = - akappa(ji-1,jj,1,1) * zv_a(ji-1,jj) - akappa(ji-1,jj,1,2) * zu_a(ji-1,jj) 
     466                  zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
     467                  zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
     468                  zvis12 =       zviseta (ji-1,jj) + dm 
     469                  zvis21 =       zviseta (ji-1,jj) 
     470                  zdiag = zvis22 * ( ze11 + ze22 ) 
     471                  zs11_12 =  zs11_12 + zvis11 * ze11 + zdiag 
     472                  zs12_12 =  zs12_12 + zvis12 * ze12 + zvis21 * ze21 
     473                  zs22_12 =  zs22_12 + zvis11 * ze22 + zdiag 
     474                  zs21_12 =  zs21_12 + zvis12 * ze21 + zvis21 * ze12 
     475 
     476                  zd1 = + alambd(ji,jj,2,2,2,1) * zs11_21 + alambd(ji,jj,2,2,2,2) * zs11_22  & 
     477                     &  - alambd(ji,jj,2,2,1,1) * zs11_11 - alambd(ji,jj,2,2,1,2) * zs11_12  & 
     478                     &  - alambd(ji,jj,1,1,2,1) * zs12_21 - alambd(ji,jj,1,1,1,1) * zs12_11  & 
     479                     &  + alambd(ji,jj,1,1,2,2) * zs12_22 + alambd(ji,jj,1,1,1,2) * zs12_12  & 
     480                     &  + alambd(ji,jj,1,2,1,1) * zs21_11 + alambd(ji,jj,1,2,2,1) * zs21_21  & 
     481                     &  + alambd(ji,jj,1,2,1,2) * zs21_12 + alambd(ji,jj,1,2,2,2) * zs21_22  & 
     482                     &  - alambd(ji,jj,2,1,1,1) * zs22_11 - alambd(ji,jj,2,1,2,1) * zs22_21  & 
     483                     &  - alambd(ji,jj,2,1,1,2) * zs22_12 - alambd(ji,jj,2,1,2,2) * zs22_22 
     484 
     485                  zd2 = + alambd(ji,jj,2,2,2,1) * zs21_21 + alambd(ji,jj,2,2,2,2) * zs21_22  & 
     486                     &  - alambd(ji,jj,2,2,1,1) * zs21_11 - alambd(ji,jj,2,2,1,2) * zs21_12  & 
     487                     &  - alambd(ji,jj,1,1,2,1) * zs22_21 - alambd(ji,jj,1,1,1,1) * zs22_11  & 
     488                     &  + alambd(ji,jj,1,1,2,2) * zs22_22 + alambd(ji,jj,1,1,1,2) * zs22_12  & 
     489                     &  - alambd(ji,jj,1,2,1,1) * zs11_11 - alambd(ji,jj,1,2,2,1) * zs11_21  & 
     490                     &  - alambd(ji,jj,1,2,1,2) * zs11_12 - alambd(ji,jj,1,2,2,2) * zs11_22  & 
     491                     &  + alambd(ji,jj,2,1,1,1) * zs12_11 + alambd(ji,jj,2,1,2,1) * zs12_21  & 
     492                     &  + alambd(ji,jj,2,1,1,2) * zs12_12 + alambd(ji,jj,2,1,2,2) * zs12_22 
     493 
     494                  zur     = zu_a(ji,jj) - ui_oce(ji,jj) 
     495                  zvr     = zv_a(ji,jj) - vi_oce(ji,jj) 
     496!!!! 
     497                  zmod    = SQRT( zur*zur + zvr*zvr ) * ( 1.0 - zfrld(ji,jj) ) 
     498                  za      = rhoco * zmod 
     499!!!! 
     500!!gm chg resul    za      = rhoco * SQRT( zur*zur + zvr*zvr ) * ( 1.0 - zfrld(ji,jj) ) 
     501                  zac     = za * cangvg 
     502                  zmpzas  = alpha * zcorl(ji,jj) + za * zsang(ji,jj) 
    411503                  zmassdt = zusdtp * zmass(ji,jj) 
    412504                  zcorlal = ( 1.0 - alpha ) * zcorl(ji,jj) 
    413505 
    414                   za1(ji,jj) =  zmassdt * zu0(ji,jj) + zcorlal * zv0(ji,jj) + za1ct(ji,jj)   & 
    415                      &        + za * ( cangvg * u_oce(ji,jj) - zsang * v_oce(ji,jj) ) 
    416  
    417                   za2(ji,jj) =  zmassdt * zv0(ji,jj) - zcorlal * zu0(ji,jj) + za2ct(ji,jj)   & 
    418                      &        + za * ( cangvg * v_oce(ji,jj) + zsang * u_oce(ji,jj) ) 
    419  
    420                   zb1(ji,jj)  = zmassdt + zac - zc1u(ji,jj) 
    421                   zb2(ji,jj)  = zmpzas  - zc2u(ji,jj) 
    422                   zc1(ji,jj)  = zmpzas  + zc1v(ji,jj) 
    423                   zc2(ji,jj)  = zmassdt + zac  - zc2v(ji,jj)  
    424                   zdeter      = zc1(ji,jj) * zb2(ji,jj) + zc2(ji,jj) * zb1(ji,jj) 
    425                   zden(ji,jj) = SIGN( rone, zdeter) / MAX( epsd , ABS( zdeter ) ) 
     506                  za1 =  zmassdt * zu0(ji,jj) + zcorlal * zv0(ji,jj) + za1ct(ji,jj)   & 
     507                     &        + za * ( cangvg * ui_oce(ji,jj) - zsang(ji,jj) * vi_oce(ji,jj) ) 
     508                  za2 =  zmassdt * zv0(ji,jj) - zcorlal * zu0(ji,jj) + za2ct(ji,jj)   & 
     509                     &        + za * ( cangvg * vi_oce(ji,jj) + zsang(ji,jj) * ui_oce(ji,jj) ) 
     510                  zb1    = zmassdt + zac - zc1u(ji,jj) 
     511                  zb2    = zmpzas        - zc2u(ji,jj) 
     512                  zc1    = zmpzas        + zc1v(ji,jj) 
     513                  zc2    = zmassdt + zac - zc2v(ji,jj) 
     514                  zdeter = zc1 * zb2 + zc2 * zb1 
     515                  zden   = SIGN( rone, zdeter) / MAX( epsd , ABS( zdeter ) ) 
     516                  zunw   = (  ( za1 + zd1 ) * zc2 + ( za2 + zd2 ) * zc1 ) * zden 
     517                  zvnw   = (  ( za2 + zd2 ) * zb1 - ( za1 + zd1 ) * zb2 ) * zden 
     518                  zmask  = ( 1.0 - MAX( rzero, SIGN( rone , 1.0 - zmass(ji,jj) ) ) ) * tmu(ji,jj) 
     519 
     520                  zu_n(ji,jj) = ( zu_a(ji,jj) + om * ( zunw - zu_a(ji,jj) ) * tmu(ji,jj) ) * zmask 
     521                  zv_n(ji,jj) = ( zv_a(ji,jj) + om * ( zvnw - zv_a(ji,jj) ) * tmu(ji,jj) ) * zmask 
    426522               END DO 
    427523            END DO 
    428524 
    429             ! The computation of ice interaction term is splitted into two parts 
    430             !------------------------------------------------------------------------- 
    431  
    432             ! Terms that do not involve already up-dated velocities. 
    433           
    434             DO jj = k_j1+1, k_jpj-1 
    435                DO ji = 2, jpim1 
    436                   iim1 = ji 
    437                   ijm1 = jj - 1 
    438                   iip1 = ji + 1 
    439                   ijp1 = jj 
    440                   ze11 =   akappa(iim1,ijm1,1,1) * u_ice(iip1,ijp1) + akappa(iim1,ijm1,1,2) * v_ice(iip1,ijp1) 
    441                   ze12 = + akappa(iim1,ijm1,2,2) * u_ice(iip1,ijp1) - akappa(iim1,ijm1,2,1) * v_ice(iip1,ijp1) 
    442                   ze22 = + akappa(iim1,ijm1,2,2) * v_ice(iip1,ijp1) + akappa(iim1,ijm1,2,1) * u_ice(iip1,ijp1) 
    443                   ze21 =   akappa(iim1,ijm1,1,1) * v_ice(iip1,ijp1) - akappa(iim1,ijm1,1,2) * u_ice(iip1,ijp1) 
    444                   zvis11 = 2.0 * zviseta (iim1,ijm1) + dm 
    445                   zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1) 
    446                   zvis12 =       zviseta (iim1,ijm1) + dm 
    447                   zvis21 =       zviseta (iim1,ijm1) 
    448                   zdiag = zvis22 * ( ze11 + ze22 ) 
    449                   zs11(ji,jj,2,1) =  zvis11 * ze11 + zdiag 
    450                   zs12(ji,jj,2,1) =  zvis12 * ze12 + zvis21 * ze21 
    451                   zs22(ji,jj,2,1) =  zvis11 * ze22 + zdiag 
    452                   zs21(ji,jj,2,1) =  zvis12 * ze21 + zvis21 * ze12 
    453  
    454  
    455                   iim1 = ji - 1 
    456                   ijm1 = jj 
    457                   iip1 = ji 
    458                   ijp1 = jj + 1                    
    459                   ze11 =   akappa(iim1,ijm1,1,1) * ( u_ice(iip1,ijp1) - u_ice(iim1,ijp1) )   & 
    460                      &   + akappa(iim1,ijm1,1,2) * ( v_ice(iip1,ijp1) + v_ice(iim1,ijp1) ) 
    461                   ze12 = + akappa(iim1,ijm1,2,2) * ( u_ice(iim1,ijp1) + u_ice(iip1,ijp1) )   & 
    462                      &   - akappa(iim1,ijm1,2,1) * ( v_ice(iim1,ijp1) + v_ice(iip1,ijp1) ) 
    463                   ze22 = + akappa(iim1,ijm1,2,2) * ( v_ice(iim1,ijp1) + v_ice(iip1,ijp1) )   & 
    464                      &   + akappa(iim1,ijm1,2,1) * ( u_ice(iim1,ijp1) + u_ice(iip1,ijp1) ) 
    465                   ze21 =   akappa(iim1,ijm1,1,1) * ( v_ice(iip1,ijp1) - v_ice(iim1,ijp1) )   & 
    466                      &   - akappa(iim1,ijm1,1,2) * ( u_ice(iip1,ijp1) + u_ice(iim1,ijp1) ) 
    467                   zvis11 = 2.0 * zviseta (iim1,ijm1) + dm 
    468                   zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1) 
    469                   zvis12 =       zviseta (iim1,ijm1) + dm 
    470                   zvis21 =       zviseta (iim1,ijm1) 
    471                   zdiag = zvis22 * ( ze11 + ze22 ) 
    472                   zs11(ji,jj,1,2) =  zvis11 * ze11 + zdiag 
    473                   zs12(ji,jj,1,2) =  zvis12 * ze12 + zvis21 * ze21 
    474                   zs22(ji,jj,1,2) =  zvis11 * ze22 + zdiag 
    475                   zs21(ji,jj,1,2) =  zvis12 * ze21 + zvis21 * ze12 
    476  
    477                   iim1 = ji 
    478                   ijm1 = jj 
    479                   iip1 = ji + 1 
    480                   ijp1 = jj + 1 
    481                   ze11 =   akappa(iim1,ijm1,1,1) * ( u_ice(iip1,ijm1) + u_ice(iip1,ijp1) - u_ice(iim1,ijp1) )   & 
    482                      &   + akappa(iim1,ijm1,1,2) * ( v_ice(iip1,ijm1) + v_ice(iip1,ijp1) + v_ice(iim1,ijp1) ) 
    483                   ze12 = - akappa(iim1,ijm1,2,2) * ( u_ice(iip1,ijm1) - u_ice(iim1,ijp1) - u_ice(iip1,ijp1) )   & 
    484                      &   - akappa(iim1,ijm1,2,1) * ( v_ice(iip1,ijm1) + v_ice(iim1,ijp1) + v_ice(iip1,ijp1) ) 
    485                   ze22 = - akappa(iim1,ijm1,2,2) * ( v_ice(iip1,ijm1) - v_ice(iim1,ijp1) - v_ice(iip1,ijp1) )   & 
    486                      &   + akappa(iim1,ijm1,2,1) * ( u_ice(iip1,ijm1) + u_ice(iim1,ijp1) + u_ice(iip1,ijp1) ) 
    487                   ze21 =   akappa(iim1,ijm1,1,1) * ( v_ice(iip1,ijm1) + v_ice(iip1,ijp1) - v_ice(iim1,ijp1) )   & 
    488                      &   - akappa(iim1,ijm1,1,2) * ( u_ice(iip1,ijm1) + u_ice(iip1,ijp1) + u_ice(iim1,ijp1) )  
    489                   zvis11 = 2.0 * zviseta (iim1,ijm1) + dm 
    490                   zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1) 
    491                   zvis12 =       zviseta (iim1,ijm1) + dm 
    492                   zvis21 =       zviseta (iim1,ijm1) 
    493  
    494                   zdiag = zvis22 * ( ze11 + ze22 ) 
    495                   zs11(ji,jj,2,2) =  zvis11 * ze11 + zdiag 
    496                   zs12(ji,jj,2,2) =  zvis12 * ze12 + zvis21 * ze21 
    497                   zs22(ji,jj,2,2) =  zvis11 * ze22 + zdiag 
    498                   zs21(ji,jj,2,2) =  zvis12 * ze21 + zvis21 * ze12 
    499  
    500                END DO 
     525            CALL lbc_lnk( zu_n(:,1:jpj), 'I', -1. ) 
     526            CALL lbc_lnk( zv_n(:,1:jpj), 'I', -1. ) 
     527 
     528            ! Test of Convergence 
     529            DO jj = k_j1+1 , k_jpj-1 
     530               zresr(:,jj) = MAX( ABS( zu_a(:,jj) - zu_n(:,jj) ) , ABS( zv_a(:,jj) - zv_n(:,jj) ) ) 
    501531            END DO 
    502  
    503             ! Terms involving already up-dated velocities. 
    504             !-Using the arrays zu_ice and zv_ice in the computation of the terms ze leads to JACOBI's method;  
    505             ! Using arrays u and v in the computation of the terms ze leads to GAUSS-SEIDEL method. 
    506               
    507             DO jj = k_j1+1, k_jpj-1 
    508                DO ji = 2, jpim1 
    509                   iim1 = ji - 1 
    510                   ijm1 = jj - 1 
    511                   iip1 = ji 
    512                   ijp1 = jj 
    513                   ze11 =   akappa(iim1,ijm1,1,1) * ( zu_ice(iip1,ijm1) - zu_ice(iim1,ijm1) - zu_ice(iim1,ijp1) )   & 
    514                      &   + akappa(iim1,ijm1,1,2) * ( zv_ice(iip1,ijm1) + zv_ice(iim1,ijm1) + zv_ice(iim1,ijp1) ) 
    515                   ze12 = - akappa(iim1,ijm1,2,2) * ( zu_ice(iim1,ijm1) + zu_ice(iip1,ijm1) - zu_ice(iim1,ijp1) )   & 
    516                      &   - akappa(iim1,ijm1,2,1) * ( zv_ice(iim1,ijm1) + zv_ice(iip1,ijm1) + zv_ice(iim1,ijp1) ) 
    517                   ze22 = - akappa(iim1,ijm1,2,2) * ( zv_ice(iim1,ijm1) + zv_ice(iip1,ijm1) - zv_ice(iim1,ijp1) )   & 
    518                      &   + akappa(iim1,ijm1,2,1) * ( zu_ice(iim1,ijm1) + zu_ice(iip1,ijm1) + zu_ice(iim1,ijp1) ) 
    519                   ze21 =   akappa(iim1,ijm1,1,1) * ( zv_ice(iip1,ijm1) - zv_ice(iim1,ijm1) - zv_ice(iim1,ijp1) )   & 
    520                      &  -  akappa(iim1,ijm1,1,2) * ( zu_ice(iip1,ijm1) + zu_ice(iim1,ijm1) + zu_ice(iim1,ijp1) ) 
    521                   zvis11 = 2.0 * zviseta (iim1,ijm1) + dm 
    522                   zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1) 
    523                   zvis12 =       zviseta (iim1,ijm1) + dm 
    524                   zvis21 =       zviseta (iim1,ijm1) 
    525  
    526                   zdiag = zvis22 * ( ze11 + ze22 ) 
    527                   zs11(ji,jj,1,1) =  zvis11 * ze11 + zdiag 
    528                   zs12(ji,jj,1,1) =  zvis12 * ze12 + zvis21 * ze21 
    529                   zs22(ji,jj,1,1) =  zvis11 * ze22 + zdiag 
    530                   zs21(ji,jj,1,1) =  zvis12 * ze21 + zvis21 * ze12 
    531  
    532 #if defined key_agrif 
    533              END DO 
    534           END DO 
    535  
    536           DO jj = k_j1+1, k_jpj-1 
    537              DO ji = 2, jpim1 
    538 #endif 
    539  
    540                   iim1 = ji 
    541                   ijm1 = jj - 1 
    542                   iip1 = ji + 1 
    543                   ze11 =   akappa(iim1,ijm1,1,1) * ( zu_ice(iip1,ijm1) - zu_ice(iim1,ijm1) )   & 
    544                      &   + akappa(iim1,ijm1,1,2) * ( zv_ice(iip1,ijm1) + zv_ice(iim1,ijm1) ) 
    545                   ze12 = - akappa(iim1,ijm1,2,2) * ( zu_ice(iim1,ijm1) + zu_ice(iip1,ijm1) )   & 
    546                      &   - akappa(iim1,ijm1,2,1) * ( zv_ice(iim1,ijm1) + zv_ice(iip1,ijm1) ) 
    547                   ze22 = - akappa(iim1,ijm1,2,2) * ( zv_ice(iim1,ijm1) + zv_ice(iip1,ijm1) )   & 
    548                      &   + akappa(iim1,ijm1,2,1) * ( zu_ice(iim1,ijm1) + zu_ice(iip1,ijm1) ) 
    549                   ze21 =   akappa(iim1,ijm1,1,1) * ( zv_ice(iip1,ijm1) - zv_ice(iim1,ijm1) )   & 
    550                      &   - akappa(iim1,ijm1,1,2) * ( zu_ice(iip1,ijm1) + zu_ice(iim1,ijm1) ) 
    551                   zvis11 = 2.0 * zviseta (iim1,ijm1) + dm 
    552                   zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1) 
    553                   zvis12 =       zviseta (iim1,ijm1) + dm 
    554                   zvis21 =       zviseta (iim1,ijm1) 
    555  
    556                   zdiag = zvis22 * ( ze11 + ze22 ) 
    557                   zs11(ji,jj,2,1) =  zs11(ji,jj,2,1) + zvis11 * ze11 + zdiag 
    558                   zs12(ji,jj,2,1) =  zs12(ji,jj,2,1) + zvis12 * ze12 + zvis21 * ze21 
    559                   zs22(ji,jj,2,1) =  zs22(ji,jj,2,1) + zvis11 * ze22 + zdiag 
    560                   zs21(ji,jj,2,1) =  zs21(ji,jj,2,1) + zvis12 * ze21 + zvis21 * ze12 
    561  
    562  
    563                   iim1 = ji - 1 
    564                   ijm1 = jj  
    565                   ze11 = - akappa(iim1,ijm1,1,1) * zu_ice(iim1,ijm1) + akappa(iim1,ijm1,1,2) * zv_ice(iim1,ijm1) 
    566                   ze12 = - akappa(iim1,ijm1,2,2) * zu_ice(iim1,ijm1) - akappa(iim1,ijm1,2,1) * zv_ice(iim1,ijm1) 
    567                   ze22 = - akappa(iim1,ijm1,2,2) * zv_ice(iim1,ijm1) + akappa(iim1,ijm1,2,1) * zu_ice(iim1,ijm1) 
    568                   ze21 = - akappa(iim1,ijm1,1,1) * zv_ice(iim1,ijm1) - akappa(iim1,ijm1,1,2) * zu_ice(iim1,ijm1) 
    569                   zvis11 = 2.0 * zviseta (iim1,ijm1) + dm 
    570                   zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1) 
    571                   zvis12 =       zviseta (iim1,ijm1) + dm 
    572                   zvis21 =       zviseta (iim1,ijm1) 
    573  
    574                   zdiag = zvis22 * ( ze11 + ze22 ) 
    575                   zs11(ji,jj,1,2) =  zs11(ji,jj,1,2) + zvis11 * ze11 + zdiag  
    576                   zs12(ji,jj,1,2) =  zs12(ji,jj,1,2) + zvis12 * ze12 + zvis21 * ze21 
    577                   zs22(ji,jj,1,2) =  zs22(ji,jj,1,2) + zvis11 * ze22 + zdiag 
    578                   zs21(ji,jj,1,2) =  zs21(ji,jj,1,2) + zvis12 * ze21 + zvis21 * ze12 
    579  
    580 #if defined key_agrif 
    581              END DO 
    582           END DO 
    583  
    584           DO jj = k_j1+1, k_jpj-1 
    585              DO ji = 2, jpim1 
    586 #endif 
    587                   zd1(ji,jj) =   & 
    588                      + alambd(ji,jj,2,2,2,1) * zs11(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zs11(ji,jj,2,2)  & 
    589                      - alambd(ji,jj,2,2,1,1) * zs11(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zs11(ji,jj,1,2)  & 
    590                      - alambd(ji,jj,1,1,2,1) * zs12(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zs12(ji,jj,1,1)  & 
    591                      + alambd(ji,jj,1,1,2,2) * zs12(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zs12(ji,jj,1,2)  & 
    592                      + alambd(ji,jj,1,2,1,1) * zs21(ji,jj,1,1) + alambd(ji,jj,1,2,2,1) * zs21(ji,jj,2,1)  & 
    593                      + alambd(ji,jj,1,2,1,2) * zs21(ji,jj,1,2) + alambd(ji,jj,1,2,2,2) * zs21(ji,jj,2,2)  & 
    594                      - alambd(ji,jj,2,1,1,1) * zs22(ji,jj,1,1) - alambd(ji,jj,2,1,2,1) * zs22(ji,jj,2,1)  & 
    595                      - alambd(ji,jj,2,1,1,2) * zs22(ji,jj,1,2) - alambd(ji,jj,2,1,2,2) * zs22(ji,jj,2,2) 
    596                   zd2(ji,jj) =   & 
    597                      + alambd(ji,jj,2,2,2,1) * zs21(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zs21(ji,jj,2,2)  & 
    598                      - alambd(ji,jj,2,2,1,1) * zs21(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zs21(ji,jj,1,2)  & 
    599                      - alambd(ji,jj,1,1,2,1) * zs22(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zs22(ji,jj,1,1)  & 
    600                      + alambd(ji,jj,1,1,2,2) * zs22(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zs22(ji,jj,1,2)  & 
    601                      - alambd(ji,jj,1,2,1,1) * zs11(ji,jj,1,1) - alambd(ji,jj,1,2,2,1) * zs11(ji,jj,2,1)  & 
    602                      - alambd(ji,jj,1,2,1,2) * zs11(ji,jj,1,2) - alambd(ji,jj,1,2,2,2) * zs11(ji,jj,2,2)  & 
    603                      + alambd(ji,jj,2,1,1,1) * zs12(ji,jj,1,1) + alambd(ji,jj,2,1,2,1) * zs12(ji,jj,2,1)  & 
    604                      + alambd(ji,jj,2,1,1,2) * zs12(ji,jj,1,2) + alambd(ji,jj,2,1,2,2) * zs12(ji,jj,2,2) 
    605                END DO 
     532            zresm = MAXVAL( zresr(1:jpi,k_j1+1:k_jpj-1) ) 
     533!!!! this should be faster on scalar processor 
     534!           zresm = MAXVAL(  MAX( ABS( zu_a(1:jpi,k_j1+1:k_jpj-1) - zu_n(1:jpi,k_j1+1:k_jpj-1) ),   & 
     535!              &                  ABS( zv_a(1:jpi,k_j1+1:k_jpj-1) - zv_n(1:jpi,k_j1+1:k_jpj-1) ) )  ) 
     536!!!! 
     537            IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
     538 
     539            DO jj = k_j1, k_jpj 
     540               zu_a(:,jj) = zu_n(:,jj) 
     541               zv_a(:,jj) = zv_n(:,jj) 
    606542            END DO 
    607543 
    608             DO jj = k_j1+1, k_jpj-1 
    609                DO ji = 2, jpim1 
    610                   zunw = (  ( za1(ji,jj) + zd1(ji,jj) ) * zc2(ji,jj)        & 
    611                      &    + ( za2(ji,jj) + zd2(ji,jj) ) * zc1(ji,jj) ) * zden(ji,jj) 
    612  
    613                   zvnw = (  ( za2(ji,jj) + zd2(ji,jj) ) * zb1(ji,jj)        & 
    614                      &    - ( za1(ji,jj) + zd1(ji,jj) ) * zb2(ji,jj) ) * zden(ji,jj) 
    615  
    616                   zmask = ( 1.0 - MAX( rzero, SIGN( rone , 1.0 - zmass(ji,jj) ) ) ) * tmu(ji,jj) 
    617  
    618                   u_ice(ji,jj) = ( u_ice(ji,jj) + om * ( zunw - u_ice(ji,jj) ) * tmu(ji,jj) ) * zmask 
    619                   v_ice(ji,jj) = ( v_ice(ji,jj) + om * ( zvnw - v_ice(ji,jj) ) * tmu(ji,jj) ) * zmask 
    620                END DO 
     544            IF( zresm <= resl )   EXIT   iflag 
     545 
     546            !                                                   ! ================ ! 
     547         END DO    iflag                                        !  end Relaxation  ! 
     548         !                                                      ! ================ ! 
     549 
     550         IF( zindu == 0 ) THEN      ! even iteration 
     551            DO jj = k_j1 , k_jpj-1 
     552               zu0(:,jj) = zu_a(:,jj) 
     553               zv0(:,jj) = zv_a(:,jj) 
    621554            END DO 
    622  
    623             CALL lbc_lnk( u_ice, 'I', -1. ) 
    624             CALL lbc_lnk( v_ice, 'I', -1. ) 
    625  
    626             !---  5.2.5.4. Convergence test. 
    627             DO jj = k_j1+1 , k_jpj-1 
    628                zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) , ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    629             END DO 
    630             zresm = MAXVAL( zresr( 1:jpi , k_j1+1:k_jpj-1 ) ) 
    631             IF( lk_mpp )   CALL mpp_max( zresm )   ! max over the global domain 
    632  
    633             IF ( zresm <= resl) EXIT iflag 
    634  
    635          END DO iflag 
    636  
    637          zindu1 = 1.0 - zindu 
    638          DO jj = k_j1 , k_jpj-1 
    639             zu0(:,jj) = zindu * zu0(:,jj) + zindu1 * u_ice(:,jj) 
    640             zv0(:,jj) = zindu * zv0(:,jj) + zindu1 * v_ice(:,jj) 
    641          END DO 
    642       !                                                   ! ==================== ! 
     555         ENDIF 
     556         !                                                ! ==================== ! 
    643557      END DO                                              !  end loop over iter  ! 
    644558      !                                                   ! ==================== ! 
     559 
     560      ui_ice(:,:) = zu_a(:,1:jpj) 
     561      vi_ice(:,:) = zv_a(:,1:jpj) 
    645562 
    646563      IF(ln_ctl) THEN 
    647564         WRITE(charout,FMT="('lim_rhg  : res =',D23.16, ' iter =',I4)") zresm, jter 
    648565         CALL prt_ctl_info(charout) 
    649          CALL prt_ctl(tab2d_1=u_ice, clinfo1=' lim_rhg  : u_ice :', tab2d_2=v_ice, clinfo2=' v_ice :') 
     566         CALL prt_ctl(tab2d_1=ui_ice, clinfo1=' lim_rhg  : ui_ice :', tab2d_2=vi_ice, clinfo2=' vi_ice :') 
    650567      ENDIF 
    651568 

  • trunk/NEMO/LIM_SRC_2/limrst_2.F90

    r823 r888  
    1717   !!---------------------------------------------------------------------- 
    1818   USE ice_2 
    19    USE dom_oce 
    20    USE ice_oce         ! ice variables 
     19   USE sbc_oce 
     20   USE sbc_ice 
    2121   USE daymod 
    2222 
    … …  
    2727   PRIVATE 
    2828 
    29    PUBLIC   lim_rst_opn_2     ! routine called by ??? module 
    30    PUBLIC   lim_rst_write_2   ! routine called by ??? module 
    31    PUBLIC   lim_rst_read_2    ! routine called by ??? module 
     29   PUBLIC   lim_rst_opn_2     ! routine called by sbcice_lim_2.F90 
     30   PUBLIC   lim_rst_write_2   ! routine called by sbcice_lim_2.F90 
     31   PUBLIC   lim_rst_read_2    ! routine called by iceini_2.F90 
    3232 
    3333   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write  
    … …  
    3636   !!---------------------------------------------------------------------- 
    3737   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
    38    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limrst.F90,v 1.15 2007/06/29 14:54:06 opalod Exp $  
     38   !! $ Id: $ 
    3939   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 
    … …  
    5757       
    5858      ! to get better performances with NetCDF format: 
    59       ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nfice + 1) 
    60       ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nfice + 1 
    61       IF( kt == nitrst - 2*nfice + 1 .OR. nstock == nfice .OR. ( kt == nitend - nfice + 1 .AND. .NOT. lrst_ice ) ) THEN 
     59      ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1) 
     60      ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 
     61      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    6262         ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    6363         IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    … …  
    7272            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    7373            END SELECT 
    74             IF( kt == nitrst - 2*nfice + 1 ) THEN    
    75                WRITE(numout,*)         '             kt = nitrst - 2*nfice + 1 = ', kt,' date= ', ndastp 
    76             ELSE   ;   WRITE(numout,*) '             kt = '                       , kt,' date= ', ndastp 
     74            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     75               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     76            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    7777            ENDIF 
    7878         ENDIF 
    … …  
    9090      !! ** purpose  :   output of sea-ice variable in a netcdf file 
    9191      !!---------------------------------------------------------------------- 
    92       INTEGER, INTENT(in) ::   kt     ! number of iteration 
    93       !! 
    94       INTEGER ::   iter     ! kt + nfice -1 
    95       !!---------------------------------------------------------------------- 
    96  
    97       iter = kt + nfice - 1   ! ice restarts are written at kt == nitrst - nfice + 1 
     92      INTEGER, INTENT(in) ::   kt   ! number of iteration 
     93      ! 
     94      INTEGER ::   iter   ! kt + nn_fsbc -1 
     95      !!---------------------------------------------------------------------- 
     96 
     97      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1 
    9898 
    9999      IF( iter == nitrst ) THEN 
    100100         IF(lwp) WRITE(numout,*) 
    101101         IF(lwp) WRITE(numout,*) 'lim_rst_write_2 : write ice restart file  kt =', kt 
    102          IF(lwp) WRITE(numout,*) '~~~~~~~'          
     102         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    103103      ENDIF 
    104104 
    … …  
    106106      ! ------------------  
    107107      !                                                                     ! calendar control 
    108       CALL iom_rstput( iter, nitrst, numriw, 'nfice' , REAL( nfice, wp) )      ! time-step  
    109       CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter , wp) )      ! date 
     108      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter, wp) )  
    110109       
    111110      CALL iom_rstput( iter, nitrst, numriw, 'hicif' , hicif (:,:)   )      ! prognostic variables  
    … …  
    119118      CALL iom_rstput( iter, nitrst, numriw, 'tbif2' , tbif  (:,:,2) ) 
    120119      CALL iom_rstput( iter, nitrst, numriw, 'tbif3' , tbif  (:,:,3) ) 
    121       CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice (:,:)   ) 
    122       CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice (:,:)   ) 
    123       CALL iom_rstput( iter, nitrst, numriw, 'gtaux' , gtaux (:,:)   ) 
    124       CALL iom_rstput( iter, nitrst, numriw, 'gtauy' , gtauy (:,:)   ) 
     120      CALL iom_rstput( iter, nitrst, numriw, 'ui_ice', ui_ice(:,:)   ) 
     121      CALL iom_rstput( iter, nitrst, numriw, 'vi_ice', vi_ice(:,:)   ) 
    125122      CALL iom_rstput( iter, nitrst, numriw, 'qstoif', qstoif(:,:)   ) 
    126123      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq (:,:)   ) 
    … …  
    175172      !! ** purpose  :   read of sea-ice variable restart in a netcdf file 
    176173      !!---------------------------------------------------------------------- 
    177       ! 
    178       REAL(wp) ::   zfice, ziter 
     174      REAL(wp) ::   ziter 
    179175      !!---------------------------------------------------------------------- 
    180176 
    … …  
    182178         WRITE(numout,*) 
    183179         WRITE(numout,*) 'lim_rst_read_2 : read ice NetCDF restart file' 
    184          WRITE(numout,*) '~~~~~~~~' 
     180         WRITE(numout,*) '~~~~~~~~~~~~~~' 
    185181      ENDIF 
    186182 
    187183      CALL iom_open ( 'restart_ice_in', numrir, kiolib = jprstlib ) 
    188184 
    189       CALL iom_get( numrir, 'nfice' , zfice ) 
    190       CALL iom_get( numrir, 'kt_ice', ziter )     
    191       IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter 
     185      CALL iom_get( numrir, 'kt_ice' , ziter ) 
     186      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', INT( ziter ) 
    192187      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1 
    193188 
    … …  
    196191      IF( ( nit000 - INT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
    197192         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  & 
    198          &                   '   verify the file or rerun with the value 0 for the',        & 
    199          &                   '   control of time parameter  nrstdt' ) 
    200       IF( INT(zfice) /= nfice          .AND. ABS( nrstdt ) == 1 )   & 
    201          &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nfice in ice restart',  & 
    202193         &                   '   verify the file or rerun with the value 0 for the',        & 
    203194         &                   '   control of time parameter  nrstdt' ) 
    … …  
    213204      CALL iom_get( numrir, jpdom_autoglo, 'tbif2' , tbif(:,:,2) )     
    214205      CALL iom_get( numrir, jpdom_autoglo, 'tbif3' , tbif(:,:,3) )     
    215       CALL iom_get( numrir, jpdom_autoglo, 'u_ice' , u_ice  )     
    216       CALL iom_get( numrir, jpdom_autoglo, 'v_ice' , v_ice  )     
    217       CALL iom_get( numrir, jpdom_autoglo, 'gtaux' , gtaux  )     
    218       CALL iom_get( numrir, jpdom_autoglo, 'gtauy' , gtauy  )     
     206      CALL iom_get( numrir, jpdom_autoglo, 'ui_ice', ui_ice )     
     207      CALL iom_get( numrir, jpdom_autoglo, 'vi_ice', vi_ice )     
    219208      CALL iom_get( numrir, jpdom_autoglo, 'qstoif', qstoif )     
    220209      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq  )     

  • trunk/NEMO/LIM_SRC_2/limtab_2.F90

    r823 r888  
    2121   !!---------------------------------------------------------------------- 
    2222   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    23    !! $Header$  
    24    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     23   !! $ Id: $ 
     24   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    2525   !!---------------------------------------------------------------------- 
    2626CONTAINS 

  • trunk/NEMO/LIM_SRC_2/limthd_2.F90

    r823 r888  
    44   !!              LIM thermo ice model : ice thermodynamic 
    55   !!====================================================================== 
     6   !! History :  1.0  !  00-01 (LIM) 
     7   !!            2.0  !  02-07 (C. Ethe, G. Madec) F90 
     8   !!            2.0  !  03-08 (C. Ethe)  add lim_thd_init 
     9   !!--------------------------------------------------------------------- 
    610#if defined key_lim2 
    711   !!---------------------------------------------------------------------- 
    … …  
    1822   USE ice_2           ! LIM sea-ice variables 
    1923   USE ice_oce         ! sea-ice/ocean variables 
    20    USE flx_oce         ! sea-ice/ocean forcings variables  
     24   USE sbc_oce         !  
     25   USE sbc_ice         !  
    2126   USE thd_ice_2       ! LIM thermodynamic sea-ice variables 
    2227   USE dom_ice_2       ! LIM sea-ice domain 
    … …  
    3035   PRIVATE 
    3136 
    32    !! * Routine accessibility 
    33    PUBLIC lim_thd_2       ! called by lim_step_2 
    34  
    35    !! * Module variables 
    36    REAL(wp)  ::            &  ! constant values 
    37       epsi20 = 1.e-20   ,  & 
    38       epsi16 = 1.e-16   ,  & 
    39       epsi04 = 1.e-04   ,  & 
    40       zzero  = 0.e0     ,  & 
    41       zone   = 1.e0 
     37   PUBLIC   lim_thd_2  ! called by lim_step 
     38 
     39   REAL(wp)  ::   epsi20 = 1.e-20   ,  &  ! constant values 
     40      &           epsi16 = 1.e-16   ,  & 
     41      &           epsi04 = 1.e-04   ,  & 
     42      &           zzero  = 0.e0     ,  & 
     43      &           zone   = 1.e0 
    4244 
    4345   !! * Substitutions 
    … …  
    4648   !!-------- ------------------------------------------------------------- 
    4749   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    48    !! $Header$  
    49    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     50   !! $ Id: $ 
     51   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5052   !!---------------------------------------------------------------------- 
    5153 
    … …  
    6870      !!             - back to the geographic grid 
    6971      !! 
    70       !! ** References : 
    71       !!       H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
    72       !! 
    73       !! History : 
    74       !!   1.0  !  00-01 (LIM) 
    75       !!   2.0  !  02-07 (C. Ethe, G. Madec) F90 
     72      !! References :   Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
    7673      !!--------------------------------------------------------------------- 
    7774      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    78  
     75      !! 
    7976      INTEGER  ::   ji, jj,    &   ! dummy loop indices 
    8077         nbpb  ,               &   ! nb of icy pts for thermo. cal. 
    … …  
    9289         zfontn             ,  &   ! heat flux from snow thickness 
    9390         zfntlat, zpareff          ! test. the val. of lead heat budget 
    94       REAL(wp), DIMENSION(jpi,jpj) :: & 
    95          zhicifp            ,  &   ! ice thickness for outputs 
    96          zqlbsbq                   ! link with lead energy budget qldif 
    97       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    98          zmsk                      ! working array 
     91      REAL(wp), DIMENSION(jpi,jpj) ::   zhicifp,   &  ! ice thickness for outputs 
     92         &                              zqlbsbq       ! link with lead energy budget qldif 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmsk      ! working array 
    9994      !!------------------------------------------------------------------- 
    10095 
    101       IF( kt == nit000  )   CALL lim_thd_init_2  ! Initialization (first time-step only) 
     96      IF( kt == nit000 )   CALL lim_thd_init_2  ! Initialization (first time-step only) 
    10297    
    10398      !-------------------------------------------! 
    … …  
    173168      !-------------------------------------------------------------------------- 
    174169 
     170      sst_m(:,:) = sst_m(:,:) + rt0 
     171 
    175172      !CDIR NOVERRCHK 
    176173      DO jj = 1, jpj 
    … …  
    188185            !  temperature and turbulent mixing (McPhee, 1992) 
    189186            zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  ! friction velocity 
    190             fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_io(ji,jj) - tfu(ji,jj) )  
     187            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_m(ji,jj) - tfu(ji,jj) )  
    191188            qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice 
    192189                         
    193190            !  partial computation of the lead energy budget (qldif) 
    194191            zfontn         = ( sprecip(ji,jj) / rhosn ) * xlsn  !   energy for melting 
    195             zfnsol         = qnsr_oce(ji,jj)  !  total non solar flux 
    196             qldif(ji,jj)   = tms(ji,jj) * ( qsr_oce(ji,jj) * ( 1.0 - thcm(ji,jj) )   & 
     192            zfnsol         = qns(ji,jj)                         !  total non solar flux over the ocean 
     193            qldif(ji,jj)   = tms(ji,jj) * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )   & 
    197194               &                               + zfnsol + fdtcn(ji,jj) - zfontn     & 
    198195               &                               + ( 1.0 - zindb ) * fsbbq(ji,jj) )   & 
    … …  
    206203             
    207204            !  energy needed to bring ocean surface layer until its freezing 
    208             qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( tfu(ji,jj) - sst_io(ji,jj) ) * ( 1 - zinda ) 
     205            qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( tfu(ji,jj) - sst_m(ji,jj) ) * ( 1 - zinda ) 
    209206             
    210207            !  calculate oceanic heat flux. 
    … …  
    216213      END DO 
    217214       
     215      sst_m(:,:) = sst_m(:,:) - rt0 
    218216       
    219217      !         Select icy points and fulfill arrays for the vectorial grid. 
    … …  
    258256         CALL tab_2d_1d_2( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0     , jpi, jpj, npb(1:nbpb) ) 
    259257         CALL tab_2d_1d_2( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0     , jpi, jpj, npb(1:nbpb) ) 
    260          CALL tab_2d_1d_2( nbpb, qnsr_ice_1d(1:nbpb)     , qnsr_ice   , jpi, jpj, npb(1:nbpb) ) 
     258         CALL tab_2d_1d_2( nbpb, qns_ice_1d (1:nbpb)     , qns_ice    , jpi, jpj, npb(1:nbpb) ) 
    261259#if ! defined key_coupled 
    262260         CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb)     , qla_ice    , jpi, jpj, npb(1:nbpb) ) 
    … …  
    404402         CALL prt_ctl(tab2d_1=qstoif, clinfo1=' lim_thd: qstoif  : ', tab2d_2=fsbbq , clinfo2=' fsbbq  : ') 
    405403      ENDIF 
    406  
     404       ! 
    407405    END SUBROUTINE lim_thd_2 
    408406 
    … …  
    419417      !! 
    420418      !! ** input   :   Namelist namicether 
    421       !! 
    422       !! history : 
    423       !!  8.5  ! 03-08 (C. Ethe) original code 
    424419      !!------------------------------------------------------------------- 
    425420      NAMELIST/namicethd/ hmelt , hiccrit, hicmin, hiclim, amax  ,        & 

  • trunk/NEMO/LIM_SRC_2/limthd_lac_2.F90

    r823 r888  
    3030   !!---------------------------------------------------------------------- 
    3131   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    32    !! $Header$  
     32   !! $ Id: $ 
    3333   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3434   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r823 r888  
    44   !!                thermodynamic growth and decay of the ice  
    55   !!====================================================================== 
     6   !! History :  1.0  !  01-04 (LIM) Original code 
     7   !!            2.0  !  02-08 (C. Ethe, G. Madec) F90 
     8   !!---------------------------------------------------------------------- 
    69#if defined key_lim2 
    710   !!---------------------------------------------------------------------- 
    811   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
     12   !!---------------------------------------------------------------------- 
    913   !!---------------------------------------------------------------------- 
    1014   !!   lim_thd_zdf_2 : vertical accr./abl. and lateral ablation of sea ice 
    … …  
    2226   PRIVATE 
    2327 
    24    !! * Routine accessibility 
    25    PUBLIC lim_thd_zdf_2      ! called by lim_thd_2 
    26  
    27    !! * Module variables 
    28    REAL(wp)  ::           &  ! constant values 
    29       epsi20 = 1.e-20  ,  & 
    30       epsi13 = 1.e-13  ,  & 
    31       zzero  = 0.e0    ,  & 
    32       zone   = 1.e0 
     28   PUBLIC   lim_thd_zdf_2        ! called by lim_thd_2 
     29 
     30   REAL(wp) ::   epsi20 = 1.e-20  ,  &  ! constant values 
     31      &          epsi13 = 1.e-13  ,  & 
     32      &          zzero  = 0.e0    ,  & 
     33      &          zone   = 1.e0 
    3334   !!---------------------------------------------------------------------- 
    3435   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    35    !! $Header$  
    36    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    37    !!---------------------------------------------------------------------- 
     36   !! $ Id: $ 
     37   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     38   !!---------------------------------------------------------------------- 
     39 
    3840CONTAINS 
    3941 
    … …  
    6466      !!              - Performs lateral ablation 
    6567      !! 
    66       !! References : 
    67       !!   Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646    
    68       !!   Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268   
     68      !! References : Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646    
     69      !!              Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268   
     70      !!------------------------------------------------------------------ 
     71      INTEGER, INTENT(in) ::   kideb    ! Start point on which the  the computation is applied 
     72      INTEGER, INTENT(in) ::   kiut     ! End point on which the  the computation is applied 
    6973      !! 
    70       !! History : 
    71       !!   original    : 01-04 (LIM) 
    72       !!   addition    : 02-08 (C. Ethe, G. Madec) 
    73       !!------------------------------------------------------------------ 
    74       !! * Arguments 
    75       INTEGER , INTENT (in) ::  & 
    76          kideb ,  &  ! Start point on which the  the computation is applied 
    77          kiut        ! End point on which the  the computation is applied 
    78  
    79       !! * Local variables 
    8074      INTEGER ::   ji       ! dummy loop indices 
    81  
    82       REAL(wp) , DIMENSION(jpij,2) ::  & 
    83          zqcmlt        ! energy due to surface( /1 ) and bottom melting( /2 ) 
    84  
     75      REAL(wp), DIMENSION(jpij,2) ::   zqcmlt        ! energy due to surface( /1 ) and bottom melting( /2 ) 
    8576      REAL(wp), DIMENSION(jpij) ::  & 
    8677         ztsmlt      &    ! snow/ice surface melting temperature 
    … …  
    9788         , zts_old   &    ! previous surface temperature 
    9889         , zidsn , z1midsn , zidsnic ! tempory variables 
    99  
    100       REAL(wp), DIMENSION(jpij) :: & 
     90      REAL(wp), DIMENSION(jpij) ::   & 
    10191          zfnet       &  ! net heat flux at the top surface( incl. conductive heat flux) 
    10292          , zsprecip  &    ! snow accumulation 
    … …  
    10999          , zfrld_1d    &    ! new sea/ice fraction 
    110100          , zep            ! internal temperature of the 2nd layer of the snow/ice system 
    111  
    112101       REAL(wp), DIMENSION(3) :: &  
    113102          zplediag  &    ! principle diagonal, subdiag. and supdiag. of the  
    … …  
    115104          , zsupdiag  &    ! of the temperatures inside the snow-ice system 
    116105          , zsmbr          ! second member 
    117  
    118106       REAL(wp) :: &  
    119107          zhsu     &     ! thickness of surface layer 
    … …  
    130118          , zb2 , zd2 , zb3 , zd3 & 
    131119          , ztint          ! equivalent temperature at the snow-ice interface 
    132  
    133120       REAL(wp) :: &  
    134121          zexp      &     ! exponential function of the ice thickness 
    … …  
    148135          , zdtic        &  ! ice internal temp. increment 
    149136          , zqnes          ! conductive energy due to ice melting in the first ice layer 
    150  
    151137       REAL(wp) :: &  
    152138          ztbot     &      ! temperature at the bottom surface 
    … …  
    162148          , zc1, zpc1, zc2, zpc2, zp1, zp2 & ! tempory variables 
    163149          , ztb2, ztb3 
    164  
    165150       REAL(wp) :: &  
    166151          zdrmh         &   ! change in snow/ice thick. after snow-ice formation 
    … …  
    181166       !     Computation of energies due to surface and bottom melting  
    182167       !----------------------------------------------------------------------- 
    183         
    184168        
    185169       DO ji = kideb , kiut 
    … …  
    201185       END DO 
    202186 
    203  
    204187       !------------------------------------------- 
    205188       !  2. Calculate some intermediate variables.   
    … …  
    265248       !     - qstbif_1d, total energy stored in brine pockets (updating) 
    266249       !------------------------------------------------------------------- 
    267  
    268250 
    269251       DO ji = kideb , kiut 
    … …  
    288270       END DO 
    289271 
    290  
    291272       !-------------------------------------------------------------------------------- 
    292273       !  4. Computation of the surface temperature : determined by considering the  
    … …  
    333314          !---computation of the energy balance function  
    334315          zfts    = - z1mi0 (ji) * qsr_ice_1d(ji)   & ! net absorbed solar radiation 
    335              &      - qnsr_ice_1d(ji)                & ! total non solar radiation 
    336              &      - zfcsu (ji)                  ! conductive heat flux from the surface 
     316             &      - qns_ice_1d(ji)                & ! total non solar radiation 
     317             &      - zfcsu (ji)                      ! conductive heat flux from the surface 
    337318          !---computation of surface temperature increment   
    338319          zdts    = -zfts / zdfts 
    … …  
    360341          sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) 
    361342#if ! defined key_coupled 
    362           qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) ) 
     343          qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) ) 
    363344          qla_ice_1d (ji) = qla_ice_1d (ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) ) 
    364345#endif 
    … …  
    366347       END DO 
    367348 
    368       
    369  
    370349       !     5.2. Calculate available heat for surface ablation.  
    371350       !--------------------------------------------------------------------- 
    372351 
    373352       DO ji = kideb, kiut 
    374           zfnet(ji) = qnsr_ice_1d(ji) + z1mi0(ji) * qsr_ice_1d(ji) + zfcsu(ji)           
     353          zfnet(ji) = qns_ice_1d(ji) + z1mi0(ji) * qsr_ice_1d(ji) + zfcsu(ji)           
    375354          zfnet(ji) = MAX( zzero , zfnet(ji) ) 
    376355          zfnet(ji) = zfnet(ji) * MAX( zzero , SIGN( zone , sist_1d(ji) - ztsmlt(ji) ) ) 
    … …  
    730709          dvnbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) 
    731710          dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn 
    732           !  case of natural freshwater flux 
    733 #if defined key_lim_fdd   
    734           rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhicnew - h_ice_1d(ji) )  * rhoic 
     711          !---  volume change of ice and snow (used for ocean-ice freshwater flux computation) 
     712          rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhicnew - h_ice_1d (ji) ) * rhoic 
    735713          rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn 
    736714 
    737 #else 
    738           rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * (  ( zhicnew - h_ice_1d(ji) ) * rhoic   & 
    739              &                                                    + ( zhsnnew - h_snow_1d(ji) ) * rhosn ) 
    740 #endif 
    741  
    742715          !---  Actualize new snow and ice thickness. 
    743  
    744716          h_snow_1d(ji)  = zhsnnew 
    745           h_ice_1d(ji)  = zhicnew 
     717          h_ice_1d (ji)  = zhicnew 
    746718 
    747719       END DO 
    … …  
    799771          qstbif_1d(ji) = zdrfrl2 * qstbif_1d(ji) 
    800772          frld_1d(ji)    = zfrld_1d(ji) 
    801  
    802        END DO 
    803         
     773          ! 
     774       END DO 
     775       !  
    804776    END SUBROUTINE lim_thd_zdf_2 
     777 
    805778#else 
    806    !!====================================================================== 
    807    !!                       ***  MODULE limthd_zdf_2   *** 
    808    !!                              no sea ice model   
    809    !!====================================================================== 
     779   !!---------------------------------------------------------------------- 
     780   !!   Default Option                                     NO sea-ice model 
     781   !!---------------------------------------------------------------------- 
    810782CONTAINS 
    811783   SUBROUTINE lim_thd_zdf_2          ! Empty routine 
    812784   END SUBROUTINE lim_thd_zdf_2 
    813785#endif 
    814  END MODULE limthd_zdf_2 
     786 
     787   !!====================================================================== 
     788END MODULE limthd_zdf_2 

  • trunk/NEMO/LIM_SRC_2/limtrp_2.F90

    r823 r888  
    3030 
    3131   !! * Routine accessibility 
    32    PUBLIC lim_trp_2     ! called by ice_step_2 
     32   PUBLIC lim_trp_2     ! called by sbc_ice_lim_2 
    3333 
    3434   !! * Shared module variables 
    … …  
    4848   !!---------------------------------------------------------------------- 
    4949   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    50    !! $Header$  
     50   !! $ Id: $ 
    5151   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5252   !!---------------------------------------------------------------------- 
    … …  
    112112         DO jj = 1, jpjm1 
    113113            DO ji = 1, jpim1 
    114                zui_u(ji,jj) = ( u_ice(ji+1,jj  ) + u_ice(ji+1,jj+1) ) / ( MAX( tmu(ji+1,jj  ) + tmu(ji+1,jj+1), zvbord ) ) 
    115                zvi_v(ji,jj) = ( v_ice(ji  ,jj+1) + v_ice(ji+1,jj+1) ) / ( MAX( tmu(ji  ,jj+1) + tmu(ji+1,jj+1), zvbord ) ) 
     114               zui_u(ji,jj) = ( ui_ice(ji+1,jj  ) + ui_ice(ji+1,jj+1) ) / ( MAX( tmu(ji+1,jj  ) + tmu(ji+1,jj+1), zvbord ) ) 
     115               zvi_v(ji,jj) = ( vi_ice(ji  ,jj+1) + vi_ice(ji+1,jj+1) ) / ( MAX( tmu(ji  ,jj+1) + tmu(ji+1,jj+1), zvbord ) ) 
    116116            END DO 
    117117         END DO 
    … …  
    128128         IF (lk_mpp ) CALL mpp_max(zcfl) 
    129129 
    130          IF ( zcfl > 0.5 .AND. lwp )   WRITE(numout,*) 'lim_trp : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl 
     130         IF ( zcfl > 0.5 .AND. lwp )   WRITE(numout,*) 'lim_trp_2 : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl 
    131131 
    132132         ! content of properties 

  • trunk/NEMO/LIM_SRC_2/limwri_2.F90

    r823 r888  
    99#if defined key_lim2 
    1010   !!---------------------------------------------------------------------- 
    11    !!   'key_lim2'  i                                 LIM 2.0 sea-ice model 
     11   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    1313   !!---------------------------------------------------------------------- 
    … …  
    1515   !!   lim_wri_init_2 : initialization and namelist read 
    1616   !!---------------------------------------------------------------------- 
    17    USE ioipsl 
    18    USE dianam    ! build name of file (routine) 
    1917   USE phycst 
    2018   USE dom_oce 
    2119   USE daymod 
    22    USE in_out_manager 
    2320   USE ice_oce         ! ice variables 
    24    USE flx_oce 
     21   USE sbc_oce 
     22   USE sbc_ice 
    2523   USE dom_ice_2 
    2624   USE ice_2 
     25 
    2726   USE lbclnk 
     27   USE dianam          ! build name of file (routine) 
     28   USE in_out_manager 
     29   USE ioipsl 
    2830 
    2931   IMPLICIT NONE 
    3032   PRIVATE 
    3133 
    32    PUBLIC   lim_wri_2        ! routine called by lim_step_2.F90 
     34   PUBLIC   lim_wri_2      ! routine called by sbc_ice_lim_2 
    3335 
    3436   INTEGER, PARAMETER                       ::   jpnoumax = 40   ! maximum number of variable for ice output 
    … …  
    4951      zone   = 1.e0 
    5052 
    51    !!---------------------------------------------------------------------- 
    52    !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    53    !! $Header$ 
     53   !! * Substitutions 
     54#   include "vectopt_loop_substitute.h90" 
     55   !!---------------------------------------------------------------------- 
     56   !!  LIM 2.0, UCL-LOCEAN-IPSL (2006) 
     57   !! $ Id: $ 
    5458   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5559   !!---------------------------------------------------------------------- 
    … …  
    7983      !!------------------------------------------------------------------- 
    8084      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    81  
     85      !! 
    8286      INTEGER  ::   ji, jj, jf                      ! dummy loop indices 
    8387      CHARACTER(len = 40)  ::   clhstnam, clop 
    … …  
    9094 
    9195      !                                          !--------------------! 
    92       IF ( kt == nit000 ) THEN                !   Initialisation   ! 
     96      IF( kt == nit000 ) THEN                    !   Initialisation   ! 
    9397         !                                       !--------------------! 
    9498         CALL lim_wri_init_2  
    … …  
    97101!!Chris         clop     = "ave(only(x))"      !ibug  namelist parameter a ajouter 
    98102         clop     = "ave(x)" 
    99          zout     = nwrite * rdt_ice / nfice 
     103         zout     = nwrite * rdt_ice / nn_fsbc 
    100104         zsec     = 0. 
    101105         niter    = 0 
    … …  
    110114          
    111115         DO jf = 1, noumef 
    112             IF ( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   & 
    113                   &                                , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
     116            IF( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   & 
     117               &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    114118         END DO 
    115119         CALL histend( nice ) 
    116           
     120         ! 
    117121      ENDIF 
    118122      !                                          !--------------------! 
    … …  
    120124      !                                          !--------------------! 
    121125 
    122 !!gm  change the print below to have it only at output time step or when nitend =< 100 
    123       IF(lwp) THEN 
    124          WRITE(numout,*) 
    125          WRITE(numout,*) 'lim_wri_2 : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, kt + nfice - 1 
    126          WRITE(numout,*) '~~~~~~~~~ ' 
    127       ENDIF 
    128  
    129       !-- calculs des valeurs instantanees 
     126      !-- Store instantaneous values in zcmo 
    130127       
    131128      zcmo(:,:, 1:jpnoumax ) = 0.e0  
    132129      DO jj = 2 , jpjm1 
    133          DO ji = 2 , jpim1 
     130         DO ji = fs_2 , fs_jpim1 
    134131            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    135132            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    … …  
    142139            zcmo(ji,jj,5)  = sist  (ji,jj) 
    143140            zcmo(ji,jj,6)  = fbif  (ji,jj) 
    144             zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    145                                       + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     141            zcmo(ji,jj,7)  = zindb * (  ui_ice(ji,jj  ) * tmu(ji,jj  ) + ui_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     142                                      + ui_ice(ji,jj+1) * tmu(ji,jj+1) + ui_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    146143                                  / ztmu  
    147144 
    148             zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    149                                       + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     145            zcmo(ji,jj,8)  = zindb * (  vi_ice(ji,jj  ) * tmu(ji,jj  ) + vi_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     146                                      + vi_ice(ji,jj+1) * tmu(ji,jj+1) + vi_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    150147                                  / ztmu 
    151             zcmo(ji,jj,9)  = sst_io(ji,jj) 
    152             zcmo(ji,jj,10) = sss_io(ji,jj) 
    153  
    154             zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    155             zcmo(ji,jj,12) = fsolar (ji,jj) 
    156             zcmo(ji,jj,13) = fnsolar(ji,jj) 
     148            zcmo(ji,jj,9)  = sst_m(ji,jj) 
     149            zcmo(ji,jj,10) = sss_m(ji,jj) 
     150            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     151            zcmo(ji,jj,12) = qsr(ji,jj) 
     152            zcmo(ji,jj,13) = qns(ji,jj) 
    157153            ! See thersf for the coefficient 
    158             zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce 
    159             zcmo(ji,jj,15) = gtaux(ji,jj) 
    160             zcmo(ji,jj,16) = gtauy(ji,jj) 
    161             zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj) 
    162             zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj) 
     154            zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ??? 
     155            zcmo(ji,jj,15) = utaui_ice(ji,jj) 
     156            zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
     157            zcmo(ji,jj,17) = qsr_ice(ji,jj) 
     158            zcmo(ji,jj,18) = qns_ice(ji,jj) 
    163159            zcmo(ji,jj,19) = sprecip(ji,jj) 
    164160         END DO 
    … …  
    175171         END DO 
    176172          
    177          IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
     173         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN 
    178174            CALL lbc_lnk( zfield, 'T', -1. ) 
    179175         ELSE  
    … …  
    181177         ENDIF 
    182178          
    183          IF ( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 
     179         IF( nc(jf) == 1 )  CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 
    184180          
    185181      END DO 
    186182       
    187       IF ( ( nfice * niter + nit000 - 1 ) >= nitend ) THEN 
    188          CALL histclo( nice )  
    189       ENDIF 
     183      IF( ( nn_fsbc * niter + nit000 - 1 ) >= nitend )   CALL histclo( nice )  
    190184      ! 
    191185   END SUBROUTINE lim_wri_2 
    … …  
    225219         field_13, field_14, field_15, field_16, field_17, field_18,   & 
    226220         field_19 
    227 !!gm      NAMELIST/namiceout/ noumef, & 
    228 !!           zfield( 1), zfield( 2), zfield( 3), zfield( 4), zfield( 5),   & 
    229 !!           zfield( 6), zfield( 7), zfield( 8), zfield( 9), zfield(10),   & 
    230 !!           zfield(11), zfield(12), zfield(13), zfield(14), zfield(15),   & 
    231 !!gm         zfield(16), zfield(17), zfield(18), zfield(19) 
    232       !!------------------------------------------------------------------- 
    233  
    234       ! Read Namelist namicewri 
    235       REWIND ( numnam_ice ) 
     221      !!------------------------------------------------------------------- 
     222 
     223      REWIND ( numnam_ice )                ! Read Namelist namicewri 
    236224      READ   ( numnam_ice  , namiceout ) 
    237225       
    238       zfield(1) = field_1 
    239       zfield(2) = field_2 
    240       zfield(3) = field_3 
    241       zfield(4) = field_4 
    242       zfield(5) = field_5 
    243       zfield(6) = field_6 
    244       zfield(7) = field_7 
    245       zfield(8) = field_8 
    246       zfield(9) = field_9 
     226      zfield( 1) = field_1 
     227      zfield( 2) = field_2 
     228      zfield( 3) = field_3 
     229      zfield( 4) = field_4 
     230      zfield( 5) = field_5 
     231      zfield( 6) = field_6 
     232      zfield( 7) = field_7 
     233      zfield( 8) = field_8 
     234      zfield( 9) = field_9 
    247235      zfield(10) = field_10 
    248236      zfield(11) = field_11 
    … …  
    274262         DO nf = 1 , noumef          
    275263            WRITE(numout,*) '   ', titn(nf), '   ', nam(nf),'      ', uni(nf),'  ', nc(nf),'        ', cmulti(nf),   & 
    276                '        ', cadd(nf) 
     264               &       '        ', cadd(nf) 
    277265         END DO 
    278266      ENDIF 

  • trunk/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    r823 r888  
    22   !!---------------------------------------------------------------------- 
    33   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    4    !! $Header$ 
     4   !! $ Id: $ 
    55   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    66   !!---------------------------------------------------------------------- 
    … …  
    8282 
    8383       zsto     = rdt_ice 
    84        zout     = nwrite * rdt_ice / nfice 
     84       zout     = nwrite * rdt_ice / nn_fsbc 
    8585       zsec     = 0. 
    8686       niter    = 0 
    … …  
    106106          zcmo(ji,jj,5)  = sist  (ji,jj) 
    107107          zcmo(ji,jj,6)  = fbif  (ji,jj) 
    108           zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    109                + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     108          zcmo(ji,jj,7)  = zindb * (  ui_ice(ji,jj  ) * tmu(ji,jj  ) + ui_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     109             &                      + ui_ice(ji,jj+1) * tmu(ji,jj+1) + ui_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    110110               / ztmu  
    111111 
    112           zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    113                + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     112          zcmo(ji,jj,8)  = zindb * (  vi_ice(ji,jj  ) * tmu(ji,jj  ) + vi_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     113             &                      + vi_ice(ji,jj+1) * tmu(ji,jj+1) + vi_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    114114               / ztmu 
    115           zcmo(ji,jj,9)  = sst_io(ji,jj) 
    116           zcmo(ji,jj,10) = sss_io(ji,jj) 
    117  
    118           zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    119           zcmo(ji,jj,12) = fsolar (ji,jj) 
    120           zcmo(ji,jj,13) = fnsolar(ji,jj) 
     115          zcmo(ji,jj,9)  = sst_m(ji,jj) 
     116          zcmo(ji,jj,10) = sss_m(ji,jj) 
     117 
     118          zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     119          zcmo(ji,jj,12) = qsr(ji,jj) 
     120          zcmo(ji,jj,13) = qns(ji,jj) 
    121121          ! See thersf for the coefficient 
    122           zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce 
    123           zcmo(ji,jj,15) = gtaux(ji,jj) 
    124           zcmo(ji,jj,16) = gtauy(ji,jj) 
    125           zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj) 
    126           zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj) 
     122          zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     123          zcmo(ji,jj,15) = utaui_ice(ji,jj) 
     124          zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
     125          zcmo(ji,jj,17) = qsr_ice(ji,jj) 
     126          zcmo(ji,jj,18) = qns_ice(ji,jj) 
    127127          zcmo(ji,jj,19) = sprecip(ji,jj) 
    128128       END DO 
    … …  
    132132    nmoyice = nmoyice + 1  
    133133    ! compute mean value if it is time to write on file 
    134     IF ( MOD(kt+nfice-1-nit000+1,nwrite) == 0 ) THEN 
     134    IF ( MOD(kt+nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN 
    135135       rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice) 
    136136#else   
    137        IF ( MOD(kt-nfice-1-nit000+1,nwrite) == 0 ) THEN  
     137       IF ( MOD(kt-nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN  
    138138          !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0 
    139139          DO jj = 2 , jpjm1 
    … …  
    149149                rcmoy(ji,jj,5)  = sist  (ji,jj) 
    150150                rcmoy(ji,jj,6)  = fbif  (ji,jj) 
    151                 rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    152                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     151                rcmoy(ji,jj,7)  = zindb * (  ui_ice(ji,jj  ) * tmu(ji,jj  ) + ui_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     152                   &                       + ui_ice(ji,jj+1) * tmu(ji,jj+1) + ui_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    153153                     / ztmu 
    154154 
    155                 rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    156                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
     155                rcmoy(ji,jj,8)  = zindb * (  vi_ice(ji,jj  ) * tmu(ji,jj  ) + vi_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
     156                   &                       + vi_ice(ji,jj+1) * tmu(ji,jj+1) + vi_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    157157                     / ztmu 
    158                 rcmoy(ji,jj,9)  = sst_io(ji,jj) 
    159                 rcmoy(ji,jj,10) = sss_io(ji,jj) 
    160  
    161                 rcmoy(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    162                 rcmoy(ji,jj,12) = fsolar (ji,jj) 
    163                 rcmoy(ji,jj,13) = fnsolar(ji,jj) 
     158                rcmoy(ji,jj,9)  = sst_m(ji,jj) 
     159                rcmoy(ji,jj,10) = sss_m(ji,jj) 
     160 
     161                rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     162                rcmoy(ji,jj,12) = qsr(ji,jj) 
     163                rcmoy(ji,jj,13) = qns(ji,jj) 
    164164                ! See thersf for the coefficient 
    165                 rcmoy(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce 
    166                 rcmoy(ji,jj,15) = gtaux(ji,jj) 
    167                 rcmoy(ji,jj,16) = gtauy(ji,jj) 
    168                 rcmoy(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj) 
    169                 rcmoy(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj) 
     165                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     166                rcmoy(ji,jj,15) = utaui_ice(ji,jj) 
     167                rcmoy(ji,jj,16) = vtaui_ice(ji,jj) 
     168                rcmoy(ji,jj,17) = qsr_ice(ji,jj) 
     169                rcmoy(ji,jj,18) = qns_ice(ji,jj) 
    170170                rcmoy(ji,jj,19) = sprecip(ji,jj) 
    171171             END DO 
    … …  
    201201          rcmoy(:,:,:) = 0.0 
    202202          nmoyice = 0  
    203        END IF     !  MOD(kt+nfice-1-nit000+1, nwrite == 0 ) ! 
     203       END IF     !  MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) ! 
    204204 
    205205     END SUBROUTINE lim_wri_2 

  • trunk/NEMO/LIM_SRC_2/par_ice_2.F90

    r823 r888  
    77   !!---------------------------------------------------------------------- 
    88   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    9    !! $Header$ 
     9   !! $ Id: $ 
    1010   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    1111   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_2/thd_ice_2.F90

    r823 r888  
    99   !!---------------------------------------------------------------------- 
    1010   !!   LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    11    !! $Header$ 
     11   !! $ Id: $ 
    1212   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    1313   !!---------------------------------------------------------------------- 
    … …  
    5757      fr1_i0_1d   ,     &  !:    "                  "      fr1_i0 
    5858      fr2_i0_1d   ,     &  !:    "                  "      fr2_i0 
    59       qnsr_ice_1d ,     &  !:    "                  "      qns_ice 
     59      qns_ice_1d ,     &  !:    "                  "      qns_ice 
    6060      qfvbq_1d    ,     &  !:    "                  "      qfvbq 
    6161      sist_1d     ,     &  !:    "                  "      sist 

  • trunk/NEMO/LIM_SRC_3/ice.F90

    r834 r888  
    99   !!---------------------------------------------------------------------- 
    1010   !!  LIM 3.0, UCL-LOCEAN-IPSL (2005) 
    11    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/ice.F90,v 1.4 2005/03/27 18:34:41 opalod Exp $ 
     11   !! $ Id: $ 
    1212   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    1313   !!---------------------------------------------------------------------- 
    … …  
    493493      diag_bot_me,                           & ! vertical bottom melt  
    494494      diag_sur_me                              ! vertical surface melt 
    495    INTEGER , PUBLIC ::   &                      !: indexes of the debugging 
    496       jiindex,           &                      !  point 
    497       jjindex 
     495   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    498496 
    499497#else 

  • trunk/NEMO/LIM_SRC_3/iceini.F90

    r862 r888  
    1313   USE in_out_manager 
    1414   USE ice_oce         ! ice variables 
    15    USE flx_oce 
     15   USE sbc_oce         ! Surface boundary condition: ocean fields 
     16   USE sbc_ice         ! Surface boundary condition: ice fields 
    1617   USE phycst          ! Define parameters for the routines 
    1718   USE ocfzpt 
    … …  
    5051   !!---------------------------------------------------------------------- 
    5152   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)  
    52    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/iceini.F90,v 1.4 2005/03/27 18:34:41 opalod Exp $  
     53   !! $ Id: $ 
    5354   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5455   !!---------------------------------------------------------------------- 
    … …  
    7475      ! Louvain la Neuve Ice model 
    7576      IF( nacc == 1 ) THEN 
    76           dtsd2   = nfice * rdtmin * 0.5 
    77           rdt_ice = nfice * rdtmin 
     77          dtsd2   = nn_fsbc * rdtmin * 0.5 
     78          rdt_ice = nn_fsbc * rdtmin 
    7879      ELSE 
    79           dtsd2   = nfice * rdt * 0.5 
    80           rdt_ice = nfice * rdt 
     80          dtsd2   = nn_fsbc * rdt * 0.5 
     81          rdt_ice = nn_fsbc * rdt 
    8182      ENDIF 
    8283 
    … …  
    104105      freeze(:,:) = at_i(:,:)   ! initialisation of sea/ice cover     
    105106# if defined key_coupled 
    106       alb_ice(:,:) = albege(:,:)      ! sea-ice albedo 
     107      Must be adpated to LIM3  
     108      alb_ice(:,:,:) = albege(:,:)      ! sea-ice albedo 
    107109# endif 
    108110       
    109       nstart = numit  + nfice       
     111      nstart = numit  + nn_fsbc       
    110112      nitrun = nitend - nit000 + 1  
    111113      nlast  = numit  + nitrun  
    … …  
    188190 
    189191       WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution ' 
    190        WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     192       WRITE(numout,*) '~~~~~~~~~~~~' 
    191193 
    192194!!-- End of declarations 

  • trunk/NEMO/LIM_SRC_3/limadv.F90

    r868 r888  
    3636   !!---------------------------------------------------------------------- 
    3737   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    38    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limadv.F90,v 1.4 2005/03/27 18:34:41 opalod Exp $  
     38   !! $ Id: $ 
    3939   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4040   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_3/limdia.F90

    r869 r888  
    77   !! 1) in lim_dia : add its definition for both hemispheres if wished 
    88   !! 2) add the new titles in lim_dia_init 
    9    !! 
     9   !!---------------------------------------------------------------------- 
    1010#if defined key_lim3 
    1111   !!---------------------------------------------------------------------- 
    … …  
    2626   USE limistate 
    2727   USE dom_oce 
     28   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2829 
    2930   IMPLICIT NONE 
    … …  
    7374   !!---------------------------------------------------------------------- 
    7475   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
    75    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limdia.F90,v 1.5 2005/03/27 18:34:41 opalod Exp $ 
     76   !! $ Id: $ 
    7677   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    7778   !!---------------------------------------------------------------------- 
    … …  
    107108       !--------------------------------------- 
    108109       zday_min = 273.0        ! zday_min = date of minimum extent, here September 30th 
    109        zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(nfice) ) 
     110       zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(nn_fsbc) ) 
    110111       IF (zday.GT.zday_min) THEN  
    111112          zshift_date  =  zday - zday_min 
    … …  
    142143                vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    143144                                                        v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12  
    144                 vinfor(53) = vinfor(53) + fsalt(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux 
     145                vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux 
    145146                vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) / 1.0e12 !brine drainage flux 
    146147                vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) / 1.0e12 !equivalent salt flux 
    147                 vinfor(59) = vinfor(59) + sst_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
    148                 vinfor(61) = vinfor(61) + sss_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
     148                vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
     149                vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
    149150                vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12  ! snow temperature 
    150151                vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12       ! ice heat content 
    … …  
    155156                vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 
    156157                vinfor(79) = 0.0 
    157                 vinfor(81) = vinfor(81) + fmass(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
     158                vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
    158159             ENDIF 
    159160          END DO 
    … …  
    293294                vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    294295                                                        v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel 
    295                 vinfor(54) = vinfor(54) + at_i(ji,jj)*fsalt(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux 
     296                vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux 
    296297                vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) / 1.0e12 ! Brine drainage salt flux 
    297298                vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) / 1.0e12 ! Equivalent salt flux 
    298                 vinfor(60) = vinfor(60) + sst_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
    299                 vinfor(62) = vinfor(62) + sss_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
     299                vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST 
     300                vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS 
    300301                vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! snow temperature 
    301302                vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! ice enthalpy 
    … …  
    306307                vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 
    307308                vinfor(80) = 0.0 
    308                 vinfor(82) = vinfor(82) + fmass(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
     309                vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 
    309310             ENDIF 
    310311          END DO 

  • trunk/NEMO/LIM_SRC_3/limdyn.F90

    r869 r888  
    1616   USE dom_ice 
    1717   USE dom_oce         ! ocean space and time domain 
    18    USE taumod 
    1918   USE ice 
    2019   USE par_ice 
     20   USE sbc_ice         ! Surface boundary condition: ice fields 
    2121   USE ice_oce 
    2222   USE iceini 
    … …  
    4141   !!---------------------------------------------------------------------- 
    4242   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008) 
    43    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limdyn.F90,v 1.5 2005/03/27 18:34:41 opalod Exp $ 
    44    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     43   !! $ Id: $ 
     44   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
    4646 
    … …  
    9090      IF ( ln_limdyn ) THEN 
    9191 
    92          ! ocean velocity 
    93          u_oce(:,:)  = u_io(:,:) * tmu(:,:) 
    94          v_oce(:,:)  = v_io(:,:) * tmv(:,:) 
    95           
    9692         old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    9793         old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
    … …  
    162158         ENDIF 
    163159 
    164          ! Ice-Ocean stress 
    165          ! ================ 
    166          DO jj = 2, jpjm1 
    167             zsang  = SIGN(1.e0, gphif(1,jj-1) ) * sangvg 
    168  
    169             DO ji = fs_2, fs_jpim1 
    170                ! computation of wind stress over ocean in X and Y direction 
    171 #if defined key_coupled && defined key_lim_cp1 
    172 !              ztairx =  ( 1.0 - at_i(ji-1,jj)   ) * gtaux(ji-1,jj)   + & 
    173 !                        ( 1.0 - at_i(ji,jj)     ) * gtaux(ji,jj  )   + & 
    174 !                        ( 1.0 - at_i(ji-1,jj-1) ) * gtaux(ji-1,jj-1) + &  
    175 !                        ( 1.0 - at_i(ji,jj-1)   ) * gtaux(ji,jj-1) 
    176  
    177 !              ztairy =  ( 1.0 - at_i(ji-1,jj)   ) * gtauy(ji-1,jj  ) + & 
    178 !                        ( 1.0 - at_i(ji,jj  )   ) * gtauy(ji,jj    ) + & 
    179 !                        ( 1.0 - at_i(ji-1,jj-1) ) * gtauy(ji-1,jj-1) + &  
    180 !                        ( 1.0 - at_i(ji,jj-1)   ) * gtauy(ji,jj-1) 
    181 #else 
    182                ztairx =  ( 2.0 - at_i(ji,jj) - at_i(ji+1,jj) ) * gtaux(ji,jj) / cai * cao 
    183                ztairy =  ( 2.0 - at_i(ji,jj) - at_i(ji,jj+1) ) * gtauy(ji,jj) / cai * cao 
    184  
    185                zsfrldmx2 = at_i(ji,jj) + at_i(ji+1,jj) 
    186                zsfrldmy2 = at_i(ji,jj) + at_i(ji,jj+1) 
    187  
    188 #endif 
    189                zu_ice   = u_ice(ji,jj) - u_oce(ji,jj) 
    190                zv_ice   = v_ice(ji,jj) - v_oce(ji,jj) 
    191                zmod     = SQRT( zu_ice * zu_ice + zv_ice * zv_ice )  
    192  
    193                ! quadratic drag formulation 
    194                ztglx   = zsfrldmx2 * rhoco * zmod * ( cangvg * zu_ice - zsang * zv_ice )  
    195                ztgly   = zsfrldmy2 * rhoco * zmod * ( cangvg * zv_ice + zsang * zu_ice )  
    196 ! 
    197 !              ! IMPORTANT 
    198 !              ! these lignes are bound to prevent numerical oscillations 
    199 !              ! in the ice-ocean stress 
    200 !              ! They are physically ill-based. There is a cleaner solution 
    201 !              ! to try (remember discussion in Paris Gurvan) 
    202 ! 
    203                ztglx   = ztglx * exp( - zmod / 0.5 ) 
    204                ztgly   = ztglx * exp( - zmod / 0.5 ) 
    205  
    206                tio_u(ji,jj) = - ( ztairx + 1.0 * ztglx ) / ( 2. * rau0 ) 
    207                tio_v(ji,jj) = - ( ztairy + 1.0 * ztgly ) / ( 2. * rau0 ) 
    208             END DO 
    209          END DO 
    210           
    211160         ! computation of friction velocity 
    212161         DO jj = 2, jpjm1 
    213162            DO ji = fs_2, fs_jpim1 
    214163 
    215                zu_ice   = u_ice(ji,jj) - u_io(ji,jj) 
     164               zu_ice   = u_ice(ji,jj) - u_oce(ji,jj) 
    216165               zt11  = rhoco * zu_ice * zu_ice 
    217166 
    218                zu_ice   = u_ice(ji-1,jj) - u_io(ji-1,jj) 
     167               zu_ice   = u_ice(ji-1,jj) - u_oce(ji-1,jj) 
    219168               zt12  = rhoco * zu_ice * zu_ice 
    220169 
    221                zv_ice   = v_ice(ji,jj) - v_io(ji,jj) 
     170               zv_ice   = v_ice(ji,jj) - v_oce(ji,jj) 
    222171               zt21  = rhoco * zv_ice * zv_ice 
    223172 
    224                zv_ice   = v_ice(ji,jj-1) - v_io(ji,jj-1) 
     173               zv_ice   = v_ice(ji,jj-1) - v_oce(ji,jj-1) 
    225174               zt22  = rhoco * zv_ice * zv_ice 
    226                ztair2 = ( ( gtaux(ji,jj) + gtaux(ji-1,jj) ) / 2. )**2 + & 
    227                         ( ( gtauy(ji,jj) + gtauy(ji,jj-1) ) / 2. )**2 
     175               ztair2 = ( ( utaui_ice(ji,jj) + utaui_ice(ji-1,jj) ) / 2. )**2 + & 
     176                        ( ( vtaui_ice(ji,jj) + vtaui_ice(ji,jj-1) ) / 2. )**2 
    228177 
    229178               ! should not be weighted 
    … …  
    241190          DO jj = 2, jpjm1 
    242191             DO ji = fs_2, fs_jpim1 
    243 #if defined key_coupled && defined key_lim_cp1 
    244                 tio_u(ji,jj) = - (  gtaux(ji  ,jj  ) + gtaux(ji-1,jj  )       & 
    245                    &              + gtaux(ji-1,jj-1) + gtaux(ji  ,jj-1) ) / ( 4 * rau0 ) 
    246  
    247                 tio_v(ji,jj) = - (  gtauy(ji  ,jj )  + gtauy(ji-1,jj  )       & 
    248                    &              + gtauy(ji-1,jj-1) + gtauy(ji  ,jj-1) ) / ( 4 * rau0 ) 
    249 #else 
    250                 tio_u(ji,jj) = - gtaux(ji,jj) / cai * cao / rau0 
    251                 tio_v(ji,jj) = - gtauy(ji,jj) / cai * cao / rau0  
    252 #endif 
    253                 ztair2 = ( ( gtaux(ji,jj) + gtaux(ji-1,jj) ) / 2. )**2 + & 
    254                          ( ( gtauy(ji,jj) + gtauy(ji,jj-1) ) / 2. )**2 
     192                ztair2 = ( ( utaui_ice(ji,jj) + utaui_ice(ji-1,jj) ) / 2. )**2 + & 
     193                         ( ( vtaui_ice(ji,jj) + vtaui_ice(ji,jj-1) ) / 2. )**2 
    255194                zustm        = SQRT( ztair2  ) 
    256195 
    … …  
    262201 
    263202      CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point 
    264       CALL lbc_lnk( tio_u, 'U', -1. )   ! I-point (i.e. ice U-V point) 
    265       CALL lbc_lnk( tio_v, 'V', -1. )   ! I-point (i.e. ice U-V point) 
    266203 
    267204      IF(ln_ctl) THEN   ! Control print 
    … …  
    269206         CALL prt_ctl_info(' - Cell values : ') 
    270207         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ') 
    271          CALL prt_ctl(tab2d_1=tio_u     , clinfo1=' lim_dyn  : tio_u     :', tab2d_2=tio_v , clinfo2=' tio_v :') 
    272208         CALL prt_ctl(tab2d_1=ust2s     , clinfo1=' lim_dyn  : ust2s     :') 
    273209         CALL prt_ctl(tab2d_1=divu_i    , clinfo1=' lim_dyn  : divu_i    :') 

  • trunk/NEMO/LIM_SRC_3/limhdf.F90

    r868 r888  
    3434   !!---------------------------------------------------------------------- 
    3535   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
    36    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limhdf.F90,v 1.5 2005/03/27 18:34:41 opalod Exp $  
     36   !! $ Id: $ 
    3737   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3838   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_3/limistate.F90

    r869 r888  
    1616   USE oce             ! dynamics and tracers variables 
    1717   USE dom_oce 
     18   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1819   USE par_ice         ! ice parameters 
    1920   USE ice_oce         ! ice variables 
    … …  
    5152   !!---------------------------------------------------------------------- 
    5253   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
    53    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limistate.F90,v 1.3 2005/03/27 18:34:41 opalod Exp $ 
    54    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     54   !! $ Id: $ 
     55   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5556   !!---------------------------------------------------------------------- 
    5657 
    … …  
    9394      CALL lim_istate_init     !  reading the initials parameters of the ice 
    9495 
    95       !-- Initialisation of sst,sss,u,v do i=1,jpi 
    96       u_io(:,:)  = 0.e0       ! ice velocity in x direction 
    97       v_io(:,:)  = 0.e0       ! ice velocity in y direction 
    98  
    9996      ! Initialisation at tn or -2 if ice 
    10097      DO jj = 1, jpj 
    … …  
    104101         END DO 
    105102      END DO 
    106  
    107       u_io  (:,:) = 0. 
    108       v_io  (:,:) = 0. 
    109       sst_io(:,:) = ( nfice - 1 ) * ( tn(:,:,1) + rt0 )   ! use the ocean initial values 
    110       sss_io(:,:) = ( nfice - 1 ) *   sn(:,:,1)           ! tricky trick *(nfice-1) ! 
    111103 
    112104      !-------------------------------------------------------------------- 
    … …  
    280272                  !--------------- 
    281273                  sm_i(ji,jj,jl)   = zidto * sinn  + ( 1.0 - zidto ) * 0.1 
    282                   smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_io(ji,jj) ) * v_i(ji,jj,jl) 
     274                  smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    283275 
    284276                  !---------- 
    … …  
    405397 
    406398                  sm_i(ji,jj,jl)   = zidto * sins  + ( 1.0 - zidto ) * 0.1 
    407                   smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_io(ji,jj) ) * v_i(ji,jj,jl) 
     399                  smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    408400 
    409401                  !---------- 
    … …  
    538530 
    539531      CALL lbc_lnk( fsbbq  , 'T', 1. ) 
    540       CALL lbc_lnk( sss_io , 'T', 1. ) 
    541532 
    542533   END SUBROUTINE lim_istate 

  • trunk/NEMO/LIM_SRC_3/limitd_me.F90

    r869 r888  
    2020   USE phycst           ! physical constants (ocean directory)  
    2121   USE ice_oce          ! ice variables 
     22   USE sbc_oce          ! Surface boundary condition: ocean fields 
    2223   USE thd_ice 
    2324   USE limistate 
    … …  
    743744      ! Temporal smoothing 
    744745      !-------------------- 
    745       IF ( numit .EQ. nit000 + nfice - 1 ) THEN 
     746      IF ( numit .EQ. nit000 + nn_fsbc - 1 ) THEN 
    746747         strp1(:,:) = 0.0             
    747748         strp2(:,:) = 0.0             
    … …  
    11941195      IF ( con_i ) THEN 
    11951196         CALL lim_column_sum (jpl,   v_i, vice_init ) 
    1196          WRITE(numout,*) ' vice_init  : ', vice_init(jiindex,jjindex) 
     1197         WRITE(numout,*) ' vice_init  : ', vice_init(jiindx,jjindx) 
    11971198         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init ) 
    1198          WRITE(numout,*) ' eice_init  : ', eice_init(jiindex,jjindex) 
     1199         WRITE(numout,*) ' eice_init  : ', eice_init(jiindx,jjindx) 
    11991200      ENDIF 
    12001201 
    … …  
    13631364            ! Salinity 
    13641365            !------------- 
    1365             smsw(ji,jj)       = sss_io(ji,jj) * vsw(ji,jj) * ridge_por  
     1366            smsw(ji,jj)       = sss_m(ji,jj) * vsw(ji,jj) * ridge_por  
    13661367 
    13671368            ! salinity of new ridge 
    … …  
    14471448                                        - eirft(ji,jj,jk) 
    14481449            ! sea water heat content 
    1449             ztmelts          = - tmut * sss_io(ji,jj) + rtt 
     1450            ztmelts          = - tmut * sss_m(ji,jj) + rtt 
    14501451            ! heat content per unit volume 
    1451             zdummy0          = - rcp * ( sst_io(ji,jj) - rtt ) * vsw(ji,jj) 
     1452            zdummy0          = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 
    14521453 
    14531454            ! corrected sea water salinity 
    … …  
    16161617         fieldid = ' v_i : limitd_me ' 
    16171618         CALL lim_cons_check (vice_init, vice_final, 1.0e-6, fieldid)  
    1618          WRITE(numout,*) ' vice_init  : ', vice_init(jiindex,jjindex) 
    1619          WRITE(numout,*) ' vice_final : ', vice_final(jiindex,jjindex) 
     1619         WRITE(numout,*) ' vice_init  : ', vice_init(jiindx,jjindx) 
     1620         WRITE(numout,*) ' vice_final : ', vice_final(jiindx,jjindx) 
    16201621 
    16211622         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_final ) 
    16221623         fieldid = ' e_i : limitd_me ' 
    16231624         CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid)  
    1624          WRITE(numout,*) ' eice_init  : ', eice_init(jiindex,jjindex) 
    1625          WRITE(numout,*) ' eice_final : ', eice_final(jiindex,jjindex) 
     1625         WRITE(numout,*) ' eice_init  : ', eice_init(jiindx,jjindx) 
     1626         WRITE(numout,*) ' eice_final : ', eice_final(jiindx,jjindx) 
    16261627      ENDIF 
    16271628 
    … …  
    18391840!           fresh_hist(i,j) = fresh_hist(i,j) + xtmp 
    18401841 
    1841 !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_io(ji,jj)                  ) * &  
     1842!           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj)                  ) * &  
    18421843!                               rhosn * v_s(ji,jj,jl) / rdt_ice 
    18431844 
    1844 !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_io(ji,jj) - sm_i(ji,jj,jl) ) * &  
     1845!           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
    18451846!                               rhoic * v_i(ji,jj,jl) / rdt_ice 
    18461847 
    1847 !           fsalt(i,j)      = fsalt(i,j)      + xtmp 
     1848!           emps(i,j)      = emps(i,j)      + xtmp 
    18481849!           fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 
    18491850 

  • trunk/NEMO/LIM_SRC_3/limmsh.F90

    r869 r888  
    2525   !!---------------------------------------------------------------------- 
    2626   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)  
    27    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limmsh.F90,v 1.5 2005/03/27 18:34:42 opalod Exp $  
     27   !! $ Id: $ 
    2828   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    2929   !!---------------------------------------------------------------------- 

  • trunk/NEMO/LIM_SRC_3/limrhg.F90

    r869 r888  
    1616   USE dom_oce 
    1717   USE dom_ice 
     18   USE sbc_ice         ! Surface boundary condition: ice fields 
    1819   USE ice 
    1920   USE iceini 
    … …  
    4041   !!---------------------------------------------------------------------- 
    4142   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)  
    42    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limrhg.F90,v 1.5 2005/03/27 18:34:42 opalod Exp $  
    43    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     43   !! $ Id: $ 
     44   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4445   !!---------------------------------------------------------------------- 
    4546 
    … …  
    268269                                          / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 
    269270            ! 
    270             u_oce1(ji,jj)  = u_io(ji,jj) 
    271             v_oce2(ji,jj)  = v_io(ji,jj) 
     271            u_oce1(ji,jj)  = u_oce(ji,jj) 
     272            v_oce2(ji,jj)  = v_oce(ji,jj) 
    272273 
    273274            ! Ocean has no slip boundary condition 
    274             v_oce1(ji,jj)  = 0.5*( (v_io(ji,jj)+v_io(ji,jj-1))*e1t(ji,jj)    & 
    275                 &                 +(v_io(ji+1,jj)+v_io(ji+1,jj-1))*e1t(ji+1,jj)) & 
     275            v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    & 
     276                &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) & 
    276277                &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)   
    277278 
    278             u_oce2(ji,jj)  = 0.5*((u_io(ji,jj)+u_io(ji-1,jj))*e2t(ji,jj)     & 
    279                 &                 +(u_io(ji,jj+1)+u_io(ji-1,jj+1))*e2t(ji,jj+1)) & 
     279            u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     & 
     280                &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) & 
    280281                &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 
    281282 
    282283            ! Wind stress. 
    283             ztagnx = ( 1. - zfrld1(ji,jj) ) * gtaux(ji,jj) 
    284             ztagny = ( 1. - zfrld2(ji,jj) ) * gtauy(ji,jj) 
     284            ztagnx = ( 1. - zfrld1(ji,jj) ) * utaui_ice(ji,jj) 
     285            ztagny = ( 1. - zfrld2(ji,jj) ) * vtaui_ice(ji,jj) 
    285286 
    286287            ! Computation of the velocity field taking into account the ice internal interaction. 
    … …  
    621622            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    622623            IF ( zdummy .LE. 5.0e-2 ) THEN 
    623                u_ice(ji,jj) = u_io(ji,jj) 
    624                v_ice(ji,jj) = v_io(ji,jj) 
     624               u_ice(ji,jj) = u_oce(ji,jj) 
     625               v_ice(ji,jj) = v_oce(ji,jj) 
    625626            ENDIF ! zdummy 
    626627         END DO 

  • trunk/NEMO/LIM_SRC_3/limrst.F90

    r838 r888  
    1818   USE dom_oce 
    1919   USE ice_oce         ! ice variables 
     20   USE sbc_oce         ! Surface boundary condition: ocean fields 
     21   USE sbc_ice         ! Surface boundary condition: ice fields 
    2022   USE daymod 
    2123   USE iom 
    … …  
    3436   !!---------------------------------------------------------------------- 
    3537   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
    36    !! $Id:$ 
     38   !! $ Id: $ 
    3739   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3840   !!---------------------------------------------------------------------- 
    … …  
    5557       
    5658      ! to get better performances with NetCDF format: 
    57       ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nfice + 1) 
    58       ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nfice + 1 
    59       IF( kt == nitrst - 2*nfice + 1 .OR. nstock == nfice .OR. ( kt == nitend - nfice + 1 .AND. .NOT. lrst_ice ) ) THEN 
     59      ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1) 
     60      ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 
     61      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    6062         ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    6163         IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    … …  
    7072            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    7173            END SELECT 
    72             IF( kt == nitrst - 2*nfice + 1 ) THEN    
    73                WRITE(numout,*)         '             kt = nitrst - 2*nfice + 1 = ', kt,' date= ', ndastp 
    74             ELSE   ;   WRITE(numout,*) '             kt = '                       , kt,' date= ', ndastp 
     74            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     75               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     76            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    7577            ENDIF 
    7678         ENDIF 
    … …  
    100102      !!---------------------------------------------------------------------- 
    101103    
    102       iter = kt + nfice - 1   ! ice restarts are written at kt == nitrst - nfice + 1 
     104      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1 
    103105 
    104106      IF( iter == nitrst ) THEN 
    … …  
    111113      ! ------------------  
    112114      !                                                                        ! calendar control 
    113       CALL iom_rstput( iter, nitrst, numriw, 'nfice' , REAL( nfice, wp) )      ! time-step  
    114       CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter , wp) )      ! date 
     115      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp) )      ! time-step  
     116      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp) )        ! date 
    115117 
    116118      ! Prognostic variables  
    … …  
    158160      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'     , u_ice      ) 
    159161      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'     , v_ice      ) 
    160       CALL iom_rstput( iter, nitrst, numriw, 'gtaux'     , gtaux      ) 
    161       CALL iom_rstput( iter, nitrst, numriw, 'gtauy'     , gtauy      ) 
     162      CALL iom_rstput( iter, nitrst, numriw, 'utaui_ice' , utaui_ice  ) 
     163      CALL iom_rstput( iter, nitrst, numriw, 'vtaui_ice' , vtaui_ice  ) 
    162164      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'     , fsbbq      ) 
    163165      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  ) 
    … …  
    299301               WRITE(numout,*) ' ~~~ Arctic' 
    300302    
    301                ji = jiindex 
    302                jj = jjindex 
     303               ji = jiindx 
     304               jj = jjindx 
    303305    
    304306               WRITE(numout,*) ' ji, jj ', ji, jj 
    … …  
    387389      !!---------------------------------------------------------------------- 
    388390      ! Local variables 
    389       INTEGER :: ji, jj, jk, jl, index 
     391      INTEGER :: ji, jj, jk, jl, indx 
    390392      REAL(wp) ::   zfice, ziter 
    391393      REAL(wp) :: & !parameters for the salinity profile 
    … …  
    405407      CALL iom_open ( 'restart_ice_in', numrir, kiolib = jprstlib ) 
    406408 
    407       CALL iom_get( numrir, 'nfice' , zfice ) 
    408       CALL iom_get( numrir, 'kt_ice', ziter )     
     409      CALL iom_get( numrir, 'nn_fsbc', zfice ) 
     410      CALL iom_get( numrir, 'kt_ice' , ziter )     
    409411      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter 
    410412      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1 
    … …  
    416418         &                   '   verify the file or rerun with the value 0 for the',        & 
    417419         &                   '   control of time parameter  nrstdt' ) 
    418       IF( INT(zfice) /= nfice          .AND. ABS( nrstdt ) == 1 )   & 
    419          &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nfice in ice restart',  & 
    420          &                   '   verify the file or rerun with the value 0 for the',        & 
     420      IF( INT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
     421         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart',  & 
     422         &                   '   verify the file or rerun with the value 0 for the',         & 
    421423         &                   '   control of time parameter  nrstdt' ) 
    422424 
    … …  
    512514      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      ) 
    513515      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    514       CALL iom_get( numrir, jpdom_autoglo, 'gtaux'     , gtaux      ) 
    515       CALL iom_get( numrir, jpdom_autoglo, 'gtauy'     , gtauy      ) 
     516      CALL iom_get( numrir, jpdom_autoglo, 'utaui_ice' , utaui_ice  ) 
     517      CALL iom_get( numrir, jpdom_autoglo, 'vtaui_ice' , vtaui_ice  ) 
    516518      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
    517519      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    … …  
    650652               WRITE(numout,*) ' ~~~ Arctic' 
    651653    
    652                index = 1 
     654               indx = 1 
    653655               ji = 24 
    654656               jj = 24 

  • trunk/NEMO/LIM_SRC_3/limtab.F90

    r834 r888  
    2323   !!---------------------------------------------------------------------- 
    2424   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)  
    25    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp $  
    26    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     25   !! $ Id: $ 
     26   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 
    2828CONTAINS 

  • trunk/NEMO/LIM_SRC_3/limthd.F90

    r869 r888  
    1818   USE ice             ! LIM sea-ice variables 
    1919   USE ice_oce         ! sea-ice/ocean variables 
    20    USE flx_oce         ! sea-ice/ocean forcings variables  
     20   USE sbc_oce         ! Surface boundary condition: ocean fields 
     21   USE sbc_ice         ! Surface boundary condition: ice fields 
    2122   USE thd_ice         ! LIM thermodynamic sea-ice variables 
    2223   USE dom_ice         ! LIM sea-ice domain 
    … …  
    5253   !!---------------------------------------------------------------------- 
    5354   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
    54    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limthd.F90,v 1.6 2005/03/27 18:34:42 opalod Exp $ 
    55    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     55   !! $ Id: $ 
     56   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5657   !!---------------------------------------------------------------------- 
    5758 
    … …  
    8485      !!--------------------------------------------------------------------- 
    8586      !! * Local variables 
    86       INTEGER  ::  ji, jj, jk, jl,  & 
    87                    zji  , zjj,      &   ! dummy loop indices 
    88                    nbpb ,           &   ! nb of icy pts for thermo. cal. 
    89                    index 
     87      INTEGER  ::  ji, jj, jk, jl, nbpb   ! nb of icy pts for thermo. cal. 
    9088 
    9189      REAL(wp) ::  & 
    … …  
    211209 
    212210            ! here the drag will depend on ice thickness and type (0.006) 
    213             fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_io(ji,jj) - t_bo(ji,jj) )  
     211            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) )  
    214212            ! also category dependent 
    215213!           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
    … …  
    220218!           !-- Lead heat budget (part 1, next one is in limthd_dh 
    221219!           !-- qldif -- (or qldif_1d in 1d routines) 
    222             zfontn         = sprecip(ji,jj) * lfus              !   energy of melting 
    223             zfnsol         = qnsr_oce(ji,jj)  ! total non solar flux 
    224             qldif(ji,jj)   = tms(ji,jj) * ( qsr_oce(ji,jj)                          & 
     220            zfontn         = sprecip(ji,jj) * lfus              ! energy of melting 
     221            zfnsol         = qns(ji,jj)                         ! total non solar flux 
     222            qldif(ji,jj)   = tms(ji,jj) * ( qsr(ji,jj)                              & 
    225223               &                               + zfnsol + fdtcn(ji,jj) - zfontn     & 
    226224               &                               + ( 1.0 - zindb ) * fsbbq(ji,jj) )   & 
    … …  
    242240            ! Energy needed to bring ocean surface layer until its freezing 
    243241            ! qcmif, limflx 
    244             qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - sst_io(ji,jj) ) * ( 1. - zinda ) 
     242            qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) * ( 1. - zinda ) 
    245243 
    246244            !  calculate oceanic heat flux (limthd_dh) 
    … …  
    271269               ENDIF 
    272270               ! debug point to follow 
    273                IF ( (ji.eq.jiindex).AND.(jj.eq.jjindex) ) THEN 
     271               IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 
    274272                   jiindex_1d = nbpb 
    275273               ENDIF 
    … …  
    310308            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0     , jpi, jpj, npb(1:nbpb) ) 
    311309            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0     , jpi, jpj, npb(1:nbpb) ) 
    312             CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb)     , qnsr_ice(:,:,jl)  , jpi, jpj, npb(1:nbpb) ) 
     310            CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb)     , qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    313311 
    314312#if ! defined key_coupled 
    … …  
    360358 
    361359                                          !---------------------------------! 
    362             CALL lim_thd_sal(1,nbpb,jl)   ! Ice salinity computation        ! 
     360            CALL lim_thd_sal(1,nbpb)      ! Ice salinity computation        ! 
    363361                                          !---------------------------------! 
    364362 
    … …  
    415413            CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
    416414            CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    417             CALL tab_1d_2d( nbpb, qnsr_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 
     415            CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 
    418416            !+++++ 
    419417 
    … …  
    543541 
    544542      INTEGER  :: & 
    545          ji,jj,jk            ! loop indices 
     543         ji,jk               ! loop indices 
    546544 
    547545      !!----------------------------------------------------------------------- 
    … …  
    598596                                       !  is violated 
    599597      INTEGER  :: & 
    600          ji,jj,jk,                  &  !: loop indices 
     598         ji,jk,                     &  !: loop indices 
    601599         zji, zjj 
    602600      !!--------------------------------------------------------------------- 
    … …  
    726724         WRITE(numout,*) ' foc        : ', fbif_1d(ji) 
    727725         WRITE(numout,*) ' fstroc     : ', fstroc   (zji,zjj,jl) 
    728          WRITE(numout,*) ' i0        : ', i0(ji) 
    729          WRITE(numout,*) ' fsolar     : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
    730          WRITE(numout,*) ' fnsolar    : ', qnsr_ice_1d(ji) 
     726         WRITE(numout,*) ' i0         : ', i0(ji) 
     727         WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
     728         WRITE(numout,*) ' qns_ice    : ', qnsr_ice_1d(ji) 
    731729         WRITE(numout,*) ' Conduction fluxes : ' 
    732730         WRITE(numout,*) ' fc_s      : ', fc_s(ji,0:nlay_s) 
    … …  
    778776         numce                         !: number of points for which conservation 
    779777                                       !  is violated 
    780       INTEGER  :: & 
    781          ji,jj,jk,                  &  !: loop indices 
    782          zji, zjj 
    783  
     778      INTEGER  ::  ji, zji, zjj        ! loop indices 
    784779      !!--------------------------------------------------------------------- 
    785780 

  • trunk/NEMO/LIM_SRC_3/limthd_dh.F90

    r869 r888  
    1616   USE phycst           ! physical constants (OCE directory)  
    1717   USE ice_oce          ! ice variables 
     18   USE sbc_oce          ! Surface boundary condition: ocean fields 
    1819   USE thd_ice 
    1920   USE iceini 
    … …  
    338339            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    339340            zfsalt_melt(ji)     = zfsalt_melt(ji) +                           & 
    340                                   ( sss_io(zji,zjj) - sm_i_b(ji)   ) *        & 
     341                                  ( sss_m(zji,zjj) - sm_i_b(ji)   ) *         & 
    341342                                  a_i_b(ji) *                                 & 
    342343                                  MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
    … …  
    368369            WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 
    369370            WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 
    370             WRITE(numout,*) ' sss_io  : ', sss_io(zji,zjj) 
     371            WRITE(numout,*) ' sss_m   : ', sss_m(zji,zjj) 
    371372         ENDIF 
    372373 
    … …  
    494495                           zswi2  * 0.26 /  & 
    495496                           ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  
    496                   zds         = zfracs*sss_io(zji,zjj) - s_i_new(ji) 
    497                   s_i_new(ji) = zfracs * sss_io(zji,zjj) 
     497                  zds         = zfracs*sss_m(zji,zjj) - s_i_new(ji) 
     498                  s_i_new(ji) = zfracs * sss_m(zji,zjj) 
    498499               ENDIF ! fc_bo_i 
    499500            END DO ! ji 
    … …  
    567568                  zjj             = ( npb(ji) - 1 ) / jpi + 1 
    568569                  zfsalt_melt(ji) = zfsalt_melt(ji) +                         & 
    569                                    ( sss_io(zji,zjj) - sm_i_b(ji)   ) *       & 
     570                                   ( sss_m(zji,zjj) - sm_i_b(ji)   ) *        & 
    570571                                   a_i_b(ji) * & 
    571572                                   MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
    … …  
    596597                WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 
    597598                WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 
    598                 WRITE(numout,*) ' sss_io  : ', sss_io(zji,zjj) 
     599                WRITE(numout,*) ' sss_m   : ', sss_m(zji,zjj) 
    599600                WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    600601                WRITE(numout,*) ' innermelt : ', innermelt(ji) 
    … …  
    701702         fseqv_1d(ji)  = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) +           & 
    702703                          (1.0 - zihgnew) * rdmicif_1d(ji) *                  & 
    703                           ( sss_io(zji,zjj) - sm_i_b(ji) ) / rdt_ice 
     704                          ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice 
    704705         ! new lines 
    705706         IF ( num_sal .EQ. 4 ) & 
    706707         fseqv_1d(ji)  = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) +           & 
    707708                          (1.0 - zihgnew) * rdmicif_1d(ji) *                  & 
    708                           ( sss_io(zji,zjj) - bulk_sal ) / rdt_ice 
     709                          ( sss_m(zji,zjj) - bulk_sal ) / rdt_ice 
    709710         ! Heat flux 
    710711         ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 
    … …  
    762763                             *(ht_s_b(ji)-zhnnew)*rhosn 
    763764 
    764 #if defined key_lim_fdd  
    765 !(presently Activated)  
    766765         rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) &  
    767766                                         * ( zhgnew(ji) - ht_i_b(ji) )*rhoic  
    … …  
    775774 
    776775         zsm_snowice  = ( rhoic - rhosn ) / rhoic *            & 
    777                         sss_io(zji,zjj)  
     776                        sss_m(zji,zjj)  
    778777 
    779778         IF ( num_sal .NE. 2 ) zsm_snowice = sm_i_b(ji) 
    … …  
    781780         IF ( num_sal .NE. 4 ) & 
    782781         fseqv_1d(ji)   = fseqv_1d(ji)   + & 
    783                           ( sss_io(zji,zjj) - zsm_snowice ) * & 
     782                          ( sss_m(zji,zjj) - zsm_snowice ) * & 
    784783                            a_i_b(ji)   * & 
    785784                          ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    … …  
    787786         IF ( num_sal .EQ. 4 ) & 
    788787         fseqv_1d(ji)   = fseqv_1d(ji)   + & 
    789                           ( sss_io(zji,zjj) - bulk_sal    ) * & 
     788                          ( sss_m(zji,zjj) - bulk_sal    ) * & 
    790789                            a_i_b(ji)   * & 
    791790                          ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    … …  
    801800                            - sm_i_b(ji) ) * isnowic      
    802801 
    803 #else 
    804          rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) & 
    805                                          * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic & 
    806                                          + ( zhnnew - ht_s_b(ji) ) * rhosn ) 
    807 #endif 
    808802!  Actualize new snow and ice thickness. 
    809803         ht_s_b(ji)  = zhnnew 

  • trunk/NEMO/LIM_SRC_3/limthd_lac.F90

    r865 r888  
    11MODULE limthd_lac 
    2 #if defined key_lim3 
    32   !!---------------------------------------------------------------------- 
    43   !!   'key_lim3'                                      LIM3 sea-ice model 
    … …  
    87   !!                lateral thermodynamic growth of the ice  
    98   !!====================================================================== 
    10  
     9#if defined key_lim3 
    1110   !!---------------------------------------------------------------------- 
    1211   !!   lim_lat_acr    : lateral accretion of ice 
    … …  
    1716   USE phycst 
    1817   USE ice_oce         ! ice variables 
     18   USE sbc_oce         ! Surface boundary condition: ocean fields 
     19   USE sbc_ice         ! Surface boundary condition: ice fields 
    1920   USE thd_ice 
    2021   USE dom_ice 
    … …  
    2324   USE iceini 
    2425   USE limtab 
    25    USE taumod 
    26    USE blk_oce 
    2726   USE limcons 
    2827      
    … …  
    4645   !!---------------------------------------------------------------------- 
    4746   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)  
    48    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limthd_lac.F90,v 1.5 2005/03/27 18:34:42 opalod Exp $  
    49    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     47   !! $ Id: $ 
     48   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5049   !!---------------------------------------------------------------------- 
    5150 
    … …  
    181180         vt_s_init, vt_s_final,   &  !  snow volume summed over categories 
    182181         et_i_init, et_i_final,   &  !  ice energy summed over categories 
    183          et_s_init, et_s_final       !  snow energy summed over categories 
     182         et_s_init                   !  snow energy summed over categories 
    184183 
    185184      REAL(wp) ::            & 
    … …  
    267266            !------------- 
    268267            ! C-grid wind stress components 
    269             ztaux         = ( gtaux(ji-1,jj  ) * tmu(ji-1,jj  ) & 
    270                           +   gtaux(ji  ,jj  ) * tmu(ji  ,jj  ) ) / 2.0 
    271             ztauy         = ( gtauy(ji  ,jj-1) * tmv(ji  ,jj-1) & 
    272                           +   gtauy(ji  ,jj  ) * tmv(ji  ,jj  ) ) / 2.0 
     268            ztaux         = ( utaui_ice(ji-1,jj  ) * tmu(ji-1,jj  ) & 
     269                          +   utaui_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) / 2.0 
     270            ztauy         = ( vtaui_ice(ji  ,jj-1) * tmv(ji  ,jj-1) & 
     271                          +   vtaui_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) / 2.0 
    273272            ! Square root of wind stress 
    274273            ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
    … …  
    343342               nbpac = nbpac + 1 
    344343               npac( nbpac ) = (jj - 1) * jpi + ji 
    345                IF ( (ji.eq.jiindex).AND.(jj.eq.jjindex) ) THEN 
     344               IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 
    346345                  jiindex_1d = nbpac 
    347346               ENDIF 
    … …  
    418417              zji            =   MOD( npac(ji) - 1, jpi ) + 1 
    419418              zjj            =   ( npac(ji) - 1 ) / jpi + 1 
    420               zs_newice(ji)  =   MIN( 0.5*sss_io(zji,zjj) , zs_newice(ji) ) 
     419              zs_newice(ji)  =   MIN( 0.5*sss_m(zji,zjj) , zs_newice(ji) ) 
    421420           END DO ! jl 
    422421 
    … …  
    476475              zjj            = ( npac(ji) - 1 ) / jpi + 1 
    477476              fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    478                                ( sss_io(zji,zjj) - bulk_sal      ) * rhoic *      & 
     477                               ( sss_m(zji,zjj) - bulk_sal      ) * rhoic *       & 
    479478                               zv_newice(ji) / rdt_ice 
    480479           END DO 
    … …  
    484483              zjj            = ( npac(ji) - 1 ) / jpi + 1 
    485484              fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    486                                ( sss_io(zji,zjj) - zs_newice(ji) ) * rhoic *      & 
     485                               ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic *       & 
    487486                               zv_newice(ji) / rdt_ice 
    488487           END DO ! ji 
    … …  
    617616        END DO 
    618617 
    619         WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex, 1:jpl) 
     618        WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 
    620619        DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    621620           DO ji = 1, nbpac 
    … …  
    626625           END DO ! ji 
    627626        END DO ! jl 
    628         WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex, 1:jpl) 
     627        WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 
    629628 
    630629        !--------------------------------- 
    … …  
    796795!     CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)  
    797796 
    798       WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindex,jjindex) 
    799       WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiindex,jjindex) 
    800       WRITE(numout,*) ' et_i_init : ', et_i_init(jiindex,jjindex) 
    801       WRITE(numout,*) ' et_i_final: ', et_i_final(jiindex,jjindex) 
     797      WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindx,jjindx) 
     798      WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiindx,jjindx) 
     799      WRITE(numout,*) ' et_i_init : ', et_i_init(jiindx,jjindx) 
     800      WRITE(numout,*) ' et_i_final: ', et_i_final(jiindx,jjindx) 
    802801 
    803802      ENDIF 

  • trunk/NEMO/LIM_SRC_3/limthd_sal.F90

    r869 r888  
    11MODULE limthd_sal 
    2 #if defined key_lim3 
    32   !!---------------------------------------------------------------------- 
    43   !!   'key_lim3'                                      LIM3 sea-ice model 
    … …  
    98   !!                               the ice 
    109   !!====================================================================== 
    11  
     10#if defined key_lim3 
    1211   !!---------------------------------------------------------------------- 
    1312   !!   lim_thd_sal : salinity variations in the ice 
    … …  
    1615   USE phycst           ! physical constants (ocean directory) 
    1716   USE ice_oce          ! ice variables 
     17   USE sbc_oce          ! Surface boundary condition: ocean fields 
    1818   USE thd_ice 
    1919   USE iceini 
    … …  
    4040   CONTAINS 
    4141 
    42    SUBROUTINE lim_thd_sal(kideb,kiut,jl) 
     42   SUBROUTINE lim_thd_sal(kideb,kiut) 
    4343      !!------------------------------------------------------------------- 
    4444      !!                ***  ROUTINE lim_thd_sal  ***        
    … …  
    7676      !! * Local variables 
    7777      INTEGER, INTENT(in) :: & 
    78          kideb, kiut, jl         !: thickness category index 
     78         kideb, kiut             !: thickness category index 
    7979 
    8080      INTEGER ::             & 
    … …  
    318318            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    319319            fseqv_1d(ji) = fseqv_1d(ji)              + &  
    320                            ( sss_io(zji,zjj) - bulk_sal    ) * &  
     320                           ( sss_m(zji,zjj) - bulk_sal    ) * &  
    321321                           rhoic * a_i_b(ji) * & 
    322322                           MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
    … …  
    327327            zjj                 = ( npb(ji) - 1 ) / jpi + 1 
    328328            fseqv_1d(ji) = fseqv_1d(ji)              + &  
    329                            ( sss_io(zji,zjj) - s_i_new(ji) ) * &  
     329                           ( sss_m(zji,zjj) - s_i_new(ji) ) * &  
    330330                             rhoic * a_i_b(ji) * & 
    331331                             MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 

  • trunk/NEMO/LIM_SRC_3/limtrp.F90

    r868 r888  
    1717   USE in_out_manager  ! I/O manager 
    1818   USE ice_oce         ! ice variables 
     19   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1920   USE dom_ice 
    2021   USE ice 
    … …  
    5152   !!---------------------------------------------------------------------- 
    5253   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008) 
    53    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtrp.F90,v 1.5 2005/03/27 18:34:42 opalod Exp $ 
    54    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     54   !! $ Id: $ 
     55   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5556   !!---------------------------------------------------------------------- 
    5657CONTAINS 
    … …  
    519520 
    520521                  ! Ice salinity and age 
    521                   zsal            = MAX( MIN( (rhoic-rhosn)/rhoic*sss_io(ji,jj)  , & 
     522                  zsal            = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj)  , & 
    522523                                            zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * & 
    523524                                            v_i(ji,jj,jl) 

  • trunk/NEMO/LIM_SRC_3/limupdate.F90

    r869 r888  
    2525   USE in_out_manager 
    2626   USE ice_oce         ! ice variables 
    27    USE flx_oce         ! forcings variables 
     27   USE sbc_oce         ! Surface boundary condition: ocean fields 
     28   USE sbc_ice         ! Surface boundary condition: ice fields 
    2829   USE dom_ice 
    2930   USE daymod 
    3031   USE phycst          ! Define parameters for the routines 
    31    USE taumod 
    3232   USE ice 
    3333   USE iceini 
    34    USE ocesbc 
    3534   USE lbclnk 
    3635   USE limdyn 
    3736   USE limtrp 
    3837   USE limthd 
    39    USE limflx 
     38   USE limsbc 
    4039   USE limdia 
    4140   USE limwri 
    … …  
    126125!+++++ [ 
    127126        WRITE(numout,*) ' O) Initial values ' 
    128         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    129         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    130         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    131         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    132         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    133         DO jk = 1, nlay_i 
    134         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     127        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     128        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     129        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     130        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     131        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     132        DO jk = 1, nlay_i 
     133        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    135134        END DO 
    136135!+++++ ] 
    … …  
    238237 
    239238              !residual salt flux if ice is over-molten 
    240               fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_io(ji,jj) - sm_i(ji,jj,jl) ) * &  
     239              fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * &  
    241240                             ( rhoic * zdvres / rdt_ice ) 
    242241!             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhoic * lfus * zdvres / rdt_ice 
    … …  
    254253 
    255254              !residual salt flux if snow is over-molten 
    256               fsalt_res(ji,jj)  = fsalt_res(ji,jj) + sss_io(ji,jj) * &  
     255              fsalt_res(ji,jj)  = fsalt_res(ji,jj) + sss_m(ji,jj) * &  
    257256                             ( rhosn * zdvres / rdt_ice ) 
    258257                             !this flux will be positive if snow was over-molten 
    … …  
    276275 
    277276     WRITE(numout,*) ' 1. Before update of Global variables ' 
    278      WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    279      WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    280      WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    281         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    282      WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    283         DO jk = 1, nlay_i 
    284         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     277     WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     278     WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     279     WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     280        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     281     WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     282        DO jk = 1, nlay_i 
     283        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    285284        END DO 
    286285!+++++ ] 
    … …  
    294293     CALL lim_var_glo2eqv ! useless, just for debug 
    295294        DO jk = 1, nlay_i 
    296         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
     295        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    297296        END DO 
    298297     e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_trp(:,:,:,:)   
    … …  
    300299        WRITE(numout,*) ' After transport update ' 
    301300        DO jk = 1, nlay_i 
    302         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
     301        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    303302        END DO 
    304303     e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_thd(:,:,:,:)   
    … …  
    306305        WRITE(numout,*) ' After thermodyn update ' 
    307306        DO jk = 1, nlay_i 
    308         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
     307        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
    309308        END DO 
    310309 
    … …  
    316315!+++++ [ 
    317316     WRITE(numout,*) ' 1. After update of Global variables (2) ' 
    318      WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    319      WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    320      WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    321         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    322      WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    323      WRITE(numout,*) ' oa_i : ', oa_i(jiindex, jjindex, 1:jpl) 
    324      WRITE(numout,*) ' e_s : ', e_s(jiindex, jjindex, 1, 1:jpl) 
    325         DO jk = 1, nlay_i 
    326         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     317     WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     318     WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     319     WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     320        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     321     WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     322     WRITE(numout,*) ' oa_i : ', oa_i(jiindx, jjindx, 1:jpl) 
     323     WRITE(numout,*) ' e_s : ', e_s(jiindx, jjindx, 1, 1:jpl) 
     324        DO jk = 1, nlay_i 
     325        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    327326        END DO 
    328327!+++++ ] 
    … …  
    348347!+++++ 
    349348     WRITE(numout,*) ' Before everything ' 
    350      WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    351      WRITE(numout,*) ' oa_i:  ', oa_i(jiindex, jjindex, 1:jpl) 
    352         DO jk = 1, nlay_i 
    353         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    354         END DO 
    355         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     349     WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     350     WRITE(numout,*) ' oa_i:  ', oa_i(jiindx, jjindx, 1:jpl) 
     351        DO jk = 1, nlay_i 
     352        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     353        END DO 
     354        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    356355!+++++ 
    357356 
    … …  
    362361!+++++ 
    363362     WRITE(numout,*) ' After advection   ' 
    364      WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    365         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     363     WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     364        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    366365!+++++ 
    367366 
    … …  
    401400!+++++ [ 
    402401        WRITE(numout,*) ' 2.1 ' 
    403         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    404         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    405         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    406         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    407         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    408         DO jk = 1, nlay_i 
    409         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     402        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     403        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     404        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     405        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     406        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     407        DO jk = 1, nlay_i 
     408        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    410409        END DO 
    411410!+++++ ] 
    … …  
    444443!+++++ [ 
    445444        WRITE(numout,*) ' 2.1 initial ' 
    446         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    447         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    448         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    449         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    450         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    451         DO jk = 1, nlay_i 
    452         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
     445        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     446        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     447        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     448        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     449        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     450        DO jk = 1, nlay_i 
     451        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
    453452        END DO 
    454453!+++++ ] 
    … …  
    464463!+++++ [ 
    465464        WRITE(numout,*) ' 2.1 before rebinning ' 
    466         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    467         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    468         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    469         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    470         DO jk = 1, nlay_i 
    471         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    472         END DO 
    473         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     465        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     466        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     467        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     468        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     469        DO jk = 1, nlay_i 
     470        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     471        END DO 
     472        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    474473!+++++ ] 
    475474 
    … …  
    483482!+++++ [ 
    484483        WRITE(numout,*) ' 2.1 after rebinning' 
    485         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    486         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    487         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    488         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    489         DO jk = 1, nlay_i 
    490         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    491         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
    492         END DO 
    493         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     484        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     485        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     486        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     487        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     488        DO jk = 1, nlay_i 
     489        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     490        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     491        END DO 
     492        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    494493!+++++ ] 
    495494 
    … …  
    611610!+++++ [ 
    612611        WRITE(numout,*) ' 2.3 after melt of an internal ice layer ' 
    613         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    614         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    615         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    616         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    617         DO jk = 1, nlay_i 
    618         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    619         WRITE(numout,*) ' t_i : ', t_i(jiindex, jjindex, jk, 1:jpl) 
    620         END DO 
    621         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     612        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     613        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     614        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     615        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     616        DO jk = 1, nlay_i 
     617        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     618        WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 
     619        END DO 
     620        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    622621!+++++ ] 
    623622 
    … …  
    638637 
    639638              !++++++ 
    640               IF ( (ji.eq.jiindex) .AND. (jj.eq.jjindex) ) THEN 
     639              IF ( (ji.eq.jiindx) .AND. (jj.eq.jjindx) ) THEN 
    641640                 WRITE(numout,*) ' jl    : ', jl 
    642641                 WRITE(numout,*) ' ze_s  : ', ze_s 
    … …  
    737736!+++++ [ 
    738737        WRITE(numout,*) ' 2.8 ' 
    739         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    740         WRITE(numout,*) ' at_i: ', at_i(jiindex,jjindex) 
    741         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    742         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
    743         DO jk = 1, nlay_i 
    744         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    745         END DO 
    746         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     738        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     739        WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 
     740        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     741        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
     742        DO jk = 1, nlay_i 
     743        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     744        END DO 
     745        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    747746!+++++ ] 
    748747 
    … …  
    767766     WRITE(numout,*) ' 2.9 ' 
    768767     DO jk = 1, nlay_i 
    769         WRITE(numout,*) ' e_i : ', e_i(jiindex, jjindex, jk, 1:jpl) 
    770      END DO 
    771         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    772  
    773         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
     768        WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 
     769     END DO 
     770        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     771 
     772        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
    774773 
    775774     !--------------------- 
    … …  
    784783              DO ji = 1, jpi 
    785784                 ! salinity stays in bounds 
    786                  smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_io(ji,jj),smv_i(ji,jj,jl)), & 
     785                 smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), & 
    787786                  0.1 * v_i(ji,jj,jl) ) 
    788787                 i_ice_switch    =  1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) 
    … …  
    798797!+++++ [ 
    799798        WRITE(numout,*) ' 2.11 ' 
    800         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    801         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    802         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    803         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    804         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     799        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     800        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     801        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     802        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     803        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    805804!+++++ ] 
    806805 
    … …  
    826825!+++++ [ 
    827826        WRITE(numout,*) ' 2.12 ' 
    828         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    829         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    830         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    831         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    832         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     827        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     828        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     829        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     830        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     831        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    833832!+++++ ] 
    834833 
    … …  
    873872!+++++ [ 
    874873        WRITE(numout,*) ' 2.13 ' 
    875         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    876         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    877         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    878         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    879         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     874        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     875        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     876        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     877        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     878        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    880879!+++++ ] 
    881880 
    … …  
    907906!+++++ [ 
    908907        WRITE(numout,*) ' rebinning before' 
    909         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    910         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    911         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    912         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    913         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     908        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     909        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     910        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     911        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     912        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    914913!+++++ ] 
    915914!old version 
    … …  
    925924!+++++ [ 
    926925        WRITE(numout,*) ' rebinning final' 
    927         WRITE(numout,*) ' a_i : ', a_i(jiindex, jjindex, 1:jpl) 
    928         WRITE(numout,*) ' at_i    ', at_i(jiindex,jjindex) 
    929         WRITE(numout,*) ' v_i : ', v_i(jiindex, jjindex, 1:jpl) 
    930         WRITE(numout,*) ' v_s : ', v_s(jiindex, jjindex, 1:jpl) 
    931         WRITE(numout,*) ' smv_i: ', smv_i(jiindex, jjindex, 1:jpl) 
     926        WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 
     927        WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx) 
     928        WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 
     929        WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 
     930        WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 
    932931!+++++ ] 
    933932 
    … …  
    10141013     END DO !ji 
    10151014 
    1016      WRITE(numout,*) ' TESTOSC1 ', tio_u(jiindex,jjindex), tio_v(jiindex,jjindex) 
    1017      WRITE(numout,*) ' TESTOSC2 ', u_ice(jiindex,jjindex), v_ice(jiindex,jjindex) 
    1018      WRITE(numout,*) ' TESTOSC3 ', u_oce(jiindex,jjindex), v_oce(jiindex,jjindex) 
    1019      WRITE(numout,*) ' TESTOSC4 ', tauxw(jiindex,jjindex), tauxw(jiindex,jjindex) 
     1015     WRITE(numout,*) ' TESTOSC1 ', tio_u(jiindx,jjindx), tio_v(jiindx,jjindx) 
     1016     WRITE(numout,*) ' TESTOSC2 ', u_ice(jiindx,jjindx), v_ice(jiindx,jjindx) 
     1017     WRITE(numout,*) ' TESTOSC3 ', u_oce(jiindx,jjindx), v_oce(jiindx,jjindx) 
     1018     WRITE(numout,*) ' TESTOSC4 ', utau (jiindx,jjindx), vtau (jiindx,jjindx) 
    10201019 
    10211020 
    … …  
    10871086         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    10881087         CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    1089          CALL prt_ctl(tab2d_1=sst_io , clinfo1= ' lim_update : sst   : ', tab2d_2=sss_io    , clinfo2= ' sss       : ') 
     1088         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    10901089         CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update : fhbri : ', tab2d_2=fheat_rpo , clinfo2= ' fheat_rpo : ') 
    10911090 
    … …  
    10931092         CALL prt_ctl_info(' - Stresses : ') 
    10941093         CALL prt_ctl_info('   ~~~~~~~~~~ ') 
    1095          CALL prt_ctl(tab2d_1=tauxw , clinfo1= ' lim_update : tauxw : ', tab2d_2=tauyw , clinfo2= ' tauyw : ') 
    1096          CALL prt_ctl(tab2d_1=taux  , clinfo1= ' lim_update : taux  : ', tab2d_2=tauy  , clinfo2= ' tauy  : ') 
    1097          CALL prt_ctl(tab2d_1=ftaux , clinfo1= ' lim_update : ftaux : ', tab2d_2=ftauy , clinfo2= ' ftauy : ') 
    1098          CALL prt_ctl(tab2d_1=gtaux , clinfo1= ' lim_update : gtaux : ', tab2d_2=gtauy , clinfo2= ' gtauy : ') 
    1099          CALL prt_ctl(tab2d_1=u_io  , clinfo1= ' lim_update : u_io  : ', tab2d_2=v_io  , clinfo2= ' v_io  : ') 
     1094         CALL prt_ctl(tab2d_1=utau       , clinfo1= ' lim_update : utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ') 
     1095         CALL prt_ctl(tab2d_1=utaui_ice  , clinfo1= ' lim_update : utaui_ice : ', tab2d_2=vtaui_ice  , clinfo2= ' vtaui_ice : ') 
     1096         CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' lim_update : u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ') 
    11001097      ENDIF 
    11011098 

  • trunk/NEMO/LIM_SRC_3/limvar.F90

    r868 r888  
    11MODULE limvar 
    2 #if defined key_lim3 
    32   !!---------------------------------------------------------------------- 
    43   !!   'key_lim3'                                      LIM3 sea-ice model 
    … …  
    3332   !!                        - ot_i(jpi,jpj)  !average ice age 
    3433   !!====================================================================== 
    35  
     34#if defined key_lim3 
    3635   !!---------------------------------------------------------------------- 
    3736   !! * Modules used 
    … …  
    4039   USE phycst           ! physical constants (ocean directory)  
    4140   USE ice_oce          ! ice variables 
     41   USE sbc_oce          ! Surface boundary condition: ocean fields 
    4242   USE thd_ice 
    4343   USE in_out_manager 
    … …  
    428428           zind0         ,     & !: switch, = 1 if sm_i lt s_i_0 
    429429           zind01        ,     & !: switch, = 1 if sm_i between s_i_0 and s_i_1 
    430            zindbal       ,     & !: switch, = 1, if 2*sm_i gt sss_io 
     430           zindbal       ,     & !: switch, = 1, if 2*sm_i gt sss_m 
    431431           zargtemp              !: dummy factor 
    432432 
    … …  
    491491                  zind01 = ( 1.0 - zind0 ) *                                  & 
    492492                           MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i(ji,jj,jl) ) )  
    493                   ! If 2.sm_i GE sss_io then zindbal = 1 
     493                  ! If 2.sm_i GE sss_m then zindbal = 1 
    494494                  zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) -      & 
    495                   sss_io(ji,jj) ) ) 
     495                  sss_m(ji,jj) ) ) 
    496496                  zalpha(ji,jj,jl) = zind0  * 1.0                             & 
    497497                                   + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + & 
    … …  
    692692               zind01 = ( 1.0 - zind0 ) *                                  & 
    693693                        MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i_b(ji) ) )  
    694                ! if 2.sm_i GE sss_io then zindbal = 1 
     694               ! if 2.sm_i GE sss_m then zindbal = 1 
    695695               zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i_b(ji) -      & 
    696                sss_io(zji,zjj) ) ) 
     696               sss_m(zji,zjj) ) ) 
    697697 
    698698               zalpha = zind0  * 1.0                                       & 

  • trunk/NEMO/LIM_SRC_3/limwri.F90

    r869 r888  
    11MODULE limwri 
    2 #if defined key_lim3 
    32   !!---------------------------------------------------------------------- 
    43   !!   'key_lim3'                                      LIM3 sea-ice model 
    … …  
    87   !!         Ice diagnostics :  write ice output files 
    98   !!====================================================================== 
     9#if defined key_lim3 
    1010   !!---------------------------------------------------------------------- 
    1111   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    12    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limwri.F90,v 1.4 2005/03/27 18:34:42 opalod Exp $ 
     12   !! $ Id: $ 
    1313   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    1414   !!---------------------------------------------------------------------- 
    … …  
    1818   !! * Modules used 
    1919   USE ioipsl 
    20    USE dianam    ! build name of file (routine) 
     20   USE dianam          ! build name of file (routine) 
    2121   USE phycst 
    2222   USE dom_oce 
    … …  
    2424   USE in_out_manager 
    2525   USE ice_oce         ! ice variables 
    26    USE flx_oce 
     26   USE sbc_oce         ! Surface boundary condition: ocean fields 
     27   USE sbc_ice         ! Surface boundary condition: ice fields 
    2728   USE dom_ice 
    2829   USE ice 
    … …  
    137138         zsto     = rdt_ice 
    138139         clop     = "ave(x)" 
    139          zout     = nwrite * rdt_ice / nfice 
     140         zout     = nwrite * rdt_ice / nn_fsbc 
    140141         zsec     = 0. 
    141142         niter    = 0 
    … …  
    165166         zsto     = rdt_ice 
    166167         clop     = "ave(x)" 
    167          zout     = nwrite * rdt_ice / nfice 
     168         zout     = nwrite * rdt_ice / nn_fsbc 
    168169         zsec     = 0. 
    169170         nitera   = 0 
    … …  
    221222               zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
    222223               zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)  
    223                zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qnsr_ice(ji,jj,jl)  
     224               zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl)  
    224225               zcmo(ji,jj,27) = zcmo(ji,jj,27) + t_su(ji,jj,jl)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi16)*zinda 
    225226            END DO 
    … …  
    253254     &                     / 2.0  
    254255            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj)        & 
    255      &                              + v_ice(ji,jj-1) * tmv(ji,jj-1) )      & 
     256     &                                + v_ice(ji,jj-1) * tmv(ji,jj-1) )    & 
    256257     &                     / 2.0 
    257             zcmo(ji,jj,9)  = sst_io(ji,jj) 
    258             zcmo(ji,jj,10) = sss_io(ji,jj) 
    259  
    260             zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    261             zcmo(ji,jj,12) = fsolar (ji,jj) 
    262             zcmo(ji,jj,13) = fnsolar(ji,jj) 
     258            zcmo(ji,jj,9)  = sst_m(ji,jj) 
     259            zcmo(ji,jj,10) = sss_m(ji,jj) 
     260 
     261            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     262            zcmo(ji,jj,12) = qsr(ji,jj) 
     263            zcmo(ji,jj,13) = qns(ji,jj) 
    263264            zcmo(ji,jj,14) = fhbri(ji,jj) 
    264             zcmo(ji,jj,15) = gtaux(ji,jj) 
    265             zcmo(ji,jj,16) = gtauy(ji,jj) 
    266             zcmo(ji,jj,17) = zcmo(ji,jj,17) + (1.0-at_i(ji,jj))*qsr_oce(ji,jj) 
    267             zcmo(ji,jj,18) = zcmo(ji,jj,18) + (1.0-at_i(ji,jj))*qnsr_oce (ji,jj) 
     265            zcmo(ji,jj,15) = utaui_ice(ji,jj) 
     266            zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
     267            zcmo(ji,jj,17) = zcmo(ji,jj,17) + (1.0-at_i(ji,jj))*qsr(ji,jj) 
     268            zcmo(ji,jj,18) = zcmo(ji,jj,18) + (1.0-at_i(ji,jj))*qns(ji,jj) 
    268269            zcmo(ji,jj,19) = sprecip(ji,jj) 
    269270            zcmo(ji,jj,20) = smt_i(ji,jj) 
    … …  
    299300         END DO 
    300301          
    301          IF ( jf == 7  .OR. jf == 8  .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR.   & 
    302             jf == 16 ) THEN  
     302         IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
    303303            CALL lbc_lnk( zfield, 'T', -1. ) 
    304304         ELSE  
    … …  
    315315      END DO 
    316316 
    317       IF ( ( nfice * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
     317      IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
    318318          WRITE(numout,*) ' Closing the icemod file ' 
    319319          CALL histclo( nice ) 
    … …  
    374374!     not yet implemented 
    375375       
    376       IF ( ( nfice * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
     376      IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
    377377         WRITE(numout,*) ' Closing the icemod file ' 
    378378         CALL histclo( nicea )  

  • trunk/NEMO/LIM_SRC_3/limwri_dimg.h90

    r825 r888  
    22   !!---------------------------------------------------------------------- 
    33   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    4    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limwri_dimg.h90,v 1.2 2005/03/27 18:34:42 opalod Exp $ 
     4   !! $ Id: $ 
    55   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    66   !!---------------------------------------------------------------------- 
    … …  
    8080 
    8181       zsto     = rdt_ice 
    82        zout     = nwrite * rdt_ice / nfice 
     82       zout     = nwrite * rdt_ice / nn_fsbc 
    8383       zsec     = 0. 
    8484       niter    = 0 
    … …  
    111111               + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    112112               / ztmu 
    113           zcmo(ji,jj,9)  = sst_io(ji,jj) 
    114           zcmo(ji,jj,10) = sss_io(ji,jj) 
    115  
    116           zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    117           zcmo(ji,jj,12) = fsolar (ji,jj) 
    118           zcmo(ji,jj,13) = fnsolar(ji,jj) 
     113          zcmo(ji,jj,9)  = sst_m(ji,jj) 
     114          zcmo(ji,jj,10) = sss_m(ji,jj) 
     115 
     116          zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     117          zcmo(ji,jj,12) = qsr(ji,jj) 
     118          zcmo(ji,jj,13) = qns(ji,jj) 
    119119          ! See thersf for the coefficient 
    120           zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce 
    121           zcmo(ji,jj,15) = gtaux(ji,jj) 
    122           zcmo(ji,jj,16) = gtauy(ji,jj) 
    123           zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj) 
    124           zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj) 
     120          zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     121          zcmo(ji,jj,15) = utaui_ice(ji,jj) 
     122          zcmo(ji,jj,16) = vtaui_ice(ji,jj) 
     123          zcmo(ji,jj,17) = qsr (ji,jj) 
     124          zcmo(ji,jj,18) = qns(ji,jj) 
    125125          zcmo(ji,jj,19) = sprecip(ji,jj) 
    126126       END DO 
    … …  
    154154                     + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    155155                     / ztmu 
    156                 rcmoy(ji,jj,9)  = sst_io(ji,jj) 
    157                 rcmoy(ji,jj,10) = sss_io(ji,jj) 
    158  
    159                 rcmoy(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj) 
    160                 rcmoy(ji,jj,12) = fsolar (ji,jj) 
    161                 rcmoy(ji,jj,13) = fnsolar(ji,jj) 
     156                rcmoy(ji,jj,9)  = sst_m(ji,jj) 
     157                rcmoy(ji,jj,10) = sss_m(ji,jj) 
     158 
     159                rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
     160                rcmoy(ji,jj,12) = qsr(ji,jj) 
     161                rcmoy(ji,jj,13) = qns(ji,jj) 
    162162                ! See thersf for the coefficient 
    163                 rcmoy(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce 
    164                 rcmoy(ji,jj,15) = gtaux(ji,jj) 
    165                 rcmoy(ji,jj,16) = gtauy(ji,jj) 
    166                 rcmoy(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj) 
    167                 rcmoy(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj) 
     163                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     164                rcmoy(ji,jj,15) = utaui_ice(ji,jj) 
     165                rcmoy(ji,jj,16) = vtaui_ice(ji,jj) 
     166                rcmoy(ji,jj,17) = qsr(ji,jj) 
     167                rcmoy(ji,jj,18) = qns(ji,jj) 
    168168                rcmoy(ji,jj,19) = sprecip(ji,jj) 
    169169             END DO 
    … …  
    176176             zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 
    177177 
    178              IF ( jf == 7  .OR. jf == 8  .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR.   & 
    179                   jf == 23 .OR. jf == 24 .OR. jf == 16 ) THEN  
     178             IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN  
    180179                CALL lbc_lnk( zfield, 'T', -1. ) 
    181180             ELSE  

  • trunk/NEMO/LIM_SRC_3/par_ice.F90

    r825 r888  
    66   !!---------------------------------------------------------------------- 
    77   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    8    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/par_ice.F90,v 1.4 2005/03/27 18:34:42 opalod Exp $ 
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     8   !! $ Id: $ 
     9   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1010   !!---------------------------------------------------------------------- 
    1111   !! * Modules used 

  • trunk/NEMO/LIM_SRC_3/thd_ice.F90

    r834 r888  
    88   !!---------------------------------------------------------------------- 
    99   !!   LIM 2.0, UCL-LOCEAN-IPSL (2005) 
    10    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/thd_ice.F90,v 1.4 2005/03/27 18:34:42 opalod Exp $ 
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     10   !! $ Id: $ 
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1212   !!---------------------------------------------------------------------- 
    1313   !! * Modules used 

  • trunk/NEMO/NST_SRC/agrif_user.F90

    r833 r888  
    6262      USE sol_oce 
    6363      USE in_out_manager 
    64 #if defined key_lim3 || defined key_lim3_old 
     64#if defined key_lim3 || defined key_lim2 
    6565      USE ice_oce 
    6666#endif 

  • trunk/NEMO/OPA_SRC/DIA/diafwb.F90

    r719 r888  
    44   !! Ocean diagnostics: freshwater budget 
    55   !!====================================================================== 
     6   !! History :  8.2  !  01-02  (E. Durand)  Original code 
     7   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     8   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     9   !!---------------------------------------------------------------------- 
    610#if ( defined key_orca_r2 || defined  key_orca_r4 ) && ! defined key_dynspg_rl && ! defined key_coupled 
    711   !!---------------------------------------------------------------------- 
    812   !!   NOT "key_dynspg_rl" and "key_orca_r2 or 4" 
    913   !!---------------------------------------------------------------------- 
     14   !!---------------------------------------------------------------------- 
    1015   !!   dia_fwb     : freshwater budget for global ocean configurations 
    1116   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1317   USE oce             ! ocean dynamics and tracers 
    1418   USE dom_oce         ! ocean space and time domain 
    1519   USE phycst          ! physical constants 
     20   USE sbc_oce         ! ??? 
    1621   USE zdf_oce         ! ocean vertical physics 
    1722   USE in_out_manager  ! I/O manager 
    18    USE flxrnf          ! ??? 
    19    USE ocesbc          ! ??? 
    20    USE blk_oce         ! ??? 
    21    USE flxblk          ! atmospheric surface quantity 
    2223   USE lib_mpp         ! distributed memory computing library 
    2324 
    … …  
    2526   PRIVATE 
    2627 
    27    !! * Routine accessibility 
    2828   PUBLIC dia_fwb    ! routine called by step.F90 
    2929 
    30    !! * Shared module variables 
    3130   LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    !: fresh water budget flag 
    3231 
    33    !! * Module variables 
    34    REAL(wp) ::   & 
    35       a_emp , a_precip, a_rnf,   & 
    36       a_sshb, a_sshn, a_salb, a_saln,   & 
    37       a_aminus, a_aplus 
    38    REAL(wp), DIMENSION(4) ::   & 
    39       a_flxi, a_flxo, a_temi, a_temo, a_sali, a_salo 
     32   REAL(wp)               ::   a_emp ,          & 
     33      &                        a_sshb, a_sshn, a_salb, a_saln 
     34   REAL(wp), DIMENSION(4) ::   a_flxi, a_flxo, a_temi, a_temo, a_sali, a_salo 
    4035 
    4136   !! * Substitutions 
    … …  
    4338#  include "vectopt_loop_substitute.h90" 
    4439   !!---------------------------------------------------------------------- 
    45    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    46    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/DIA/diafwb.F90,v 1.11 2007/06/29 17:01:51 opalod Exp $  
    47    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     40   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     41   !! $Header: $ 
     42   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4843   !!---------------------------------------------------------------------- 
    4944 
    … …  
    5550      !!      
    5651      !! ** Purpose : 
    57       !!  
    58       !! ** Method : 
    59       !!  
    60       !! History : 
    61       !!   8.2  !  01-02  (E. Durand)  Original code 
    62       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    63       !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    6452      !!---------------------------------------------------------------------- 
    65       !! * Arguments 
    6653      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    67  
    68       !! * Local declarations 
    69       CHARACTER (len=32) ::  clname 
     54      !! 
    7055      INTEGER :: inum             ! temporary logical unit 
    7156      INTEGER :: ji, jj, jk, jt   ! dummy loop indices 
    … …  
    8570 
    8671         a_emp    = 0.e0 
    87          a_precip = 0.e0 
    88          a_rnf    = 0.e0 
    8972         a_sshb   = 0.e0 ! valeur de ssh au debut de la simulation 
    9073         a_salb   = 0.e0 ! valeur de sal au debut de la simulation 
    91          a_aminus = 0.e0 
    92          a_aplus  = 0.e0 
    9374         ! sshb used because diafwb called after tranxt (i.e. after the swap) 
    9475         a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) ) 
    … …  
    10889      a_emp    = SUM( e1t(:,:) * e2t(:,:) * emp   (:,:) * tmask_i(:,:) ) 
    10990      IF( lk_mpp )   CALL mpp_sum( a_emp    )       ! sum over the global domain 
    110 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
    111       a_precip = SUM( e1t(:,:) * e2t(:,:) * watm  (:,:) * tmask_i(:,:) ) 
    112       IF( lk_mpp )   CALL mpp_sum( a_precip )       ! sum over the global domain 
    113 #endif 
    114       a_rnf    = SUM( e1t(:,:) * e2t(:,:) * runoff(:,:) * tmask_i(:,:) ) 
    115       IF( lk_mpp )   CALL mpp_sum( a_rnf    )       ! sum over the global domain 
    116  
    117       IF( aminus /= 0.e0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus ) 
    118       IF( aplus  /= 0.e0 ) a_aplus  = a_aplus  + ( MIN( aplus, aminus ) / aplus  ) 
    11991 
    12092      IF( kt == nitend ) THEN 
    … …  
    142114         IF( lk_mpp )   CALL mpp_sum( zvol )      ! sum over the global domain 
    143115          
    144          a_aminus = a_aminus / ( nitend - nit000 + 1 ) 
    145          a_aplus  = a_aplus  / ( nitend - nit000 + 1 ) 
    146  
    147116         ! Conversion in m3 
    148117         a_emp    = a_emp * rdttra(1) * 1.e-3  
    149          a_precip = a_precip * rdttra(1) * 1.e-3 / rday 
    150          a_rnf    = a_rnf * rdttra(1) * 1.e-3 
    151118          
    152          ! Alpha1=Alpha0-Rest/(Precip+runoff) 
    153          !  C A U T I O N : precipitations are negative !!      
    154           
     119         ! emp correction to bring back the mean ssh to zero 
    155120         zempnew = a_sshn / ( ( nitend - nit000 + 1 ) * rdt ) * 1.e3 / zarea 
    156121 
    … …  
    389354      IF ( kt == nitend .AND. cp_cfg == "orca" ) THEN 
    390355 
    391          clname = 'STRAIT.dat' 
    392          CALL ctlopn( inum, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   & 
     356         CALL ctlopn( inum, 'STRAIT.dat', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   & 
    393357            &         1, numout, lwp, 1 ) 
    394358         WRITE(inum,*) 
    395359         WRITE(inum,*)    'Net freshwater budget ' 
    396360         WRITE(inum,9010) '  emp    = ',a_emp,   ' m3 =', a_emp   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
    397          WRITE(inum,9010) '  precip = ',a_precip,' m3 =', a_precip/(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
    398          WRITE(inum,9010) '  a_rnf  = ',a_rnf,   ' m3 =', a_rnf   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
    399361         WRITE(inum,*) 
    400362         WRITE(inum,9010) '  zarea =',zarea 
    … …  
    417379         WRITE(inum,9020) '  diff      =',(a_saln-a_salb)/zvol,' psu' 
    418380         WRITE(inum,9020) '  S-SLevitus=',a_saln/zvol,' psu' 
    419          WRITE(inum,*) 
    420          WRITE(inum,*)    'Coeff : ' 
    421          WRITE(inum,9030) '  Alpha+   =  ', a_aplus 
    422          WRITE(inum,9030) '  Alpha-   =  ', a_aminus 
    423          WRITE(inum,*) 
    424381         WRITE(inum,*) 
    425382         WRITE(inum,*)    'Gibraltar : ' 

  • trunk/NEMO/OPA_SRC/DIA/diawri.F90

    r833 r888  
    1414   USE sol_oce         ! solver variables 
    1515   USE ice_oce         ! ice variables 
     16   USE sbc_oce         ! Surface boundary condition: ocean fields 
     17   USE sbc_ice         ! Surface boundary condition: ice fields 
     18   USE sbcssr          ! restoring term toward SST/SSS climatology 
    1619   USE phycst          ! physical constants 
    1720   USE ocfzpt          ! ocean freezing point 
    18    USE ocesbc          ! surface thermohaline fluxes 
    19    USE taumod          ! surface stress 
    20    USE flxrnf          ! ocean runoffs 
    2121   USE zdfmxl          ! mixed layer 
    2222   USE daymod          ! calendar 
    … …  
    2727   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2828   USE in_out_manager  ! I/O manager 
    29    USE flx_oce         ! sea-ice/ocean forcings variables 
    3029   USE diadimg         ! dimg direct access file format output 
    3130   USE ioipsl 
    … …  
    5453   !!---------------------------------------------------------------------- 
    5554   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    56    !! $Header$  
     55   !! $Id$ 
    5756   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5857   !!---------------------------------------------------------------------- 
    … …  
    245244            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    246245#endif 
    247 #if ! defined key_dynspg_rl && ( defined key_lim3 || defined key_lim2 ) 
    248          ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to 
    249          !    internal damping to Levitus that can be diagnosed from others 
    250          ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup 
    251          CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt 
    252             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    253          CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass 
    254             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    255 #endif 
     246!!$#if ! defined key_dynspg_rl && ( defined key_lim3 || defined key_lim2 ) 
     247!!$         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to 
     248!!$         !    internal damping to Levitus that can be diagnosed from others 
     249!!$         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup 
     250!!$         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt 
     251!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     252!!$         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass 
     253!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     254!!$#endif 
    256255         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! emp 
    257256            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    258          CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs 
    259             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     257!!$         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs 
     258!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    260259         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! emps 
    261260            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    262261         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! emps * sn 
    263262            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    264          CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qt 
     263         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr 
    265264            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    266265         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr 
    … …  
    281280#endif 
    282281 
    283 #if defined key_flx_core 
    284          CALL histdef( nid_T, "solhflup", "Latent Heat Flux Upward"         , "W/m2"   ,   &  ! qla 
    285             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    286          CALL histdef( nid_T, "solwfldo", "Longwave Radiation downward"     , "W/m2"   ,   &  ! qlw 
    287             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    288          CALL histdef( nid_T, "sosbhfup", "Sensible Heat Flux upward"       , "W/m2"   ,   &  ! qsb 
    289             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    290 #endif 
    291  
    292  
    293 #if defined key_coupled &&  ! defined key_lim3 && ! defined key_lim2    
     282 
     283 
     284#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    294285         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    295286            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    317308#endif 
    318309 
    319 #if ( defined key_lim3  || defined key_lim2 ) && defined key_coupled 
     310#if defined key_coupled  
     311# if defined key_lim3 
     312         Must be adapted to LIM3 
     313# else 
    320314         CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    321315            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    322316         CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    323317            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     318# endif  
    324319#endif  
    325320 
    … …  
    334329#endif 
    335330         !                                                                                      !!! nid_U : 2D 
    336          CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! taux 
     331         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! utau 
    337332            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    338333#if defined key_dynspg_rl 
    … …  
    351346#endif 
    352347         !                                                                                      !!! nid_V : 2D 
    353          CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! tauy 
     348         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! vtau 
    354349            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout ) 
    355350#if defined key_dynspg_rl 
    … …  
    423418      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height 
    424419#endif 
    425 #if ! defined key_dynspg_rl && ( defined key_lim3 || defined key_lim2 ) 
    426       CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux 
    427       CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux 
    428 #endif 
     420!!$#if ! defined key_dynspg_rl && ( defined key_lim3 || defined key_lim2 ) 
     421!!$      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux 
     422!!$      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux 
     423!!$#endif 
    429424      CALL histwrite( nid_T, "sowaflup", it, emp           , ndim_hT, ndex_hT )   ! upward water flux 
    430       CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff 
     425!!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff 
    431426      CALL histwrite( nid_T, "sowaflcd", it, emps          , ndim_hT, ndex_hT )   ! c/d water flux 
    432427      zw2d(:,:) = emps(:,:) * sn(:,:,1) * tmask(:,:,1) 
    433428      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux 
    434       CALL histwrite( nid_T, "sohefldo", it, qt            , ndim_hT, ndex_hT )   ! total heat flux 
     429      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux 
    435430      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux 
    436431      CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth 
    … …  
    443438      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    444439#endif 
    445 #if defined key_flx_core 
    446       CALL histwrite( nid_T, "solhflup", it, qla           , ndim_hT, ndex_hT )   ! latent heat flux 
    447       CALL histwrite( nid_T, "solwfldo", it, qlw           , ndim_hT, ndex_hT )   ! longwave heat flux 
    448       CALL histwrite( nid_T, "sosbhfup", it, qsb           , ndim_hT, ndex_hT )   ! sensible heat flux 
    449 #endif 
    450 #if  defined key_coupled && ! defined key_lim3 && ! defined key_lim2  
     440#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    451441      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    452442      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    … …  
    466456      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content 
    467457#endif 
    468 #if ( defined key_lim3  ||  defined key_lim2 ) &&  defined key_coupled  
     458 
     459#if defined key_coupled  
     460# if defined key_lim3 
     461      Must be adapted for LIM3 
    469462      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
    470463      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
     464# else 
     465      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
     466      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
     467# endif 
    471468#endif 
    472469         ! Write fields on U grid 
    … …  
    475472      CALL histwrite( nid_U, "vozoeivu", it, u_eiv         , ndim_U , ndex_U )    ! i-eiv current 
    476473#endif 
    477       CALL histwrite( nid_U, "sozotaux", it, taux          , ndim_hU, ndex_hU )   ! i-wind stress 
     474      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    478475#if defined key_dynspg_rl 
    479476      CALL lbc_lnk( spgu, 'U', -1. ) 
    … …  
    486483      CALL histwrite( nid_V, "vomeeivv", it, v_eiv         , ndim_V , ndex_V  )   ! j-eiv current 
    487484#endif 
    488       CALL histwrite( nid_V, "sometauy", it, tauy          , ndim_hV, ndex_hV )   ! j-wind stress 
     485      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    489486#if defined key_dynspg_rl 
    490487      CALL lbc_lnk( spgv, 'V', -1. ) 
    … …  
    640637 
    641638      ! Write all fields on T grid 
    642       CALL histwrite( id_i, "votemper", 1, tn    , jpi*jpj*jpk, idex )    ! now temperature 
    643       CALL histwrite( id_i, "vosaline", 1, sn    , jpi*jpj*jpk, idex )    ! now salinity 
    644 #if defined key_dynspg_rl 
    645       CALL histwrite( id_i, "sobarstf", 1, bsfn  , jpi*jpj    , idex )    ! barotropic streamfunction 
     639      CALL histwrite( id_i, "votemper", 1, tn      , jpi*jpj*jpk, idex )    ! now temperature 
     640      CALL histwrite( id_i, "vosaline", 1, sn      , jpi*jpj*jpk, idex )    ! now salinity 
     641#if defined key_dynspg_rl 
     642      CALL histwrite( id_i, "sobarstf", 1, bsfn     , jpi*jpj    , idex )    ! barotropic streamfunction 
    646643#else 
    647       CALL histwrite( id_i, "sossheig", 1, sshn  , jpi*jpj    , idex )    ! sea surface height 
    648 #endif 
    649       CALL histwrite( id_i, "vozocrtx", 1, un    , jpi*jpj*jpk, idex )    ! now i-velocity 
    650       CALL histwrite( id_i, "vomecrty", 1, vn    , jpi*jpj*jpk, idex )    ! now j-velocity 
    651       CALL histwrite( id_i, "vovecrtz", 1, wn    , jpi*jpj*jpk, idex )    ! now k-velocity 
    652       CALL histwrite( id_i, "sowaflup", 1, emp   , jpi*jpj    , idex )    ! freshwater budget 
    653       CALL histwrite( id_i, "sohefldo", 1, qt    , jpi*jpj    , idex )    ! total heat flux 
    654       CALL histwrite( id_i, "soshfldo", 1, qsr   , jpi*jpj    , idex )    ! total heat flux 
    655       CALL histwrite( id_i, "soicecov", 1, freeze, jpi*jpj    , idex )    ! ice cover 
    656       CALL histwrite( id_i, "sozotaux", 1, taux  , jpi*jpj    , idex )    ! i-wind stress 
    657       CALL histwrite( id_i, "sometauy", 1, tauy  , jpi*jpj    , idex )    ! j-wind stress 
     644      CALL histwrite( id_i, "sossheig", 1, sshn     , jpi*jpj    , idex )    ! sea surface height 
     645#endif 
     646      CALL histwrite( id_i, "vozocrtx", 1, un       , jpi*jpj*jpk, idex )    ! now i-velocity 
     647      CALL histwrite( id_i, "vomecrty", 1, vn       , jpi*jpj*jpk, idex )    ! now j-velocity 
     648      CALL histwrite( id_i, "vovecrtz", 1, wn       , jpi*jpj*jpk, idex )    ! now k-velocity 
     649      CALL histwrite( id_i, "sowaflup", 1, emp      , jpi*jpj    , idex )    ! freshwater budget 
     650      CALL histwrite( id_i, "sohefldo", 1, qsr + qns, jpi*jpj    , idex )    ! total heat flux 
     651      CALL histwrite( id_i, "soshfldo", 1, qsr      , jpi*jpj    , idex )    ! solar heat flux 
     652      CALL histwrite( id_i, "soicecov", 1, freeze   , jpi*jpj    , idex )    ! ice cover 
     653      CALL histwrite( id_i, "sozotaux", 1, utau     , jpi*jpj    , idex )    ! i-wind stress 
     654      CALL histwrite( id_i, "sometauy", 1, vtau     , jpi*jpj    , idex )    ! j-wind stress 
    658655 
    659656      ! 3. Close the file 

  • trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r833 r888  
    33  !!---------------------------------------------------------------------- 
    44  !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    5   !! $Header$  
     5  !! $Id$ 
    66  !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    77  !!---------------------------------------------------------------------- 
    … …  
    4141    !!    To be tested with a lot of procs !!!! 
    4242    !! 
    43     !!  level 1:  taux(:,:) * umask(:,:,1) zonal stress in N.m-2 
    44     !!  level 2:  tauy(:,:) * vmask(:,:,1) meridional stress in N. m-2 
    45     !!  level 3:   qt  (:,:)               total heat flux (W/m2) 
    46     !!  level 4:   emp (:,:)               E-P flux (mm/day) 
     43    !!  level 1:  utau(:,:) * umask(:,:,1) zonal stress in N.m-2 
     44    !!  level 2:  vtau(:,:) * vmask(:,:,1) meridional stress in N. m-2 
     45    !!  level 3:  qsr + qns                total heat flux (W/m2) 
     46    !!  level 4:  emp (:,:)               E-P flux (mm/day) 
    4747    !!  level 5:  tb  (:,:,1)-sst          model SST -forcing sst (degree C) 
    4848    !!  level 6:  bsfb(:,:)         streamfunction (m**3/s) 
    … …  
    7676    !! * modules used 
    7777    USE lib_mpp 
    78     USE dtasst, ONLY : sst 
    7978 
    8079    !! * Arguments 
    … …  
    167166       sm(:,:,:)=sm(:,:,:) + sn (:,:,:) 
    168167       ! 
    169        fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:) * umask(:,:,1) 
    170        fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:) * vmask(:,:,1) 
    171        fsel(:,:,3 ) = fsel(:,:,3 ) + qt  (:,:)  
     168       fsel(:,:,1 ) = fsel(:,:,1 ) + utau(:,:) * umask(:,:,1) 
     169       fsel(:,:,2 ) = fsel(:,:,2 ) + vtau(:,:) * vmask(:,:,1) 
     170       fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:)  
    172171       fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:) 
    173172       fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1) - sst(:,:) 
    … …  
    187186       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:) 
    188187       fsel(:,:,16) = fsel(:,:,16) + emps(:,:) 
    189 #if defined key_lim3 || defined key_lim3_old 
    190        fsel(:,:,17) = fsel(:,:,17) + fsalt(:,:) 
    191 #endif 
    192188#ifdef key_diaspr    
    193189       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g  
    194 #endif 
    195 #if defined key_flx_core 
    196        fsel(:,:,21) = fsel(:,:,21) + qla(:,:) 
    197        fsel(:,:,22) = fsel(:,:,22) + qlw(:,:) 
    198        fsel(:,:,23) = fsel(:,:,23) + qsb(:,:) 
    199190#endif 
    200191       ! 
    … …  
    231222          fsel(:,:,20)= spgv(:,:) 
    232223#endif 
    233           ! mask mean field with tmask except taux tauy (1,2) 
     224          ! mask mean field with tmask except utau vtau (1,2) 
    234225          DO jk=3,inbsel 
    235226            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1) 
    … …  
    256247          fsel(:,:,:) = 0._wp 
    257248          ! 
    258           fsel(:,:,1 ) = taux(:,:) * umask(:,:,1) 
    259           fsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1) 
    260           fsel(:,:,3 ) = qt  (:,:) * tmask(:,:,1) 
     249          fsel(:,:,1 ) = utau(:,:) * umask(:,:,1) 
     250          fsel(:,:,2 ) = vtau(:,:) * vmask(:,:,1) 
     251          fsel(:,:,3 ) = (qsr (:,:) + qnr (:,:)) * tmask(:,:,1) 
    261252          fsel(:,:,4 ) = emp (:,:) * tmask(:,:,1) 
    262253          fsel(:,:,5 ) = (tb  (:,:,1) -sst(:,:)) *tmask(:,:,1) 
    … …  
    277268          !         fsel(:,:,15) =  fbt(:,:) 
    278269          fsel(:,:,16) =  emps(:,:) * tmask(:,:,1) 
    279 #if defined key_lim3 || defined key_lim3_old 
    280           fsel(:,:,17) =  fsalt(:,:) * tmask(:,:,1) 
    281 #endif 
    282270#ifdef key_diaspr            
    283271          fsel(:,:,18) =      gps(:,:) /g 
    284272          fsel(:,:,19) =      spgu(:,:) 
    285273          fsel(:,:,20) =      spgv(:,:) 
    286 #endif 
    287 #if defined key_flx_core 
    288           fsel(:,:,21) =  qla(:,:)* tmask(:,:,1) 
    289           fsel(:,:,22) =  qlw(:,:)* tmask(:,:,1) 
    290           fsel(:,:,23) =  qsb(:,:)* tmask(:,:,1) 
    291274#endif 
    292275          ! 

  • trunk/NEMO/OPA_SRC/DOM/closea.F90

    r719 r888  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  closea  *** 
    4    !! Closed Seas  :  
     4   !! Closed Seas  : specific treatments associated with closed seas 
    55   !!====================================================================== 
     6   !! History :   8.2  !  00-05  (O. Marti)  Original code 
     7   !!             8.5  !  02-06  (E. Durand, G. Madec)  F90 
     8   !!             9.0  !  06-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat 
     9   !!---------------------------------------------------------------------- 
    610 
    711   !!---------------------------------------------------------------------- 
    812   !!   dom_clo    : modification of the ocean domain for closed seas cases 
    9    !!   flx_clo    : Special handling of closed seas 
    10    !!---------------------------------------------------------------------- 
    11    !! * Modules used 
     13   !!   sbc_clo    : Special handling of closed seas 
     14   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf) 
     15   !!   clo_ups    : set mixed centered/upstream scheme in closed sea (see traadv_cen2) 
     16   !!   clo_bat    : set to zero a field over closed sea (see domzrg) 
     17   !!---------------------------------------------------------------------- 
    1218   USE oce             ! dynamics and tracers 
    1319   USE dom_oce         ! ocean space and time domain 
    1420   USE in_out_manager  ! I/O manager 
    15    USE ocesbc          ! ocean surface boundary conditions (fluxes) 
    16    USE flxrnf          ! runoffs 
     21   USE sbc_oce         ! ocean surface boundary conditions 
    1722   USE lib_mpp         ! distributed memory computing library 
    1823   USE lbclnk          ! ??? 
    … …  
    2126   PRIVATE 
    2227 
    23    !! * Accessibility 
    24    PUBLIC dom_clo      ! routine called by dom_init 
    25    PUBLIC flx_clo      ! routine called by step 
    26  
    27    !! * Share module variables 
    28    INTEGER, PUBLIC, PARAMETER ::   &  !: 
    29       jpncs   = 4               !: number of closed sea 
    30    INTEGER, PUBLIC ::          & !!: namclo : closed seas and lakes 
    31       nclosea =  0                !: = 0 no closed sea or lake 
    32       !                           !  = 1 closed sea or lake in the domain 
    33    INTEGER, PUBLIC, DIMENSION (jpncs) ::   &  !: 
    34       ncstt,           &  !: Type of closed sea 
    35       ncsi1, ncsj1,    &  !: closed sea limits                                                                  
    36       ncsi2, ncsj2,    &  !:  
    37       ncsnr               !: number of point where run-off pours 
    38    INTEGER, PUBLIC, DIMENSION (jpncs,4) ::   & 
    39       ncsir, ncsjr        !: Location of run-off 
    40  
    41    !! * Module variable 
    42    REAL(wp), DIMENSION (jpncs+1) ::   & 
    43       surf               ! closed sea surface 
     28   PUBLIC dom_clo      ! routine called by domain module 
     29   PUBLIC sbc_clo      ! routine called by step module 
     30   PUBLIC clo_rnf      ! routine called by sbcrnf module 
     31   PUBLIC clo_ups      ! routine called in traadv_cen2(_jki) module 
     32   PUBLIC clo_bat      ! routine called in domzgr module 
     33 
     34   !!* Namelist namclo : closed seas and lakes 
     35   INTEGER, PUBLIC                     ::   nclosea =  0     !: = 0 no closed sea or lake 
     36      !                                                      !  = 1 closed sea or lake in the domain 
     37       
     38   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: number of closed sea 
     39   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea 
     40   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi1, ncsj1     !: south-west closed sea limits (i,j) 
     41   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsi2, ncsj2     !: north-east closed sea limits (i,j) 
     42   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncsnr            !: number of point where run-off pours 
     43   INTEGER, PUBLIC, DIMENSION(jpncs,4) ::   ncsir, ncsjr     !: Location of runoff 
     44 
     45   REAL(wp), DIMENSION (jpncs+1)       ::   surf             ! closed sea surface 
    4446 
    4547   !! * Substitutions 
    4648#  include "vectopt_loop_substitute.h90" 
    4749   !!---------------------------------------------------------------------- 
    48    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    49    !! $Header$  
    50    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     50   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     51   !! $Id$ 
     52   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5153   !!---------------------------------------------------------------------- 
    5254 
    … …  
    6062      !! 
    6163      !! ** Method  :   if a closed sea is located only in a model grid point 
    62       !!      just the thermodynamic processes are applied. 
    63       !! 
    64       !! ** Action :   ncsi1(), ncsj1() : south-west closed sea limits (i,j) 
    65       !!               ncsi2(), ncsj2() : north-east Closed sea limits (i,j) 
    66       !!               ncsir(), ncsjr() : Location of runoff 
    67       !!               ncsnr            : number of point where run-off pours 
    68       !!               ncstt            : Type of closed sea 
    69       !!                                  =0 spread over the world ocean 
    70       !!                                  =2 put at location runoff 
    71       !! 
    72       !! History : 
    73       !!        !  01-04  (E. Durand)  Original code 
    74       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    75       !!---------------------------------------------------------------------- 
    76       !! * Local variables 
     64      !!                just the thermodynamic processes are applied. 
     65      !! 
     66      !! ** Action  :   ncsi1(), ncsj1() : south-west closed sea limits (i,j) 
     67      !!                ncsi2(), ncsj2() : north-east Closed sea limits (i,j) 
     68      !!                ncsir(), ncsjr() : Location of runoff 
     69      !!                ncsnr            : number of point where run-off pours 
     70      !!                ncstt            : Type of closed sea 
     71      !!                                   =0 spread over the world ocean 
     72      !!                                   =2 put at location runoff 
     73      !!---------------------------------------------------------------------- 
    7774      INTEGER ::   jc            ! dummy loop indices 
    7875      !!---------------------------------------------------------------------- 
    … …  
    9087 
    9188      IF( cp_cfg == "orca" ) THEN 
    92     
     89         ! 
    9390         SELECT CASE ( jp_cfg ) 
    9491         !                                           ! ======================= 
    9592         CASE ( 2 )                                  !  ORCA_R2 configuration 
    9693            !                                        ! ======================= 
    97  
    9894            !                                            ! Caspian Sea 
    9995            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe 
    … …  
    116112            ncsi2(4)   =   6  ;  ncsj2(4)   = 112 
    117113            ncsir(4,1) = 171  ;  ncsjr(4,1) = 106  
    118  
    119114            !                                        ! ======================= 
    120115         CASE ( 4 )                                  !  ORCA_R4 configuration 
    121116            !                                        ! ======================= 
    122  
    123117            !                                            ! Caspian Sea 
    124118            ncsnr(1)   =  1  ;  ncstt(1)   =  0   
    … …  
    144138            ncsi2(4)   = 76  ;  ncsj2(4)   = 61 
    145139            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59  
    146  
    147140            !                                        ! ======================= 
    148141         CASE ( 025 )                                ! ORCA_R025 configuration 
    … …  
    157150            ncsi2(2)   = 1304 ; ncsj2(2)   = 747 
    158151            ncsir(2,1) = 1    ; ncsjr(2,1) = 1 
    159  
     152            ! 
    160153         END SELECT 
    161  
     154         ! 
    162155      ENDIF 
    163156 
    … …  
    171164         ncsj2(jc)   = mj1( ncsj2(jc) )   
    172165      END DO 
    173           
    174  
     166      ! 
    175167   END SUBROUTINE dom_clo 
    176168 
    177169 
    178    SUBROUTINE flx_clo( kt ) 
    179       !!--------------------------------------------------------------------- 
    180       !!                  ***  ROUTINE flx_clo  *** 
     170   SUBROUTINE sbc_clo( kt ) 
     171      !!--------------------------------------------------------------------- 
     172      !!                  ***  ROUTINE sbc_clo  *** 
    181173      !!                     
    182174      !! ** Purpose :   Special handling of closed seas 
    … …  
    186178      !!      put as run-off in open ocean. 
    187179      !! 
    188       !! ** Action : 
    189       !! 
    190       !! History : 
    191       !!   8.2  !  00-05  (O. Marti)  Original code 
    192       !!   8.5  !  02-07  (G. Madec)  Free form, F90 
    193       !!---------------------------------------------------------------------- 
    194       !! * Arguments 
    195       INTEGER, INTENT (in) :: kt 
    196  
    197       !! * Local declarations 
    198       REAL(wp), DIMENSION (jpncs) :: zemp 
    199       INTEGER  :: ji, jj, jc, jn 
    200       REAL(wp) :: zze2 
    201       !!---------------------------------------------------------------------- 
    202  
    203       ! 1 - Initialisation 
    204       ! ------------------ 
    205  
    206       IF( kt == nit000 ) THEN  
     180      !! ** Action  :   emp, emps   updated surface freshwater fluxes at kt 
     181      !!---------------------------------------------------------------------- 
     182      INTEGER, INTENT(in) ::   kt   ! ocean model time step 
     183      ! 
     184      INTEGER                     ::   ji, jj, jc, jn   ! dummy loop indices 
     185      REAL(wp)                    ::   zze2 
     186      REAL(wp), DIMENSION (jpncs) ::   zemp 
     187      !!---------------------------------------------------------------------- 
     188      ! 
     189      !                                                   !------------------! 
     190      IF( kt == nit000 ) THEN                             !  Initialisation  ! 
     191         !                                                !------------------! 
    207192         IF(lwp) WRITE(numout,*) 
    208          IF(lwp) WRITE(numout,*)'flx_clo : closed seas ' 
     193         IF(lwp) WRITE(numout,*)'sbc_clo : closed seas ' 
    209194         IF(lwp) WRITE(numout,*)'~~~~~~~' 
    210195 
    … …  
    216201            DO jj = ncsj1(jc), ncsj2(jc) 
    217202               DO ji = ncsi1(jc), ncsi2(jc) 
    218                   ! surface of closed seas 
    219                   surf(jc) = surf(jc) + e1t(ji,jj)*e2t(ji,jj)*tmask_i(ji,jj) 
    220                   ! upstream in closed seas 
    221                   upsadv(ji,jj) = 0.5 
     203                  surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas 
    222204               END DO  
    223205            END DO  
    224             ! upstream at closed sea outflow 
    225             IF( ncstt(jc) >= 1 ) THEN  
    226                 DO jn = 1, 4 
    227                   ji = mi0( ncsir(jc,jn) ) 
    228                   jj = mj0( ncsjr(jc,jn) ) 
    229                   upsrnfh(ji,jj) = MAX( upsrnfh(ji,jj), 1.0 ) 
    230                 END DO  
    231             ENDIF  
    232206         END DO  
    233207         IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain 
    … …  
    235209         IF(lwp) WRITE(numout,*)'     Closed sea surfaces' 
    236210         DO jc = 1, jpncs 
    237             IF(lwp) WRITE(numout,FMT='(1I3,4I4,5X,F16.2)')    & 
    238                 jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 
     211            IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 
    239212         END DO 
    240213 
    … …  
    243216            surf(jpncs+1) = surf(jpncs+1) - surf(jc) 
    244217         END DO            
    245   
     218         ! 
    246219      ENDIF 
    247  
    248       ! 2 - Computation 
    249       ! --------------- 
    250       zemp = 0.e0 
    251  
     220      !                                                   !--------------------! 
     221      !                                                   !  update emp, emps  ! 
     222      zemp = 0.e0                                         !--------------------! 
    252223      DO jc = 1, jpncs 
    253224         DO jj = ncsj1(jc), ncsj2(jc) 
    … …  
    257228         END DO  
    258229      END DO 
    259       IF( lk_mpp )   CALL mpp_sum ( zemp , jpncs )       ! mpp: sum over all the global domain 
     230      IF( lk_mpp )   CALL mpp_sum ( zemp(:) , jpncs )       ! mpp: sum over all the global domain 
    260231 
    261232      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration 
    … …  
    266237 
    267238      DO jc = 1, jpncs 
    268  
     239         ! 
    269240         IF( ncstt(jc) == 0 ) THEN  
    270241            ! water/evap excess is shared by all open ocean 
    … …  
    303274            ENDIF  
    304275         ENDIF  
    305  
     276         ! 
    306277         DO jj = ncsj1(jc), ncsj2(jc) 
    307278            DO ji = ncsi1(jc), ncsi2(jc) 
    … …  
    310281            END DO   
    311282         END DO  
    312  
     283         ! 
    313284      END DO  
    314  
    315  
    316       ! 5. Boundary condition on emp and emps 
    317       ! ------------------------------------- 
     285      ! 
    318286      CALL lbc_lnk( emp , 'T', 1. ) 
    319287      CALL lbc_lnk( emps, 'T', 1. ) 
    320  
    321    END SUBROUTINE flx_clo 
     288      ! 
     289   END SUBROUTINE sbc_clo 
     290    
     291    
     292   SUBROUTINE clo_rnf( p_rnfmsk ) 
     293      !!--------------------------------------------------------------------- 
     294      !!                  ***  ROUTINE sbc_rnf  *** 
     295      !!                     
     296      !! ** Purpose :   allow the treatment of closed sea outflow grid-points 
     297      !!                to be the same as river mouth grid-points 
     298      !! 
     299      !! ** Method  :   set to 1 the runoff mask (mskrnf, see sbcrnf module) 
     300      !!                at the closed sea outflow grid-point. 
     301      !! 
     302      !! ** Action  :   update (p_)mskrnf (set 1 at closed sea outflow) 
     303      !!---------------------------------------------------------------------- 
     304      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_rnfmsk   ! river runoff mask (rnfmsk array) 
     305      ! 
     306      INTEGER  ::   jc, jn      ! dummy loop indices 
     307      INTEGER  ::   ii, ij      ! temporary integer 
     308      !!---------------------------------------------------------------------- 
     309      ! 
     310      DO jc = 1, jpncs 
     311         IF( ncstt(jc) >= 1 ) THEN            ! runoff mask set to 1 at closed sea outflows 
     312             DO jn = 1, 4 
     313               ii = mi0( ncsir(jc,jn) ) 
     314               ij = mj0( ncsjr(jc,jn) ) 
     315               p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 ) 
     316            END DO  
     317         ENDIF  
     318      END DO  
     319      ! 
     320   END SUBROUTINE clo_rnf 
     321 
     322    
     323   SUBROUTINE clo_ups( p_upsmsk ) 
     324      !!--------------------------------------------------------------------- 
     325      !!                  ***  ROUTINE sbc_rnf  *** 
     326      !!                     
     327      !! ** Purpose :   allow the treatment of closed sea outflow grid-points 
     328      !!                to be the same as river mouth grid-points 
     329      !! 
     330      !! ** Method  :   set to 0.5 the upstream mask (upsmsk, see traadv_cen2  
     331      !!                module) over the closed seas. 
     332      !! 
     333      !! ** Action  :   update (p_)upsmsk (set 0.5 over closed seas) 
     334      !!---------------------------------------------------------------------- 
     335      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_upsmsk   ! upstream mask (upsmsk array) 
     336      ! 
     337      INTEGER  ::   jc, ji, jj      ! dummy loop indices 
     338      !!---------------------------------------------------------------------- 
     339      ! 
     340      DO jc = 1, jpncs 
     341         DO jj = ncsj1(jc), ncsj2(jc) 
     342            DO ji = ncsi1(jc), ncsi2(jc) 
     343               p_upsmsk(ji,jj) = 0.5            ! mixed upstream/centered scheme over closed seas 
     344            END DO  
     345         END DO  
     346       END DO  
     347       ! 
     348   END SUBROUTINE clo_ups 
     349    
     350       
     351   SUBROUTINE clo_bat( pbat, kbat ) 
     352      !!--------------------------------------------------------------------- 
     353      !!                  ***  ROUTINE clo_bat  *** 
     354      !!                     
     355      !! ** Purpose :   suppress closed sea from the domain 
     356      !! 
     357      !! ** Method  :   set to 0 the meter and level bathymetry (given in  
     358      !!                arguments) over the closed seas. 
     359      !! 
     360      !! ** Action  :   set pbat=0 and kbat=0 over closed seas 
     361      !!---------------------------------------------------------------------- 
     362      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array) 
     363      INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array) 
     364      ! 
     365      INTEGER  ::   jc, ji, jj      ! dummy loop indices 
     366      !!---------------------------------------------------------------------- 
     367      ! 
     368      DO jc = 1, jpncs 
     369         DO jj = ncsj1(jc), ncsj2(jc) 
     370            DO ji = ncsi1(jc), ncsi2(jc) 
     371               pbat(ji,jj) = 0.e0    
     372               kbat(ji,jj) = 0    
     373            END DO  
     374         END DO  
     375       END DO  
     376       ! 
     377   END SUBROUTINE clo_bat 
    322378 
    323379   !!====================================================================== 

  • trunk/NEMO/OPA_SRC/DOM/domain.F90

    r833 r888  
    1313   USE oce             !  
    1414   USE dom_oce         ! ocean space and time domain 
     15   USE ice_oce         ! ice variables 
     16   USE sbc_oce         ! surface boundary condition: ocean 
    1517   USE phycst          ! physical constants 
     18   USE daymod          ! calendar 
    1619   USE in_out_manager  ! I/O manager 
    17    USE ice_oce         ! ice variables 
    18    USE blk_oce         ! bulk variables 
    19    USE flxrnf          ! runoffs 
    20    USE daymod          ! calendar 
    2120   USE lib_mpp         ! distributed memory computing library 
    2221 
    … …  
    3938   !!---------------------------------------------------------------------- 
    4039   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    41    !! $Header$  
     40   !! $Id$ 
    4241   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4342   !!---------------------------------------------------------------------- 
    … …  
    144143      NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,         & 
    145144         &             nitend, ndate0   , nleapy   , ninist , nstock,          & 
    146          &             nwrite, nrunoff  , ln_dimgnnn 
     145         &             nwrite, ln_dimgnnn 
    147146 
    148147      NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, ngrid  , nmsh  ,   & 
    149148         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   & 
    150          &             rdth  , rdtbt    , nfice    , nfbulk , nclosea 
     149         &             rdth  , rdtbt    , nclosea 
    151150      NAMELIST/namcla/ n_cla 
    152151      !!---------------------------------------------------------------------- 
    … …  
    175174         WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock 
    176175         WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite 
    177          WRITE(numout,*) '           runoff option                   nrunoff   = ', nrunoff 
    178176         WRITE(numout,*) '           multi file dimgout           ln_dimgnnn   = ', ln_dimgnnn 
    179177      ENDIF 
    … …  
    257255      ENDIF 
    258256 
    259       IF( lk_lim3 .OR. lk_lim2 ) THEN 
    260          IF(lwp) WRITE(numout,*) '           ice model coupling frequency      nfice  = ', nfice 
    261          IF( MOD( nitend - nit000 + 1, nfice) /= 0 ) THEN  
    262             WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') is NOT a multiple of nfice (', nfice, ')' 
    263             CALL ctl_stop( ctmp1, 'Impossible to do proper restart files' ) 
    264          ENDIF 
    265          IF( MOD( nstock             , nfice) /= 0 ) THEN  
    266             WRITE(ctmp1,*) 'nstock ('           , nstock             , ') is NOT a multiple of nfice (', nfice, ')' 
    267             CALL ctl_stop( ctmp1, 'Impossible to do proper restart files' ) 
    268          ENDIF 
    269          nfbulk = nfice 
    270          IF( MOD( rday, nfice*rdt ) /= 0 )   CALL ctl_warn( 'nfice is NOT a multiple of the number of time steps in a day' ) 
    271          IF(lwp) WRITE(numout,*) '           bulk computation frequency       nfbulk  = ', nfbulk, ' = nfice if ice model used' 
    272          IF(lwp) WRITE(numout,*) '           flag closed sea or not           nclosea = ', nclosea 
    273       ENDIF 
    274  
    275257      ! Default values 
    276258      n_cla = 0 

  • trunk/NEMO/OPA_SRC/DOM/domvvl.F90

    r719 r888  
    1818   USE oce             ! ocean dynamics and tracers 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE sbc_oce         ! surface boundary condition: ocean 
     21   USE dynspg_oce      ! surface pressure gradient variables 
     22   USE phycst          ! physical constants 
    2023   USE in_out_manager  ! I/O manager 
    2124   USE lib_mpp         ! distributed memory computing library 
    2225   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    23    USE dynspg_oce      ! surface pressure gradient variables 
    24    USE ocesbc          ! ocean surface boundary condition 
    25    USE phycst          ! physical constants 
    2626 
    2727   IMPLICIT NONE 
    … …  
    4747   !!---------------------------------------------------------------------- 
    4848   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    49    !! $Header$  
     49   !! $Id$ 
    5050   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5151   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r800 r888  
    1616   USE oce             ! ocean dynamics and tracers  
    1717   USE dom_oce         ! ocean space and time domain  
    18    USE in_out_manager  ! I/O manager 
     18   USE sbc_oce         ! surface boundary condition: ocean 
     19   USE obc_oce         ! Lateral open boundary condition 
    1920   USE phycst          ! physical constants 
    20    USE ocesbc          ! ocean surface boundary condition 
    21    USE obc_oce         ! Lateral open boundary condition 
    2221   USE obc_par         ! open boundary condition parameters 
    2322   USE obcdta          ! open boundary condition data     (obc_dta_bt routine) 
     23   USE in_out_manager  ! I/O manager 
    2424   USE lib_mpp         ! distributed memory computing library 
    2525   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    4040   !!---------------------------------------------------------------------- 
    4141   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    42    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/DYN/dynspg_exp.F90,v 1.9 2007/06/05 10:38:27 opalod Exp $  
     42   !! $Id$ 
    4343   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4444   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r800 r888  
    2525   USE dom_oce         ! ocean space and time domain  
    2626   USE zdf_oce         ! ocean vertical physics 
     27   USE sbc_oce         ! surface boundary condition: ocean 
     28   USE obc_oce         ! Lateral open boundary condition 
     29   USE sol_oce         ! ocean elliptic solver 
    2730   USE phycst          ! physical constants 
    28    USE ocesbc          ! ocean surface boundary condition 
    29    USE flxrnf          ! ocean runoffs 
    30    USE sol_oce         ! ocean elliptic solver 
     31   USE domvvl          ! variable volume 
    3132   USE solver          ! solver initialization 
    3233   USE solpcg          ! preconditionned conjugate gradient solver 
    3334   USE solsor          ! Successive Over-relaxation solver 
    3435   USE solfet          ! FETI solver 
    35    USE obc_oce         ! Lateral open boundary condition 
    3636   USE obcdyn          ! ocean open boundary condition (obc_dyn routines) 
    3737   USE obcvol          ! ocean open boundary condition (obc_vol routines) 
     38   USE cla_dynspg      ! cross land advection 
     39   USE in_out_manager  ! I/O manager 
    3840   USE lib_mpp         ! distributed memory computing library 
    3941   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    40    USE cla_dynspg      ! cross land advection 
    4142   USE prtctl          ! Print control 
    4243   USE solmat          ! matrix construction for elliptic solvers 
    4344   USE agrif_opa_interp 
    44    USE in_out_manager  ! I/O manager 
    4545   USE iom 
    4646   USE restart         ! only for lrst_oce 
    47    USE domvvl          ! variable volume 
    4847 
    4948   IMPLICIT NONE 
    … …  
    5857   !!---------------------------------------------------------------------- 
    5958   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    60    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/DYN/dynspg_flt.F90,v 1.14 2007/06/05 10:38:27 opalod Exp $  
     59   !! $Id$ 
    6160   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    6261   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r800 r888  
    2121   USE oce             ! ocean dynamics and tracers 
    2222   USE dom_oce         ! ocean space and time domain 
     23   USE sbc_oce         ! surface boundary condition: ocean 
     24   USE dynspg_oce      ! surface pressure gradient variables 
    2325   USE phycst          ! physical constants 
    24    USE ocesbc          ! ocean surface boundary condition 
     26   USE domvvl          ! variable volume 
    2527   USE obcdta          ! open boundary condition data      
    2628   USE obcfla          ! Flather open boundary condition   
    … …  
    3133   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3234   USE prtctl          ! Print control 
    33    USE dynspg_oce      ! surface pressure gradient variables 
    3435   USE in_out_manager  ! I/O manager 
    3536   USE iom 
    3637   USE restart         ! only for lrst_oce 
    37    USE domvvl          ! variable volume 
    3838 
    3939   IMPLICIT NONE 
    … …  
    5252   !!---------------------------------------------------------------------- 
    5353   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    54    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/DYN/dynspg_ts.F90,v 1.16 2007/06/05 10:38:27 opalod Exp $  
     54   !! $Id$ 
    5555   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5656   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/DYN/dynzad.F90

    r789 r888  
    1616   USE oce            ! ocean dynamics and tracers 
    1717   USE dom_oce        ! ocean space and time domain 
     18   USE sbc_oce        ! surface boundary condition: ocean 
     19   USE trdmod_oce     ! ocean variables trends 
     20   USE trdmod         ! ocean dynamics trends  
    1821   USE in_out_manager ! I/O manager 
    19    USE trdmod         ! ocean dynamics trends  
    20    USE trdmod_oce     ! ocean variables trends 
    21    USE flxrnf         ! ocean runoffs 
    2222   USE prtctl         ! Print control 
    2323 
    … …  
    3232   !!---------------------------------------------------------------------- 
    3333   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    34    !! $Header$  
     34   !! $Id$ 
    3535   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r719 r888  
    1818   USE phycst          ! physical constants 
    1919   USE zdf_oce         ! ocean vertical physics 
     20   USE sbc_oce         ! surface boundary condition: ocean 
    2021   USE in_out_manager  ! I/O manager 
    21    USE taumod          ! surface ocean stress 
    2222 
    2323   IMPLICIT NONE 
    … …  
    3232   !!---------------------------------------------------------------------- 
    3333   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    34    !! $Header$  
     34   !! $Id$ 
    3535   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    … …  
    8181         ! Surface boundary condition 
    8282         DO ji = 2, jpim1 
    83             zwy(ji,1) = taux(ji,jj) * zrau0r 
    84             zww(ji,1) = tauy(ji,jj) * zrau0r 
     83            zwy(ji,1) = utau(ji,jj) * zrau0r 
     84            zww(ji,1) = vtau(ji,jj) * zrau0r 
    8585         END DO   
    8686 

  • trunk/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r719 r888  
    1414   !!---------------------------------------------------------------------- 
    1515   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    16    !! $Header$  
     16   !! $Id$ 
    1717   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1818   !!---------------------------------------------------------------------- 
    … …  
    2020   USE oce             ! ocean dynamics and tracers 
    2121   USE dom_oce         ! ocean space and time domain 
     22   USE sbc_oce         ! surface boundary condition: ocean 
     23   USE zdf_oce         ! ocean vertical physics 
    2224   USE phycst          ! physical constants 
    23    USE zdf_oce         ! ocean vertical physics 
    2425   USE in_out_manager  ! I/O manager 
    25    USE taumod          ! surface ocean stress 
    2626 
    2727   IMPLICIT NONE 
    … …  
    3636   !!---------------------------------------------------------------------- 
    3737   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    38    !! $Header$  
     38   !! $Id$ 
    3939   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4040   !!---------------------------------------------------------------------- 
    … …  
    141141!!! change les resultats (derniers digit, pas significativement + rapide 1* de moins) 
    142142!!!         ua(ji,jj,1) = ub(ji,jj,1)  & 
    143 !!!                      + p2dt * ( ua(ji,jj,1) + taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) ) 
     143!!!                      + p2dt * ( ua(ji,jj,1) + utau(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) ) 
    144144            z2dtf = p2dt / ( fse3u(ji,jj,1)*rau0 ) 
    145145            ua(ji,jj,1) = ub(ji,jj,1)  & 
    146                          + p2dt *  ua(ji,jj,1) + z2dtf * taux(ji,jj) 
     146                         + p2dt *  ua(ji,jj,1) + z2dtf * utau(ji,jj) 
    147147         END DO 
    148148      END DO 
    … …  
    236236!!! change les resultats (derniers digit, pas significativement + rapide 1* de moins) 
    237237!!!         va(ji,jj,1) = vb(ji,jj,1)  & 
    238 !!!                      + p2dt * ( va(ji,jj,1) + tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) ) 
     238!!!                      + p2dt * ( va(ji,jj,1) + vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) ) 
    239239            z2dtf = p2dt / ( fse3v(ji,jj,1)*rau0 ) 
    240240            va(ji,jj,1) = vb(ji,jj,1)  & 
    241                          + p2dt * va(ji,jj,1) + z2dtf * tauy(ji,jj) 
     241                         + p2dt * va(ji,jj,1) + z2dtf * vtau(ji,jj) 
    242242         END DO 
    243243      END DO 

  • trunk/NEMO/OPA_SRC/DYN/wzvmod.F90

    r789 r888  
    1313   USE oce             ! ocean dynamics and tracers variables 
    1414   USE dom_oce         ! ocean space and time domain variables  
     15   USE sbc_oce         ! surface boundary condition: ocean 
     16   USE domvvl          ! Variable volume 
    1517   USE in_out_manager  ! I/O manager 
    1618   USE prtctl          ! Print control 
    17  
    18    USE domvvl          ! Variable volume 
    1919   USE phycst 
    20    USE ocesbc          ! ocean surface boundary condition 
    2120   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2221 
    … …  
    3130   !!---------------------------------------------------------------------- 
    3231   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    33    !! $Header$  
     32   !! $Id$ 
    3433   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3534   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r789 r888  
    1414   USE oce             ! ocean dynamics and tracers 
    1515   USE dom_oce         ! ocean space and time domain 
     16   USE sbc_oce         ! surface boundary condition: ocean 
     17   USE sbcrnf          ! river runoffs 
    1618   USE ldftra_oce      ! ocean tracer   lateral physics 
    1719   USE phycst          ! physical constants 
    1820   USE ldfslp          ! iso-neutral slopes 
    19    USE flxrnf          !  
    2021   USE in_out_manager  ! I/O manager 
    2122   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    2930   !!---------------------------------------------------------------------- 
    3031   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    31    !! $Header$  
     32   !! $Id$ 
    3233   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3334   !!---------------------------------------------------------------------- 
    … …  
    188189            DO ji = 1, jpi 
    189190               zaht      = ( 1. -  MIN( 1., ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  & 
    190                   &      + aht0 * upsrnfh(ji,jj)                          ! enhanced near river mouths 
     191                  &      + aht0 * rnfmsk(ji,jj)                          ! enhanced near river mouths 
    191192               ahtu(ji,jj) = MAX( MAX( zaht_min, aeiu(ji,jj) ) + zaht, aht0 ) 
    192193               ahtv(ji,jj) = MAX( MAX( zaht_min, aeiv(ji,jj) ) + zaht, aht0 ) 

  • trunk/NEMO/OPA_SRC/OBC/obcvol.F90

    r719 r888  
    1212   USE oce             ! ocean dynamics and tracers  
    1313   USE dom_oce         ! ocean space and time domain  
     14   USE sbc_oce         ! surface boundary condition: ocean 
    1415   USE phycst          ! physical constants 
    1516   USE obc_oce         ! ocean open boundary conditions 
    1617   USE lib_mpp         ! for mppsum 
    1718   USE in_out_manager  ! I/O manager 
    18    USE ocesbc          ! ocean surface boundary conditions 
    1919 
    2020   IMPLICIT NONE 
    … …  
    2929   !!--------------------------------------------------------------------------------- 
    3030   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    31    !! $Header$  
     31   !! $Id$ 
    3232   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    3333   !!--------------------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/SBC/albedo.F90

    r833 r888  
    44   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice) 
    55   !!===================================================================== 
    6    !!---------------------------------------------------------------------- 
    7    !!   flx_blk_albedo : albedo for ocean and ice (clear and overcast skies) 
    8    !!---------------------------------------------------------------------- 
    9    !! * Modules used 
    10    USE oce             ! ocean dynamics and tracers 
    11    USE dom_oce         ! ocean space and time domain 
    12    USE cpl_oce         ! ??? 
     6   !! History :  8.0  !  01-04  (LIM 1.0) 
     7   !!            8.5  !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
     8   !!            9.0  !  04-11  (C. Talandier)  add albedo_init 
     9   !!             -   !  01-06  (M. Vancoppenolle) LIM 3.0 
     10   !!             -   !  06-08  (G. Madec)  cleaning for surface module 
     11   !!---------------------------------------------------------------------- 
     12   !!   albedo_ice  : albedo for   ice (clear and overcast skies) 
     13   !!   albedo_oce  : albedo for ocean (clear and overcast skies) 
     14   !!   albedo_init : initialisation of albedo computation 
     15   !!---------------------------------------------------------------------- 
    1316   USE phycst          ! physical constants 
    14    USE daymod 
    15    USE blk_oce         ! bulk variables 
    16    USE flx_oce         ! forcings variables 
    17    USE ocfzpt          ! ??? 
    18    USE in_out_manager 
    19    USE lbclnk 
     17   USE in_out_manager  ! I/O manager 
    2018 
    2119   IMPLICIT NONE 
    2220   PRIVATE 
    2321 
    24    !! * Accessibility 
    25    PUBLIC flx_blk_albedo ! routine called by limflx.F90 in coupled 
    26                          ! and in flxblk.F90 in forced 
    27    !! * Module variables 
    28    INTEGER  ::             &  !: nameos : ocean physical parameters 
    29       albd_init = 0           !: control flag for initialization 
    30  
    31    REAL(wp)  ::            &  ! constant values 
    32       zzero   = 0.e0    ,  & 
    33       zone    = 1.0 
    34  
    35    !! * constants for albedo computation (flx_blk_albedo) 
     22   PUBLIC albedo_ice   ! routine called sbcice_lim.F90 
     23   PUBLIC albedo_oce   ! routine called by ??? 
     24 
     25   INTEGER  ::   albd_init = 0      !: control flag for initialization 
     26   REAL(wp) ::   zzero     = 0.e0   ! constant values 
     27   REAL(wp) ::   zone      = 1.e0   !    "       " 
     28 
     29   REAL(wp) ::   c1     = 0.05    ! constants values 
     30   REAL(wp) ::   c2     = 0.10    !    "        " 
     31   REAL(wp) ::   rmue   = 0.40    !  cosine of local solar altitude 
     32 
     33   !!* namelist namalb 
    3634   REAL(wp) ::   & 
    37       c1     = 0.05  ,     &   ! constants values 
    38       c2     = 0.10  ,     & 
     35      cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account 
     36      !                        !  effects of cloudiness (Grenfell & Perovich, 1984) 
    3937#if defined key_lim3 
    4038      albice = 0.53  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
    … …  
    4240      albice = 0.50  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
    4341#endif 
    44       cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account 
    45                                !  effects of cloudiness (Grenfell & Perovich, 1984) 
    4642      alphd  = 0.80  ,     &   !  coefficients for linear interpolation used to compute 
    4743      alphdi = 0.72  ,     &   !  albedo between two extremes values (Pyane, 1972) 
    48       alphc  = 0.65  ,     & 
    49       zmue   = 0.40            !  cosine of local solar altitude 
    50  
    51    !!---------------------------------------------------------------------- 
    52    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    53    !! $Header$  
    54    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     44      alphc  = 0.65  
     45 
     46   !!---------------------------------------------------------------------- 
     47   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     48   !! $Id$ 
     49   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5550   !!---------------------------------------------------------------------- 
    5651 
    5752CONTAINS 
    5853 
    59 #if defined key_lim3 || defined key_lim2 
    60    !!---------------------------------------------------------------------- 
    61    !!   'key_lim3' OR 'key_lim2'               LIM 2.0 or LIM 3.0 ice model 
    62    !!---------------------------------------------------------------------- 
    63  
    64    SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp ) 
    65       !!---------------------------------------------------------------------- 
    66       !!               ***  ROUTINE flx_blk_albedo  *** 
     54   SUBROUTINE albedo_ice( pt_ice, ph_ice, ph_snw, pa_ice_cs, pa_ice_os ) 
     55      !!---------------------------------------------------------------------- 
     56      !!               ***  ROUTINE albedo_ice  *** 
    6757      !!           
    6858      !! ** Purpose :   Computation of the albedo of the snow/ice system  
    69       !!      as well as the ocean one 
     59      !!                as well as the ocean one 
    7060      !!        
    7161      !! ** Method  : - Computation of the albedo of snow or ice (choose the  
    72       !!      rignt one by a large number of tests 
     62      !!                rignt one by a large number of tests 
    7363      !!              - Computation of the albedo of the ocean 
    7464      !! 
    75       !! References : 
    76       !!      Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
    77       !! 
    78       !! History : 
    79       !!  8.0   !  01-04  (LIM 1.0) 
    80       !!  8.5   !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
    81       !!  9.0   !  01-06  (M. Vancoppenolle) LIM 3.0 
    82       !!---------------------------------------------------------------------- 
    83       !! * Modules used 
    84 #if defined key_lim3 
    85       USE par_ice 
    86       USE ice                   ! ??? 
    87 #elif defined key_lim2 
    88       USE ice_2                 ! ??? 
    89 #endif 
    90  
    91       !! * Arguments 
    92 #if defined key_lim3 
    93       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(out) ::  & 
    94 #elif defined key_lim2 
    95       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  & 
    96 #endif 
    97          palb         ,     &    !  albedo of ice under overcast sky 
    98          palbp                   !  albedo of ice under clear sky  
    99       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  & 
    100          palcn        ,     &    !  albedo of ocean under overcast sky 
    101          palcnp                  !  albedo of ocean under clear sky 
    102  
    103       !! * Local variables 
    104       INTEGER ::    & 
    105          ji, jj, jl               ! dummy loop indices 
    106       REAL(wp) ::   &  
    107          zmue14         ,     &   !  zmue**1.4 
    108          zalbpsnm       ,     &   !  albedo of ice under clear sky when snow is melting 
    109          zalbpsnf       ,     &   !  albedo of ice under clear sky when snow is freezing 
    110          zalbpsn        ,     &   !  albedo of snow/ice system when ice is coverd by snow 
    111          zalbpic        ,     &   !  albedo of snow/ice system when ice is free of snow 
    112          zithsn         ,     &   !  = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow) 
    113          zitmlsn        ,     &   !  = 1 freezinz snow (t_su >=rt0_snow) ; = 0 melting snow (t_su<rt0_snow) 
    114          zihsc1         ,     &   !  = 1 hsn <= c1 ; = 0 hsn > c1 
    115          zihsc2                   !  = 1 hsn >= c2 ; = 0 hsn < c2 
    116 #if defined key_lim3 
    117       REAL(wp), DIMENSION(jpi,jpj,jpl) ::  & 
    118 #elif defined key_lim2 
    119       REAL(wp), DIMENSION(jpi,jpj) ::  & 
    120 #endif 
    121          zalbfz         ,     &   !  ( = alphdi for freezing ice ; = albice for melting ice ) 
    122          zficeth                  !  function of ice thickness 
    123 #if defined key_lim3 
    124       LOGICAL , DIMENSION(jpi,jpj,jpl) ::  & 
    125 #elif defined key_lim2 
    126       LOGICAL , DIMENSION(jpi,jpj) ::  & 
    127 #endif 
    128          llmask 
     65      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
     66      !!---------------------------------------------------------------------- 
     67      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature 
     68      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice      !  sea-ice thickness 
     69      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_snw      !  snow thickness 
     70      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_cs   !  albedo of ice under clear    sky 
     71      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_os   !  albedo of ice under overcast sky 
     72      !! 
     73      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     74      INTEGER  ::   ijpl          ! number of ice categories (3rd dim of ice input arrays) 
     75      REAL(wp) ::   zalbpsnm      ! albedo of ice under clear sky when snow is melting 
     76      REAL(wp) ::   zalbpsnf      ! albedo of ice under clear sky when snow is freezing 
     77      REAL(wp) ::   zalbpsn       ! albedo of snow/ice system when ice is coverd by snow 
     78      REAL(wp) ::   zalbpic       ! albedo of snow/ice system when ice is free of snow 
     79      REAL(wp) ::   zithsn        ! = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow) 
     80      REAL(wp) ::   zitmlsn       ! = 1 freezinz snow (pt_ice >=rt0_snow) ; = 0 melting snow (pt_ice<rt0_snow) 
     81      REAL(wp) ::   zihsc1        ! = 1 hsn <= c1 ; = 0 hsn > c1 
     82      REAL(wp) ::   zihsc2        ! = 1 hsn >= c2 ; = 0 hsn < c2 
     83      !! 
     84      LOGICAL , DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   llmask 
     85      REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zalbfz    ! = alphdi for freezing ice ; = albice for melting ice 
     86      REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zficeth   !  function of ice thickness 
    12987      !!--------------------------------------------------------------------- 
    13088       
    131       ! initialization  
    132       IF( albd_init == 0 )   CALL albedo_init 
    133  
    134       !-------------------------                                                              
     89      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
     90 
     91      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
     92 
     93      !--------------------------- 
    13594      !  Computation of  zficeth 
    136       !--------------------------  
    137 #if defined key_lim3 
    138       llmask = (ht_s(:,:,:) == 0.e0) .AND. ( t_su(:,:,:) >= rt0_ice ) 
    139 #elif defined key_lim2       
    140       llmask = (hsnif == 0.e0) .AND. ( sist >= rt0_ice ) 
    141 #endif 
    142       WHERE ( llmask )   !  ice free of snow and melts 
    143          zalbfz = albice 
    144       ELSEWHERE                    
    145          zalbfz = alphdi 
     95      !--------------------------- 
     96      llmask = ( ph_snw == 0.e0 ) .AND. ( pt_ice >= rt0_ice ) 
     97      ! ice free of snow and melts 
     98      WHERE( llmask )   ;   zalbfz = albice 
     99      ELSEWHERE         ;   zalbfz = alphdi 
    146100      END WHERE 
    147        
    148 #if defined key_lim3 
    149       DO jl = 1, jpl 
     101 
     102      DO jl = 1, ijpl 
    150103         DO jj = 1, jpj 
    151104            DO ji = 1, jpi 
    152                IF( ht_i(ji,jj,jl) > 1.5 ) THEN 
     105               IF( ph_ice(ji,jj,jl) > 1.5 ) THEN 
    153106                  zficeth(ji,jj,jl) = zalbfz(ji,jj,jl) 
    154                ELSEIF( ht_i(ji,jj,jl) > 1.0  .AND. ht_i(ji,jj,jl) <= 1.5 ) THEN 
    155                   zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ht_i(ji,jj,jl) - 1.0 ) 
    156                ELSEIF( ht_i(ji,jj,jl) > 0.05 .AND. ht_i(ji,jj,jl) <= 1.0 ) THEN 
    157                   zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ht_i(ji,jj,jl)                               & 
    158                      &                    - 0.8608 * ht_i(ji,jj,jl) * ht_i(ji,jj,jl)                 & 
    159                      &                    + 0.3812 * ht_i(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i (ji,jj,jl) 
     107               ELSEIF( ph_ice(ji,jj,jl) > 1.0  .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN 
     108                  zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ph_ice(ji,jj,jl) - 1.0 ) 
     109               ELSEIF( ph_ice(ji,jj,jl) > 0.05 .AND. ph_ice(ji,jj,jl) <= 1.0 ) THEN 
     110                  zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ph_ice(ji,jj,jl)                               & 
     111                     &                    - 0.8608 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl)                 & 
     112                     &                    + 0.3812 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl) * ph_ice (ji,jj,jl) 
    160113               ELSE 
    161                   zficeth(ji,jj,jl) = 0.1 + 3.6 * ht_i(ji,jj,jl)  
     114                  zficeth(ji,jj,jl) = 0.1 + 3.6 * ph_ice(ji,jj,jl)  
    162115               ENDIF 
    163116            END DO 
    164117         END DO 
    165118      END DO 
    166 #elif defined key_lim2       
    167       DO jj = 1, jpj 
    168          DO ji = 1, jpi 
    169             IF( hicif(ji,jj) > 1.5 ) THEN 
    170                zficeth(ji,jj) = zalbfz(ji,jj) 
    171             ELSEIF( hicif(ji,jj) > 1.0  .AND. hicif(ji,jj) <= 1.5 ) THEN 
    172                zficeth(ji,jj) = 0.472 + 2.0 * ( zalbfz(ji,jj) - 0.472 ) * ( hicif(ji,jj) - 1.0 ) 
    173             ELSEIF( hicif(ji,jj) > 0.05 .AND. hicif(ji,jj) <= 1.0 ) THEN 
    174                zficeth(ji,jj) = 0.2467 + 0.7049 * hicif(ji,jj)                                & 
    175                   &                    - 0.8608 * hicif(ji,jj) * hicif(ji,jj)                 & 
    176                   &                    + 0.3812 * hicif(ji,jj) * hicif(ji,jj) * hicif (ji,jj) 
    177             ELSE 
    178                zficeth(ji,jj) = 0.1 + 3.6 * hicif(ji,jj)  
    179             ENDIF 
    180          END DO 
    181       END DO 
    182 #endif 
    183119       
    184120      !-----------------------------------------------  
    … …  
    188124      !    Albedo of snow-ice for clear sky. 
    189125      !-----------------------------------------------     
    190 #if defined key_lim3 
    191       DO jl = 1, jpl 
     126      DO jl = 1, ijpl 
    192127         DO jj = 1, jpj 
    193128            DO ji = 1, jpi 
    194129               !  Case of ice covered by snow.              
    195              
    196                !  freezing snow         
    197                zihsc1       = 1.0 - MAX ( zzero , SIGN ( zone , - ( ht_s(ji,jj,jl) - c1 ) ) ) 
    198                zalbpsnf     = ( 1.0 - zihsc1 ) * ( zficeth(ji,jj,jl) + ht_s(ji,jj,jl) * ( alphd - zficeth(ji,jj,jl) ) / c1 ) & 
    199                   &                 + zihsc1   * alphd   
    200  
    201                !  melting snow                 
    202                zihsc2       = MAX ( zzero , SIGN ( zone , ht_s(ji,jj,jl) - c2 ) ) 
    203                zalbpsnm     = ( 1.0 - zihsc2 ) * ( albice + ht_s(ji,jj,jl) * ( alphc - albice ) / c2 )                 & 
    204                   &                 + zihsc2   * alphc  
    205  
    206  
    207                zitmlsn      =  MAX ( zzero , SIGN ( zone , t_su(ji,jj,jl) - rt0_snow ) )    
    208                zalbpsn      =  zitmlsn * zalbpsnm + ( 1.0 - zitmlsn ) * zalbpsnf 
     130               !                                        !  freezing snow         
     131               zihsc1   = 1.0 - MAX( zzero , SIGN( zone , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 
     132               zalbpsnf = ( 1.0 - zihsc1 ) * (  zficeth(ji,jj,jl)                                        & 
     133                  &                           + ph_snw(ji,jj,jl) * ( alphd - zficeth(ji,jj,jl) ) / c1  )   & 
     134                  &     +         zihsc1   * alphd   
     135               !                                        !  melting snow                 
     136               zihsc2   = MAX( zzero , SIGN( zone , ph_snw(ji,jj,jl) - c2 ) ) 
     137               zalbpsnm = ( 1.0 - zihsc2 ) * ( albice + ph_snw(ji,jj,jl) * ( alphc - albice ) / c2 )       & 
     138                  &     +         zihsc2   * alphc  
     139               ! 
     140               zitmlsn  =  MAX( zzero , SIGN( zone , pt_ice(ji,jj,jl) - rt0_snow ) )    
     141               zalbpsn  =  zitmlsn * zalbpsnm + ( 1.0 - zitmlsn ) * zalbpsnf 
    209142             
    210143               !  Case of ice free of snow. 
    211                zalbpic      = zficeth(ji,jj,jl)  
     144               zalbpic  = zficeth(ji,jj,jl)  
    212145             
    213146               ! albedo of the system    
    214                zithsn       = 1.0 - MAX ( zzero , SIGN ( zone , - ht_s(ji,jj,jl) ) ) 
    215                palbp(ji,jj,jl) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic 
     147               zithsn   = 1.0 - MAX( zzero , SIGN( zone , - ph_snw(ji,jj,jl) ) ) 
     148               pa_ice_cs(ji,jj,jl) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic 
    216149            END DO 
    217150         END DO 
    … …  
    220153      !    Albedo of snow-ice for overcast sky. 
    221154      !----------------------------------------------   
    222       palb(:,:,:)   = palbp(:,:,:) + cgren       ! Oberhuber correction 
    223  
    224 #elif defined key_lim2       
    225  
    226       DO jj = 1, jpj 
    227          DO ji = 1, jpi 
    228             !  Case of ice covered by snow.              
    229              
    230             !  melting snow         
    231             zihsc1       = 1.0 - MAX ( zzero , SIGN ( zone , - ( hsnif(ji,jj) - c1 ) ) ) 
    232             zalbpsnm     = ( 1.0 - zihsc1 ) * ( zficeth(ji,jj) + hsnif(ji,jj) * ( alphd - zficeth(ji,jj) ) / c1 ) & 
    233                &                 + zihsc1   * alphd   
    234             !  freezing snow                 
    235             zihsc2       = MAX ( zzero , SIGN ( zone , hsnif(ji,jj) - c2 ) ) 
    236             zalbpsnf     = ( 1.0 - zihsc2 ) * ( albice + hsnif(ji,jj) * ( alphc - albice ) / c2 )                 & 
    237                &                 + zihsc2   * alphc  
    238              
    239             zitmlsn      =  MAX ( zzero , SIGN ( zone , sist(ji,jj) - rt0_snow ) )    
    240             zalbpsn      =  zitmlsn * zalbpsnf + ( 1.0 - zitmlsn ) * zalbpsnm  
    241              
    242             !  Case of ice free of snow. 
    243             zalbpic      = zficeth(ji,jj)  
    244              
    245             ! albedo of the system    
    246             zithsn       = 1.0 - MAX ( zzero , SIGN ( zone , - hsnif(ji,jj) ) ) 
    247             palbp(ji,jj) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic 
    248          END DO 
    249       END DO 
    250        
    251       !    Albedo of snow-ice for overcast sky. 
    252       !----------------------------------------------   
    253       palb(:,:)   = palbp(:,:) + cgren                                            
    254 #endif 
    255        
    256       !-------------------------------------------- 
    257       !    Computation of the albedo of the ocean  
    258       !-------------------------- -----------------                                                           
    259        
    260       !  Parameterization of Briegled and Ramanathan, 1982  
    261       zmue14      = zmue**1.4                                        
    262       palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 )                 
    263        
    264       !  Parameterization of Kondratyev, 1969 and Payne, 1972 
    265       palcn(:,:)  = 0.06                                                  
    266        
    267    END SUBROUTINE flx_blk_albedo 
    268  
    269 # else 
    270    !!---------------------------------------------------------------------- 
    271    !!   Default option :                                   NO sea-ice model 
    272    !!---------------------------------------------------------------------- 
    273  
    274    SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp ) 
    275       !!---------------------------------------------------------------------- 
    276       !!               ***  ROUTINE flx_blk_albedo  *** 
     155      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + cgren       ! Oberhuber correction 
     156      ! 
     157   END SUBROUTINE albedo_ice 
     158 
     159 
     160   SUBROUTINE albedo_oce( pa_oce_os , pa_oce_cs ) 
     161      !!---------------------------------------------------------------------- 
     162      !!               ***  ROUTINE albedo_oce  *** 
    277163      !!  
    278       !! ** Purpose :   Computation of the albedo of the snow/ice system 
    279       !!      as well as the ocean one 
    280       !! 
    281       !! ** Method  :   Computation of the albedo of snow or ice (choose the 
    282       !!      wright one by a large number of tests Computation of the albedo 
    283       !!      of the ocean 
    284       !! 
    285       !! History : 
    286       !!  8.0   !  01-04  (LIM 1.0) 
    287       !!  8.5   !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
    288       !!---------------------------------------------------------------------- 
    289       !! * Arguments 
    290       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  & 
    291          palb         ,     &    !  albedo of ice under overcast sky 
    292          palcn        ,     &    !  albedo of ocean under overcast sky 
    293          palbp        ,     &    !  albedo of ice under clear sky 
    294          palcnp                  !  albedo of ocean under clear sky 
    295  
    296       REAL(wp) ::   & 
    297          zmue14                 !  zmue**1.4 
    298       !!---------------------------------------------------------------------- 
    299  
    300       !-------------------------------------------- 
    301       !    Computation of the albedo of the ocean 
    302       !-------------------------- ----------------- 
    303  
    304       !  Parameterization of Briegled and Ramanathan, 1982 
    305       zmue14      = zmue**1.4 
    306       palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 ) 
    307  
    308       !  Parameterization of Kondratyev, 1969 and Payne, 1972 
    309       palcn(:,:)  = 0.06 
    310  
    311       palb (:,:)  = palcn(:,:) 
    312       palbp(:,:)  = palcnp(:,:) 
    313  
    314    END SUBROUTINE flx_blk_albedo 
    315  
    316 #endif 
     164      !! ** Purpose :   Computation of the albedo of the ocean 
     165      !! 
     166      !! ** Method  :   .... 
     167      !!---------------------------------------------------------------------- 
     168      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky 
     169      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
     170      !! 
     171      REAL(wp) ::   zcoef   ! temporary scalar 
     172      !!---------------------------------------------------------------------- 
     173      ! 
     174      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )      ! Parameterization of Briegled and Ramanathan, 1982  
     175      pa_oce_cs(:,:) = zcoef                
     176      pa_oce_os(:,:)  = 0.06                         ! Parameterization of Kondratyev, 1969 and Payne, 1972 
     177      ! 
     178   END SUBROUTINE albedo_oce 
     179 
    317180 
    318181   SUBROUTINE albedo_init 
    … …  
    323186      !! 
    324187      !! ** Method  :   Read the namelist namalb 
    325       !! 
    326       !! ** Action  :   
    327       !! 
    328       !! 
    329       !! History : 
    330       !!   9.0  !  04-11  (C. Talandier)  Original code 
    331188      !!---------------------------------------------------------------------- 
    332189      NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc 
    333       !!---------------------------------------------------------------------- 
    334       !!  OPA 9.0, LODYC-IPSL (2004) 
    335190      !!---------------------------------------------------------------------- 
    336191 
    … …  
    342197      READ  ( numnam, namalb ) 
    343198 
    344       ! Control print 
    345       IF(lwp) THEN 
     199      IF(lwp) THEN               ! Control print 
    346200         WRITE(numout,*) 
    347          WRITE(numout,*) 'albedo_init : albedo ' 
     201         WRITE(numout,*) 'albedo_init : set albedo parameters from namelist namalb' 
    348202         WRITE(numout,*) '~~~~~~~~~~~' 
    349          WRITE(numout,*) '          Namelist namalb : set albedo parameters' 
    350          WRITE(numout,*) 
    351          WRITE(numout,*) '             correction of the snow or ice albedo to take into account cgren = ', cgren 
    352          WRITE(numout,*) '             albedo of melting ice in the arctic and antarctic        albice = ', albice 
    353          WRITE(numout,*) '             coefficients for linear                                   alphd = ', alphd 
    354          WRITE(numout,*) '             interpolation used to compute albedo                     alphdi = ', alphdi 
    355          WRITE(numout,*) '             between two extremes values (Pyane, 1972)                 alphc = ', alphc 
    356          WRITE(numout,*) 
     203         WRITE(numout,*) '             correction for snow and ice albedo                    cgren  = ', cgren 
     204         WRITE(numout,*) '             albedo of melting ice in the arctic and antarctic     albice = ', albice 
     205         WRITE(numout,*) '             coefficients for linear                               alphd  = ', alphd 
     206         WRITE(numout,*) '             interpolation used to compute albedo                  alphdi = ', alphdi 
     207         WRITE(numout,*) '             between two extremes values (Pyane, 1972)             alphc  = ', alphc 
    357208      ENDIF 
    358  
     209      ! 
    359210   END SUBROUTINE albedo_init 
     211 
    360212   !!====================================================================== 
    361213END MODULE albedo 

  • trunk/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r719 r888  
    4545   USE daymod                       ! date and time info 
    4646   USE dom_oce                      ! ocean space and time domain 
     47   USE sbc_ice                      ! surface boundary condition: ice 
    4748   USE in_out_manager               ! I/O manager 
    4849   USE par_oce                      ! 
    … …  
    5051 
    5152   USE oce, only: tn, un, vn 
    52    USE ice, only: frld, hicif, hsnif 
    53    USE flx_oce, only : alb_ice ,  & ! albedo of ice 
    54                        tn_ice       ! ice surface temperature 
     53#if defined key_lim2 
     54   USE ice_2, only: frld, hicif, hsnif 
     55#endif 
    5556 
    5657   IMPLICIT NONE 
    … …  
    116117   !!---------------------------------------------------------------------- 
    117118   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    118    !! $Header$  
     119   !! $Id$ 
    119120   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    120121   !!---------------------------------------------------------------------- 
    … …  
    309310 
    310311#if defined key_cpl_albedo 
     312# if defined key_lim3 
     313         Must be adapted for LIM3 
     314# endif 
    311315         tn_ice  = 271.285 
    312316    alb_ice =   0.75 

  • trunk/NEMO/OPA_SRC/SBC/cpl_oasis4.F90

    r719 r888  
    120120   !!---------------------------------------------------------------------- 
    121121   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    122    !! $Header$  
     122   !! $ Id: $ 
    123123   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    124124   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/SBC/oasis4_date.F90

    r719 r888  
    1111   !!---------------------------------------------------------------------- 
    1212   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    13    !! $Header$  
     13   !! $ Id: $ 
    1414   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1515   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r833 r888  
    11MODULE traadv_cen2 
    2    !!============================================================================== 
    3    !!                       ***  MODULE  traadv_cen2  *** 
     2   !!====================================================================== 
     3   !!                     ***  MODULE  traadv_cen2  *** 
    44   !! Ocean active tracers:  horizontal & vertical advective trend 
    5    !!============================================================================== 
    6    !! History :  8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv  
    7    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    8    !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    9    !!            " "  !  06-04  (R. Benshila, G. Madec) Step reorganization 
     5   !!====================================================================== 
     6   !! History :   8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad=traadv  
     7   !!             8.5  !  02-06  (G. Madec)  F90: Free form and module 
     8   !!             9.0  !  04-08  (C. Talandier) New trends organization 
     9   !!             " "  !  05-11  (V. Garnier) Surface pressure gradient organization 
     10   !!             " "  !  06-04  (R. Benshila, G. Madec) Step reorganization 
     11   !!             " "  !  06-07  (G. madec)  add ups_orca_set routine 
    1012   !!---------------------------------------------------------------------- 
    1113 
    … …  
    1315   !!   tra_adv_cen2 : update the tracer trend with the horizontal and 
    1416   !!                  vertical advection trends using a seconder order 
     17   !!   ups_orca_set : allow mixed upstream/centered scheme in specific 
     18   !!                  area (set for orca 2 and 4 only) 
    1519   !!---------------------------------------------------------------------- 
    1620   USE oce             ! ocean dynamics and active tracers 
    1721   USE dom_oce         ! ocean space and time domain 
     22   USE sbc_oce         ! surface boundary condition: ocean 
     23   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
     24   USE trdmod_oce      ! ocean variables trends 
    1825   USE trdmod          ! ocean active tracers trends  
    19    USE trdmod_oce      ! ocean variables trends 
    20    USE flxrnf          ! 
     26   USE closea          ! closed sea 
    2127   USE trabbl          ! advective term in the BBL 
    2228   USE ocfzpt          ! 
     29   USE sbcrnf          ! river runoffs 
     30   USE in_out_manager  ! I/O manager 
    2331   USE lib_mpp 
    2432   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    25    USE in_out_manager  ! I/O manager 
    2633   USE diaptr          ! poleward transport diagnostics 
    27    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    2834   USE prtctl          ! Print control 
    2935 
    … …  
    3137   PRIVATE 
    3238 
    33    PUBLIC   tra_adv_cen2   ! routine called by step.F90 
     39   PUBLIC   tra_adv_cen2    ! routine called by step.F90 
     40   PUBLIC   ups_orca_set    ! routine used by traadv_cen2_jki.F90 
     41 
     42   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   upsmsk    !: mixed upstream/centered scheme near some straits  
     43   !                                                   !  and in closed seas (orca 2 and 4 configurations) 
    3444 
    3545   REAL(wp), DIMENSION(jpi,jpj) ::   btr2   ! inverse of T-point surface [1/(e1t*e2t)] 
    … …  
    3949#  include "vectopt_loop_substitute.h90" 
    4050   !!---------------------------------------------------------------------- 
    41    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    42    !! $Header$  
     51   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     52   !! $Id$ 
    4353   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4454   !!---------------------------------------------------------------------- 
    … …  
    118128      !! 
    119129      INTEGER  ::   ji, jj, jk                           ! dummy loop indices 
    120       REAL(wp) ::                           & 
    121          zbtr, zta, zsa, zfui, zfvj,        &  ! temporary scalars 
    122          zhw, ze3tr, zcofi, zcofj,          &  !    "         " 
    123          zupsut, zupsvt, zupsus, zupsvs,    &  !    "         " 
    124          zfp_ui, zfp_vj, zfm_ui, zfm_vj,    &  !    "         " 
    125          zcofk, zupst, zupss, zcent,        &  !    "         " 
    126          zcens, zfp_w, zfm_w,               &  !    "         " 
    127          zcenut, zcenvt, zcenus, zcenvs,    &  !    "         " 
    128          z_hdivn_x, z_hdivn_y, z_hdivn 
    129       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace  
     130      REAL(wp) ::   zta, zsa, zbtr, zhw, ze3tr,       &  ! temporary scalars 
     131         &          zfp_ui, zfp_vj, zfp_w , zfui  ,   &  !    "         " 
     132         &          zfm_ui, zfm_vj, zfm_w , zfvj  ,   &  !    "         " 
     133         &          zcofi , zcofj , zcofk ,           &  !    "         " 
     134         &          zupsut, zupsus, zcenut, zcenus,   &  !    "         " 
     135         &          zupsvt, zupsvs, zcenvt, zcenvs,   &  !    "         " 
     136         &          zupst , zupss , zcent , zcens ,   &  !    "         " 
     137         &          z_hdivn_x, z_hdivn_y, z_hdivn  
     138      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace 
    130139      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      " 
    131140      !!---------------------------------------------------------------------- 
    … …  
    136145         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case' 
    137146         IF(lwp) WRITE(numout,*) 
    138          !  
    139          btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
     147         ! 
     148         upsmsk(:,:) = 0.e0                              ! not upstream by default 
     149         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits 
     150         !                                               ! and in closed seas (orca2 and orca4 only) 
     151         !    
     152         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )        ! inverse of T-point surface 
    140153      ENDIF 
    141154 
    … …  
    145158         DO jj = 1, jpj 
    146159            DO ji = 1, jpi 
    147                zind(ji,jj,jk) =  MAX ( upsrnfh(ji,jj) * upsrnfz(jk),     &  ! changing advection scheme near runoff 
    148                   &                    upsadv(ji,jj)                     &  ! in the vicinity of some straits 
     160               zind(ji,jj,jk) = MAX (   & 
     161                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows) 
     162                  upsmsk(ji,jj)                      &  ! some of some straits 
    149163#if defined key_lim3 || defined key_lim2 
    150                   &                  , tmask(ji,jj,jk)                   &  ! half upstream tracer fluxes 
    151                   &                  * MAX( 0., SIGN( 1., fzptn(ji,jj)   &  ! if tn < ("freezing"+0.1 ) 
    152                   &                                +0.1-tn(ji,jj,jk) ) ) & 
     164                  !                                     ! below ice covered area (if tn < "freezing"+0.1 ) 
     165                  , MAX(  0., SIGN( 1., fzptn(ji,jj) + 0.1 - tn(ji,jj,jk) )  ) * tmask(ji,jj,jk)   & 
    153166#endif 
    154167                  &                  ) 
    … …  
    157170      END DO 
    158171 
    159  
    160       !  Horizontal advective fluxes 
    161       ! ----------------------------- 
     172      ! I. Horizontal advective fluxes 
     173      ! ------------------------------ 
     174      !  Second order centered tracer flux at u and v-points 
     175      ! ----------------------------------------------------- 
    162176      !                                                ! =============== 
    163177      DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    278292         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    279293 
    280       ! 4. "zonal" mean advective heat and salt transport  
    281       ! ------------------------------------------------- 
     294      ! "zonal" mean advective heat and salt transport  
     295      ! ---------------------------------------------- 
    282296 
    283297      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    … …  
    312326      ENDIF 
    313327 
    314       ! 1. Vertical advective fluxes 
     328      ! 1. Vertical advective fluxes  
    315329      ! ---------------------------- 
    316330      ! Second order centered tracer flux at w-point 
    … …  
    386400      ! 
    387401   END SUBROUTINE tra_adv_cen2 
     402    
     403    
     404   SUBROUTINE ups_orca_set 
     405      !!---------------------------------------------------------------------- 
     406      !!                  ***  ROUTINE ups_orca_set  *** 
     407      !!        
     408      !! ** Purpose :   add a portion of upstream scheme in area where the 
     409      !!                centered scheme generates too strong overshoot 
     410      !! 
     411      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk 
     412      !!                array to nozero value in some straith.  
     413      !! 
     414      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca 
     415      !!---------------------------------------------------------------------- 
     416      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers 
     417      !!---------------------------------------------------------------------- 
     418       
     419      ! mixed upstream/centered scheme near river mouths 
     420      ! ------------------------------------------------ 
     421      SELECT CASE ( jp_cfg ) 
     422      !                                        ! ======================= 
     423      CASE ( 4 )                               !  ORCA_R4 configuration  
     424         !                                     ! ======================= 
     425         !                                          ! Gibraltar Strait 
     426         ii0 =  70   ;   ii1 =  71 
     427         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     428         ! 
     429         !                                     ! ======================= 
     430      CASE ( 2 )                               !  ORCA_R2 configuration  
     431         !                                     ! ======================= 
     432         !                                          ! Gibraltar Strait 
     433         ij0 = 102   ;   ij1 = 102 
     434         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20 
     435         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40 
     436         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     437         ij0 = 101   ;   ij1 = 102 
     438         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     439         !                                          ! Bab el Mandeb Strait 
     440         ij0 =  87   ;   ij1 =  88 
     441         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10 
     442         ij0 =  88   ;   ij1 =  88 
     443         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     444         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40 
     445         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     446         ij0 =  89   ;   ij1 =  89 
     447         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     448         ij0 =  90   ;   ij1 =  90 
     449         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     450         !                                          ! Sound Strait 
     451         ij0 = 116   ;   ij1 = 116 
     452         ii0 = 144   ;   ii1 = 144   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     453         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 
     454         ii0 = 148   ;   ii1 = 148   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 
     455         ! 
     456      END SELECT  
     457       
     458      ! mixed upstream/centered scheme over closed seas 
     459      ! ----------------------------------------------- 
     460      CALL clo_ups( upsmsk(:,:) ) 
     461      ! 
     462   END SUBROUTINE ups_orca_set 
    388463 
    389464   !!====================================================================== 

  • trunk/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r789 r888  
    1414   USE oce             ! ocean dynamics and active tracers 
    1515   USE dom_oce         ! ocean space and time domain 
     16   USE dynspg_oce      !  
     17   USE trdmod_oce      ! ocean variables trends 
    1618   USE trdmod          ! ocean active tracers trends  
    17    USE trdmod_oce      ! ocean variables trends 
    18    USE flxrnf          ! 
    1919   USE trabbl          ! advective term in the BBL 
    20    USE ocfzpt          ! 
    2120   USE lib_mpp 
    2221   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2322   USE in_out_manager  ! I/O manager 
    2423   USE diaptr          ! poleward transport diagnostics 
    25    USE dynspg_oce      !  
    2624   USE prtctl          ! Print control 
    2725 
    … …  
    4745   !!---------------------------------------------------------------------- 
    4846   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    49    !! $Header$  
     47   !! $Id$ 
    5048   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5149   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/TRA/tranxt.F90

    r782 r888  
    2121   USE dom_oce         ! ocean space and time domain variables  
    2222   USE zdf_oce         ! ??? 
     23   USE dynspg_oce      ! surface pressure gradient variables 
     24   USE trdmod_oce      ! ocean variables trends 
     25   USE trdmod          ! ocean active tracers trends  
     26   USE phycst 
     27   USE domvvl          ! variable volume 
     28   USE obctra          ! open boundary condition (obc_tra routine) 
    2329   USE in_out_manager  ! I/O manager 
    2430   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    25    USE obctra          ! open boundary condition (obc_tra routine) 
    26    USE trdmod          ! ocean active tracers trends  
    27    USE trdmod_oce      ! ocean variables trends 
    2831   USE prtctl          ! Print control 
    2932   USE agrif_opa_update 
    3033   USE agrif_opa_interp 
    3134 
    32    USE ocesbc          ! ocean surface boundary condition 
    33    USE domvvl          ! variable volume 
    34    USE dynspg_oce      ! surface pressure gradient variables 
    35    USE phycst 
    3635 
    3736   IMPLICIT NONE 
    … …  
    4746   !!---------------------------------------------------------------------- 
    4847   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    49    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRA/tranxt.F90,v 1.12 2007/05/25 15:51:50 opalod Exp $  
     48   !! $Id$ 
    5049   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5150   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/TRA/traqsr.F90

    r719 r888  
    1717   USE oce             ! ocean dynamics and active tracers 
    1818   USE dom_oce         ! ocean space and time domain 
     19   USE sbc_oce         ! surface boundary condition: ocean 
     20   USE trc_oce         ! share SMS/Ocean variables 
     21   USE trdmod_oce      ! ocean variables trends 
    1922   USE trdmod          ! ocean active tracers trends  
    20    USE trdmod_oce      ! ocean variables trends 
    2123   USE in_out_manager  ! I/O manager 
    22    USE trc_oce         ! share SMS/Ocean variables 
    23    USE ocesbc          ! thermohaline fluxes 
    2424   USE phycst          ! physical constants 
    2525   USE prtctl          ! Print control 
    … …  
    4646   !!---------------------------------------------------------------------- 
    4747   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    48    !! $Header$  
     48   !! $Id$ 
    4949   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5050   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/TRA/trasbc.F90

    r719 r888  
    1313   !!---------------------------------------------------------------------- 
    1414   USE oce             ! ocean dynamics and active tracers 
     15   USE sbc_oce         ! surface boundary condition: ocean 
    1516   USE dom_oce         ! ocean space domain variables 
    16    USE ocesbc          ! surface thermohaline fluxes 
    1717   USE phycst          ! physical constant 
    1818   USE traqsr          ! solar radiation penetration 
    … …  
    3232   !!---------------------------------------------------------------------- 
    3333   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    34    !! $Header$  
     34   !! $Id$ 
    3535   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    … …  
    132132#endif 
    133133            IF( lk_vvl) THEN 
    134                zta = ro0cpr * ( qt(ji,jj) - qsr(ji,jj) ) * zse3t &   ! temperature : heat flux 
     134               zta = ro0cpr * qns(ji,jj) * zse3t &                   ! temperature : heat flux 
    135135                &    - emp(ji,jj) * zsrau * tn(ji,jj,1)  * zse3t     ! & cooling/heating effet of EMP flux 
    136136               zsa = 0.e0                                            ! No salinity concent./dilut. effect 
    137137            ELSE 
    138                zta = ro0cpr * ( qt(ji,jj) - qsr(ji,jj) ) * zse3t     ! temperature : heat flux 
     138               zta = ro0cpr * qns(ji,jj) * zse3t     ! temperature : heat flux 
    139139               zsa = emps(ji,jj) * zsrau * sn(ji,jj,1)   * zse3t     ! salinity :  concent./dilut. effect 
    140140            ENDIF 

  • trunk/NEMO/OPA_SRC/TRA/trazdf.F90

    r789 r888  
    1414   USE dom_oce         ! ocean space and time domain variables  
    1515   USE zdf_oce         ! ocean vertical physics variables 
     16   USE sbc_oce         ! surface boundary condition: ocean 
     17   USE dynspg_oce 
    1618 
    1719   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    … …  
    2527 
    2628   USE phycst 
    27    USE dynspg_oce 
    28    USE ocesbc          ! ocean surface boundary condition 
    2929   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3030   USE domvvl          ! variable volume 
    … …  
    4747   !!---------------------------------------------------------------------- 
    4848   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    49    !! $Header$  
     49   !! $Id$ 
    5050   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5151   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/TRD/trdmod.F90

    r719 r888  
    1212   !!   trd_mod_init     : Initialization step 
    1313   !!---------------------------------------------------------------------- 
    14    USE phycst                  ! physical constants 
    1514   USE oce                     ! ocean dynamics and tracers variables 
    1615   USE dom_oce                 ! ocean space and time domain variables 
    … …  
    1817   USE trdmod_oce              ! ocean variables trends 
    1918   USE ldftra_oce              ! ocean active tracers lateral physics 
     19   USE sbc_oce                 ! surface boundary condition: ocean 
     20   USE phycst                  ! physical constants 
    2021   USE trdvor                  ! ocean vorticity trends  
    2122   USE trdicp                  ! ocean bassin integral constraints properties 
    2223   USE trdmld                  ! ocean active mixed layer tracers trends  
    2324   USE in_out_manager          ! I/O manager 
    24    USE taumod                  ! surface ocean stress 
    2525 
    2626   IMPLICIT NONE 
    … …  
    3737   !!---------------------------------------------------------------------- 
    3838   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    39    !! $Header$  
     39   !! $Id$ 
    4040   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 
    … …  
    124124                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    125125                     ! save the surface forcing momentum fluxes 
    126                      ztswu(ji,jj) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 
    127                      ztswv(ji,jj) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
     126                     ztswu(ji,jj) = utau(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 
     127                     ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
    128128                     ! save bottom friction momentum fluxes 
    129129                     ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) 
    … …  
    175175               DO ji = fs_2, fs_jpim1   ! vector opt. 
    176176                  ! save the surface forcing momentum fluxes 
    177                   ztswu(ji,jj) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 
    178                   ztswv(ji,jj) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
     177                  ztswu(ji,jj) = utau(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 
     178                  ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 
    179179                  ! save bottom friction momentum fluxes 
    180180                  ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) 

  • trunk/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r719 r888  
    2121   USE dom_oce         ! ocean space and time domain 
    2222   USE zdf_oce         ! ocean vertical physics 
     23   USE sbc_oce         ! surface boundary condition: ocean 
    2324   USE phycst          ! physical constants 
    24    USE taumod          ! surface stress 
    2525   USE eosbn2          ! equation of state 
    26    USE ocesbc          ! thermohaline fluxes 
    2726   USE zdfddm          ! double diffusion mixing 
    2827   USE in_out_manager  ! I/O manager 
    … …  
    148147   !!---------------------------------------------------------------------- 
    149148   !!   OPA 9.0 , LOCEAN-IPSL   (2005) 
    150    !! $Header$  
     149   !! $Id$ 
    151150   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    152151   !!---------------------------------------------------------------------- 
    … …  
    460459            zBosol(ji,jj) = grav * zthermal * qsr(ji,jj) 
    461460            ! Non radiative surface buoyancy force 
    462             zBo   (ji,jj) = grav * zthermal * ( qt(ji,jj) - qsr(ji,jj) ) -  grav * zhalin * emp(ji,jj) 
     461            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * emp(ji,jj) 
    463462            ! Surface Temperature flux for non-local term 
    464             wt0(ji,jj) = - qt(ji,jj) * ro0cpr * tmask(ji,jj,1) 
     463            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1) 
    465464            ! Surface salinity flux for non-local term 
    466465            ws0(ji,jj) = - ( emp(ji,jj) * sn(ji,jj,1) * rcs ) * tmask(ji,jj,1) 
    … …  
    476475            zrhos         = rhop(ji,jj,1) + zflageos * rau0 * ( 1. - tmask(ji,jj,1) )   
    477476            ! Friction velocity (zustar), at T-point : LMD94 eq. 2 
    478             ztx           = 0.5 * ( taux(ji,jj) + taux(ji - 1, jj    ) ) 
    479             zty           = 0.5 * ( tauy(ji,jj) + tauy(ji    , jj - 1) ) 
     477            ztx           = 0.5 * ( utau(ji,jj) + utau(ji - 1, jj    ) ) 
     478            zty           = 0.5 * ( vtau(ji,jj) + vtau(ji    , jj - 1) ) 
    480479            ztau          = SQRT( ztx * ztx + zty * zty ) 
    481480            zustar(ji,jj) = SQRT( ztau / ( zrhos +  epsln ) ) 

  • trunk/NEMO/OPA_SRC/ZDF/zdftke.F90

    r789 r888  
    3131   USE dom_oce         ! ocean space and time domain 
    3232   USE zdf_oce         ! ocean vertical physics 
     33   USE sbc_oce         ! surface boundary condition: ocean 
    3334   USE phycst          ! physical constants 
    34    USE taumod          ! surface stress 
    3535   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3636   USE prtctl          ! Print control 
    … …  
    7979   !!---------------------------------------------------------------------- 
    8080   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    81    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/ZDF/zdftke.F90,v 1.16 2007/06/05 10:39:27 opalod Exp $  
     81   !! $Id$ 
    8282   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    8383   !!---------------------------------------------------------------------- 
    … …  
    9999      !!                  - ediss / emxl en**(2/3)        ! dissipation 
    100100      !!      with the boundary conditions: 
    101       !!         surface: en = max( emin0,ebb sqrt(taux^2 + tauy^2) ) 
     101      !!         surface: en = max( emin0,ebb sqrt(utau^2 + vtau^2) ) 
    102102      !!         bottom : en = emin 
    103103      !!      -1- The dissipation and mixing turbulent lengh scales are computed 
    … …  
    299299      ! 2. Surface boundary condition on tke and its eddy viscosity (zmxlm) 
    300300      ! ------------------------------------------------- 
    301       ! en(1)   = ebb sqrt(taux^2+tauy^2) / rau0  (min value emin0) 
     301      ! en(1)   = ebb sqrt(utau^2+vtau^2) / rau0  (min value emin0) 
    302302      ! zmxlm(1) = avmb(1) and zmxlm(jpk) = 0. 
    303303!CDIR NOVERRCHK 
    … …  
    305305!CDIR NOVERRCHK 
    306306         DO ji = fs_2, fs_jpim1   ! vector opt. 
    307             ztx2 = taux(ji-1,jj  ) + taux(ji,jj) 
    308             zty2 = tauy(ji  ,jj-1) + tauy(ji,jj) 
     307            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
     308            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
    309309            zesurf = zbbrau * SQRT( ztx2 * ztx2 + zty2 * zty2 ) 
    310310            en (ji,jj,1) = MAX( zesurf, emin0 ) * tmask(ji,jj,1) 

  • trunk/NEMO/OPA_SRC/cla.F90

    r719 r888  
    1919   USE oce             ! ocean dynamics and tracers variables 
    2020   USE dom_oce         ! ocean space and time domain variables  
     21   USE sbc_oce         ! surface boundary condition: ocean 
    2122   USE in_out_manager  ! I/O manager 
    2223   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    23    USE ocesbc          ! ocean surface boundary condition (fluxes) 
    2424   USE lib_mpp         ! distributed memory computing 
    2525 
    … …  
    4848   !!---------------------------------------------------------------------- 
    4949   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    50    !! $Header$  
     50   !! $Id$ 
    5151   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5252   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/cla_div.F90

    r719 r888  
    1818   USE oce             ! ocean dynamics and tracers 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE sbc_oce         ! surface boundary condition: ocean 
    2021   USE in_out_manager  ! I/O manager 
    21    USE ocesbc          ! ocean surface boundary condition (fluxes) 
    2222   USE lib_mpp         ! distributed memory computing library 
    2323   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    4545   !!---------------------------------------------------------------------- 
    4646   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    47    !! $Header$  
     47   !! $Id$ 
    4848   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4949   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/cla_dynspg.F90

    r719 r888  
    1313   USE obc_oce         ! Lateral open boundary condition 
    1414   USE sol_oce         ! solver variables 
     15   USE sbc_oce         ! surface boundary condition: ocean 
    1516   USE phycst          ! physical constants 
    16    USE ocesbc          ! ocean surface boundary condition (fluxes) 
    17    USE flxrnf          ! ocean runoffs 
    1817   USE solpcg          ! preconditionned conjugate gradient solver 
    1918   USE solsor          ! Successive Over-relaxation solver 
    … …  
    3635   !!---------------------------------------------------------------------- 
    3736   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    38    !! $Header$  
     37   !! $Id$ 
    3938   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4039   !!---------------------------------------------------------------------- 

  • trunk/NEMO/OPA_SRC/cpl_oce.F90

    r833 r888  
    1616   !!---------------------------------------------------------------------- 
    1717   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    18    !! $Header$  
     18   !! $Id$ 
    1919   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    2020   !!---------------------------------------------------------------------- 
    … …  
    218218      qsrc           !: solar radiation (w m-2) 
    219219 
    220 #  if defined key_lim3 || defined key_lim3 
     220#  if defined key_lim3 || defined key_lim2 
    221221   REAL(wp), DIMENSION(jpi,jpj) ::   &  !: 
    222222      watm        ,    &  !: 

  • trunk/NEMO/OPA_SRC/daymod.F90

    r719 r888  
    44   !! Ocean        :  calendar  
    55   !!===================================================================== 
     6   !! History :        !  94-09  (M. Pontaud M. Imbard)  Original code 
     7   !!                  !  97-03  (O. Marti) 
     8   !!                  !  97-05  (G. Madec)  
     9   !!                  !  97-08  (M. Imbard) 
     10   !!             9.0  !  03-09  (G. Madec)  F90 + nyear, nmonth, nday 
     11   !!                  !  04-01  (A.M. Treguier) new calculation based on adatrj 
     12   !!                  !  06-08  (G. Madec)  surface module major update 
     13   !!----------------------------------------------------------------------       
    614 
    715   !!---------------------------------------------------------------------- 
    816   !!   day        : calendar 
    917   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1118   USE dom_oce         ! ocean space and time domain 
    1219   USE phycst          ! physical constants 
    … …  
    1724   PRIVATE 
    1825 
    19    !! * Routine accessibility 
    2026   PUBLIC day        ! called by step.F90 
    2127 
    22    !! * Shared module variables 
    23    INTEGER , PUBLIC ::   &  !: 
    24       nyear     ,   &  !: current year 
    25       nmonth    ,   &  !: current month 
    26       nday      ,   &  !: current day of the month 
    27       nday_year ,   &  !: curent day counted from jan 1st of the current year 
    28       ndastp           !: time step date in year/month/day aammjj 
    29    REAL(wp), PUBLIC ::   &  !: 
    30        adatrj   ,   &  !: number of elapsed days since the begining of the run 
    31        adatrj0         !: value of adatrj at nit000-1 (before the present run). 
    32        !               !  it is the accumulated duration of previous runs 
    33        !               !  that may have been run with different time steps. 
    34    !!---------------------------------------------------------------------- 
    35    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    36    !! $Header$  
    37    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     28   INTEGER , PUBLIC ::   nyear       !: current year 
     29   INTEGER , PUBLIC ::   nmonth      !: current month 
     30   INTEGER , PUBLIC ::   nday        !: current day of the month 
     31   INTEGER , PUBLIC ::   nday_year   !: current day counted from jan 1st of the current year 
     32   REAL(wp), PUBLIC ::   rsec_year   !: current time step counted in second since 00h jan 1st of the current year 
     33   REAL(wp), PUBLIC ::   rsec_month  !: current time step counted in second since 00h 1st day of the current month 
     34   REAL(wp), PUBLIC ::   rsec_day    !: current time step counted in second since 00h         of the current day 
     35   INTEGER , PUBLIC ::   ndastp      !: time step date in year/month/day aammjj 
     36 
     37!!gm supprimer adatrj et adatrj0 ==> remplacer par rsecday..... 
     38   REAL(wp), PUBLIC ::   adatrj      !: number of elapsed days since the begining of the run 
     39   REAL(wp), PUBLIC ::   adatrj0     !: value of adatrj at nit000-1 (before the present run). 
     40   !                                 !  it is the accumulated duration of previous runs 
     41   !                                 !  that may have been run with different time steps. 
     42   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len   !: length of the current year 
     43 
     44   INTEGER, PUBLIC, DIMENSION(12) ::   nbiss = (/ 31, 29, 31, 30, 31, 30,    &  !: number of days per month 
     45      &                                           31, 31, 30, 31, 30, 31 /)     !: (leap-year) 
     46   INTEGER, PUBLIC, DIMENSION(12) ::   nobis = (/ 31, 28, 31, 30, 31, 30,    &  !: number of days per month 
     47      &                                           31, 31, 30, 31, 30, 31 /)     !: (365 days a year) 
     48 
     49   REAL(wp), PUBLIC, DIMENSION(0:14) ::   rmonth_half(0:14) 
     50 
     51   !!---------------------------------------------------------------------- 
     52   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     53   !! $Id$ 
     54   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3855   !!---------------------------------------------------------------------- 
    3956 
    … …  
    5471      !!              - ndastp    : =nyear*10000+nmonth*100+nday 
    5572      !!              - adatrj    : date in days since the beginning of the run 
    56       !! 
    57       !! History : 
    58       !!        !  94-09  (M. Pontaud M. Imbard)  Original code 
    59       !!        !  97-03  (O. Marti) 
    60       !!        !  97-05  (G. Madec)  
    61       !!        !  97-08  (M. Imbard) 
    62       !!   9.0  !  03-09  (G. Madec)  F90 + nyear, nmonth, nday 
    63       !!        !  04-01  (A.M. Treguier) new calculation based on adatrj 
     73      !!              - rsec_year : current time of the year (in second since 00h, jan 1st) 
    6474      !!----------------------------------------------------------------------       
    65       !! * Arguments 
    66       INTEGER, INTENT( in ) ::   kt      ! ocean time-step indices 
    67  
    68       !! * Local declarations 
    69       INTEGER  ::   js                   ! dummy loop indice 
    70       INTEGER  ::   iend, iday0, iday1   ! temporary integers 
    71       REAL(wp) :: zadatrjn, zadatrjb     ! adatrj at timestep kt-1 and kt-2  
    72       CHARACTER (len=25) :: charout 
     75      INTEGER, INTENT(in) ::   kt        ! ocean time-step indices 
     76      ! 
     77      INTEGER  ::   js, jm               ! dummy loop indice 
     78      CHARACTER (len=25) ::   charout 
    7379      !!---------------------------------------------------------------------- 
    7480 
    … …  
    7783      !----------------------------------------------------------------- 
    7884 
    79       IF( kt == nit000 ) THEN 
    80  
     85      !                        ! ---------------- ! 
     86      IF( kt == -1 ) THEN      !  Initialisation  ! 
     87         !                     ! ---------------- ! 
     88         ! 
    8189         IF( .NOT.ln_rstart )   adatrj0 = 0.e0      ! adatrj0 initialized in rst_read when restart  
    8290 
    83          adatrj  = adatrj0 
     91         ! set the calandar from adatrj0 and ndastp (read in restart file and namelist) 
     92         adatrj  =   adatrj0      !???? bug.... toujours rest   !!gm 
    8493         nyear   =   ndastp / 10000 
    8594         nmonth  = ( ndastp - (nyear * 10000) ) / 100 
    8695         nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 )  
    8796 
    88          ! Calculates nday_year, day since january 1st (useful to read  daily forcing fields) 
     97         ! length of the month of the current year (from nleapy, read in namelist) 
     98         nmonth_len(0) = nbiss(12)   ;   nmonth_len(13) = nbiss(1) 
     99         SELECT CASE( nleapy ) 
     100         CASE( 1  )    
     101            IF( MOD( nyear, 4 ) == 0 ) THEN 
     102               ;          nmonth_len(1:12) = nbiss(:)      ! 366 days per year (leap year) 
     103            ELSE 
     104               ;          nmonth_len(1:12) = nobis(:)      ! 365 days per year 
     105            ENDIF 
     106         CASE( 0  )   ;   nmonth_len(1:12) = nobis(:)      ! 365 days per year 
     107         CASE( 2: )   ;   nmonth_len(1:13) = nleapy        ! 12*nleapy days per year 
     108         END SELECT 
     109 
     110         ! half month in second since the bigining of the year 
     111         rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len( 0 ) ) 
     112         DO jm = 1, 12 
     113            rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm) ) 
     114         END DO 
     115         rmonth_half(13) = rmonth_half( 1 ) + 365. * rday 
     116         rmonth_half(14) = rmonth_half( 2 ) + 365. * rday 
     117 
     118         ! day since january 1st (useful to read  daily forcing fields) 
    89119         nday_year =  nday 
    90          !                               ! accumulates days of previous months of this year 
    91          DO js = 1, nmonth-1 
    92             IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    93                nday_year = nday_year + nbiss(js) 
    94             ELSE 
    95                nday_year = nday_year + nobis(js) 
     120         DO js = 1, nmonth - 1             ! accumulates days of previous months of this year 
     121            nday_year = nday_year + nmonth_len(js) 
     122         END DO 
     123 
     124         ! number of seconds since... 
     125         IF( ln_rstart )   THEN 
     126            rsec_year  = REAL( nday_year ) * rday     - rdttra(1)      ! 00h 1st day of the current year 
     127            rsec_month = REAL( nday      ) * rday     - rdttra(1)      ! 00h 1st day of the current month 
     128            rsec_day   = REAL( nday      ) * rday     - rdttra(1)      ! 00h         of the current day 
     129         ELSE 
     130            rsec_year  = REAL( nday_year - 1 ) * rday - rdttra(1)      ! 00h 1st day of the current year 
     131            rsec_month = REAL( nday      - 1 ) * rday - rdttra(1)      ! 00h 1st day of the current month 
     132            rsec_day   =                              - rdttra(1)      ! 00h         of the current day 
     133         ENDIF 
     134 
     135         ! control print 
     136         IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' Initial DATE Y/M/D = ',   & 
     137               &                   nyear, '/', nmonth, '/', nday, '  rsec_day:', rsec_day 
     138 
     139         !                     ! -------------------------------- !  
     140      ELSE                     !  Model calendar at time-step kt  ! 
     141         !                     ! -------------------------------- !  
     142 
     143         rsec_year  = rsec_year  + rdttra(1)                 ! New time-step 
     144         rsec_month = rsec_month + rdttra(1)                 ! New time-step 
     145         rsec_day   = rsec_day   + rdttra(1)                 ! New time-step 
     146 
     147         adatrj    = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday 
     148 
     149         IF( rsec_day >= rday ) THEN 
     150            ! 
     151            rsec_day  = 0.e0                               ! NEW day 
     152            nday      = nday + 1 
     153            nday_year = nday_year + 1 
     154            ! 
     155            IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! NEW month 
     156               nday  = 1 
     157               rsec_month = 0.e0    
     158               nmonth = nmonth + 1 
     159               IF( nmonth == 13 ) THEN                     ! NEW year 
     160                  nyear     = nyear + 1 
     161                  nmonth    = 1 
     162                  nday_year = 1 
     163                  rsec_year = 0.e0 
     164                  !                                        ! update the length of the month 
     165                  IF( nleapy == 1 ) THEN                   ! of the current year (if necessary) 
     166                     IF( MOD( nyear, 4 ) == 0 ) THEN 
     167                        nmonth_len(1:12) = nbiss(:)              ! 366 days per year (leap year) 
     168                     ELSE 
     169                        nmonth_len(1:12) = nobis(:)              ! 365 days per year 
     170                     ENDIF 
     171                     ! half month in second since the bigining of the year 
     172                     rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len( 0 ) ) 
     173                     DO jm = 1, 12 
     174                        rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm) ) 
     175                     END DO 
     176                     rmonth_half(13) = rmonth_half( 1 ) + 365. * rday 
     177                     rmonth_half(14) = rmonth_half( 2 ) + 365. * rday 
     178                  ENDIF 
     179               ENDIF 
    96180            ENDIF 
    97          END DO 
    98  
    99       ENDIF 
    100  
    101       ! I.  calculates adatrj, zadatrjn, zadatrjb. 
    102       ! ------------------------------------------------------------------ 
    103  
    104       adatrj    = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday 
    105       zadatrjn  = adatrj0 + ( kt - nit000     ) * rdttra(1) / rday 
    106       zadatrjb  = adatrj0 + ( kt - nit000 - 1 ) * rdttra(1) / rday 
    107  
    108  
    109       ! II.  increment the date.  The date corresponds to 'now' variables (kt-1), 
    110       !      which is the time step of forcing fields.  
    111       !      Do not do this at nit000  unless nrstdt= 2 
    112       !      In that case ndastp (read in restart) was for step nit000-2 
    113       ! ------------------------------------------------------------------- 
    114  
    115       iday0 = INT( zadatrjb ) 
    116       iday1 = INT( zadatrjn ) 
    117  
    118       IF( iday1 - iday0 >= 1 .AND. ( kt /= nit000 .OR. nrstdt == 2 ) ) THEN 
    119  
    120          ! increase calendar 
    121          nyear  =   ndastp / 10000 
    122          nmonth = ( ndastp - (nyear * 10000) ) / 100 
    123          nday   =   ndastp - (nyear * 10000) - ( nmonth * 100 )  
    124          nday = nday + 1 
    125          IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    126             iend = nbiss(nmonth) 
    127          ELSEIF( nleapy > 1 ) THEN  
    128             iend = nleapy 
    129          ELSE  
    130             iend = nobis(nmonth) 
     181 
     182            ! 
     183            ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date 
     184            ! 
     185           IF(lwp) WRITE(numout,'(a,i8,a,i4,a,i2,a,i2,a,i3)') '======>> time-step =', kt,   & 
     186              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year 
     187           IF(lwp) WRITE(numout,'(a,F9.0,a,F9.0,a,F9.0)') '         rsec_year = ', rsec_year,   & 
     188              &   '   rsec_month = ', rsec_month, '   rsec_day = ', rsec_day 
    131189         ENDIF 
    132          IF( nday == iend + 1 ) THEN 
    133             nday  = 1 
    134             nmonth = nmonth + 1 
    135             IF( nmonth == 13 ) THEN 
    136                nmonth  = 1 
    137                nyear = nyear + 1 
    138             ENDIF 
     190 
     191         IF(ln_ctl) THEN 
     192            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
     193            CALL prt_ctl_info(charout) 
    139194         ENDIF 
    140          ndastp = nyear * 10000 + nmonth * 100 + nday 
    141  
    142          ! Calculates nday_year, day since january 1st (useful to read  daily forcing fields) 
    143          nday_year =  nday 
    144          !                                ! accumulates days of previous months of this year 
    145          DO js = 1, nmonth-1 
    146             IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    147                nday_year = nday_year + nbiss(js) 
    148             ELSE 
    149                nday_year = nday_year + nobis(js) 
    150             ENDIF 
    151          END DO 
    152  
    153          IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' New day, DATE= ',   & 
    154             &                   nyear, '/', nmonth, '/', nday, 'nday_year:', nday_year 
    155       ENDIF 
    156  
    157       IF(ln_ctl) THEN 
    158          WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    159          CALL prt_ctl_info(charout, itime=kt) 
     195         ! 
    160196      ENDIF 
    161197 

  • trunk/NEMO/OPA_SRC/eosbn2.F90

    r789 r888  
    55   !!                                               - Brunt-Vaisala frequency  
    66   !!============================================================================== 
     7   !! History :       !  89-03  (O. Marti)  Original code 
     8   !!            6.0  !  94-07  (G. Madec, M. Imbard)  add bn2 
     9   !!            6.0  !  94-08  (G. Madec)  Add Jackett & McDougall eos 
     10   !!            7.0  !  96-01  (G. Madec)  statement function for e3 
     11   !!            8.1  !  97-07  (G. Madec)  introduction of neos, OPA8.1 
     12   !!            8.1  !  97-07  (G. Madec)  density instead of volumic mass 
     13   !!                 !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient 
     14   !!                 !  01-09  (M. Ben Jelloul)  bugfix onlinear eos 
     15   !!            8.5  !  02-10  (G. Madec)  add eos_init 
     16   !!            8.5  !  02-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d 
     17   !!            9.0  !  03-08  (G. Madec)  F90, free form 
     18   !!            9.0  !  06-08  (G. Madec)  add tfreez function 
     19   !!---------------------------------------------------------------------- 
    720 
    821   !!---------------------------------------------------------------------- 
    … …  
    1326   !!   eos_insitu_2d  : Compute the in situ density for 2d fields 
    1427   !!   eos_bn2        : Compute the Brunt-Vaisala frequency 
     28   !!   tfreez         : Compute the surface freezing temperature 
    1529   !!   eos_init       : set eos parameters (namelist) 
    1630   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1831   USE dom_oce         ! ocean space and time domain 
    1932   USE phycst          ! physical constants 
    … …  
    3346   END INTERFACE  
    3447 
    35    !! * Routine accessibility 
    36    PUBLIC eos        ! called by step.F90, inidtr.F90, tranpc.F90 and intgrd.F90 
    37    PUBLIC bn2        ! called by step.F90 
    38    PUBLIC eos_init   ! called by step.F90 
    39  
    40    !! * Share module variables 
    41    INTEGER , PUBLIC ::   &  !: nameos : ocean physical parameters 
    42       neos      = 0,     &  !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    43       neos_init = 0         !: control flag for initialization 
    44  
    45    REAL(wp), PUBLIC ::   &  !: nameos : ocean physical parameters 
    46       ralpha = 2.0e-4,   &  !: thermal expension coeff. (linear equation of state) 
    47       rbeta  = 7.7e-4       !: saline  expension coeff. (linear equation of state) 
     48   PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules 
     49   PUBLIC   bn2        ! called by step module 
     50   PUBLIC   tfreez     ! called by sbcice_... modules 
     51 
     52   !!* Namelist (nameos) 
     53   INTEGER , PUBLIC ::   neos   = 0        !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
     54   REAL(wp), PUBLIC ::   ralpha = 2.0e-4   !: thermal expension coeff. (linear equation of state) 
     55   REAL(wp), PUBLIC ::   rbeta  = 7.7e-4   !: saline  expension coeff. (linear equation of state) 
     56   NAMELIST/nameos/ neos, ralpha, rbeta 
    4857    
     58   INTEGER ::   neos_init = 0         !: control flag for initialization 
     59 
    4960   !! * Substitutions 
    5061#  include "domzgr_substitute.h90" 
    5162#  include "vectopt_loop_substitute.h90" 
    5263   !!---------------------------------------------------------------------- 
    53    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    54    !! $Header$  
    55    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     64   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     65   !! $Id$ 
     66   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5667   !!---------------------------------------------------------------------- 
    5768 
    5869CONTAINS 
    5970 
    60    SUBROUTINE eos_insitu ( ptem, psal, prd ) 
     71   SUBROUTINE eos_insitu( ptem, psal, prd ) 
    6172      !!---------------------------------------------------------------------- 
    6273      !!                   ***  ROUTINE eos_insitu  *** 
    … …  
    92103      !! ** Action  :   compute prd , the in situ density (no units) 
    93104      !! 
    94       !! References : 
    95       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    96       !! 
    97       !! History : 
    98       !!        !  89-03 (o. Marti)  Original code 
    99       !!        ! 94-08 (G. Madec) 
    100       !!        !  96-01 (G. Madec) statement function for e3 
    101       !!        !  97-07 (G. Madec) introduction of neos, OPA8.1 
    102       !!        !  97-07 (G. Madec) density instead of volumic mass 
    103       !!        !  99-02 (G. Madec, N. Grima) semi-implicit pressure gradient 
    104       !!        !  01-09 (M. Ben Jelloul) bugfix    
    105       !!---------------------------------------------------------------------- 
    106       !! * Arguments 
    107       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    108          ptem,                 &  ! potential temperature 
    109          psal                     ! salinity 
    110       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    111          prd                      ! potential density (surface referenced) 
    112  
    113       !! * Local declarations 
     105      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     106      !!---------------------------------------------------------------------- 
     107      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     108      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu] 
     109      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density  
     110      !! 
    114111      INTEGER ::  ji, jj, jk      ! dummy loop indices 
    115112      REAL(wp) ::   &           
    … …  
    119116         zd , zc , zaw, za ,   &  !    "         " 
    120117         zb1, za1, zkw, zk0       !    "         " 
    121       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    122          zws                      ! temporary workspace 
    123       !!---------------------------------------------------------------------- 
    124  
    125  
    126       ! initialization (in not already done) 
    127       IF( neos_init == 0 ) CALL eos_init 
    128  
     118      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! temporary workspace 
     119      !!---------------------------------------------------------------------- 
     120 
     121      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    129122 
    130123      SELECT CASE ( neos ) 
    131  
     124      ! 
    132125      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    133  
     126         ! 
    134127!CDIR NOVERRCHK 
    135128         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) ) 
    136  
    137129         !                                                ! =============== 
    138130         DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    181173         END DO                                           !   End of slab 
    182174         !                                                ! =============== 
    183  
    184  
     175         ! 
    185176      CASE ( 1 )               ! Linear formulation function of temperature only 
    186  
     177         ! 
    187178         !                                                ! =============== 
    188179         DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    199190         END DO                                           !   End of slab 
    200191         !                                                ! =============== 
    201  
    202  
     192         ! 
    203193      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    204  
     194         ! 
    205195         !                                                ! =============== 
    206196         DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    217207         END DO                                           !   End of slab 
    218208         !                                                ! =============== 
    219  
     209         ! 
    220210      CASE DEFAULT 
    221  
     211         ! 
    222212         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    223213         CALL ctl_stop( ctmp1 ) 
    224  
     214         ! 
    225215      END SELECT 
    226  
    227       IF(ln_ctl)   THEN 
    228          CALL prt_ctl(tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk) 
    229       ENDIF 
    230  
     216      ! 
     217      IF(ln_ctl)   CALL prt_ctl(tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk) 
     218      ! 
    231219   END SUBROUTINE eos_insitu 
    232220 
    233221 
    234    SUBROUTINE eos_insitu_pot ( ptem, psal, prd, prhop) 
     222   SUBROUTINE eos_insitu_pot( ptem, psal, prd, prhop ) 
    235223      !!---------------------------------------------------------------------- 
    236224      !!                  ***  ROUTINE eos_insitu_pot  *** 
    … …  
    275263      !!              - prhop, the potential volumic mass (Kg/m3) 
    276264      !! 
    277       !! References : 
    278       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    279       !!      Brown, J. A. and K. A. Campana. Mon. Weather Rev., 1978 
    280       !! 
    281       !! History : 
    282       !!   4.0  !  89-03  (O. Marti) 
    283       !!        !  94-08  (G. Madec) 
    284       !!        !  96-01  (G. Madec) statement function for e3 
    285       !!        !  97-07  (G. Madec) introduction of neos, OPA8.1 
    286       !!        !  97-07  (G. Madec) density instead of volumic mass 
    287       !!        !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient 
    288       !!        !  01-09  (M. Ben Jelloul) bugfix    
    289       !!   9.0  !  03-08  (G. Madec)  F90, free form 
    290       !!---------------------------------------------------------------------- 
    291       !! * Arguments 
    292       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    293          ptem,   &  ! potential temperature 
    294          psal       ! salinity 
    295       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    296          prd,    &  ! potential density (surface referenced) 
    297          prhop      ! potential density (surface referenced) 
    298  
    299       !! * Local declarations 
     265      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     266      !!                Brown and Campana, Mon. Weather Rev., 1978 
     267      !!---------------------------------------------------------------------- 
     268      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     269      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu] 
     270      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density  
     271      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     272 
    300273      INTEGER  ::  ji, jj, jk                ! dummy loop indices 
    301274      REAL(wp) ::   &             ! temporary scalars 
    302275         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   & 
    303276         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0 
    304       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws 
    305       !!---------------------------------------------------------------------- 
    306  
    307       ! initialization (in not already done) 
    308       IF( neos_init == 0 ) CALL eos_init 
    309  
     277      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws 
     278      !!---------------------------------------------------------------------- 
     279 
     280      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    310281 
    311282      SELECT CASE ( neos ) 
    312  
     283      ! 
    313284      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    314  
     285         ! 
    315286!CDIR NOVERRCHK 
    316287         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) ) 
    317  
    318288         !                                                ! =============== 
    319289         DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    326296                  zh = fsdept(ji,jj,jk) 
    327297                  ! square root salinity 
    328 !!Edmee           zsr= SQRT( ABS( zs ) ) 
    329298                  zsr= zws(ji,jj,jk) 
    330299                  ! compute volumic mass pure water at atm pressure 
    … …  
    366335         END DO                                           !   End of slab 
    367336         !                                                ! =============== 
    368  
    369  
     337         ! 
    370338      CASE ( 1 )               ! Linear formulation function of temperature only 
    371  
     339         ! 
    372340         !                                                ! =============== 
    373341         DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    385353         END DO                                           !   End of slab 
    386354         !                                                ! =============== 
    387  
    388  
     355         ! 
    389356      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    390  
     357         ! 
    391358         !                                                ! =============== 
    392359         DO jk = 1, jpkm1                                 ! Horizontal slab 
    … …  
    404371         END DO                                           !   End of slab 
    405372         !                                                ! =============== 
    406  
     373         ! 
    407374      CASE DEFAULT 
    408  
     375         ! 
    409376         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    410377         CALL ctl_stop( ctmp1 ) 
    411  
     378         ! 
    412379      END SELECT 
    413  
    414       IF(ln_ctl)   THEN 
    415          CALL prt_ctl(tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk) 
    416       ENDIF 
    417  
     380      ! 
     381      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
     382      ! 
    418383   END SUBROUTINE eos_insitu_pot 
    419384 
    420    SUBROUTINE eos_insitu_2d ( ptem, psal, pdep, prd ) 
     385 
     386   SUBROUTINE eos_insitu_2d( ptem, psal, pdep, prd ) 
    421387      !!---------------------------------------------------------------------- 
    422388      !!                  ***  ROUTINE eos_insitu_2d  *** 
    … …  
    452418      !! ** Action  : - prd , the in situ density (no units) 
    453419      !! 
    454       !! References : 
    455       !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 
    456       !! 
    457       !! History : 
    458       !!   8.5  !  02-11  (G. Madec, A. Bozec)  partial step 
    459       !!---------------------------------------------------------------------- 
    460       !! * Arguments 
    461       REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::   & 
    462          ptem,                           &  ! potential temperature 
    463          psal,                           &  ! salinity 
    464          pdep                               ! depth 
    465       REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   & 
    466          prd                                ! potential density (surface referenced) 
    467  
    468       !! * Local declarations 
    469       INTEGER ::  ji, jj                    ! dummy loop indices 
     420      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
     421      !!---------------------------------------------------------------------- 
     422      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius] 
     423      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity               [psu] 
     424      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pdep   ! depth                  [m] 
     425      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prd    ! in situ density  
     426      !! 
     427      INTEGER  ::  ji, jj                    ! dummy loop indices 
    470428      REAL(wp) ::   &             ! temporary scalars 
    471429         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   & 
    472430         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0,               & 
    473431         zmask 
    474       REAL(wp), DIMENSION(jpi,jpj) :: zws 
    475       !!---------------------------------------------------------------------- 
    476  
    477  
    478       ! initialization (in not already done) 
    479       IF( neos_init == 0 ) CALL eos_init 
     432      REAL(wp), DIMENSION(jpi,jpj) ::   zws 
     433      !!---------------------------------------------------------------------- 
     434 
     435      IF( neos_init == 0 ) CALL eos_init      ! initialization (in not already done) 
    480436 
    481437      prd(:,:) = 0.e0 
    482438 
    483439      SELECT CASE ( neos ) 
    484  
     440      ! 
    485441      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    486  
     442      ! 
    487443!CDIR NOVERRCHK 
    488444         DO jj = 1, jpjm1 
    … …  
    492448            END DO 
    493449         END DO 
    494  
    495450         !                                                ! =============== 
    496451         DO jj = 1, jpjm1                                 ! Horizontal slab 
    497452            !                                             ! =============== 
    498453            DO ji = 1, fs_jpim1   ! vector opt. 
    499  
    500454               zmask = tmask(ji,jj,1)      ! land/sea bottom mask = surf. mask 
    501455 
    … …  
    535489               ! masked in situ density anomaly 
    536490               prd(ji,jj) = ( zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 )   & 
    537                           / rau0 * zmask 
    538             END DO 
    539             !                                             ! =============== 
    540          END DO                                           !   End of slab 
    541          !                                                ! =============== 
    542  
    543  
     491                  &       / rau0 * zmask 
     492            END DO 
     493            !                                             ! =============== 
     494         END DO                                           !   End of slab 
     495         !                                                ! =============== 
     496         ! 
    544497      CASE ( 1 )               ! Linear formulation function of temperature only 
    545  
     498         ! 
    546499         !                                                ! =============== 
    547500         DO jj = 1, jpjm1                                 ! Horizontal slab 
    … …  
    553506         END DO                                           !   End of slab 
    554507         !                                                ! =============== 
    555  
    556  
     508         ! 
    557509      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    558  
     510         ! 
    559511         !                                                ! =============== 
    560512         DO jj = 1, jpjm1                                 ! Horizontal slab 
    … …  
    566518         END DO                                           !   End of slab 
    567519         !                                                ! =============== 
    568  
     520         ! 
    569521      CASE DEFAULT 
    570  
     522         ! 
    571523         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    572524         CALL ctl_stop( ctmp1 ) 
    573  
     525         ! 
    574526      END SELECT 
    575527 
    576       IF(ln_ctl)   CALL prt_ctl(tab2d_1=prd, clinfo1=' eos2d: ') 
    577  
     528      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
     529      ! 
    578530   END SUBROUTINE eos_insitu_2d 
    579531 
    … …  
    607559      !! ** Action  : - pn2 : the brunt-vaisala frequency 
    608560      !! 
    609       !! References : 
    610       !!      McDougall, T. J., J. Phys. Oceanogr., 17, 1950-1964, 1987. 
    611       !! 
    612       !! History : 
    613       !!   6.0  !  94-07  (G. Madec, M. Imbard)  Original code 
    614       !!   8.0  !  97-07  (G. Madec) introduction of statement functions 
    615       !!   8.5  !  02-07  (G. Madec) Free form, F90 
    616       !!   8.5  !  02-08  (G. Madec) introduction of arguments 
    617       !!---------------------------------------------------------------------- 
    618       !! * Arguments 
    619       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    620          ptem,                           &  ! potential temperature 
    621          psal                               ! salinity 
    622       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    623          pn2                               ! Brunt-Vaisala frequency 
    624  
    625       !! * Local declarations 
     561      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 
     562      !!---------------------------------------------------------------------- 
     563      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature   [Celcius] 
     564      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity                [psu] 
     565      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1] 
     566 
    626567      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    627       REAL(wp) ::   & 
    628          zgde3w, zt, zs, zh,  &  ! temporary scalars  
    629          zalbet, zbeta           !    "         " 
     568      REAL(wp) ::   zgde3w, zt, zs, zh,  &  ! temporary scalars  
     569         &          zalbet, zbeta           !    "         " 
    630570#if defined key_zdfddm 
    631571      REAL(wp) ::   zds          ! temporary scalars 
    632572#endif 
    633573      !!---------------------------------------------------------------------- 
    634       !!  OPA8.5, LODYC-IPSL (2002) 
    635       !!---------------------------------------------------------------------- 
    636574 
    637575      ! pn2 : first and last levels 
    … …  
    644582 
    645583      SELECT CASE ( neos ) 
    646  
     584      ! 
    647585      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    648  
     586         ! 
    649587         !                                                ! =============== 
    650588         DO jk = 2, jpkm1                                 ! Horizontal slab 
    … …  
    696634         END DO                                           !   End of slab 
    697635         !                                                ! =============== 
    698  
    699  
     636         ! 
    700637      CASE ( 1 )               ! Linear formulation function of temperature only 
    701  
     638         ! 
    702639         !                                                ! =============== 
    703640         DO jk = 2, jpkm1                                 ! Horizontal slab 
    … …  
    712649         END DO                                           !   End of slab 
    713650         !                                                ! =============== 
    714  
    715  
     651         ! 
    716652      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    717  
     653         ! 
    718654         !                                                ! =============== 
    719655         DO jk = 2, jpkm1                                 ! Horizontal slab 
    … …  
    740676         END DO                                           !   End of slab 
    741677         !                                                ! =============== 
    742  
     678         ! 
    743679      CASE DEFAULT 
    744  
     680         ! 
    745681         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    746682         CALL ctl_stop( ctmp1 ) 
    747  
     683         ! 
    748684      END SELECT 
    749685 
    750       IF(ln_ctl)   THEN 
    751          CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk) 
     686      IF(ln_ctl)   CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk) 
    752687#if defined key_zdfddm 
    753          CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk) 
     688      IF(ln_ctl)   CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk) 
    754689#endif 
    755       ENDIF 
    756  
     690      ! 
    757691   END SUBROUTINE eos_bn2 
    758692 
    759693 
     694   FUNCTION tfreez( psal ) RESULT( ptf ) 
     695      !!---------------------------------------------------------------------- 
     696      !!                 ***  ROUTINE eos_init  *** 
     697      !! 
     698      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius] 
     699      !! 
     700      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???) 
     701      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p 
     702      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars 
     703      !! 
     704      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
     705      !!---------------------------------------------------------------------- 
     706      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu] 
     707      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius] 
     708      !!---------------------------------------------------------------------- 
     709      ptf(:,:) = ( - 0.0575 + 1.710523e-3 * SQRT( psal(:,:) )   & 
     710         &                  - 2.154996e-4 *       psal(:,:)   ) * psal(:,:) 
     711   END FUNCTION tfreez 
     712 
     713 
    760714   SUBROUTINE eos_init 
    761715      !!---------------------------------------------------------------------- 
    … …  
    764718      !! ** Purpose :   initializations for the equation of state 
    765719      !! 
    766       !! ** Method  :   Read the namelist nameos 
    767       !! 
    768       !! ** Action  :   blahblah.... 
    769       !! 
    770       !! History : 
    771       !!   8.5  !  02-10  (G. Madec)  Original code 
    772       !!---------------------------------------------------------------------- 
    773       NAMELIST/nameos/ neos, ralpha, rbeta 
    774       !!---------------------------------------------------------------------- 
    775       !!  OPA 8.5, LODYC-IPSL (2002) 
    776       !!---------------------------------------------------------------------- 
    777  
    778       ! set the initialization flag to 1 
    779       neos_init = 1           ! indicate that the initialization has been done 
    780  
    781       ! namelist nameos : ocean physical parameters 
    782  
    783       ! Read Namelist nameos : equation of state 
    784       REWIND( numnam ) 
     720      !! ** Method  :   Read the namelist nameos and control the parameters 
     721      !!---------------------------------------------------------------------- 
     722 
     723      neos_init = 1               ! indicate that the initialization has been done 
     724 
     725      REWIND( numnam )            ! Read Namelist nameos : equation of state 
    785726      READ  ( numnam, nameos ) 
    786727 
    … …  
    791732         WRITE(numout,*) '~~~~~~~~' 
    792733         WRITE(numout,*) '          Namelist nameos : set eos parameters' 
    793          WRITE(numout,*) 
    794734         WRITE(numout,*) '             flag for eq. of state and N^2  neos   = ', neos 
    795735         WRITE(numout,*) '             thermal exp. coef. (linear)    ralpha = ', ralpha 
    796736         WRITE(numout,*) '             saline  exp. coef. (linear)    rbeta  = ', rbeta 
    797          WRITE(numout,*) 
    798737      ENDIF 
    799738 
    … …  
    801740 
    802741      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    803  
     742         IF(lwp) WRITE(numout,*) 
    804743         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and' 
    805744         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency' 
    806  
     745         ! 
    807746      CASE ( 1 )               ! Linear formulation function of temperature only 
    808  
     747         IF(lwp) WRITE(numout,*) 
    809748         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )' 
    810749         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   & 
    811750              &                         ' that T and S are used as state variables' ) 
    812  
     751         ! 
    813752      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    814  
     753         IF(lwp) WRITE(numout,*) 
    815754         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    816  
    817       CASE DEFAULT 
    818  
     755         ! 
     756      CASE DEFAULT             ! E R R O R in neos  
    819757         WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    820758         CALL ctl_stop( ctmp1 ) 
    821  
    822759      END SELECT 
    823760 

  • trunk/NEMO/OPA_SRC/ice_oce.F90

    r833 r888  
    88   !!---------------------------------------------------------------------- 
    99   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    10    !! $Header$  
     10   !! $Id$ 
    1111   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_lim2 || defined key_lim3 
     13#if defined key_lim3 || defined key_lim2 
    1414   !!---------------------------------------------------------------------- 
    15    !!   'key_lim2 or key_lim3 '   :             LIM 2.0 or 3.0 ice model 
     15   !!   'key_lim2' or 'key_lim3'   :               LIM 2.0 or 3.0 ice model 
    1616   !!---------------------------------------------------------------------- 
    1717   !! * Modules used 
    1818   USE par_oce         ! ocean parameters 
    19    USE blk_oce         ! bulk parameters 
    2019 
    2120   IMPLICIT NONE 
    … …  
    4746# endif 
    4847 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: field exchanges with ice model to ocean 
    50       sst_io, sss_io , &  !: sea surface temperature (C) and salinity (PSU) 
    51       u_io  , v_io   , &  !: velocity at ice surface (m/s) 
    52       fsolar, fnsolar, &  !: solar and non-solar heat fluxes (W/m2) 
    53       fsalt , fmass  , &  !: salt and freshwater fluxes 
    54       ftaux , ftauy  , &  !: wind stresses 
    55       gtaux , gtauy       !: wind stresses 
    56  
    5748# if defined key_lim3 
    5849   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: field exchanges with ice model to ocean 
    … …  
    6859#else 
    6960   !!---------------------------------------------------------------------- 
    70    !!   Default option                                 NO LIM sea-ice model 
     61   !!   Default option                      NO LIM 2.0 or 3.0 sea-ice model 
    7162   !!---------------------------------------------------------------------- 
    7263   LOGICAL, PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.  !: No LIM 2.0 ice model 
    … …  
    7465#endif 
    7566 
    76    INTEGER, PUBLIC ::   &  !: namdom : space/time domain (namlist) 
    77       nfice =  5           !: coupling frequency OPA ICELLN  nfice  
    78  
    7967   !!---------------------------------------------------------------------- 
    8068END MODULE ice_oce 

  • trunk/NEMO/OPA_SRC/istate.F90

    r719 r888  
    5555   !!---------------------------------------------------------------------- 
    5656   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    57    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/istate.F90,v 1.20 2007/06/06 20:25:36 opalod Exp $  
     57   !! $Id$ 
    5858   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5959   !!---------------------------------------------------------------------- 
    … …  
    8181         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog) 
    8282         CALL rst_read                           ! Read the restart file 
     83         CALL day( -1 )                          ! model calendar (using both namelist and restart infos) 
    8384      ELSE 
    8485         !                                    ! Start from rest 
    … …  
    8687         neuler = 0                              ! Set time-step indicator at nit000 (euler forward) 
    8788         adatrj = 0._wp 
     89         CALL day( -1 )                          ! model calendar (using namelist infos) 
    8890         numror = 0                              ! define numror = 0 -> no restart file to read 
    8991         !                                       ! Initialization of ocean to zero 

  • trunk/NEMO/OPA_SRC/lbclnk.F90

    r869 r888  
    9393      !!---------------------------------------------------------------------- 
    9494      !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    95       !! $Header$  
     95      !! $Id$ 
    9696      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    9797      !!---------------------------------------------------------------------- 
    … …  
    329329 
    330330 
    331    SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp ) 
     331   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
    332332      !!--------------------------------------------------------------------- 
    333333      !!                  ***  ROUTINE lbc_lnk_3d  *** 
    … …  
    355355      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
    356356         cd_mpp        ! fill the overlap area only (here do nothing) 
     357      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries) 
    357358 
    358359      !! * Local declarations 
    359360      INTEGER  ::   ji, jk 
    360361      INTEGER  ::   ijt, iju 
     362      REAL(wp) ::   zland 
    361363      !!---------------------------------------------------------------------- 
    362364      !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    363       !! $Header$  
     365      !! $Id$ 
    364366      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    365367      !!---------------------------------------------------------------------- 
    366368 
    367       IF (PRESENT(cd_mpp)) THEN 
     369      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default) 
     370         zland = pval 
     371      ELSE 
     372         zland = 0.e0 
     373      ENDIF 
     374 
     375 
     376      IF( PRESENT( cd_mpp ) ) THEN 
    368377         ! only fill the overlap area and extra allows  
    369378         ! this is in mpp case. In this module, just do nothing 
    … …  
    385394            SELECT CASE ( cd_type ) 
    386395            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    387                pt3d( 1 ,:,jk) = 0.e0 
    388                pt3d(jpi,:,jk) = 0.e0 
    389             CASE ( 'F' )                               ! F-point 
    390                pt3d(jpi,:,jk) = 0.e0 
     396               pt3d( 1 ,:,jk) = zland 
     397               pt3d(jpi,:,jk) = zland 
     398            CASE ( 'F' )                               ! F-point 
     399               pt3d(jpi,:,jk) = zland 
    391400            END SELECT 
    392401 
    … …  
    402411            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points 
    403412               pt3d(:, 1 ,jk) = pt3d(:,3,jk) 
    404                pt3d(:,jpj,jk) = 0.e0 
     413               pt3d(:,jpj,jk) = zland 
    405414            CASE ( 'V' , 'F' )                         ! V-, F-points 
    406415               pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk) 
    407                pt3d(:,jpj,jk) = 0.e0 
     416               pt3d(:,jpj,jk) = zland 
    408417            END SELECT 
    409418 
    410419         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot 
    411420 
    412 !            pt3d( 1 ,jpj,jk) = 0.e0 
    413 !            pt3d(jpi,jpj,jk) = 0.e0 
     421            pt3d( 1 ,jpj,jk) = zland 
     422            pt3d(jpi,jpj,jk) = zland 
    414423 
    415424            SELECT CASE ( cd_type ) 
    … …  
    417426               DO ji = 2, jpi 
    418427                  ijt = jpi-ji+2 
    419                   pt3d(ji, 1 ,jk) = 0.e0 
     428                  pt3d(ji, 1 ,jk) = zland 
    420429                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 
    421430               END DO 
    … …  
    427436               DO ji = 1, jpi-1 
    428437                  iju = jpi-ji+1 
    429                   pt3d(ji, 1 ,jk) = 0.e0 
     438                  pt3d(ji, 1 ,jk) = zland 
    430439                  pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk) 
    431440               END DO 
    … …  
    437446                  DO ji = 2, jpi 
    438447                     ijt = jpi-ji+2 
    439                      pt3d(ji,  1  ,jk) = 0.e0 
     448                     pt3d(ji,  1  ,jk) = zland 
    440449                     pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk) 
    441450                     pt3d(ji,jpj  ,jk) = psgn * pt3d(ijt,jpj-3,jk) 
    … …  
    451460         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot 
    452461 
    453             pt3d( 1 ,jpj,jk) = 0.e0 
    454             pt3d(jpi,jpj,jk) = 0.e0 
     462            pt3d( 1 ,jpj,jk) = zland 
     463            pt3d(jpi,jpj,jk) = zland 
    455464 
    456465            SELECT CASE ( cd_type ) 
    … …  
    458467               DO ji = 1, jpi 
    459468                  ijt = jpi-ji+1 
    460                   pt3d(ji, 1 ,jk) = 0.e0 
     469                  pt3d(ji, 1 ,jk) = zland 
    461470                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk) 
    462471               END DO 
    … …  
    464473                  DO ji = 1, jpi-1 
    465474                     iju = jpi-ji 
    466                      pt3d(ji, 1 ,jk) = 0.e0 
     475                     pt3d(ji, 1 ,jk) = zland 
    467476                     pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk) 
    468477                  END DO 
    … …  
    470479                  DO ji = 1, jpi 
    471480                     ijt = jpi-ji+1 
    472                      pt3d(ji, 1 ,jk) = 0.e0 
     481                     pt3d(ji, 1 ,jk) = zland 
    473482                     pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 
    474483                  END DO 
    … …  
    492501            SELECT CASE ( cd_type ) 
    493502            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    494                pt3d(:, 1 ,jk) = 0.e0 
    495                pt3d(:,jpj,jk) = 0.e0 
    496             CASE ( 'F' )                               ! F-point 
    497                pt3d(:,jpj,jk) = 0.e0 
     503               pt3d(:, 1 ,jk) = zland 
     504               pt3d(:,jpj,jk) = zland 
     505            CASE ( 'F' )                               ! F-point 
     506               pt3d(:,jpj,jk) = zland 
    498507            END SELECT 
    499508 
    … …  
    506515 
    507516 
    508    SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp ) 
     517   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    509518      !!--------------------------------------------------------------------- 
    510519      !!                 ***  ROUTINE lbc_lnk_2d  *** 
    … …  
    532541      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
    533542         cd_mpp        ! fill the overlap area only (here do nothing) 
     543      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries) 
    534544 
    535545      !! * Local declarations 
    536546      INTEGER  ::   ji 
    537547      INTEGER  ::   ijt, iju 
     548      REAL(wp) ::   zland 
    538549      !!---------------------------------------------------------------------- 
    539       !!  OPA 8.5, LODYC-IPSL (2002) 
    540       !!---------------------------------------------------------------------- 
     550 
     551      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default) 
     552         zland = pval 
     553      ELSE 
     554         zland = 0.e0 
     555      ENDIF 
    541556 
    542557      IF (PRESENT(cd_mpp)) THEN 
    … …  
    556571         SELECT CASE ( cd_type ) 
    557572         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points 
    558             pt2d( 1 ,:) = 0.e0 
    559             pt2d(jpi,:) = 0.e0 
     573            pt2d( 1 ,:) = zland 
     574            pt2d(jpi,:) = zland 
    560575         CASE ( 'F' )                                  ! F-point, ice U-V point 
    561             pt2d(jpi,:) = 0.e0  
     576            pt2d(jpi,:) = zland 
    562577         CASE ( 'I' )                                  ! F-point, ice U-V point 
    563             pt2d( 1 ,:) = 0.e0  
    564             pt2d(jpi,:) = 0.e0  
     578            pt2d( 1 ,:) = zland 
     579            pt2d(jpi,:) = zland 
    565580         END SELECT 
    566581 
    … …  
    576591         CASE ( 'T' , 'U' , 'W' )                      ! T-, U-, W-points 
    577592            pt2d(:, 1 ) = pt2d(:,3) 
    578             pt2d(:,jpj) = 0.e0 
     593            pt2d(:,jpj) = zland 
    579594         CASE ( 'V' , 'F' , 'I' )                      ! V-, F-points, ice U-V point 
    580595            pt2d(:, 1 ) = psgn * pt2d(:,2) 
    581             pt2d(:,jpj) = 0.e0 
     596            pt2d(:,jpj) = zland 
    582597         END SELECT 
    583598 
    584599      CASE ( 3 , 4 )                           ! * North fold  T-point pivot 
    585600 
    586 !         pt2d( 1 , 1 ) = 0.e0        !!!!!  bug gm ??? !Edmee 
    587 !         pt2d( 1 ,jpj) = 0.e0 
    588 !         pt2d(jpi,jpj) = 0.e0 
     601         pt2d( 1 , 1 ) = zland       !!!!!  bug gm ??? !Edmee 
     602         pt2d( 1 ,jpj) = zland 
     603         pt2d(jpi,jpj) = zland 
    589604 
    590605         SELECT CASE ( cd_type ) 
    … …  
    593608            DO ji = 2, jpi 
    594609               ijt = jpi-ji+2 
    595                pt2d(ji, 1 ) = 0.e0 
     610               pt2d(ji, 1 ) = zland 
    596611               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2) 
    597612            END DO 
    … …  
    604619            DO ji = 1, jpi-1 
    605620               iju = jpi-ji+1 
    606                pt2d(ji, 1 ) = 0.e0 
     621               pt2d(ji, 1 ) = zland 
    607622               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2) 
    608623            END DO 
    … …  
    615630            DO ji = 2, jpi 
    616631               ijt = jpi-ji+2 
    617                pt2d(ji, 1   ) = 0.e0 
     632               pt2d(ji, 1   ) = zland 
    618633               pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2) 
    619634               pt2d(ji,jpj  ) = psgn * pt2d(ijt,jpj-3) 
    … …  
    628643 
    629644         CASE ( 'I' )                                  ! ice U-V point 
    630             pt2d(:, 1 ) = 0.e0 
     645            pt2d(:, 1 ) = zland 
    631646            pt2d(2,jpj) = psgn * pt2d(3,jpj-1) 
    632647            DO ji = 3, jpi 
    … …  
    639654      CASE ( 5 , 6 )                           ! * North fold  F-point pivot 
    640655 
    641          pt2d( 1 , 1 ) = 0.e0           !!bug  ??? 
    642          pt2d( 1 ,jpj) = 0.e0 
    643          pt2d(jpi,jpj) = 0.e0 
     656         pt2d( 1 , 1 ) = zland          !!bug  ??? 
     657         pt2d( 1 ,jpj) = zland 
     658         pt2d(jpi,jpj) = zland 
    644659 
    645660         SELECT CASE ( cd_type ) 
    … …  
    648663            DO ji = 1, jpi 
    649664               ijt = jpi-ji+1 
    650                pt2d(ji, 1 ) = 0.e0 
     665               pt2d(ji, 1 ) = zland 
    651666               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1) 
    652667            END DO 
    … …  
    655670            DO ji = 1, jpi-1 
    656671               iju = jpi-ji 
    657                pt2d(ji, 1 ) = 0.e0 
     672               pt2d(ji, 1 ) = zland 
    658673               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1) 
    659674            END DO 
    … …  
    662677            DO ji = 1, jpi 
    663678               ijt = jpi-ji+1 
    664                pt2d(ji, 1 ) = 0.e0 
     679               pt2d(ji, 1 ) = zland 
    665680               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2) 
    666681            END DO 
    … …  
    681696 
    682697         CASE ( 'I' )                                  ! ice U-V point 
    683             pt2d( : , 1 ) = 0.e0 
    684             pt2d( 2 ,jpj) = 0.e0 
     698            pt2d( : , 1 ) = zland 
     699            pt2d( 2 ,jpj) = zland 
    685700            DO ji = 2 , jpim1 
    686701               ijt = jpi - ji + 2 
    … …  
    694709         SELECT CASE ( cd_type ) 
    695710         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points 
    696             pt2d(:, 1 ) = 0.e0 
    697             pt2d(:,jpj) = 0.e0 
     711            pt2d(:, 1 ) = zland 
     712            pt2d(:,jpj) = zland 
    698713         CASE ( 'F' )                                  ! F-point 
    699             pt2d(:,jpj) = 0.e0 
     714            pt2d(:,jpj) = zland 
    700715         CASE ( 'I' )                                  ! ice U-V point 
    701             pt2d(:, 1 ) = 0.e0 
    702             pt2d(:,jpj) = 0.e0 
     716            pt2d(:, 1 ) = zland 
     717            pt2d(:,jpj) = zland 
    703718         END SELECT 
    704719 

  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r869 r888  
    4848   !!---------------------------------------------------------------------- 
    4949   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    50    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/lib_mpp.F90,v 1.21 2007/06/05 10:28:55 opalod Exp $  
     50   !! $Id$ 
    5151   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5252   !!--------------------------------------------------------------------- 
    … …  
    278278   !!---------------------------------------------------------------------- 
    279279   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    280    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/lib_mpp.F90,v 1.21 2007/06/05 10:28:55 opalod Exp $  
     280   !! $Id$ 
    281281   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    282282   !!--------------------------------------------------------------------- 
    … …  
    605605#endif 
    606606 
    607    SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp ) 
     607   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
    608608      !!---------------------------------------------------------------------- 
    609609      !!                  ***  routine mpp_lnk_3d  *** 
    … …  
    640640      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
    641641         cd_mpp        ! fill the overlap area only  
     642      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries) 
    642643 
    643644      !! * Local variables 
    … …  
    646647      INTEGER ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend 
    647648      INTEGER ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend 
     649      REAL(wp) ::   zland 
    648650      !!---------------------------------------------------------------------- 
    649651 
    650652      ! 1. standard boundary treatment 
    651653      ! ------------------------------ 
     654 
     655      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default) 
     656         zland = pval 
     657      ELSE 
     658         zland = 0.e0 
     659      ENDIF 
    652660 
    653661      IF( PRESENT( cd_mpp ) ) THEN 
    … …  
    670678            SELECT CASE ( cd_type ) 
    671679            CASE ( 'T', 'U', 'V', 'W' ) 
    672                ptab(     1       :jpreci,:,:) = 0.e0 
    673                ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     680               ptab(     1       :jpreci,:,:) = zland 
     681               ptab(nlci-jpreci+1:jpi   ,:,:) = zland 
    674682            CASE ( 'F' ) 
    675                ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
     683               ptab(nlci-jpreci+1:jpi   ,:,:) = zland 
    676684            END SELECT  
    677685         ENDIF 
    … …  
    681689         SELECT CASE ( cd_type ) 
    682690         CASE ( 'T', 'U', 'V', 'W' ) 
    683             ptab(:,     1       :jprecj,:) = 0.e0 
    684             ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
     691            ptab(:,     1       :jprecj,:) = zland 
     692            ptab(:,nlcj-jprecj+1:jpj   ,:) = zland 
    685693         CASE ( 'F' ) 
    686             ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
     694            ptab(:,nlcj-jprecj+1:jpj   ,:) = zland 
    687695         END SELECT 
    688696      
    … …  
    10581066 
    10591067 
    1060    SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp ) 
     1068   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    10611069      !!---------------------------------------------------------------------- 
    10621070      !!                  ***  routine mpp_lnk_2d  *** 
    … …  
    10921100      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    & 
    10931101         cd_mpp        ! fill the overlap area only  
     1102      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries) 
    10941103 
    10951104      !! * Local variables 
    … …  
    11001109      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend 
    11011110      INTEGER  ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend 
     1111      REAL(wp) ::   zland 
    11021112      !!---------------------------------------------------------------------- 
     1113 
     1114      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default) 
     1115         zland = pval 
     1116      ELSE 
     1117         zland = 0.e0 
     1118      ENDIF 
    11031119 
    11041120      ! 1. standard boundary treatment 
    … …  
    11231139            SELECT CASE ( cd_type ) 
    11241140            CASE ( 'T', 'U', 'V', 'W' , 'I' ) 
    1125                pt2d(     1       :jpreci,:) = 0.e0 
    1126                pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0 
     1141               pt2d(     1       :jpreci,:) = zland 
     1142               pt2d(nlci-jpreci+1:jpi   ,:) = zland 
    11271143            CASE ( 'F' ) 
    1128                pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0 
     1144               pt2d(nlci-jpreci+1:jpi   ,:) = zland 
    11291145            END SELECT 
    11301146         ENDIF 
    … …  
    11341150         SELECT CASE ( cd_type ) 
    11351151         CASE ( 'T', 'U', 'V', 'W' , 'I' ) 
    1136             pt2d(:,     1       :jprecj) = 0.e0 
    1137             pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0 
     1152            pt2d(:,     1       :jprecj) = zland 
     1153            pt2d(:,nlcj-jprecj+1:jpj   ) = zland 
    11381154         CASE ( 'F' ) 
    1139             pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0 
     1155            pt2d(:,nlcj-jprecj+1:jpj   ) = zland 
    11401156         END SELECT 
    11411157 
    … …  
    14021418   
    14031419            CASE ( 'I' )                                  ! ice U-V point 
    1404                pt2d( 2 ,nlcj) = 0.e0 
     1420               pt2d( 2 ,nlcj) = zland 
    14051421               DO ji = 2 , nlci-1 
    14061422                  ijt = iloc - ji + 2 
    … …  
    30873103      INTEGER , INTENT( in  )                  ::   kdim        ! size of array 
    30883104      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array 
    3089       INTEGER , INTENT(in), OPTIONAL         ::   kcom   
     3105      INTEGER , INTENT(in)   , OPTIONAL        ::   kcom   
    30903106   
    30913107#if defined key_mpp_shmem 
    … …  
    31973213      INTEGER , INTENT( in  )                  ::   kdim        ! size of array 
    31983214      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array 
    3199       INTEGER , INTENT(in), OPTIONAL        ::   kcom        ! input array 
     3215      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array 
    32003216   
    32013217#if defined key_mpp_shmem 
    … …  
    35383554    INTEGER , INTENT( in  )                  ::   kdim 
    35393555    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab 
    3540     INTEGER , INTENT( in  ), OPTIONAL     ::   kcom 
     3556    INTEGER , INTENT( in  ), OPTIONAL        ::   kcom 
    35413557 
    35423558#if defined key_mpp_shmem 
    … …  
    35953611    !! * Arguments 
    35963612    REAL(wp), INTENT(inout) ::   ptab      ! ??? 
    3597     INTEGER, INTENT(in), OPTIONAL ::   kcom      ! ??? 
     3613    INTEGER , INTENT( in  ), OPTIONAL ::   kcom      ! ??? 
    35983614 
    35993615#if defined key_mpp_shmem 
    … …  
    37033719    !! * Arguments 
    37043720    REAL(wp), INTENT( inout ) ::   ptab        !  
    3705     INTEGER,INTENT(in), OPTIONAL :: kcom 
     3721    INTEGER , INTENT(  in   ), OPTIONAL :: kcom 
    37063722 
    37073723#if defined key_mpp_shmem 
    … …  
    37533769    INTEGER , INTENT( in )                     ::   kdim      ! size of ptab 
    37543770    REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array 
    3755     INTEGER, INTENT(in), OPTIONAL :: kcom 
     3771    INTEGER , INTENT( in ), OPTIONAL          :: kcom 
    37563772 
    37573773#if defined key_mpp_shmem 
    … …  
    38113827    !!----------------------------------------------------------------------- 
    38123828    REAL(wp), INTENT(inout) ::   ptab        ! input scalar 
    3813     INTEGER, INTENT(in), OPTIONAL :: kcom 
     3829    INTEGER , INTENT( in  ), OPTIONAL :: kcom 
    38143830 
    38153831#if defined key_mpp_shmem 
    … …  
    54545470      INTEGER               :: kdim 
    54555471      INTEGER, OPTIONAL     :: kcom  
    5456       WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1) 
     5472      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom 
    54575473   END SUBROUTINE mppmax_a_int 
    54585474 
    … …  
    55685584   END SUBROUTINE mppstop 
    55695585 
    5570    SUBROUTINE mpp_ini_lim 
    5571       WRITE(*,*) 'mpp_ini_north: You should not have seen this print! error?' 
    5572    END SUBROUTINE mpp_ini_lim 
     5586   SUBROUTINE mpp_ini_ice(kcom) 
     5587      INTEGER :: kcom 
     5588      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?',kcom 
     5589   END SUBROUTINE mpp_ini_ice 
    55735590 
    55745591   SUBROUTINE mpp_comm_free(kcom) 
    55755592      INTEGER :: kcom 
    5576       WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?' 
     5593      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?',kcom 
    55775594   END SUBROUTINE mpp_comm_free 
    55785595 

  • trunk/NEMO/OPA_SRC/opa.F90

    r833 r888  
    3636   !!---------------------------------------------------------------------- 
    3737   !! * Modules used 
     38   USE oce             ! dynamics and tracers variables 
    3839   USE cpl_oce         ! ocean-atmosphere-sea ice coupled exchanges 
    3940   USE dom_oce         ! ocean space domain variables 
    40    USE oce             ! dynamics and tracers variables 
     41   USE sbc_oce         ! surface boundary condition: ocean 
    4142   USE trdmod_oce      ! ocean variables trends 
    4243   USE daymod          ! calendar 
    … …  
    5960 
    6061   USE phycst          ! physical constant                  (par_cst routine) 
    61 #if defined key_lim3 
    62    USE iceini          ! initialization of sea-ice         (ice_init routine) 
    63 #endif 
    64 #if defined key_lim2 
    65    USE iceini_2        ! initialization of sea-ice         (ice_init_2 routine) 
    66 #endif 
    67    USE cpl             ! coupled ocean/atmos.              (cpl_init routine) 
    6862   USE ocfzpt          ! ocean freezing point              (oc_fz_pt routine) 
    6963   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine) 
    70    USE flxfwb          ! freshwater budget correction  (flx_fwb_init routine) 
    71    USE flxmod          ! thermohaline forcing of the ocean (flx_init routine) 
    7264 
    7365   USE diaptr          ! poleward transports           (dia_ptr_init routine) 
    … …  
    9991   !!---------------------------------------------------------------------- 
    10092   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    101    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/opa.F90,v 1.38 2007/06/05 10:32:02 opalod Exp $  
     93   !! $Id$ 
    10294   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    10395   !!---------------------------------------------------------------------- 
    … …  
    281273      IF( lk_obc    )   CALL obc_init       ! Open boundaries  
    282274 
    283       CALL day( nit000 )                    ! Calendar 
    284  
    285275      CALL istate_init                      ! ocean initial state (Dynamics and tracers) 
    286276 
    287277      CALL oc_fz_pt                         ! Surface freezing point 
    288  
    289 #if defined key_lim3 
    290       CALL ice_init                         ! Sea ice model LIM3 
    291 #endif 
    292  
    293 #if defined key_lim2 
    294       CALL ice_init_2                       ! Sea ice model LIM2 
    295 #endif 
    296278 
    297279      !                                     ! Ocean physics 
    … …  
    319301      CALL cpl_prism_define 
    320302#endif 
    321  
    322       CALL flx_init                         ! Thermohaline forcing initialization 
    323  
    324       CALL flx_fwb_init                     ! FreshWater Budget correction 
    325303 
    326304      CALL dia_ptr_init                     ! Poleward TRansports initialization 
    … …  
    475453      USE dtatem        ! temperature data 
    476454      USE dtasal        ! salinity data 
    477       USE dtasst        ! sea surface temperature data 
    478455      !!---------------------------------------------------------------------- 
    479456 

  • trunk/NEMO/OPA_SRC/phycst.F90

    r833 r888  
    44   !!     Definition of of both ocean and ice parameters used in the code 
    55   !!===================================================================== 
    6    !! * Modules used 
     6   !! History :        !  90-10  (C. Levy - G. Madec)  Original code 
     7   !!                  !  91-11  (G. Madec) 
     8   !!                  !  91-12  (M. Imbard) 
     9   !!             8.5  !  02-08  (G. Madec, C. Ethe)  F90, add ice constants 
     10   !!             9.0  !  06-08  (G. Madec)  style  
     11   !!---------------------------------------------------------------------- 
     12 
     13   !!---------------------------------------------------------------------- 
     14   !!   phy_cst  : define and print physical constant and domain parameters 
     15   !!---------------------------------------------------------------------- 
    716   USE par_oce          ! ocean parameters 
    817   USE in_out_manager   ! I/O manager 
    … …  
    1120   PRIVATE 
    1221 
    13    !! * Routine accessibility 
    14    PUBLIC phy_cst          ! routine called by inipar.F90 
    15  
    16    !! * Shared module variables 
    17    INTEGER, PUBLIC, DIMENSION(12) ::   &  !: 
    18       nbiss = (/ 31, 29, 31, 30, 31, 30,      &  !: number of days per month 
    19          &       31, 31, 30, 31, 30, 31 /) ,  &  !  (leap-year) 
    20       nobis = (/ 31, 28, 31, 30, 31, 30,      &  !: number of days per month 
    21          &       31, 31, 30, 31, 30, 31 /)       !  (365 days a year) 
    22     
    23    REAL(wp), PUBLIC ::                        &  !: 
    24       rpi = 3.141592653589793_wp           ,  &  !: pi 
    25       rad = 3.141592653589793_wp / 180._wp ,  &  !: conversion from degre into radian 
    26       rsmall = 0.5 * EPSILON( 1. )               !: smallest real computer value 
     22   PUBLIC   phy_cst     ! routine called by inipar.F90 
     23 
     24   REAL(wp), PUBLIC ::   rpi = 3.141592653589793_wp             !: pi 
     25   REAL(wp), PUBLIC ::   rad = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian 
     26   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1. )           !: smallest real computer value 
    2727    
    2828   REAL(wp), PUBLIC ::          & !: 
    … …  
    5454#endif 
    5555      rau0     = 1020._wp   ,  &  !: volumic mass of reference (kg/m3) 
    56       rauw     = 1000._wp   ,  &  !: density of pure water (kg/m3) 
     56      rauw     = 1000._wp   ,  &  !: volumic mass of pure water (kg/m3) 
    5757      rcp      =    4.e+3_wp,  &  !: ocean specific heat 
    5858      ro0cpr                      !: = 1. / ( rau0 * rcp ) 
    … …  
    6666      lsub    = 2.834e+6      ,   &  !: pure ice latent heat of sublimation (J.kg-1) 
    6767      lfus    = 0.334e+6      ,   &  !: latent heat of fusion of fresh ice   (J.kg-1) 
    68       rhoic   = 917._wp       ,   &  !: density of sea ice (kg/m3) 
     68      rhoic   = 917._wp       ,   &  !: volumic mass of sea ice (kg/m3) 
    6969      tmut    =   0.054       ,   &  !: decrease of seawater meltpoint with salinity 
    7070#else 
    … …  
    7676      xlic    = 300.33e+6_wp  ,   &  !: volumetric latent heat fusion of ice 
    7777      xsn     =   2.8e+6      ,   &  !: latent heat of sublimation of snow 
    78       rhoic   = 900._wp       ,   &  !: density of sea ice (kg/m3) 
     78      rhoic   = 900._wp       ,   &  !: volumic mass of sea ice (kg/m3) 
    7979#endif 
    80       rhosn   = 330._wp       ,   &  !: density of snow (kg/m3) 
     80      rhosn   = 330._wp       ,   &  !: volumic mass of snow (kg/m3) 
    8181      emic    =   0.97_wp     ,   &  !: emissivity of snow or ice 
    8282      sice    =   6.0_wp      ,   &  !: salinity of ice (psu) 
    … …  
    9999      !! 
    100100      !! ** Purpose :   Print model parameters and set and print the constants 
    101       !! 
    102       !! ** Method  :   no 
    103       !! 
    104       !! History : 
    105       !!        !  90-10  (C. Levy - G. Madec)  Original code 
    106       !!        !  91-11  (G. Madec) 
    107       !!        !  91-12  (M. Imbard) 
    108       !!   8.5  !  02-08  (G. Madec, C. Ethe)  F90, add ice constants  
    109       !!---------------------------------------------------------------------- 
    110       !! * Local variables 
    111       CHARACTER (len=64) ::   cform = "(A9, 3(A13, I7) )"  
     101      !!---------------------------------------------------------------------- 
     102      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7) )"  
    112103      !!---------------------------------------------------------------------- 
    113104 
    … …  
    119110      ! ---------------- 
    120111      IF(lwp) THEN 
    121          WRITE(numout,*) '       parameter file' 
    122          WRITE(numout,*) 
     112         WRITE(numout,*) '       Domain info' 
    123113         WRITE(numout,*) '          dimension of model' 
    124          WRITE(numout,*) '              Local domain      Global domain       Data domain ' 
    125          WRITE(numout,cform) '         ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta 
    126          WRITE(numout,cform) '         ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta 
    127          WRITE(numout,cform) '         ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta 
    128          WRITE(numout,*)      '        ','   jpij    : ', jpij 
    129          WRITE(numout,*) 
     114         WRITE(numout,*) '                 Local domain      Global domain       Data domain ' 
     115         WRITE(numout,cform) '            ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta 
     116         WRITE(numout,cform) '            ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta 
     117         WRITE(numout,cform) '            ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta 
     118         WRITE(numout,*)      '           ','   jpij    : ', jpij 
    130119         WRITE(numout,*) '          mpp local domain info (mpp)' 
    131120         WRITE(numout,*) '             jpni    : ', jpni, '   jpreci  : ', jpreci 
    132121         WRITE(numout,*) '             jpnj    : ', jpnj, '   jprecj  : ', jprecj 
    133122         WRITE(numout,*) '             jpnij   : ', jpnij 
    134  
    135          WRITE(numout,*) 
    136123         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio 
    137          WRITE(numout,*) '          domain island (use in rigid-lid case)  : jpisl   = ', jpisl  
    138          WRITE(numout,*) '                                                   jpnisl  = ', jpnisl 
     124         WRITE(numout,*) '          domain island (use in rigid-lid case)  : jpisl   = ', jpisl, '   jpnisl  = ', jpnisl 
    139125      ENDIF 
    140126 
    … …  
    142128      ! ---------------- 
    143129      IF(lwp) WRITE(numout,*) 
    144       IF(lwp) WRITE(numout,*) '       constants' 
     130      IF(lwp) WRITE(numout,*) '       Constants' 
    145131 
    146132      IF(lwp) WRITE(numout,*) 

  • trunk/NEMO/OPA_SRC/restart.F90

    r833 r888  
    1919   USE phycst          ! physical constants 
    2020   USE daymod          ! calendar 
    21    USE ice_oce         ! ice variables 
    22    USE blk_oce         ! bulk variables 
    2321   USE cpl_oce, ONLY : lk_cpl              ! 
    2422   USE in_out_manager  ! I/O manager 
    … …  
    4341   !!---------------------------------------------------------------------- 
    4442   !!  OPA 9.0 , LOCEAN-IPSL (2006)  
    45    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/restart.F90,v 1.27 2007/06/05 10:35:19 opalod Exp $  
     43   !! $Id$ 
    4644   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4745   !!---------------------------------------------------------------------- 
    … …  
    143141      CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn    ) 
    144142      CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn   ) 
    145  
    146 #if defined key_lim3 || defined key_lim2 
    147       CALL iom_rstput( kt, nitrst, numrow, 'nfice'  , REAL( nfice, wp) )   !  ice computation frequency 
    148       CALL iom_rstput( kt, nitrst, numrow, 'sst_io' , sst_io  ) 
    149       CALL iom_rstput( kt, nitrst, numrow, 'sss_io' , sss_io  ) 
    150       CALL iom_rstput( kt, nitrst, numrow, 'u_io'   , u_io    ) 
    151       CALL iom_rstput( kt, nitrst, numrow, 'v_io'   , v_io    ) 
    152 # if defined key_coupled 
    153       CALL iom_rstput( kt, nitrst, numrow, 'alb_ice', alb_ice ) 
    154 # endif 
    155 #endif 
    156 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core  
    157       CALL iom_rstput( kt, nitrst, numrow, 'nfbulk' , REAL( nfbulk, wp) )   !  bulk computation frequency 
    158       CALL iom_rstput( kt, nitrst, numrow, 'gsst'   , gsst    ) 
    159 #endif 
    160143 
    161144      IF( nn_dynhpg_rst == 1 .OR. lk_vvl ) THEN 
    … …  
    209192      !!                    has been stored in the restart file. 
    210193      !!---------------------------------------------------------------------- 
    211       REAL(wp) ::   zcoef, zkt, zrdt, zrdttra1, zndastp, znfice, znfbulk 
    212 #if defined key_lim3 || defined key_lim2 
    213       INTEGER  ::   ji, jj 
    214 #endif 
     194      REAL(wp) ::   zkt, zrdt, zrdttra1, zndastp 
    215195      !!---------------------------------------------------------------------- 
    216196 
    … …  
    304284      ENDIF 
    305285 
    306       !!sm: TO BE MOVED IN NEW SURFACE MODULE... 
    307  
    308 #if defined key_lim3 || defined key_lim2 
    309       ! Louvain La Neuve Sea Ice Model 
    310       IF( iom_varid( numror, 'nfice', ldstop = .FALSE. ) > 0 ) then  
    311          CALL iom_get( numror             , 'nfice'  , znfice  )   ! ice computation frequency 
    312          CALL iom_get( numror, jpdom_autoglo, 'sst_io' , sst_io  ) 
    313          CALL iom_get( numror, jpdom_autoglo, 'sss_io' , sss_io  ) 
    314          CALL iom_get( numror, jpdom_autoglo, 'u_io'   , u_io    ) 
    315          CALL iom_get( numror, jpdom_autoglo, 'v_io'   , v_io    ) 
    316 # if defined key_coupled 
    317          CALL iom_get( numror, jpdom_autoglo, 'alb_ice', alb_ice ) 
    318 # endif 
    319          IF( znfice /= REAL( nfice, wp ) ) THEN      ! if nfice changed between 2 runs 
    320             zcoef = REAL( nfice-1, wp ) / znfice 
    321             sst_io(:,:) = zcoef * sst_io(:,:) 
    322             sss_io(:,:) = zcoef * sss_io(:,:) 
    323             u_io  (:,:) = zcoef * u_io  (:,:) 
    324             v_io  (:,:) = zcoef * v_io  (:,:) 
    325          ENDIF 
    326       ELSE 
    327          IF(lwp) WRITE(numout,*) 
    328          IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization' 
    329          IF(lwp) WRITE(numout,*) 
    330          zcoef = REAL( nfice-1, wp ) 
    331          sst_io(:,:) = zcoef *( tn(:,:,1) + rt0 )          !!bug a explanation is needed here! 
    332          sss_io(:,:) = zcoef *  sn(:,:,1) 
    333          zcoef = 0.5 * REAL( nfice-1, wp ) 
    334          DO jj = 2, jpj 
    335             DO ji = fs_2, jpi   ! vector opt. 
    336                u_io(ji,jj) = zcoef * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) ) 
    337                v_io(ji,jj) = zcoef * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) ) 
    338             END DO 
    339          END DO 
    340 # if defined key_coupled 
    341          alb_ice(:,:) = 0.8 * tmask(:,:,1) 
    342 # endif 
    343       ENDIF 
    344 #endif 
    345 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core  
    346       ! Louvain La Neuve Sea Ice Model 
    347       IF( iom_varid( numror, 'nfbulk', ldstop = .FALSE. ) > 0 ) THEN  
    348          CALL iom_get( numror             , 'nfbulk', znfbulk )   ! bulk computation frequency 
    349          CALL iom_get( numror, jpdom_autoglo, 'gsst'  , gsst    ) 
    350          IF( znfbulk /= REAL(nfbulk, wp) ) THEN      ! if you change nfbulk between 2 runs 
    351             zcoef = REAL( nfbulk-1, wp ) / znfbulk 
    352             gsst(:,:) = zcoef * gsst(:,:) 
    353          ENDIF 
    354       ELSE 
    355          IF(lwp) WRITE(numout,*) 
    356          IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization' 
    357          IF(lwp) WRITE(numout,*) 
    358          gsst(:,:) = REAL( nfbulk - 1, wp )*( tn(:,:,1) + rt0 ) 
    359       ENDIF 
    360 #endif 
    361  
    362       !!sm: end of TO BE MOVED IN NEW SURFACE MODULE... 
    363  
    364286      IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN 
    365287         CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd  ) 

  • trunk/NEMO/OPA_SRC/step.F90

    r833 r888  
    44   !! Time-stepping    : manager of the ocean, tracer and ice time stepping 
    55   !!====================================================================== 
    6    !! History :        !  91-03  ()  Original code 
    7    !!                  !  91-11  (G. Madec) 
     6   !! History :        !  91-03  (G. Madec)  Original code 
    87   !!                  !  92-06  (M. Imbard)  add a first output record 
    98   !!                  !  96-04  (G. Madec)  introduction of dynspg 
    … …  
    2019   !!             " "  !  06-01  (L. Debreu, C. Mazauric)  Agrif implementation 
    2120   !!             " "  !  06-07  (S. Masson)  restart using iom 
     21   !!             " "  !  06-08  (G. Madec)  surface module  
     22   !!---------------------------------------------------------------------- 
     23 
    2224   !!---------------------------------------------------------------------- 
    2325   !!   stp            : OPA system time-stepping 
    … …  
    3032   USE cpl_oce         ! coupled ocean-atmosphere variables 
    3133   USE in_out_manager  ! I/O manager 
    32    USE iom 
     34   USE iom             ! 
    3335   USE lbclnk 
    3436 
    … …  
    3739   USE dtatem          ! ocean temperature data           (dta_tem routine) 
    3840   USE dtasal          ! ocean salinity    data           (dta_sal routine) 
    39    USE dtasst          ! ocean sea surface temperature    (dta_sst routine) 
    40    USE dtasss          ! ocean sea surface salinity       (dta_sss routine) 
    41    USE taumod          ! surface stress                   (tau     routine) 
    42    USE flxmod          ! thermohaline fluxes              (flx     routine) 
    43    USE ocesbc          ! thermohaline fluxes              (oce_sbc routine) 
    44    USE flxrnf          ! runoffs                          (flx_rnf routine) 
    45    USE flxfwb          ! freshwater budget correction     (flx_fwb routine) 
    46    USE closea          ! closed sea freshwater budget     (flx_clo routine) 
     41   USE sbcmod          ! surface boundary condition       (sbc     routine) 
     42   USE sbcrnf          ! surface boundary condition: runoff variables 
    4743   USE ocfzpt          ! surface ocean freezing point    (oc_fz_pt routine) 
    4844 
    … …  
    9692   USE zpshde          ! partial step: hor. derivative     (zps_hde routine) 
    9793   USE ice_oce         ! sea-ice variable 
    98 #if defined key_lim3 
    99    USE icestp          ! sea-ice time-stepping             (ice_stp routine) 
    100 #endif 
    101 #if defined key_lim2 
    102    USE icestp_2        ! sea-ice time-stepping             (ice_stp_2 routine) 
    103 #endif 
     94 
    10495   USE diawri          ! Standard run outputs             (dia_wri routine) 
    10596   USE trdicp          ! Ocean momentum/tracers trends    (trd_wri routine) 
    … …  
    119110   USE stpctl          ! time stepping control            (stp_ctl routine) 
    120111   USE restart         ! ocean restart                    (rst_wri routine) 
    121    USE cpl             ! exchanges in coupled mode        (cpl_stp routine) 
    122112   USE prtctl          ! Print control                    (prt_ctl routine) 
    123113   USE domvvl          ! variable volume                  (dom_vvl routine) 
    … …  
    137127   !!---------------------------------------------------------------------- 
    138128   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    139    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/step.F90,v 1.35 2007/06/01 16:55:39 opalod Exp $  
     129   !! $Id$ 
    140130   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    141131   !!---------------------------------------------------------------------- 
    … …  
    166156      !! * Arguments 
    167157#if defined key_agrif    
    168       INTEGER               :: kstp   ! ocean time-step index 
     158      INTEGER             ::  kstp   ! ocean time-step index 
    169159#else 
    170       INTEGER, INTENT( in ) :: kstp   ! ocean time-step index 
     160      INTEGER, INTENT(in) ::  kstp   ! ocean time-step index 
    171161#endif       
    172  
    173       !! * local declarations 
     162      INTEGER ::   jk       ! dummy loop indice 
    174163      INTEGER ::   indic    ! error indicator if < 0 
    175164      !! --------------------------------------------------------------------- 
    … …  
    182171      indic = 1                    ! reset to no error condition 
    183172 
    184       adatrj = adatrj + rdt/86400._wp 
    185  
    186173      CALL day( kstp )             ! Calendar 
    187174 
    … …  
    189176 
    190177      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    191       ! Update data, open boundaries and Forcings 
     178      ! Update data, open boundaries, surface boundary condition (including sea-ice) 
    192179      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    193180 
    194181      IF( lk_dtatem  )   CALL dta_tem( kstp )         ! update 3D temperature data 
    195  
    196       IF( lk_dtasal  )   CALL dta_sal( kstp )         ! Salinity data 
    197  
    198       IF( lk_dtasst  )   CALL dta_sst( kstp )         ! Sea Surface Temperature data 
    199  
    200       IF( lk_dtasss  )   CALL dta_sss( kstp )         ! Sea Surface Salinity data 
     182      IF( lk_dtasal  )   CALL dta_sal( kstp )         ! update 3D salinity data 
     183 
     184                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    201185 
    202186      IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries 
    203  
    204187      IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries 
    205188 
    206       IF( .NOT. lk_core )    CALL tau( kstp )         ! wind stress 
    207  
    208                          CALL flx_rnf( kstp )         ! runoff data 
    209  
    210                          CALL flx( kstp )             ! heat and freshwater fluxes 
    211  
    212 #if defined key_lim3 
    213       CALL ice_stp( kstp )           ! sea-ice model (Update stress & fluxes) 
    214 #endif 
    215 #if defined key_lim2 
    216       CALL ice_stp_2( kstp )         ! sea-ice model (Update stress & fluxes) 
    217 #endif 
    218  
    219                          CALL oce_sbc( kstp )         ! ocean surface boudaries 
    220  
    221       IF( ln_fwb     )   CALL flx_fwb( kstp )         ! freshwater budget 
    222  
    223       IF( nclosea == 1 ) CALL flx_clo( kstp )         ! closed sea in the domain (update freshwater fluxes) 
    224  
    225       IF( kstp == nit000 ) THEN  
    226          IF( ninist == 1 ) THEN                       ! Output the initial state and forcings 
    227             CALL dia_wri_state( 'output.init' ) 
    228          ENDIF 
    229       ENDIF 
    230  
    231       IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    232          CALL prt_ctl(tab2d_1=emp    , clinfo1=' emp  -   : ', mask1=tmask, ovlap=1) 
    233          CALL prt_ctl(tab2d_1=emps   , clinfo1=' emps -   : ', mask1=tmask, ovlap=1) 
    234          CALL prt_ctl(tab2d_1=qt     , clinfo1=' qt   -   : ', mask1=tmask, ovlap=1) 
    235          CALL prt_ctl(tab2d_1=qsr    , clinfo1=' qsr  -   : ', mask1=tmask, ovlap=1) 
    236          CALL prt_ctl(tab2d_1=runoff , clinfo1=' runoff   : ', mask1=tmask, ovlap=1) 
    237          CALL prt_ctl(tab3d_1=tmask  , clinfo1=' tmask    : ', mask1=tmask, ovlap=1, kdim=jpk) 
    238          CALL prt_ctl(tab3d_1=tn     , clinfo1=' sst  -   : ', mask1=tmask, ovlap=1, kdim=1) 
    239          CALL prt_ctl(tab3d_1=sn     , clinfo1=' sss  -   : ', mask1=tmask, ovlap=1, kdim=1) 
    240          CALL prt_ctl(tab2d_1=taux   , clinfo1=' tau  - x : ', mask1=umask, & 
    241             &         tab2d_2=tauy   , clinfo2='      - y : ', mask2=vmask,ovlap=1) 
     189      IF( ninist == 1 ) THEN                       ! Output the initial state and forcings 
     190                        CALL dia_wri_state( 'output.init' ) 
     191                        ninist = 0 
    242192      ENDIF 
    243193 
    … …  
    252202      !----------------------------------------------------------------------- 
    253203 
    254                        CALL bn2( tb, sb, rn2 )              ! before Brunt-Vaisala frequency 
     204                        CALL bn2( tb, sb, rn2 )              ! before Brunt-Vaisala frequency 
    255205       
    256206      !                                                     ! Vertical eddy viscosity and diffusivity coefficients 
    … …  
    267217      ENDIF 
    268218 
    269       IF( cp_cfg == "orca" ) THEN                           ! ORCA: Reduce vertical mixing in some specific areas 
    270          SELECT CASE ( jp_cfg ) 
    271             CASE ( 05 )                         ! ORCA R2 configuration 
    272                avt  (:,:,2) = avt  (:,:,2) + 1.e-3 * upsrnfh(:,:)   ! increase diffusivity of rivers mouths 
    273             CASE ( 025 )                         ! ORCA R025 configuration 
    274                avt  (:,:,2) = avt  (:,:,2) + 2.e-3 * upsrnfh(:,:)   ! increase diffusivity of rivers mouths 
    275          END SELECT 
     219      IF( nn_runoff /=0 ) THEN                              ! increase diffusivity at rivers mouths 
     220         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + rn_avt_rnf * rnfmsk(:,:)   ;   END DO 
    276221      ENDIF 
    277222 
    278223      IF( ln_zdfevd )   CALL zdf_evd( kstp )                 ! enhanced vertical eddy diffusivity 
    279224 
    280       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp)   & 
     225      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    281226         &              CALL zdf_ddm( kstp )                 ! double diffusive mixing 
    282227 
    … …  
    291236      ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    292237      !----------------------------------------------------------------------- 
    293  
    294238      IF( lk_ldfslp     )   CALL ldf_slp( kstp, rhd, rn2 )       ! before slope of the lateral mixing 
    295  
    296239#if defined key_traldf_c2d 
    297240      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )                 ! eddy induced velocity coefficient 
    298241#endif 
    299242 
    300  
    301243#if defined key_passivetrc 
    302244      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    305247      ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    306248      !----------------------------------------------------------------------- 
    307  
    308249                             CALL trc_stp( kstp, indic )            ! time-stepping 
    309  
    310 #endif 
    311  
     250#endif 
    312251 
    313252      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    316255      ! N.B. ua, va arrays are used as workspace in this section 
    317256      !----------------------------------------------------------------------- 
    318  
    319257                             ta(:,:,:) = 0.e0               ! set tracer trends to zero 
    320258                             sa(:,:,:) = 0.e0 
    321259 
    322260                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    323  
    324261      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr 
    325  
    326262      IF( lk_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
    327  
    328263      IF( lk_trabbl_dif  )   CALL tra_bbl_dif( kstp )       ! diffusive bottom boundary layer scheme 
    329264      IF( lk_trabbl_adv  )   CALL tra_bbl_adv( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
    330  
    331265      IF( lk_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
    332  
    333266                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
    334  
    335267      IF( n_cla == 1     )   CALL tra_cla    ( kstp )       ! Cross Land Advection (Update Hor. advection) 
    336  
    337268      IF( lk_zdfkpp )        CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    338  
    339269                             CALL tra_ldf    ( kstp )       ! lateral mixing 
    340270#if defined key_agrif 
    … …  
    342272#endif 
    343273                             CALL tra_zdf    ( kstp )       ! vertical mixing 
    344  
    345274                             CALL tra_nxt( kstp )           ! tracer fields at next time step 
    346  
    347275      IF( ln_zdfnpc      )   CALL tra_npc( kstp )           ! update the new (t,s) fields by non 
    348276      !                                                     ! penetrative convective adjustment 
    … …  
    365293      ! N.B. ta, sa arrays are used as workspace in this section  
    366294      !----------------------------------------------------------------------- 
    367  
    368  
    369295                               ua(:,:,:) = 0.e0               ! set dynamics trends to zero 
    370296                               va(:,:,:) = 0.e0 
    371297 
    372298                               CALL dyn_adv( kstp )           ! advection (vector or flux form) 
    373  
    374299                               CALL dyn_vor( kstp )           ! vorticity term including Coriolis 
    375  
    376300                               CALL dyn_ldf( kstp )           ! lateral mixing 
    377301#if defined key_agrif 
    … …  
    379303#endif 
    380304                               CALL dyn_hpg( kstp )           ! horizontal gradient of Hydrostatic pressure 
    381  
    382305                               CALL dyn_zdf( kstp )           ! vertical diffusion 
    383  
    384306      IF( lk_dynspg_rl ) THEN 
    385307         IF( lk_obc    )       CALL obc_spg( kstp )           ! surface pressure gradient at open boundaries 
    386308      ENDIF 
    387                        indic=0 
    388 !i bug lbc sur emp 
    389       CALL lbc_lnk( emp, 'T', 1. ) 
    390 !i 
     309                               indic=0 
    391310                               CALL dyn_spg( kstp, indic )    ! surface pressure gradient 
    392  
    393311                               CALL dyn_nxt( kstp )           ! lateral velocity at next time step 
    394  
    395312      IF( lk_vvl )             CALL dom_vvl                   ! vertical mesh at next time step 
    396313 
    … …  
    401318      ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    402319      !----------------------------------------------------------------------- 
    403  
    404320                       CALL oc_fz_pt                        ! ocean surface freezing temperature 
    405  
    406321                       CALL div_cur( kstp )                 ! Horizontal divergence & Relative vorticity 
    407  
    408322      IF( n_cla == 1 ) CALL div_cla( kstp )                 ! Cross Land Advection (Update Hor. divergence) 
    409  
    410323                       CALL wzv( kstp )                     ! Vertical velocity 
    411324 
    412  
    413  
    414       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    415       ! Control, and restarts 
    416       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    417       ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    418       !----------------------------------------------------------------------- 
    419       !                                                     ! Time loop: control and print 
     325      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     326      ! Control and restarts 
     327      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    420328                                 CALL stp_ctl( kstp, indic ) 
    421329      IF( indic < 0          )   CALL ctl_stop( 'step: indic < 0' ) 
    422  
    423330      IF( kstp == nit000     )   CALL iom_close( numror )             ! close input  ocean restart file 
    424331      IF( lrst_oce           )   CALL rst_write  ( kstp )             ! write output ocean restart file 
    … …  
    431338      !----------------------------------------------------------------------- 
    432339 
    433       IF ( nstop == 0 ) THEN                                ! Diagnostics 
     340      IF( nstop == 0 ) THEN                                 ! Diagnostics: 
    434341         IF( lk_floats  )   CALL flo_stp( kstp )                 ! drifting Floats 
    435342         IF( lk_trddyn  )   CALL trd_dwr( kstp )                 ! trends: dynamics  
    … …  
    443350         IF( lk_diafwb  )   CALL dia_fwb( kstp )                 ! Fresh water budget diagnostics 
    444351         IF( ln_diaptr  )   CALL dia_ptr( kstp )                 ! Poleward TRansports diagnostics 
    445  
    446          !                                                 ! Outputs 
    447                             CALL dia_wri    ( kstp, indic )      ! ocean model: outputs 
     352         !                                                 ! outputs 
     353                            CALL dia_wri( kstp, indic )          ! ocean model: outputs 
    448354      ENDIF 
    449355 

  • trunk/NEMO/TOP_SRC/TRP/trcadv_cen2.F90

    r833 r888  
    164164               zind(ji,jj,jk) =  MAX ( upsrnfh(ji,jj) * upsrnfz(jk),     &  ! changing advection scheme near runoff 
    165165                  &                    upsadv(ji,jj)                     &  ! in the vicinity of some straits 
    166 #if defined key_lim3 
     166#if defined key_lim3 || defined key_lim2 
    167167                  &                  , tmask(ji,jj,jk)                   &  ! half upstream tracer fluxes 
    168168                  &                  * MAX( 0., SIGN( 1., fzptn(ji,jj)   &  ! if tn < ("freezing"+0.1 ) 
Note: See TracChangeset for help on using the changeset viewer.