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 2528 for trunk/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

Location:
trunk/NEMOGCM/NEMO/LIM_SRC_2
Files:
22 edited
1 copied

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90

    • Property svn:eol-style deleted
    r1228 r2528  
    55   !!====================================================================== 
    66   !! History :   2.0  !  03-08  (C. Ethe)  Free form and module 
     7   !!             3.3  !  2009-05 (G.Garric, C. Bricaud) addition of lim2_evp case 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim2 
    910   !!---------------------------------------------------------------------- 
    10    !!   LIM 2.0, UCL-LOCEAN-IPSL (2005) 
     11   !!   'key_lim2'                                       LIM2 sea-ice model 
     12   !!---------------------------------------------------------------------- 
     13   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    1114   !! $Id$ 
    12    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     15   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1316   !!---------------------------------------------------------------------- 
    1417   USE par_ice_2 
    … …  
    2225      !                                        !  (otherwise = jpj+10 (SH) or -10 (SH) ) 
    2326 
    24    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   fs2cor , fcor,   &  !: coriolis factor and coeficient 
    25       &                                              covrai ,         &  !: sine of geographic latitude 
    26       &                                              area   ,         &  !: surface of grid cell  
    27       &                                              tms    , tmu        !: temperature and velocity points masks 
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght   ,         &  !: weight of the 4 neighbours to compute averages 
    29       &                                              akappa , bkappa     !: first and third group of metric coefficients 
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd   !: second group of metric coefficients 
     27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   fs2cor , fcor     !: coriolis factor and coeficient 
     28   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   covrai            !: sine of geographic latitude 
     29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   area              !: surface of grid cell  
     30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tms    , tmu      !: temperature and velocity points masks 
     31   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght              !: weight of the 4 neighbours to compute averages 
    3132 
     33 
     34# if defined key_lim2_vp 
     35   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   akappa , bkappa   !: first and third group of metric coefficients 
     36   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd            !: second group of metric coefficients 
     37# else 
     38   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmv    , tmf      !: y-velocity and F-points masks 
     39   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmi               !: ice mask: =1 if ice thick > 0 
     40# endif 
     41 
     42#else 
     43   !!---------------------------------------------------------------------- 
     44   !!   Default option          Empty module         NO LIM-2 sea-ice model 
     45   !!---------------------------------------------------------------------- 
     46#endif 
    3247   !!====================================================================== 
    33 #endif 
    3448END MODULE dom_ice_2 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    • Property svn:eol-style deleted
    r1756 r2528  
    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 
     6   !! History :  2.0  !  2003-08  (C. Ethe)  F90: Free form and module 
     7   !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim2 
    … …  
    1011   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    1112   !!---------------------------------------------------------------------- 
    12    !!  LIM 2.0, UCL-LOCEAN-IPSL (2006) 
    13    !! $Id$ 
    14    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    15    !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    1713   USE par_ice_2          ! LIM sea-ice parameters 
    1814 
    1915   IMPLICIT NONE 
    2016   PRIVATE 
     17    
     18   INTEGER , PUBLIC ::   numit     !: ice iteration index 
     19   REAL(wp), PUBLIC ::   rdt_ice   !: ice time step 
    2120 
    22    !!* Share parameters namelist (namicerun read in iceini) * 
     21   !                                                                     !!* namicerun read in iceini * 
    2322   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in  = "restart_ice_in"   !: suffix of ice restart name (input) 
    2423   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out = "restart_ice"      !: suffix of ice restart name (output) 
    2524   LOGICAL               , PUBLIC ::   ln_limdyn     = .TRUE.             !: flag for ice dynamics (T) or not (F) 
    2625   LOGICAL               , PUBLIC ::   ln_limdmp     = .FALSE.            !: Ice damping 
    27    REAL(wp)              , PUBLIC ::   hsndif        = 0.e0               !: computation of temp. in snow (0) or not (9999) 
    28    REAL(wp)              , PUBLIC ::   hicdif        = 0.e0               !: computation of temp. in ice (0) or not (9999) 
    29    REAL(wp), DIMENSION(2), PUBLIC ::   acrit = (/ 1.e-06 , 1.e-06 /)      !: minimum fraction for leads in  
    30    !                                                                      !: north and south hemisphere 
    31    !!* ice-dynamic namelist (namicedyn) * 
    32    INTEGER , PUBLIC ::   nbiter = 1         !: number of sub-time steps for relaxation 
    33    INTEGER , PUBLIC ::   nbitdr = 250       !: maximum number of iterations for relaxation 
    34    REAL(wp), PUBLIC ::   rdt_ice            !: ice time step 
    35    REAL(wp), PUBLIC ::   epsd   = 1.0e-20   !: tolerance parameter for dynamic 
    36    REAL(wp), PUBLIC ::   alpha  = 0.5       !: coefficient for semi-implicit coriolis 
    37    REAL(wp), PUBLIC ::   dm     = 0.6e+03   !: diffusion constant for dynamics 
    38    REAL(wp), PUBLIC ::   om     = 0.5       !: relaxation constant 
    39    REAL(wp), PUBLIC ::   resl   = 5.0e-05   !: maximum value for the residual of relaxation 
    40    REAL(wp), PUBLIC ::   cw     = 5.0e-03   !: drag coefficient for oceanic stress 
    41    REAL(wp), PUBLIC ::   angvg  = 0.e0      !: turning angle for oceanic stress 
    42    REAL(wp), PUBLIC ::   pstar  = 1.0e+04   !: first bulk-rheology parameter 
    43    REAL(wp), PUBLIC ::   c_rhg  = 20.e0     !: second bulk-rhelogy parameter 
    44    REAL(wp), PUBLIC ::   etamn  = 0.e+07    !: minimun value for viscosity 
    45    REAL(wp), PUBLIC ::   creepl = 2.e-08    !: creep limit 
    46    REAL(wp), PUBLIC ::   ecc    = 2.e0      !: eccentricity of the elliptical yield curve 
    47    REAL(wp), PUBLIC ::   ahi0   = 350.e0    !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
     26   LOGICAL               , PUBLIC ::   ln_nicep      = .TRUE.             !: flag grid points output (T) or not (F) 
     27   REAL(wp)              , PUBLIC ::   hsndif        = 0._wp              !: snow temp. computation (0) or not (9999) 
     28   REAL(wp)              , PUBLIC ::   hicdif        = 0._wp              !: ice  temp. computation (0) or not (9999) 
     29   REAL(wp), DIMENSION(2), PUBLIC ::   acrit = (/ 1.e-6_wp , 1.e-6_wp /)  !: minimum lead fraction in the 2 hemisphere 
     30    
     31   !                                          !!* ice-dynamic namelist (namicedyn) * 
     32   INTEGER , PUBLIC ::   nbiter =    1         !: number of sub-time steps for relaxation 
     33   INTEGER , PUBLIC ::   nbitdr =  250         !: maximum number of iterations for relaxation 
     34   INTEGER , PUBLIC ::   nevp   =  360         !: number of EVP subcycling iterations 
     35   INTEGER , PUBLIC ::   telast = 3600         !: timescale for EVP elastic waves 
     36   REAL(wp), PUBLIC ::   epsd   = 1.0e-20_wp   !: tolerance parameter for dynamic 
     37   REAL(wp), PUBLIC ::   alpha  = 0.5_wp       !: coefficient for semi-implicit coriolis 
     38   REAL(wp), PUBLIC ::   dm     = 0.6e+03_wp   !: diffusion constant for dynamics 
     39   REAL(wp), PUBLIC ::   om     = 0.5_wp       !: relaxation constant 
     40   REAL(wp), PUBLIC ::   resl   = 5.0e-05_wp   !: maximum value for the residual of relaxation 
     41   REAL(wp), PUBLIC ::   cw     = 5.0e-03_wp   !: drag coefficient for oceanic stress 
     42   REAL(wp), PUBLIC ::   angvg  = 0._wp        !: turning angle for oceanic stress 
     43   REAL(wp), PUBLIC ::   pstar  = 1.0e+04_wp   !: first bulk-rheology parameter 
     44   REAL(wp), PUBLIC ::   c_rhg  = 20._wp       !: second bulk-rhelogy parameter 
     45   REAL(wp), PUBLIC ::   etamn  = 0._wp        !: minimun value for viscosity 
     46   REAL(wp), PUBLIC ::   creepl = 2.e-08_wp    !: creep limit 
     47   REAL(wp), PUBLIC ::   ecc    = 2._wp        !: eccentricity of the elliptical yield curve 
     48   REAL(wp), PUBLIC ::   ahi0   = 350._wp      !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
     49   REAL(wp), PUBLIC ::   alphaevp = 1._wp      !: coefficient for the solution of EVP int. stresses 
    4850 
    49    REAL(wp), PUBLIC ::   usecc2             !:  = 1.0 / ( ecc * ecc ) 
    50    REAL(wp), PUBLIC ::   rhoco              !: = rau0 * cw 
    51    REAL(wp), PUBLIC ::   sangvg, cangvg     !: sin and cos of the turning angle for ocean stress 
    52    REAL(wp), PUBLIC ::   pstarh             !: pstar / 2.0 
     51   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( ecc * ecc ) 
     52   REAL(wp), PUBLIC ::   rhoco                 !: = rau0 * cw 
     53   REAL(wp), PUBLIC ::   sangvg, cangvg        !: sin and cos of the turning angle for ocean stress 
     54   REAL(wp), PUBLIC ::   pstarh                !: pstar / 2.0 
    5355 
    5456   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
    5557   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
     58   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s         !: friction velocity 
     59 
     60   !!* Ice Rheology 
     61# if defined key_lim2_vp 
     62   !                                                      !!* VP rheology * 
     63   LOGICAL , PUBLIC ::   lk_lim2_vp = .TRUE.               !: Visco-Plactic reology flag  
     64   ! 
    5665   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnm , hicm   !: mean snow and ice thicknesses 
    57    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s                 !: friction velocity 
     66   ! 
     67# else 
     68   !                                                      !!* EVP rheology * 
     69   LOGICAL , PUBLIC::   lk_lim2_vp = .FALSE.               !: Visco-Plactic reology flag  
     70   ! 
     71   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress1_i     !: first stress tensor element        
     72   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress2_i     !: second stress tensor element 
     73   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress12_i    !: diagonal stress tensor element 
     74   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   delta_i       !: rheology delta factor (see Flato and Hibler 95) [s-1] 
     75   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   divu_i        !: Divergence of the velocity field [s-1] -> limrhg.F90 
     76   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   shear_i       !: Shear of the velocity field [s-1] -> limrhg.F90 
     77   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   at_i          !: ice fraction 
     78   ! 
     79   REAL(wp), PUBLIC, DIMENSION(:,:)    , POINTER :: vt_s ,vt_i    !: mean snow and ice thicknesses 
     80   REAL(wp), PUBLIC, DIMENSION(jpi,jpj), TARGET  :: hsnm , hicm   !: target vt_s,vt_i pointers  
     81#endif 
    5882 
    59    !!* diagnostic quantities 
    60    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sist          !: Sea-Ice Surface Temperature (Kelvin) 
     83   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvosif       !: ice volume change at ice surface (only used for outputs) 
     84   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvobif       !: ice volume change at ice bottom  (only used for outputs) 
     85   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdvolif       !: Total   ice volume change (only used for outputs) 
     86   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvonif       !: Lateral ice volume change (only used for outputs) 
     87   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sist          !: Sea-Ice Surface Temperature [Kelvin] 
    6188   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS 
    6289   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hicif         !: Ice thickness 
    … …  
    7198   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdmicif       !: Variation of ice mass 
    7299   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qldif         !: heat balance of the lead (or of the open ocean) 
    73    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qcmif         !: Energy needed to bring the ocean surface layer until its freezing  
     100   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qcmif         !: Energy needed to freeze the ocean surface layer 
    74101   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdtcn         !: net downward heat flux from the ice to the ocean 
    75102   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2) 
    76103   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   thcm          !: part of the solar energy used in the lead heat budget 
    77104   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fstric        !: Solar flux transmitted trough the ice 
    78    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ffltbif       !: Array linked with the max heat contained in brine pockets (?) 
     105   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ffltbif       !: linked with the max heat contained in brine pockets (?) 
    79106   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fscmbq        !: Linked with the solar flux below the ice (?) 
    80107   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fsbbq         !: Also linked with the solar flux below the ice (?) 
    81    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qfvbq         !: Array used to store energy in case of toral lateral ablation (?) 
     108   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qfvbq         !: used to store energy in case of toral lateral ablation (?) 
    82109   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dmgwi         !: Variation of the mass of snow ice 
    83  
    84    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_ice, v_ice   !: two components of the ice   velocity at I-point (m/s) 
    85    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_oce, v_oce   !: two components of the ocean velocity at I-point (m/s) 
     110   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_ice, v_ice  !: two components of the ice   velocity at I-point (m/s) 
     111   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_oce, v_oce  !: two components of the ocean velocity at I-point (m/s) 
    86112 
    87113   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) ::   tbif  !: Temperature inside the ice/snow layer 
    … …  
    102128#endif 
    103129 
     130   !!---------------------------------------------------------------------- 
     131   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
     132   !! $Id$ 
     133   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    104134   !!====================================================================== 
    105135END MODULE ice_2 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90

    • Property svn:eol-style deleted
    r1581 r2528  
    66   !! History :   1.0  !  02-08  (G. Madec)  F90: Free form and modules 
    77   !!             2.0  !  03-08  (C. Ethe)  add ice_run 
     8   !!             3.3  !  09-05  (G.Garric, C. Bricaud) addition of the lim2_evp case 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_lim2 
    … …  
    1516   !!   ice_run_2        : Definition some run parameter for ice model 
    1617   !!---------------------------------------------------------------------- 
    17    USE dom_oce 
    18    USE dom_ice_2 
    19    USE sbc_oce         ! surface boundary condition: ocean 
    20    USE sbc_ice         ! surface boundary condition: ice 
    21    USE phycst          ! Define parameters for the routines 
    22    USE ice_2 
    23    USE limmsh_2 
    24    USE limistate_2 
    25    USE limrst_2    
    26    USE in_out_manager 
     18   USE dom_oce          ! ocean domain 
     19   USE dom_ice_2        ! LIM2: ice domain 
     20   USE sbc_oce          ! surface boundary condition: ocean 
     21   USE sbc_ice          ! surface boundary condition: ice 
     22   USE phycst           ! Define parameters for the routines 
     23   USE ice_2            ! LIM2: ice variable 
     24   USE limmsh_2         ! LIM2: mesh 
     25   USE limistate_2      ! LIM2: initial state 
     26   USE limrst_2         ! LIM2: restart 
     27   USE in_out_manager   ! I/O manager 
    2728       
    2829   IMPLICIT NONE 
    … …  
    3233 
    3334   !!---------------------------------------------------------------------- 
    34    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     35   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    3536   !! $Id$  
    36    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     37   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3738   !!---------------------------------------------------------------------- 
    38  
    3939CONTAINS 
    4040 
    … …  
    4343      !!                  ***  ROUTINE ice_init_2  *** 
    4444      !! 
    45       !! ** purpose :    
     45      !! ** purpose :   initialisation of LIM-2 domain and variables   
    4646      !!---------------------------------------------------------------------- 
    4747      ! 
    48       ! Open the namelist file  
    49       CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )       
    50       CALL ice_run_2                    !  read in namelist some run parameters 
    51                   
    52       ! Louvain la Neuve Ice model 
    53       rdt_ice = nn_fsbc * rdttra(1) 
    54  
    55       CALL lim_msh_2                  ! ice mesh initialization 
    56       
    57       ! Initial sea-ice state 
    58       IF( .NOT.ln_rstart ) THEN 
    59          CALL lim_istate_2            ! start from rest: sea-ice deduced from sst 
    60       ELSE 
    61          CALL lim_rst_read_2          ! start from a restart file 
     48      !                                ! Open the namelist file  
     49      CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )  
     50      !     
     51      CALL ice_run_2                   ! read in namelist some run parameters 
     52      !           
     53      rdt_ice = nn_fsbc * rdttra(1)    ! sea-ice time step 
     54      numit   = nit000 - 1 
     55      ! 
     56      CALL lim_msh_2                   ! ice mesh initialization 
     57      ! 
     58      !                                ! Initial sea-ice state 
     59      IF( .NOT.ln_rstart ) THEN   ;   CALL lim_istate_2     ! start from rest: sea-ice deduced from sst 
     60      ELSE                        ;   CALL lim_rst_read_2   ! start from a restart file 
    6261      ENDIF 
    63        
    64       tn_ice(:,:,1) = sist(:,:)         ! initialisation of ice temperature    
    65       fr_i  (:,:) = 1.0 - frld(:,:)   ! initialisation of sea-ice fraction     
     62      ! 
     63      tn_ice(:,:,1) = sist(:,:)        ! initialisation of ice temperature    
     64      fr_i  (:,:) = 1.0 - frld(:,:)    ! initialisation of sea-ice fraction     
    6665      ! 
    6766   END SUBROUTINE ice_init_2 
    … …  
    8281      !!------------------------------------------------------------------- 
    8382      !                     
    84       REWIND ( numnam_ice )                       ! Read Namelist namicerun  
    85       READ   ( numnam_ice , namicerun ) 
    86  
    87       IF(lwp) THEN 
     83      REWIND( numnam_ice )                      ! Read Namelist namicerun  
     84      READ  ( numnam_ice , namicerun ) 
     85      ! 
     86      IF(lwp) THEN                              ! control print 
    8887         WRITE(numout,*) 
    8988         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice' 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90

    • Property svn:eol-style deleted
    r1530 r2528  
    3737#  include "vectopt_loop_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    39    !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2009)  
     39   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    4040   !! $Id$  
    41    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     41   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 
    4343 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90

    • Property svn:eol-style deleted
    r1715 r2528  
    5757#  include "vectopt_loop_substitute.h90" 
    5858   !!---------------------------------------------------------------------- 
    59    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     59   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    6060   !! $Id$ 
    61    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     61   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6262   !!---------------------------------------------------------------------- 
    6363 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90

    • Property svn:eol-style deleted
    r1715 r2528  
    22   !!====================================================================== 
    33   !!                       ***  MODULE limdmp_2   *** 
    4    !!  Ice model : restoring Ice thickness and Fraction leads 
     4   !!  LIM-2 ice model : restoring Ice thickness and Fraction leads 
    55   !!====================================================================== 
    6    !! History :   2.0  !  04-04 (S. Theetten) Original code 
     6   !! History :   2.0  !  2004-04 (S. Theetten) Original code 
     7   !!             3.3  !  2010-06 (J.-M. Molines) use of fldread 
    78   !!---------------------------------------------------------------------- 
    8 #if defined key_lim2   &&   defined key_tradmp 
     9#if defined key_lim2 
    910   !!---------------------------------------------------------------------- 
    10    !!   'key_lim2'  AND                               LIM 2.0 sea-ice model 
    11    !!   'key_tradmp'                                                Damping 
    12    !!---------------------------------------------------------------------- 
     11   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    1312   !!---------------------------------------------------------------------- 
    1413   !!   lim_dmp_2      : ice model damping 
    1514   !!---------------------------------------------------------------------- 
    1615   USE in_out_manager  ! I/O manager 
    17    USE phycst          ! physical constants 
    18    USE ice_2 
    19    USE tradmp 
    20    USE dom_oce 
    21    USE oce 
    22    USE iom 
     16   USE ice_2           ! ice variables  
     17   USE sbc_oce, ONLY : nn_fsbc ! for fldread 
     18   USE dom_oce         ! for mi0; mi1 etc ... 
     19   USE fldread         ! read input fields 
    2320    
    2421   IMPLICIT NONE 
    2522   PRIVATE 
    2623 
    27    PUBLIC   lim_dmp_2     ! called by ice_step_2 
     24   PUBLIC   lim_dmp_2     ! called by sbc_ice_lim2 
     25 
     26   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   resto_ice   ! restoring coeff. on ICE   [s-1] 
     27 
     28   INTEGER, PARAMETER :: jp_hicif = 1 , jp_frld = 2 
     29   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_icedmp    ! structure of ice damping input 
    2830    
    29    INTEGER                        ::   nice1, nice2,  &  ! first and second record used 
    30       &                                inumice_dmp       ! logical unit for ice variables (damping) 
    31    REAL(wp), DIMENSION(jpi,jpj)   ::   hicif_dta  ,   &  ! ice thickness at a given time 
    32       &                                frld_dta          ! fraction lead at a given time 
    33    REAL(wp), DIMENSION(jpi,jpj,2) ::   hicif_data ,   &  ! ice thickness data at two consecutive times 
    34       &                                frld_data         ! fraction lead data at two consecutive times 
    35  
    3631   !! * Substitution 
    3732#  include "vectopt_loop_substitute.h90" 
    3833   !!---------------------------------------------------------------------- 
    39    !!   LIM 2.0 , UCL-LOCEAN-IPSL  (2006) 
     34   !! NEMO/LIM 3.3 , UCL-NEMO-consortium (2010)  
    4035   !! $Id$ 
    41    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4237   !!---------------------------------------------------------------------- 
    43  
    4438CONTAINS 
    4539 
    46    SUBROUTINE lim_dmp_2(kt) 
     40   SUBROUTINE lim_dmp_2( kt ) 
    4741      !!------------------------------------------------------------------- 
    48       !!                   ***  ROUTINE lim_dmp_2 *** 
     42      !!                   ***  ROUTINE lim_dmp_2  *** 
    4943      !! 
    50       !! ** purpose : ice model damping : restoring ice thickness and  
    51       !!              fraction leads 
     44      !! ** purpose : ice model damping : restoring ice thickness and fraction leads 
    5245      !! 
    53       !! ** method  : the key_tradmp must be used to compute resto(:,:) coef. 
     46      !! ** method  : the key_tradmp must be used to compute resto(:,:,1) coef. 
    5447      !!--------------------------------------------------------------------- 
    55       INTEGER, INTENT(in) ::   kt     ! ocean time-step 
     48      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
    5649      ! 
    57       INTEGER             ::   ji, jj         ! dummy loop indices 
     50      INTEGER  ::   ji, jj         ! dummy loop indices 
     51      REAL(wp) ::   zfrld, zhice   ! local scalars 
    5852      !!--------------------------------------------------------------------- 
    5953      ! 
    60       CALL dta_lim_2( kt ) 
    61  
    62       DO jj = 2, jpjm1 
    63          DO ji = fs_2, fs_jpim1   ! vector opt. 
    64             hicif(ji,jj) = hicif(ji,jj) - rdt_ice * resto(ji,jj,1) * ( hicif(ji,jj) - hicif_dta(ji,jj) ) 
    65             frld(ji,jj)  = frld (ji,jj) - rdt_ice * resto(ji,jj,1) * ( frld(ji,jj)  - frld_dta (ji,jj) )   
    66          END DO 
    67       END DO 
     54      IF (kt == nit000)  THEN  
     55         IF(lwp) WRITE(numout,*) 
     56         IF(lwp) WRITE(numout,*) 'lim_dmp_2 : Ice thickness and ice concentration restoring' 
     57         IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     58         ! 
     59         ! ice_resto_init create resto_ice (in 1/s) for restoring ice parameters near open boundaries. 
     60         ! Double check this routine to verify if it corresponds to your config 
     61         CALL lim_dmp_init 
     62      ENDIF 
     63      ! 
     64      IF( ln_limdmp ) THEN   ! ice restoring in this case 
     65         ! 
     66         CALL fld_read( kt, nn_fsbc, sf_icedmp ) 
     67         ! 
     68!CDIR COLLAPSE 
     69         hicif(:,:) = MAX( 0._wp,                     &        ! h >= 0         avoid spurious out of physical range 
     70            &         hicif(:,:) - rdt_ice * resto_ice(:,:,1) * ( hicif(:,:) - sf_icedmp(jp_hicif)%fnow(:,:,1) )  )  
     71!CDIR COLLAPSE 
     72         hicif(:,:) = MAX( 0._wp, MIN( 1._wp,         &        ! 0<= frld<=1    values which blow the run up 
     73            &         frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) )  )  ) 
     74         ! 
     75      ENDIF 
    6876      ! 
    6977   END SUBROUTINE lim_dmp_2 
    7078 
    7179 
    72    SUBROUTINE dta_lim_2( kt )  
     80   SUBROUTINE lim_dmp_init 
    7381      !!---------------------------------------------------------------------- 
    74       !!                   ***  ROUTINE dta_lim_2  *** 
     82      !!                   ***  ROUTINE lim_dmp_init  *** 
    7583      !! 
    76       !! ** Purpose :   Reads monthly ice thickness and fraction lead  data 
     84      !! ** Purpose :   Initialization for the ice thickness and concentration  
     85      !!                restoring 
     86      !!              restoring will be used. It is used to mimic ice open 
     87      !!              boundaries. 
    7788      !! 
    78       !! ** Method  :   Read on unit numicedt the interpolated ice variable 
    79       !!      onto the model grid. 
    80       !!      Data begin at january. 
    81       !!      The value is centered at the middle of month. 
    82       !!      In the opa model, kt=1 agree with january 1. 
    83       !!      At each time step, a linear interpolation is applied between 
    84       !!      two monthly values. 
     89      !! ** Method  :  ????? 
    8590      !!       
    86       !! ** Action  :   define hicif_dta and frld_dta arrays at time-step kt 
     91      !! ** Action  :   define resto_ice(:,:,1) 
    8792      !!---------------------------------------------------------------------- 
    88       INTEGER, INTENT(in) ::   kt     ! ocean time-step 
     93      INTEGER  :: ji, jj, jk       ! dummy loop indices 
     94      INTEGER  :: irelax, ierror   ! error flag for allocation 
    8995      ! 
    90       INTEGER  ::   imois, iman, i15          ! temporary integers 
    91       REAL(wp) ::   zxy 
     96      REAL(wp) :: zdmpmax, zdmpmin, zfactor, zreltim ! temporary scalar 
     97      ! 
     98      CHARACTER(len=100)           ::   cn_dir       ! Root directory for location of ssr files 
     99      TYPE(FLD_N), DIMENSION (2)   ::   sl_icedmp    ! informations about the icedmp  field to be read 
     100      TYPE(FLD_N)                  ::   sn_hicif     !  
     101      TYPE(FLD_N)                  ::   sn_frld      !  
     102      NAMELIST/namice_dmp/ cn_dir, ln_limdmp, sn_hicif, sn_frld 
    92103      !!---------------------------------------------------------------------- 
     104      ! 
     105      ! 1)  initialize fld read structure for input data  
     106      !     -------------------------------------------- 
     107      ln_limdmp = .false.                 !* set file information (default values) 
     108      cn_dir    = './' 
     109      ! (NB: frequency positive => hours, negative => months) 
     110      !                !    file     ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
     111      !                !    name     !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
     112      sn_hicif = FLD_N( 'ice_damping ', -1       , 'hicif'  ,  .true.    , .true.  ,  'yearly'   ,  ''      ,  ''      ) 
     113      sn_frld  = FLD_N( 'ice_damping ', -1       , 'frld'   ,  .true.    , .true.  ,  'yearly'   ,  ''      ,  ''      ) 
    93114 
    94       ! 0. Initialization 
    95       ! ----------------- 
    96       iman  = INT( raamo ) 
    97 !!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    98       i15   = nday / 16 
    99       imois = nmonth + i15 - 1 
    100       IF( imois == 0 ) imois = iman 
    101        
    102       ! 1. First call kt=nit000: Initialization and Open 
    103       ! ----------------------- 
    104       IF( kt == nit000 ) THEN 
    105          nice1 = 0 
    106          IF(lwp) WRITE(numout,*) 
    107          IF(lwp) WRITE(numout,*) 'dtalim : Ice thickness and lead fraction  monthly fields' 
    108          IF(lwp) WRITE(numout,*) '~~~~~~' 
    109          IF(lwp) WRITE(numout,*) '             NetCDF FORMAT' 
    110          IF(lwp) WRITE(numout,*) 
    111          ! open file 
    112          CALL iom_open( 'ice_damping_ATL4.nc', inumice_dmp ) 
     115      REWIND( numnam_ice )                !* read in namelist_ice namicedmp 
     116      READ  ( numnam_ice, namice_dmp ) 
     117      ! 
     118      IF ( lwp ) THEN                     !* control print 
     119         WRITE (numout,*)'     lim_dmp_init : lim_dmp initialization '  
     120         WRITE (numout,*)'       Namelist namicedmp read ' 
     121         WRITE (numout,*)'         Ice restoring (T) or not (F) ln_limdmp =', ln_limdmp  
     122         WRITE (numout,*) 
     123         WRITE (numout,*)'     CAUTION : here hard coded ice restoring along northern and southern boundaries' 
     124         WRITE (numout,*)'               adapt the lim_dmp_init routine to your needs' 
    113125      ENDIF 
    114126 
     127      ! 2)  initialise resto_ice    ==>  config dependant ! 
     128      !     --------------------         ++++++++++++++++ 
     129      ! 
     130      IF( ln_limdmp ) THEN                !* ice restoring is used, follow initialization 
     131         !  
     132         sl_icedmp ( jp_hicif ) = sn_hicif 
     133         sl_icedmp ( jp_frld  ) = sn_frld 
     134         ALLOCATE ( sf_icedmp (2) , resto_ice(jpi,jpj,1), STAT=ierror ) 
     135         IF( ierror > 0 ) THEN 
     136            CALL ctl_stop( 'lim_dmp_init: unable to allocate sf_icedmp structure or resto_ice array' )   ;   RETURN 
     137         ENDIF 
     138         ALLOCATE( sf_icedmp(jp_hicif)%fnow(jpi,jpj,1) , sf_icedmp(jp_hicif)%fdta(jpi,jpj,1,2) ) 
     139         ALLOCATE( sf_icedmp(jp_frld )%fnow(jpi,jpj,1) , sf_icedmp(jp_frld )%fdta(jpi,jpj,1,2) ) 
     140         !                         ! fill sf_icedmp with sn_icedmp and control print 
     141         CALL fld_fill( sf_icedmp, sl_icedmp, cn_dir, 'lim_dmp_init', 'Ice  restoring input data', 'namicedmp' ) 
     142       
     143         resto_ice(:,:,:) = 0._wp 
     144         !      Re-calculate the North and South boundary restoring term 
     145         !      because those boundaries may change with the prescribed zoom area. 
     146         ! 
     147         irelax  = 16                     ! width of buffer zone with respect to close boundary 
     148         zdmpmax = 10._wp                 ! max restoring time scale  (days) (low restoring) 
     149         zdmpmin = rdt_ice / 86400._wp    ! min restoring time scale  (days) (high restoring) 
     150         !                                ! days / grid-point 
     151         zfactor = ( zdmpmax - zdmpmin ) / REAL( irelax, wp ) 
    115152 
    116       ! 2. Read monthly file 
    117       ! -------------------- 
    118       IF( ( kt == nit000 ) .OR. imois /= nice1 ) THEN 
    119          ! 
    120          ! Calendar computation 
    121          nice1 = imois        ! first file record used  
    122          nice2 = nice1 + 1    ! last  file record used 
    123          nice1 = MOD( nice1, iman ) 
    124          nice2 = MOD( nice2, iman ) 
    125          IF( nice1 == 0 )   nice1 = iman 
    126          IF( nice2 == 0 )   nice2 = iman 
    127          IF(lwp) WRITE(numout,*) 'first record file used nice1 ', nice1 
    128          IF(lwp) WRITE(numout,*) 'last  record file used nice2 ', nice2 
    129           
    130          ! Read monthly ice thickness Levitus  
    131          CALL iom_get( inumice_dmp, jpdom_data, 'iicethic', hicif_data(:,:,1), nice1 )  
    132          CALL iom_get( inumice_dmp, jpdom_data, 'iicethic', hicif_data(:,:,2), nice2 )  
    133           
    134          ! Read monthly ice thickness Levitus  
    135          CALL iom_get( inumice_dmp, jpdom_data, 'ileadfra', frld_data(:,:,1), nice1 )  
    136          CALL iom_get( inumice_dmp, jpdom_data, 'ileadfra', frld_data(:,:,2), nice2 )  
    137           
    138          ! The fraction lead read in the file is in fact the  
    139          ! ice concentration which is 1 - the fraction lead 
    140          frld_data = 1 - frld_data           
    141           
    142          IF(lwp) THEN 
    143             WRITE(numout,*) 
    144             WRITE(numout,*) ' Ice thickness month ', nice1,' and ', nice2 
    145             WRITE(numout,*) 
    146             WRITE(numout,*) ' Ice thickness month = ', nice1 
    147             CALL prihre( hicif_data(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    148             WRITE(numout,*) 
    149             WRITE(numout,*) ' Fraction lead months ', nice1,' and ', nice2 
    150             WRITE(numout,*) 
    151             WRITE(numout,*) ' Fraction lead month = ', nice1 
    152             CALL prihre( frld_data(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    153          ENDIF 
     153         !    South boundary restoring term 
     154         ! REM: if there is no ice in the model and in the data,  
     155         !      no restoring even with non zero resto_ice 
     156         DO jj = mj0(jpjzoom - 1 + 1), mj1(jpjzoom -1 + irelax) 
     157            zreltim = zdmpmin + zfactor * ( mjg(jj) - jpjzoom + 1 ) 
     158            resto_ice(:,jj,:) = 1._wp / ( zreltim * 86400._wp ) 
     159         END DO 
    154160 
    155          CALL FLUSH(numout) 
    156  
     161         ! North boundary restoring term 
     162         DO jj =  mj0(jpjzoom -1 + jpjglo - irelax), mj1(jpjzoom - 1 + jpjglo) 
     163            zreltim = zdmpmin + zfactor * (jpjglo - ( mjg(jj) - jpjzoom + 1 )) 
     164            resto_ice(:,jj,:) = 1.e0 / ( zreltim * 86400 ) 
     165         END DO 
    157166      ENDIF 
    158          
    159       ! 3. At every time step compute ice thickness and fraction lead data 
    160       ! ------------------------------------------------------------------ 
    161       zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    162       hicif_dta(:,:) = (1.-zxy) * hicif_data(:,:,1) + zxy * hicif_data(:,:,2) 
    163       frld_dta (:,:) = (1.-zxy) * frld_data (:,:,1) + zxy * frld_data (:,:,2) 
    164  
    165       IF( kt == nitend )   CALL iom_close( inumice_dmp ) 
    166167      ! 
    167    END SUBROUTINE dta_lim_2 
    168  
     168   END SUBROUTINE lim_dmp_init 
     169    
    169170#else 
    170171   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

    • Property svn:eol-style deleted
    r1694 r2528  
    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 
     6   !! History :  1.0  ! 2001-04  (LIM)  Original code 
     7   !!            2.0  ! 2002-08  (C. Ethe, G. Madec)  F90, mpp 
     8   !!            2.0  ! 2003-08  (C. Ethe) add lim_dyn_init 
     9   !!            2.0  ! 2006-07  (G. Madec)  Surface module 
     10   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 
    1011   !!--------------------------------------------------------------------- 
    1112#if defined key_lim2 
    … …  
    1617   !!    lim_dyn_init_2 : initialization and namelist read 
    1718   !!---------------------------------------------------------------------- 
    18    USE dom_oce        ! ocean space and time domain 
    19    USE sbc_oce        ! 
    20    USE phycst         ! 
    21    USE ice_2          ! 
    22    USE dom_ice_2      ! 
    23    USE limistate_2    ! 
    24    USE limrhg_2       ! ice rheology 
    25  
    26    USE lbclnk         ! 
    27    USE lib_mpp        ! 
    28    USE in_out_manager ! I/O manager 
    29    USE prtctl         ! Print control 
     19   USE dom_oce          ! ocean space and time domain 
     20   USE sbc_oce          ! ocean surface boundary condition 
     21   USE phycst           ! physical constant 
     22   USE ice_2            ! LIM-2: ice variables 
     23   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
     24   USE dom_ice_2        ! LIM-2: ice domain 
     25   USE limistate_2      ! LIM-2: initial state 
     26   USE limrhg_2         ! LIM-2: VP  ice rheology 
     27   USE limrhg           ! LIM  : EVP ice rheology 
     28   USE lbclnk           ! lateral boundary condition - MPP link 
     29   USE lib_mpp          ! MPP library 
     30   USE in_out_manager   ! I/O manager 
     31   USE prtctl           ! Print control 
    3032 
    3133   IMPLICIT NONE 
    3234   PRIVATE 
    3335 
    34    PUBLIC   lim_dyn_2 ! routine called by sbc_ice_lim 
    35  
    36    !! * Module variables 
    37    REAL(wp)  ::  rone    = 1.e0   ! constant value 
    38  
     36   PUBLIC   lim_dyn_2   ! routine called by sbc_ice_lim 
     37 
     38   !! * Substitutions 
    3939#  include "vectopt_loop_substitute.h90" 
    4040   !!---------------------------------------------------------------------- 
    41    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
     41   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    4242   !! $Id$ 
    43    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    44    !!---------------------------------------------------------------------- 
    45  
     43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     44   !!---------------------------------------------------------------------- 
    4645CONTAINS 
    4746 
    … …  
    8382         ! --------------------------------------------------- 
    8483          
    85          IF( lk_mpp .OR. nbit_cmp == 1 ) THEN                    ! mpp: compute over the whole domain 
     84         IF( lk_mpp .OR. lk_mpp_rep ) THEN                    ! mpp: compute over the whole domain 
    8685            i_j1 = 1    
    8786            i_jpj = jpj 
    8887            IF(ln_ctl)   CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    89             CALL lim_rhg_2( i_j1, i_jpj ) 
     88            IF( lk_lim2_vp )   THEN   ;   CALL lim_rhg_2( i_j1, i_jpj )             !  VP rheology 
     89            ELSE                      ;   CALL lim_rhg  ( i_j1, i_jpj )             ! EVP rheology 
     90            ENDIF 
    9091            ! 
    9192         ELSE                                 ! optimization of the computational area 
    … …  
    105106                  i_j1 = i_j1 + 1 
    106107               END DO 
    107                i_j1 = MAX( 1, i_j1-1 ) 
    108                IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    109                !  
    110                CALL lim_rhg_2( i_j1, i_jpj ) 
    111                !  
     108               IF( lk_lim2_vp )   THEN             ! VP  rheology 
     109                  i_j1 = MAX( 1, i_j1-1 ) 
     110                  CALL lim_rhg_2( i_j1, i_jpj ) 
     111               ELSE                                ! EVP rheology 
     112                  i_j1 = MAX( 1, i_j1-2 ) 
     113                  CALL lim_rhg( i_j1, i_jpj ) 
     114               ENDIF 
     115               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, 'ij_jpj = ', i_jpj 
     116               ! 
    112117               ! Southern hemisphere 
    113118               i_j1  =  1  
    … …  
    116121                  i_jpj = i_jpj - 1 
    117122               END DO 
    118                i_jpj = MIN( jpj, i_jpj+2 ) 
    119                IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    120                !  
    121                CALL lim_rhg_2( i_j1, i_jpj ) 
    122                !  
     123               IF( lk_lim2_vp )   THEN             ! VP  rheology 
     124                  i_jpj = MIN( jpj, i_jpj+2 ) 
     125                  CALL lim_rhg_2( i_j1, i_jpj ) 
     126               ELSE                                ! EVP rheology 
     127                  i_jpj = MIN( jpj, i_jpj+1 ) 
     128                  CALL lim_rhg( i_j1, i_jpj ) 
     129               ENDIF 
     130               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, 'ij_jpj = ', i_jpj 
     131               ! 
    123132            ELSE                                 ! local domain extends over one hemisphere only 
    124133               !                                 ! Rheology is computed only over the ice cover 
    … …  
    134143                  i_jpj = i_jpj - 1 
    135144               END DO 
    136                i_jpj = MIN( jpj, i_jpj+2) 
    137      
     145               i_jpj = MIN( jpj, i_jpj+2 ) 
     146               !  
     147               IF( lk_lim2_vp )   THEN             ! VP  rheology 
     148                  i_jpj = MIN( jpj, i_jpj+2 ) 
     149                  CALL lim_rhg_2( i_j1, i_jpj )                !  VP rheology 
     150               ELSE                                ! EVP rheology 
     151                  i_j1  = MAX( 1  , i_j1-2  ) 
     152                  i_jpj = MIN( jpj, i_jpj+1 ) 
     153                  CALL lim_rhg  ( i_j1, i_jpj )                ! EVP rheology 
     154               ENDIF 
    138155               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    139                !  
    140                CALL lim_rhg_2( i_j1, i_jpj ) 
    141156               ! 
    142157            ENDIF 
    … …  
    148163         ! computation of friction velocity 
    149164         ! -------------------------------- 
    150          ! ice-ocean velocity at U & V-points (u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points) 
    151           
    152          DO jj = 1, jpjm1 
    153             DO ji = 1, jpim1   ! NO vector opt. 
    154                zu_io(ji,jj) = 0.5 * ( u_ice(ji+1,jj+1) + u_ice(ji+1,jj  ) ) - ssu_m(ji,jj) 
    155                zv_io(ji,jj) = 0.5 * ( v_ice(ji+1,jj+1) + v_ice(ji  ,jj+1) ) - ssv_m(ji,jj) 
    156             END DO 
    157          END DO 
     165         SELECT CASE( cp_ice_msh )           ! ice-ocean relative velocity at u- & v-pts 
     166         CASE( 'C' )                               ! EVP : C-grid ice dynamics 
     167            zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)           ! ice-ocean & ice velocity at ocean velocity points 
     168            zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
     169         CASE( 'I' )                               ! VP  : B-grid ice dynamics (I-point)  
     170            DO jj = 1, jpjm1                               ! u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points 
     171               DO ji = 1, jpim1   ! NO vector opt.         ! 
     172                  zu_io(ji,jj) = 0.5_wp * ( u_ice(ji+1,jj+1) + u_ice(ji+1,jj  ) ) - ssu_m(ji,jj) 
     173                  zv_io(ji,jj) = 0.5_wp * ( v_ice(ji+1,jj+1) + v_ice(ji  ,jj+1) ) - ssv_m(ji,jj) 
     174               END DO 
     175            END DO 
     176         END SELECT 
     177 
    158178         ! frictional velocity at T-point 
     179         zcoef = 0.5_wp * cw 
    159180         DO jj = 2, jpjm1 
    160181            DO ji = 2, jpim1   ! NO vector opt. because of zu_io 
    161                ust2s(ji,jj) = 0.5 * cw                                                          & 
    162                   &         * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    163                   &            + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj) 
     182               ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
     183                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj) 
    164184            END DO 
    165185         END DO 
    … …  
    170190         DO jj = 2, jpjm1 
    171191            DO ji = fs_2, fs_jpim1   ! vector opt. 
    172                ust2s(ji,jj) = zcoef * tms(ji,jj) * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    173                   &                                     + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) 
     192               ust2s(ji,jj) = zcoef * SQRT(  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     193                  &                        + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1)   ) * tms(ji,jj) 
    174194            END DO 
    175195         END DO 
    … …  
    180200      ! 
    181201      IF(ln_ctl)   CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :') 
    182  
     202      ! 
    183203   END SUBROUTINE lim_dyn_2 
    184204 
    … …  
    198218      NAMELIST/namicedyn/ epsd, alpha,     & 
    199219         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    200          &                c_rhg, etamn, creepl, ecc, ahi0 
     220         &                c_rhg, etamn, creepl, ecc, ahi0,                  & 
     221         &                nevp, telast,alphaevp 
    201222      !!------------------------------------------------------------------- 
    202223 
    … …  
    223244         WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc 
    224245         WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
     246         WRITE(numout,*) '       number of iterations for subcycling nevp   = ', nevp 
     247         WRITE(numout,*) '       timescale for elastic waves telast = ', telast 
     248         WRITE(numout,*) '       coefficient for the solution of int. stresses alphaevp = ', alphaevp 
     249      ENDIF 
     250      ! 
     251      IF( angvg /= 0._wp .AND. .NOT.lk_lim2_vp ) THEN 
     252         CALL ctl_warn( 'lim_dyn_init_2: turning angle for oceanic stress not properly coded for EVP ',   & 
     253            &           '(see limsbc_2 module). We force  angvg = 0._wp'  ) 
     254         angvg = 0._wp 
    225255      ENDIF 
    226256 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

    • Property svn:eol-style deleted
    r1465 r2528  
    3232#  include "vectopt_loop_substitute.h90" 
    3333   !!---------------------------------------------------------------------- 
    34    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     34   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    3535   !! $Id$ 
    36    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     36   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 
    3838 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90

    • Property svn:eol-style deleted
    r1471 r2528  
    4646   REAL(wp) ::   zone      = 1.e0     ! constant value = 1 
    4747   !!---------------------------------------------------------------------- 
    48    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
     48   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    4949   !! $Id$ 
    50    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     50   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5151   !!---------------------------------------------------------------------- 
    5252 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90

    • Property svn:eol-style deleted
    r1923 r2528  
    44   !! LIM 2.0 ice model :   definition of the ice mesh parameters 
    55   !!====================================================================== 
     6   !! History :   -   ! 2001-04 (LIM) original code 
     7   !!            1.0  ! 2002-08 (C. Ethe, G. Madec) F90, module 
     8   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_lim2 
    711   !!---------------------------------------------------------------------- 
    … …  
    1014   !!   lim_msh_2   : definition of the ice mesh 
    1115   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1316   USE phycst 
    1417   USE dom_oce 
    … …  
    2023   PRIVATE 
    2124 
    22    !! * Accessibility 
    2325   PUBLIC lim_msh_2      ! routine called by ice_ini_2.F90 
    2426 
    2527   !!---------------------------------------------------------------------- 
    26    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     28   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    2729   !! $Id$ 
    28    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    29    !!---------------------------------------------------------------------- 
    30  
     30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     31   !!---------------------------------------------------------------------- 
    3132CONTAINS 
    3233 
    … …  
    4344      !!  
    4445      !! ** Refer.  : Deleersnijder et al. Ocean Modelling 100, 7-10  
    45       !! 
    46       !! ** History : 
    47       !!         original    : 01-04 (LIM) 
    48       !!         addition    : 02-08 (C. Ethe, G. Madec) 
    4946      !!---------------------------------------------------------------------  
    50       !! * Local variables 
    5147      INTEGER :: ji, jj      ! dummy loop indices 
    52  
    53       REAL(wp), DIMENSION(jpi,jpj) ::  & 
    54          zd2d1 , zd1d2       ! Derivative of zh2 (resp. zh1) in the x direction 
    55          !                   ! (resp. y direction) (defined at the center) 
    56       REAL(wp) ::         & 
    57          zh1p  , zh2p   , &  ! Idem zh1, zh2 for the bottom left corner of the grid 
    58          zd2d1p, zd1d2p , &  ! Idem zd2d1, zd1d2 for the bottom left corner of the grid 
    59          zusden, zusden2     ! temporary scalars 
     48      REAL(wp) ::   zusden   ! local scalars 
     49#if defined key_lim2_vp 
     50      REAL(wp) ::   zusden2           ! local scalars 
     51      REAL(wp) ::   zh1p  , zh2p      !   -      - 
     52      REAL(wp) ::   zd2d1p, zd1d2p    !   -      - 
     53      REAL(wp), DIMENSION(jpi,jpj) ::   zd2d1 , zd1d2   ! 2D workspace 
     54#endif 
    6055      !!--------------------------------------------------------------------- 
    6156 
    … …  
    7671      njeqm1 = njeq - 1  
    7772 
    78       fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor 
     73      fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor at T-point 
    7974  
    8075!i    DO jj = 1, jpj 
    … …  
    115110      !------------------- 
    116111!!ibug ??? 
    117       akappa(:,:,:,:) = 0.e0 
    118112      wght(:,:,:,:) = 0.e0 
     113      tmu(:,:)      = 0.e0 
     114#if defined key_lim2_vp  
     115      akappa(:,:,:,:)     = 0.e0 
    119116      alambd(:,:,:,:,:,:) = 0.e0 
    120       tmu(:,:) = 0.e0 
     117#else 
     118      tmv(:,:) = 0.e0 
     119      tmf(:,:) = 0.e0 
     120#endif 
    121121!!i 
    122122       
    123        
     123 
     124#if defined key_lim2_vp       
    124125      ! metric coefficients for sea ice dynamic 
    125126      !---------------------------------------- 
    … …  
    155156      CALL lbc_lnk( wght(:,:,2,1), 'I', 1. )      ! but it is never used 
    156157      CALL lbc_lnk( wght(:,:,2,2), 'I', 1. ) 
     158#else 
     159      ! metric coefficients for sea ice dynamic (EVP rheology) 
     160      !---------------------------------------- 
     161      DO jj = 1, jpjm1                                       ! weights (wght) at F-points 
     162         DO ji = 1, jpim1 
     163            zusden = 1. / (  ( e1t(ji+1,jj  ) + e1t(ji,jj) )   & 
     164               &           * ( e2t(ji  ,jj+1) + e2t(ji,jj) ) )  
     165            wght(ji,jj,1,1) = zusden * e1t(ji+1,jj) * e2t(ji,jj+1) 
     166            wght(ji,jj,1,2) = zusden * e1t(ji+1,jj) * e2t(ji,jj  ) 
     167            wght(ji,jj,2,1) = zusden * e1t(ji  ,jj) * e2t(ji,jj+1) 
     168            wght(ji,jj,2,2) = zusden * e1t(ji  ,jj) * e2t(ji,jj  ) 
     169         END DO 
     170      END DO 
     171      CALL lbc_lnk( wght(:,:,1,1), 'F', 1. )   ;   CALL lbc_lnk( wght(:,:,1,2),'F', 1. )       ! lateral boundary cond.    
     172      CALL lbc_lnk( wght(:,:,2,1), 'F', 1. )   ;   CALL lbc_lnk( wght(:,:,2,2),'F', 1. ) 
     173#endif 
    157174     
    158175      ! Coefficients for divergence of the stress tensor 
    159176      !------------------------------------------------- 
    160177 
     178#if defined key_lim2_vp 
    161179      DO jj = 2, jpj 
    162180         DO ji = 2, jpi   ! NO vector opt. 
    … …  
    226244      CALL lbc_lnk( alambd(:,:,2,1,1,1), 'I', 1. )      ! 
    227245      CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. )      ! 
     246#endif 
    228247             
    229248 
    … …  
    233252      tms(:,:) = tmask(:,:,1)      ! ice T-point  : use surface tmask 
    234253 
     254#if defined key_lim2_vp 
     255      ! VP rheology : ice velocity point is I-point 
    235256!i here we can use umask with a i and j shift of -1,-1 
    236257      tmu(:,1) = 0.e0 
    … …  
    241262         END DO 
    242263      END DO 
    243        
    244       !--lateral boundary conditions     
    245       CALL lbc_lnk( tmu(:,:), 'I', 1. ) 
    246        
     264      CALL lbc_lnk( tmu(:,:), 'I', 1. )      !--lateral boundary conditions     
     265#else 
     266      ! EVP rheology : ice velocity point are U- & V-points ; ice vorticity 
     267      ! point is F-point 
     268      tmu(:,:) = umask(:,:,1) 
     269      tmv(:,:) = vmask(:,:,1) 
     270      tmf(:,:) = 0.e0                        ! used of fmask except its special value along the coast (rn_shlat) 
     271      WHERE( fmask(:,:,1) == 1.e0 )   tmf(:,:) = 1.e0 
     272#endif 
     273      ! 
    247274      ! unmasked and masked area of T-grid cell 
    248275      area(:,:) = e1t(:,:) * e2t(:,:) 
    249        
     276      ! 
    250277   END SUBROUTINE lim_msh_2 
    251278 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    • Property svn:eol-style deleted
    r1774 r2528  
    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    !!---------------------------------------------------------------------- 
    12 #if defined key_lim2 
    13    !!---------------------------------------------------------------------- 
    14    !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    15    !!---------------------------------------------------------------------- 
     6   !! History :  0.0  !  1993-12  (M.A. Morales Maqueda.)  Original code 
     7   !!            1.0  !  1994-12  (H. Goosse)  
     8   !!            2.0  !  2003-12  (C. Ethe, G. Madec)  F90, mpp 
     9   !!             -   !  2006-08  (G. Madec)  surface module, ice-stress at I-point 
     10   !!             -   !  2009-09  (G. Madec)  Huge verctor optimisation 
     11   !!            3.3  !  2009-05  (G.Garric, C. Bricaud) addition of the lim2_evp case 
     12   !!---------------------------------------------------------------------- 
     13#if defined   key_lim2   &&   defined key_lim2_vp 
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_lim2'                AND                   LIM-2 sea-ice model 
     16   !!   'key_lim2_vp'                                       VP ice rheology 
    1617   !!---------------------------------------------------------------------- 
    1718   !!   lim_rhg_2   : computes ice velocities 
    … …  
    2122   USE sbc_oce        ! surface boundary condition: ocean variables 
    2223   USE sbc_ice        ! surface boundary condition: ice variables 
    23    USE dom_ice_2      ! domaine: ice variables 
     24   USE dom_ice_2      ! LIM2: ice domain 
    2425   USE phycst         ! physical constant 
    25    USE ice_2          ! ice variables 
    26    USE lbclnk         ! lateral boundary condition 
     26   USE ice_2          ! LIM2: ice variables 
     27   USE lbclnk         ! lateral boundary condition - MPP exchanges 
    2728   USE lib_mpp        ! MPP library 
    2829   USE in_out_manager ! I/O manager 
    … …  
    3435   PUBLIC   lim_rhg_2 ! routine called by lim_dyn 
    3536 
    36    REAL(wp) ::   rzero   = 0.e0   ! constant value: zero 
    37    REAL(wp) ::   rone    = 1.e0   !            and  one 
     37   REAL(wp) ::   rzero   = 0._wp   ! constant value: zero 
     38   REAL(wp) ::   rone    = 1._wp   !            and  one 
    3839 
    3940   !! * Substitutions 
    4041#  include "vectopt_loop_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    42    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
     43   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    4344   !! $Id$ 
    44    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    45    !!---------------------------------------------------------------------- 
    46  
     45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     46   !!---------------------------------------------------------------------- 
    4747CONTAINS 
    4848 
    … …  
    6565      INTEGER ::   iter, jter          ! temporary integers 
    6666      CHARACTER (len=50) ::   charout 
    67       REAL(wp) ::   ze11  , ze12  , ze22  , ze21               ! temporary scalars 
    68       REAL(wp) ::   zt11  , zt12  , zt21  , zt22               !    "         " 
    69       REAL(wp) ::   zvis11, zvis21, zvis12, zvis22             !    "         " 
    70       REAL(wp) ::   zgphsx, ztagnx, zgsshx, zunw, zur, zusw    !    "         " 
    71       REAL(wp) ::   zgphsy, ztagny, zgsshy, zvnw, zvr          !    "         " 
     67      REAL(wp) ::   ze11  , ze12  , ze22  , ze21               ! local scalars 
     68      REAL(wp) ::   zt11  , zt12  , zt21  , zt22               !   -      - 
     69      REAL(wp) ::   zvis11, zvis21, zvis12, zvis22             !   -      - 
     70      REAL(wp) ::   zgphsx, ztagnx, zgsshx, zunw, zur, zusw    !   -      - 
     71      REAL(wp) ::   zgphsy, ztagny, zgsshy, zvnw, zvr          !   -      - 
    7272      REAL(wp) ::   zresm,  za, zac, zmod 
    7373      REAL(wp) ::   zmpzas, zstms, zindu, zusdtp, zmassdt, zcorlal 
    … …  
    8989      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zzfrld, zztms 
    9090      REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zi1, zi2, zmasst, zpresh 
    91  
    9291      !!------------------------------------------------------------------- 
    93  
    94 !!bug 
    95 !!    u_oce(:,:) = 0.e0 
    96 !!    v_oce(:,:) = 0.e0 
    97 !!    write(*,*) 'rhg min, max u & v', maxval(u_oce), minval(u_oce), maxval(v_oce), minval(v_oce) 
    98 !!bug 
    9992       
    10093      !  Store initial velocities 
    10194      !  ---------------- 
    102       zztms(:,0    ) = 0.e0       ;    zzfrld(:,0    ) = 0.e0 
    103       zztms(:,jpj+1) = 0.e0       ;    zzfrld(:,jpj+1) = 0.e0 
    104       zu0(:,0    ) = 0.e0         ;    zv0(:,0    ) = 0.e0 
    105       zu0(:,jpj+1) = 0.e0         ;    zv0(:,jpj+1) = 0.e0 
    106       zztms(:,1:jpj) = tms(:,:)   ;    zzfrld(:,1:jpj) = frld(:,:) 
    107       zu0(:,1:jpj) = u_ice(:,:)   ;    zv0(:,1:jpj) = v_ice(:,:) 
    108  
    109       zu_a(:,:)    = zu0(:,:)     ;   zv_a(:,:) = zv0(:,:) 
    110       zu_n(:,:)    = zu0(:,:)     ;   zv_n(:,:) = zv0(:,:) 
     95      zztms(:,0    ) = 0._wp        ;   zzfrld(:,0    ) = 0._wp 
     96      zztms(:,jpj+1) = 0._wp        ;   zzfrld(:,jpj+1) = 0._wp 
     97      zu0  (:,0    ) = 0._wp        ;   zv0   (:,0    ) = 0._wp 
     98      zu0  (:,jpj+1) = 0._wp        ;   zv0   (:,jpj+1) = 0._wp 
     99      zztms(:,1:jpj) = tms  (:,:)   ;   zzfrld(:,1:jpj) = frld (:,:) 
     100      zu0  (:,1:jpj) = u_ice(:,:)   ;   zv0   (:,1:jpj) = v_ice(:,:) 
     101      zu_a (:, :   ) = zu0  (:,:)   ;   zv_a  (:, :   ) = zv0  (:,:) 
     102      zu_n (:, :   ) = zu0  (:,:)   ;   zv_n  (:, :   ) = zv0  (:,:) 
    111103 
    112104!i 
    113       zi1   (:,:) = 0.e0 
    114       zi2   (:,:) = 0.e0 
    115       zpresh(:,:) = 0.e0 
    116       zmasst(:,:) = 0.e0 
     105      zi1   (:,:) = 0._wp 
     106      zi2   (:,:) = 0._wp 
     107      zpresh(:,:) = 0._wp 
     108      zmasst(:,:) = 0._wp 
    117109!i 
    118110!!gm violant 
    119       zfrld(:,:) =0.e0 
    120       zcorl(:,:) =0.e0 
    121       zmass(:,:) =0.e0 
    122       za1ct(:,:) =0.e0 
    123       za2ct(:,:) =0.e0 
     111      zfrld(:,:) =0._wp 
     112      zcorl(:,:) =0._wp 
     113      zmass(:,:) =0._wp 
     114      za1ct(:,:) =0._wp 
     115      za2ct(:,:) =0._wp 
    124116!!gm end 
    125117 
    126       zviszeta(:,:) = 0.e0 
    127       zviseta (:,:) = 0.e0 
    128  
    129 !i    zviszeta(:,0    ) = 0.e0    ;    zviseta(:,0    ) = 0.e0 
    130 !i    zviszeta(:,jpj  ) = 0.e0    ;    zviseta(:,jpj  ) = 0.e0 
    131 !i    zviszeta(:,jpj+1) = 0.e0    ;    zviseta(:,jpj+1) = 0.e0 
     118      zviszeta(:,:) = 0._wp 
     119      zviseta (:,:) = 0._wp 
     120 
     121!i    zviszeta(:,0    ) = 0._wp    ;    zviseta(:,0    ) = 0._wp 
     122!i    zviszeta(:,jpj  ) = 0._wp    ;    zviseta(:,jpj  ) = 0._wp 
     123!i    zviszeta(:,jpj+1) = 0._wp    ;    zviseta(:,jpj+1) = 0._wp 
    132124 
    133125 
    … …  
    141133         DO ji = 1 , jpi 
    142134            ! only the sinus changes its sign with the hemisphere 
    143             zsang(ji,jj)  = SIGN( 1.e0, fcor(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere 
     135            zsang(ji,jj)  = SIGN( 1._wp, fcor(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere 
    144136            ! 
    145137            zmasst(ji,jj) = tms(ji,jj) * ( rhosn * hsnm(ji,jj) + rhoic * hicm(ji,jj) ) 
    146138            zpresh(ji,jj) = tms(ji,jj) *  pstarh * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) ) 
    147139!!gm  :: stress given at I-point (F-point for the ocean) only compute the ponderation with the ice fraction (1-frld) 
    148             zi1(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) ) 
    149             zi2(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) ) 
     140            zi1(ji,jj)    = tms(ji,jj) * ( 1._wp - frld(ji,jj) ) 
     141            zi2(ji,jj)    = tms(ji,jj) * ( 1._wp - frld(ji,jj) ) 
    150142         END DO 
    151143      END DO 
    … …  
    161153            zstms = zztms(ji,jj  ) * wght(ji,jj,2,2) + zztms(ji-1,jj  ) * wght(ji,jj,1,2)   & 
    162154               &  + zztms(ji,jj-1) * wght(ji,jj,2,1) + zztms(ji-1,jj-1) * wght(ji,jj,1,1) 
    163             zusw  = 1.0 / MAX( zstms, epsd ) 
     155            zusw  = 1._wp / MAX( zstms, epsd ) 
    164156 
    165157            zt11 = zztms(ji  ,jj  ) * zzfrld(ji  ,jj  )  
    … …  
    199191            ! Gradient of the sea surface height 
    200192            zgsshx =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji-1,jj  ))/e1u(ji-1,jj  )   & 
    201                &       +  (ssh_m(ji  ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5 
     193               &       +  (ssh_m(ji  ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp 
    202194            zgsshy =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji  ,jj-1))/e2v(ji  ,jj-1)   & 
    203                &       +  (ssh_m(ji-1,jj  ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5 
     195               &       +  (ssh_m(ji-1,jj  ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp 
    204196 
    205197            ! Computation of the velocity field taking into account the ice-ice interaction.                                  
    … …  
    217209         !                                                ! ==================== !         
    218210         zindu = MOD( iter , 2 ) 
    219          zusdtp = ( zindu * 2.0 + ( 1.0 - zindu ) * 1.0 )  * REAL( nbiter ) / rdt_ice 
     211         zusdtp = ( zindu * 2._wp + ( 1._wp - zindu ) * 1._wp )  * REAL( nbiter ) / rdt_ice 
    220212 
    221213         ! Computation of free drift field for free slip boundary conditions. 
    … …  
    239231               zdgi = zt12 + zt21 
    240232               ztrace2 = zdgp * zdgp  
    241                zdeter  = zt11 * zt22 - 0.25 * zdgi * zdgi 
     233               zdeter  = zt11 * zt22 - 0.25_wp * zdgi * zdgi 
    242234 
    243235               !  Creep limit depends on the size of the grid. 
    244                zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4.0 * zdeter ) * usecc2 ),  creepl) 
     236               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  creepl) 
    245237 
    246238               !-  Computation of viscosities. 
    … …  
    254246            DO ji = 2, fs_jpim1   ! NO vector opt. 
    255247               !* zc1u , zc2v 
    256                zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm 
    257                zvis12 =       zviseta (ji-1,jj-1) + dm 
    258                zvis21 =       zviseta (ji-1,jj-1) 
    259                zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
     248               zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm 
     249               zvis12 =         zviseta (ji-1,jj-1) + dm 
     250               zvis21 =         zviseta (ji-1,jj-1) 
     251               zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
    260252               zdiag  = zvis22 * ( akappa(ji-1,jj-1,1,1) + akappa(ji-1,jj-1,2,1) ) 
    261253               zs11_11 =  zvis11 * akappa(ji-1,jj-1,1,1) + zdiag 
    … …  
    264256               zs22_11 =  zvis11 * akappa(ji-1,jj-1,2,1) + zdiag 
    265257 
    266                zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
    267                zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
    268                zvis12 =       zviseta (ji,jj-1) + dm 
    269                zvis21 =       zviseta (ji,jj-1) 
     258               zvis11 = 2._wp * zviseta (ji,jj-1) + dm 
     259               zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
     260               zvis12 =         zviseta (ji,jj-1) + dm 
     261               zvis21 =         zviseta (ji,jj-1) 
    270262               zdiag = zvis22 * ( -akappa(ji,jj-1,1,1) + akappa(ji,jj-1,2,1) ) 
    271263               zs11_21 = -zvis11 * akappa(ji,jj-1,1,1) + zdiag 
    … …  
    274266               zs21_21 = -zvis12 * akappa(ji,jj-1,1,2) + zvis21 * akappa(ji,jj-1,2,2) 
    275267 
    276                zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
    277                zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
    278                zvis12 =       zviseta (ji-1,jj) + dm 
    279                zvis21 =       zviseta (ji-1,jj) 
    280                zdiag = zvis22 * ( akappa(ji-1,jj,1,1) + akappa(ji-1,jj,2,1) ) 
     268               zvis11 = 2._wp * zviseta (ji-1,jj) + dm 
     269               zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
     270               zvis12 =         zviseta (ji-1,jj) + dm 
     271               zvis21 =         zviseta (ji-1,jj) 
     272               zdiag  = zvis22 * ( akappa(ji-1,jj,1,1) + akappa(ji-1,jj,2,1) ) 
    281273               zs11_12 =  zvis11 * akappa(ji-1,jj,1,1) + zdiag 
    282274               zs12_12 = -zvis12 * akappa(ji-1,jj,2,2) - zvis21 * akappa(ji-1,jj,1,2) 
    … …  
    284276               zs21_12 = -zvis12 * akappa(ji-1,jj,1,2) - zvis21 * akappa(ji-1,jj,2,2) 
    285277 
    286                zvis11 = 2.0 * zviseta (ji,jj) + dm 
    287                zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj) 
    288                zvis12 =       zviseta (ji,jj) + dm 
    289                zvis21 =       zviseta (ji,jj) 
     278               zvis11 = 2._wp * zviseta (ji,jj) + dm 
     279               zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj) 
     280               zvis12 =         zviseta (ji,jj) + dm 
     281               zvis21 =         zviseta (ji,jj) 
    290282               zdiag = zvis22 * ( -akappa(ji,jj,1,1) + akappa(ji,jj,2,1) ) 
    291283               zs11_22 = -zvis11 * akappa(ji,jj,1,1) + zdiag 
    … …  
    313305 
    314306               !* zc1v , zc2v. 
    315                zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm 
    316                zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
    317                zvis12 =       zviseta (ji-1,jj-1) + dm 
    318                zvis21 =       zviseta (ji-1,jj-1) 
     307               zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm 
     308               zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
     309               zvis12 =         zviseta (ji-1,jj-1) + dm 
     310               zvis21 =         zviseta (ji-1,jj-1) 
    319311               zdiag = zvis22 * ( akappa(ji-1,jj-1,1,2) + akappa(ji-1,jj-1,2,2) ) 
    320312               zs11_11 =  zvis11 * akappa(ji-1,jj-1,1,2) + zdiag 
    … …  
    323315               zs21_11 =  zvis12 * akappa(ji-1,jj-1,1,1) - zvis21 * akappa(ji-1,jj-1,2,1) 
    324316  
    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) 
     317               zvis11 = 2._wp * zviseta (ji,jj-1) + dm 
     318               zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
     319               zvis12 =         zviseta (ji,jj-1) + dm 
     320               zvis21 =         zviseta (ji,jj-1) 
    329321               zdiag = zvis22 * ( akappa(ji,jj-1,1,2) + akappa(ji,jj-1,2,2) ) 
    330322               zs11_21 =  zvis11 * akappa(ji,jj-1,1,2) + zdiag 
    … …  
    333325               zs21_21 = -zvis12 * akappa(ji,jj-1,1,1) - zvis21 * akappa(ji,jj-1,2,1) 
    334326 
    335                zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
    336                zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
    337                zvis12 =       zviseta (ji-1,jj) + dm 
    338                zvis21 =       zviseta (ji-1,jj) 
     327               zvis11 = 2._wp * zviseta (ji-1,jj) + dm 
     328               zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
     329               zvis12 =         zviseta (ji-1,jj) + dm 
     330               zvis21 =         zviseta (ji-1,jj) 
    339331               zdiag = zvis22 * ( akappa(ji-1,jj,1,2) - akappa(ji-1,jj,2,2) ) 
    340332               zs11_12 =  zvis11 * akappa(ji-1,jj,1,2) + zdiag 
    … …  
    343335               zs21_12 =  zvis12 * akappa(ji-1,jj,1,1) - zvis21 * akappa(ji-1,jj,2,1) 
    344336 
    345                zvis11 = 2.0 * zviseta (ji,jj) + dm 
    346                zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj) 
    347                zvis12 =       zviseta (ji,jj) + dm 
    348                zvis21 =       zviseta (ji,jj) 
     337               zvis11 = 2._wp * zviseta (ji,jj) + dm 
     338               zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj) 
     339               zvis12 =         zviseta (ji,jj) + dm 
     340               zvis21 =         zviseta (ji,jj) 
    349341               zdiag = zvis22 * ( akappa(ji,jj,1,2) - akappa(ji,jj,2,2) ) 
    350342               zs11_22 =  zvis11 * akappa(ji,jj,1,2) + zdiag 
    … …  
    386378                  ze22 = + akappa(ji,jj-1,2,2) * zv_a(ji+1,jj) + akappa(ji,jj-1,2,1) * zu_a(ji+1,jj) 
    387379                  ze21 =   akappa(ji,jj-1,1,1) * zv_a(ji+1,jj) - akappa(ji,jj-1,1,2) * zu_a(ji+1,jj) 
    388                   zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
    389                   zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
    390                   zvis12 =       zviseta (ji,jj-1) + dm 
    391                   zvis21 =       zviseta (ji,jj-1) 
     380                  zvis11 = 2._wp * zviseta (ji,jj-1) + dm 
     381                  zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
     382                  zvis12 =         zviseta (ji,jj-1) + dm 
     383                  zvis21 =         zviseta (ji,jj-1) 
    392384                  zdiag = zvis22 * ( ze11 + ze22 ) 
    393385                  zs11_21 =  zvis11 * ze11 + zdiag 
    … …  
    404396                  ze21 =   akappa(ji-1,jj,1,1) * ( zv_a(ji  ,jj+1) - zv_a(ji-1,jj+1) )   & 
    405397                     &   - akappa(ji-1,jj,1,2) * ( zu_a(ji  ,jj+1) + zu_a(ji-1,jj+1) ) 
    406                   zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
    407                   zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
    408                   zvis12 =       zviseta (ji-1,jj) + dm 
    409                   zvis21 =       zviseta (ji-1,jj) 
     398                  zvis11 = 2._wp * zviseta (ji-1,jj) + dm 
     399                  zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
     400                  zvis12 =         zviseta (ji-1,jj) + dm 
     401                  zvis21 =         zviseta (ji-1,jj) 
    410402                  zdiag = zvis22 * ( ze11 + ze22 ) 
    411403                  zs11_12 =  zvis11 * ze11 + zdiag 
    … …  
    422414                  ze21 =   akappa(ji,jj,1,1) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) - zv_a(ji  ,jj+1) )   & 
    423415                     &   - akappa(ji,jj,1,2) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) + zu_a(ji  ,jj+1) ) 
    424                   zvis11 = 2.0 * zviseta (ji,jj) + dm 
    425                   zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj) 
    426                   zvis12 =       zviseta (ji,jj) + dm 
    427                   zvis21 =       zviseta (ji,jj) 
     416                  zvis11 = 2._wp * zviseta (ji,jj) + dm 
     417                  zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj) 
     418                  zvis12 =         zviseta (ji,jj) + dm 
     419                  zvis21 =         zviseta (ji,jj) 
    428420                  zdiag = zvis22 * ( ze11 + ze22 ) 
    429421                  zs11_22 =  zvis11 * ze11 + zdiag 
    … …  
    441433                  ze21 =   akappa(ji-1,jj-1,1,1) * ( zv_a(ji  ,jj-1) - zv_a(ji-1,jj-1) - zv_a(ji-1,jj) )   & 
    442434                     &  -  akappa(ji-1,jj-1,1,2) * ( zu_a(ji  ,jj-1) + zu_a(ji-1,jj-1) + zu_a(ji-1,jj) ) 
    443                   zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm 
    444                   zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
    445                   zvis12 =       zviseta (ji-1,jj-1) + dm 
    446                   zvis21 =       zviseta (ji-1,jj-1) 
     435                  zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm 
     436                  zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1) 
     437                  zvis12 =         zviseta (ji-1,jj-1) + dm 
     438                  zvis21 =         zviseta (ji-1,jj-1) 
    447439                  zdiag = zvis22 * ( ze11 + ze22 ) 
    448440                  zs11_11 =  zvis11 * ze11 + zdiag 
    … …  
    459451                  ze21 =   akappa(ji,jj-1,1,1) * ( zv_a(ji+1,jj-1) - zv_a(ji  ,jj-1) )   & 
    460452                     &   - akappa(ji,jj-1,1,2) * ( zu_a(ji+1,jj-1) + zu_a(ji  ,jj-1) ) 
    461                   zvis11 = 2.0 * zviseta (ji,jj-1) + dm 
    462                   zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
    463                   zvis12 =       zviseta (ji,jj-1) + dm 
    464                   zvis21 =       zviseta (ji,jj-1) 
     453                  zvis11 = 2._wp * zviseta (ji,jj-1) + dm 
     454                  zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1) 
     455                  zvis12 =         zviseta (ji,jj-1) + dm 
     456                  zvis21 =         zviseta (ji,jj-1) 
    465457                  zdiag = zvis22 * ( ze11 + ze22 ) 
    466458                  zs11_21 =  zs11_21 + zvis11 * ze11 + zdiag 
    … …  
    473465                  ze22 = - akappa(ji-1,jj,2,2) * zv_a(ji-1,jj) + akappa(ji-1,jj,2,1) * zu_a(ji-1,jj) 
    474466                  ze21 = - akappa(ji-1,jj,1,1) * zv_a(ji-1,jj) - akappa(ji-1,jj,1,2) * zu_a(ji-1,jj) 
    475                   zvis11 = 2.0 * zviseta (ji-1,jj) + dm 
    476                   zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
    477                   zvis12 =       zviseta (ji-1,jj) + dm 
    478                   zvis21 =       zviseta (ji-1,jj) 
     467                  zvis11 = 2._wp * zviseta (ji-1,jj) + dm 
     468                  zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj) 
     469                  zvis12 =         zviseta (ji-1,jj) + dm 
     470                  zvis21 =         zviseta (ji-1,jj) 
    479471                  zdiag = zvis22 * ( ze11 + ze22 ) 
    480472                  zs11_12 =  zs11_12 + zvis11 * ze11 + zdiag 
    … …  
    504496                  zvr     = zv_a(ji,jj) - v_oce(ji,jj) 
    505497!!!! 
    506                   zmod    = SQRT( zur*zur + zvr*zvr ) * ( 1.0 - zfrld(ji,jj) ) 
     498                  zmod    = SQRT( zur*zur + zvr*zvr ) * ( 1._wp - zfrld(ji,jj) ) 
    507499                  za      = rhoco * zmod 
    508500!!!! 
    509 !!gm chg resul    za      = rhoco * SQRT( zur*zur + zvr*zvr ) * ( 1.0 - zfrld(ji,jj) ) 
     501!!gm chg resul    za      = rhoco * SQRT( zur*zur + zvr*zvr ) * ( 1._wp - zfrld(ji,jj) ) 
    510502                  zac     = za * cangvg 
    511503                  zmpzas  = alpha * zcorl(ji,jj) + za * zsang(ji,jj) 
    512504                  zmassdt = zusdtp * zmass(ji,jj) 
    513                   zcorlal = ( 1.0 - alpha ) * zcorl(ji,jj) 
     505                  zcorlal = ( 1._wp - alpha ) * zcorl(ji,jj) 
    514506 
    515507                  za1 =  zmassdt * zu0(ji,jj) + zcorlal * zv0(ji,jj) + za1ct(ji,jj)   & 
    … …  
    525517                  zunw   = (  ( za1 + zd1 ) * zc2 + ( za2 + zd2 ) * zc1 ) * zden 
    526518                  zvnw   = (  ( za2 + zd2 ) * zb1 - ( za1 + zd1 ) * zb2 ) * zden 
    527                   zmask  = ( 1.0 - MAX( rzero, SIGN( rone , 1.0 - zmass(ji,jj) ) ) ) * tmu(ji,jj) 
     519                  zmask  = ( 1._wp - MAX( rzero, SIGN( rone , 1._wp - zmass(ji,jj) ) ) ) * tmu(ji,jj) 
    528520 
    529521                  zu_n(ji,jj) = ( zu_a(ji,jj) + om * ( zunw - zu_a(ji,jj) ) * tmu(ji,jj) ) * zmask 
    … …  
    580572#else 
    581573   !!---------------------------------------------------------------------- 
    582    !!   Default option          Dummy module       NO 2.0 LIM sea-ice model 
     574   !!   Default option        Dummy module      NO VP & LIM-2 sea-ice model 
    583575   !!---------------------------------------------------------------------- 
    584576CONTAINS 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90

    • Property svn:eol-style deleted
    r1715 r2528  
    66   !! History :  2.0  !  01-04  (C. Ethe, G. Madec)  Original code 
    77   !!                 !  06-07  (S. Masson)  use IOM for restart read/write 
     8   !!            3.3  !  09-05  (G.Garric) addition of the lim2_evp case 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_lim2 
    1011   !!---------------------------------------------------------------------- 
    1112   !!   'key_lim2' :                                  LIM 2.0 sea-ice model 
    12    !!---------------------------------------------------------------------- 
    1313   !!---------------------------------------------------------------------- 
    1414   !!   lim_rst_opn_2   : open ice restart file 
    … …  
    1616   !!   lim_rst_read_2  : read  the ice restart file  
    1717   !!---------------------------------------------------------------------- 
    18    USE dom_oce         ! ocean space and time domain 
    19    USE ice_2 
    20    USE sbc_oce 
    21    USE sbc_ice 
    22  
    23    USE in_out_manager 
    24    USE iom 
     18   USE dom_oce          ! ocean domain 
     19   USE ice_2            ! LIM-2: sea-ice variables 
     20   USE sbc_oce          ! Surface Boundary Condition: ocean 
     21   USE sbc_ice          ! Surface Boundary Condition: sea-ice 
     22   USE in_out_manager   ! I/O manager 
     23   USE iom              ! I/O library 
    2524 
    2625   IMPLICIT NONE 
    … …  
    3534 
    3635   !!---------------------------------------------------------------------- 
    37    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
     36   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    3837   !! $Id$ 
    39    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    40    !!---------------------------------------------------------------------- 
    41  
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    4240CONTAINS 
    4341 
    … …  
    8482   END SUBROUTINE lim_rst_opn_2 
    8583 
     84 
    8685   SUBROUTINE lim_rst_write_2( kt ) 
    8786      !!---------------------------------------------------------------------- 
    … …  
    108107      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter, wp) )  
    109108       
    110       CALL iom_rstput( iter, nitrst, numriw, 'hicif' , hicif (:,:)   )      ! prognostic variables  
    111       CALL iom_rstput( iter, nitrst, numriw, 'hsnif' , hsnif (:,:)   ) 
    112       CALL iom_rstput( iter, nitrst, numriw, 'frld'  , frld  (:,:)   ) 
    113       CALL iom_rstput( iter, nitrst, numriw, 'sist'  , sist  (:,:)   ) 
    114       CALL iom_rstput( iter, nitrst, numriw, 'tbif1' , tbif  (:,:,1) ) 
    115       CALL iom_rstput( iter, nitrst, numriw, 'tbif2' , tbif  (:,:,2) ) 
    116       CALL iom_rstput( iter, nitrst, numriw, 'tbif3' , tbif  (:,:,3) ) 
    117       CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice (:,:)   ) 
    118       CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice (:,:)   ) 
    119       CALL iom_rstput( iter, nitrst, numriw, 'qstoif', qstoif(:,:)   ) 
    120       CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq (:,:)   ) 
    121       CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice (:,:)   ) 
    122       CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice (:,:)   ) 
    123       CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice(:,:)   ) 
    124       CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice(:,:)   ) 
    125       CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice(:,:)   ) 
    126       CALL iom_rstput( iter, nitrst, numriw, 'sxsn'  , sxsn  (:,:)   ) 
    127       CALL iom_rstput( iter, nitrst, numriw, 'sysn'  , sysn  (:,:)   ) 
    128       CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn (:,:)   ) 
    129       CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn (:,:)   ) 
    130       CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn (:,:)   ) 
    131       CALL iom_rstput( iter, nitrst, numriw, 'sxa'   , sxa   (:,:)   ) 
    132       CALL iom_rstput( iter, nitrst, numriw, 'sya'   , sya   (:,:)   ) 
    133       CALL iom_rstput( iter, nitrst, numriw, 'sxxa'  , sxxa  (:,:)   ) 
    134       CALL iom_rstput( iter, nitrst, numriw, 'syya'  , syya  (:,:)   ) 
    135       CALL iom_rstput( iter, nitrst, numriw, 'sxya'  , sxya  (:,:)   ) 
    136       CALL iom_rstput( iter, nitrst, numriw, 'sxc0'  , sxc0  (:,:)   ) 
    137       CALL iom_rstput( iter, nitrst, numriw, 'syc0'  , syc0  (:,:)   ) 
    138       CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' , sxxc0 (:,:)   ) 
    139       CALL iom_rstput( iter, nitrst, numriw, 'syyc0' , syyc0 (:,:)   ) 
    140       CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' , sxyc0 (:,:)   ) 
    141       CALL iom_rstput( iter, nitrst, numriw, 'sxc1'  , sxc1  (:,:)   ) 
    142       CALL iom_rstput( iter, nitrst, numriw, 'syc1'  , syc1  (:,:)   ) 
    143       CALL iom_rstput( iter, nitrst, numriw, 'sxxc1' , sxxc1 (:,:)   ) 
    144       CALL iom_rstput( iter, nitrst, numriw, 'syyc1' , syyc1 (:,:)   ) 
    145       CALL iom_rstput( iter, nitrst, numriw, 'sxyc1' , sxyc1 (:,:)   ) 
    146       CALL iom_rstput( iter, nitrst, numriw, 'sxc2'  , sxc2  (:,:)   ) 
    147       CALL iom_rstput( iter, nitrst, numriw, 'syc2'  , syc2  (:,:)   ) 
    148       CALL iom_rstput( iter, nitrst, numriw, 'sxxc2' , sxxc2 (:,:)   ) 
    149       CALL iom_rstput( iter, nitrst, numriw, 'syyc2' , syyc2 (:,:)   ) 
    150       CALL iom_rstput( iter, nitrst, numriw, 'sxyc2' , sxyc2 (:,:)   ) 
    151       CALL iom_rstput( iter, nitrst, numriw, 'sxst'  , sxst  (:,:)   ) 
    152       CALL iom_rstput( iter, nitrst, numriw, 'syst'  , syst  (:,:)   ) 
    153       CALL iom_rstput( iter, nitrst, numriw, 'sxxst' , sxxst (:,:)   ) 
    154       CALL iom_rstput( iter, nitrst, numriw, 'syyst' , syyst (:,:)   ) 
    155       CALL iom_rstput( iter, nitrst, numriw, 'sxyst' , sxyst (:,:)   ) 
     109      CALL iom_rstput( iter, nitrst, numriw, 'hicif'      , hicif (:,:)   )      ! prognostic variables  
     110      CALL iom_rstput( iter, nitrst, numriw, 'hsnif'      , hsnif (:,:)   ) 
     111      CALL iom_rstput( iter, nitrst, numriw, 'frld'       , frld  (:,:)   ) 
     112      CALL iom_rstput( iter, nitrst, numriw, 'sist'       , sist  (:,:)   ) 
     113      CALL iom_rstput( iter, nitrst, numriw, 'tbif1'      , tbif  (:,:,1) ) 
     114      CALL iom_rstput( iter, nitrst, numriw, 'tbif2'      , tbif  (:,:,2) ) 
     115      CALL iom_rstput( iter, nitrst, numriw, 'tbif3'      , tbif  (:,:,3) ) 
     116      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'      , u_ice (:,:)   ) 
     117      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'      , v_ice (:,:)   ) 
     118      CALL iom_rstput( iter, nitrst, numriw, 'qstoif'     , qstoif(:,:)   ) 
     119      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'      , fsbbq (:,:)   ) 
     120#if ! defined key_lim2_vp 
     121      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'  , stress1_i (:,:) )    ! EVP rheology 
     122      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'  , stress2_i (:,:) ) 
     123      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i' , stress12_i(:,:) ) 
     124#endif 
     125      CALL iom_rstput( iter, nitrst, numriw, 'sxice'      , sxice (:,:)   ) 
     126      CALL iom_rstput( iter, nitrst, numriw, 'syice'      , syice (:,:)   ) 
     127      CALL iom_rstput( iter, nitrst, numriw, 'sxxice'     , sxxice(:,:)   ) 
     128      CALL iom_rstput( iter, nitrst, numriw, 'syyice'     , syyice(:,:)   ) 
     129      CALL iom_rstput( iter, nitrst, numriw, 'sxyice'     , sxyice(:,:)   ) 
     130      CALL iom_rstput( iter, nitrst, numriw, 'sxsn'       , sxsn  (:,:)   ) 
     131      CALL iom_rstput( iter, nitrst, numriw, 'sysn'       , sysn  (:,:)   ) 
     132      CALL iom_rstput( iter, nitrst, numriw, 'sxxsn'      , sxxsn (:,:)   ) 
     133      CALL iom_rstput( iter, nitrst, numriw, 'syysn'      , syysn (:,:)   ) 
     134      CALL iom_rstput( iter, nitrst, numriw, 'sxysn'      , sxysn (:,:)   ) 
     135      CALL iom_rstput( iter, nitrst, numriw, 'sxa'        , sxa   (:,:)   ) 
     136      CALL iom_rstput( iter, nitrst, numriw, 'sya'        , sya   (:,:)   ) 
     137      CALL iom_rstput( iter, nitrst, numriw, 'sxxa'       , sxxa  (:,:)   ) 
     138      CALL iom_rstput( iter, nitrst, numriw, 'syya'       , syya  (:,:)   ) 
     139      CALL iom_rstput( iter, nitrst, numriw, 'sxya'       , sxya  (:,:)   ) 
     140      CALL iom_rstput( iter, nitrst, numriw, 'sxc0'       , sxc0  (:,:)   ) 
     141      CALL iom_rstput( iter, nitrst, numriw, 'syc0'       , syc0  (:,:)   ) 
     142      CALL iom_rstput( iter, nitrst, numriw, 'sxxc0'      , sxxc0 (:,:)   ) 
     143      CALL iom_rstput( iter, nitrst, numriw, 'syyc0'      , syyc0 (:,:)   ) 
     144      CALL iom_rstput( iter, nitrst, numriw, 'sxyc0'      , sxyc0 (:,:)   ) 
     145      CALL iom_rstput( iter, nitrst, numriw, 'sxc1'       , sxc1  (:,:)   ) 
     146      CALL iom_rstput( iter, nitrst, numriw, 'syc1'       , syc1  (:,:)   ) 
     147      CALL iom_rstput( iter, nitrst, numriw, 'sxxc1'      , sxxc1 (:,:)   ) 
     148      CALL iom_rstput( iter, nitrst, numriw, 'syyc1'      , syyc1 (:,:)   ) 
     149      CALL iom_rstput( iter, nitrst, numriw, 'sxyc1'      , sxyc1 (:,:)   ) 
     150      CALL iom_rstput( iter, nitrst, numriw, 'sxc2'       , sxc2  (:,:)   ) 
     151      CALL iom_rstput( iter, nitrst, numriw, 'syc2'       , syc2  (:,:)   ) 
     152      CALL iom_rstput( iter, nitrst, numriw, 'sxxc2'      , sxxc2 (:,:)   ) 
     153      CALL iom_rstput( iter, nitrst, numriw, 'syyc2'      , syyc2 (:,:)   ) 
     154      CALL iom_rstput( iter, nitrst, numriw, 'sxyc2'      , sxyc2 (:,:)   ) 
     155      CALL iom_rstput( iter, nitrst, numriw, 'sxst'       , sxst  (:,:)   ) 
     156      CALL iom_rstput( iter, nitrst, numriw, 'syst'       , syst  (:,:)   ) 
     157      CALL iom_rstput( iter, nitrst, numriw, 'sxxst'      , sxxst (:,:)   ) 
     158      CALL iom_rstput( iter, nitrst, numriw, 'syyst'      , syyst (:,:)   ) 
     159      CALL iom_rstput( iter, nitrst, numriw, 'sxyst'      , sxyst (:,:)   ) 
    156160       
    157161      IF( iter == nitrst ) THEN 
    … …  
    218222      ENDIF 
    219223 
    220       CALL iom_get( numrir, jpdom_autoglo, 'qstoif', qstoif )     
    221       CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq  )     
    222       CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice  ) 
    223       CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice  ) 
    224       CALL iom_get( numrir, jpdom_autoglo, 'sxxice', sxxice ) 
    225       CALL iom_get( numrir, jpdom_autoglo, 'syyice', syyice ) 
    226       CALL iom_get( numrir, jpdom_autoglo, 'sxyice', sxyice ) 
    227       CALL iom_get( numrir, jpdom_autoglo, 'sxsn'  , sxsn   ) 
    228       CALL iom_get( numrir, jpdom_autoglo, 'sysn'  , sysn   ) 
    229       CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn  ) 
    230       CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn  ) 
    231       CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn  ) 
    232       CALL iom_get( numrir, jpdom_autoglo, 'sxa'   , sxa    ) 
    233       CALL iom_get( numrir, jpdom_autoglo, 'sya'   , sya    ) 
    234       CALL iom_get( numrir, jpdom_autoglo, 'sxxa'  , sxxa   ) 
    235       CALL iom_get( numrir, jpdom_autoglo, 'syya'  , syya   ) 
    236       CALL iom_get( numrir, jpdom_autoglo, 'sxya'  , sxya   ) 
    237       CALL iom_get( numrir, jpdom_autoglo, 'sxc0'  , sxc0   ) 
    238       CALL iom_get( numrir, jpdom_autoglo, 'syc0'  , syc0   ) 
    239       CALL iom_get( numrir, jpdom_autoglo, 'sxxc0' , sxxc0  ) 
    240       CALL iom_get( numrir, jpdom_autoglo, 'syyc0' , syyc0  ) 
    241       CALL iom_get( numrir, jpdom_autoglo, 'sxyc0' , sxyc0  ) 
    242       CALL iom_get( numrir, jpdom_autoglo, 'sxc1'  , sxc1   ) 
    243       CALL iom_get( numrir, jpdom_autoglo, 'syc1'  , syc1   ) 
    244       CALL iom_get( numrir, jpdom_autoglo, 'sxxc1' , sxxc1  ) 
    245       CALL iom_get( numrir, jpdom_autoglo, 'syyc1' , syyc1  ) 
    246       CALL iom_get( numrir, jpdom_autoglo, 'sxyc1' , sxyc1  ) 
    247       CALL iom_get( numrir, jpdom_autoglo, 'sxc2'  , sxc2   ) 
    248       CALL iom_get( numrir, jpdom_autoglo, 'syc2'  , syc2   ) 
    249       CALL iom_get( numrir, jpdom_autoglo, 'sxxc2' , sxxc2  ) 
    250       CALL iom_get( numrir, jpdom_autoglo, 'syyc2' , syyc2  ) 
    251       CALL iom_get( numrir, jpdom_autoglo, 'sxyc2' , sxyc2  ) 
    252       CALL iom_get( numrir, jpdom_autoglo, 'sxst'  , sxst   ) 
    253       CALL iom_get( numrir, jpdom_autoglo, 'syst'  , syst   ) 
    254       CALL iom_get( numrir, jpdom_autoglo, 'sxxst' , sxxst  ) 
    255       CALL iom_get( numrir, jpdom_autoglo, 'syyst' , syyst  ) 
    256       CALL iom_get( numrir, jpdom_autoglo, 'sxyst' , sxyst  ) 
     224      CALL iom_get( numrir, jpdom_autoglo, 'qstoif'     , qstoif )     
     225      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'      , fsbbq  )     
     226#if ! defined key_lim2_vp 
     227      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i'  , stress1_i  ) 
     228      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i'  , stress2_i  ) 
     229      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i' , stress12_i ) 
     230#endif 
     231      CALL iom_get( numrir, jpdom_autoglo, 'sxice'      , sxice  ) 
     232      CALL iom_get( numrir, jpdom_autoglo, 'syice'      , syice  ) 
     233      CALL iom_get( numrir, jpdom_autoglo, 'sxxice'     , sxxice ) 
     234      CALL iom_get( numrir, jpdom_autoglo, 'syyice'     , syyice ) 
     235      CALL iom_get( numrir, jpdom_autoglo, 'sxyice'     , sxyice ) 
     236      CALL iom_get( numrir, jpdom_autoglo, 'sxsn'       , sxsn   ) 
     237      CALL iom_get( numrir, jpdom_autoglo, 'sysn'       , sysn   ) 
     238      CALL iom_get( numrir, jpdom_autoglo, 'sxxsn'      , sxxsn  ) 
     239      CALL iom_get( numrir, jpdom_autoglo, 'syysn'      , syysn  ) 
     240      CALL iom_get( numrir, jpdom_autoglo, 'sxysn'      , sxysn  ) 
     241      CALL iom_get( numrir, jpdom_autoglo, 'sxa'        , sxa    ) 
     242      CALL iom_get( numrir, jpdom_autoglo, 'sya'        , sya    ) 
     243      CALL iom_get( numrir, jpdom_autoglo, 'sxxa'       , sxxa   ) 
     244      CALL iom_get( numrir, jpdom_autoglo, 'syya'       , syya   ) 
     245      CALL iom_get( numrir, jpdom_autoglo, 'sxya'       , sxya   ) 
     246      CALL iom_get( numrir, jpdom_autoglo, 'sxc0'       , sxc0   ) 
     247      CALL iom_get( numrir, jpdom_autoglo, 'syc0'       , syc0   ) 
     248      CALL iom_get( numrir, jpdom_autoglo, 'sxxc0'      , sxxc0  ) 
     249      CALL iom_get( numrir, jpdom_autoglo, 'syyc0'      , syyc0  ) 
     250      CALL iom_get( numrir, jpdom_autoglo, 'sxyc0'      , sxyc0  ) 
     251      CALL iom_get( numrir, jpdom_autoglo, 'sxc1'       , sxc1   ) 
     252      CALL iom_get( numrir, jpdom_autoglo, 'syc1'       , syc1   ) 
     253      CALL iom_get( numrir, jpdom_autoglo, 'sxxc1'      , sxxc1  ) 
     254      CALL iom_get( numrir, jpdom_autoglo, 'syyc1'      , syyc1  ) 
     255      CALL iom_get( numrir, jpdom_autoglo, 'sxyc1'      , sxyc1  ) 
     256      CALL iom_get( numrir, jpdom_autoglo, 'sxc2'       , sxc2   ) 
     257      CALL iom_get( numrir, jpdom_autoglo, 'syc2'       , syc2   ) 
     258      CALL iom_get( numrir, jpdom_autoglo, 'sxxc2'      , sxxc2  ) 
     259      CALL iom_get( numrir, jpdom_autoglo, 'syyc2'      , syyc2  ) 
     260      CALL iom_get( numrir, jpdom_autoglo, 'sxyc2'      , sxyc2  ) 
     261      CALL iom_get( numrir, jpdom_autoglo, 'sxst'       , sxst   ) 
     262      CALL iom_get( numrir, jpdom_autoglo, 'syst'       , syst   ) 
     263      CALL iom_get( numrir, jpdom_autoglo, 'sxxst'      , sxxst  ) 
     264      CALL iom_get( numrir, jpdom_autoglo, 'syyst'      , syyst  ) 
     265      CALL iom_get( numrir, jpdom_autoglo, 'sxyst'      , sxyst  ) 
    257266       
    258267      CALL iom_close( numrir ) 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r1928 r2528  
    22   !!====================================================================== 
    33   !!                       ***  MODULE limsbc_2   *** 
    4    !!           computation of the flux at the sea ice/ocean interface 
     4   !! LIM-2 :   updates the fluxes at the ocean surface with ice-ocean fluxes 
    55   !!====================================================================== 
    6    !! History : 00-01 (H. Goosse) Original code 
    7    !!           02-07 (C. Ethe, G. Madec) re-writing F90 
    8    !!           06-07 (G. Madec) surface module 
     6   !! History :  LIM  ! 2000-01 (H. Goosse) Original code 
     7   !!            1.0  ! 2002-07 (C. Ethe, G. Madec) re-writing F90 
     8   !!            3.0  ! 2006-07 (G. Madec) surface module 
     9   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 
     10   !!             -   ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step 
    911   !!---------------------------------------------------------------------- 
    1012#if defined key_lim2 
    … …  
    1214   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
    1315   !!---------------------------------------------------------------------- 
    14    !!---------------------------------------------------------------------- 
    15    !!   lim_sbc_2  : flux at the ice / ocean interface 
     16   !!   lim_sbc_flx_2  : update mass, heat and salt fluxes at the ocean surface 
     17   !!   lim_sbc_tau_2  : update i- and j-stresses, and its modulus at the ocean surface 
    1618   !!---------------------------------------------------------------------- 
    1719   USE par_oce          ! ocean parameters 
     20   USE phycst           ! physical constants 
    1821   USE dom_oce          ! ocean domain 
    19    USE sbc_ice          ! surface boundary condition 
    20    USE sbc_oce          ! surface boundary condition 
    21    USE phycst           ! physical constants 
    22    USE ice_2            ! LIM sea-ice variables 
    23  
    24    USE lbclnk           ! ocean lateral boundary condition 
     22   USE dom_ice_2        ! LIM-2: ice domain 
     23   USE ice_2            ! LIM-2: ice variables 
     24   USE sbc_ice          ! surface boundary condition: ice 
     25   USE sbc_oce          ! surface boundary condition: ocean 
     26 
     27   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges 
    2528   USE in_out_manager   ! I/O manager 
    2629   USE diaar5, ONLY :   lk_diaar5 
    27    USE iom              !  
     30   USE iom              ! I/O library 
    2831   USE albedo           ! albedo parameters 
    2932   USE prtctl           ! Print control 
    … …  
    3336   PRIVATE 
    3437 
    35    PUBLIC lim_sbc_2     ! called by sbc_ice_lim_2 
    36  
    37    REAL(wp)  ::   epsi16 = 1.e-16  ! constant values 
    38    REAL(wp)  ::   rzero  = 0.e0     
    39    REAL(wp)  ::   rone   = 1.e0 
    40    REAL(wp), DIMENSION(jpi,jpj)  ::   soce_r 
    41    REAL(wp), DIMENSION(jpi,jpj)  ::   sice_r 
     38   PUBLIC   lim_sbc_flx_2   ! called by sbc_ice_lim_2 
     39   PUBLIC   lim_sbc_tau_2   ! called by sbc_ice_lim_2 
     40 
     41   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice  
     42   REAL(wp)  ::   epsi16 = 1.e-16_wp   ! constant values 
     43   REAL(wp)  ::   rzero  = 0._wp       !     -      - 
     44   REAL(wp)  ::   rone   = 1._wp       !     -      - 
     45   ! 
     46   REAL(wp), DIMENSION(jpi,jpj) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case 
     47 
     48   REAL(wp), DIMENSION(jpi,jpj) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2] 
     49   REAL(wp), DIMENSION(jpi,jpj) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s] 
    4250 
    4351   !! * Substitutions 
    4452#  include "vectopt_loop_substitute.h90" 
    4553   !!---------------------------------------------------------------------- 
    46    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006)  
     54   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    4755   !! $Id$ 
    48    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    49    !!---------------------------------------------------------------------- 
    50  
     56   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     57   !!---------------------------------------------------------------------- 
    5158CONTAINS 
    5259 
    53    SUBROUTINE lim_sbc_2( kt ) 
     60   SUBROUTINE lim_sbc_flx_2( kt ) 
    5461      !!------------------------------------------------------------------- 
    5562      !!                ***  ROUTINE lim_sbc_2 *** 
    … …  
    7582      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
    7683      !!--------------------------------------------------------------------- 
    77       INTEGER ::   kt    ! number of iteration 
     84      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    7885      !! 
    79       INTEGER  ::   ji, jj           ! dummy loop indices 
    80       INTEGER  ::   ifvt, i1mfr, idfr               ! some switches 
    81       INTEGER  ::   iflt, ial, iadv, ifral, ifrdv 
    82       REAL(wp) ::   zrdtir           ! 1. / rdt_ice 
    83       REAL(wp) ::   zqsr  , zqns     ! solar & non solar heat flux 
    84       REAL(wp) ::   zinda            ! switch for testing the values of ice concentration 
    85       REAL(wp) ::   zfons            ! salt exchanges at the ice/ocean interface 
    86       REAL(wp) ::   zemp             ! freshwater exchanges at the ice/ocean interface 
    87       REAL(wp) ::   zfrldu, zfrldv   ! lead fraction at U- & V-points 
    88       REAL(wp) ::   zutau , zvtau    ! lead fraction at U- & V-points 
    89       REAL(wp) ::   zu_io , zv_io    ! 2 components of the ice-ocean velocity 
    90 ! interface 2D --> 3D 
    91       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb     ! albedo of ice under overcast sky 
    92       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalbp    ! albedo of ice under clear sky 
    93       REAL(wp) ::   zsang, zmod, zztmp, zfm 
    94       REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! component of ocean stress below sea-ice at I-point 
    95       REAL(wp), DIMENSION(jpi,jpj) ::   ztiomi           ! module    of ocean stress below sea-ice at I-point 
    96       REAL(wp), DIMENSION(jpi,jpj) ::   zqnsoce          ! save qns before its modification by ice model 
    97  
     86      INTEGER  ::   ji, jj   ! dummy loop indices 
     87      INTEGER  ::   ii0, ii1, ij0, ij1         ! local integers 
     88      INTEGER  ::   ifvt, i1mfr, idfr, iflt    !   -       - 
     89      INTEGER  ::   ial, iadv, ifral, ifrdv    !   -       - 
     90      REAL(wp) ::   zqsr, zqns, zfm            ! local scalars 
     91      REAL(wp) ::   zinda, zfons, zemp         !   -      - 
     92      REAL(wp), DIMENSION(jpi,jpj)   ::   zqnsoce       ! 2D workspace 
     93      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb, zalbp   ! 2D/3D workspace 
    9894      !!--------------------------------------------------------------------- 
    9995      
    100       zrdtir = 1. / rdt_ice 
    101        
    10296      IF( kt == nit000 ) THEN 
    10397         IF(lwp) WRITE(numout,*) 
    104          IF(lwp) WRITE(numout,*) 'lim_sbc_2 : LIM 2.0 sea-ice - surface boundary condition' 
    105          IF(lwp) WRITE(numout,*) '~~~~~~~~~   ' 
    106  
    107          soce_r(:,:) = soce 
    108          sice_r(:,:) = sice 
    109          ! 
    110          IF( cp_cfg == "orca" ) THEN 
    111            !   ocean/ice salinity in the Baltic sea  
    112            DO jj = 1, jpj 
    113               DO ji = 1, jpi 
    114                  IF( glamt(ji,jj) >= 14. .AND.  glamt(ji,jj) <= 32. .AND. gphit(ji,jj) >= 54. .AND. gphit(ji,jj) <= 66. ) THEN  
    115                    soce_r(ji,jj) = 4.e0  
    116                    sice_r(ji,jj) = 2.e0 
    117                  END IF 
    118               END DO 
    119            END DO 
    120            ! 
    121          END IF 
    122       END IF 
     98         IF(lwp) WRITE(numout,*) 'lim_sbc_flx_2 : LIM-2 sea-ice - surface boundary condition - Mass, heat & salt fluxes' 
     99         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   ' 
     100         ! 
     101         r1_rdtice = 1. / rdt_ice 
     102         ! 
     103         soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
     104         sice_0(:,:) = sice 
     105         ! 
     106         IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
     107            WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     108               &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     109               soce_0(:,:) = 4._wp 
     110               sice_0(:,:) = 2._wp 
     111            END WHERE 
     112         ENDIF 
     113         ! 
     114      ENDIF 
    123115 
    124116      !------------------------------------------! 
    … …  
    126118      !------------------------------------------! 
    127119 
    128 !!gm 
    129 !!gm CAUTION    
    130 !!gm re-verifies the non solar expression, especially over open ocen 
    131 !!gm 
    132120      zqnsoce(:,:) = qns(:,:) 
    133121      DO jj = 1, jpj 
    … …  
    186174            zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr   &   ! part of the solar energy used in leads 
    187175               &       + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                            & 
    188                &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * zrdtir    & 
    189                &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * zrdtir 
     176               &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice    & 
     177               &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) )                   * r1_rdtice  
    190178 
    191179            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! ??? 
    192              
     180            ! 
    193181            qsr  (ji,jj) = zqsr                                          ! solar heat flux  
    194182            qns  (ji,jj) = zqns - fdtcn(ji,jj)                           ! non solar heat flux 
    … …  
    198186      CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )       
    199187      CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )       
    200       CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1. - pfrld(:,:)) ) 
     188      CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 
    201189 
    202190      !------------------------------------------! 
    203191      !      mass flux at the ocean surface      ! 
    204192      !------------------------------------------! 
    205  
    206 !!gm 
    207 !!gm CAUTION    
    208 !!gm re-verifies the emp & emps expression, especially the absence of 1-frld on zfm 
    209 !!gm 
    210193      DO jj = 1, jpj 
    211194         DO ji = 1, jpi 
    212              
     195            ! 
    213196#if defined key_coupled 
    214           zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  
    215              &   + rdmsnif(ji,jj) * zrdtir                                      !  freshwaterflux due to snow melting  
     197            ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode) 
     198            zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  
     199               &   + rdmsnif(ji,jj) * r1_rdtice                                   !  freshwaterflux due to snow melting  
    216200#else 
    217 !!$            !  computing freshwater exchanges at the ice/ocean interface 
    218 !!$            zpme = - evap(ji,jj)    *   frld(ji,jj)           &   !  evaporation over oceanic fraction 
    219 !!$               &   + tprecip(ji,jj)                           &   !  total precipitation 
    220 !!$               &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )   &   !  remov. snow precip over ice 
    221 !!$               &   - rdmsnif(ji,jj) / rdt_ice                     !  freshwaterflux due to snow melting  
    222201            !  computing freshwater exchanges at the ice/ocean interface 
    223202            zemp = + emp(ji,jj)     *         frld(ji,jj)      &   !  e-p budget over open ocean fraction  
    224203               &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &   !  liquid precipitation reaches directly the ocean 
    225204               &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  taking into account change in ice cover within the time step 
    226                &   + rdmsnif(ji,jj) * zrdtir                       !  freshwaterflux due to snow melting  
     205               &   + rdmsnif(ji,jj) * r1_rdtice                    !  freshwaterflux due to snow melting  
    227206               !                                                   !  ice-covered fraction: 
    228207#endif             
    229  
     208            ! 
    230209            !  computing salt exchanges at the ice/ocean interface 
    231             zfons =  ( soce_r(ji,jj) - sice_r(ji,jj) ) * ( rdmicif(ji,jj) * zrdtir )  
    232              
     210            zfons =  ( soce_0(ji,jj) - sice_0(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice )  
     211            ! 
    233212            !  converting the salt flux from ice to a freshwater flux from ocean 
    234213            zfm  = zfons / ( sss_m(ji,jj) + epsi16 ) 
    235              
     214            ! 
    236215            emps(ji,jj) = zemp + zfm      ! surface ocean concentration/dilution effect (use on SSS evolution) 
    237216            emp (ji,jj) = zemp            ! surface ocean volume flux (use on sea-surface height evolution) 
    238  
     217            ! 
    239218         END DO 
    240219      END DO 
    241220 
    242       IF( lk_diaar5 ) THEN 
    243          CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * zrdtir ) 
    244          CALL iom_put( 'fsal_virt_cea',   soce_r(:,:) * rdmicif(:,:) * zrdtir ) 
    245          CALL iom_put( 'fsal_real_cea', - sice_r(:,:) * rdmicif(:,:) * zrdtir ) 
    246       ENDIF 
    247  
    248       !------------------------------------------! 
    249       !    momentum flux at the ocean surface    ! 
    250       !------------------------------------------! 
    251  
    252       IF ( ln_limdyn ) THEN                        ! Update the stress over ice-over area (only in ice-dynamic case) 
    253          !                                         ! otherwise the atmosphere-ocean stress is used everywhere 
    254  
    255          ! ... ice stress over ocean with a ice-ocean rotation angle (at I-point) 
    256 !CDIR NOVERRCHK 
    257          DO jj = 1, jpj 
    258 !CDIR NOVERRCHK 
    259             DO ji = 1, jpi 
    260                ! ... change the cosinus angle sign in the south hemisphere 
    261                zsang  = SIGN(1.e0, gphif(ji,jj) ) * sangvg 
    262                ! ... ice velocity relative to the ocean at I-point 
    263                zu_io  = u_ice(ji,jj) - u_oce(ji,jj) 
    264                zv_io  = v_ice(ji,jj) - v_oce(ji,jj) 
    265                zmod   = SQRT( zu_io * zu_io + zv_io * zv_io ) 
    266                zztmp  = rhoco * zmod 
    267                ! ... components of ice stress over ocean with a ice-ocean rotation angle (at I-point) 
    268                ztio_u(ji,jj) = zztmp * ( cangvg * zu_io - zsang * zv_io ) 
    269                ztio_v(ji,jj) = zztmp * ( cangvg * zv_io + zsang * zu_io ) 
    270                ! ... module of ice stress over ocean (at I-point) 
    271                ztiomi(ji,jj) = zztmp * zmod 
    272                !  
    273             END DO 
    274          END DO 
    275  
    276          DO jj = 2, jpjm1 
    277             DO ji = 2, jpim1   ! NO vector opt. 
    278                ! ... components of ice-ocean stress at U and V-points  (from I-point values) 
    279                zutau  = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) ) 
    280                zvtau  = 0.5 * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) ) 
    281                ! ... open-ocean (lead) fraction at U- & V-points (from T-point values) 
    282                zfrldu = 0.5 * ( frld(ji,jj) + frld(ji+1,jj  ) ) 
    283                zfrldv = 0.5 * ( frld(ji,jj) + frld(ji  ,jj+1) ) 
    284                ! ... update components of surface ocean stress (ice-cover wheighted) 
    285                utau(ji,jj) = zfrldu * utau(ji,jj) + ( 1. - zfrldu ) * zutau 
    286                vtau(ji,jj) = zfrldv * vtau(ji,jj) + ( 1. - zfrldv ) * zvtau 
    287                ! ... module of ice-ocean stress at T-points (from I-point values) 
    288                zztmp = 0.25 * ( ztiomi(ji,jj) + ztiomi(ji+1,jj) + ztiomi(ji,jj+1) + ztiomi(ji+1,jj+1) ) 
    289                ! ... update module of surface ocean stress (ice-cover wheighted) 
    290                taum(ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1. - frld(ji,jj) ) * zztmp 
    291                ! 
    292             END DO 
    293          END DO 
    294  
    295          ! boundary condition on the stress (utau,vtau,taum) 
    296          CALL lbc_lnk( utau, 'U', -1. ) 
    297          CALL lbc_lnk( vtau, 'V', -1. ) 
    298          CALL lbc_lnk( taum, 'T',  1. ) 
    299  
     221      IF( lk_diaar5 ) THEN       ! AR5 diagnostics 
     222         CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * r1_rdtice ) 
     223         CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdmicif(:,:) * r1_rdtice ) 
     224         CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdmicif(:,:) * r1_rdtice ) 
    300225      ENDIF 
    301226 
    … …  
    304229      !-----------------------------------------------! 
    305230 
    306       IF ( lk_cpl ) THEN            
     231      IF( lk_cpl ) THEN          ! coupled case 
    307232         ! Ice surface temperature  
    308233         tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature        
    … …  
    313238      ENDIF 
    314239 
    315       IF(ln_ctl) THEN 
     240      IF(ln_ctl) THEN            ! control print 
    316241         CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ') 
    317242         CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=emps  , clinfo2=' emps    : ') 
    … …  
    320245         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ') 
    321246      ENDIF  
    322     
    323     END SUBROUTINE lim_sbc_2 
     247      ! 
     248   END SUBROUTINE lim_sbc_flx_2 
     249 
     250 
     251   SUBROUTINE lim_sbc_tau_2( kt , pu_oce, pv_oce ) 
     252      !!------------------------------------------------------------------- 
     253      !!                ***  ROUTINE lim_sbc_tau *** 
     254      !!   
     255      !! ** Purpose : Update the ocean surface stresses due to the ice 
     256      !!          
     257      !! ** Action  : * at each ice time step (every nn_fsbc time step): 
     258      !!                - compute the modulus of ice-ocean relative velocity  
     259      !!                  at T-point (C-grid) or I-point (B-grid) 
     260      !!                      tmod_io = rhoco * | U_ice-U_oce | 
     261      !!                - update the modulus of stress at ocean surface 
     262      !!                      taum = frld * taum + (1-frld) * tmod_io * | U_ice-U_oce | 
     263      !!              * at each ocean time step (each kt):  
     264      !!                  compute linearized ice-ocean stresses as 
     265      !!                      Utau = tmod_io * | U_ice - pU_oce | 
     266      !!                using instantaneous current ocean velocity (usually before) 
     267      !! 
     268      !!    NB: - the averaging operator used depends on the ice dynamics grid (cp_ice_msh='I' or 'C') 
     269      !!        - ice-ocean rotation angle only allowed in cp_ice_msh='I' case 
     270      !!        - here we make an approximation: taum is only computed every ice time step 
     271      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids  
     272      !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton... 
     273      !! 
     274      !! ** Outputs : - utau, vtau   : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes 
     275      !!              - taum         : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes 
     276      !!--------------------------------------------------------------------- 
     277      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index 
     278      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents 
     279      !! 
     280      INTEGER  ::   ji, jj   ! dummy loop indices 
     281      REAL(wp) ::   zfrldu, zat_u, zu_i, zutau_ice, zu_t, zmodt   ! local scalar 
     282      REAL(wp) ::   zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi   !   -      - 
     283      REAL(wp) ::   zsang, zumt                                          !    -         - 
     284      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice 
     285      !!--------------------------------------------------------------------- 
     286      ! 
     287      IF( kt == nit000 .AND. lwp ) THEN         ! control print 
     288         WRITE(numout,*) 
     289         WRITE(numout,*) 'lim_sbc_tau_2 : LIM 2.0 sea-ice - surface ocean momentum fluxes' 
     290         WRITE(numout,*) '~~~~~~~~~~~~~ ' 
     291         IF( lk_lim2_vp )   THEN   ;   WRITE(numout,*) '                VP  rheology - B-grid case' 
     292         ELSE                      ;   WRITE(numout,*) '                EVP rheology - C-grid case' 
     293         ENDIF 
     294      ENDIF 
     295      ! 
     296      SELECT CASE( cp_ice_msh )      
     297      !                             !-----------------------! 
     298      CASE( 'I' )                   !  B-grid ice dynamics  !   I-point (i.e. F-point with sea-ice indexation) 
     299         !                          !--=--------------------! 
     300         ! 
     301         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step) 
     302!CDIR NOVERRCHK 
     303            DO jj = 1, jpj                               !* modulus of ice-ocean relative velocity at I-point 
     304!CDIR NOVERRCHK 
     305               DO ji = 1, jpi 
     306                  zu_i  = u_ice(ji,jj) - u_oce(ji,jj)                   ! ice-ocean relative velocity at I-point 
     307                  zv_i  = v_ice(ji,jj) - v_oce(ji,jj) 
     308                  tmod_io(ji,jj) = SQRT( zu_i * zu_i + zv_i * zv_i )    ! modulus of this velocity (at I-point) 
     309               END DO 
     310            END DO 
     311!CDIR NOVERRCHK 
     312            DO jj = 1, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
     313!CDIR NOVERRCHK 
     314               DO ji = 1, jpim1   ! NO vector opt. 
     315                  !                                               ! modulus of U_ice-U_oce at T-point 
     316                  zumt  = 0.25_wp * (  tmod_io(ji+1,jj) + tmod_io(ji+1,jj+1)    &    
     317                     &               + tmod_io(ji,jj+1) + tmod_io(ji+1,jj+1)  ) 
     318                  !                                               ! update the modulus of stress at ocean surface 
     319                  taum(ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1._wp - frld(ji,jj) ) * rhoco * zumt * zumt 
     320               END DO 
     321            END DO 
     322            CALL lbc_lnk( taum, 'T', 1. ) 
     323            ! 
     324            utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
     325            vtau_oce(:,:) = vtau(:,:) 
     326            ! 
     327         ENDIF 
     328         ! 
     329         !                                        !==  at each ocean time-step  ==! 
     330         ! 
     331         !                                               !* ice/ocean stress WITH a ice-ocean rotation angle at I-point 
     332         DO jj = 2, jpj 
     333            zsang  = SIGN( 1._wp, gphif(1,jj) ) * sangvg          ! change the cosine angle sign in the SH  
     334            DO ji = 2, jpi    ! NO vect. opt. possible 
     335               ! ... ice-ocean relative velocity at I-point using instantaneous surface ocean current at u- & v-pts 
     336               zu_i = u_ice(ji,jj) - 0.5_wp * ( pu_oce(ji-1,jj  ) + pu_oce(ji-1,jj-1) ) * tmu(ji,jj) 
     337               zv_i = v_ice(ji,jj) - 0.5_wp * ( pv_oce(ji  ,jj-1) + pv_oce(ji-1,jj-1) ) * tmu(ji,jj) 
     338               ! ... components of stress with a ice-ocean rotation angle  
     339               zmodi = rhoco * tmod_io(ji,jj)                      
     340               ztio_u(ji,jj) = zmodi * ( cangvg * zu_i - zsang * zv_i ) 
     341               ztio_v(ji,jj) = zmodi * ( cangvg * zv_i + zsang * zu_i ) 
     342            END DO 
     343         END DO 
     344         !                                               !* surface ocean stresses at u- and v-points 
     345         DO jj = 2, jpjm1 
     346            DO ji = 2, jpim1   ! NO vector opt. 
     347               !                                   ! ice-ocean stress at U and V-points  (from I-point values) 
     348               zutau_ice  = 0.5_wp * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) ) 
     349               zvtau_ice  = 0.5_wp * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) ) 
     350               !                                   ! open-ocean (lead) fraction at U- & V-points (from T-point values) 
     351               zfrldu = 0.5_wp * ( frld(ji,jj) + frld(ji+1,jj  ) ) 
     352               zfrldv = 0.5_wp * ( frld(ji,jj) + frld(ji  ,jj+1) ) 
     353               !                                   ! update the surface ocean stress (ice-cover wheighted) 
     354               utau(ji,jj) = zfrldu * utau_oce(ji,jj) + ( 1._wp - zfrldu ) * zutau_ice 
     355               vtau(ji,jj) = zfrldv * vtau_oce(ji,jj) + ( 1._wp - zfrldv ) * zvtau_ice 
     356            END DO 
     357         END DO 
     358         CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )     ! lateral boundary condition 
     359         ! 
     360         ! 
     361         !                          !-----------------------! 
     362      CASE( 'C' )                   !  C-grid ice dynamics  !   U & V-points (same as in the ocean) 
     363         !                          !--=--------------------! 
     364         ! 
     365         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step) 
     366!CDIR NOVERRCHK 
     367            DO jj = 2, jpjm1                          !* modulus of the ice-ocean velocity at T-point 
     368!CDIR NOVERRCHK 
     369               DO ji = fs_2, fs_jpim1 
     370                  zu_t  = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   ! 2*(U_ice-U_oce) at T-point 
     371                  zv_t  = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1)       
     372                  zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )                      ! |U_ice-U_oce|^2 
     373                  !                                               ! update the modulus of stress at ocean surface 
     374                  taum   (ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1._wp - frld(ji,jj) ) * rhoco * zmodt 
     375                  tmod_io(ji,jj) = SQRT( zmodt ) * rhoco          ! rhoco*|Uice-Uoce| 
     376               END DO 
     377            END DO 
     378            CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. ) 
     379            ! 
     380            utau_oce(:,:) = utau(:,:)                 !* save the air-ocean stresses at ice time-step 
     381            vtau_oce(:,:) = vtau(:,:) 
     382            ! 
     383         ENDIF 
     384         ! 
     385         !                                        !==  at each ocean time-step  ==! 
     386         ! 
     387         DO jj = 2, jpjm1                             !* ice stress over ocean WITHOUT a ice-ocean rotation angle 
     388            DO ji = fs_2, fs_jpim1 
     389               !                                            ! ocean area at u- & v-points 
     390               zfrldu  = 0.5_wp * ( frld(ji,jj) + frld(ji+1,jj  ) ) 
     391               zfrldv  = 0.5_wp * ( frld(ji,jj) + frld(ji  ,jj+1) ) 
     392               !                                            ! quadratic drag formulation without rotation 
     393               !                                            ! using instantaneous surface ocean current 
     394               zutau_ice = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) ) 
     395               zvtau_ice = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) ) 
     396               !                                            ! update the surface ocean stress (ice-cover wheighted) 
     397               utau(ji,jj) = zfrldu * utau_oce(ji,jj) + ( 1._wp - zfrldu ) * zutau_ice 
     398               vtau(ji,jj) = zfrldv * vtau_oce(ji,jj) + ( 1._wp - zfrldv ) * zvtau_ice 
     399            END DO 
     400         END DO 
     401         CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition 
     402         ! 
     403      END SELECT 
     404 
     405      IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   & 
     406         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask ) 
     407      !   
     408   END SUBROUTINE lim_sbc_tau_2 
    324409 
    325410#else 
    326411   !!---------------------------------------------------------------------- 
    327    !!   Default option :        Dummy module       NO LIM 2.0 sea-ice model 
    328    !!---------------------------------------------------------------------- 
    329 CONTAINS 
    330    SUBROUTINE lim_sbc_2         ! Dummy routine 
    331    END SUBROUTINE lim_sbc_2 
     412   !!   Default option         Empty module        NO LIM 2.0 sea-ice model 
     413   !!---------------------------------------------------------------------- 
    332414#endif  
    333415 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90

    • Property svn:eol-style deleted
    r1156 r2528  
    2020 
    2121   !!---------------------------------------------------------------------- 
    22    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     22   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    2323   !! $Id$ 
    24    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     24   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2525   !!---------------------------------------------------------------------- 
    2626CONTAINS 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    • Property svn:eol-style deleted
    r2411 r2528  
    5050#  include "vectopt_loop_substitute.h90" 
    5151   !!-------- ------------------------------------------------------------- 
    52    !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2009)  
     52   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    5353   !! $Id$ 
    54    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     54   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5555   !!---------------------------------------------------------------------- 
    5656 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90

    • Property svn:eol-style deleted
    r1697 r2528  
    2828      zone   = 1.e0 
    2929   !!---------------------------------------------------------------------- 
    30    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     30   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    3131   !! $Id$ 
    32    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     32   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 
    3434CONTAINS 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    • Property svn:eol-style deleted
    r1756 r2528  
    3333      &          zone   = 1.e0 
    3434   !!---------------------------------------------------------------------- 
    35    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     35   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    3636   !! $Id$ 
    37    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 
    3939 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

    • Property svn:eol-style deleted
    r1922 r2528  
    77   !!            2.0  !  2001-05 (G. Madec, R. Hordoir) opa norm 
    88   !!             -   !  2004-01 (G. Madec, C. Ethe)  F90, mpp 
     9   !!            3.3  !  2009-05  (G. Garric, C. Bricaud) addition of the lim2_evp case 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_lim2 
    … …  
    3233   PUBLIC   lim_trp_2   ! called by sbc_ice_lim_2 
    3334 
    34    REAL(wp), PUBLIC  ::   bound  = 0.e0   !: boundary condit. (0.0 no-slip, 1.0 free-slip) 
    35  
    36    REAL(wp)  ::           &  ! constant values 
    37       epsi06 = 1.e-06  ,  & 
    38       epsi03 = 1.e-03  ,  & 
    39       epsi16 = 1.e-16  ,  & 
    40       rzero  = 0.e0    ,  & 
    41       rone   = 1.e0 
     35   REAL(wp), PUBLIC ::   bound  = 0.e0          !: boundary condit. (0.0 no-slip, 1.0 free-slip) 
     36 
     37   REAL(wp)  ::   epsi06 = 1.e-06   ! constant values 
     38   REAL(wp)  ::   epsi03 = 1.e-03   
     39   REAL(wp)  ::   epsi16 = 1.e-16   
     40   REAL(wp)  ::   rzero  = 0.e0    
     41   REAL(wp)  ::   rone   = 1.e0 
    4242 
    4343   !! * Substitution 
    4444#  include "vectopt_loop_substitute.h90" 
    4545   !!---------------------------------------------------------------------- 
    46    !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2010)  
     46   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    4747   !! $Id$ 
    48    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 
    5050 
    … …  
    8787         ! ice velocities at ocean U- and V-points (zui_u,zvi_v) 
    8888         ! --------------------------------------- 
    89          zvbord = 1.0 + ( 1.0 - bound )      ! zvbord=2 no-slip, =0 free slip boundary conditions         
    90          DO jj = 1, jpjm1 
    91             DO ji = 1, jpim1   ! NO vector opt. 
    92                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 ) ) 
    93                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 ) ) 
    94             END DO 
    95          END DO 
    96          CALL lbc_lnk( zui_u, 'U', -1. )   ;   CALL lbc_lnk( zvi_v, 'V', -1. )         ! Lateral boundary conditions 
    97  
     89         IF( lk_lim2_vp ) THEN      ! VP rheology : B-grid sea-ice dynamics (I-point ice velocity) 
     90            zvbord = 1._wp + ( 1._wp - bound )      ! zvbord=2 no-slip, =0 free slip boundary conditions         
     91            DO jj = 1, jpjm1 
     92               DO ji = 1, jpim1   ! NO vector opt. 
     93                  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 ) ) 
     94                  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 ) ) 
     95               END DO 
     96            END DO 
     97            CALL lbc_lnk( zui_u, 'U', -1. )   ;   CALL lbc_lnk( zvi_v, 'V', -1. )      ! Lateral boundary conditions 
     98            ! 
     99         ELSE                       ! EVP rheology : C-grid sea-ice dynamics (u- & v-points ice velocity) 
     100            zui_u(:,:) = u_ice(:,:)      ! EVP rheology: ice (u,v) at u- and v-points 
     101            zvi_v(:,:) = v_ice(:,:) 
     102         ENDIF 
    98103 
    99104         ! CFL test for stability 
    100105         ! ---------------------- 
    101          zcfl  = 0.e0 
     106         zcfl  = 0._wp 
    102107         zcfl  = MAX( zcfl, MAXVAL( ABS( zui_u(1:jpim1, :     ) ) * rdt_ice / e1u(1:jpim1, :     ) ) ) 
    103108         zcfl  = MAX( zcfl, MAXVAL( ABS( zvi_v( :     ,1:jpjm1) ) * rdt_ice / e2v( :     ,1:jpjm1) ) ) 
    … …  
    109114         ! content of properties 
    110115         ! --------------------- 
    111          zs0sn (:,:) =  hsnm(:,:) * area(:,:)                 ! Snow volume. 
    112          zs0ice(:,:) =  hicm(:,:) * area(:,:)                 ! Ice volume. 
     116         zs0sn (:,:) =  hsnm(:,:)              * area  (:,:)  ! Snow volume. 
     117         zs0ice(:,:) =  hicm(:,:)              * area  (:,:)  ! Ice volume. 
    113118         zs0a  (:,:) =  ( 1.0 - frld(:,:) )    * area  (:,:)  ! Surface covered by ice. 
    114119         zs0c0 (:,:) =  tbif(:,:,1) / rt0_snow * zs0sn (:,:)  ! Heat content of the snow layer. 
    … …  
    188193!        DO jj = 1, jpjm1          ! NB: has not to be defined on jpj line and jpi row 
    189194!           DO ji = 1 , fs_jpim1   ! vector opt. 
    190 !              IF( MIN( zs0a(ji,jj) , zs0a(ji+1,jj) ) == 0.e0 )   pahu(ji,jj) = 0.e0 
    191 !              IF( MIN( zs0a(ji,jj) , zs0a(ji,jj+1) ) == 0.e0 )   pahv(ji,jj) = 0.e0 
     195!              IF( MIN( zs0a(ji,jj) , zs0a(ji+1,jj) ) == 0.e0 )   pahu(ji,jj) = 0._wp 
     196!              IF( MIN( zs0a(ji,jj) , zs0a(ji,jj+1) ) == 0.e0 )   pahv(ji,jj) = 0._wp 
    192197!           END DO 
    193198!        END DO 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

    • Property svn:eol-style deleted
    r1818 r2528  
    6060#   include "vectopt_loop_substitute.h90" 
    6161   !!---------------------------------------------------------------------- 
    62    !!  LIM 2.0, UCL-LOCEAN-IPSL (2006) 
     62   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    6363   !! $Id$ 
    64    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     64   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6565   !!---------------------------------------------------------------------- 
    6666 
    … …  
    112112         CALL dia_nam ( clhstnam, nwrite, 'icemod' ) 
    113113         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    & 
    114             &           1, jpi, 1, jpj, niter, zjulian, rdt_ice, nhorid, nice , domain_id=nidom) 
     114            &           1, jpi, 1, jpj, niter, zjulian, rdt_ice, nhorid, nice , domain_id=nidom, snc4chunks=snc4set) 
    115115         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 
    116116         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    … …  
    120120               &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    121121         END DO 
    122          CALL histend( nice ) 
     122         CALL histend( nice, snc4set ) 
    123123         ! 
    124124      ENDIF 
    … …  
    305305      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    306306 
    307       CALL histend( kid )   ! end of the file definition 
     307      CALL histend( kid, snc4set )   ! end of the file definition 
    308308 
    309309      CALL histwrite( kid, "isnowthi", kt, hsnif          , jpi*jpj, (/1/) )    

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    • Property svn:eol-style deleted
    r1694 r2528  
    11    SUBROUTINE lim_wri_2(kt) 
    22   !!---------------------------------------------------------------------- 
    3    !!  LIM 2.0, UCL-LOCEAN-IPSL (2005) 
     3   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    44   !! $Id$ 
    5    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     5   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    66   !!---------------------------------------------------------------------- 
    77    !!------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90

    • Property svn:eol-style deleted
    r1471 r2528  
    2424#endif 
    2525   !!---------------------------------------------------------------------- 
    26    !! NEMO/LIM 2.0, UCL-LOCEAN-IPSL (2008) 
     26   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    2727   !! $Id$ 
    28    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     28   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2929   !!====================================================================== 
    3030END MODULE par_ice_2 

  • trunk/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90

    • Property svn:eol-style deleted
    r1756 r2528  
    88   !!   2.0  !  02-11  (C. Ethe)  F90: Free form and module 
    99   !!---------------------------------------------------------------------- 
    10    !!   LIM 2.0, UCL-LOCEAN-IPSL (2005) 
     10   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 
    1111   !! $Id$ 
    12    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     12   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1313   !!---------------------------------------------------------------------- 
    1414   !! * Modules used 
Note: See TracChangeset for help on using the changeset viewer.