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 3938 for branches/2013/dev_r3406_CNRS_LIM3 – NEMO

Ignore:
Timestamp:
2013-06-26T09:54:16+02:00 (11 years ago)
Author:
flavoni
Message:

dev_r3406_CNRS_LIM3: update LIM3, see ticket #1116

Location:
branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM
Files:
4 added
48 deleted
51 edited

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/Job_mpi

    r3935 r3938  
    77# Type de travail 
    88# @ job_type = parallel 
    9 # @ as_limit = 7.0Gb 
    109# Fichier de sortie standard 
    1110# @ output = Script_Output 
    … …  
    1312# @ error = error 
    1413# Nombre de processus demandes 
    15 # @ total_tasks =  30 
    16 # @ environment = "BATCH_NUM_PROC_TOT=30" 
     14# @ total_tasks = 24  
     15# @ environment = "BATCH_NUM_PROC_TOT=24" 
    1716# Temps CPU max. par processus MPI hh:mm:ss 
    1817# @ wall_clock_limit = 4:30:00 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/xmlio_server.def

    r3931 r3938  
    3030                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which 
    3131                              !  is optimal for postprocessing which works exclusively with horizontal slabs 
    32    ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression 
     32   ln_nc4zip      =   .FALSE.  !  (T) use netcdf4 chunking and compression 
    3333                              !  (F) ignore chunking information and produce netcdf3-compatible files   
    3434/ 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r2777 r3938  
    187187   REAL(wp), PUBLIC ::   alphaevp = 1._wp      !: coeficient of the internal stresses !SB 
    188188   REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
     189   REAL(wp), PUBLIC ::   hminrhg = 0.05_wp     !: clem : ice thickness (in m) below which ice velocity is set to ocean velocity 
    189190 
    190191   !                                              !!** ice-salinity namelist (namicesal) ** 
    … …  
    393394   LOGICAL               , PUBLIC ::   ln_limdyn     = .TRUE.             !: flag for ice dynamics (T) or not (F) 
    394395   LOGICAL               , PUBLIC ::   ln_nicep      = .TRUE.             !: flag for sea-ice points output (T) or not (F) 
    395    REAL(wp)              , PUBLIC ::   hsndif        = 0.e0               !: computation of temp. in snow (0) or not (9999) 
    396    REAL(wp)              , PUBLIC ::   hicdif        = 0.e0               !: computation of temp. in ice (0) or not (9999) 
    397396   REAL(wp)              , PUBLIC ::   cai           = 1.40e-3            !: atmospheric drag over sea ice 
    398397   REAL(wp)              , PUBLIC ::   cao           = 1.00e-3            !: atmospheric drag over ocean 
    399    REAL(wp), DIMENSION(2), PUBLIC ::   acrit  = (/ 1.e-06 , 1.e-06 /)     !: minimum fraction for leads in 
    400    !                                                                      !: north and south hemisphere 
     398   REAL(wp)              , PUBLIC ::   amax          = 0.99               !: maximum ice concentration 
     399   !                                                                      ! 
    401400   !!-------------------------------------------------------------------------- 
    402401   !! * Ice diagnostics 
    403402   !!-------------------------------------------------------------------------- 
    404403   !! Check if everything down here is necessary 
     404   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  = .TRUE. !: flag for ice diag (T) or not (F) 
    405405   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   v_newice   !: volume of ice formed in the leads 
    406406   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd  !: thermodynamic growth rates  
    … …  
    412412   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_me   ! vertical bottom melt  
    413413   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sur_me   ! vertical surface melt 
     414   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_res_pr   ! production (growth+melt) due to limupdate 
     415   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   ! transport of ice volume 
    414416   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    415417 
    … …  
    460462 
    461463      ii = ii + 1 
    462       ALLOCATE( patho_case(jpi, jpj, jpl) , STAT=ierr(ii) ) 
     464      ALLOCATE( patho_case(jpi,jpj,jpl) , STAT=ierr(ii) ) 
    463465 
    464466      ! * Ice global state variables 
    … …  
    524526         &      izero    (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) ,     & 
    525527         &      fstroc   (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) ,     & 
    526          &      fhbricat (jpi,jpj,jpl) , v_newice   (jpi,jpj)                        , STAT=ierr(ii) ) 
     528         &      fhbricat (jpi,jpj,jpl) , diag_res_pr(jpi,jpj) , diag_trp_vi(jpi,jpj) , v_newice(jpi,jpj) , STAT=ierr(ii) ) 
    527529 
    528530      ice_alloc = MAXVAL( ierr(:) ) 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

    r3294 r3938  
    124124      !! ** input   :   Namelist namicerun 
    125125      !!------------------------------------------------------------------- 
    126       NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, acrit, hsndif, hicdif, cai, cao, ln_nicep 
     126      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, amax, cai, cao, ln_nicep, ln_limdiahsb 
    127127      !!------------------------------------------------------------------- 
    128128      !                     
    … …  
    140140         WRITE(numout,*) ' ~~~~~~' 
    141141         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)      ln_limdyn   = ', ln_limdyn 
    142          WRITE(numout,*) '   minimum fraction for leads in the NH (SH)  acrit(1/2)   = ', acrit(:) 
    143          WRITE(numout,*) '   computation of temp. in snow (=0) or not (=9999) hsndif = ', hsndif 
    144          WRITE(numout,*) '   computation of temp. in ice  (=0) or not (=9999) hicdif = ', hicdif 
     142         WRITE(numout,*) '   maximum ice concentration                               = ', amax  
    145143         WRITE(numout,*) '   atmospheric drag over sea ice                           = ', cai 
    146144         WRITE(numout,*) '   atmospheric drag over ocean                             = ', cao 
    147145         WRITE(numout,*) '   Several ice points in the ice or not in ocean.output    = ', ln_nicep 
     146         WRITE(numout,*) '   Diagnose heat/salt budget or not          ln_limdiahsb  = ', ln_limdiahsb 
    148147      ENDIF 
    149148      ! 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r3294 r3938  
    2323   USE lib_mpp          ! MPP library 
    2424   USE wrk_nemo         ! work arrays 
     25   USE lib_fortran      ! to use key_nosignedzero 
    2526 
    2627   IMPLICIT NONE 
    … …  
    8889            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    8990               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    90             zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     91            zin0    = ( 1.0 - MAX( rzero, SIGN ( rone, -zslpmax ) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    9192 
    9293            ps0 (ji,jj) = zslpmax   
    … …  
    273274            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    274275               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    275             zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     276            zin0    = ( 1.0 - MAX( rzero, SIGN ( rone, -zslpmax ) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    276277            ! 
    277278            ps0 (ji,jj) = zslpmax   

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90

    r2715 r3938  
    2323   USE in_out_manager  ! I/O manager 
    2424   USE lib_mpp         ! MPP library 
     25   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2526    
    2627   IMPLICIT NONE 
    … …  
    4344   INTEGER  ::   naveg               ! number of step for accumulation before averaging 
    4445   REAL(wp) ::   epsi06 = 1.e-6_wp   ! small number 
     46   REAL(wp) ::   epsi20 = 1.e-20_wp  ! small number 
    4547 
    4648   CHARACTER(len= 8) ::   fmtinf = '1PE13.5 '   ! format of the output values   
    … …  
    7072      !!              the temporal evolution of some key variables 
    7173      !!------------------------------------------------------------------- 
    72       INTEGER  ::   jv, ji, jj, jl   ! dummy loop indices 
    73       REAL(wp) ::   zshift_date      ! date from the minimum ice extent 
    74       REAL(wp) ::   zday, zday_min   ! current day, day of minimum extent 
    75       REAL(wp) ::   zafy, zamy       ! temporary area of fy and my ice 
     74      INTEGER  ::   jv, ji, jj, jl       ! dummy loop indices 
     75      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integer 
     76      REAL(wp) ::   zshift_date          ! date from the minimum ice extent 
     77      REAL(wp) ::   zday, zday_min       ! current day, day of minimum extent 
     78      REAL(wp) ::   zafy, zamy           ! temporary area of fy and my ice 
    7679      REAL(wp) ::   zindb 
    77       REAL(wp), DIMENSION(jpinfmx) ::   vinfor           ! temporary working space  
     80      REAL(wp), DIMENSION(jpinfmx) ::   vinfor   ! 1D workspace  
    7881      !!------------------------------------------------------------------- 
    7982 
    8083      ! 0) date from the minimum of ice extent 
    8184      !--------------------------------------- 
     85      !RETURN ! use this for debugging 
    8286      zday_min = 273._wp        ! zday_min = date of minimum extent, here September 30th 
    8387      zday = REAL(numit-nit000,wp) * rdt_ice / ( 86400._wp * REAL(nn_fsbc,wp) ) 
    … …  
    112116               ! the computation of this diagnostic is not reliable 
    113117               vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    114                   v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12  
     118                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj) * 1.e-12  
    115119               vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) * 1.e-12_wp !salt flux 
    116120               vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp !brine drainage flux 
    … …  
    153157      vinfor(79) = vinfor(79) / MAX(vinfor(5),epsi06) ! 
    154158 
    155       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(3))) ! 
     159      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(3)+epsi20)) ! 
    156160      vinfor(59) = zindb*vinfor(59) / MAX(vinfor(3),epsi06) ! divide by ice area 
    157161      vinfor(61) = zindb*vinfor(61) / MAX(vinfor(3),epsi06) ! 
    158162 
    159       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(9))) ! 
     163      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(9)+epsi20)) ! 
    160164      vinfor(65) = zindb*vinfor(65) / MAX(vinfor(9),epsi06) ! divide it by snow volume 
    161165 
    … …  
    226230         END DO 
    227231      END DO 
    228       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(25))) !=0 if no multiyear ice 1 if yes 
     232      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(25)+epsi20)) !=0 if no multiyear ice 1 if yes 
    229233      vinfor(49) = zindb*vinfor(49) / MAX(vinfor(25),epsi06) 
    230       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(27))) !=0 if no multiyear ice 1 if yes 
     234      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(27)+epsi20)) !=0 if no multiyear ice 1 if yes 
    231235      vinfor(51) = zindb*vinfor(51) / MAX(vinfor(27),epsi06) 
    232236 
    233       !! Fram Strait Export 
    234       !! 83 = area export 
    235       !! 84 = volume export 
    236       !! Fram strait in ORCA2 = 5 points 
    237       !! export = -v_ice*e1t*ddtb*at_i or -v_ice*e1t*ddtb*at_i*h_i 
    238       jj = 136 ! C grid 
    239       vinfor(83) = 0.0 
    240       vinfor(84) = 0.0 
    241       DO ji = 134, 138 
    242          vinfor(83) = vinfor(83) - v_ice(ji,jj) * &  
    243             e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12_wp 
    244          vinfor(84) = vinfor(84) - v_ice(ji,jj) * &  
    245             e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12_wp 
    246       END DO 
     237      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : Fram Strait Export 
     238         SELECT CASE ( jp_cfg ) 
     239         CASE ( 2 )                          ! ORCA_R2 
     240            ij0 = 136   ;   ij1 = 136              ! Fram strait : 83 = area export 
     241            ii0 = 134   ;   ii1 = 138              !               84 = volume export 
     242            DO jj = mj0(ij0),mj1(ij1) 
     243               DO ji = mi0(ii0),mi1(ii1) 
     244                  vinfor(83) = vinfor(83) - v_ice(ji,jj) * e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12_wp 
     245                  vinfor(84) = vinfor(84) - v_ice(ji,jj) * e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12_wp 
     246               END DO 
     247            END DO 
     248         END SELECT 
     249!!gm   just above, this is NOT the correct way of evaluating the transport ! 
     250!!gm        mass of snow is missing and v_ice should be the mean between jj and jj+1 
     251!!gm   Other ORCA configurations should be added 
     252      ENDIF 
    247253 
    248254      !!------------------------------------------------------------------- 
    … …  
    264270               vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + &  
    265271                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel 
     272!!gm  error??  multiplication by at_i seem wrong here.... 
    266273               vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Total salt flux 
    267274               vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Brine drainage salt flux 
    268275               vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Equivalent salt flux 
     276!!gm end 
    269277               vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SST 
    270278               vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SSS 
    … …  
    292300      vinfor(14) = 0.0 
    293301 
    294       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(8)))  
     302      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(8)+epsi20))  
    295303      vinfor(16) = zindb * vinfor(16) / MAX(vinfor(8),epsi06) ! these have to be divided by ice vol 
    296304      vinfor(30) = zindb * vinfor(30) / MAX(vinfor(8),epsi06) !  
    … …  
    298306      vinfor(68) = zindb * vinfor(68) / MAX(vinfor(8),epsi06) !  
    299307 
    300       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(6)))  
     308      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(6)+epsi20))  
    301309      vinfor(54) = zindb * vinfor(54) / MAX(vinfor(6),epsi06) ! these have to be divided by ice extt 
    302310      vinfor(56) = zindb * vinfor(56) / MAX(vinfor(6),epsi06) !  
    … …  
    305313      !      vinfor(84) = vinfor(84) / vinfor(6) ! 
    306314 
    307       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) ! 
     315      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4)+epsi20)) ! 
    308316      vinfor(60) = zindb*vinfor(60) / ( MAX(vinfor(4), epsi06) ) ! divide by ice area 
    309317      vinfor(62) = zindb*vinfor(62) / ( MAX(vinfor(4), epsi06) ) ! 
    310318 
    311       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(10))) ! 
     319      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(10)+epsi20)) ! 
    312320      vinfor(66) = zindb*vinfor(66) / MAX(vinfor(10),epsi06) ! divide it by snow volume 
    313321 
    … …  
    345353         END DO 
    346354      END DO 
    347       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) ! 
     355      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4)+epsi20)) ! 
    348356      vinfor(64) = zindb * vinfor(64) / MAX(vinfor(4),epsi06) ! divide by ice extt 
    349357      !! 2.2) Diagnostics dependent on age 
    … …  
    377385         END DO ! jj 
    378386      END DO ! ji 
    379       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(26))) !=0 if no multiyear ice 1 if yes 
     387      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(26)+epsi20)) !=0 if no multiyear ice 1 if yes 
    380388      vinfor(50) = zindb*vinfor(50) / MAX(vinfor(26),epsi06) 
    381       zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(28))) !=0 if no multiyear ice 1 if yes 
     389      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(28)+epsi20)) !=0 if no multiyear ice 1 if yes 
    382390      vinfor(52) = zindb*vinfor(52) / MAX(vinfor(28),epsi06) 
    383391 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r3294 r3938  
    2828   USE in_out_manager   ! I/O manager 
    2929   USE prtctl           ! Print control 
     30   USE lib_fortran      ! glob_sum 
    3031 
    3132   IMPLICIT NONE 
    … …  
    6465      REAL(wp), POINTER, DIMENSION(:)   ::   zmsk           ! i-averaged of tmask 
    6566      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity 
    66       !!--------------------------------------------------------------------- 
     67      REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     68     !!--------------------------------------------------------------------- 
    6769 
    6870      CALL wrk_alloc( jpi, jpj, zu_io, zv_io ) 
    6971      CALL wrk_alloc( jpj, zind, zmsk ) 
     72 
     73      ! ------------------------------- 
     74      !- check conservation (C Rousset) 
     75      IF (ln_limdiahsb) THEN 
     76         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     77         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     78         zchk_fw_b  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) 
     79         zchk_fs_b  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) 
     80      ENDIF 
     81      !- check conservation (C Rousset) 
     82      ! ------------------------------- 
    7083 
    7184      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    … …  
    207220      ENDIF 
    208221      ! 
     222 
     223      ! ------------------------------- 
     224      !- check conservation (C Rousset) 
     225      IF (ln_limdiahsb) THEN 
     226         !INTEGER                                 ::   numhsb  
     227         !CHARACTER (len=32) ::   cl_name  ! output file name 
     228         !cl_name    = 'heat_salt_volume_budgets.txt'                         ! name of output file 
     229 
     230         zchk_fs  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     231         zchk_fw  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     232  
     233         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
     234         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
     235 
     236         IF(lwp) THEN 
     237            IF (    ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limdyn) = ',(zchk_v_i * 86400.) 
     238            IF (    ABS( zchk_smv   ) >  1.e-4  ) WRITE(numout,*) 'violation saline [psu*m3/day] (limdyn) = ',(zchk_smv * 86400.) 
     239            IF ( MINVAL( v_i(:,:,:) ) <  0.    ) WRITE(numout,*) 'violation v_i<0  [mm]         (limdyn) = ',(MINVAL(v_i) * 1.e-3) 
     240            IF ( MAXVAL( SUM(a_i(:,:,:),dim=3) ) > amax+1.e-10 ) WRITE(numout,*) 'violation a_i>amax    (limdyn) = ',MAXVAL(SUM(a_i,dim=3)) 
     241         ENDIF 
     242         !CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 ) 
     243         ! 
     244         !WRITE( numhsb, 9010 ) "kt   |     heat content budget     |            salt content budget             ",   & 
     245         !     &                                                  "|            volume budget (ssh)             ",   & 
     246         !     &                                                  "|            volume budget (e3t)             " 
     247         !WRITE( numhsb, 9010 ) "     |      [C]         [W/m2]     |     [psu]        [mmm/s]          [SV]     ",   & 
     248         !     &                                                  "|     [m3]         [mmm/s]          [SV]     ",   & 
     249         !     &                                                  "|     [m3]         [mmm/s]          [SV]     " 
     250         !IF ( kt == nitend ) CLOSE( numhsb ) 
     251          
     252!9010     FORMAT(A80,A45,A45) 
     253      ENDIF 
     254      !- check conservation (C Rousset) 
     255      ! ------------------------------- 
     256 
    209257      CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 
    210258      CALL wrk_dealloc( jpj, zind, zmsk ) 
    … …  
    228276         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    229277         &                c_rhg, etamn, creepl, ecc, ahi0, & 
    230          &                nevp, telast, alphaevp 
     278         &                nevp, telast, alphaevp, hminrhg 
    231279      !!------------------------------------------------------------------- 
    232280 
    … …  
    256304         WRITE(numout,*) '   timescale for elastic waves                      telast = ', telast 
    257305         WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp 
     306         WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg 
    258307      ENDIF 
    259308      ! 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r3294 r3938  
    136136      END DO                                       ! end of sub-time step loop 
    137137 
     138      ! ----------------------- 
     139      !!! final step (clem) !!! 
     140      DO jj = 1, jpjm1                                ! diffusive fluxes in U- and V- direction 
     141         DO ji = 1 , fs_jpim1   ! vector opt. 
     142            zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) ) 
     143            zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) ) 
     144         END DO 
     145      END DO 
     146      ! 
     147      DO jj= 2, jpjm1                                 ! diffusive trend : divergence of the fluxes 
     148         DO ji = fs_2 , fs_jpim1   ! vector opt.  
     149            zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   & 
     150                 &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) ) 
     151            ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 
     152         END DO 
     153      END DO 
     154      CALL lbc_lnk( ptab, 'T', 1. )                   ! lateral boundary condition 
     155      !!! final step (clem) !!! 
     156      ! ----------------------- 
     157 
    138158      IF(ln_ctl)   THEN 
    139159         zrlx(:,:) = ptab(:,:) - ztab0(:,:) 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r3349 r3938  
    55   !!====================================================================== 
    66   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code 
    7    !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
     7   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     8   !!             -   ! 2012    (C. Rousset) clean + add par_oce (for jp_sal)...bug? 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_lim3 
    … …  
    2122   USE ice              ! sea-ice variables 
    2223   USE par_ice          ! ice parameters 
     24   USE par_oce          ! ocean parameters 
    2325   USE dom_ice          ! sea-ice domain 
    2426   USE in_out_manager   ! I/O manager 
    … …  
    6365      !!                or from arbitrary sea-ice conditions 
    6466      !!------------------------------------------------------------------- 
    65       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    66       REAL(wp) ::   zeps6, zeps, ztmelts, epsi06   ! local scalars 
    67       REAL(wp) ::   zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs  
    68       REAL(wp), POINTER, DIMENSION(:)   ::   zgfactorn, zhin  
    69       REAL(wp), POINTER, DIMENSION(:)   ::   zgfactors, zhis 
     67      INTEGER  ::   ji, jj, jk, jl            ! dummy loop indices 
     68      INTEGER  ::   i_fill, jl0, ztest_1, ztest_2, ztest_3, ztest_4, ztests   
     69      REAL(wp) ::   zarg, zV, zconv 
     70      REAL(wp) ::   zeps06, zeps, ztmelts   ! local scalars 
     71      REAL(wp),          DIMENSION(jpl) ::   zain, zhtin, zhtsn, zais, zhtis, zhtss  
     72      REAL(wp),          DIMENSION(jpl) ::   zai, zhti, zhts  
    7073      REAL(wp), POINTER, DIMENSION(:,:) ::   zidto      ! ice indicator 
    7174      !-------------------------------------------------------------------- 
    7275 
    73       CALL wrk_alloc( jpm, zgfactorn, zgfactors, zhin, zhis ) 
    7476      CALL wrk_alloc( jpi, jpj, zidto ) 
    7577 
    … …  
    7779      ! 1) Preliminary things  
    7880      !-------------------------------------------------------------------- 
    79       epsi06 = 1.e-6_wp 
    8081 
    8182      CALL lim_istate_init     !  reading the initials parameters of the ice 
    … …  
    106107 
    107108      ! constants for heat contents 
    108       zeps   = 1.e-20_wp 
    109       zeps6  = 1.e-06_wp 
    110  
    111       ! zgfactor for initial ice distribution 
    112       zgfactorn(:) = 0._wp 
    113       zgfactors(:) = 0._wp 
    114  
    115       ! first ice type 
    116       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
    117          zhin (1)     = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp 
    118          zgfactorn(1) = zgfactorn(1) + exp(-(zhin(1)-hginn_u)*(zhin(1)-hginn_u) * 0.5_wp ) 
    119          zhis (1)     = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp 
    120          zgfactors(1) = zgfactors(1) + exp(-(zhis(1)-hgins_u)*(zhis(1)-hgins_u) * 0.5_wp ) 
    121       END DO ! jl 
    122       zgfactorn(1) = aginn_u / zgfactorn(1) 
    123       zgfactors(1) = agins_u / zgfactors(1) 
    124  
    125       ! ------------- 
    126       ! new distribution, polynom of second order, conserving area and volume 
    127       zh1 = 0._wp 
    128       zh2 = 0._wp 
    129       zh3 = 0._wp 
     109      zeps    = 1.e-20_wp 
     110      zeps06  = 1.e-06_wp 
     111 
     112      !------------------------------------------------------------------- 
     113      ! 3) Distribute ice concentration and thickness into the categories  
     114      !------------------------------------------------------------------- 
     115      ! snow distribution 
     116      zhtsn(1:jpl) = 0.d0 
     117      zhtss(1:jpl) = 0.d0 
    130118      DO jl = 1, jpl 
    131          zh = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp 
    132          zh1 = zh1 + zh 
    133          zh2 = zh2 + zh * zh 
    134          zh3 = zh3 + zh * zh * zh 
     119         zhtsn(jl) = hninn 
     120         zhtss(jl) = hnins 
    135121      END DO 
    136       IF(lwp) WRITE(numout,*) ' zh1 : ', zh1 
    137       IF(lwp) WRITE(numout,*) ' zh2 : ', zh2 
    138       IF(lwp) WRITE(numout,*) ' zh3 : ', zh3 
    139  
    140       zvol = aginn_u * hginn_u 
    141       zare = aginn_u 
    142       IF( jpl >= 2 ) THEN 
    143          zbn = ( zvol*zh2 - zare*zh3 ) / ( zh2*zh2 - zh1*zh3) 
    144          zan = ( zare - zbn*zh1 ) / zh2 
     122 
     123      ! ------------------- 
     124      ! Northern Hemisphere 
     125      ! ------------------- 
     126      ! initialisation of tests 
     127      ztest_1 = 0 
     128      ztest_2 = 0 
     129      ztest_3 = 0 
     130      ztest_4 = 0 
     131      ztests  = 0 
     132          
     133      i_fill = jpl + 1                                    !==================================== 
     134      DO WHILE ( ( ztests /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories   
     135         ! iteration                                      !==================================== 
     136         i_fill = i_fill - 1 
     137  
     138         ! initialisation of ice variables for each try 
     139         zhtin(1:jpl) = 0.d0 
     140         zain (1:jpl) = 0.d0 
     141          
     142         ! *** case very thin ice: fill only category 1 
     143         IF ( i_fill == 1 ) THEN 
     144            zhtin(1) = hginn_u 
     145            zain (1) = aginn_u 
     146             
     147            ! *** case ice is thicker: fill categories >1 
     148         ELSE 
     149             
     150            ! Fill ice thicknesses except the last one (i_fill) by (hmax-hmin)/2  
     151            DO jl = 1, i_fill - 1 
     152               zhtin(jl) = ( hi_max(jl) + hi_max(jl-1) ) / 2. 
     153            END DO 
     154             
     155            ! find which category (jl0) the input ice thickness falls into 
     156            jl0 = i_fill 
     157            DO jl = 1, i_fill 
     158               IF ( ( hginn_u >= hi_max(jl-1) ) .AND. ( hginn_u < hi_max(jl) ) ) THEN 
     159                  jl0 = jl 
     160                  CYCLE 
     161               ENDIF 
     162            END DO 
     163             
     164            ! Concentrations in the (i_fill-1) categories  
     165            zain(jl0) = aginn_u / SQRT(REAL(jpl)) 
     166            DO jl = 1, i_fill - 1 
     167               IF ( jl == jl0 ) CYCLE 
     168               zarg           = ( zhtin(jl) - hginn_u ) / ( hginn_u / 2. ) 
     169               zain(jl) =   zain (jl0) * EXP(-zarg**2) 
     170            END DO 
     171             
     172            ! Concentration in the last (i_fill) category 
     173            zain(i_fill) = aginn_u - SUM( zain(1:i_fill-1) ) 
     174             
     175            ! Ice thickness in the last (i_fill) category 
     176            zV = SUM( zain(1:i_fill-1) * zhtin(1:i_fill-1) ) 
     177            zhtin(i_fill) = ( hginn_u*aginn_u -  zV ) / zain(i_fill)  
     178             
     179         ENDIF ! case ice is thick or thin 
     180          
     181         !--------------------- 
     182         ! Compatibility tests 
     183         !---------------------  
     184         ! Test 1: area conservation 
     185         zconv = ABS( aginn_u - SUM( zain(1:jpl) ) ) 
     186         IF ( zconv < zeps06 ) ztest_1 = 1 
     187          
     188         ! Test 2: volume conservation 
     189         zconv = ABS( hginn_u*aginn_u - SUM( zain(1:jpl)*zhtin(1:jpl) ) ) 
     190         IF ( zconv < zeps06 ) ztest_2 = 1 
     191          
     192         ! Test 3: thickness of the last category is in-bounds ? 
     193         IF ( zhtin(i_fill) >= hi_max(i_fill-1) ) ztest_3 = 1 
     194          
     195         ! Test 4: positivity of ice concentrations 
     196         ztest_4 = 1 
     197         DO jl = 1, i_fill 
     198            IF ( zain(jl) < 0.0d0 ) ztest_4 = 0 
     199         END DO 
     200          
     201         ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 
     202                                                        !============================ 
     203      END DO                                            ! end iteration on categories 
     204                                                        !============================ 
     205      ! Check if tests have passed (i.e. volume conservation...) 
     206      IF ( ztests .NE. 4 ) THEN 
     207         WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
     208         WRITE(numout,*) ' !! ALERT categories distribution !!' 
     209         WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
     210         WRITE(numout,*) ' *** ztests is not equal to 4 ' 
     211         WRITE(numout,*) ' *** ztest (1:4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    145212      ENDIF 
    146213 
    147       IF(lwp) WRITE(numout,*) ' zvol: ', zvol 
    148       IF(lwp) WRITE(numout,*) ' zare: ', zare 
    149       IF(lwp) WRITE(numout,*) ' zbn : ', zbn  
    150       IF(lwp) WRITE(numout,*) ' zan : ', zan  
    151  
    152       zvol = agins_u * hgins_u 
    153       zare = agins_u 
    154       IF( jpl >= 2 ) THEN 
    155          zbs = ( zvol*zh2 - zare*zh3 ) / ( zh2*zh2 - zh1*zh3) 
    156          zas = ( zare - zbs*zh1 ) / zh2 
     214      ! ------------------- 
     215      ! Southern Hemisphere 
     216      ! ------------------- 
     217      ! initialisation of tests 
     218      ztest_1 = 0 
     219      ztest_2 = 0 
     220      ztest_3 = 0 
     221      ztest_4 = 0 
     222      ztests  = 0 
     223          
     224      i_fill = jpl + 1                                    !==================================== 
     225      DO WHILE ( ( ztests /= 4 ) .AND. ( i_fill >= 2 ) )  ! iterative loop on i_fill categories   
     226         ! iteration                                      !==================================== 
     227         i_fill = i_fill - 1 
     228  
     229         ! initialisation of ice variables for each try 
     230         zhtis(1:jpl) = 0.d0 
     231         zais (1:jpl) = 0.d0 
     232          
     233         ! *** case very thin ice: fill only category 1 
     234         IF ( i_fill == 1 ) THEN 
     235            zhtis(1) = hgins_u 
     236            zais (1) = agins_u 
     237             
     238            ! *** case ice is thicker: fill categories >1 
     239         ELSE 
     240             
     241            ! Fill ice thicknesses except the last one (i_fill) by (hmax-hmin)/2  
     242            DO jl = 1, i_fill - 1 
     243               zhtis(jl) = ( hi_max(jl) + hi_max(jl-1) ) / 2. 
     244            END DO 
     245             
     246            ! find which category (jl0) the input ice thickness falls into 
     247            jl0 = i_fill 
     248            DO jl = 1, i_fill 
     249               IF ( ( hgins_u >= hi_max(jl-1) ) .AND. ( hgins_u < hi_max(jl) ) ) THEN 
     250                  jl0 = jl 
     251                  CYCLE 
     252               ENDIF 
     253            END DO 
     254             
     255            ! Concentrations in the (i_fill-1) categories  
     256            zais(jl0) = agins_u / SQRT(REAL(jpl)) 
     257            DO jl = 1, i_fill - 1 
     258               IF ( jl == jl0 ) CYCLE 
     259               zarg           = ( zhtis(jl) - hgins_u ) / ( hgins_u / 2. ) 
     260               zais(jl) =   zais (jl0) * EXP(-zarg**2) 
     261            END DO 
     262             
     263            ! Concentration in the last (i_fill) category 
     264            zais(i_fill) = agins_u - SUM( zais(1:i_fill-1) ) 
     265             
     266            ! Ice thickness in the last (i_fill) category 
     267            zV = SUM( zais(1:i_fill-1) * zhtis(1:i_fill-1) ) 
     268            zhtis(i_fill) = ( hgins_u*agins_u -  zV ) / zais(i_fill)  
     269             
     270         ENDIF ! case ice is thick or thin 
     271          
     272         !--------------------- 
     273         ! Compatibility tests 
     274         !---------------------  
     275         ! Test 1: area conservation 
     276         zconv = ABS( agins_u - SUM( zais(1:jpl) ) ) 
     277         IF ( zconv < zeps06 ) ztest_1 = 1 
     278          
     279         ! Test 2: volume conservation 
     280         zconv = ABS( hgins_u*agins_u - SUM( zais(1:jpl)*zhtis(1:jpl) ) ) 
     281         IF ( zconv < zeps06 ) ztest_2 = 1 
     282          
     283         ! Test 3: thickness of the last category is in-bounds ? 
     284         IF ( zhtis(i_fill) >= hi_max(i_fill-1) ) ztest_3 = 1 
     285          
     286         ! Test 4: positivity of ice concentrations 
     287         ztest_4 = 1 
     288         DO jl = 1, i_fill 
     289            IF ( zais(jl) < 0.0d0 ) ztest_4 = 0 
     290         END DO 
     291          
     292         ztests = ztest_1 + ztest_2 + ztest_3 + ztest_4 
     293                                                        !============================ 
     294      END DO                                            ! end iteration on categories 
     295                                                        !============================ 
     296      ! Check if tests have passed (i.e. volume conservation...) 
     297      IF ( ztests .NE. 4 ) THEN 
     298         WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
     299         WRITE(numout,*) ' !! ALERT categories distribution !!' 
     300         WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
     301         WRITE(numout,*) ' *** ztests is not equal to 4 ' 
     302         WRITE(numout,*) ' *** ztest (1:4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    157303      ENDIF 
    158  
    159       IF(lwp) WRITE(numout,*) ' zvol: ', zvol 
    160       IF(lwp) WRITE(numout,*) ' zare: ', zare 
    161       IF(lwp) WRITE(numout,*) ' zbn : ', zbn  
    162       IF(lwp) WRITE(numout,*) ' zan : ', zan  
    163  
    164       !end of new lines 
    165       ! ------------- 
    166 !!! 
    167       ! retour a LIMA_MEC 
    168       !     ! second ice type 
    169       !     zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    170       !     hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    171  
    172       !     ! here to change !!!! 
    173       !     jm = 2 
    174       !     DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    175       !        zhin (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    176       !        zhin (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + & 
    177       !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0 
    178       !        zgfactorn(2) = zgfactorn(2) + exp(-(zhin(2)-hginn_d)*(zhin(2)-hginn_d)/2.0) 
    179       !        zhis (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    180       !        zhis (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + & 
    181       !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0 
    182       !        zgfactors(2) = zgfactors(2) + exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0) 
    183       !     END DO ! jl 
    184       !     zgfactorn(2) = aginn_d / zgfactorn(2) 
    185       !     zgfactors(2) = agins_d / zgfactors(2) 
    186       !     hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    187       ! END retour a LIMA_MEC 
    188 !!! 
    189  
    190 !!gm  optimisation :  loop over the ice categories inside the ji, jj loop !!! 
    191  
     304!! 
     305!! 
     306!! 
     307      ! --------------------- 
     308      ! 4) fill ice variables 
     309      ! --------------------- 
     310      zai(:) = 0.0 
     311      zhti(:)= 0.0 
     312      zhts(:)= 0.0 
    192313      DO jj = 1, jpj 
    193314         DO ji = 1, jpi 
    … …  
    195316            !--- Northern hemisphere 
    196317            !---------------------------------------------------------------- 
    197             IF( fcor(ji,jj) >= 0._wp ) THEN     
    198  
     318            IF( fcor(ji,jj) >= 0._wp ) THEN 
     319               zai(:) = zain(:) ; zhti(:) = zhtin(:) ; zhts(:) = zhtsn(:)      
     320            ELSE  
     321               zai(:) = zais(:) ; zhti(:) = zhtis(:) ; zhts(:) = zhtss(:)      
     322            ENDIF 
     323             
     324            DO jl = 1, jpl 
    199325               !----------------------- 
    200326               ! Ice area / thickness 
    201327               !----------------------- 
    202  
    203                IF ( jpl .EQ. 1) THEN ! one category 
    204  
    205                   DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories 
    206                      a_i(ji,jj,jl)    = zidto(ji,jj) * aginn_u 
    207                      ht_i(ji,jj,jl)   = zidto(ji,jj) * hginn_u 
    208                      v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    209                   END DO 
    210  
    211                ELSE ! several categories 
    212  
    213                   DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories 
    214                      zhin(1)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    215                      a_i(ji,jj,jl)    = zidto(ji,jj) * MAX( zgfactorn(1) * exp(-(zhin(1)-hginn_u)* &  
    216                         (zhin(1)-hginn_u)/2.0) , epsi06) 
    217                      ! new line 
    218                      a_i(ji,jj,jl)    = zidto(ji,jj) * ( zan * zhin(1) * zhin(1) + zbn * zhin(1) ) 
    219                      ht_i(ji,jj,jl)   = zidto(ji,jj) * zhin(1)  
    220                      v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    221                   END DO 
    222  
    223                ENDIF 
    224  
    225  
    226 !!! 
    227                ! retour a LIMA_MEC 
    228                !              !ridged ice 
    229                !              zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    230                !              hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    231                !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) ! loop over ice thickness categories 
    232                !                 zhin(2)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    233                !                 a_i(ji,jj,jl)    = zidto(ji,jj) * MAX( zgfactorn(2) * exp(-(zhin(2)-hginn_d)* & 
    234                !                                    (zhin(2)-hginn_d)/2.0) , epsi06) 
    235                !                 ht_i(ji,jj,jl)   = zidto(ji,jj) * zhin(2)  
    236                !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    237                !              END DO 
    238                !              hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    239  
    240                !              !rafted ice 
    241                !              jl = 6 
    242                !              a_i(ji,jj,jl)       = 0.0 
    243                !              ht_i(ji,jj,jl)      = 0.0 
    244                !              v_i(ji,jj,jl)       = 0.0 
    245                ! END retour a LIMA_MEC 
    246 !!! 
    247  
    248                DO jl = 1, jpl 
    249  
    250                   !------------- 
    251                   ! Snow depth 
    252                   !------------- 
    253                   ht_s(ji,jj,jl)   = zidto(ji,jj) * hninn 
    254                   v_s(ji,jj,jl)    = ht_s(ji,jj,jl)*a_i(ji,jj,jl) 
    255  
    256                   !--------------- 
    257                   ! Ice salinity 
    258                   !--------------- 
    259                   sm_i(ji,jj,jl)   = zidto(ji,jj) * sinn  + ( 1.0 - zidto(ji,jj) ) * 0.1 
    260                   smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    261  
    262                   !---------- 
    263                   ! Ice age 
    264                   !---------- 
    265                   o_i(ji,jj,jl)    = zidto(ji,jj) * 1.0   + ( 1.0 - zidto(ji,jj) ) 
    266                   oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
    267  
    268                   !------------------------------ 
    269                   ! Sea ice surface temperature 
    270                   !------------------------------ 
    271  
    272                   t_su(ji,jj,jl)   = zidto(ji,jj) * 270.0 + ( 1.0 - zidto(ji,jj) ) * t_bo(ji,jj) 
    273  
    274                   !------------------------------------ 
    275                   ! Snow temperature and heat content 
    276                   !------------------------------------ 
    277  
    278                   DO jk = 1, nlay_s 
    279                      t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1.0 - zidto(ji,jj) ) * rtt 
    280                      ! Snow energy of melting 
    281                      e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    282                      ! Change dimensions 
    283                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    284                      ! Multiply by volume, so that heat content in 10^9 Joules 
    285                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * & 
    286                         v_s(ji,jj,jl)  / nlay_s 
    287                   END DO !jk 
    288  
    289                   !----------------------------------------------- 
    290                   ! Ice salinities, temperature and heat content  
    291                   !----------------------------------------------- 
    292  
    293                   DO jk = 1, nlay_i 
    294                      t_i(ji,jj,jk,jl) = zidto(ji,jj)*270.00 + ( 1.0 - zidto(ji,jj) ) * rtt  
    295                      s_i(ji,jj,jk,jl) = zidto(ji,jj) * sinn + ( 1.0 - zidto(ji,jj) ) * 0.1 
    296                      ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    297  
    298                      ! heat content per unit volume 
    299                      e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * & 
    300                         (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    301                         +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
    302                         - rcp      * ( ztmelts - rtt ) & 
    303                         ) 
    304  
    305                      ! Correct dimensions to avoid big values 
    306                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    307  
    308                      ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    309                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * &  
    310                         area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
    311                         nlay_i 
    312                   END DO ! jk 
    313  
    314                END DO ! jl  
    315  
    316             ELSE ! on fcor  
    317  
    318                !--- Southern hemisphere 
    319                !---------------------------------------------------------------- 
    320  
    321                !----------------------- 
    322                ! Ice area / thickness 
    323                !----------------------- 
    324  
    325                IF ( jpl .EQ. 1) THEN ! one category 
    326  
    327                   DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories 
    328                      a_i(ji,jj,jl)    = zidto(ji,jj) * agins_u 
    329                      ht_i(ji,jj,jl)   = zidto(ji,jj) * hgins_u 
    330                      v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    331                   END DO 
    332  
    333                ELSE ! several categories 
    334  
    335                   !level ice 
    336                   DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) !over thickness categories 
    337  
    338                      zhis(1)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    339                      a_i(ji,jj,jl) = zidto(ji,jj) * MAX( zgfactors(1) * exp(-(zhis(1)-hgins_u) * &  
    340                         (zhis(1)-hgins_u)/2.0) , epsi06 ) 
    341                      ! new line square distribution volume conserving 
    342                      a_i(ji,jj,jl)    = zidto(ji,jj) * ( zas * zhis(1) * zhis(1) + zbs * zhis(1) ) 
    343                      ht_i(ji,jj,jl)   = zidto(ji,jj) * zhis(1)  
    344                      v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    345  
    346                   END DO ! jl 
    347  
    348                ENDIF 
    349  
    350 !!! 
    351                ! retour a LIMA_MEC 
    352                !              !ridged ice 
    353                !              zdummy  = hi_max(ice_cat_bounds(2,1)-1) 
    354                !              hi_max(ice_cat_bounds(2,1)-1) = 0.0 
    355                !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) !over thickness categories 
    356                !                 zhis(2)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0 
    357                !                 a_i(ji,jj,jl) = zidto(ji,jj)*MAX( zgfactors(2)   & 
    358                !                    &          * exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0), epsi06 ) 
    359                !                 ht_i(ji,jj,jl)   = zidto(ji,jj) * zhis(2)  
    360                !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
    361                !              END DO 
    362                !              hi_max(ice_cat_bounds(2,1)-1) = zdummy 
    363  
    364                !              !rafted ice 
    365                !              jl = 6 
    366                !              a_i(ji,jj,jl)       = 0.0 
    367                !              ht_i(ji,jj,jl)      = 0.0 
    368                !              v_i(ji,jj,jl)       = 0.0 
    369                ! END retour a LIMA_MEC 
    370 !!! 
    371  
    372                DO jl = 1, jpl !over thickness categories 
    373  
    374                   !--------------- 
    375                   ! Snow depth 
    376                   !--------------- 
    377  
    378                   ht_s(ji,jj,jl)   = zidto(ji,jj) * hnins 
    379                   v_s(ji,jj,jl)    = ht_s(ji,jj,jl)*a_i(ji,jj,jl) 
    380  
    381                   !--------------- 
    382                   ! Ice salinity 
    383                   !--------------- 
    384  
    385                   sm_i(ji,jj,jl)   = zidto(ji,jj) * sins  + ( 1.0 - zidto(ji,jj) ) * 0.1 
    386                   smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    387  
    388                   !---------- 
    389                   ! Ice age 
    390                   !---------- 
    391  
    392                   o_i(ji,jj,jl)    = zidto(ji,jj) * 1.0   + ( 1.0 - zidto(ji,jj) ) 
    393                   oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
    394  
    395                   !------------------------------ 
    396                   ! Sea ice surface temperature 
    397                   !------------------------------ 
    398  
    399                   t_su(ji,jj,jl)   = zidto(ji,jj) * 270.0 + ( 1.0 - zidto(ji,jj) ) * t_bo(ji,jj) 
    400  
    401                   !---------------------------------- 
    402                   ! Snow temperature / heat content 
    403                   !---------------------------------- 
    404  
    405                   DO jk = 1, nlay_s 
    406                      t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1.0 - zidto(ji,jj) ) * rtt 
    407                      ! Snow energy of melting 
    408                      e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    409                      ! Change dimensions 
    410                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    411                      ! Multiply by volume, so that heat content in 10^9 Joules 
    412                      e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * & 
    413                         v_s(ji,jj,jl)  / nlay_s 
    414                   END DO 
    415  
    416                   !--------------------------------------------- 
    417                   ! Ice temperature, salinity and heat content 
    418                   !--------------------------------------------- 
    419  
    420                   DO jk = 1, nlay_i 
    421                      t_i(ji,jj,jk,jl) = zidto(ji,jj)*270.00 + ( 1.0 - zidto(ji,jj) ) * rtt  
    422                      s_i(ji,jj,jk,jl) = zidto(ji,jj) * sins + ( 1.0 - zidto(ji,jj) ) * 0.1 
    423                      ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    424  
    425                      ! heat content per unit volume 
    426                      e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * & 
    427                         (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    428                         +   lfus  * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
    429                         - rcp      * ( ztmelts - rtt ) & 
    430                         ) 
    431  
    432                      ! Correct dimensions to avoid big values 
    433                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    434  
    435                      ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    436                      e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * &  
    437                         area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
    438                         nlay_i 
    439                   END DO !jk 
    440  
    441                END DO ! jl  
    442  
    443             ENDIF ! on fcor 
    444  
     328               a_i(ji,jj,jl)    = zidto(ji,jj) * zai(jl) 
     329               ht_i(ji,jj,jl)   = zidto(ji,jj) * zhti(jl) 
     330               v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl) 
     331                
     332               !------------- 
     333               ! Snow depth 
     334               !------------- 
     335               ht_s(ji,jj,jl)   = zidto(ji,jj) * zhts(jl) 
     336               v_s(ji,jj,jl)    = ht_s(ji,jj,jl)*a_i(ji,jj,jl) 
     337                
     338               !--------------- 
     339               ! Ice salinity 
     340               !--------------- 
     341               sm_i(ji,jj,jl)   = zidto(ji,jj) * sinn  + ( 1.0 - zidto(ji,jj) ) * 0.1 
     342               smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
     343                
     344               !---------- 
     345               ! Ice age 
     346               !---------- 
     347               o_i(ji,jj,jl)    = zidto(ji,jj) * 1.0   + ( 1.0 - zidto(ji,jj) ) 
     348               oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl) 
     349                
     350               !------------------------------ 
     351               ! Sea ice surface temperature 
     352               !------------------------------ 
     353               t_su(ji,jj,jl)   = zidto(ji,jj) * 270.0 + ( 1.0 - zidto(ji,jj) ) * t_bo(ji,jj) 
     354                
     355               !------------------------------------ 
     356               ! Snow temperature and heat content 
     357               !------------------------------------ 
     358               DO jk = 1, nlay_s 
     359                  t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1.0 - zidto(ji,jj) ) * rtt 
     360                  ! Snow energy of melting 
     361                  e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
     362                  ! Change dimensions 
     363                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
     364                  ! Multiply by volume, so that heat content in 10^9 Joules 
     365                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * & 
     366                       v_s(ji,jj,jl)  / REAL( nlay_s ) 
     367               END DO !jk 
     368                
     369               !----------------------------------------------- 
     370               ! Ice salinities, temperature and heat content  
     371               !----------------------------------------------- 
     372               DO jk = 1, nlay_i 
     373                  t_i(ji,jj,jk,jl) = zidto(ji,jj)*270.00 + ( 1.0 - zidto(ji,jj) ) * rtt  
     374                  s_i(ji,jj,jk,jl) = zidto(ji,jj) * sinn + ( 1.0 - zidto(ji,jj) ) * 0.1 
     375                  ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
     376                   
     377                  ! heat content per unit volume 
     378                  e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * & 
     379                       (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     380                       +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) & 
     381                       - rcp      * ( ztmelts - rtt ) & 
     382                       ) 
     383                   
     384                  ! Correct dimensions to avoid big values 
     385                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
     386                   
     387                  ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
     388                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * &  
     389                       area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / & 
     390                       REAL( nlay_i ) 
     391               END DO ! jk 
     392                
     393            END DO ! jl  
     394             
    445395         END DO 
    446396      END DO 
    447  
    448       !-------------------------------------------------------------------- 
    449       ! 3) Global ice variables for output diagnostics                    |  
     397  
     398      IF(lwp) THEN                        ! control print 
     399         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     400         WRITE(numout,*) '   max ice  thickness   = ', (MAXVAL(ht_i(:,:,jl)),jl=1,jpl) 
     401         WRITE(numout,*) '   max snow thickness   = ', (MAXVAL(ht_s(:,:,jl)),jl=1,jpl) 
     402         WRITE(numout,*) '   max ice  area        = ', (MAXVAL(a_i(:,:,jl)),jl=1,jpl) 
     403         WRITE(numout,*) '   max ice  salinity    = ', (MAXVAL(sm_i(:,:,jl)),jl=1,jpl) 
     404         WRITE(numout,*) '   min ice  salinity    = ', (MINVAL(sm_i(:,:,jl)),jl=1,jpl) 
     405         WRITE(numout,*) '   max ice  surf temper = ', (MAXVAL(t_su(:,:,jl)-rtt),jl=1,jpl) 
     406         WRITE(numout,*) '   min ice  surf temper = ', (MINVAL(t_su(:,:,jl)-rtt),jl=1,jpl) 
     407      ENDIF 
     408 
     409      !-------------------------------------------------------------------- 
     410      ! 5) Global ice variables for output diagnostics                    |  
    450411      !-------------------------------------------------------------------- 
    451412 
    … …  
    458419 
    459420      !-------------------------------------------------------------------- 
    460       ! 4) Moments for advection 
     421      ! 6) Moments for advection 
    461422      !-------------------------------------------------------------------- 
    462423 
    … …  
    485446      sxysal (:,:,:)  = 0.e0 
    486447 
    487       !-------------------------------------------------------------------- 
    488       ! 5) Lateral boundary conditions                                    |  
     448      sxopw(:,:) = 0.e0 ; syopw(:,:) = 0.e0; sxxopw(:,:) = 0.e0; syyopw(:,:) = 0.e0; sxyopw(:,:) = 0.e0 
     449 
     450      !-------------------------------------------------------------------- 
     451      ! 7) Lateral boundary conditions                                    |  
    489452      !-------------------------------------------------------------------- 
    490453 
    … …  
    518481      CALL lbc_lnk( fsbbq  , 'T', 1. ) 
    519482      ! 
    520       CALL wrk_dealloc( jpm, zgfactorn, zgfactors, zhin, zhis ) 
    521483      CALL wrk_dealloc( jpi, jpj, zidto ) 
    522484      ! 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r3294 r3938  
    2828   USE wrk_nemo         ! work arrays 
    2929   USE prtctl           ! Print control 
     30  ! Check budget (Rousset) 
     31   USE iom              ! I/O manager 
     32   USE lib_fortran     ! glob_sum 
     33   USE limdiahsb 
    3034 
    3135   IMPLICIT NONE 
    … …  
    5054   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/ 
    5155   !                                                           !  closing associated w/ category n 
    52  
    5356   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hrmin    ! minimum ridge thickness 
    5457   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hrmax    ! maximum ridge thickness 
    … …  
    138141      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    139142      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
     143      REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     144      ! mass and salt flux (clem) 
     145      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
    140146      !!----------------------------------------------------------------------------- 
    141147 
    142148      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
     149 
     150      CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    143151 
    144152      IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only) 
    … …  
    148156         CALL prt_ctl(tab2d_1=divu_i, clinfo1=' lim_itd_me: divu_i : ', tab2d_2=delta_i, clinfo2=' delta_i : ') 
    149157      ENDIF 
     158 
     159      IF( ln_limdyn ) THEN          !   Start ridging and rafting   ! 
     160      ! ------------------------------- 
     161      !- check conservation (C Rousset) 
     162      IF (ln_limdiahsb) THEN 
     163         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     164         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     165         zchk_fw_b  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) 
     166         zchk_fs_b  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) 
     167      ENDIF 
     168      !- check conservation (C Rousset) 
     169      ! ------------------------------- 
     170 
     171      ! mass and salt flux init (clem) 
     172      zviold(:,:,:) = v_i(:,:,:) 
     173      zvsold(:,:,:) = v_s(:,:,:) 
     174      zsmvold(:,:,:) = smv_i(:,:,:) 
    150175 
    151176      !-----------------------------------------------------------------------------! 
    … …  
    201226            ! to give asum = 1.0 after ridging. 
    202227 
    203             divu_adv(ji,jj) = ( 1._wp - asum(ji,jj) ) / rdt_ice  ! asum found in ridgeprep 
     228            divu_adv(ji,jj) = ( amax - asum(ji,jj) ) / rdt_ice  ! asum found in ridgeprep 
    204229 
    205230            IF( divu_adv(ji,jj) < 0._wp )   closing_net(ji,jj) = MAX( closing_net(ji,jj), -divu_adv(ji,jj) ) 
    … …  
    286311         DO jj = 1, jpj 
    287312            DO ji = 1, jpi 
    288                IF (ABS(asum(ji,jj) - 1.0) .LT. epsi11) THEN 
     313               IF (ABS(asum(ji,jj) - amax ) .LT. epsi11) THEN 
    289314                  closing_net(ji,jj) = 0._wp 
    290315                  opning     (ji,jj) = 0._wp 
    291316               ELSE 
    292317                  iterate_ridging    = 1 
    293                   divu_adv   (ji,jj) = (1._wp - asum(ji,jj)) / rdt_ice 
     318                  divu_adv   (ji,jj) = ( amax - asum(ji,jj) ) / rdt_ice 
    294319                  closing_net(ji,jj) = MAX( 0._wp, -divu_adv(ji,jj) ) 
    295320                  opning     (ji,jj) = MAX( 0._wp,  divu_adv(ji,jj) ) 
    … …  
    330355         DO ji = 1, jpi 
    331356 
    332             IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) asum_error = .true. 
     357            IF (ABS(asum(ji,jj) - amax) .GT. epsi11) asum_error = .true. 
    333358 
    334359            dardg1dt(ji,jj) = dardg1dt(ji,jj) * dti 
    … …  
    349374      DO jj = 1, jpj 
    350375         DO ji = 1, jpi 
    351             IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) THEN ! there is a bug 
     376            IF (ABS(asum(ji,jj) - amax) .GT. epsi11) THEN ! there is a bug 
    352377               WRITE(numout,*) ' ' 
    353378               WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj) 
    … …  
    377402      CALL lim_var_glo2eqv 
    378403      CALL lim_itd_me_zapsmall 
     404 
     405      !-------------------------------- 
     406      ! Update mass/salt fluxes (clem) 
     407      !-------------------------------- 
     408      DO jl = 1, jpl 
     409         DO jj = 1, jpj  
     410            DO ji = 1, jpi 
     411               diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice 
     412               rdmicif(ji,jj) = rdmicif(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
     413               rdmsnif(ji,jj) = rdmsnif(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
     414               fsalt_rpo(ji,jj) = fsalt_rpo(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
     415            END DO 
     416         END DO 
     417      END DO 
    379418 
    380419      !----------------- 
    … …  
    425464      ENDIF 
    426465 
     466      ! ------------------------------- 
     467      !- check conservation (C Rousset) 
     468      IF (ln_limdiahsb) THEN 
     469         zchk_fs  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     470         zchk_fw  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     471  
     472         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
     473         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
     474 
     475         IF(lwp) THEN 
     476            IF (    ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_me) = ',(zchk_v_i * 86400.) 
     477            IF (    ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_me) = ',(zchk_smv * 86400.) 
     478            IF ( MINVAL( v_i(:,:,:) ) <  0.    ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_me) = ',(MINVAL(v_i) * 1.e-3) 
     479            IF ( MAXVAL( SUM(a_i(:,:,:),dim=3) ) > amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax            (limitd_me) = ',MAXVAL(SUM(a_i,dim=3)) 
     480            IF ( MINVAL( a_i(:,:,:) ) <  0.    ) WRITE(numout,*) 'violation a_i<0               (limitd_me) = ',MINVAL(a_i) 
     481         ENDIF 
     482      ENDIF 
     483      !- check conservation (C Rousset) 
     484      ! ------------------------------- 
     485 
    427486      !-------------------------! 
    428487      ! Back to initial values 
    429488      !-------------------------! 
    430  
    431489      ! update of fields will be made later in lim update 
    432490      u_ice(:,:)    = old_u_ice(:,:) 
    … …  
    439497      oa_i(:,:,:)   = old_oa_i(:,:,:) 
    440498      IF(  num_sal == 2  .OR.  num_sal == 4  )   smv_i(:,:,:)  = old_smv_i(:,:,:) 
    441  
    442499      !----------------------------------------------------! 
    443500      ! Advection of ice in a free cell, newly ridged ice 
    … …  
    448505 
    449506      ! heat content has to be corrected before ice volume 
    450       DO jl = 1, jpl 
    451          DO jk = 1, nlay_i 
    452             DO jj = 1, jpj 
    453                DO ji = 1, jpi 
    454                   IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 
    455                      ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 
    456                      old_e_i(ji,jj,jk,jl)   = d_e_i_trp(ji,jj,jk,jl) 
    457                      d_e_i_trp(ji,jj,jk,jl) = 0._wp 
    458                   ENDIF 
    459                END DO 
    460             END DO 
    461          END DO 
    462       END DO 
    463  
    464       DO jl = 1, jpl 
    465          DO jj = 1, jpj 
    466             DO ji = 1, jpi 
    467                IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 
    468                   ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 
    469                   old_v_i(ji,jj,jl)     = d_v_i_trp(ji,jj,jl) 
    470                   d_v_i_trp(ji,jj,jl)   = 0._wp 
    471                   old_a_i(ji,jj,jl)     = d_a_i_trp(ji,jj,jl) 
    472                   d_a_i_trp(ji,jj,jl)   = 0._wp 
    473                   old_v_s(ji,jj,jl)     = d_v_s_trp(ji,jj,jl) 
    474                   d_v_s_trp(ji,jj,jl)   = 0._wp 
    475                   old_e_s(ji,jj,1,jl)   = d_e_s_trp(ji,jj,1,jl) 
    476                   d_e_s_trp(ji,jj,1,jl) = 0._wp 
    477                   old_oa_i(ji,jj,jl)    = d_oa_i_trp(ji,jj,jl) 
    478                   d_oa_i_trp(ji,jj,jl)  = 0._wp 
    479                   IF(  num_sal == 2  .OR.  num_sal == 4  )   old_smv_i(ji,jj,jl)   = d_smv_i_trp(ji,jj,jl) 
    480                   d_smv_i_trp(ji,jj,jl) = 0._wp 
    481                ENDIF 
    482             END DO 
    483          END DO 
    484       END DO 
    485  
     507!clem@order 
     508!      DO jl = 1, jpl 
     509!         DO jk = 1, nlay_i 
     510!            DO jj = 1, jpj 
     511!               DO ji = 1, jpi 
     512!                  IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 
     513!                     ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 
     514!                     old_e_i(ji,jj,jk,jl)   = d_e_i_trp(ji,jj,jk,jl) 
     515!                     d_e_i_trp(ji,jj,jk,jl) = 0._wp 
     516!                  ENDIF 
     517!               END DO 
     518!            END DO 
     519!         END DO 
     520!      END DO 
     521! 
     522!      DO jl = 1, jpl 
     523!         DO jj = 1, jpj 
     524!            DO ji = 1, jpi 
     525!               IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. & 
     526!                  ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN 
     527!                  old_v_i(ji,jj,jl)     = d_v_i_trp(ji,jj,jl) 
     528!                  d_v_i_trp(ji,jj,jl)   = 0._wp 
     529!                  old_a_i(ji,jj,jl)     = d_a_i_trp(ji,jj,jl) 
     530!                  d_a_i_trp(ji,jj,jl)   = 0._wp 
     531!                  old_v_s(ji,jj,jl)     = d_v_s_trp(ji,jj,jl) 
     532!                  d_v_s_trp(ji,jj,jl)   = 0._wp 
     533!                  old_e_s(ji,jj,1,jl)   = d_e_s_trp(ji,jj,1,jl) 
     534!                  d_e_s_trp(ji,jj,1,jl) = 0._wp 
     535!                  old_oa_i(ji,jj,jl)    = d_oa_i_trp(ji,jj,jl) 
     536!                  d_oa_i_trp(ji,jj,jl)  = 0._wp 
     537!                  IF(  num_sal == 2  .OR.  num_sal == 4  )   old_smv_i(ji,jj,jl)   = d_smv_i_trp(ji,jj,jl) 
     538!                  d_smv_i_trp(ji,jj,jl) = 0._wp 
     539!               ENDIF 
     540!            END DO 
     541!         END DO 
     542!      END DO 
     543!clem@order 
     544      ENDIF  ! ln_limdyn=.true. 
     545      ! 
    486546      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
     547      ! 
     548      CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    487549      ! 
    488550   END SUBROUTINE lim_itd_me 
    … …  
    10861148            afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 
    10871149 
    1088             IF (afrac(ji,jj) > 1.0 + epsi11) THEN  !riging 
     1150            IF (afrac(ji,jj) > amax + epsi11) THEN  !riging 
    10891151               large_afrac = .true. 
    1090             ELSEIF (afrac(ji,jj) > 1.0) THEN  ! roundoff error 
    1091                afrac(ji,jj) = 1.0 
     1152            ELSEIF (afrac(ji,jj) > amax) THEN  ! roundoff error 
     1153               afrac(ji,jj) = amax 
    10921154            ENDIF 
    1093             IF (afrft(ji,jj) > 1.0 + epsi11) THEN !rafting 
     1155            IF (afrft(ji,jj) > amax + epsi11) THEN !rafting 
    10941156               large_afrft = .true. 
    1095             ELSEIF (afrft(ji,jj) > 1.0) THEN  ! roundoff error 
    1096                afrft(ji,jj) = 1.0 
     1157            ELSEIF (afrft(ji,jj) > amax) THEN  ! roundoff error 
     1158               afrft(ji,jj) = amax 
    10971159            ENDIF 
    10981160 
    … …  
    11371199             
    11381200            !                                                             ! excess of salt is flushed into the ocean 
    1139             fsalt_rpo(ji,jj) = fsalt_rpo(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic / rdt_ice 
     1201            !fsalt_rpo(ji,jj) = fsalt_rpo(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic / rdt_ice 
     1202 
     1203            !rdmicif(ji,jj) = rdmicif(ji,jj) + vsw(ji,jj) * rhoic    ! gurvan: increase in ice volume du to seawater frozen in voids              
    11401204 
    11411205            !------------------------------------             
    … …  
    11481212            dardg1dt   (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj) 
    11491213            dardg2dt   (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj) 
    1150             diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) / rdt_ice 
     1214            !clem diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) / rdt_ice 
    11511215            opening    (ji,jj) = opening (ji,jj) + opning(ji,jj)*rdt_ice 
    11521216 
    … …  
    12171281 
    12181282               ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    1219                ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / nlay_i 
     1283               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / REAL( nlay_i ) 
    12201284 
    12211285               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
    … …  
    12401304               ji = indxi(ij) 
    12411305               jj = indxj(ij) 
    1242                IF( afrac(ji,jj) > 1.0 + epsi11 ) THEN  
     1306               IF( afrac(ji,jj) > amax + epsi11 ) THEN  
    12431307                  WRITE(numout,*) '' 
    12441308                  WRITE(numout,*) ' ardg > a_i' 
    … …  
    12521316               ji = indxi(ij) 
    12531317               jj = indxj(ij) 
    1254                IF( afrft(ji,jj) > 1.0 + epsi11 ) THEN  
     1318               IF( afrft(ji,jj) > amax + epsi11 ) THEN  
    12551319                  WRITE(numout,*) '' 
    12561320                  WRITE(numout,*) ' arft > a_i' 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r3294 r3938  
    3434   USE lib_mpp          ! MPP library 
    3535   USE wrk_nemo         ! work arrays 
     36   USE lib_fortran      ! to use key_nosignedzero 
    3637 
    3738   IMPLICIT NONE 
    … …  
    4445   PUBLIC   lim_itd_shiftice 
    4546 
    46    REAL(wp) ::   epsi20 = 1e-20_wp   ! constant values 
    47    REAL(wp) ::   epsi13 = 1e-13_wp   ! 
    48    REAL(wp) ::   epsi10 = 1e-10_wp   ! 
     47   REAL(wp) ::   epsi20 = 1.e-20_wp   ! constant values 
     48   REAL(wp) ::   epsi13 = 1.e-13_wp   ! 
     49   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    4950 
    5051   !!---------------------------------------------------------------------- 
    … …  
    6667      ! 
    6768      INTEGER ::   jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index          
    68  
    69       !!------------------------------------------------------------------ 
     69      REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     70      !!------------------------------------------------------------------ 
     71      ! ------------------------------- 
     72      !- check conservation (C Rousset) 
     73      IF (ln_limdiahsb) THEN 
     74         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     75         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     76         zchk_fw_b  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) 
     77         zchk_fs_b  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) 
     78      ENDIF 
     79      !- check conservation (C Rousset) 
     80      ! ------------------------------- 
    7081 
    7182      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    106117      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
    107118      d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 
    108  
     119      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:) 
    109120      d_smv_i_thd(:,:,:) = 0._wp 
    110121      IF( num_sal == 2 .OR. num_sal == 4 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
     122 
     123      ! diag only (clem) 
     124      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) / rdt_ice * 86400.0 
    111125 
    112126      IF(ln_ctl) THEN   ! Control print 
    … …  
    141155         END DO 
    142156      ENDIF 
    143  
     157      ! 
     158      ! ------------------------------- 
     159      !- check conservation (C Rousset) 
     160      IF (ln_limdiahsb) THEN 
     161         zchk_fs  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     162         zchk_fw  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     163  
     164         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
     165         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
     166 
     167         IF(lwp) THEN 
     168            IF (    ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_th) = ',(zchk_v_i * 86400.) 
     169            IF (    ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * 86400.) 
     170            IF ( MINVAL( v_i(:,:,:) ) <  0.    ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_th) = ',(MINVAL(v_i) * 1.e-3) 
     171            IF ( MAXVAL( SUM(a_i(:,:,:),dim=3) ) >  amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax    (limitd_th) = ',MAXVAL(SUM(a_i,dim=3)) 
     172         ENDIF 
     173       ENDIF 
     174      !- check conservation (C Rousset) 
     175      ! ------------------------------- 
     176      ! 
    144177      !- Recover Old values 
    145178      a_i(:,:,:)   = old_a_i (:,:,:) 
    … …  
    148181      e_s(:,:,:,:) = old_e_s (:,:,:,:) 
    149182      e_i(:,:,:,:) = old_e_i (:,:,:,:) 
    150       ! 
     183      !?? oa_i(:,:,:)  = old_oa_i(:,:,:) 
    151184      IF( num_sal == 2 .OR. num_sal == 4 )   smv_i(:,:,:)       = old_smv_i (:,:,:) 
    152185      ! 
    … …  
    239272         DO jj = 1, jpj 
    240273            DO ji = 1, jpi 
    241                zindb             = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl)))     !0 if no ice and 1 if yes 
     274               zindb             = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl)+epsi10))     !0 if no ice and 1 if yes 
    242275               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX(a_i(ji,jj,jl),epsi10) * zindb 
    243                zindb             = 1.0-MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
     276               zindb             = 1.0-MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes 
    244277               zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX(old_a_i(ji,jj,jl),epsi10) * zindb 
    245278               IF( a_i(ji,jj,jl) > 1e-6 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
    … …  
    405438                     * a_i(zji,zjj,klbnd) / ( a_i(zji,zjj,klbnd) - zda0 ) 
    406439                  a_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd) - zda0 
    407                   v_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd)*ht_i(zji,zjj,klbnd) 
     440                  v_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd)*ht_i(zji,zjj,klbnd) ! clem@useless 
    408441               ENDIF     ! zetamax > 0 
    409442               ! ji, a_i > epsi10 
    … …  
    499532            a_i(zji,zjj,1)  = a_i(zji,zjj,1) * ht_i(zji,zjj,1) / zhimin  
    500533            ht_i(zji,zjj,1) = zhimin 
    501             v_i(zji,zjj,1)  = a_i(zji,zjj,1)*ht_i(zji,zjj,1) 
     534            v_i(zji,zjj,1)  = a_i(zji,zjj,1)*ht_i(zji,zjj,1) !clem@useless 
    502535         ENDIF 
    503536      END DO !ji 
    … …  
    859892                  ht_i(ji,jj,jl)  =  v_i   (ji,jj,jl) / a_i(ji,jj,jl)  
    860893                  t_su(ji,jj,jl)  =  zaTsfn(ji,jj,jl) / a_i(ji,jj,jl)  
    861                   zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl))) !0 if no ice and 1 if yes 
     894                  zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes 
    862895               ELSE 
    863896                  ht_i(ji,jj,jl)  = 0._wp 
    … …  
    9681001                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl) 
    9691002                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl) 
     1003                  ! begin TECLIM change 
     1004                  ! zdaice(ji,jj,jl)  = a_i(ji,jj,jl)  
     1005                  ! zdvice(ji,jj,jl)  = v_i(ji,jj,jl) 
     1006                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl)/2 
     1007                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1))/2 
     1008                  ! end TECLIM change  
    9701009               ENDIF 
    9711010            END DO                 ! ji 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r3294 r3938  
    3535   USE dom_ice_2        ! LIM2: ice domain 
    3636#endif 
     37   USE lib_fortran      ! to use key_nosignedzero 
     38 
     39#if defined key_bdy 
     40   USE bdyice_lim 
     41#endif 
    3742 
    3843   IMPLICIT NONE 
    … …  
    4348   REAL(wp) ::   rzero   = 0._wp   ! constant values 
    4449   REAL(wp) ::   rone    = 1._wp   ! constant values 
     50   REAL(wp) ::   epsi20  = 1.e-20_wp   ! constant values 
    4551       
    4652   !! * Substitutions 
    … …  
    189195#endif 
    190196            ! tmi = 1 where there is ice or on land 
    191             tmi(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj) 
     197            tmi(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) ) ) ) * tms(ji,jj) 
    192198         END DO 
    193199      END DO 
    … …  
    569575 
    570576         ENDIF 
     577          
     578!#if defined key_bdy 
     579!         ! clem: change u_ice and v_ice at the boundary for each iteration 
     580!         CALL bdy_ice_lim_dyn() 
     581!#endif          
    571582 
    572583         IF(ln_ctl) THEN 
    … …  
    580591         ENDIF 
    581592 
    582          !                                                   ! ==================== ! 
     593         !                                                ! ==================== ! 
    583594      END DO                                              !  end loop over jter  ! 
    584595      !                                                   ! ==================== ! 
    585  
    586596      ! 
    587597      !------------------------------------------------------------------------------! 
    588598      ! 4) Prevent ice velocities when the ice is thin 
    589599      !------------------------------------------------------------------------------! 
    590       ! 
    591       ! If the ice thickness is below 1cm then ice velocity should equal the 
     600      !clem : add hminrhg in the namelist 
     601      ! 
     602      ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    592603      ! ocean velocity,  
    593604      ! This prevents high velocity when ice is thin 
    … …  
    598609            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) )  
    599610            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    600             IF ( zdummy .LE. 5.0e-2 ) THEN 
     611            IF ( zdummy .LE. hminrhg ) THEN 
    601612               u_ice(ji,jj) = u_oce(ji,jj) 
    602613               v_ice(ji,jj) = v_oce(ji,jj) 
    … …  
    607618      CALL lbc_lnk( u_ice(:,:), 'U', -1. )  
    608619      CALL lbc_lnk( v_ice(:,:), 'V', -1. )  
     620 
     621      ! clem: change u_ice and v_ice at the boundary 
     622#if defined key_bdy 
     623      CALL bdy_ice_lim_dyn() 
     624#endif          
    609625 
    610626      DO jj = k_j1+1, k_jpj-1  
    … …  
    612628            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) )  
    613629            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    614             IF ( zdummy .LE. 5.0e-2 ) THEN 
     630            IF ( zdummy .LE. hminrhg ) THEN 
    615631               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   & 
    616632                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) & 
    … …  
    637653            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 
    638654 
    639             IF ( zdummy .LE. 5.0e-2 ) THEN 
     655            IF ( zdummy .LE. hminrhg ) THEN 
    640656 
    641657               zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      & 
    … …  
    692708            divu_i (ji,jj) = zdd   (ji,jj) 
    693709            delta_i(ji,jj) = deltat(ji,jj) 
    694             shear_i(ji,jj) = zds   (ji,jj) 
     710            ! begin TECLIM change  
     711            ! shear_i(ji,jj) = zds   (ji,jj) 
     712            zdst       = (  e2u( ji  , jj   ) * v_ice1(ji,jj)           &    
     713               &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &    
     714               &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &    
     715               &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1)         &    
     716               &          )                                             &    
     717               &         / area(ji,jj)  
     718            shear_i(ji,jj) = SQRT( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) 
     719            ! end TECLIM change 
    695720         END DO 
    696721      END DO 
    … …  
    699724      CALL lbc_lnk( divu_i (:,:), 'T', 1. ) 
    700725      CALL lbc_lnk( delta_i(:,:), 'T', 1. ) 
    701       CALL lbc_lnk( shear_i(:,:), 'F', 1. ) 
     726      ! CALL lbc_lnk( shear_i(:,:), 'F', 1. ) 
     727      CALL lbc_lnk( shear_i(:,:), 'T', 1. ) 
    702728 
    703729      ! * Store the stress tensor for the next time step 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r3294 r3938  
    2525   USE lib_mpp          ! MPP library 
    2626   USE wrk_nemo         ! work arrays 
     27   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2728 
    2829   IMPLICIT NONE 
    … …  
    161162      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'     , v_ice      ) 
    162163      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'     , fsbbq      ) 
     164      CALL iom_rstput( iter, nitrst, numriw, 'iatte'     , iatte      ) ! clem modif 
     165      CALL iom_rstput( iter, nitrst, numriw, 'oatte'     , oatte      ) ! clem modif 
    163166      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  ) 
    164167      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i  ) 
    … …  
    339342      !Control of date 
    340343 
    341       IF( ( nit000 - INT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
     344      IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   & 
    342345         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  & 
    343346         &                   '   verify the file or rerun with the value 0 for the',        & 
    344347         &                   '   control of time parameter  nrstdt' ) 
    345       IF( INT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
     348      IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   & 
    346349         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart',  & 
    347350         &                   '   verify the file or rerun with the value 0 for the',         & 
    … …  
    436439      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    437440      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
     441      CALL iom_get( numrir, jpdom_autoglo, 'iatte'     , iatte      ) ! clem modif 
     442      CALL iom_get( numrir, jpdom_autoglo, 'oatte'     , oatte      ) ! clem modif 
    438443      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    439444      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
    … …  
    562567      END DO 
    563568      ! 
    564       CALL iom_close( numrir ) 
     569      !clem CALL iom_close( numrir ) 
    565570      ! 
    566571      CALL wrk_dealloc( nlay_i, zs_zero ) 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r3294 r3938  
    1010   !!                 !                  + simplification of the ice-ocean stress calculation 
    1111   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     12   !!             -   ! 2012    (D. Iovino) salt flux change 
     13   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux 
    1214   !!---------------------------------------------------------------------- 
    1315#if defined key_lim3 
    … …  
    3436   USE prtctl           ! Print control 
    3537   USE cpl_oasis3, ONLY : lk_cpl 
     38   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
     39   USE lib_fortran      ! to use key_nosignedzero 
    3640 
    3741   IMPLICIT NONE 
    … …  
    4448   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice  
    4549   REAL(wp)  ::   epsi16 = 1.e-16_wp   ! constant values 
     50   REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values 
    4651   REAL(wp)  ::   rzero  = 0._wp     
    4752   REAL(wp)  ::   rone   = 1._wp 
    … …  
    100105      INTEGER  ::   ifvt, i1mfr, idfr               ! some switches 
    101106      INTEGER  ::   iflt, ial, iadv, ifral, ifrdv 
    102       REAL(wp) ::   zinda, zfons, zpme              ! local scalars 
     107      REAL(wp) ::   zinda, zindb, zfons, zpme              ! local scalars 
     108      REAL(wp) ::   zfmm             ! IOVINO freezing minus melting (F-M)  
    103109      REAL(wp), POINTER, DIMENSION(:,:) ::   zfcm1 , zfcm2    ! solar/non solar heat fluxes 
    104110      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace 
    … …  
    117123         DO ji = 1, jpi 
    118124            zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    119             ifvt    = zinda  *  MAX( rzero , SIGN( rone, -phicif  (ji,jj) ) )  !subscripts are bad here 
    120             i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - ( at_i(ji,jj)       ) ) ) 
     125            zindb   = 1.0 - MAX( rzero , SIGN( rone , - iatte(ji,jj) ) ) 
     126            ifvt    = zinda  *  MAX( rzero , SIGN( rone, - phicif(ji,jj) ) )  !subscripts are bad here 
     127            i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - at_i(ji,jj) ) ) 
    121128            idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 
    122129            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt ) 
    … …  
    139146 
    140147            !   computation the solar flux at ocean surface 
    141             zfcm1(ji,jj)   = pfrld(ji,jj) * qsr(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 
     148            zfcm1(ji,jj)   = pfrld(ji,jj) * qsr(ji,jj)  + & 
     149                 &           zindb * ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) / MAX( iatte(ji,jj), epsi20 ) 
    142150            ! fstric     Solar flux transmitted trough the ice 
    143151            ! qsr        Net short wave heat flux on free ocean 
    144152            ! new line 
    145             fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
     153            fscmbq(ji,jj) = zindb * ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / MAX( iatte(ji,jj), epsi20 ) 
    146154 
    147155            !  computation the non solar heat flux at ocean surface 
    … …  
    178186 
    179187            !!gm   this IF prevents the vertorisation of the whole loop 
    180             IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 
    181                WRITE(numout,*) ' lim_sbc : heat fluxes ' 
    182                WRITE(numout,*) ' qsr       : ', qsr(jiindx,jjindx) 
    183                WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindx,jjindx) 
    184                WRITE(numout,*) ' pfrld     : ', pfrld(jiindx,jjindx) 
    185                WRITE(numout,*) ' fstric    : ', fstric (jiindx,jjindx) 
    186                WRITE(numout,*) 
    187                WRITE(numout,*) ' qns       : ', qns(jiindx,jjindx) 
    188                WRITE(numout,*) ' zfcm2     : ', zfcm2(jiindx,jjindx) 
    189                WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindx,jjindx) 
    190                WRITE(numout,*) ' ifral     : ', ifral 
    191                WRITE(numout,*) ' ial       : ', ial   
    192                WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx) 
    193                WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx) 
    194                WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice 
    195                WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice 
    196                WRITE(numout,*) ' ifrdv     : ', ifrdv 
    197                WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx) 
    198                WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx) 
    199                WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice 
    200                WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice 
    201                WRITE(numout,*) ' ' 
    202                WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
    203                WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx) 
    204                WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(jiindx,jjindx) 
    205                WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx) 
    206                WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 
    207             ENDIF 
     188          !  IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 
     189          !     WRITE(numout,*) 'lim_sbc : heat fluxes ' 
     190          !     WRITE(numout,*) ' at_i      : ', at_i(jiindx,jjindx) 
     191          !     WRITE(numout,*) ' ht_i      : ', SUM( ht_i(jiindx,jjindx,1:jpl) ) 
     192          !     WRITE(numout,*) ' ht_s      : ', SUM( ht_s(jiindx,jjindx,1:jpl) ) 
     193          !     WRITE(numout,*) 
     194          !     WRITE(numout,*) ' qsr       : ', qsr(jiindx,jjindx) 
     195          !     WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindx,jjindx) 
     196          !     WRITE(numout,*) ' pfrld     : ', pfrld(jiindx,jjindx) 
     197          !     WRITE(numout,*) ' fstric    : ', fstric (jiindx,jjindx) 
     198          !     WRITE(numout,*) 
     199          !     WRITE(numout,*) ' qns       : ', qns(jiindx,jjindx) 
     200          !     WRITE(numout,*) ' zfcm2     : ', zfcm2(jiindx,jjindx) 
     201          !     WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindx,jjindx) 
     202          !     WRITE(numout,*) ' ifral     : ', ifral 
     203          !     WRITE(numout,*) ' ial       : ', ial   
     204          !     WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx) 
     205          !     WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx) 
     206          !     !WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice 
     207          !     !WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice 
     208          !     WRITE(numout,*) ' ifrdv     : ', ifrdv 
     209          !     WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx) 
     210          !     WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx) 
     211          !     !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice 
     212          !     !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice 
     213          !     WRITE(numout,*) ' ' 
     214          !     WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
     215          !     WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx) 
     216          !     WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(jiindx,jjindx) 
     217          !     WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx) 
     218          !     WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 
     219          !  ENDIF 
    208220            !!gm   end 
    209221         END DO 
    … …  
    236248            !  computing salt exchanges at the ice/ocean interface 
    237249            !  sice should be the same as computed with the ice model 
    238             zfons =  ( soce_0(ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice  
     250            !zfons =  ( soce_0(ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice  
    239251            ! SOCE 
    240             zfons =  ( sss_m (ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice 
    241  
     252            !zfons =  ( sss_m (ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice 
     253            zfmm = rdmicif(ji,jj) * r1_rdtice  ! IOVINO   
    242254            !CT useless            !  salt flux for constant salinity 
    243255            !CT useless            fsalt(ji,jj)      =  zfons / ( sss_m(ji,jj) + epsi16 ) + fsalt_res(ji,jj) 
    … …  
    247259            fsbri(ji,jj)      =  zinda*fsbri(ji,jj) 
    248260            !  converting the salt fluxes from ice to a freshwater flux from ocean 
    249             fsalt_res(ji,jj)  =  fsalt_res(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 
    250             fseqv(ji,jj)      =  fseqv(ji,jj)     / ( sss_m(ji,jj) + epsi16 ) 
    251             fsbri(ji,jj)      =  fsbri(ji,jj)     / ( sss_m(ji,jj) + epsi16 ) 
    252             fsalt_rpo(ji,jj)  =  fsalt_rpo(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 
     261            ! fsalt_res(ji,jj)  =  fsalt_res(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 
     262            ! fseqv(ji,jj)      =  fseqv(ji,jj)     / ( sss_m(ji,jj) + epsi16 ) 
     263            ! fsbri(ji,jj)      =  fsbri(ji,jj)     / ( sss_m(ji,jj) + epsi16 ) 
     264            ! fsalt_rpo(ji,jj)  =  fsalt_rpo(ji,jj) / ( sss_m(ji,jj) + epsi16 ) 
    253265 
    254266            !  freshwater mass exchange (positive to the ice, negative for the ocean ?) 
    … …  
    258270            !  POSITIVE FRESHWATER FLUX FROM THE OCEAN TO THE ICE [kg.m-2.s-1] 
    259271 
    260             emp(ji,jj) = - zpme  
     272            emp(ji,jj) =  - zpme + zfmm ! volume flux IOVINO   
     273            ! emp(ji,jj) = - zpme  
    261274         END DO 
    262275      END DO 
    263276 
    264277      IF( num_sal == 2 ) THEN      ! variable ice salinity: brine drainage included in the salt flux 
    265          emps(:,:) = fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:) 
     278         emps(:,:) =   fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ! + emp(:,:) ! IOVINO 
    266279      ELSE                         ! constant ice salinity: 
    267          emps(:,:) =              fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:) 
     280         emps(:,:) =   fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ! + emp(:,:)              ! IOVINO 
    268281      ENDIF 
     282 
    269283 
    270284      !-----------------------------------------------! 
    … …  
    402416         END WHERE 
    403417      ENDIF 
     418      ! clem modif 
     419      iatte(:,:) = 1._wp 
     420      oatte(:,:) = 1._wp 
    404421      ! 
    405422   END SUBROUTINE lim_sbc_init 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r3294 r3938  
    1111   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 
    1212   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     13   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_lim3 
    … …  
    3940   USE in_out_manager  ! I/O manager 
    4041   USE prtctl          ! Print control 
     42   USE lib_fortran      ! to use key_nosignedzero 
    4143 
    4244   IMPLICIT NONE 
    … …  
    9193      REAL(wp) ::   zfntlat, zpareff, zareamin, zcoef   !    -         - 
    9294      REAL(wp), POINTER, DIMENSION(:,:) ::   zqlbsbq   ! link with lead energy budget qldif 
     95      REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    9396      !!------------------------------------------------------------------- 
    9497 
    9598      CALL wrk_alloc( jpi, jpj, zqlbsbq ) 
    9699    
     100      ! ------------------------------- 
     101      !- check conservation (C Rousset) 
     102      IF (ln_limdiahsb) THEN 
     103         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     104         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     105         zchk_fw_b  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) 
     106         zchk_fs_b  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) 
     107      ENDIF 
     108      !- check conservation (C Rousset) 
     109      ! ------------------------------- 
     110 
    97111      !------------------------------------------------------------------------------! 
    98112      ! 1) Initialization of diagnostic variables                                    ! 
    … …  
    108122               DO ji = 1, jpi 
    109123                  !Energy of melting q(S,T) [J.m-3] 
    110                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi06 ) ) * nlay_i 
     124                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi06 ) ) * REAL( nlay_i ) 
    111125                  !0 if no ice and 1 if yes 
    112126                  zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i(ji,jj,jl) ) )  
    … …  
    120134               DO ji = 1, jpi 
    121135                  !Energy of melting q(S,T) [J.m-3] 
    122                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * nlay_s 
     136                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * REAL( nlay_s ) 
    123137                  !0 if no ice and 1 if yes 
    124138                  zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s(ji,jj,jl) ) )  
    … …  
    133147      ! 1.3) Set some dummies to 0 
    134148      !----------------------------- 
    135       rdvosif(:,:) = 0.e0   ! variation of ice volume at surface 
    136       rdvobif(:,:) = 0.e0   ! variation of ice volume at bottom 
    137       fdvolif(:,:) = 0.e0   ! total variation of ice volume 
    138       rdvonif(:,:) = 0.e0   ! lateral variation of ice volume 
    139       fstric (:,:) = 0.e0   ! part of solar radiation transmitted through the ice 
    140       ffltbif(:,:) = 0.e0   ! linked with fstric 
    141       qfvbq  (:,:) = 0.e0   ! linked with fstric 
    142       rdmsnif(:,:) = 0.e0   ! variation of snow mass per unit area 
    143       rdmicif(:,:) = 0.e0   ! variation of ice mass per unit area 
    144       hicifp (:,:) = 0.e0   ! daily thermodynamic ice production.  
    145       fsbri  (:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
    146       fhbri  (:,:) = 0.e0   ! brine flux contribution to heat flux to the ocean 
    147       fseqv  (:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
     149      !clem rdvosif(:,:) = 0.e0   ! variation of ice volume at surface 
     150      !clem rdvobif(:,:) = 0.e0   ! variation of ice volume at bottom 
     151      !clem fdvolif(:,:) = 0.e0   ! total variation of ice volume 
     152      !clem rdvonif(:,:) = 0.e0   ! lateral variation of ice volume 
     153      !clem fstric (:,:) = 0.e0   ! part of solar radiation transmitted through the ice 
     154      !clem ffltbif(:,:) = 0.e0   ! linked with fstric 
     155      !clem qfvbq  (:,:) = 0.e0   ! linked with fstric 
     156      !clem rdmsnif(:,:) = 0.e0   ! variation of snow mass per unit area 
     157      !clem rdmicif(:,:) = 0.e0   ! variation of ice mass per unit area 
     158      !clem hicifp (:,:) = 0.e0   ! daily thermodynamic ice production.  
     159      !clem fsbri  (:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
     160      !clem fhbri  (:,:) = 0.e0   ! brine flux contribution to heat flux to the ocean 
     161      !clem fseqv  (:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
    148162 
    149163      !----------------------------------- 
    … …  
    164178!CDIR NOVERRCHK 
    165179         DO ji = 1, jpi 
    166             zthsnice       = SUM( ht_s(ji,jj,1:jpl) ) + SUM( ht_i(ji,jj,1:jpl) ) 
    167             zindb          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice ) ) )  
     180            !clem zthsnice       = SUM( ht_s(ji,jj,1:jpl) ) + SUM( ht_i(ji,jj,1:jpl) ) 
     181            !clem zindb          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice + epsi20 ) ) )  
    168182            phicif(ji,jj)  = vt_i(ji,jj) 
    169183            pfrld(ji,jj)   = 1.0 - at_i(ji,jj) 
    170             zinda          = 1.0 - MAX( zzero , SIGN( zone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
     184            zinda          = tms(ji,jj) * (1.0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) ) ) ) 
    171185            ! 
    172186            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    … …  
    179193 
    180194            ! here the drag will depend on ice thickness and type (0.006) 
    181             fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) )  
     195            fdtcn(ji,jj)  = zinda * rau0 * rcp * 0.006  * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) )  
    182196            ! also category dependent 
    183197            !           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
    184             qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * (1.0 - at_i(ji,jj)) * rdt_ice 
     198            qdtcn(ji,jj)  = zinda * fdtcn(ji,jj) * (1.0 - at_i(ji,jj)) * rdt_ice 
    185199            !                        
    186200            !           !-- Lead heat budget, qldif (part 1, next one is in limthd_dh)  
    187201            !           !   caution: exponent betas used as more snow can fallinto leads 
    188202            qldif(ji,jj) =  tms(ji,jj) * rdt_ice  * (                             & 
    189                &   pfrld(ji,jj)        * (  qsr(ji,jj)                            &   ! solar heat 
     203               &   pfrld(ji,jj)        * (  qsr(ji,jj) * oatte(ji,jj)             &   ! solar heat + clem modif 
    190204               &                            + qns(ji,jj)                          &   ! non solar heat 
    191205               &                            + fdtcn(ji,jj)                        &   ! turbulent ice-ocean heat 
    192                &                            + fsbbq(ji,jj) * ( 1.0 - zindb )  )   &   ! residual heat from previous step 
     206               &                            + fsbbq(ji,jj) * ( 1.0 - zinda )  )   &   ! residual heat from previous step 
    193207               & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus                    )   ! latent heat of sprecip melting 
    194208            ! 
    … …  
    205219            ! 
    206220            ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx) 
    207             qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) * ( 1. - zinda ) 
     221            qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) !!clem * ( 1. - zinda ) 
    208222            ! 
    209223            ! oceanic heat flux (limthd_dh) 
    210             fbif   (ji,jj) = zindb * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi20 ) + fdtcn(ji,jj) ) 
     224            fbif   (ji,jj) = zinda * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi20 ) + fdtcn(ji,jj) ) 
    211225            ! 
    212226         END DO 
    … …  
    294308            CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric     , jpi, jpj, npb(1:nbpb) ) 
    295309            CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq      , jpi, jpj, npb(1:nbpb) ) 
    296  
     310            CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte(:,:) , jpi, jpj, npb(1:nbpb) ) ! clem modif 
     311            CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte(:,:) , jpi, jpj, npb(1:nbpb) ) ! clem modif 
    297312            !-------------------------------- 
    298313            ! 4.3) Thermodynamic processes 
    … …  
    305320            CALL lim_thd_dif( 1, nbpb, jl )   ! Ice/Snow Temperature profile    ! 
    306321            !                                 !---------------------------------! 
    307  
     322! 
    308323            CALL lim_thd_enmelt( 1, nbpb )    ! computes sea ice energy of melting compulsory for limthd_dh 
    309  
     324! 
    310325            IF( con_i )   CALL lim_thd_glohec ( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )  
    311326            IF( con_i )   CALL lim_thd_con_dif( 1 , nbpb , jl ) 
    … …  
    314329            CALL lim_thd_dh( 1, nbpb, jl )    ! Ice/Snow thickness              !  
    315330            !                                 !---------------------------------! 
    316  
    317331            !                                 !---------------------------------! 
    318332            CALL lim_thd_ent( 1, nbpb, jl )   ! Ice/Snow enthalpy remapping     ! 
    319333            !                                 !---------------------------------! 
    320  
    321334            !                                 !---------------------------------! 
    322335            CALL lim_thd_sal( 1, nbpb )       ! Ice salinity computation        ! 
    323336            !                                 !---------------------------------! 
    324  
    325337            !           CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting 
    326338            IF( con_i )   CALL lim_thd_glohec( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )  
    … …  
    418430      ! 5.4) Diagnostic thermodynamic growth rates 
    419431      !-------------------------------------------- 
    420       d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes  
    421       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) / rdt_ice * 86400.0 
     432!clem@useless      d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes  
     433!clem@mv-to-itd    dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) / rdt_ice * 86400.0 
    422434 
    423435      IF( con_i )   fbif(:,:) = fbif(:,:) + zqlbsbq(:,:) 
    … …  
    455467      ENDIF 
    456468      ! 
     469      ! ------------------------------- 
     470      !- check conservation (C Rousset) 
     471      IF (ln_limdiahsb) THEN 
     472         zchk_fs  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     473         zchk_fw  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     474  
     475         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
     476         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
     477 
     478         IF(lwp) THEN 
     479            IF (    ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limthd) = ',(zchk_v_i * 86400.) 
     480            IF (    ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limthd) = ',(zchk_smv * 86400.) 
     481            IF ( MINVAL( v_i(:,:,:) ) <  0.    ) WRITE(numout,*) 'violation v_i<0  [mm]         (limthd) = ',(MINVAL(v_i) * 1.e-3) 
     482            IF ( MAXVAL( SUM(a_i(:,:,:),dim=3) ) >  amax+epsi10 ) WRITE(numout,*) 'violation a_i>amax    (limthd) = ',MAXVAL(SUM(a_i,dim=3)) 
     483         ENDIF 
     484      ENDIF 
     485      !- check conservation (C Rousset) 
     486      ! ------------------------------- 
     487      ! 
    457488      CALL wrk_dealloc( jpi, jpj, zqlbsbq ) 
    458489      ! 
    … …  
    479510      DO jk = 1, nlay_i                ! total q over all layers, ice [J.m-2] 
    480511         DO ji = kideb, kiut 
    481             etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 
     512            etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    482513            eti     (ji,jl) = eti(ji,jl) + etilayer(ji,jk)  
    483514         END DO 
    484515      END DO 
    485516      DO ji = kideb, kiut              ! total q over all layers, snow [J.m-2] 
    486          ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / nlay_s 
     517         ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / REAL( nlay_s ) 
    487518      END DO 
    488519      ! 
    … …  
    799830      !!------------------------------------------------------------------- 
    800831      NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   & 
    801          &                hicmin, hiclim, amax  ,                                & 
     832         &                hicmin, hiclim,                                        & 
    802833         &                sbeta  , parlat, hakspl, hibspl, exld,                 & 
    803834         &                hakdif, hnzst  , thth  , parsub, alphs, betas,         &  
    … …  
    825856         WRITE(numout,*)'      ice thick. corr. to max. energy stored in brine pocket  hicmin       = ', hicmin   
    826857         WRITE(numout,*)'      minimum ice thickness                                   hiclim       = ', hiclim  
    827          WRITE(numout,*)'      maximum lead fraction                                   amax         = ', amax  
    828858         WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    829859         WRITE(numout,*)'      Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)   sbeta        = ', sbeta 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r3294 r3938  
    2424   USE lib_mpp          ! MPP library 
    2525   USE wrk_nemo         ! work arrays 
     26   USE lib_fortran      ! to use key_nosignedzero 
    2627 
    2728   IMPLICIT NONE 
    … …  
    7273      INTEGER  ::   ji , jk        ! dummy loop indices 
    7374      INTEGER  ::   zji, zjj       ! 2D corresponding indices to ji 
    74       INTEGER  ::   isnow          ! switch for presence (1) or absence (0) of snow 
    75       INTEGER  ::   isnowic        ! snow ice formation not 
    76       INTEGER  ::   i_ice_switch   ! ice thickness above a certain treshold or not 
    7775      INTEGER  ::   iter 
     76 
     77      REAL(wp) ::   isnow          ! switch for presence (1) or absence (0) of snow 
     78      REAL(wp) ::   isnowic        ! snow ice formation not 
     79      REAL(wp) ::   i_ice_switch   ! ice thickness above a certain treshold or not 
    7880 
    7981      REAL(wp) ::   zzfmass_i, zihgnew                     ! local scalar 
    … …  
    118120      REAL(wp), POINTER, DIMENSION(:,:) ::   zqt_i_lay   ! total ice heat content 
    119121 
     122      ! mass and salt flux (clem) 
     123      REAL(wp) :: zdvres 
     124      REAL(wp), POINTER, DIMENSION(:) ::   zviold, zvsold   ! old ice volume... 
     125 
    120126      ! Heat conservation  
    121127      INTEGER  ::   num_iter_max, numce_dh 
    … …  
    130136      CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
    131137 
     138      CALL wrk_alloc( jpij, zviold, zvsold ) ! clem 
     139       
    132140      zfsalt_melt(:)  = 0._wp 
    133141      ftotal_fin(:)   = 0._wp 
    134142      zfdt_init(:)    = 0._wp 
    135143      zfdt_final(:)   = 0._wp 
     144      dh_i_surf(:)    = 0._wp 
     145      dh_i_bott(:)    = 0._wp 
     146      dh_snowice(:)    = 0._wp 
    136147 
    137148      DO ji = kideb, kiut 
    138149         old_ht_i_b(ji) = ht_i_b(ji) 
    139150         old_ht_s_b(ji) = ht_s_b(ji) 
     151         zviold(ji) = a_i_b(ji) * ht_i_b(ji) ! clem 
     152         zvsold(ji) = a_i_b(ji) * ht_s_b(ji) ! clem 
    140153      END DO 
    141154      ! 
    … …  
    145158      ! 
    146159      DO ji = kideb, kiut 
    147          isnow         = INT( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ) ) 
     160         isnow         = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ) 
    148161         ztfs(ji)      = isnow * rtt + ( 1.0 - isnow ) * rtt 
    149162         z_f_surf(ji)  = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
    … …  
    162175      ! 
    163176      DO ji = kideb, kiut     ! Layer thickness 
    164          zh_i(ji) = ht_i_b(ji) / nlay_i 
    165          zh_s(ji) = ht_s_b(ji) / nlay_s 
     177         zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
     178         zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
    166179      END DO 
    167180      ! 
    … …  
    169182      DO jk = 1, nlay_s 
    170183         DO ji = kideb, kiut 
    171             zqt_s(ji) =  zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / nlay_s 
     184            zqt_s(ji) =  zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s ) 
    172185         END DO 
    173186      END DO 
    … …  
    176189      DO jk = 1, nlay_i 
    177190         DO ji = kideb, kiut 
    178             zzc = q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 
     191            zzc = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    179192            zqt_i(ji)        =  zqt_i(ji) + zzc 
    180193            zqt_i_lay(ji,jk) =              zzc 
    … …  
    243256         ht_s_b(ji)     =  MAX( zzero , zhsnew ) 
    244257         ! Volume and mass variations of snow 
    245          dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_mel(ji) ) 
     258         ! dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_mel(ji) ) 
     259         dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) )   ! IOVINO 
    246260         dvsbq_1d  (ji) =  MIN( zzero, dvsbq_1d(ji) ) 
    247          rdmsnif_1d(ji) =  rdmsnif_1d(ji) + rhosn * dvsbq_1d(ji) 
     261         !clem rdmsnif_1d(ji) =  rdmsnif_1d(ji) + rhosn * dvsbq_1d(ji) 
    248262      END DO ! ji 
    249263 
    … …  
    252266      !-------------------------- 
    253267      DO ji = kideb, kiut  
    254          dh_i_surf(ji) =  0._wp 
    255268         z_f_surf (ji) =  zqfont_su(ji) / rdt_ice ! heat conservation test 
    256269         zdq_i    (ji) =  0._wp 
    … …  
    270283            zdq_i    (ji)    = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) / rdt_ice 
    271284            ! 
    272             ! contribution to ice-ocean salt flux  
    273             zji = MOD( npb(ji) - 1 , jpi ) + 1 
    274             zjj =    ( npb(ji) - 1 ) / jpi + 1 
    275             zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji) ) * a_i_b(ji)    & 
    276                &                              * MIN( zdeltah(ji,jk) , 0.e0 ) * rhoic / rdt_ice  
     285            ! IOVINO 
     286            !zfsalt_melt(ji) = zfsalt_melt(ji) - sm_i_b(ji) * a_i_b(ji)    & 
     287            !   &                              * MIN( zdeltah(ji,jk) , 0.e0 ) * rhoic / rdt_ice 
     288            fseqv_1d(ji) = fseqv_1d(ji) - sm_i_b(ji) * a_i_b(ji)    & 
     289               &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 
    277290         END DO 
    278291      END DO 
    … …  
    331344         DO ji = kideb,kiut 
    332345            q_s_b    (ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 
    333             zqt_dummy(ji)    =  zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / nlay_s            ! heat conservation 
     346            zqt_dummy(ji)    =  zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s )            ! heat conservation 
    334347         END DO 
    335348      END DO 
    … …  
    372385               ! Basal growth rate = - F*dt / q 
    373386               dh_i_bott(ji)       =  - rdt_ice*( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
     387               fseqv_1d(ji) = fseqv_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic / rdt_ice 
    374388            ENDIF 
    375389         END DO 
    … …  
    437451               dsm_i_se_1d(ji) = ( s_i_new(ji) * dh_i_bott(ji) + sm_i_b(ji) * ht_i_b(ji) )    & 
    438452                  &            / MAX( ht_i_b(ji) + dh_i_bott(ji) ,epsi13 ) - sm_i_b(ji) 
     453               fseqv_1d(ji) = fseqv_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic / rdt_ice 
    439454            ENDIF ! heat budget 
    440455         END DO 
    … …  
    473488                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk) 
    474489                  zdq_i(ji)       = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) / rdt_ice 
    475                   ! contribution to salt flux 
    476                   zji             = MOD( npb(ji) - 1, jpi ) + 1 
    477                   zjj             = ( npb(ji) - 1 ) / jpi + 1 
    478                   zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji)   ) * a_i_b(ji)   & 
    479                      &                              * MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice  
    480490               ENDIF 
     491               ! IOVINO contribution to salt flux 
     492               !zfsalt_melt(ji) = zfsalt_melt(ji) - sm_i_b(ji) * a_i_b(ji)   & 
     493               !     &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 
     494               fseqv_1d(ji) = fseqv_1d(ji) - sm_i_b(ji) * a_i_b(ji)    & 
     495                    &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 
    481496            ENDIF 
    482497         END DO ! ji 
    … …  
    529544         ELSE                  ;   zdhbf =              dh_i_bott(ji)  
    530545         ENDIF 
     546         zdvres        = zdhbf - dh_i_bott(ji) 
     547         dh_i_bott(ji) = zdhbf 
     548         fseqv_1d(ji)  = fseqv_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic / rdt_ice 
    531549         !                     ! excessive energy is sent to lateral ablation 
    532          fsup     (ji) =  rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi13 )   & 
    533             &                          * ( zdhbf - dh_i_bott(ji) ) / rdt_ice 
    534          dh_i_bott(ji)  = zdhbf 
     550         fsup     (ji) =  rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi13 ) * zdvres / rdt_ice 
    535551         !                     !since ice volume is only used for outputs, we keep it global for all categories 
    536552         dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji) 
    537553         !                     !new ice thickness 
    538554         zhgnew   (ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 
    539          !                     ! diagnostic ( bottom ice growth ) 
    540          zji = MOD( npb(ji) - 1, jpi ) + 1 
    541          zjj = ( npb(ji) - 1 ) / jpi + 1 
    542          diag_bot_gr(zji,zjj) = diag_bot_gr(zji,zjj) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice 
    543          diag_sur_me(zji,zjj) = diag_sur_me(zji,zjj) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) / rdt_ice 
    544          diag_bot_me(zji,zjj) = diag_bot_me(zji,zjj) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice 
    545555      END DO 
    546556 
    … …  
    554564         ! Adapt the remaining energy if too much ice melts 
    555565         !-------------------------------------------------- 
     566         zdvres     = MAX( 0._wp, - zhgnew(ji) ) 
    556567         zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice 
    557          ! 0 if no more ice 
     568         dh_i_bott (ji) = dh_i_bott(ji) + zdvres ! clem@bug 
    558569         zhgnew    (ji) =         zihgnew   * zhgnew(ji)      ! ice thickness is put to 0 
    559570         ! remaining heat 
    … …  
    581592         ! 
    582593         !                                              ! mass variation cumulated over category 
    583          rdmsnif_1d(ji) = rdmsnif_1d(ji) + zzfmass_s                     ! snow  
    584          rdmicif_1d(ji) = rdmicif_1d(ji) + zzfmass_i                     ! ice  
     594         !clem rdmsnif_1d(ji) = rdmsnif_1d(ji) + zzfmass_s                     ! snow  
     595         !clem rdmicif_1d(ji) = rdmicif_1d(ji) + zzfmass_i                     ! ice  
    585596 
    586597         ! Remaining heat to the ocean  
    587598         !--------------------------------- 
    588599         focea(ji)  = - zfdt_final(ji) / rdt_ice         ! focea is in W.m-2 * dt 
    589  
     600         ! salt flux 
     601         fseqv_1d(ji)  = fseqv_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic / rdt_ice 
     602         !                     ! diagnostic ( bottom ice growth ) 
     603         zji = MOD( npb(ji) - 1, jpi ) + 1 
     604         zjj = ( npb(ji) - 1 ) / jpi + 1 
     605         diag_bot_gr(zji,zjj) = diag_bot_gr(zji,zjj) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice 
     606         diag_sur_me(zji,zjj) = diag_sur_me(zji,zjj) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) / rdt_ice 
     607         diag_bot_me(zji,zjj) = diag_bot_me(zji,zjj) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice 
    590608      END DO 
    591609 
    … …  
    602620         zjj = ( npb(ji) - 1 ) / jpi + 1 
    603621         ! new lines 
    604          IF( num_sal == 4 ) THEN 
    605             fseqv_1d(ji) = fseqv_1d(ji) +        zihgnew  * zfsalt_melt(ji)                                & 
    606                &                        + (1.0 - zihgnew) * zfmass_i(ji) * ( sss_m(zji,zjj) - bulk_sal   ) / rdt_ice 
    607          ELSE 
    608             fseqv_1d(ji) = fseqv_1d(ji) +        zihgnew  * zfsalt_melt(ji)                                & 
    609                &                        + (1.0 - zihgnew) * zfmass_i(ji) * ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice 
    610          ENDIF 
     622         !IF( num_sal == 4 ) THEN 
     623         !   ! IOVINO 
     624         !   fseqv_1d(ji) = fseqv_1d(ji) +        zihgnew  * zfsalt_melt(ji)                                & 
     625         !      &                        - (1.0 - zihgnew) * zfmass_i(ji) * bulk_sal / rdt_ice 
     626         !ELSE 
     627         !   ! IOVINO 
     628         !   fseqv_1d(ji) = fseqv_1d(ji) +        zihgnew  * zfsalt_melt(ji)                                & 
     629         !      &                        - (1.0 - zihgnew) * zfmass_i(ji) * sm_i_b(ji) / rdt_ice  
     630         !ENDIF 
    611631         ! Heat flux 
    612632         ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 
    … …  
    619639         qldif_1d(ji)  = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji)    * a_i_b(ji) * rdt_ice   & 
    620640            &                                    + ( 1.0 - zihic   ) * fscbq_1d(ji)             * rdt_ice 
     641         !IF ( (zji.eq.jiindx).AND.(zjj.eq.jjindx) ) THEN 
     642         !   !clemclem 
     643         !   WRITE(numout,*) 'lim_thd_dh : qldif = ', qldif_1d(ji) 
     644         !   !clemclem 
     645         !ENDIF 
    621646      END DO  ! ji 
    622647 
    … …  
    656681         dmgwi_1d  (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 
    657682 
    658          rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic  
    659          rdmsnif_1d(ji) = rdmsnif_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn 
     683         !clem rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic  
     684         !clem rdmsnif_1d(ji) = rdmsnif_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn  
    660685 
    661686         !        Equivalent salt flux (1) Snow-ice formation component 
    … …  
    667692         ELSE                      ;   zsm_snowice = ( rhoic - rhosn ) / rhoic * sss_m(zji,zjj)  
    668693         ENDIF 
    669          IF( num_sal == 4 ) THEN 
    670             fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal    ) * a_i_b(ji)   & 
    671                &                        * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    672          ELSE 
    673             fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - zsm_snowice ) * a_i_b(ji)   & 
    674                &                        * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice 
    675          ENDIF 
     694         !IF( num_sal == 4 ) THEN   
     695         !   ! IOVINO 
     696         !   fseqv_1d(ji) = fseqv_1d(ji) - bulk_sal * a_i_b(ji) * dh_snowice(ji) * rhoic / rdt_ice 
     697         !ELSE 
     698         !   ! IOVINO 
     699         !   fseqv_1d(ji) = fseqv_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic / rdt_ice 
     700         !ENDIF 
    676701         ! entrapment during snow ice formation 
    677          i_ice_switch = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - ht_i_b(ji) + 1.0e-6 ) ) 
    678          isnowic      = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - dh_snowice(ji)      ) ) * i_ice_switch 
    679          IF(  num_sal == 2  .OR.  num_sal == 4  )   & 
    680             dsm_i_si_1d(ji) = ( zsm_snowice*dh_snowice(ji) & 
    681             &               + sm_i_b(ji) * ht_i_b(ji) / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13)   & 
    682             &               - sm_i_b(ji) ) * isnowic      
     702         i_ice_switch = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - ht_i_b(ji) + epsi13 ) ) 
     703         isnowic      = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - dh_snowice(ji) ) ) * i_ice_switch 
     704 
     705         !clem IF(  num_sal == 2  .OR.  num_sal == 4  )   & 
     706         !clem   dsm_i_si_1d(ji) = ( zsm_snowice*dh_snowice(ji) & 
     707         !clem   &               + sm_i_b(ji) * ht_i_b(ji) / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13)   & 
     708         !clem   &               - sm_i_b(ji) ) * isnowic 
     709         IF (  num_sal == 2  .OR.  num_sal == 4  )   & 
     710            & dsm_i_si_1d(ji) = ( ( zsm_snowice * dh_snowice(ji) + sm_i_b(ji) * ht_i_b(ji) ) & 
     711            &                    / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13 ) - sm_i_b(ji) ) * isnowic      
    683712 
    684713         !  Actualize new snow and ice thickness. 
    … …  
    693722         zjj =    ( npb(ji) - 1 ) / jpi + 1 
    694723         diag_sni_gr(zji,zjj)  = diag_sni_gr(zji,zjj) + dh_snowice(ji)*a_i_b(ji) / rdt_ice 
    695          ! 
     724 
     725         ! salt flux 
     726         fseqv_1d(ji) = fseqv_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic / rdt_ice 
     727         !-------------------------------- 
     728         ! Update mass fluxes (clem) 
     729         !-------------------------------- 
     730         rdmicif_1d(ji) = rdmicif_1d(ji) + ( a_i_b(ji) * ht_i_b(ji) - zviold(ji) ) * rhoic  
     731         rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( a_i_b(ji) * ht_s_b(ji) - zvsold(ji) ) * rhosn  
     732 
    696733      END DO !ji 
    697734      ! 
    … …  
    700737      CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 
    701738      CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
     739      ! 
     740      CALL wrk_dealloc( jpij, zviold, zvsold ) ! clem 
    702741      ! 
    703742   END SUBROUTINE lim_thd_dh 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r3351 r3938  
    1010   !!                 ! 04-2007 (M. Vancoppenolle) Energy conservation 
    1111   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     12   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux 
    1213   !!---------------------------------------------------------------------- 
    1314#if defined key_lim3 
    … …  
    2324   USE lib_mpp          ! MPP library 
    2425   USE wrk_nemo         ! work arrays 
     26   USE lib_fortran      ! to use key_nosignedzero 
    2527 
    2628   IMPLICIT NONE 
    … …  
    102104      INTEGER ::   nconv       ! number of iterations in iterative procedure 
    103105      INTEGER ::   minnumeqmin, maxnumeqmax 
    104       INTEGER, DIMENSION(kiut) ::   numeqmin   ! reference number of top equation 
    105       INTEGER, DIMENSION(kiut) ::   numeqmax   ! reference number of bottom equation 
    106       INTEGER, DIMENSION(kiut) ::   isnow      ! switch for presence (1) or absence (0) of snow 
     106 
     107      INTEGER , DIMENSION(kiut) ::   numeqmin   ! reference number of top equation 
     108      INTEGER , DIMENSION(kiut) ::   numeqmax   ! reference number of bottom equation 
     109      INTEGER , DIMENSION(kiut) ::   isnow      ! switch for presence (1) or absence (0) of snow 
     110 
     111      !! * New local variables        
     112      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztcond_i   !Ice thermal conductivity 
     113      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradtr_i   !Radiation transmitted through the ice 
     114      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradab_i   !Radiation absorbed in the ice 
     115      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zkappa_i   !Kappa factor in the ice 
     116 
     117      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradtr_s   !Radiation transmited through the snow 
     118      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradab_s   !Radiation absorbed in the snow 
     119      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zkappa_s   !Kappa factor in the snow 
     120 
     121      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztiold      !Old temperature in the ice 
     122      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zeta_i      !Eta factor in the ice  
     123      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztitemp     !Temporary temperature in the ice to check the convergence 
     124      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zspeche_i   !Ice specific heat 
     125      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   z_i         !Vertical cotes of the layers in the ice 
     126 
     127      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zeta_s      !Eta factor in the snow 
     128      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztstemp     !Temporary temperature in the snow to check the convergence 
     129      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztsold      !Temporary temperature in the snow 
     130      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   z_s         !Vertical cotes of the layers in the snow 
     131 
     132      REAL(wp), DIMENSION(kiut,jkmax+2)   ::   zindterm    ! Independent term 
     133      REAL(wp), DIMENSION(kiut,jkmax+2)   ::   zindtbis    ! temporary independent term 
     134      REAL(wp), DIMENSION(kiut,jkmax+2)   ::   zdiagbis 
     135      REAL(wp), DIMENSION(kiut,jkmax+2,3) ::   ztrid       ! tridiagonal system terms 
     136 
     137      REAL(wp), DIMENSION(kiut) ::   ztfs        ! ice melting point 
     138      REAL(wp), DIMENSION(kiut) ::   ztsuold     ! old surface temperature (before the iterative procedure ) 
     139      REAL(wp), DIMENSION(kiut) ::   ztsuoldit   ! surface temperature at previous iteration 
     140      REAL(wp), DIMENSION(kiut) ::   zh_i        ! ice layer thickness 
     141      REAL(wp), DIMENSION(kiut) ::   zh_s        ! snow layer thickness 
     142      REAL(wp), DIMENSION(kiut) ::   zfsw        ! solar radiation absorbed at the surface 
     143      REAL(wp), DIMENSION(kiut) ::   zf          ! surface flux function 
     144      REAL(wp), DIMENSION(kiut) ::   dzf         ! derivative of the surface flux function 
     145 
    107146      REAL(wp) ::   zeps      =  1.e-10_wp    ! 
    108147      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
    … …  
    113152      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
    114153      REAL(wp) ::   zht_smin  =  1.e-4_wp     ! minimum snow depth 
     154 
    115155      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    116156      REAL(wp) ::   zerritmax   ! current maximal error on temperature  
    117       REAL(wp), DIMENSION(kiut) ::   ztfs        ! ice melting point 
    118       REAL(wp), DIMENSION(kiut) ::   ztsuold     ! old surface temperature (before the iterative procedure ) 
    119       REAL(wp), DIMENSION(kiut) ::   ztsuoldit   ! surface temperature at previous iteration 
    120       REAL(wp), DIMENSION(kiut) ::   zh_i        ! ice layer thickness 
    121       REAL(wp), DIMENSION(kiut) ::   zh_s        ! snow layer thickness 
    122       REAL(wp), DIMENSION(kiut) ::   zfsw        ! solar radiation absorbed at the surface 
    123       REAL(wp), DIMENSION(kiut) ::   zf          ! surface flux function 
    124       REAL(wp), DIMENSION(kiut) ::   dzf         ! derivative of the surface flux function 
    125       REAL(wp), DIMENSION(kiut) ::   zerrit      ! current error on temperature 
    126       REAL(wp), DIMENSION(kiut) ::   zdifcase    ! case of the equation resolution (1->4) 
    127       REAL(wp), DIMENSION(kiut) ::   zftrice     ! solar radiation transmitted through the ice 
     157      REAL(wp), DIMENSION(kiut) ::   zerrit       ! current error on temperature  
     158      REAL(wp), DIMENSION(kiut) ::   zdifcase     ! case of the equation resolution (1->4) 
     159      REAL(wp), DIMENSION(kiut) ::   zftrice      ! solar radiation transmitted through the ice 
    128160      REAL(wp), DIMENSION(kiut) ::   zihic, zhsu 
    129       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztcond_i    ! Ice thermal conductivity 
    130       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradtr_i    ! Radiation transmitted through the ice 
    131       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradab_i    ! Radiation absorbed in the ice 
    132       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zkappa_i    ! Kappa factor in the ice 
    133       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztiold      ! Old temperature in the ice 
    134       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zeta_i      ! Eta factor in the ice 
    135       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
    136       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zspeche_i   ! Ice specific heat 
    137       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   z_i         ! Vertical cotes of the layers in the ice 
    138       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradtr_s    ! Radiation transmited through the snow 
    139       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradab_s    ! Radiation absorbed in the snow 
    140       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zkappa_s    ! Kappa factor in the snow 
    141       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zeta_s       ! Eta factor in the snow 
    142       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztstemp      ! Temporary temperature in the snow to check the convergence 
    143       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztsold       ! Temporary temperature in the snow 
    144       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   z_s          ! Vertical cotes of the layers in the snow 
    145       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindterm   ! Independent term 
    146       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindtbis   ! temporary independent term 
    147       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zdiagbis 
    148       REAL(wp), DIMENSION(kiut,jkmax+2,3) ::   ztrid   ! tridiagonal system terms 
    149161      !!------------------------------------------------------------------ 
    150        
    151       !  
     162      ! 
    152163      !------------------------------------------------------------------------------! 
    153164      ! 1) Initialization                                                            ! 
    … …  
    156167      DO ji = kideb , kiut 
    157168         ! is there snow or not 
    158          isnow(ji)= INT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
     169         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
    159170         ! surface temperature of fusion 
    160171!!gm ???  ztfs(ji) = rtt !!!???? 
    161          ztfs(ji) = isnow(ji) * rtt + (1.0-isnow(ji)) * rtt 
     172         ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 
    162173         ! layer thickness 
    163          zh_i(ji) = ht_i_b(ji) / nlay_i 
    164          zh_s(ji) = ht_s_b(ji) / nlay_s 
     174         zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
     175         zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
    165176      END DO 
    166177 
    … …  
    174185      DO layer = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
    175186         DO ji = kideb , kiut 
    176             z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / nlay_s 
     187            z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / REAL( nlay_s ) 
    177188         END DO 
    178189      END DO 
    … …  
    180191      DO layer = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
    181192         DO ji = kideb , kiut 
    182             z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / nlay_i 
     193            z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / REAL( nlay_i ) 
    183194         END DO 
    184195      END DO 
    … …  
    201212      DO ji = kideb , kiut 
    202213         ! switches 
    203          isnow(ji) = INT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  )  
     214         isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  )  
    204215         ! hs > 0, isnow = 1 
    205216         zhsu (ji) = hnzst  ! threshold for the computation of i0 
    206217         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) )      
    207218 
    208          i0(ji)    = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
     219         i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
    209220         !fr1_i0_1d = i0 for a thin ice surface 
    210221         !fr1_i0_2d = i0 for a thick ice surface 
    … …  
    243254 
    244255      DO ji = kideb, kiut           ! ice initialization 
    245          zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp - isnow(ji) ) 
     256         zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1 - isnow(ji) ) 
    246257      END DO 
    247258 
    … …  
    256267 
    257268      DO ji = kideb, kiut           ! Radiation transmitted below the ice 
    258          fstbif_1d(ji) = fstbif_1d(ji) + zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) 
     269         fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
    259270      END DO 
    260271 
    … …  
    264275         ii                = MOD( npb(ji) - 1, jpi ) + 1 
    265276         ij                = ( npb(ji) - 1 ) / jpi + 1 
    266          fstroc(ii,ij,jl) = zradtr_i(ji,nlay_i) 
     277         fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 
    267278      END DO 
    268279      ! +++++ 
    … …  
    273284         END DO 
    274285      END DO 
    275  
    276286 
    277287      ! 
    … …  
    377387            zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(zeps, & 
    378388               (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji))) 
    379             zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*isnow(ji) & 
    380                + zkappa_i(ji,0)*(1.0-isnow(ji)) 
     389            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) & 
     390               + zkappa_i(ji,0)*REAL( 1 - isnow(ji) ) 
    381391         END DO 
    382392         ! 
    … …  
    659669               t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
    660670               *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) & 
    661                *        MAX(0.0,SIGN(1.0,ht_s_b(ji)-zeps))  
     671               *        MAX(0.0,SIGN(1.0,ht_s_b(ji)))  
    662672 
    663673            ! surface temperature 
    664             isnow(ji)     = INT(1.0-max(0.0,sign(1.0,-ht_s_b(ji)))) 
     674            isnow(ji)     = NINT(1.0-max(0.0,SIGN(1.0,-ht_s_b(ji)))) 
    665675            ztsuoldit(ji) = t_su_b(ji) 
    666676            IF (t_su_b(ji) .LT. ztfs(ji)) & 
    667                t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( isnow(ji)*t_s_b(ji,1)   & 
    668                &          + (1.0-isnow(ji))*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
     677               t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_b(ji,1)   & 
     678               &          + REAL( 1 - isnow(ji) )*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
    669679         END DO 
    670680         ! 
    … …  
    718728      DO ji = kideb, kiut 
    719729         !                                ! update of latent heat fluxes 
    720          qla_ice_1d (ji) = qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) 
     730         ! qla_ice_1d (ji) =          qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji)! - ztsuold(ji) )     ! TECLIM change 
     731         qla_ice_1d (ji) = MAX( 0.e0, qla_ice_1d (ji) + dqla_ice_1d(ji) * (t_su_b(ji) - ztsuold(ji) ) ) 
    721732         !                                ! surface ice conduction flux 
    722          isnow(ji)       = INT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  ) 
    723          fc_su(ji)       =  -           isnow(ji)  * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   & 
    724             &               - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(ji)) 
     733         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  ) 
     734         fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   & 
     735            &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(ji)) 
    725736         !                                ! bottom ice conduction flux 
    726737         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    … …  
    733744         DO ji = kideb, kiut 
    734745            ! Upper snow value 
    735             fc_s(ji,0) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )  
     746            fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )  
    736747            ! Bott. snow value 
    737             fc_s(ji,1) = - isnow(ji)* zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )  
     748            fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )  
    738749         END DO 
    739750         DO ji = kideb, kiut         ! Upper ice layer 
    740             fc_i(ji,0) = - isnow(ji) * &  ! interface flux if there is snow 
     751            fc_i(ji,0) = - REAL( isnow(ji) ) * &  ! interface flux if there is snow 
    741752               ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 
    742                - ( 1.0 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
     753               - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
    743754               zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 
    744755         END DO 
    … …  
    755766      ENDIF 
    756767      ! 
     768 
    757769   END SUBROUTINE lim_thd_dif 
    758770 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

    r3294 r3938  
    2929   USE lib_mpp          ! MPP library 
    3030   USE wrk_nemo         ! work arrays 
     31   USE lib_fortran      ! to use key_nosignedzero 
    3132 
    3233   IMPLICIT NONE 
    … …  
    144145 
    145146      DO ji = kideb, kiut 
    146          zh_i(ji) = old_ht_i_b(ji) / nlay_i  
    147          zh_s(ji) = old_ht_s_b(ji) / nlay_s 
     147         zh_i(ji) = old_ht_i_b(ji) / REAL( nlay_i )  
     148         zh_s(ji) = old_ht_s_b(ji) / REAL( nlay_s ) 
    148149      END DO 
    149150 
    … …  
    165166      DO jk = 1, nlays0 
    166167         DO ji = kideb, kiut 
    167             snind(ji)  = jk        *      INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-epsi20))) & 
    168                + snind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-epsi20)))) 
     168            snind(ji)  = jk        *      NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)))) & 
     169               + snind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji))))) 
    169170            zdeltah(ji)= zdeltah(ji) + zh_s(ji) 
    170171         END DO ! ji 
    … …  
    174175      !              0 if not 
    175176      DO ji = kideb, kiut 
    176          snswi(ji)     = MAX(0,INT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 
     177         snswi(ji)     = MAX(0,NINT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 
    177178      END DO ! ji 
    178179 
    … …  
    189190      DO jk = 1, nlayi0 
    190191         DO ji = kideb, kiut 
    191             icsuind(ji) = jk          *      INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-epsi20))) & 
    192                + icsuind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-epsi20)))) 
     192            icsuind(ji) = jk          *      NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)))) & 
     193               + icsuind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji))))) 
    193194            zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    194195         END DO ! ji 
    … …  
    199200      !     0 if not 
    200201      DO ji = kideb, kiut 
    201          icsuswi(ji)  = MAX(0,INT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 
     202         icsuswi(ji)  = MAX(0,NINT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 
    202203      ENDDO 
    203204 
    … …  
    215216      DO jk = nlayi0, 1, -1 
    216217         DO ji = kideb, kiut 
    217             icboind(ji) = (nlayi0+1-jk) *      INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-epsi20))) & 
    218                &          + icboind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-epsi20))))  
     218            icboind(ji) = (nlayi0+1-jk) *      NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))) & 
     219               &          + icboind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))))  
    219220            zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    220221         END DO 
    … …  
    231232      !     0 if ablation is on the way 
    232233      DO ji = kideb, kiut  
    233          icboswi(ji) = MAX(0,INT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 
     234         icboswi(ji) = MAX(0,NINT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 
    234235      END DO 
    235236 
    … …  
    247248         DO ji = kideb, kiut 
    248249            snicind(ji) = (nlays0+1-jk) & 
    249                *      INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-epsi20))) + snicind(ji)   & 
    250                * (1 - INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-epsi20)))) 
     250               *      NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)))) + snicind(ji)   & 
     251               * (1 - NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji))))) 
    251252            zdeltah(ji) = zdeltah(ji) + zh_s(ji) 
    252253         END DO 
    … …  
    257258      !     0 if not 
    258259      DO ji = kideb, kiut 
    259          snicswi(ji)   = MAX(0,INT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 
     260         snicswi(ji)   = MAX(0,NINT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 
    260261      ENDDO 
    261262 
    … …  
    278279 
    279280      DO ji = kideb, kiut 
    280          nbot0(ji) =  nlays0  + 1 - snind(ji) + ( 1. - snicind(ji) ) * snicswi(ji) 
     281         nbot0(ji) =  nlays0  + 1 - snind(ji) + ( 1 - snicind(ji) ) * snicswi(ji) 
    281282         ! cotes of the top of the layers 
    282283         zm0(ji,0) =  0._wp 
    … …  
    290291            limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 
    291292            limsum = MIN( limsum , nlay_s ) 
    292             zm0(ji,jk) =  dh_s_tot(ji) + zh_s(ji) * limsum 
    293          END DO 
    294       END DO 
    295  
    296       DO ji = kideb, kiut 
    297          zm0(ji,nbot0(ji)) =  dh_s_tot(ji) - snicswi(ji) * dh_snowice(ji) + zh_s(ji) * nlays0 
    298          zm0(ji,1)         =  dh_s_tot(ji) * (1 -snswi(ji) ) + snswi(ji) * zm0(ji,1) 
     293            zm0(ji,jk) =  dh_s_tot(ji) + zh_s(ji) * REAL( limsum ) 
     294         END DO 
     295      END DO 
     296 
     297      DO ji = kideb, kiut 
     298         zm0(ji,nbot0(ji)) =  dh_s_tot(ji) - REAL( snicswi(ji) ) * dh_snowice(ji) + zh_s(ji) * REAL( nlays0 ) 
     299         zm0(ji,1)         =  dh_s_tot(ji) * REAL( 1 - snswi(ji) ) + REAL( snswi(ji) ) * zm0(ji,1) 
    299300      END DO 
    300301 
    … …  
    308309 
    309310      DO ji = kideb, kiut         ! layer heat content 
    310          qm0    (ji,1) =  rhosn * (  cpic * ( rtt - ( 1. - snswi(ji) ) * tatm_ice_1d(ji)        & 
    311             &                                            - snswi(ji)  * t_s_b      (ji,1)  )   & 
     311         qm0    (ji,1) =  rhosn * (  cpic * ( rtt - REAL( 1 - snswi(ji) ) * tatm_ice_1d(ji)        & 
     312            &                                         - REAL( snswi(ji) ) * t_s_b      (ji,1)  )   & 
    312313            &                      + lfus  ) * zthick0(ji,1) 
    313314         zqts_in(ji)   =  zqts_in(ji) + qm0(ji,1)  
    … …  
    319320            limsum      = MIN( limsum , nlay_s ) 
    320321            qm0(ji,jk)  = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) * zthick0(ji,jk) 
    321             zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, epsi20 - ht_s_b(ji) ) ) 
    322             zqts_in(ji) = zqts_in(ji) + ( 1. - snswi(ji) ) * qm0(ji,jk) * zswitch 
     322            zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, - ht_s_b(ji) ) ) 
     323            zqts_in(ji) = zqts_in(ji) + REAL( 1 - snswi(ji) ) * qm0(ji,jk) * zswitch 
    323324         END DO ! jk 
    324325      END DO ! ji 
    … …  
    359360      !------------------- 
    360361      DO ji = kideb, kiut 
    361          zh_s(ji)  = ht_s_b(ji) / nlay_s 
     362         zh_s(ji)  = ht_s_b(ji) / REAL( nlay_s ) 
    362363         z_s(ji,0) =  0._wp 
    363364      ENDDO 
    … …  
    365366      DO jk = 1, nlay_s 
    366367         DO ji = kideb, kiut 
    367             z_s(ji,jk) =  zh_s(ji) * jk 
     368            z_s(ji,jk) =  zh_s(ji) * REAL( jk ) 
    368369         END DO 
    369370      END DO 
    … …  
    393394                  &                 - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10))  
    394395               q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0)   & 
    395                   &                                * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+epsi20)) 
     396                  &                                * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 
    396397            END DO 
    397398         END DO 
    … …  
    440441      DO jk = 1, nlay_s 
    441442         DO ji = kideb, kiut 
    442             zswitch = MAX ( 0.0 , SIGN ( 1.0, epsi20 - ht_s_b(ji) ) ) 
     443            zswitch = MAX ( 0.0 , SIGN ( 1.0, - ht_s_b(ji) ) ) 
    443444            t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 
    444445         END DO 
    … …  
    479480            limsum    =  ( (icsuswi(ji)*(icsuind(ji)+jk-1) + &  
    480481               (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 
    481             zm0(ji,jk)=  icsuswi(ji)*dh_i_surf(ji) + snicswi(ji)*dh_snowice(ji) & 
    482                +  limsum * zh_i(ji) 
    483          END DO 
    484       END DO 
    485  
    486       DO ji = kideb, kiut 
    487          zm0(ji,nbot0(ji)) =  icsuswi(ji)*dh_i_surf(ji) + snicswi(ji)*dh_snowice(ji) + dh_i_bott(ji) & 
    488             +  zh_i(ji) * nlayi0 
    489          zm0(ji,1)         =  snicswi(ji)*dh_snowice(ji) + (1-snicswi(ji))*zm0(ji,1) 
     482            zm0(ji,jk)=  REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) & 
     483               +  REAL(limsum) * zh_i(ji) 
     484         END DO 
     485      END DO 
     486 
     487      DO ji = kideb, kiut 
     488         zm0(ji,nbot0(ji)) =  REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) + dh_i_bott(ji) & 
     489            +  zh_i(ji) * REAL(nlayi0) 
     490         zm0(ji,1)         =  REAL(snicswi(ji))*dh_snowice(ji) + REAL(1-snicswi(ji))*zm0(ji,1) 
    490491      END DO 
    491492 
    … …  
    520521      !---------------------------- 
    521522      DO ji = kideb, kiut         
    522          ztmelts    = ( 1.0 - icboswi(ji) ) * (-tmut * s_i_b  (ji,nlayi0) )   &   ! case of melting ice 
    523             &       +         icboswi(ji)  * (-tmut * s_i_new(ji)        )   &   ! case of forming ice 
     523         ztmelts    = REAL( 1 - icboswi(ji) ) * (-tmut * s_i_b  (ji,nlayi0) )   &   ! case of melting ice 
     524            &       +     REAL( icboswi(ji) ) * (-tmut * s_i_new(ji)        )   &   ! case of forming ice 
    524525            &       + rtt                                                         ! in Kelvin 
    525526 
    … …  
    527528         ztform = t_i_b(ji,nlay_i) 
    528529         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) ztform = t_bo_b(ji) 
    529          qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji))             &   ! case of melting ice 
    530             &              + icboswi(ji) * rhoic * ( cpic*(ztmelts-ztform)       &   ! case of forming ice 
     530         qm0(ji,nbot0(ji)) = REAL( 1 - icboswi(ji) )*qm0(ji,nbot0(ji))             &   ! case of melting ice 
     531            &              + REAL( icboswi(ji) ) * rhoic * ( cpic*(ztmelts-ztform)       &   ! case of forming ice 
    531532            + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) )      &  
    532533            - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji)  ) 
    … …  
    539540         ! energy of the flooding seawater 
    540541         zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * & 
    541             (rhoic - rhosn) / rhoic * snicswi(ji) ! generally positive 
     542            (rhoic - rhosn) / rhoic * REAL(snicswi(ji)) ! generally positive 
    542543         ! Heat conservation diagnostic 
    543544         qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic  
    … …  
    548549         ! = enthalpy of snow + enthalpy of frozen water 
    549550         zqsnic         =  zqsnow(ji) + zqsnic 
    550          qm0(ji,1)      =  snicswi(ji) * zqsnic + ( 1 - snicswi(ji) ) * qm0(ji,1) 
     551         qm0(ji,1)      =  REAL(snicswi(ji)) * zqsnic + REAL( 1 - snicswi(ji) ) * qm0(ji,1) 
     552 
     553         zji = MOD( npb(ji) - 1, jpi ) + 1 
     554         zjj = ( npb(ji) - 1 ) / jpi + 1 
     555         IF ( (zji.eq.jiindx).AND.(zjj.eq.jjindx) ) THEN 
     556            !clemclem 
     557            WRITE(numout,*) 'lim_thd_ent : qldif = ', qldif_1d(ji) 
     558            !clemclem 
     559         ENDIF 
    551560 
    552561      END DO ! ji 
    … …  
    555564         DO ji = kideb, kiut 
    556565            ! Heat conservation 
    557             zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi06+epsi20) ) & 
    558                &                                   * MAX( 0.0 , SIGN( 1. , nbot0(ji) - jk + epsi20 ) ) 
     566            zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi06) ) & 
     567               &                                   * MAX( 0.0 , SIGN( 1. , REAL(nbot0(ji) - jk) ) ) 
    559568         END DO 
    560569      END DO 
    … …  
    574583      !------------------ 
    575584      DO ji = kideb, kiut 
    576          zh_i(ji) = ht_i_b(ji) / nlay_i 
     585         zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
    577586      ENDDO 
    578587 
    … …  
    605614               q_i_b(ji,layer1) = q_i_b(ji,layer1) &  
    606615                  + zrl01(layer1,layer0)*qm0(ji,layer0) & 
    607                   * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi06+epsi20)) & 
    608                   * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+epsi20)) 
     616                  * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi06)) & 
     617                  * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 
    609618            END DO 
    610619         END DO 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r3294 r3938  
    2929   USE lib_mpp          ! MPP library 
    3030   USE wrk_nemo         ! work arrays 
     31   USE lib_fortran      ! to use key_nosignedzero 
    3132 
    3233   IMPLICIT NONE 
    … …  
    159160                  !Energy of melting q(S,T) [J.m-3] 
    160161                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / & 
    161                      MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * & 
    162                      nlay_i 
     162                     MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * REAL( nlay_i ) 
    163163                  zindb      = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) !0 if no ice and 1 if yes 
    164164                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl)*unit_fac*zindb 
    … …  
    185185 
    186186      ! Default new ice thickness  
    187       DO jj = 1, jpj 
    188          DO ji = 1, jpi 
    189             hicol(ji,jj) = hiccrit(1) 
    190          END DO 
    191       END DO 
     187      hicol(:,:) = hiccrit(1) 
    192188 
    193189      IF (fraz_swi.eq.1.0) THEN 
    … …  
    335331         CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel ,              & 
    336332            jpi, jpj, npac(1:nbpac) ) 
     333         CALL tab_2d_1d( nbpac, rdmicif_1d  (1:nbpac)   , rdmicif, jpi, jpj, npac(1:nbpac) ) !martin 
    337334 
    338335         !------------------------------------------------------------------------------! 
    … …  
    410407            zdh_frazb(ji) = zfrazb*zv_newice(ji) 
    411408            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
     409            ! 
     410!clem@mv            rdmicif_1d(ji) = rdmicif_1d(ji) + zv_newice(ji) * rhoic  !martin 
    412411         END DO 
    413412 
    … …  
    415414         ! Salt flux due to new ice growth 
    416415         !--------------------------------- 
    417          IF ( ( num_sal .EQ. 4 ) ) THEN  
    418             DO ji = 1, nbpac 
    419                zji            = MOD( npac(ji) - 1, jpi ) + 1 
    420                zjj            = ( npac(ji) - 1 ) / jpi + 1 
    421                fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    422                   ( sss_m(zji,zjj) - bulk_sal      ) * rhoic *       & 
    423                   zv_newice(ji) / rdt_ice 
    424             END DO 
    425          ELSE 
    426             DO ji = 1, nbpac 
    427                zji            = MOD( npac(ji) - 1, jpi ) + 1 
    428                zjj            = ( npac(ji) - 1 ) / jpi + 1 
    429                fseqv_1d(ji)   = fseqv_1d(ji) +                                     & 
    430                   ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic *       & 
    431                   zv_newice(ji) / rdt_ice 
    432             END DO ! ji 
    433          ENDIF 
     416!clem@mv         IF ( ( num_sal .EQ. 4 ) ) THEN  
     417!clem@mv            DO ji = 1, nbpac 
     418!clem@mv               ! IOVINO 
     419!clem@mv               fseqv_1d(ji)   = fseqv_1d(ji) - bulk_sal * rhoic *  & 
     420!clem@mv                  zv_newice(ji) / rdt_ice 
     421!clem@mv            END DO 
     422!clem@mv         ELSE 
     423!clem@mv            DO ji = 1, nbpac 
     424!clem@mv               ! IOVINO 
     425!clem@mv               fseqv_1d(ji)   = fseqv_1d(ji)  - zs_newice(ji) * rhoic *   & 
     426!clem@mv                  zv_newice(ji) / rdt_ice 
     427!clem@mv            END DO ! ji 
     428!clem@mv         ENDIF 
    434429 
    435430         !------------------------------------ 
    … …  
    460455            zjj                  = ( npac(ji) - 1 ) / jpi + 1 
    461456            diag_lat_gr(zji,zjj) = zv_newice(ji) / rdt_ice 
    462          END DO !ji 
     457          END DO !ji 
    463458 
    464459         !------------------------------------------------------------------------------! 
    … …  
    480475         DO ji = 1, nbpac 
    481476            ! vectorize 
    482             IF ( za_newice(ji) .GT. ( 1.0 - zat_i_ac(ji) ) ) THEN 
    483                zda_res(ji)    = za_newice(ji) - (1.0 - zat_i_ac(ji) ) 
     477            IF ( za_newice(ji) .GT. ( amax - zat_i_ac(ji) ) ) THEN 
     478               zda_res(ji)    = za_newice(ji) - ( amax - zat_i_ac(ji) ) 
    484479               zdv_res(ji)    = zda_res(ji) * zh_newice(ji)  
    485480               za_newice(ji)  = za_newice(ji) - zda_res(ji) 
    486481               zv_newice(ji)  = zv_newice(ji) - zdv_res(ji) 
    487             ELSE 
     482           ELSE 
    488483               zda_res(ji) = 0.0 
    489484               zdv_res(ji) = 0.0 
    … …  
    512507         DO ji = 1, nbpac 
    513508            jl = zcatac(ji)                                                           ! categroy in which new ice is put 
    514             zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) ) )             ! zindb=1 if ice =0 otherwise 
     509            zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) )             ! zindb=1 if ice =0 otherwise 
    515510            zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb  ! old ice thickness 
    516511            zdhex    (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) )           ! difference in thickness 
    517             zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi11 ) )   ! ice totally new in jl category 
     512            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) )   ! ice totally new in jl category 
    518513         END DO 
    519514 
    … …  
    522517               jl = zcatac(ji) 
    523518               zqold   = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
    524                zalphai = MIN( zhice_old(ji,jl) *   jk       / nlay_i , zh_newice(ji) )   & 
    525                   &    - MIN( zhice_old(ji,jl) * ( jk - 1 ) / nlay_i , zh_newice(ji) ) 
     519               zalphai = MIN( zhice_old(ji,jl) * REAL( jk )     / REAL( nlay_i ), zh_newice(ji) )   & 
     520                  &    - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 
    526521               ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji)                                     & 
    527                   + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / nlay_i   & 
     522                  + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / REAL( nlay_i )  & 
    528523                  + za_newice(ji)  * ze_newice(ji) * zalphai                                       & 
    529                   + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / nlay_i ) / ( ( zv_i_ac(ji,jl) ) / nlay_i ) 
     524                  + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 
    530525            END DO 
    531526         END DO 
    … …  
    563558         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    564559            DO ji = 1, nbpac 
    565                zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) ) )       ! zindb=1 if ice =0 otherwise 
     560               zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) )       ! zindb=1 if ice =0 otherwise 
    566561               zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 
    567562               zdhicbot (ji,jl) = zdv_res(ji)    / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    & 
    … …  
    575570            DO jk = 1, nlay_i 
    576571               DO ji = 1, nbpac 
    577                   zthick0(ji,jk,jl) =  zhice_old(ji,jl) / nlay_i 
     572                  zthick0(ji,jk,jl) =  zhice_old(ji,jl) / REAL( nlay_i ) 
    578573                  zqm0   (ji,jk,jl) =  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 
    579574               END DO 
    … …  
    594589               DO layer = 1, nlay_i + 1 
    595590                  DO ji = 1, nbpac 
    596                      zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) ) )  
     591                     zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  
    597592                     ! Redistributing energy on the new grid 
    598                      zweight = MAX (  MIN( zhice_old(ji,jl) * layer , zdummy(ji,jl) * jk )   & 
    599                         &    - MAX( zhice_old(ji,jl) * ( layer - 1 ) , zdummy(ji,jl) * ( jk - 1 ) ) , 0._wp )   & 
    600                         &    /( MAX(nlay_i * zthick0(ji,layer,jl),epsi10) ) * zindb 
     593                     zweight = MAX (  MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) )   & 
     594                        &    - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp )   & 
     595                        &    /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 
    601596                     ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl)   
    602597                  END DO ! ji 
    … …  
    608603            DO jk = 1, nlay_i 
    609604               DO ji = 1, nbpac 
    610                   zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) )  
     605                  zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  
    611606                  ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl)   & 
    612                      &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * nlay_i * zindb 
     607                     &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 
    613608               END DO 
    614609            END DO 
    … …  
    620615         DO jl = 1, jpl 
    621616            DO ji = 1, nbpac 
    622                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes 
     617               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    623618               zoa_i_ac(ji,jl)  = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    
    624619            END DO  
    … …  
    631626            DO jl = 1, jpl 
    632627               DO ji = 1, nbpac 
    633                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes 
     628                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    634629                  zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    635630                  zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * zindb 
    … …  
    637632            END DO    
    638633         ENDIF 
     634 
     635         !-------------------------------- 
     636         ! Update mass/salt fluxes (clem) 
     637         !-------------------------------- 
     638         DO jl = 1, jpl 
     639            DO ji = 1, nbpac 
     640               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
     641               zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
     642               rdmicif_1d(ji) = rdmicif_1d(ji) + zdv * rhoic !* zindb 
     643               fseqv_1d(ji)   =   fseqv_1d(ji) - zdv * rhoic * zs_newice(ji) / rdt_ice * zindb 
     644           END DO 
     645         END DO 
    639646 
    640647         !------------------------------------------------------------------------------! 
    … …  
    652659         END DO 
    653660         CALL tab_1d_2d( nbpac, fseqv , npac(1:nbpac), fseqv_1d  (1:nbpac) , jpi, jpj ) 
     661         CALL tab_1d_2d( nbpac, rdmicif , npac(1:nbpac), rdmicif_1d  (1:nbpac) , jpi, jpj ) 
    654662         ! 
    655663      ENDIF ! nbpac > 0 
    … …  
    660668      DO jl = 1, jpl 
    661669         DO jk = 1, nlay_i          ! heat content in 10^9 Joules 
    662             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / nlay_i  / unit_fac  
     670            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i )  / unit_fac  
    663671         END DO 
    664672      END DO 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r3294 r3938  
    2424   USE lib_mpp          ! MPP library 
    2525   USE wrk_nemo         ! work arrays 
     26   USE lib_fortran      ! to use key_nosignedzero 
    2627 
    2728   IMPLICIT NONE 
    … …  
    3132   PUBLIC   lim_thd_sal_init   ! called by iceini module 
    3233 
     34   REAL(wp) ::   epsi20 = 1e-20_wp   ! constant values 
    3335   !!---------------------------------------------------------------------- 
    3436   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    … …  
    6769      IF( num_sal == 1 ) THEN 
    6870         ! 
    69          DO jk = 1, nlay_i 
    70             DO ji = kideb, kiut 
    71                s_i_b(ji,jk) =  bulk_sal 
    72             END DO ! ji 
    73          END DO ! jk 
    74          ! 
    75          DO ji = kideb, kiut 
    76             sm_i_b(ji)      =  bulk_sal  
    77          END DO ! ji 
    78          ! 
     71         s_i_b  (kideb:kiut,1:nlay_i) =  bulk_sal  
     72         sm_i_b (kideb:kiut)          =  bulk_sal 
     73         s_i_new(kideb:kiut)          =  bulk_sal 
     74        ! 
    7975      ENDIF 
    8076 
    … …  
    9086         DO ji = kideb, kiut 
    9187            zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji) 
     88            zsiold(ji) = sm_i_b(ji) 
    9289         END DO 
    9390 
    … …  
    9895         DO jk = 1, nlay_i 
    9996            DO ji = kideb, kiut 
    100                ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 
     97               ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i ) 
    10198            END DO 
    10299         END DO 
    … …  
    125122            ! only drainage terms ( gravity drainage and flushing ) 
    126123            ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 
    127             zsiold(ji) = sm_i_b(ji) 
    128124            sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    129125 
    … …  
    156152         ! Salt flux - brine drainage 
    157153         !---------------------------- 
    158          DO ji = kideb, kiut 
     154          DO ji = kideb, kiut 
    159155            i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 
    160             fsbri_1d(ji) = fsbri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji)         & 
    161                &         * ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice 
     156            fsbri_1d(ji) = fsbri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) * ( sm_i_b(ji) - zsiold(ji) ) / rdt_ice 
     157            !i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - zhiold(ji) ) ) 
     158            !fsbri_1d(ji) = fsbri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * zhiold(ji) * ( sm_i_b(ji) - zsiold(ji) ) / rdt_ice 
     159            !clem fsbri_1d(ji) = fsbri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji)         & 
     160            !clem     &         * ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice 
    162161            IF( num_sal == 4 ) fsbri_1d(ji) = 0._wp 
    163          END DO ! ji 
     162          END DO ! ji 
    164163 
    165164         ! Only necessary for conservation check since salinity is modified 
    … …  
    211210      ENDIF ! num_sal 
    212211 
    213       !------------------------------------------------------------------------------| 
    214       ! 5) Computation of salt flux due to Bottom growth 
    215       !------------------------------------------------------------------------------| 
    216  
    217       IF ( num_sal == 4 ) THEN 
    218          DO ji = kideb, kiut 
    219             zji = MOD( npb(ji) - 1 , jpi ) + 1 
    220             zjj =    ( npb(ji) - 1 ) / jpi + 1 
    221             fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal    )               & 
    222                &                        * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
    223          END DO 
    224       ELSE 
    225          DO ji = kideb, kiut 
    226             zji = MOD( npb(ji) - 1 , jpi ) + 1 
    227             zjj =    ( npb(ji) - 1 ) / jpi + 1 
    228             fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - s_i_new(ji) )               & 
    229                &                        * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 
    230          END DO 
    231       ENDIF 
    232212      ! 
    233213      CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r3294 r3938  
    2727   USE wrk_nemo        ! work arrays 
    2828   USE prtctl          ! Print control 
     29   USE lib_fortran     ! to use key_nosignedzero 
     30   USE limvar          ! clem for ice thickness correction 
    2931 
    3032   IMPLICIT NONE 
    … …  
    3537   REAL(wp)  ::   epsi06 = 1.e-06_wp   ! constant values 
    3638   REAL(wp)  ::   epsi03 = 1.e-03_wp   
    37    REAL(wp)  ::   zeps10 = 1.e-10_wp   
     39   REAL(wp)  ::   epsi10 = 1.e-10_wp   
    3840   REAL(wp)  ::   epsi16 = 1.e-16_wp 
     41   REAL(wp)  ::   epsi20 = 1.e-20_wp 
    3942   REAL(wp)  ::   rzero  = 0._wp    
    4043   REAL(wp)  ::   rone   = 1._wp 
    … …  
    6568      INTEGER, INTENT(in) ::   kt   ! number of iteration 
    6669      ! 
    67       INTEGER  ::   ji, jj, jk, jl, layer   ! dummy loop indices 
     70      INTEGER  ::   ji, jj, jk, jl, jm, layer   ! dummy loop indices 
     71      INTEGER  ::   jbnd1, jbnd2 
    6872      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    6973      INTEGER  ::   ierr                    ! error status 
    70       REAL(wp) ::   zindb  , zindsn , zindic      ! local scalar 
     74      REAL(wp) ::   zindb  , zindsn , zindic, zindh, zinda      ! local scalar 
    7175      REAL(wp) ::   zusvosn, zusvoic, zbigval     !   -      - 
    7276      REAL(wp) ::   zcfl , zusnit , zrtt          !   -      - 
    … …  
    7680      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 
    7781      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e 
     82      REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
     83      ! mass and salt flux (clem) 
     84      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold   ! old ice volume... 
     85      ! correct ice thickness (clem) 
     86      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaiold, zhimax   ! old ice concentration 
     87      REAL(wp) :: zdv, zda, zvi, zvs, zsmv 
    7888      !!--------------------------------------------------------------------- 
    7989 
    … …  
    8191      CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    8292      CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 
     93 
     94      CALL wrk_alloc( jpi,jpj,jpl,zviold )   ! clem 
     95      CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
     96 
     97      ! ------------------------------- 
     98      !- check conservation (C Rousset) 
     99      IF (ln_limdiahsb) THEN 
     100         zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     101         zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     102         zchk_fw_b  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) 
     103         zchk_fs_b  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) 
     104      ENDIF 
     105      !- check conservation (C Rousset) 
     106      ! ------------------------------- 
    83107 
    84108      IF( numit == nstart .AND. lwp ) THEN 
    … …  
    95119      IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
    96120         !                          !-------------------------------------! 
    97          ! 
    98  
     121         ! mass and salt flux init (clem) 
     122         zviold(:,:,:)  = v_i(:,:,:) 
     123 
     124         !--- Thickness correction init. (clem) ------------------------------- 
     125         CALL lim_var_glo2eqv 
     126         zaiold(:,:,:) = a_i(:,:,:) 
     127         !--------------------------------------------------------------------- 
     128         ! Record max of the surrounding ice thicknesses for correction in limupdate 
     129         ! in case advection creates ice too thick. 
     130         !--------------------------------------------------------------------- 
     131         zhimax(:,:,:) = ht_i(:,:,:) 
     132         DO jl = 1, jpl 
     133            DO jj = 2, jpjm1 
     134               DO ji = 2, jpim1 
     135                  zhimax(ji,jj,jl) = MAXVAL( ht_i(ji-1:ji+1,jj-1:jj+1,jl) ) 
     136               END DO 
     137            END DO 
     138            CALL lbc_lnk(zhimax(:,:,jl),'T',1.) 
     139         END DO 
     140          
    99141         !------------------------- 
    100142         ! transported fields                                         
    … …  
    125167!         ENDIF 
    126168!!gm end 
    127          initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
     169         initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
    128170         zusnit = 1.0 / REAL( initad )  
    129171         IF( zcfl > 0.5 .AND. lwp )   & 
    … …  
    134176            DO jk = 1,initad 
    135177               CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    136                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     178                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    137179               CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
    138                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     180                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    139181               DO jl = 1, jpl 
    140182                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    … …  
    174216         ELSE 
    175217            DO jk = 1, initad 
    176                CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    177                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    178                CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   & 
    179                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     218               CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
     219                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
     220               CALL lim_adv_x( zusnit, u_ice, rzero , zsm, zs0ow (:,:), sxopw(:,:),   & 
     221                   &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    180222               DO jl = 1, jpl 
    181                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     223                  CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    182224                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    183                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     225                  CALL lim_adv_x( zusnit, u_ice, rzero , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
    184226                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    185                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     227                  CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    186228                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    187                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     229                  CALL lim_adv_x( zusnit, u_ice, rzero , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
    188230                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    189                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     231                  CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    190232                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    191                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     233                  CALL lim_adv_x( zusnit, u_ice, rzero , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
    192234                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    193  
    194                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     235                  CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    195236                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    196                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     237                  CALL lim_adv_x( zusnit, u_ice, rzero , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
    197238                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    198                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     239                  CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    199240                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    200                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
     241                  CALL lim_adv_x( zusnit, u_ice, rzero , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
    201242                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    202                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     243                  CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    203244                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    204                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     245                  CALL lim_adv_x( zusnit, u_ice, rzero , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
    205246                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    206247                  DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    207                      CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
     248                     CALL lim_adv_y( zusnit, v_ice, rone, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    208249                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    209250                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    210                      CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
     251                     CALL lim_adv_x( zusnit, u_ice, rzero , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    211252                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    212253                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    … …  
    270311            END DO 
    271312 
    272             CALL lim_hdf( zs0ice (:,:,jl) ) 
    273             CALL lim_hdf( zs0sn  (:,:,jl) ) 
    274             CALL lim_hdf( zs0sm  (:,:,jl) ) 
    275             CALL lim_hdf( zs0oi  (:,:,jl) ) 
    276             CALL lim_hdf( zs0a   (:,:,jl) ) 
    277             CALL lim_hdf( zs0c0  (:,:,jl) ) 
    278             DO jk = 1, nlay_i 
    279                CALL lim_hdf( zs0e (:,:,jk,jl) ) 
    280             END DO 
     313             CALL lim_hdf( zs0ice (:,:,jl) ) 
     314             CALL lim_hdf( zs0sn  (:,:,jl) ) 
     315             CALL lim_hdf( zs0sm  (:,:,jl) ) 
     316             CALL lim_hdf( zs0oi  (:,:,jl) ) 
     317             CALL lim_hdf( zs0a   (:,:,jl) ) 
     318             CALL lim_hdf( zs0c0  (:,:,jl) ) 
     319             DO jk = 1, nlay_i 
     320                CALL lim_hdf( zs0e (:,:,jk,jl) ) 
     321             END DO 
    281322         END DO 
    282323 
    … …  
    284325         !  Remultiply everything by ice area 
    285326         !----------------------------------------- 
    286          zs0ow(:,:) = MAX( rzero, zs0ow(:,:) * area(:,:) ) 
    287          DO jl = 1, jpl 
    288             zs0ice(:,:,jl) = MAX( rzero, zs0ice(:,:,jl) * area(:,:) )    !!bug:  est-ce utile 
    289             zs0sn (:,:,jl) = MAX( rzero, zs0sn (:,:,jl) * area(:,:) )    !!bug:  cf /area  juste apres 
    290             zs0sm (:,:,jl) = MAX( rzero, zs0sm (:,:,jl) * area(:,:) )    !!bug:  cf /area  juste apres 
    291             zs0oi (:,:,jl) = MAX( rzero, zs0oi (:,:,jl) * area(:,:) ) 
    292             zs0a  (:,:,jl) = MAX( rzero, zs0a  (:,:,jl) * area(:,:) )    !! suppress both change le resultat 
    293             zs0c0 (:,:,jl) = MAX( rzero, zs0c0 (:,:,jl) * area(:,:) ) 
    294             DO jk = 1, nlay_i 
    295                zs0e(:,:,jk,jl) = MAX( rzero, zs0e (:,:,jk,jl) * area(:,:) ) 
    296             END DO ! jk 
    297          END DO ! jl 
     327         !clem zs0ow(:,:) = MAX( rzero, zs0ow(:,:) * area(:,:) ) 
     328         !clem DO jl = 1, jpl 
     329         !clem    zs0ice(:,:,jl) = MAX( rzero, zs0ice(:,:,jl) * area(:,:) )    !!bug:  est-ce utile 
     330         !clem    zs0sn (:,:,jl) = MAX( rzero, zs0sn (:,:,jl) * area(:,:) )    !!bug:  cf /area  juste apres 
     331         !clem    zs0sm (:,:,jl) = MAX( rzero, zs0sm (:,:,jl) * area(:,:) )    !!bug:  cf /area  juste apres 
     332         !clem    zs0oi (:,:,jl) = MAX( rzero, zs0oi (:,:,jl) * area(:,:) ) 
     333         !clem    zs0a  (:,:,jl) = MAX( rzero, zs0a  (:,:,jl) * area(:,:) )    !! suppress both change le resultat 
     334         !clem    zs0c0 (:,:,jl) = MAX( rzero, zs0c0 (:,:,jl) * area(:,:) ) 
     335         !clem    DO jk = 1, nlay_i 
     336         !clem       zs0e(:,:,jk,jl) = MAX( rzero, zs0e (:,:,jk,jl) * area(:,:) ) 
     337         !clem    END DO ! jk 
     338         !clem END DO ! jl 
    298339 
    299340         !------------------------------------------------------------------------------! 
    … …  
    305346         !-------------------------------------------------- 
    306347 
    307          DO jl = 1, jpl 
    308             DO jk = 1, nlay_i 
    309                DO jj = 1, jpj 
    310                   DO ji = 1, jpi 
    311                      zs0e(ji,jj,jk,jl) = MAX( rzero, zs0e(ji,jj,jk,jl) / area(ji,jj) ) 
    312                   END DO 
    313                END DO 
    314             END DO 
    315          END DO 
    316  
    317          DO jj = 1, jpj 
    318             DO ji = 1, jpi 
    319                zs0ow(ji,jj) = MAX( rzero, zs0ow (ji,jj) / area(ji,jj) ) 
    320             END DO 
    321          END DO 
     348         !clem DO jl = 1, jpl 
     349         !clem    DO jk = 1, nlay_i 
     350         !clem       DO jj = 1, jpj 
     351         !clem          DO ji = 1, jpi 
     352         !clem             zs0e(ji,jj,jk,jl) = MAX( rzero, zs0e(ji,jj,jk,jl) / area(ji,jj) ) 
     353         !clem          END DO 
     354         !clem       END DO 
     355         !clem    END DO 
     356         !clem END DO 
     357 
     358         !clem DO jj = 1, jpj 
     359         !clem    DO ji = 1, jpi 
     360         !clem       zs0ow(ji,jj) = MAX( rzero, zs0ow (ji,jj) / area(ji,jj) ) 
     361         !clem    END DO 
     362         !clem END DO 
    322363 
    323364         zs0at(:,:) = 0._wp 
    … …  
    325366            DO jj = 1, jpj 
    326367               DO ji = 1, jpi 
    327                   zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl)/area(ji,jj) ) 
    328                   zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl)/area(ji,jj) ) 
    329                   zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl)/area(ji,jj) ) 
    330                   zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl)/area(ji,jj) ) 
    331                   zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl)/area(ji,jj) ) 
    332                   zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl)/area(ji,jj) ) 
     368                 !clem  zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl)/area(ji,jj) ) 
     369                 !clem  zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl)/area(ji,jj) ) 
     370                 !clem  zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl)/area(ji,jj) ) 
     371                 !clem  zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl)/area(ji,jj) ) 
     372                 !clem  zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl)/area(ji,jj) ) 
     373                 !clem  zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl)/area(ji,jj) ) 
     374                  zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) ) 
     375                  zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) ) 
     376                  zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) ) 
     377                  zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) ) 
     378                  zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl) ) 
     379                  zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) ) 
    333380                  zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl) 
    334381               END DO 
    … …  
    341388         DO jj = 1, jpj 
    342389            DO ji = 1, jpi 
    343                zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - zeps10) ) 
     390               zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 
    344391               zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 
    345392               ato_i(ji,jj) = zs0ow(ji,jj) 
    … …  
    347394         END DO 
    348395 
     396         ! 
     397         ! 
    349398         DO jl = 1, jpl         ! Remove very small areas  
    350399            DO jj = 1, jpj 
    351400               DO ji = 1, jpi 
    352                   zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - zeps10) ) 
     401                  zvi = zs0ice(ji,jj,jl) 
     402                  zvs = zs0sn(ji,jj,jl) 
    353403                  ! 
    354                   zs0a(ji,jj,jl) = zindb * MIN( zs0a(ji,jj,jl), 0.99 ) 
     404                  zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 
     405                  ! 
     406                  !zs0a(ji,jj,jl) = zindb * MIN( zs0a(ji,jj,jl), 0.99 ) 
    355407                  v_s(ji,jj,jl)  = zindb * zs0sn (ji,jj,jl)  
    356408                  v_i(ji,jj,jl)  = zindb * zs0ice(ji,jj,jl) 
    357409                  ! 
    358                   zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - zeps10 ) ) 
    359                   zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) ) 
     410                  zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
     411                  zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    360412                  zindb          = MAX( zindsn, zindic ) 
     413                  ! 
    361414                  zs0a(ji,jj,jl) = zindb  * zs0a(ji,jj,jl) !ice concentration 
    362415                  a_i (ji,jj,jl) = zs0a(ji,jj,jl) 
    363416                  v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 
    364417                  v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 
     418                  ! 
     419                  ! Update mass fluxes (clem) 
     420                  rdmicif(ji,jj) = rdmicif(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic  
     421                  rdmsnif(ji,jj) = rdmsnif(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn  
     422              END DO 
     423            END DO 
     424         END DO 
     425 
     426         !--- Thickness correction in case too high (clem) -------------------------------------------------------- 
     427         CALL lim_var_glo2eqv 
     428         DO jl = 1, jpl 
     429            DO jj = 1, jpj 
     430               DO ji = 1, jpi 
     431 
     432                  IF ( v_i(ji,jj,jl) > 0. ) THEN 
     433                     zvi = v_i(ji,jj,jl) 
     434                     zvs = v_s(ji,jj,jl) 
     435                     zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
     436                     !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)    
     437                      
     438                     IF ( ( zdv > 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) .AND. SUM( zaiold(ji,jj,1:jpl) ) < 0.80 ) .OR. & 
     439                          ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                           
     440                        ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 
     441                        zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
     442                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
     443                     ELSE 
     444                        ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 
     445                        zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
     446                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
     447                     ENDIF 
     448 
     449                     !zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
     450                     v_i(ji,jj,jl) = a_i(ji,jj,jl) * ht_i(ji,jj,jl) 
     451                     v_s(ji,jj,jl) = a_i(ji,jj,jl) * ht_s(ji,jj,jl) 
     452 
     453                     ! Update mass fluxes (clem) 
     454                     rdmicif(ji,jj) = rdmicif(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 
     455                     rdmsnif(ji,jj) = rdmsnif(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 
     456 
     457                  ENDIF 
     458 
     459                  diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice 
     460 
    365461               END DO 
    366462            END DO 
    367463         END DO 
    368464 
     465         ! --- 
    369466         DO jj = 1, jpj 
    370467            DO ji = 1, jpi 
    371                zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) 
     468         !      ato_i(ji,jj) = 1._wp - SUM( a_i(ji,jj,1:jpl) ) !clem@rm-ow-advection 
     469               zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless?? 
    372470            END DO 
    373471         END DO 
    … …  
    377475         !---------------------- 
    378476 
    379          zbigval = 1.d+13 
     477         zbigval = 1.e+13 
    380478 
    381479         DO jl = 1, jpl 
    382480            DO jj = 1, jpj 
    383481               DO ji = 1, jpi 
     482                  zsmv = zs0sm(ji,jj,jl) 
    384483 
    385484                  ! Switches and dummy variables 
    … …  
    387486                  zusvoic         = 1.0/MAX( v_i(ji,jj,jl) , epsi16 ) 
    388487                  zrtt            = 173.15 * rone  
    389                   zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - zeps10 ) ) 
    390                   zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) ) 
     488                  zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
     489                  zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    391490                  zindb           = MAX( zindsn, zindic ) 
    392491 
    … …  
    394493                  zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj)  , & 
    395494                     zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 
    396                   IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) &  
    397                      smv_i(ji,jj,jl) = zindic*zsal + (1.0-zindic)*0.0 
     495                  IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) smv_i(ji,jj,jl) = zindic*zsal 
    398496 
    399497                  zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / &  
    … …  
    403501                  ! Snow heat content 
    404502                  ze              =  MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 
    405                   e_s(ji,jj,1,jl) = zindsn * ze + (1.0 - zindsn) * 0.0       
    406  
     503                  e_s(ji,jj,1,jl) = zindsn * ze       
     504 
     505                  ! Update salt fluxes (clem) 
     506                  fsalt_res(ji,jj) = fsalt_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic / rdt_ice  
    407507               END DO !ji 
    408508            END DO !jj 
    … …  
    414514                  DO ji = 1, jpi 
    415515                     ! Ice heat content 
    416                      zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) ) 
     516                     zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    417517                     ze              =  MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 
    418                      e_i(ji,jj,jk,jl) = zindic * ze    + ( 1.0 - zindic ) * 0.0 
     518                     e_i(ji,jj,jk,jl) = zindic * ze 
    419519                  END DO !ji 
    420520               END DO ! jj 
    421521            END DO ! jk 
    422522         END DO ! jl 
     523 
     524 
     525      ! --- agglomerate variables (clem) ----------------- 
     526      vt_i (:,:) = 0._wp 
     527      vt_s (:,:) = 0._wp 
     528      at_i (:,:) = 0._wp 
     529      ! 
     530      DO jl = 1, jpl 
     531         DO jj = 1, jpj 
     532            DO ji = 1, jpi 
     533               ! 
     534               vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
     535               vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
     536               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
     537               ! 
     538               zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi16 ) ) 
     539               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi16 ) * zinda  ! ice thickness 
     540            END DO 
     541         END DO 
     542      END DO 
     543      ! ------------------------------------------------- 
     544 
     545 
    423546 
    424547      ENDIF 
    … …  
    455578         END DO 
    456579      ENDIF 
     580      ! ------------------------------- 
     581      !- check conservation (C Rousset) 
     582      IF (ln_limdiahsb) THEN 
     583         zchk_fs  = glob_sum( ( fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
     584         zchk_fw  = glob_sum( rdmicif(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
     585  
     586         zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
     587         zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
     588 
     589         IF(lwp) THEN 
     590            IF (    ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limtrp) = ',(zchk_v_i * 86400.) 
     591            IF (    ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * 86400.) 
     592            IF ( MINVAL( v_i(:,:,:) ) <  0.    ) WRITE(numout,*) 'violation v_i<0  [mm]         (limtrp) = ',(MINVAL(v_i) * 1.e-3) 
     593            IF ( MINVAL( a_i(:,:,:) ) <  0.    ) WRITE(numout,*) 'violation a_i<0               (limtrp) = ',MINVAL(a_i) 
     594         ENDIF 
     595      ENDIF 
     596      !- check conservation (C Rousset) 
     597      ! ------------------------------- 
    457598      ! 
    458599      CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
    459600      CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    460601      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 
     602 
     603      CALL wrk_dealloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
    461604      ! 
    462605   END SUBROUTINE lim_trp 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r3294 r3938  
    5353   USE lib_mpp          ! MPP library 
    5454   USE wrk_nemo         ! work arrays 
     55   USE lib_fortran      ! to use key_nosignedzero 
    5556 
    5657   IMPLICIT NONE 
    … …  
    6162   PUBLIC   lim_var_eqv2glo      ! 
    6263   PUBLIC   lim_var_salprof      ! 
     64   PUBLIC   lim_var_icetm        ! 
    6365   PUBLIC   lim_var_bv           ! 
    6466   PUBLIC   lim_var_salprof1d    ! 
    6567 
    66    REAL(wp) ::   eps20 = 1.e-20_wp   ! module constants 
    67    REAL(wp) ::   eps16 = 1.e-16_wp   !    -       - 
    68    REAL(wp) ::   eps13 = 1.e-13_wp   !    -       - 
    69    REAL(wp) ::   eps10 = 1.e-10_wp   !    -       - 
    70    REAL(wp) ::   eps06 = 1.e-06_wp   !    -       - 
     68   REAL(wp) ::   epsi20 = 1.e-20_wp   ! module constants 
     69   REAL(wp) ::   epsi16 = 1.e-16_wp   !    -       - 
     70   REAL(wp) ::   epsi13 = 1.e-13_wp   !    -       - 
     71   REAL(wp) ::   epsi10 = 1.e-10_wp   !    -       - 
     72   REAL(wp) ::   epsi06 = 1.e-06_wp   !    -       - 
    7173   REAL(wp) ::   zzero = 0.e0        !    -       - 
    7274   REAL(wp) ::   zone  = 1.e0        !    -       - 
    … …  
    9698      ! 
    9799      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    98       REAL(wp) ::   zinda 
     100      REAL(wp) ::   zinda, zindb 
    99101      !!------------------------------------------------------------------ 
    100102 
    … …  
    115117               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    116118               ! 
    117                zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )  
    118                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , eps16 ) * zinda  ! ice thickness 
     119               zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi16 ) )  
     120               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi16 ) * zinda  ! ice thickness 
    119121            END DO 
    120122         END DO 
    … …  
    136138            DO jj = 1, jpj 
    137139               DO ji = 1, jpi 
     140                  zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - epsi16 ) )  
     141                  zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi16 ) )  
    138142                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content 
    139                   zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - 0.10 ) )  
    140                   smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , eps13 ) * zinda   ! ice salinity 
    141                   zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )  
    142                   ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , eps13 ) * zinda   ! ice age 
    143                END DO 
    144             END DO 
    145          END DO 
    146          ! 
     143                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi16 ) * zinda   ! ice salinity 
     144                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , epsi16 ) * zindb   ! ice age 
     145               END DO 
     146            END DO 
     147         END DO 
     148          ! 
    147149         DO jl = 1, jpl 
    148150            DO jk = 1, nlay_i 
    … …  
    174176         DO jj = 1, jpj 
    175177            DO ji = 1, jpi 
    176                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) )   !0 if no ice and 1 if yes 
    177                ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 
    178                ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 
    179                o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb 
     178               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
     179               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
     180               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
     181               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb 
    180182            END DO 
    181183         END DO 
    … …  
    186188            DO jj = 1, jpj 
    187189               DO ji = 1, jpi 
    188                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) )   !0 if no ice and 1 if yes 
    189                   sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , eps10 ) * zindb 
     190                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) )   !0 if no ice and 1 if yes 
     191                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * zindb 
    190192               END DO 
    191193            END DO 
    … …  
    207209               DO ji = 1, jpi 
    208210                  !                                                              ! Energy of melting q(S,T) [J.m-3] 
    209                   zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , eps06 ) * REAL(nlay_i,wp)  
     211                  zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi06 ) * REAL(nlay_i,wp)  
    210212                  zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) ) )     ! zindb = 0 if no ice and 1 if yes 
    211213                  zq_i    = zq_i * unit_fac * zindb                              !convert units 
    … …  
    233235               DO ji = 1, jpi 
    234236                  !Energy of melting q(S,T) [J.m-3] 
    235                   zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , eps06 ) ) * REAL(nlay_s,wp) 
     237                  zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * REAL(nlay_s,wp) 
    236238                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) ) )     ! zindb = 0 if no ice and 1 if yes 
    237239                  zq_s  = zq_s * unit_fac * zindb                                    ! convert units 
    … …  
    252254            DO jj = 1, jpj 
    253255               DO ji = 1, jpi 
    254                   zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , -a_i(ji,jj,jl) ) )  )   & 
    255                      &  * (  1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) ) )  ) 
    256                   tm_i(ji,jj) = tm_i(ji,jj) + t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
    257                      &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , eps10 )  ) 
     256                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     257                  tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
     258                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
    258259               END DO 
    259260            END DO 
    … …  
    337338               DO ji = 1, jpi 
    338339                  ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    339                   zind0  = MAX( 0.0   , SIGN( 1.0  , s_i_0 - sm_i(ji,jj,jl) ) )  
     340                  zind0  = MAX( 0._wp   , SIGN( 1._wp  , s_i_0 - sm_i(ji,jj,jl) ) )  
    340341                  ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    341                   zind01 = ( 1.0 - zind0 ) * MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i(ji,jj,jl) ) )  
     342                  zind01 = ( 1._wp - zind0 ) * MAX( 0._wp   , SIGN( 1._wp  , s_i_1 - sm_i(ji,jj,jl) ) )  
    342343                  ! If 2.sm_i GE sss_m then zindbal = 1 
    343                   zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
    344                   zalpha(ji,jj,jl) = zind0  * 1.0 + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
    345                   zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1.0 - zindbal ) 
    346                END DO 
    347             END DO 
    348          END DO 
    349  
    350          dummy_fac = 1._wp / nlay_i                   ! Computation of the profile 
     344                  zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) ) 
     345                  zalpha(ji,jj,jl) = zind0  + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 ) 
     346                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zindbal ) 
     347               END DO 
     348            END DO 
     349         END DO 
     350 
     351         dummy_fac = 1._wp / REAL( nlay_i )                   ! Computation of the profile 
    351352         DO jl = 1, jpl 
    352353            DO jk = 1, nlay_i 
    … …  
    388389 
    389390 
     391   SUBROUTINE lim_var_icetm 
     392      !!------------------------------------------------------------------ 
     393      !!                ***  ROUTINE lim_var_icetm *** 
     394      !! 
     395      !! ** Purpose :   computes mean sea ice temperature 
     396      !!------------------------------------------------------------------ 
     397      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     398      REAL(wp) ::   zindb   !   -      - 
     399      !!------------------------------------------------------------------ 
     400 
     401      ! Mean sea ice temperature 
     402      tm_i(:,:) = 0._wp 
     403      DO jl = 1, jpl 
     404         DO jk = 1, nlay_i 
     405            DO jj = 1, jpj 
     406               DO ji = 1, jpi 
     407                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) )  ) 
     408                  tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   & 
     409                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 )  ) 
     410               END DO 
     411            END DO 
     412         END DO 
     413      END DO 
     414 
     415   END SUBROUTINE lim_var_icetm 
     416 
     417 
    390418   SUBROUTINE lim_var_bv 
    391419      !!------------------------------------------------------------------ 
    … …  
    399427      !!------------------------------------------------------------------ 
    400428      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    401       REAL(wp) ::   zbvi, zindb      ! local scalars 
     429      REAL(wp) ::   zbvi, zinda, zindb      ! local scalars 
    402430      !!------------------------------------------------------------------ 
    403431      ! 
    … …  
    407435            DO jj = 1, jpj 
    408436               DO ji = 1, jpi 
    409                   zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes 
    410                   zbvi  = - zindb * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - 273.15 , eps13 )   & 
     437                  zinda = (  1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi16 ) )  ) 
     438                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi16 ) )  ) 
     439                  zbvi  = - zinda * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi16 )   & 
    411440                     &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp) 
    412                   bv_i(ji,jj) = bv_i(ji,jj) + zbvi  / MAX( vt_i(ji,jj) , eps13 ) 
     441                  bv_i(ji,jj) = bv_i(ji,jj) + zindb * zbvi  / MAX( vt_i(ji,jj) , epsi16 ) 
    413442               END DO 
    414443            END DO 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r3294 r3938  
    1010   !!   lim_wri      : write of the diagnostics variables in ouput file  
    1111   !!   lim_wri_init : initialization and namelist read 
     12   !!   lim_wri_state : write for initial state or/and abandon 
    1213   !!---------------------------------------------------------------------- 
    1314   USE ioipsl 
    … …  
    2526   USE wrk_nemo        ! work arrays 
    2627   USE par_ice 
     28   USE iom 
     29   USE timing          ! Timing 
     30   USE lib_fortran     ! Fortran utilities 
    2731 
    2832   IMPLICIT NONE 
    … …  
    3034 
    3135   PUBLIC lim_wri        ! routine called by lim_step.F90 
    32  
    33    INTEGER, PARAMETER ::   jpnoumax = 40   !: maximum number of variable for ice output 
     36   PUBLIC lim_wri_state  ! called by dia_wri_state  
     37 
     38   INTEGER, PARAMETER ::   jpnoumax = 43   !: maximum number of variable for ice output 
    3439    
    3540   INTEGER  ::   noumef             ! number of fields 
    … …  
    4752   INTEGER            , DIMENSION(jpnoumax) ::   nc  , nca     ! switch for saving field ( = 1 ) or not ( = 0 ) 
    4853 
    49    REAL(wp)  ::   epsi16 = 1e-16_wp 
     54   REAL(wp)  ::   epsi06 = 1e-6_wp 
    5055   REAL(wp)  ::   zzero  = 0._wp 
    5156   REAL(wp)  ::   zone   = 1._wp       
    … …  
    7681      INTEGER ::  ierr 
    7782      REAL(wp),DIMENSION(1) ::   zdept 
    78       REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb 
     83      REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb, zindc 
    7984      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcmo, zcmoa 
    8085      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zfield 
    … …  
    8893      INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndexitd 
    8994      !!------------------------------------------------------------------- 
     95 
     96      IF( nn_timing == 1 )  CALL timing_start('limwri') 
    9097 
    9198      CALL wrk_alloc( jpi, jpj, zfield ) 
    … …  
    126133         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 
    127134         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    128          CALL dia_nam ( clhstnam, nwrite, 'icemod' ) 
     135         CALL dia_nam ( clhstnam, nwrite, 'icemod_old' ) 
    129136         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice,   & 
    130137            &           nhorid, nice, domain_id=nidom, snc4chunks=snc4set ) 
    … …  
    158165            nhorida,                   & ! ? linked with horizontal ... 
    159166            nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file  
    160          CALL histvert( nicea, "icethi", "L levels",               & 
    161             "m", ipl , hi_mean , nz ) 
     167         CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz ) 
    162168         DO jl = 1, jpl 
    163169            zmaskitd(:,:,jl) = tmask(:,:,1) 
    … …  
    197203      zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 
    198204 
     205      ! Ice surface temperature and some fluxes 
    199206      DO jl = 1, jpl 
    200207         DO jj = 1, jpj 
    201208            DO ji = 1, jpi 
    202                zindh  = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) ) 
    203                zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
     209               zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
    204210               zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)  
    205211               zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl)  
    206                zcmo(ji,jj,27) = zcmo(ji,jj,27) + t_su(ji,jj,jl)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi16)*zinda 
     212               zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda*(t_su(ji,jj,jl)-rtt)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 
     213               zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06)  
    207214            END DO 
    208215         END DO 
    209216      END DO 
    210217 
     218      ! Mean sea ice temperature 
     219      CALL lim_var_icetm 
     220 
     221      ! Brine volume 
    211222      CALL lim_var_bv 
    212223 
    213224      DO jj = 2 , jpjm1 
    214225         DO ji = 2 , jpim1 
    215             zindh  = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) ) 
    216             zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
    217             zindb  = zindh * zinda 
     226            zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
     227            zindb  = MAX( zzero , SIGN( zone , at_i(ji,jj) ) ) 
    218228 
    219229            zcmo(ji,jj,1)  = at_i(ji,jj) 
    220             zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda 
    221             zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda 
    222             zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * 86400.0 * zinda    ! Bottom thermodynamic ice production 
    223             zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * 86400.0 * zinda    ! Dynamic ice production (rid/raft) 
    224             zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * 86400.0 * zinda    ! Lateral thermodynamic ice production 
    225             zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * 86400.0 * zinda    ! Snow ice production ice production 
    226             zcmo(ji,jj,24) = tm_i(ji,jj) - rtt 
    227  
    228             zcmo(ji,jj,6)  = fbif  (ji,jj) 
    229             zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 
    230             zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 
     230            zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 
     231            zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 
     232            zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * 86400.0     ! Bottom thermodynamic ice production 
     233            zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * 86400.0     ! Dynamic ice production (rid/raft) 
     234            zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * 86400.0     ! Lateral thermodynamic ice production 
     235            zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * 86400.0     ! Snow ice production ice production 
     236            zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda 
     237 
     238            zcmo(ji,jj,6)  = fbif(ji,jj)*at_i(ji,jj) 
     239            zcmo(ji,jj,7)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 
     240            zcmo(ji,jj,8)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 
    231241            zcmo(ji,jj,9)  = sst_m(ji,jj) 
    232242            zcmo(ji,jj,10) = sss_m(ji,jj) 
    … …  
    242252            zcmo(ji,jj,19) = sprecip(ji,jj) 
    243253            zcmo(ji,jj,20) = smt_i(ji,jj) 
    244             zcmo(ji,jj,21) = ot_i(ji,jj) 
    245254            zcmo(ji,jj,25) = et_i(ji,jj) 
    246255            zcmo(ji,jj,26) = et_s(ji,jj) 
    … …  
    249258 
    250259            zcmo(ji,jj,30) = bv_i(ji,jj) 
    251             zcmo(ji,jj,31) = hicol(ji,jj) 
     260            zcmo(ji,jj,31) = hicol(ji,jj) * zindb 
    252261            zcmo(ji,jj,32) = strength(ji,jj) 
    253262            zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  ) 
    254             zcmo(ji,jj,34) = diag_sur_me(ji,jj) * 86400.0 * zinda    ! Surface melt 
    255             zcmo(ji,jj,35) = diag_bot_me(ji,jj) * 86400.0 * zinda    ! Bottom melt 
     263            zcmo(ji,jj,34) = diag_sur_me(ji,jj) * 86400.0     ! Surface melt 
     264            zcmo(ji,jj,35) = diag_bot_me(ji,jj) * 86400.0     ! Bottom melt 
    256265            zcmo(ji,jj,36) = divu_i(ji,jj) 
    257266            zcmo(ji,jj,37) = shear_i(ji,jj) 
    258          END DO 
     267            zcmo(ji,jj,38) = diag_res_pr(ji,jj) * 86400.0     ! Bottom melt 
     268            zcmo(ji,jj,39) = vt_i(ji,jj)  ! ice volume 
     269            zcmo(ji,jj,40) = vt_s(ji,jj)  ! snow volume 
     270 
     271            zcmo(ji,jj,41) = fsalt_rpo(ji,jj) 
     272            zcmo(ji,jj,42) = fsalt_res(ji,jj) 
     273 
     274            zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * 86400.0     ! transport of ice volume 
     275 
     276        END DO 
    259277      END DO 
    260278 
    … …  
    285303      ENDIF 
    286304 
     305       CALL iom_put ('iceconc', zcmo(:,:,1) )          ! field1: ice concentration 
     306       CALL iom_put ('icethic_cea', zcmo(:,:,2) )      ! field2: ice thickness (i.e. icethi(:,:)) 
     307       CALL iom_put ('snowthic_cea', zcmo(:,:,3))      ! field3: snow thickness 
     308       CALL iom_put ('icebopr', zcmo(:,:,4) )   ! field4: daily bottom thermo ice production 
     309       CALL iom_put ('icedypr', zcmo(:,:,5) )   ! field5: daily dynamic ice production 
     310       CALL iom_put ('ioceflxb', zcmo(:,:,6) )         ! field6: Oceanic flux at the ice base 
     311       CALL iom_put ('uice_ipa', zcmo(:,:,7) )         ! field7: ice velocity u component 
     312       CALL iom_put ('vice_ipa', zcmo(:,:,8) )         ! field8: ice velocity v component 
     313       CALL iom_put ('isst', zcmo(:,:,9) )             ! field 9: sea surface temperature 
     314       CALL iom_put ('isss', zcmo(:,:,10) )            ! field 10: sea surface salinity 
     315       CALL iom_put ('qt_oc', zcmo(:,:,11) )           ! field 11: total flux at ocean surface 
     316       CALL iom_put ('qsr_oc', zcmo(:,:,12) )          ! field 12: solar flux at ocean surface 
     317       CALL iom_put ('qns_oc', zcmo(:,:,13) )          ! field 13: non-solar flux at ocean surface 
     318       !CALL iom_put ('hfbri', fhbri )                  ! field 14: heat flux due to brine release 
     319       CALL iom_put ('qsr_io', zcmo(:,:,17) )          ! field 17: solar flux at ice/ocean surface 
     320       CALL iom_put ('qns_io', zcmo(:,:,18) )          ! field 18: non-solar flux at ice/ocean surface 
     321       !CALL iom_put ('snowpre', zcmo(:,:,19) * 86400) ! field 19 :snow precip           
     322       CALL iom_put ('micesalt', zcmo(:,:,20) )        ! field 20 :mean ice salinity 
     323       CALL iom_put ('miceage', zcmo(:,:,21) / 365)    ! field 21: mean ice age 
     324       CALL iom_put ('icelapr',zcmo(:,:,22) )   ! field 22: daily lateral thermo ice prod. 
     325       CALL iom_put ('icesipr',zcmo(:,:,23) )   ! field 23: daily snowice ice prod. 
     326       CALL iom_put ('micet', zcmo(:,:,24) )           ! field 24: mean ice temperature 
     327       CALL iom_put ('icehc', zcmo(:,:,25) )           ! field 25: ice total heat content 
     328       CALL iom_put ('isnowhc', zcmo(:,:,26) )         ! field 26: snow total heat content 
     329       CALL iom_put ('icest', zcmo(:,:,27) )           ! field 27: ice surface temperature 
     330       CALL iom_put ('fsbri', zcmo(:,:,28) * 86400 )           ! field 28: brine salt flux 
     331       CALL iom_put ('fseqv', zcmo(:,:,29) * 86400 )           ! field 29: equivalent FW salt flux 
     332       CALL iom_put ('ibrinv', zcmo(:,:,30) *100 )     ! field 30: brine volume 
     333       CALL iom_put ('icecolf', zcmo(:,:,31) )         ! field 31: frazil ice collection thickness 
     334       CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 )  ! field 32: ice strength 
     335       CALL iom_put ('icevel', zcmo(:,:,33) )          ! field 33: ice velocity 
     336       CALL iom_put ('isume', zcmo(:,:,34) )    ! field 34: surface melt 
     337       CALL iom_put ('ibome', zcmo(:,:,35) )     ! field 35: bottom melt 
     338       CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8)    ! field 36: divergence 
     339       CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 )  ! field 37: shear 
     340       CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate 
     341       CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume 
     342       CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume 
     343       CALL iom_put ('fsrpo', zcmo(:,:,41) * 86400 )           ! field 41: salt flux from ridging rafting 
     344       CALL iom_put ('fsres', zcmo(:,:,42) * 86400 )           ! field 42: salt flux from limupdate (resultant) 
     345       CALL iom_put ('icetrp', zcmo(:,:,43) )    ! field 43: ice volume transport 
     346 
    287347      !----------------------------- 
    288348      ! Thickness distribution file 
    … …  
    302362            DO jj = 1, jpj 
    303363               DO ji = 1, jpi 
    304                   zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 
    305                   zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * zinda 
     364                  zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
     365                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda 
    306366               END DO 
    307367            END DO 
    … …  
    314374               DO jj = 1, jpj 
    315375                  DO ji = 1, jpi 
    316                      zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) ) 
     376                     zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
    317377                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
    318                         ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * & 
     378                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & 
    319379                        zinda / nlay_i 
    320380                  END DO 
    … …  
    348408      CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    349409      CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 
     410 
     411      IF( nn_timing == 1 )  CALL timing_stop('limwri') 
    350412       
    351413   END SUBROUTINE lim_wri 
    … …  
    381443         field_25, field_26, field_27, field_28, field_29, field_30,   & 
    382444         field_31, field_32, field_33, field_34, field_35, field_36,   & 
    383          field_37 
     445         field_37, field_38, field_39, field_40, field_41, field_42, field_43 
    384446 
    385447      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 
    … …  
    392454         field_25, field_26, field_27, field_28, field_29, field_30,   & 
    393455         field_31, field_32, field_33, field_34, field_35, field_36,   & 
    394          field_37, add_diag_swi 
     456         field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi 
    395457      !!------------------------------------------------------------------- 
    396458 
    … …  
    435497      zfield(36) = field_36 
    436498      zfield(37) = field_37 
     499      zfield(38) = field_38 
     500      zfield(39) = field_39 
     501      zfield(40) = field_40 
     502      zfield(41) = field_41 
     503      zfield(42) = field_42 
     504      zfield(43) = field_43 
    437505 
    438506      DO nf = 1, noumef 
    … …  
    460528      ! 
    461529   END SUBROUTINE lim_wri_init 
     530  
     531   SUBROUTINE lim_wri_state( kt, kid, kh_i ) 
     532      !!--------------------------------------------------------------------- 
     533      !!                 ***  ROUTINE lim_wri_state  *** 
     534      !!         
     535      !! ** Purpose :   create a NetCDF file named cdfile_name which contains  
     536      !!      the instantaneous ice state and forcing fields for ice model 
     537      !!        Used to find errors in the initial state or save the last 
     538      !!      ocean state in case of abnormal end of a simulation 
     539      !! 
     540      !! History : 
     541      !!   4.1  !  2013-06  (C. Rousset) 
     542      !!---------------------------------------------------------------------- 
     543      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index) 
     544      INTEGER, INTENT( in ) ::   kid , kh_i        
     545      !!---------------------------------------------------------------------- 
     546      !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz ) 
     547 
     548      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     549      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     550      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     551      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     552      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     553      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     554      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     555      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     556      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     557      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     558      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     559      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     560      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     561 
     562      !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     563      !CALL histdef( kid, "iice_hid", "Ice thickness by cat"    , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     564      !CALL histdef( kid, "iice_hsd", "Snow thickness by cat"   , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     565      !CALL histdef( kid, "iice_std", "Ice salinity by cat"     , "PSU"    , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     566 
     567      CALL histend( kid, snc4set )   ! end of the file definition 
     568 
     569      CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )     
     570      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) ) 
     571      CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) ) 
     572      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) ) 
     573      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) ) 
     574      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) ) 
     575      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) ) 
     576      CALL histwrite( kid, "iicesflx", kt, qsr , jpi*jpj, (/1/) ) 
     577      CALL histwrite( kid, "iicenflx", kt, qns , jpi*jpj, (/1/) ) 
     578      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) ) 
     579      CALL histwrite( kid, "iicesali", kt, smt_i          , jpi*jpj, (/1/) ) 
     580      CALL histwrite( kid, "iicevolu", kt, vt_i           , jpi*jpj, (/1/) ) 
     581      CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) ) 
     582 
     583      !CALL histwrite( kid, "iice_itd", kt, a_i  , jpi*jpj*jpl, (/1/)  )   ! area 
     584      !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/)  )   ! thickness 
     585      !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/)  )   ! snow depth 
     586      !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/)  )   ! salinity 
     587 
     588    END SUBROUTINE lim_wri_state 
    462589 
    463590#else 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90

    r2715 r3938  
    111111         zcmo(ji,jj,13) = qns(ji,jj) 
    112112         ! See thersf for the coefficient 
    113          zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     113         zcmo(ji,jj,14) = - emps(ji,jj) * rday     ! converted in Kg/m2/day = mm/day 
    114114         zcmo(ji,jj,15) = utau_ice(ji,jj) 
    115115         zcmo(ji,jj,16) = vtau_ice(ji,jj) 
    … …  
    154154               rcmoy(ji,jj,13) = qns(ji,jj) 
    155155               ! See thersf for the coefficient 
    156                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 
     156               rcmoy(ji,jj,14) = - emps(ji,jj) * rday     ! converted in Kg/m2/day = mm/day 
    157157               rcmoy(ji,jj,15) = utau_ice(ji,jj) 
    158158               rcmoy(ji,jj,16) = vtau_ice(ji,jj) 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r2715 r3938  
    2222   REAL(wp), PUBLIC ::   hicmin  = 0.2       !: (REMOVE) 
    2323   REAL(wp), PUBLIC ::   hiclim  = 0.05      !: minimum ice thickness 
    24    REAL(wp), PUBLIC ::   amax    = 0.999     !: maximum lead fraction 
    2524   REAL(wp), PUBLIC ::   sbeta   = 1.0       !: numerical scheme for diffusion in ice  (REMOVE) 
    2625   REAL(wp), PUBLIC ::   parlat  = 0.0       !: (REMOVE) 
    … …  
    8382   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
    8483   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m] 
    85     REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::  old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
    8685   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsbri_1d      !: Salt flux due to brine drainage 
    8786   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage 
    … …  
    108107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days] 
    109108 
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
     111 
    110112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s 
    111113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i 
    … …  
    157159         &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     & 
    158160         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     & 
    159          &      qfvbq_1d (jpij) , t_bo_b   (jpij)                     , STAT=ierr(1) ) 
     161         &      qfvbq_1d (jpij) , t_bo_b   (jpij) , iatte_1d   (jpij) ,     & 
     162         &      oatte_1d (jpij)                                       , STAT=ierr(1) ) 
    160163      ! 
    161164      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     & 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r3294 r3938  
    88   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions 
    99   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
     10   !!             -   !  2012-01  (C. Rousset) add ice boundary conditions for lim3 
    1011   !!---------------------------------------------------------------------- 
    1112#if defined key_bdy  
    … …  
    4445      REAL, POINTER, DIMENSION(:)     ::  hicif 
    4546      REAL, POINTER, DIMENSION(:)     ::  hsnif 
     47#elif defined key_lim3 
     48      REAL, POINTER, DIMENSION(:,:)   ::  a_i   !: now ice leads fraction climatology 
     49      REAL, POINTER, DIMENSION(:,:)   ::  ht_i  !: Now ice  thickness climatology 
     50      REAL, POINTER, DIMENSION(:,:)   ::  ht_s  !: now snow thickness 
    4651#endif 
    4752   END TYPE OBC_DATA 
    … …  
    7378   INTEGER, DIMENSION(jp_bdy) ::   nn_tra_dta             !: = 0 use the initial state as bdy dta ;  
    7479                                                            !: = 1 read it in a NetCDF file 
    75 #if defined key_lim2 
    76    INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables  
    77    INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2_dta          !: = 0 use the initial state as bdy dta ;  
     80#if ( defined key_lim2 || defined key_lim3 ) 
     81   INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim               ! Choice of boundary condition for sea ice variables  
     82   INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim_dta           !: = 0 use the initial state as bdy dta ;  
    7883                                                            !: = 1 read it in a NetCDF file 
    7984#endif 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r3294 r3938  
    1111   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions 
    1212   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
     13   !!             -   !  2012-01  (C. Rousset) add ice boundary conditions for lim3 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_bdy 
    … …  
    3132#if defined key_lim2 
    3233   USE ice_2 
     34#elif defined key_lim3 
     35   USE par_ice 
     36   USE ice 
     37   USE limcat_1D          ! redistribute ice input into categories 
    3338#endif 
    3439 
    … …  
    4853 
    4954   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
     55 
     56#if defined key_lim3 
     57   LOGICAL :: ll_bdylim3                  ! determine whether ice input is lim2 (F) or lim3 (T) type 
     58   INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure 
     59#endif 
    5060 
    5161#  include "domzgr_substitute.h90" 
    … …  
    7686                                                        ! etc. 
    7787      !! 
    78       INTEGER     ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd  ! local indices 
     88      INTEGER     ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices 
    7989      INTEGER,          DIMENSION(jpbgrd) ::   ilen1  
    8090      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts 
    … …  
    175185 
    176186#if defined key_lim2 
    177             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN  
    178                IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     187            IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN  
     188               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
    179189                  ilen1(:) = nblen(:) 
    180190               ELSE 
    … …  
    185195                  ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    186196                  ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    187                   dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
     197                  dta_bdy(ib_bdy)%frld (ib) = frld(ii,ij) * tmask(ii,ij,1)          
    188198                  dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
    189199                  dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
    190200               END DO  
     201            ENDIF 
     202#elif defined key_lim3 
     203            IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN  
     204               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
     205                  ilen1(:) = nblen(:) 
     206               ELSE 
     207                  ilen1(:) = nblenrim(:) 
     208               ENDIF 
     209               igrd = 1                       ! Everything is at T-points here 
     210               DO jl = 1, jpl 
     211                  DO ib = 1, ilen1(igrd) 
     212                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     213                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     214                     dta_bdy(ib_bdy)%a_i (ib,jl) =  a_i(ii,ij,jl) * tmask(ii,ij,1)  
     215                     dta_bdy(ib_bdy)%ht_i(ib,jl) = ht_i(ii,ij,jl) * tmask(ii,ij,1)  
     216                     dta_bdy(ib_bdy)%ht_s(ib,jl) = ht_s(ii,ij,jl) * tmask(ii,ij,1)  
     217                  END DO 
     218               END DO 
    191219            ENDIF 
    192220#endif 
    … …  
    237265                  CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), time_offset=time_offset ) 
    238266               ENDIF 
     267 
     268#if defined key_lim3 
     269               IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN ! bdy ice input 
     270                IF ( .NOT. ll_bdylim3 ) THEN ! case input is lim2 type 
     271                   CALL lim_cat_1D ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 
     272                                     & dta_bdy(ib_bdy)%ht_i,     dta_bdy(ib_bdy)%ht_s,     dta_bdy(ib_bdy)%a_i     ) 
     273                ENDIF 
     274               ENDIF 
     275#endif 
     276 
    239277            ENDIF 
    240278            jstart = jend+1 
    … …  
    311349      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V) 
    312350      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts 
     351#if defined key_lim3 
     352      INTEGER, DIMENSION(3) ::   zdimsz   ! number of elements in each of the 4 dimensions (i.e. i,j,t,ice-cat) for an array 
     353      INTEGER               ::   zndims   ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat) 
     354      INTEGER               ::   inum,id1 ! local integer 
     355#endif 
    313356      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures 
    314357      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
    315358      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    316359#if defined key_lim2 
    317       TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      ! 
     360      TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif       
     361#elif defined key_lim3 
     362      TYPE(FLD_N) ::   bn_a_i, bn_ht_i, bn_ht_s       
    318363#endif 
    319364      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
    320365#if defined key_lim2 
    321366      NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif 
     367#elif defined key_lim3 
     368      NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s 
    322369#endif 
    323370      NAMELIST/nambdy_dta/ ln_full_vel 
    … …  
    326373      IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init') 
    327374 
    328       ! Set nn_dta 
     375      ! Set nn_dta to 0 or 1 
    329376      DO ib_bdy = 1, nb_bdy 
    330          nn_dta(ib_bdy) = MAX(  nn_dyn2d_dta(ib_bdy)       & 
    331                                ,nn_dyn3d_dta(ib_bdy)       & 
    332                                ,nn_tra_dta(ib_bdy)         & 
    333 #if defined key_lim2 
    334                                ,nn_ice_lim2_dta(ib_bdy)    & 
     377         nn_dta(ib_bdy) = MAX( nn_dyn2d_dta(ib_bdy)       & 
     378                              ,nn_dyn3d_dta(ib_bdy)       & 
     379                              ,nn_tra_dta(ib_bdy)         & 
     380#if ( defined key_lim2 || defined key_lim3 ) 
     381                              ,nn_ice_lim_dta(ib_bdy)    & 
    335382#endif 
    336383                              ) 
    … …  
    352399            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    353400         ENDIF 
    354 #if defined key_lim2 
    355          IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN 
     401#if ( defined key_lim2 || defined key_lim3 ) 
     402         IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 1  ) THEN 
    356403            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    357404         ENDIF 
    … …  
    377424      ALLOCATE( igrid(nb_bdy_fld_sum) )  
    378425 
    379       ! Read namelists 
     426     ! Read namelists 
    380427      ! -------------- 
    381428      REWIND(numnam) 
    … …  
    387434            ln_full_vel = .false. 
    388435            ! ... default values (NB: frequency positive => hours, negative => months) 
    389             !                    !  file       ! frequency !  variable   ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
    390             !                    !  name       ! hours !   name     !  (T/F)  !  (T/F)  !  'monthly'  ! filename ! pairs     ! 
    391             bn_ssh     = FLD_N(  'bdy_ssh'     ,  24   , 'sossheig' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    392             bn_u2d     = FLD_N(  'bdy_vel2d_u' ,  24   , 'vobtcrtx' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    393             bn_v2d     = FLD_N(  'bdy_vel2d_v' ,  24   , 'vobtcrty' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    394             bn_u3d     = FLD_N(  'bdy_vel3d_u' ,  24   , 'vozocrtx' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    395             bn_v3d     = FLD_N(  'bdy_vel3d_v' ,  24   , 'vomecrty' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    396             bn_tem     = FLD_N(  'bdy_tem'     ,  24   , 'votemper' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    397             bn_sal     = FLD_N(  'bdy_sal'     ,  24   , 'vosaline' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
     436            !                 !  file       ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
     437            !                 !  name       ! hours     !   name     !  (T/F)     !  (T/F)  !  'monthly'  ! filename ! pairs     ! 
     438            bn_ssh   = FLD_N(  'bdy_ssh'     ,  24      , 'sossheig' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     439            bn_u2d   = FLD_N(  'bdy_vel2d_u' ,  24      , 'vobtcrtx' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     440            bn_v2d   = FLD_N(  'bdy_vel2d_v' ,  24      , 'vobtcrty' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     441            bn_u3d   = FLD_N(  'bdy_vel3d_u' ,  24      , 'vozocrtx' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     442            bn_v3d   = FLD_N(  'bdy_vel3d_v' ,  24      , 'vomecrty' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     443            bn_tem   = FLD_N(  'bdy_tem'     ,  24      , 'votemper' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     444            bn_sal   = FLD_N(  'bdy_sal'     ,  24      , 'vosaline' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
    398445#if defined key_lim2 
    399             bn_frld    = FLD_N(  'bdy_frld'    ,  24   , 'ildsconc' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    400             bn_hicif   = FLD_N(  'bdy_hicif'   ,  24   , 'iicethic' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    401             bn_hsnif   = FLD_N(  'bdy_hsnif'   ,  24   , 'isnothic' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
     446            bn_frld  = FLD_N(  'bdy_frld'    ,  24      , 'ildsconc' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     447            bn_hicif = FLD_N(  'bdy_hicif'   ,  24      , 'iicethic' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     448            bn_hsnif = FLD_N(  'bdy_hsnif'   ,  24      , 'isnothic' , .false.    , .false. ,   'yearly'  , ''       , ''        ) 
     449#elif defined key_lim3 
     450            bn_a_i  = FLD_N(  'bdy_a_i'     ,  24   , 'ileadfra' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
     451            bn_ht_i = FLD_N(  'bdy_ht_i'    ,  24   , 'iicethic' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
     452            bn_ht_s = FLD_N(  'bdy_ht_s'    ,  24   , 'isnowthi' , .false. , .false. ,   'yearly'  , ''       , ''        ) 
    402453#endif 
    403454 
    … …  
    515566#if defined key_lim2 
    516567            ! sea ice 
    517             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 
     568            IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 
    518569 
    519570               jfld = jfld + 1 
    … …  
    521572               ibdy(jfld) = ib_bdy 
    522573               igrid(jfld) = 1 
    523                IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     574               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
    524575                  ilen1(jfld) = nblen(igrid(jfld)) 
    525576               ELSE 
    … …  
    532583               ibdy(jfld) = ib_bdy 
    533584               igrid(jfld) = 1 
    534                IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     585               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
    535586                  ilen1(jfld) = nblen(igrid(jfld)) 
    536587               ELSE 
    … …  
    543594               ibdy(jfld) = ib_bdy 
    544595               igrid(jfld) = 1 
    545                IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     596               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
    546597                  ilen1(jfld) = nblen(igrid(jfld)) 
    547598               ELSE 
    … …  
    549600               ENDIF 
    550601               ilen3(jfld) = 1 
     602 
     603            ENDIF 
     604#elif defined key_lim3 
     605            ! sea ice 
     606            IF( nn_ice_lim(ib_bdy) .gt. 0 .and. nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 
     607 
     608               ! Test for types of ice input (lim2 or lim3)  
     609               CALL iom_open ( bn_a_i%clname, inum ) 
     610               id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
     611               CALL iom_close ( inum ) 
     612               !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 
     613               !CALL iom_open ( bn_a_i%clname, inum ) 
     614               !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
     615                IF ( zndims == 4 ) THEN 
     616                 ll_bdylim3 = .TRUE. 
     617               ELSE 
     618                 ll_bdylim3 = .FALSE.         
     619               ENDIF 
     620               ! End test 
     621 
     622               jfld = jfld + 1 
     623               blf_i(jfld) = bn_a_i 
     624               ibdy(jfld) = ib_bdy 
     625               igrid(jfld) = 1 
     626               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
     627                  ilen1(jfld) = nblen(igrid(jfld)) 
     628               ELSE 
     629                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     630               ENDIF 
     631               IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF 
     632 
     633               jfld = jfld + 1 
     634               blf_i(jfld) = bn_ht_i 
     635               ibdy(jfld) = ib_bdy 
     636               igrid(jfld) = 1 
     637               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
     638                  ilen1(jfld) = nblen(igrid(jfld)) 
     639               ELSE 
     640                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     641               ENDIF 
     642               IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF 
     643 
     644               jfld = jfld + 1 
     645               blf_i(jfld) = bn_ht_s 
     646               ibdy(jfld) = ib_bdy 
     647               igrid(jfld) = 1 
     648               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
     649                  ilen1(jfld) = nblen(igrid(jfld)) 
     650               ELSE 
     651                  ilen1(jfld) = nblenrim(igrid(jfld)) 
     652               ENDIF 
     653               IF ( ll_bdylim3 ) THEN ; ilen3(jfld)=jpl ; ELSE ; ilen3(jfld)=1 ; ENDIF 
    551654 
    552655            ENDIF 
    … …  
    652755 
    653756#if defined key_lim2 
    654          IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN 
    655             IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 
    656                IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN 
     757         IF (nn_ice_lim(ib_bdy) .gt. 0) THEN 
     758            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN 
     759               IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
    657760                  ilen0(1:3) = nblen(1:3) 
    658761               ELSE 
    … …  
    669772               jfld = jfld + 1 
    670773               dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1) 
     774            ENDIF 
     775         ENDIF 
     776#elif defined key_lim3 
     777         IF (nn_ice_lim(ib_bdy) .gt. 0) THEN 
     778            IF( nn_ice_lim(ib_bdy) .eq. jp_frs ) THEN 
     779               ilen0(1:3) = nblen(1:3) 
     780            ELSE 
     781               ilen0(1:3) = nblenrim(1:3) 
     782            ENDIF 
     783            IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN 
     784               ALLOCATE( dta_bdy(ib_bdy)%a_i (ilen0(1),jpl) ) 
     785               ALLOCATE( dta_bdy(ib_bdy)%ht_i(ilen0(1),jpl) ) 
     786               ALLOCATE( dta_bdy(ib_bdy)%ht_s(ilen0(1),jpl) ) 
     787            ELSE 
     788               IF ( ll_bdylim3 ) THEN 
     789                  jfld = jfld + 1 
     790                  dta_bdy(ib_bdy)%a_i  => bf(jfld)%fnow(:,1,:) 
     791                  jfld = jfld + 1 
     792                  dta_bdy(ib_bdy)%ht_i => bf(jfld)%fnow(:,1,:) 
     793                  jfld = jfld + 1 
     794                  dta_bdy(ib_bdy)%ht_s => bf(jfld)%fnow(:,1,:) 
     795               ELSE 
     796                  jfld    = jfld + 1                   
     797                  jfld_ai = jfld 
     798                  ALLOCATE( dta_bdy(ib_bdy)%a_i (ilen0(1),jpl) ) 
     799                  dta_bdy(ib_bdy)%a_i(:,:) = 0.0 
     800                  jfld     = jfld + 1                   
     801                  jfld_hti = jfld 
     802                  ALLOCATE( dta_bdy(ib_bdy)%ht_i(ilen0(1),jpl) ) 
     803                  dta_bdy(ib_bdy)%ht_i(:,:) = 0.0 
     804                  jfld     = jfld + 1                   
     805                  jfld_hts = jfld 
     806                  ALLOCATE( dta_bdy(ib_bdy)%ht_s(ilen0(1),jpl) ) 
     807                  dta_bdy(ib_bdy)%ht_s(:,:) = 0.0 
     808               ENDIF 
     809 
    671810            ENDIF 
    672811         ENDIF 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r3298 r3938  
    6969      REAL   , POINTER  ::  flagu, flagv                   !    -   - 
    7070      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars 
    71       INTEGER, DIMENSION (2)                ::   kdimsz 
     71      INTEGER, DIMENSION (1)                ::   kdimsz 
    7272      INTEGER, DIMENSION(jpbgrd,jp_bdy)       ::   nblendta         ! Length of index arrays  
    7373      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbidta, nbjdta   ! Index arrays: i and j indices of bdy dta 
    7474      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbrdta           ! Discrete distance from rim points 
     75      REAL, ALLOCATABLE, DIMENSION(:)         ::   znblendta            
    7576      REAL(wp), DIMENSION(jpidta,jpjdta)    ::   zmask            ! global domain mask 
    7677      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile 
    … …  
    8081         &             ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta, & 
    8182         &             nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta,         &   
    82 #if defined key_lim2 
    83          &             nn_ice_lim2, nn_ice_lim2_dta,                       & 
     83#if ( defined key_lim2 || defined key_lim3 ) 
     84         &             nn_ice_lim, nn_ice_lim_dta,                       & 
    8485#endif 
    8586         &             ln_vol, nn_volctl, nn_rimwidth 
    … …  
    121122      nn_tra(:)         = 0 
    122123      nn_tra_dta(:)     = -1  ! uninitialised flag 
    123 #if defined key_lim2 
    124       nn_ice_lim2(:)    = 0 
    125       nn_ice_lim2_dta(:)= -1  ! uninitialised flag 
     124#if ( defined key_lim2 || defined key_lim3 ) 
     125      nn_ice_lim(:)    = 0 
     126      nn_ice_lim_dta(:)= -1  ! uninitialised flag 
    126127#endif 
    127128      ln_vol            = .false. 
    … …  
    204205        IF(lwp) WRITE(numout,*) 
    205206 
    206 #if defined key_lim2 
     207#if ( defined key_lim2 || defined key_lim3 ) 
    207208        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    208         SELECT CASE( nn_ice_lim2(ib_bdy) )                   
     209        SELECT CASE( nn_ice_lim(ib_bdy) )                   
    209210          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    210211          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    211212          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
    212213        END SELECT 
    213         IF( nn_ice_lim2(ib_bdy) .gt. 0 ) THEN  
    214            SELECT CASE( nn_ice_lim2_dta(ib_bdy) )                   !  
     214        IF( nn_ice_lim(ib_bdy) .gt. 0 ) THEN  
     215           SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   !  
    215216              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    216217              CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    217               CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim2_dta must be 0 or 1' ) 
     218              CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' ) 
    218219           END SELECT 
    219220        ENDIF 
    … …  
    327328            DO igrd = 1, jpbgrd 
    328329               id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )   
    329                nblendta(igrd,ib_bdy) = kdimsz(1) 
    330                jpbdta = MAX(jpbdta, kdimsz(1)) 
    331             ENDDO 
     330               !clem nblendta(igrd,ib_bdy) = kdimsz(1) 
     331               !clem jpbdta = MAX(jpbdta, kdimsz(1)) 
     332               nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 
     333               jpbdta = MAX(jpbdta, MAXVAL(kdimsz)) 
     334            ENDDO 
     335            CALL iom_close( inum ) 
    332336 
    333337         ENDIF  
    … …  
    505509            ENDDO 
    506510 
    507          ELSE            ! Read global index arrays from boundary coordinates file. 
    508  
    509             DO igrd = 1, jpbgrd 
    510                CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     511         ELSE            ! Read global index arrays from boundary coordinates file 
     512 
     513          CALL iom_open( cn_coords_file(ib_bdy), inum ) 
     514          DO igrd = 1, jpbgrd 
     515               ALLOCATE(znblendta(nblendta(igrd,ib_bdy))) 
     516 
     517               CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), znblendta(1:nblendta(igrd,ib_bdy)) ) 
    511518               DO ii = 1,nblendta(igrd,ib_bdy) 
    512                   nbidta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     519                  nbidta(ii,igrd,ib_bdy) = INT( znblendta(ii) ) 
    513520               END DO 
    514                CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     521               CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), znblendta(1:nblendta(igrd,ib_bdy)) ) 
    515522               DO ii = 1,nblendta(igrd,ib_bdy) 
    516                   nbjdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     523                  nbjdta(ii,igrd,ib_bdy) = INT( znblendta(ii) ) 
    517524               END DO 
    518                CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), dta_global(1:nblendta(igrd,ib_bdy),:,1) ) 
     525               CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), znblendta(1:nblendta(igrd,ib_bdy)) ) 
    519526               DO ii = 1,nblendta(igrd,ib_bdy) 
    520                   nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
     527                  nbrdta(ii,igrd,ib_bdy) = INT( znblendta(ii) ) 
    521528               END DO 
    522529 
    523                ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) ) 
     530               ibr_max = MAXVAL( nbrdta(1:nblendta(igrd,ib_bdy),igrd,ib_bdy) ) 
     531               !WRITE(numout,*) nbrdta(1:nblendta(igrd,ib_bdy),igrd,ib_bdy) 
    524532               IF(lwp) WRITE(numout,*) 
    525533               IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 
    … …  
    527535               IF (ibr_max < nn_rimwidth(ib_bdy))   & 
    528536                     CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file',cn_coords_file(ib_bdy) ) 
    529  
     537               DEALLOCATE(znblendta) 
    530538            END DO 
    531539            CALL iom_close( inum ) 
    … …  
    680688      tmask_i (:,:) = tmask(:,:,1) * tmask_i(:,:)              
    681689      bdytmask(:,:) = tmask(:,:,1) 
     690      bdyumask(:,:) = umask(:,:,1) 
     691      bdyvmask(:,:) = vmask(:,:,1) 
    682692 
    683693      ! bdy masks and bmask are now set to zero on boundary points: 
    … …  
    803813 
    804814      IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 
    805  
    806815   END SUBROUTINE bdy_init 
    807816 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r3294 r3938  
    99   !!            3.3  !  2010-09  (D.Storkey and E.O'Dea)  bug fixes 
    1010   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
     11   !!             -   !  2012-02  (C. Rousset) tides reordered  
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_bdy 
    … …  
    8990      NAMELIST/nambdy_tide/ln_tide_date, filtide, tide_cpt, tide_speed 
    9091      !!---------------------------------------------------------------------- 
    91  
    92       IF( nn_timing == 1 ) CALL timing_start('tide_init') 
     92      IF( nn_timing == 1 ) CALL timing_start('bdy-tide_init') 
    9393 
    9494      IF(lwp) WRITE(numout,*) 
    … …  
    125125            DO itide = 1, td%ncpt 
    126126               nindx(itide) = 0 
    127                IF( TRIM( tide_cpt(itide) ) == 'Q1'  )   nindx(itide) =  1 
    128                IF( TRIM( tide_cpt(itide) ) == 'O1'  )   nindx(itide) =  2 
    129                IF( TRIM( tide_cpt(itide) ) == 'P1'  )   nindx(itide) =  3 
    130                IF( TRIM( tide_cpt(itide) ) == 'S1'  )   nindx(itide) =  4 
     127               IF( TRIM( tide_cpt(itide) ) == 'M2'  )   nindx(itide) =  1 
     128               IF( TRIM( tide_cpt(itide) ) == 'S2'  )   nindx(itide) =  2 
     129               IF( TRIM( tide_cpt(itide) ) == 'N2'  )   nindx(itide) =  3 
     130               IF( TRIM( tide_cpt(itide) ) == 'K2'  )   nindx(itide) =  4 
    131131               IF( TRIM( tide_cpt(itide) ) == 'K1'  )   nindx(itide) =  5 
    132                IF( TRIM( tide_cpt(itide) ) == '2N2' )   nindx(itide) =  6 
    133                IF( TRIM( tide_cpt(itide) ) == 'MU2' )   nindx(itide) =  7 
    134                IF( TRIM( tide_cpt(itide) ) == 'N2'  )   nindx(itide) =  8 
    135                IF( TRIM( tide_cpt(itide) ) == 'NU2' )   nindx(itide) =  9 
    136                IF( TRIM( tide_cpt(itide) ) == 'M2'  )   nindx(itide) = 10 
    137                IF( TRIM( tide_cpt(itide) ) == 'L2'  )   nindx(itide) = 11 
    138                IF( TRIM( tide_cpt(itide) ) == 'T2'  )   nindx(itide) = 12 
    139                IF( TRIM( tide_cpt(itide) ) == 'S2'  )   nindx(itide) = 13 
    140                IF( TRIM( tide_cpt(itide) ) == 'K2'  )   nindx(itide) = 14 
     132               IF( TRIM( tide_cpt(itide) ) == 'O1' )   nindx(itide) =  6 
     133               IF( TRIM( tide_cpt(itide) ) == 'P1' )   nindx(itide) =  7 
     134               IF( TRIM( tide_cpt(itide) ) == 'Q1'  )   nindx(itide) =  8 
     135               IF( TRIM( tide_cpt(itide) ) == 'S1' )   nindx(itide) =  9 
     136               IF( TRIM( tide_cpt(itide) ) == '2N2' )   nindx(itide) = 10  
     137               IF( TRIM( tide_cpt(itide) ) == 'MU2' )   nindx(itide) = 11  
     138               IF( TRIM( tide_cpt(itide) ) == 'NU2' )   nindx(itide) = 12  
     139               IF( TRIM( tide_cpt(itide) ) == 'L2'  )   nindx(itide) = 13 
     140               IF( TRIM( tide_cpt(itide) ) == 'T2'  )   nindx(itide) = 14 
    141141               IF( TRIM( tide_cpt(itide) ) == 'M4'  )   nindx(itide) = 15 
    142142               IF( nindx(itide) == 0  .AND. lwp ) THEN 
    … …  
    225225                  ! 
    226226                  IF( nindx(itide) /= 0 ) THEN 
    227 !!gm use rpi  and rad global variable   
    228                      z_arg = 3.14159265d0 * z_vplu(nindx(itide)) / 180.0d0 
     227                     z_arg = rad * z_vplu(nindx(itide)) 
    229228                     z_atde=z_ftc(nindx(itide))*cos(z_arg) 
    230229                     z_btde=z_ftc(nindx(itide))*sin(z_arg) 
    … …  
    268267      END DO ! loop on ib_bdy 
    269268 
    270       IF( nn_timing == 1 ) CALL timing_stop('tide_init') 
     269      IF( nn_timing == 1 ) CALL timing_stop('bdy-tide_init') 
    271270 
    272271   END SUBROUTINE tide_init 
    … …  
    299298      !!---------------------------------------------------------------------- 
    300299 
    301       IF( nn_timing == 1 ) CALL timing_start('tide_update') 
     300      IF( nn_timing == 1 ) CALL timing_start('bdy-tide_update') 
    302301 
    303302      time_add = 0 
    … …  
    338337      END DO 
    339338      ! 
    340       IF( nn_timing == 1 ) CALL timing_stop('tide_update') 
     339      IF( nn_timing == 1 ) CALL timing_stop('bdy-tide_update') 
    341340      ! 
    342341   END SUBROUTINE tide_update 
    … …  
    361360      CHARACTER(len=8), DIMENSION(nc) :: cname 
    362361      INTEGER                 ::   year, vd, ivdy, ndc, i, k 
    363       REAL(wp)                ::   ss, h, p, en, p1, rtd 
     362      REAL(wp)                ::   ss, h, p, en, p1 
    364363      REAL(wp), DIMENSION(nc) ::   f                          ! nodal correction 
    365364      REAL(wp), DIMENSION(nc) ::   z_vplu                     ! phase correction 
    366365      REAL(wp), DIMENSION(nc) ::   u, v, zig 
    367366      !! 
    368       DATA cname/  'q1'    ,    'o1'    ,     'p1'   ,    's1'    ,     'k1'    ,   & 
    369          &         '2n2'   ,    'mu2'   ,     'n2'   ,    'nu2'   ,     'm2'    ,   & 
    370          &         'l2'    ,    't2'    ,     's2'   ,    'k2'    ,     'm4'      / 
    371       DATA zig/ .2338507481, .2433518789, .2610826055, .2617993878,  .2625161701,  & 
    372          &      .4868657873, .4881373225, .4963669182, .4976384533,  .5058680490,  & 
    373          &      .5153691799, .5228820265, .5235987756, .5250323419, 1.011736098  / 
     367      DATA cname/  'm2'   ,    's2'   ,     'n2'   ,    'k2'   ,     'k1'    ,   & 
     368         &         'o1'   ,    'p1'   ,     'q1'   ,    's1'   ,     '2n2'   ,   & 
     369         &         'mu2'  ,    'nu2'  ,     'l2'   ,    't2'   ,     'm4'      / 
     370      DATA zig/ .5058680490, .5235987756, .4963669182, .5250323419, .2625161701, & 
     371                .2433518789, .2610826055, .2338507481, .2617993878, .4868657873, & 
     372                .4881373225, .4976384533, .5153691799, .5228820265, 1.011736098 / 
    374373      !!---------------------------------------------------------------------- 
    375374! 
    … …  
    389388      ndc = nc 
    390389!.....ndc   =  number of constituents allowed 
    391 !!gm use rpi ? 
    392       rtd = 360.0 / 6.2831852 
    393390      DO i = 1, ndc 
    394          zig(i) = zig(i)*rtd 
     391         zig(i) = zig(i) / rad 
    395392         ! sigo(i)= zig(i) 
    396393      END DO 
    … …  
    535532! 
    536533!!gm   precision of the computation   :  example for s it should be replace by: 
    537 !!gm  s   = 218.3165 + (481267.8813 - 0.0016*t)*t + 152.0*deltat   ==>  more precise  modify the last digits results 
    538       s   = 218.3165 + 481267.8813*t - 0.0016*t*t + 152.0*deltat 
    539       h   = 280.4661 + 36000.7698 *t + 0.0003*t*t +  11.0*deltat 
    540       p   =  83.3535 + 4069.0139  *t - 0.0103*t*t +       deltat 
    541       en  = 234.9555 + 1934.1363  *t - 0.0021*t*t +       deltat 
    542       p1  = 282.9384 + 1.7195     *t + 0.0005*t*t 
     534      s   = 218.3165 + (481267.8813 - 0.0016*t)*t + 152.0*deltat 
     535      h   = 280.4661 + (36000.7698  + 0.0003*t)*t +  11.0*deltat 
     536      p   =  83.3535 + (4069.0139   - 0.0103*t)*t +       deltat 
     537      en  = 234.9555 + (1934.1363   - 0.0021*t)*t +       deltat 
     538      p1  = 282.9384 + (1.7195      + 0.0005*t)*t 
    543539      ! 
    544540      nn = s / cycle 
    … …  
    579575      !! 
    580576       
    581 !!gm  rad is already a public variable defined in phycst.F90 ....   ==> doctor norme  local real start with "z" 
    582       REAL(wp) ::   w1, w2, w3, w4, w5, w6, w7, w8, nw, pw, rad 
     577      REAL(wp) ::   w1, w2, w3, w4, w5, w6, w7, w8, nw, pw 
    583578      REAL(wp) ::   a(nc), b(nc) 
    584579      INTEGER  ::   ndc, k 
    … …  
    589584!    a=f       ,  b =u 
    590585!    t is  zero as compared to tifa. 
    591 !! use rad defined in phycst   (i.e.  add a USE phycst at the begining of the module 
    592       rad = 6.2831852d0/360.0 
    593586      pw = p  * rad 
    594587      nw = cn * rad 
    … …  
    604597         &    - 0.0156 * SIN( 2*pw-2*nw ) - 0.037  * SIN(     nw ) 
    605598      ! 
    606       a(1) = 1.0089 + 0.1871 * w1 - 0.0147 * w2 + 0.0014 * w3 
    607       b(1) =          0.1885 * w4 - 0.0234 * w5 + 0.0033 * w6 
    608       !   q1 
    609       a(2) = a(1) 
    610       b(2) = b(1) 
    611       !   o1 
    612       a(3) = 1.0 
    613       b(3) = 0.0 
    614       !   p1 
    615       a(4) = 1.0 
    616       b(4) = 0.0 
    617       !   s1 
     599      a(1) = 1.0004 -0.0373*w1+ 0.0002*w2 
     600      b(1) = -0.0374*w4 
     601      !   m2 
     602      a(2)=  1.0 
     603      b(2)=  0.0 
     604      !   s2 
     605      a(3) = 1.0004 -0.0373*w1+ 0.0002*w2 
     606      b(3) = -0.0374*w4 
     607      !   n2 
     608      a(4) = 1.0241+0.2863*w1+0.0083*w2 -0.0015*w3 
     609      b(4) = -0.3096*w4 + 0.0119*w5 - 0.0007*w6 
     610      !   k2 
    618611      a(5) = 1.0060+0.1150*w1- 0.0088*w2 +0.0006*w3 
    619612      b(5) = -0.1546*w4 + 0.0119*w5 -0.0012*w6 
    620613      !   k1 
    621       a(6) =1.0004 -0.0373*w1+ 0.0002*w2 
    622       b(6) = -0.0374*w4 
     614      a(6) = 1.0089 + 0.1871 * w1 - 0.0147 * w2 + 0.0014 * w3 
     615      b(6) =          0.1885 * w4 - 0.0234 * w5 + 0.0033 * w6 
     616      !   o1 
     617      a(7) = 1.0 
     618      b(7) = 0.0 
     619      !   p1 
     620      a(8) = 1.0089 + 0.1871 * w1 - 0.0147 * w2 + 0.0014 * w3 
     621      b(8) =          0.1885 * w4 - 0.0234 * w5 + 0.0033 * w6 
     622      !   q1 
     623      a(9) = 1.0 
     624      b(9) = 0.0 
     625      !   s1 
     626      a(10) =  1.0004 -0.0373*w1+ 0.0002*w2 
     627      b(10) = -0.0374*w4 
    623628      !  2n2 
    624       a(7) = a(6) 
    625       b(7) = b(6) 
     629      a(11) =  1.0004 -0.0373*w1+ 0.0002*w2 
     630      b(11) = -0.0374*w4 
    626631      !  mu2 
    627       a(8) = a(6) 
    628       b(8) = b(6) 
    629       !   n2 
    630       a(9) = a(6) 
    631       b(9) = b(6) 
     632      a(12) =  1.0004 -0.0373*w1+ 0.0002*w2 
     633      b(12) = -0.0374*w4 
    632634      !  nu2 
    633       a(10) = a(6) 
    634       b(10) = b(6) 
    635       !   m2 
    636       a(11) = SQRT( w7 * w7 + w8 * w8 ) 
    637       b(11) = ATAN( w8 / w7 ) 
     635      a(13) = SQRT( w7 * w7 + w8 * w8 ) 
     636      b(13) = ATAN( w8 / w7 ) 
    638637!!gmuse rpi  instead of 3.141992 ???   true pi is rpi=3.141592653589793_wp  .....   ???? 
    639       IF( w7 < 0.e0 )   b(11) = b(11) + 3.141992 
     638      IF( w7 < 0.e0 )   b(13) = b(13) + 3.141992 
    640639      !   l2 
    641       a(12) = 1.0 
    642       b(12) = 0.0 
     640      a(14) = 1.0 
     641      b(14) = 0.0 
    643642      !   t2 
    644       a(13)= a(12) 
    645       b(13)= b(12) 
    646       !   s2 
    647       a(14) = 1.0241+0.2863*w1+0.0083*w2 -0.0015*w3 
    648       b(14) = -0.3096*w4 + 0.0119*w5 - 0.0007*w6 
    649       !   k2 
    650       a(15) = a(6)*a(6) 
    651       b(15) = 2*b(6) 
     643      a(15) = a(10)*a(10) 
     644      b(15) = 2*b(10) 
    652645      !   m4 
    653646!!gm  old coding,  remove GOTO and label of lines 
    … …  
    686679      ndc = nc 
    687680      !   v s  are computed here. 
    688       v(1) =-3*s +h +p +270      ! Q1 
    689       v(2) =-2*s +h +270.0       ! O1 
    690       v(3) =-h +270              ! P1 
    691       v(4) =180                  ! S1 
    692       v(5) =h +90.0              ! K1 
    693       v(6) =-4*s +2*h +2*p       ! 2N2 
    694       v(7) =-4*(s-h)             ! MU2 
    695       v(8) =-3*s +2*h +p         ! N2 
    696       v(9) =-3*s +4*h -p         ! MU2 
    697       v(10) =-2*s +2*h           ! M2 
    698       v(11) =-s +2*h -p +180     ! L2  
    699       v(12) =-h +p1              ! T2 
    700       v(13) =0                   ! S2 
    701       v(14) =h+h                 ! K2 
    702       v(15) =2*v(10)             ! M4 
     681      v(1)  =-2*s +2*h           ! M2 
     682      v(2)  =0                   ! S2 
     683      v(3)  =-3*s +2*h +p        ! N2 
     684      v(4)  =h+h                 ! K2 
     685      v(5)  =h +90.0             ! K1 
     686      v(6)  =-2*s +h +270.0      ! O1 
     687      v(7)  =-h +270             ! P1 
     688      v(8)  =-3*s +h +p +270     ! Q1 
     689      v(9)  =180                 ! S1 
     690      v(10) =-4*s +2*h +2*p      ! 2N2 
     691      v(11) =-4*(s-h)            ! MU2 
     692      v(12) =-3*s +4*h -p        ! NU2 
     693      v(13) =-s +2*h -p +180     ! L2  
     694      v(14) =-h +p1              ! T2 
     695      v(15) =2*v(1)              ! M4 
    703696! 
    704697!!gm  old coding,  remove GOTO and label of lines 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r3294 r3938  
    8585            ij = idx%nbj(ib,igrd) 
    8686            zwgt = idx%nbw(ib,igrd) 
    87             tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik)          
     87            tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik) 
    8888            tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) + zwgt * ( dta%sal(ib,ik) - tsa(ii,ij,ik,jp_sal) ) ) * tmask(ii,ij,ik) 
    8989         END DO 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r3294 r3938  
    7777      TYPE(OBC_INDEX), POINTER :: idx 
    7878      !!----------------------------------------------------------------------------- 
    79  
    8079      IF( nn_timing == 1 ) CALL timing_start('bdy_vol') 
    8180 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r3294 r3938  
    55   !!====================================================================== 
    66   !! History :  3.3  ! 2010-09  (M. Leclair)  Original code  
     7   !!                 ! 2012-10  (C. Rousset)  add iom_put 
    78   !!---------------------------------------------------------------------- 
    89 
    … …  
    2122   USE bdy_par         ! (for lk_bdy) 
    2223   USE timing          ! preformance summary 
     24   USE iom             ! I/O manager 
     25   USE lib_fortran     ! glob_sum 
     26   USE restart         ! ocean restart 
     27   USE wrk_nemo         ! work arrays 
    2328 
    2429   IMPLICIT NONE 
    … …  
    2631 
    2732   PUBLIC   dia_hsb        ! routine called by step.F90 
    28    PUBLIC   dia_hsb_init   ! routine called by opa.F90 
     33   PUBLIC   dia_hsb_init   ! routine called by nemogcm.F90 
     34   PUBLIC   dia_hsb_rst    ! routine called by step.F90 
    2935 
    3036   LOGICAL, PUBLIC ::   ln_diahsb  = .FALSE.   !: check the heat and salt budgets 
    3137 
    32    INTEGER                                 ::   numhsb                           ! 
    33    REAL(dp)                                ::   surf_tot   , vol_tot             ! 
    34    REAL(dp)                                ::   frc_t      , frc_s     , frc_v   ! global forcing trends 
    35    REAL(dp)                                ::   fact1                            ! conversion factors 
    36    REAL(dp)                                ::   fact21    , fact22               !     -         - 
    37    REAL(dp)                                ::   fact31    , fact32               !     -         - 
    38    REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   surf      , ssh_ini              ! 
    39    REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
     38   REAL(wp), SAVE                                ::   frc_t      , frc_s     , frc_v   ! global forcing trends 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ssh_ini              ! 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hcssh_loc_ini, scssh_loc_ini     ! 
    4042 
    4143   !! * Substitutions 
    … …  
    6163      !!             - Compute the contribution of forcing and remove it from these deviations 
    6264      !! 
    63       !! ** Action : Write the results in the 'heat_salt_volume_budgets.txt' ASCII file 
    6465      !!--------------------------------------------------------------------------- 
    6566      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    6667      !! 
    6768      INTEGER    ::   jk                          ! dummy loop indice 
    68       REAL(dp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations 
    69       REAL(dp)   ::   zdiff_v1    , zdiff_v2      ! volume variation 
    70       REAL(dp)   ::   z1_rau0                     ! local scalars 
    71       REAL(dp)   ::   zdeltat                     !    -     - 
    72       REAL(dp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     - 
    73       REAL(dp)   ::   z_frc_trd_v                 !    -     - 
    74       !!--------------------------------------------------------------------------- 
    75       IF( nn_timing == 1 )   CALL timing_start('dia_hsb') 
    76  
     69      REAL(wp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations 
     70      REAL(wp)   ::   zdiff_v1    , zdiff_v2      ! volume variation 
     71      REAL(wp)   ::   z_hc        , z_sc          ! heat and salt content 
     72      REAL(wp)   ::   z_v1        , z_v2          ! volume 
     73      REAL(wp)   ::   z1_rau0                     ! local scalars 
     74      REAL(wp)   ::   zdeltat                     !    -     - 
     75      REAL(wp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     - 
     76      REAL(wp)   ::   z_frc_trd_v                 !    -     - 
     77      REAL(wp), POINTER, DIMENSION(:,:)   ::   zsurf              ! 
     78      !!--------------------------------------------------------------------------- 
     79      IF( nn_timing == 1 )   CALL timing_start('dia_hsb')       
     80 
     81      CALL wrk_alloc( jpi, jpj, zsurf ) 
     82   
     83      zsurf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area 
     84       
    7785      ! ------------------------- ! 
    7886      ! 1 - Trends due to forcing ! 
    7987      ! ------------------------- ! 
    8088      z1_rau0 = 1.e0 / rau0 
    81       z_frc_trd_v = z1_rau0 * SUM( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) )    ! volume fluxes 
    82       z_frc_trd_t =           SUM( sbc_tsc(:,:,jp_tem) * surf(:,:) )     ! heat fluxes 
    83       z_frc_trd_s =           SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) )     ! salt fluxes 
     89      z_frc_trd_v = z1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * zsurf(:,:) ) ! volume fluxes 
     90      z_frc_trd_t =           glob_sum( sbc_tsc(:,:,jp_tem) * zsurf(:,:) )       ! heat fluxes 
     91      z_frc_trd_s =           glob_sum( sbc_tsc(:,:,jp_sal) * zsurf(:,:) )       ! salt fluxes 
    8492      ! Add penetrative solar radiation 
    85       IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qsr     (:,:) * surf(:,:) ) 
     93      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + ro0cpr * glob_sum( qsr     (:,:) * zsurf(:,:) ) 
    8694      ! Add geothermal heat flux 
    87       IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qgh_trd0(:,:) * surf(:,:) ) 
    88       IF( lk_mpp ) THEN 
    89          CALL mpp_sum( z_frc_trd_v ) 
    90          CALL mpp_sum( z_frc_trd_t ) 
    91       ENDIF 
     95      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + ro0cpr * glob_sum( qgh_trd0(:,:) * zsurf(:,:) ) 
     96      ! 
    9297      frc_v = frc_v + z_frc_trd_v * rdt 
    9398      frc_t = frc_t + z_frc_trd_t * rdt 
    9499      frc_s = frc_s + z_frc_trd_s * rdt 
    95100 
    96       ! ----------------------- ! 
    97       ! 2 -  Content variations ! 
    98       ! ----------------------- ! 
    99       zdiff_v2 = 0.d0 
    100       zdiff_hc = 0.d0 
    101       zdiff_sc = 0.d0 
     101      ! ------------------------ ! 
     102      ! 2a -  Content variations ! 
     103      ! ------------------------ ! 
     104      zdiff_v2 = 0._wp 
     105      zdiff_hc = 0._wp 
     106      zdiff_sc = 0._wp 
    102107      ! volume variation (calculated with ssh) 
    103       zdiff_v1 = SUM( surf(:,:) * tmask(:,:,1) * ( sshn(:,:) - ssh_ini(:,:) ) ) 
     108      zdiff_v1 = glob_sum( zsurf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 
    104109      DO jk = 1, jpkm1 
    105110         ! volume variation (calculated with scale factors) 
    106          zdiff_v2 = zdiff_v2 + SUM( surf(:,:) * tmask(:,:,jk)   & 
    107             &                       * ( fse3t_n(:,:,jk)         & 
    108             &                           - e3t_ini(:,:,jk) ) ) 
     111         zdiff_v2 = zdiff_v2 + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 
    109112         ! heat content variation 
    110          zdiff_hc = zdiff_hc + SUM( surf(:,:) * tmask(:,:,jk)          & 
    111             &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem)   & 
     113         zdiff_hc = zdiff_hc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem)   & 
    112114            &                           - hc_loc_ini(:,:,jk) ) ) 
    113115         ! salt content variation 
    114          zdiff_sc = zdiff_sc + SUM( surf(:,:) * tmask(:,:,jk)          & 
    115             &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal)   & 
     116         zdiff_sc = zdiff_sc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal)   & 
    116117            &                           - sc_loc_ini(:,:,jk) ) ) 
    117118      ENDDO 
    118119 
    119       IF( lk_mpp ) THEN 
    120          CALL mpp_sum( zdiff_hc ) 
    121          CALL mpp_sum( zdiff_sc ) 
    122          CALL mpp_sum( zdiff_v1 ) 
    123          CALL mpp_sum( zdiff_v2 ) 
    124       ENDIF 
    125  
    126120      ! Substract forcing from heat content, salt content and volume variations 
    127       zdiff_v1 = zdiff_v1 - frc_v 
    128       zdiff_v2 = zdiff_v2 - frc_v 
    129       zdiff_hc = zdiff_hc - frc_t 
    130       zdiff_sc = zdiff_sc - frc_s 
     121      !frc_v = zdiff_v2 - frc_v 
     122      !frc_t = zdiff_hc - frc_t 
     123      !frc_s = zdiff_sc - frc_s 
    131124       
     125      ! add ssh if not vvl 
     126#ifndef key_vvl 
     127     zdiff_v2 = zdiff_v2 + zdiff_v1 
     128     zdiff_hc = zdiff_hc + glob_sum( zsurf(:,:) * ( sshn(:,:) * tsn(:,:,1,jp_tem)   & 
     129            &                           - hcssh_loc_ini(:,:) ) ) 
     130     zdiff_sc = zdiff_sc + glob_sum( zsurf(:,:) * ( sshn(:,:) * tsn(:,:,1,jp_sal)   & 
     131            &                           - scssh_loc_ini(:,:) ) ) 
     132#endif  
     133      ! 
     134      ! ----------------------- ! 
     135      ! 2b -  Content           ! 
     136      ! ----------------------- ! 
     137      z_v2 = 0._wp 
     138      z_hc = 0._wp 
     139      z_sc = 0._wp 
     140      ! volume (calculated with ssh) 
     141      z_v1 = glob_sum( zsurf(:,:) * sshn(:,:) ) 
     142      DO jk = 1, jpkm1 
     143         ! volume (calculated with scale factors) 
     144         z_v2 = z_v2 + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) ) 
     145         ! heat content 
     146         z_hc = z_hc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) ) 
     147         ! salt content 
     148         z_sc = z_sc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) ) 
     149      ENDDO 
     150      ! add ssh if not vvl 
     151#ifndef key_vvl 
     152     z_v2 = z_v2 + z_v1 
     153     z_hc = z_hc + glob_sum( zsurf(:,:) * sshn(:,:) * tsn(:,:,1,jp_tem) ) 
     154     z_sc = z_sc + glob_sum( zsurf(:,:) * sshn(:,:) * tsn(:,:,1,jp_sal) ) 
     155#endif  
     156 
    132157      ! ----------------------- ! 
    133158      ! 3 - Diagnostics writing ! 
    134159      ! ----------------------- ! 
    135160      zdeltat  = 1.e0 / ( ( kt - nit000 + 1 ) * rdt ) 
    136       WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1  * zdeltat,                                & 
    137          &                      zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat,   & 
    138          &                      zdiff_v1           , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat,   & 
    139          &                      zdiff_v2           , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat 
    140  
    141       IF ( kt == nitend ) CLOSE( numhsb ) 
    142  
     161! 
     162      CALL iom_put( 'bgtemper',z_hc / z_v2 )               ! Temperature (C)  
     163      CALL iom_put( 'bgsaline',z_sc / z_v2 )               ! Salinity (psu) 
     164      !CALL iom_put( 'bgheatco',zdiff_hc*fact1*zdeltat )      ! Equivalent heat flux (W/m2) 
     165      !CALL iom_put( 'bgsaltco',zdiff_sc*fact21*zdeltat )     ! Equivalent water flux (mm/s) 
     166      CALL iom_put( 'bgheatco',zdiff_hc * rau0 * rcp * 1.e-9_wp ) ! Heat content variation (10^9 J) 
     167      CALL iom_put( 'bgsaltco',zdiff_sc * 1.e-9 )                        ! Salt content variation (psu*km3)  
     168      CALL iom_put( 'bgvolssh',zdiff_v1 * 1.e-9 )                         ! volume ssh (km3)   
     169      CALL iom_put( 'bgsshtot',zdiff_v1 / glob_sum(zsurf) )              ! ssh (m)   
     170      CALL iom_put( 'bgvoltot',zdiff_v2 * 1.e-9 )                         ! volume total (km3)  
     171      CALL iom_put( 'bgfrcvol',frc_v * 1.e-9 )                         ! vol - surface forcing (volume)  
     172      CALL iom_put( 'bgfrctem',frc_t * rau0 * rcp * 1.e-9_wp ) ! hc  - surface forcing (heat content)  
     173      CALL iom_put( 'bgfrcsal',frc_s * 1.e-9 )                         ! sc  - surface forcing (salt content)  
     174      ! 
     175      CALL wrk_dealloc( jpi, jpj, zsurf ) 
     176      ! 
    143177      IF( nn_timing == 1 )   CALL timing_stop('dia_hsb') 
    144  
    145 9020  FORMAT(I5,11D15.7) 
    146       ! 
     178! 
    147179   END SUBROUTINE dia_hsb 
    148180 
    … …  
    160192      !!             - Compute coefficients for conversion 
    161193      !!--------------------------------------------------------------------------- 
    162       CHARACTER (len=32) ::   cl_name  ! output file name 
    163194      INTEGER            ::   jk       ! dummy loop indice 
    164195      INTEGER            ::   ierror   ! local integer 
    … …  
    180211      IF( .NOT. ln_diahsb )   RETURN 
    181212 
    182       ! ------------------- ! 
    183       ! 1 - Allocate memory ! 
    184       ! ------------------- ! 
    185       ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 
    186       IF( ierror > 0 ) THEN 
    187          CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
    188       ENDIF 
    189       ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 
    190       IF( ierror > 0 ) THEN 
    191          CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' )   ;   RETURN 
    192       ENDIF 
    193       ALLOCATE( e3t_ini(jpi,jpj,jpk)   , STAT=ierror ) 
    194       IF( ierror > 0 ) THEN 
    195          CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' )      ;   RETURN 
    196       ENDIF 
    197       ALLOCATE( surf(jpi,jpj)          , STAT=ierror ) 
    198       IF( ierror > 0 ) THEN 
    199          CALL ctl_stop( 'dia_hsb: unable to allocate surf' )         ;   RETURN 
    200       ENDIF 
    201       ALLOCATE( ssh_ini(jpi,jpj)       , STAT=ierror ) 
    202       IF( ierror > 0 ) THEN 
    203          CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' )      ;   RETURN 
    204       ENDIF 
    205  
    206       ! ----------------------------------------------- ! 
    207       ! 2 - Time independant variables and file opening ! 
    208       ! ----------------------------------------------- ! 
    209       WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
    210       WRITE(numout,*) "~~~~~~~  output written in the 'heat_salt_volume_budgets.txt' ASCII file" 
    211       IF( lk_obc .or. lk_bdy ) THEN 
    212          CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
    213       ENDIF 
    214       cl_name    = 'heat_salt_volume_budgets.txt'                         ! name of output file 
    215       surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area 
    216       surf_tot  = SUM( surf(:,:) )                                       ! total ocean surface area 
    217       vol_tot   = 0.d0                                                   ! total ocean volume 
    218       DO jk = 1, jpkm1 
    219          vol_tot  = vol_tot + SUM( surf(:,:) * tmask(:,:,jk)     & 
    220             &                      * fse3t_n(:,:,jk)         ) 
    221       END DO 
    222       IF( lk_mpp ) THEN  
    223          CALL mpp_sum( vol_tot ) 
    224          CALL mpp_sum( surf_tot ) 
    225       ENDIF 
    226  
    227       CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 ) 
    228       !                   12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 
    229       WRITE( numhsb, 9010 ) "kt   |     heat content budget     |            salt content budget             ",   & 
    230          !                                                   123456789012345678901234567890123456789012345 -> 45 
    231          &                                                  "|            volume budget (ssh)             ",   & 
    232          !                                                   678901234567890123456789012345678901234567890 -> 45 
    233          &                                                  "|            volume budget (e3t)             " 
    234       WRITE( numhsb, 9010 ) "     |      [C]         [W/m2]     |     [psu]        [mmm/s]          [SV]     ",   & 
    235          &                                                  "|     [m3]         [mmm/s]          [SV]     ",   & 
    236          &                                                  "|     [m3]         [mmm/s]          [SV]     " 
    237  
    238       ! --------------- ! 
    239       ! 3 - Conversions ! (factors will be multiplied by duration afterwards) 
    240       ! --------------- ! 
    241  
    242       ! heat content variation   =>   equivalent heat flux: 
    243       fact1  = rau0 * rcp / surf_tot                                         ! [C*m3]   ->  [W/m2] 
    244       ! salt content variation   =>   equivalent EMP and equivalent "flow":  
    245       fact21 = 1.e3  / ( soce * surf_tot )                                   ! [psu*m3] ->  [mm/s] 
    246       fact22 = 1.e-6 / soce                                                  ! [psu*m3] ->  [Sv] 
    247       ! volume variation         =>   equivalent EMP and equivalent "flow": 
    248       fact31 = 1.e3  / surf_tot                                              ! [m3]     ->  [mm/s] 
    249       fact32 = 1.e-6                                                         ! [m3]     ->  [SV] 
    250  
    251       ! ---------------------------------- ! 
    252       ! 4 - initial conservation variables ! 
    253       ! ---------------------------------- ! 
    254       ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
    255       DO jk = 1, jpk 
    256          e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
    257          hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
    258          sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
    259       END DO 
    260       frc_v = 0.d0                                           ! volume       trend due to forcing 
    261       frc_t = 0.d0                                           ! heat content   -    -   -    -    
    262       frc_s = 0.d0                                           ! salt content   -    -   -    -          
    263       ! 
    264 9010  FORMAT(A80,A45,A45) 
     213         ! ------------------- ! 
     214         ! 1 - Allocate memory ! 
     215         ! ------------------- ! 
     216         ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 
     217         IF( ierror > 0 ) THEN 
     218            CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
     219         ENDIF 
     220         ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 
     221         IF( ierror > 0 ) THEN 
     222            CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' )   ;   RETURN 
     223         ENDIF 
     224         ALLOCATE( hcssh_loc_ini(jpi,jpj), STAT=ierror ) 
     225         IF( ierror > 0 ) THEN 
     226            CALL ctl_stop( 'dia_hsb: unable to allocate hcssh_loc_ini' )   ;   RETURN 
     227         ENDIF 
     228         ALLOCATE( scssh_loc_ini(jpi,jpj), STAT=ierror ) 
     229         IF( ierror > 0 ) THEN 
     230            CALL ctl_stop( 'dia_hsb: unable to allocate scssh_loc_ini' )   ;   RETURN 
     231         ENDIF 
     232         ALLOCATE( e3t_ini(jpi,jpj,jpk)   , STAT=ierror ) 
     233         IF( ierror > 0 ) THEN 
     234            CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' )      ;   RETURN 
     235         ENDIF 
     236         ALLOCATE( ssh_ini(jpi,jpj)       , STAT=ierror ) 
     237         IF( ierror > 0 ) THEN 
     238            CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' )      ;   RETURN 
     239         ENDIF 
     240          
     241         ! ----------------------------------------------- ! 
     242         ! 2 - Time independant variables and file opening ! 
     243         ! ----------------------------------------------- ! 
     244         WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 
     245         IF( lk_obc .or. lk_bdy ) THEN 
     246            CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )          
     247         ENDIF 
     248          
     249         ! ---------------------------------- ! 
     250         ! 4 - initial conservation variables ! 
     251         ! ---------------------------------- ! 
     252         !ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
     253         !DO jk = 1, jpk 
     254         !   e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
     255         !   hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
     256         !   sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
     257         !END DO 
     258         !hcssh_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
     259         !scssh_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
     260         !frc_v = 0._wp                                           ! volume       trend due to forcing 
     261         !frc_t = 0._wp                                           ! heat content   -    -   -    -    
     262         !frc_s = 0._wp                                           ! salt content   -    -   -    -          
     263         ! 
     264         CALL dia_hsb_rst( nit000, 'READ' )  !* read or initialize all required files 
    265265      ! 
    266266   END SUBROUTINE dia_hsb_init 
     267 
     268   SUBROUTINE dia_hsb_rst( kt, cdrw ) 
     269     !!--------------------------------------------------------------------- 
     270     !!                   ***  ROUTINE limdia_rst  *** 
     271     !!                      
     272     !! ** Purpose :   Read or write DIA file in restart file 
     273     !! 
     274     !! ** Method  :   use of IOM library 
     275     !!---------------------------------------------------------------------- 
     276     INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
     277     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
     278     ! 
     279     INTEGER ::   jk   !  
     280     INTEGER ::   id1   ! local integers 
     281     !!---------------------------------------------------------------------- 
     282     ! 
     283     IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
     284        IF( ln_rstart ) THEN                   !* Read the restart file 
     285           !id1 = iom_varid( numror, 'frc_vol'  , ldstop = .FALSE. ) 
     286           ! 
     287           CALL iom_get( numror, 'frc_v', frc_v ) 
     288           CALL iom_get( numror, 'frc_t', frc_t ) 
     289           CALL iom_get( numror, 'frc_s', frc_s ) 
     290 
     291           CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 
     292           CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 
     293           CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 
     294           CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 
     295           CALL iom_get( numror, jpdom_autoglo, 'hcssh_loc_ini', hcssh_loc_ini ) 
     296           CALL iom_get( numror, jpdom_autoglo, 'scssh_loc_ini', scssh_loc_ini ) 
     297       ELSE 
     298          ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
     299          DO jk = 1, jpk 
     300             e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
     301             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
     302             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
     303          END DO 
     304          hcssh_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
     305          scssh_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
     306          frc_v = 0._wp                                            
     307          frc_t = 0._wp                                            
     308          frc_s = 0._wp                                                   
     309       ENDIF    
     310 
     311     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
     312        !                                   ! ------------------- 
     313        IF(lwp) WRITE(numout,*) '---- dia-rst ----' 
     314        CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v     ) 
     315        CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     ) 
     316        CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     ) 
     317         
     318        CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
     319        CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 
     320        CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 
     321        CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 
     322        CALL iom_rstput( kt, nitrst, numrow, 'hcssh_loc_ini', hcssh_loc_ini ) 
     323        CALL iom_rstput( kt, nitrst, numrow, 'scssh_loc_ini', scssh_loc_ini ) 
     324        ! 
     325     ENDIF 
     326     ! 
     327   END SUBROUTINE dia_hsb_rst 
    267328 
    268329   !!====================================================================== 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r3389 r3938  
    4646#if defined key_lim2 
    4747   USE limwri_2  
     48#elif defined key_lim3 
     49   USE limwri  
    4850#endif 
    4951   USE lib_mpp         ! MPP library 
    … …  
    743745      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater  
    744746         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     747      CALL histdef( id_i, "sosaltfx", "Net Upward Salt Flux"  , "Kg/m2/S",   &   ! net salt flux  
     748         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    745749      CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux 
    746750         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    … …  
    756760#if defined key_lim2 
    757761      CALL lim_wri_state_2( kt, id_i, nh_i ) 
     762#elif defined key_lim3 
     763      CALL lim_wri_state( kt, id_i, nh_i ) 
    758764#else 
    759765      CALL histend( id_i, snc4chunks=snc4set ) 
    … …  
    775781      CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
    776782      CALL histwrite( id_i, "sowaflup", kt, (emp-rnf )       , jpi*jpj    , idex )    ! freshwater budget 
     783      CALL histwrite( id_i, "sosaltfx", kt, emps             , jpi*jpj    , idex )    ! freshwater budget 
    777784      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
    778785      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r3294 r3938  
    510510         zhmin = gdepw_0(ik+1)                                                         ! minimum depth = ik+1 w-levels  
    511511         WHERE( bathy(:,:) <= 0._wp )   ;   bathy(:,:) = 0._wp                         ! min=0     over the lands 
    512          ELSE WHERE                     ;   bathy(:,:) = MAX(  zhmin , bathy(:,:)  )   ! min=zhmin over the oceans 
     512         ELSEWHERE                      ;   bathy(:,:) = MAX(  zhmin , bathy(:,:)  )   ! min=zhmin over the oceans 
    513513         END WHERE 
    514514         IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik 
    … …  
    871871      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat) 
    872872      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0 
    873       ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level 
     873      ELSEWHERE                      ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level 
    874874      END WHERE 
    875875 
    … …  
    15751575            END DO 
    15761576         END DO 
    1577          DO jj = mj0(74), mj1(74) 
    1578             DO ji = mi0(100), mi1(100) 
    1579                WRITE(numout,*) 
    1580                WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj) 
    1581                WRITE(numout,*) ' ~~~~~~  --------------------' 
    1582                WRITE(numout,"(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')") 
    1583                WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     & 
    1584                   &                                 fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk ) 
    1585             END DO 
    1586          END DO 
    1587       ENDIF 
     1577       ENDIF 
    15881578 
    15891579!!gm bug?  no more necessary?  if ! defined key_helsinki 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r3294 r3938  
    319319            !RBbug for vvl and external mode we may need to use varying fse3 
    320320            !!gm  Rq: the bottom e3 present the smallest variation, the use of e3u_0 is not a big approx. 
    321               zbfru(ji,jj) = MAX(  bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef  ) 
    322               zbfrv(ji,jj) = MAX(  bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef  ) 
     321            zbfru(ji,jj) = MAX(  bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef  ) 
     322            zbfrv(ji,jj) = MAX(  bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef  ) 
    323323           END DO 
    324324        END DO 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r3294 r3938  
    2727   USE in_out_manager  ! I/O manager 
    2828   USE lib_mpp           ! MPP library 
     29   USE timing          ! Timing 
    2930#if defined key_iomput 
    3031   USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain 
    … …  
    376377 
    377378 
    378    FUNCTION iom_varid ( kiomid, cdvar, kdimsz, ldstop )   
     379   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )   
    379380      !!----------------------------------------------------------------------- 
    380381      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    385386      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    386387      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
     388      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
    387389      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.) 
    388390      ! 
    … …  
    416418                  SELECT CASE (iom_file(kiomid)%iolib) 
    417419                  CASE (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz ) 
    418                   CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz ) 
     420                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims ) 
    419421                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file 
    420422                  CASE DEFAULT    
    … …  
    437439                  ENDIF 
    438440               ENDIF 
     441               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv) 
    439442            ENDIF 
    440443         ENDIF 
    … …  
    959962      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    960963      REAL(wp)        , INTENT(in) ::   pfield0d 
     964      IF( nn_timing == 1 )  CALL timing_start('iom_put0') 
    961965#if defined key_iomput 
    962966      CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) ) 
    … …  
    964968      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    965969#endif 
     970      IF( nn_timing == 1 )  CALL timing_stop('iom_put0') 
    966971   END SUBROUTINE iom_p0d 
    967972 
    … …  
    970975      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
    971976      INTEGER :: jpz 
     977      IF( nn_timing == 1 )  CALL timing_start('iom_put1') 
    972978#if defined key_iomput 
    973979      jpz=SIZE(pfield1d) 
    … …  
    976982      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
    977983#endif 
     984      IF( nn_timing == 1 )  CALL timing_stop('iom_put1') 
    978985   END SUBROUTINE iom_p1d 
    979986 
    … …  
    981988      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    982989      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
     990      IF( nn_timing == 1 )  CALL timing_start('iom_put2') 
    983991#if defined key_iomput 
    984992      CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 
    … …  
    986994      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    987995#endif 
     996      IF( nn_timing == 1 )  CALL timing_stop('iom_put2') 
    988997   END SUBROUTINE iom_p2d 
    989998 
    … …  
    9911000      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    9921001      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
     1002      IF( nn_timing == 1 )  CALL timing_start('iom_put3') 
    9931003#if defined key_iomput 
    9941004      CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 
    … …  
    9961006      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    9971007#endif 
     1008      IF( nn_timing == 1 )  CALL timing_stop('iom_put3') 
    9981009   END SUBROUTINE iom_p3d 
    9991010   !!---------------------------------------------------------------------- 
    … …  
    10701081      CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt           ) )    ! model time-step 
    10711082      CALL event__set_attribut( 'SBC'             , attr( field__freq_op, idt * nn_fsbc ) )    ! SBC time-step 
     1083 !SF  
     1084      CALL event__set_attribut( 'scalar_SBC'      , attr( field__freq_op, idt * nn_fsbc ) )    ! SBC time-step 
    10721085       
    10731086      ! output file names (attribut: name) 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r2715 r3938  
    181181 
    182182 
    183    FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz )   
     183   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )   
    184184      !!----------------------------------------------------------------------- 
    185185      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    191191      INTEGER              , INTENT(in   )           ::   kiv   !  
    192192      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
     193      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
    193194      ! 
    194195      INTEGER                        ::   iom_nf90_varid   ! iom variable Id 
    … …  
    242243            ENDIF 
    243244         ENDIF 
     245         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv) 
    244246      ELSE   
    245247         iom_nf90_varid = -1   !   variable not found, return error code: -1 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r3294 r3938  
    362362 
    363363 
    364    SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
     364   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval, ldup ) 
    365365      !!---------------------------------------------------------------------- 
    366366      !!                  ***  routine mpp_lnk_3d  *** 
    … …  
    390390      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
    391391      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     392      LOGICAL         , OPTIONAL      , INTENT(in   ) ::   ldup     ! duplicate value (used at closed boundaries) 
    392393      !! 
    393394      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    … …  
    427428            ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    428429            ptab(jpi,:,:) = ptab(  2  ,:,:) 
     430         ELSEIF ( nperio == 0 .AND. PRESENT( ldup ) ) THEN 
     431            ptab(3,:,:) = ptab(2,:,:) 
     432            ptab(:,3,:) = ptab(:,2,:) 
     433            ptab(nlci-2,:,:) = ptab(nlci-1,:,:) 
     434            ptab(:,nlcj-2,:) = ptab(:,nlcj-1,:) 
     435            
    429436         ELSE                                     !* closed 
    430437            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    … …  
    559566 
    560567 
    561    SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
     568   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval, ldup ) 
    562569      !!---------------------------------------------------------------------- 
    563570      !!                  ***  routine mpp_lnk_2d  *** 
    … …  
    585592      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only  
    586593      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
     594      LOGICAL         , OPTIONAL  , INTENT(in   ) ::   ldup     ! duplicate value (used at closed boundaries) 
    587595      !! 
    588596      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    … …  
    621629            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
    622630            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
     631         ELSEIF ( nperio == 0 .AND. PRESENT( ldup ) ) THEN 
     632            pt2d(3,:) = pt2d(2,:) 
     633            pt2d(:,3) = pt2d(:,2) 
     634            pt2d(nlci-2,:) = pt2d(nlci-1,:) 
     635            pt2d(:,nlcj-2) = pt2d(:,nlcj-1) 
    623636         ELSE                                     ! closed 
    624637            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    … …  
    20112024      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr ) 
    20122025      ndim_rank_ice = SUM( zwork )           
     2026  
     2027      !SF ! if there is no ice in the domain, return to the main program (clem modif) 
     2028     !SF  IF ( ndim_rank_ice == 0 ) THEN 
     2029      !SF    DEALLOCATE(kice, zwork) 
     2030     !SF     RETURN 
     2031     !SF  ENDIF 
    20132032 
    20142033      ! Allocate the right size to nrank_north 
    … …  
    20272046      ! Create the world group 
    20282047      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr ) 
    2029  
     2048  
    20302049      ! Create the ice group from the world group 
    20312050      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr ) 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r3294 r3938  
    3535      REAL(wp) ::   zd_max       ! maximum grid spacing over the global domain 
    3636      REAL(wp) ::   za00, zc, zd, zetmax, zefmax, zeumax, zevmax   ! local scalars 
    37       REAL(wp), POINTER, DIMENSION(:) :: zcoef    
     37      REAL(wp), POINTER, DIMENSION(:)   :: zcoef    
     38      INTEGER,  PARAMETER               :: zrim = 5  ! number of grid points over which diffusion is increased linearly 
     39      REAL(wp), PARAMETER               :: zinc_coef = 0.0 ! coef of diffusion increase   
     40      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers 
    3841      !!---------------------------------------------------------------------- 
    3942      ! 
    … …  
    8891            CALL ldf_dyn_c3d_orca( ld_print ) 
    8992         ENDIF 
    90  
    91       ENDIF 
    92        
    93       ! Control print 
    94       IF(lwp .AND. ld_print ) THEN 
    95          WRITE(numout,*) 
    96          WRITE(numout,*) '         3D ahm1 array (k=1)' 
    97          CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout ) 
    98          WRITE(numout,*) 
    99          WRITE(numout,*) '         3D ahm2 array (k=1)' 
    100          CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout ) 
    101       ENDIF 
    102  
     93     
     94          ! Control print 
     95         IF(lwp .AND. ld_print ) THEN 
     96            WRITE(numout,*) 
     97            WRITE(numout,*) '         3D ahm1 array (k=1)' 
     98            CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1.e-3, numout ) 
     99            WRITE(numout,*) 
     100            WRITE(numout,*) '         3D ahm2 array (k=1)' 
     101            CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1.e-3, numout ) 
     102         ENDIF 
     103 
     104      ENDIF 
     105       
    103106 
    104107      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator 
    … …  
    172175            WRITE(numout,*) 
    173176            WRITE(numout,*) 'inildf: ahm3 array at level 1' 
    174             CALL prihre(ahm3(:,:,1  ),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
     177            CALL prihre(ahm3(:,:,1  ),jpi,jpj,1,jpi,1,1,jpj,1,1.e-12,numout) 
    175178            WRITE(numout,*) 
    176179            WRITE(numout,*) 'inildf: ahm4 array at level 1' 
    177             CALL prihre(ahm4(:,:,jpk),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
     180            CALL prihre(ahm4(:,:,jpk),jpi,jpj,1,jpi,1,1,jpj,1,1.e-12,numout) 
    178181         ENDIF 
    179182      ENDIF 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r3294 r3938  
    3333   USE wrk_nemo        ! work arrays 
    3434   USE timing          ! Timing 
     35   USE lib_fortran     ! to use key_nosignedzero 
     36  
    3537 
    3638   IMPLICIT NONE 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r3294 r3938  
    99   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step 
    1010   !!            3.3  ! 2010-10  (J. Chanut, C. Bricaud)  add the surface pressure forcing 
     11   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model  
    1112   !!---------------------------------------------------------------------- 
    1213 
    … …  
    6869   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk 
    6970   !! 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   oatte, iatte      !: clem attenuation coef of the input solar flux [unitless] 
     72   !! 
    7073   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s] 
    7174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
    … …  
    111114         ! 
    112115      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 
    113          &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 
     116         &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,     & 
     117         &      iatte(jpi,jpj) , oatte    (jpi,jpj)                              , STAT=ierr(3) ) 
    114118         ! 
    115119      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r3294 r3938  
    6868   REAL(wp), PARAMETER ::   Ls   =    2.839e6     ! latent heat of sublimation 
    6969   REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant 
    70    REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice 
     70   !iovi REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice 
     71   REAL(wp), PARAMETER ::   Cice =    1.4e-3      ! transfer coefficient over ice 
    7172   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be contant 
    7273 
    … …  
    7576   LOGICAL  ::   ln_taudif = .FALSE.   ! logical flag to use the "mean of stress module - module of mean stress" data 
    7677   REAL(wp) ::   rn_pfac   = 1.        ! multiplication factor for precipitation 
     78   REAL(wp) ::   rn_efac   = 1.        ! multiplication factor for evaporation (clem) 
     79   REAL(wp) ::   rn_vfac   = 1.        ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 
    7780 
    7881   !! * Substitutions 
    … …  
    128131      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
    129132      TYPE(FLD_N) ::   sn_tdif                                 !   "                                 " 
    130       NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           & 
     133      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac, rn_efac, rn_vfac,  & 
    131134         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    132135         &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif 
    … …  
    266269      DO jj = 2, jpjm1 
    267270         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    268             zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    269             zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
     271            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
     272            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    270273         END DO 
    271274      END DO 
    … …  
    351354      IF( ln_2m ) THEN 
    352355         ! Values of temp. and hum. adjusted to 10m must be used instead of 2m values 
    353          zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) )   ! Evaporation 
    354          zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat 
     356         zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) )   ! Evaporation 
     357         zqsb (:,:) =                      rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat 
    355358      ELSE 
    356359!CDIR COLLAPSE 
    357          zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
    358 !CDIR COLLAPSE 
    359          zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
     360         zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
     361!CDIR COLLAPSE 
     362         zqsb (:,:) =                      rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
    360363      ENDIF 
    361364!CDIR COLLAPSE 
    … …  
    491494               ! ... scalar wind at I-point (fld being at T-point) 
    492495               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
    493                   &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - pui(ji,jj) 
     496                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pui(ji,jj) 
    494497               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
    495                   &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - pvi(ji,jj) 
     498                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * pvi(ji,jj) 
    496499               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    497500               ! ... ice stress at I-point 
    … …  
    499502               p_tauj(ji,jj) = zwnorm_f * zwndj_f 
    500503               ! ... scalar wind at T-point (fld being at T-point) 
    501                zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
    502                   &                                          + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
    503                zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
    504                   &                                          + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
     504               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
     505                  &                                                    + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
     506               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
     507                  &                                                    + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
    505508               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    506509            END DO 
    … …  
    516519         DO jj = 2, jpj 
    517520            DO ji = fs_2, jpi   ! vect. opt. 
    518                zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
    519                zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
     521               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
     522               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
    520523               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    521524            END DO 
    … …  
    555558               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    556559               ! Long  Wave (lw) 
    557                z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1) 
     560               ! iovino 
     561               IF( ff(ji,jj) .GT. 0._wp ) THEN 
     562                  z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) ! MV test 2 garde juste cette ligne ci 
     563               ELSE 
     564                  z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) ! MV test 1 garde juste cette ligne ci 
     565               ENDIF 
    558566               ! lw sensitivity 
    559567               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
    … …  
    567575               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
    568576               ! Latent Heat 
    569                p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
    570                   &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
     577               p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
     578                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    571579               ! Latent heat sensitivity for ice (Dqla/Dt) 
    572                p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     580               p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
    573581               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    574582               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
    575  
     583               ! 
     584               ! 
    576585               ! ----------------------------! 
    577586               !     III    Total FLUXES     ! 
    … …  
    601610!CDIR COLLAPSE 
    602611      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    603       CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation  
     612      CALL iom_put( 'snowpre', p_spr * 86400 )                  ! Snow precipitation  
     613      CALL iom_put( 'precip', p_tpr * 86400 )                   ! Total precipitation  
    604614      ! 
    605615      IF(ln_ctl) THEN 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r3294 r3938  
    9797            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain 
    9898            emp (:,:) = emp (:,:) - z_fwf  
    99             emps(:,:) = emps(:,:) - z_fwf  
     99            erp (:,:) = erp (:,:) - z_fwf  
     100!SF bad            emps(:,:) = emps(:,:) - z_fwf  
    100101         ENDIF 
    101102         ! 
    … …  
    127128         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN      ! correct the freshwater fluxes 
    128129            emp (:,:) = emp (:,:) + fwfold 
    129             emps(:,:) = emps(:,:) + fwfold 
     130            erp (:,:) = erp (:,:) + fwfold 
     131!SF bad            emps(:,:) = emps(:,:) + fwfold 
    130132         ENDIF 
    131133         ! 
    … …  
    169171            ! 
    170172            emp (:,:) = emp (:,:) + zerp_cor(:,:) 
    171             emps(:,:) = emps(:,:) + zerp_cor(:,:) 
     173!SF bad            emps(:,:) = emps(:,:) + zerp_cor(:,:) 
    172174            erp (:,:) = erp (:,:) + zerp_cor(:,:) 
    173175            ! 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r3294 r3938  
    1111   !!            3.3  ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step 
    1212   !!            4.0  ! 2011-01  (A Porter)  dynamical allocation 
     13   !!             -   ! 2012-10  (C. Rousset)  add lim_diahsb 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_lim3 
    … …  
    4243   USE limsbc          ! sea surface boundary condition 
    4344   USE limdia          ! Ice diagnostics 
     45   USE limdiahsb       ! Ice budget diagnostics 
    4446   USE limwri          ! Ice outputs 
    4547   USE limrst          ! Ice restarts 
    46    USE limupdate       ! update of global variables 
     48!clem@order   USE limupdate       ! update of global variables 
     49   USE limupdate1       ! update of global variables 
     50   USE limupdate2       ! update of global variables 
    4751   USE limvar          ! Ice variables switch 
    4852 
    … …  
    5155   USE lib_mpp         ! MPP library 
    5256   USE wrk_nemo        ! work arrays 
     57   USE timing          ! Timing 
    5358   USE iom             ! I/O manager library 
    5459   USE in_out_manager  ! I/O manager 
    5560   USE prtctl          ! Print control 
     61 
     62#if defined key_bdy  
     63   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
     64#endif 
    5665 
    5766   IMPLICIT NONE 
    … …  
    98107      !!---------------------------------------------------------------------- 
    99108 
     109      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
     110 
    100111      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    101112 
    … …  
    108119         ! 
    109120         IF( ln_nicep ) THEN      ! control print at a given point 
    110             jiindx = 44   ;   jjindx = 140 
     121            !jiindx = 3   ;   jjindx = 51 
     122            !jiindx = 34   ;   jjindx = 45 
     123            jiindx = 117   ;   jjindx = 116 
    111124            WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 
    112125         ENDIF 
    … …  
    153166         END SELECT 
    154167 
     168         CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point 
     169         CALL iom_put( 'vtau_ice', vtau_ice )     ! Wind stress over ice along j-axis at I-point 
     170 
    155171         !                                           !----------------------! 
    156172         !                                           ! LIM-3  time-stepping ! 
    … …  
    178194         d_oa_i_thd (:,:,:)   = 0.e0   ;   d_oa_i_trp (:,:,:)   = 0.e0 
    179195         ! 
    180          fseqv    (:,:) = 0.e0 
    181          fsbri    (:,:) = 0.e0     ;   fsalt_res(:,:) = 0.e0 
     196         !clem fseqv    (:,:) = 0.e0 
     197         !clem fsbri    (:,:) = 0.e0 
     198         fsalt_res(:,:) = 0.e0 
    182199         fsalt_rpo(:,:) = 0.e0 
    183          fhmec    (:,:) = 0.e0     ;   fhbri    (:,:) = 0.e0 
    184          fmmec    (:,:) = 0.e0     ;   fheat_res(:,:) = 0.e0 
    185          fheat_rpo(:,:) = 0.e0     ;   focea2D  (:,:) = 0.e0 
     200         fhmec    (:,:) = 0.e0 
     201         !clem fhbri    (:,:) = 0.e0 
     202         fmmec    (:,:) = 0.e0 
     203         fheat_res(:,:) = 0.e0 
     204         fheat_rpo(:,:) = 0.e0 
     205         focea2D  (:,:) = 0.e0 
    186206         fsup2D   (:,:) = 0.e0 
    187          !  
     207 
     208         ! clem: moved from limthd.F90  
     209         rdvosif(:,:) = 0.e0   ! variation of ice volume at surface 
     210         rdvobif(:,:) = 0.e0   ! variation of ice volume at bottom 
     211         fdvolif(:,:) = 0.e0   ! total variation of ice volume 
     212         rdvonif(:,:) = 0.e0   ! lateral variation of ice volume 
     213         fstric (:,:) = 0.e0   ! part of solar radiation transmitted through the ice 
     214         ffltbif(:,:) = 0.e0   ! linked with fstric 
     215         qfvbq  (:,:) = 0.e0   ! linked with fstric 
     216         rdmsnif(:,:) = 0.e0   ! variation of snow mass per unit area 
     217         rdmicif(:,:) = 0.e0   ! variation of ice mass per unit area 
     218         hicifp (:,:) = 0.e0   ! daily thermodynamic ice production.  
     219         fsbri  (:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean 
     220         fhbri  (:,:) = 0.e0   ! brine flux contribution to heat flux to the ocean 
     221         fseqv  (:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay 
     222         ! 
    188223         diag_sni_gr(:,:) = 0.e0   ;   diag_lat_gr(:,:) = 0.e0 
    189224         diag_bot_gr(:,:) = 0.e0   ;   diag_dyn_gr(:,:) = 0.e0 
    190225         diag_bot_me(:,:) = 0.e0   ;   diag_sur_me(:,:) = 0.e0 
     226         diag_res_pr(:,:) = 0.e0   ;   diag_trp_vi(:,:) = 0.e0 
    191227         ! dynamical invariants 
    192228         delta_i(:,:) = 0.e0       ;   divu_i(:,:) = 0.e0       ;   shear_i(:,:) = 0.e0 
    193  
     229         ! 
    194230                          CALL lim_rst_opn( kt )     ! Open Ice restart file 
    195231         ! 
    … …  
    200236                          CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics ) 
    201237                          CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion ) 
    202                           CALL lim_var_agg(1)             ! aggregate categories, requested 
     238                          !clem(done in trp wo ato_i) CALL lim_var_agg(1)             ! aggregate categories, requested 
    203239                          CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting 
    204240         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print 
    205241                          CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting) 
     242                          CALL lim_var_agg( 1 ) ! clem@order 
     243                          CALL lim_update1  ! clem@order 
    206244         ENDIF 
     245!                          !- Change old values for new values 
     246!clem@order 
     247                          old_u_ice(:,:)   = u_ice (:,:) 
     248                          old_v_ice(:,:)   = v_ice (:,:) 
     249                          old_a_i(:,:,:)   = a_i (:,:,:) 
     250                          old_v_s(:,:,:)   = v_s (:,:,:) 
     251                          old_v_i(:,:,:)   = v_i (:,:,:) 
     252                          old_e_s(:,:,:,:) = e_s (:,:,:,:) 
     253                          old_e_i(:,:,:,:) = e_i (:,:,:,:) 
     254                          old_oa_i(:,:,:)  = oa_i(:,:,:) 
     255                          old_smv_i(:,:,:) = smv_i (:,:,:) 
     256!clem@order 
    207257         !                                           ! Ice thermodynamics  
    208258                          CALL lim_var_glo2eqv            ! equivalent variables 
    … …  
    218268         !                                           ! Global variables update 
    219269                          CALL lim_var_agg( 1 )           ! requested by limupdate 
    220                           CALL lim_update                 ! Global variables update 
     270                          !clem@order CALL lim_update                 ! Global variables update 
     271                          CALL lim_update2  ! clem@order 
     272! 
     273#if defined key_bdy 
     274                          CALL bdy_ice_lim( kt )          ! clem modif: bdy ice 
     275#endif 
    221276                          CALL lim_var_glo2eqv            ! equivalent variables (outputs) 
    222277                          CALL lim_var_agg(2)             ! aggregate ice thickness categories 
    … …  
    230285         IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp )   & 
    231286            &             CALL lim_dia  
     287        IF (ln_limdiahsb) CALL lim_diahsb 
    232288                          CALL lim_wri( 1  )              ! Ice outputs  
     289         IF( kt == nit000 )   CALL iom_close( numrir )  ! clem: close input ice restart file 
    233290         IF( lrst_ice )   CALL lim_rst_write( kt )        ! Ice restart file  
    234291                          CALL lim_var_glo2eqv            ! ??? 
    … …  
    236293         IF( ln_nicep )   CALL lim_ctl               ! alerts in case of model crash 
    237294         ! 
    238       ENDIF                                    ! End sea-ice time step only 
     295     ENDIF                                    ! End sea-ice time step only 
    239296 
    240297      !                                        !--------------------------! 
    … …  
    249306      ! 
    250307      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
     308      ! 
     309      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
    251310      ! 
    252311   END SUBROUTINE sbc_ice_lim 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r3294 r3938  
    4848   USE in_out_manager   ! I/O manager 
    4949   USE prtctl           ! Print control 
     50 
     51#if defined key_bdy  
     52   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
     53#endif 
    5054 
    5155   IMPLICIT NONE 
    … …  
    191195           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping  
    192196         END IF 
     197!#if defined key_bdy 
     198!                           CALL bdy_ice_lim    ( kt )      ! clem modif 
     199!#endif 
    193200#if defined key_coupled 
    194201         !                                             ! Ice surface fluxes in coupled mode  
    … …  
    202209#endif 
    203210                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics  
     211#if defined key_bdy 
     212                           CALL bdy_ice_lim    ( kt )      ! clem modif 
     213#endif 
    204214                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes  
    205215 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3294 r3938  
    1212   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing 
    1313   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
     14   !!             -   ! 2012-01  (C. Rousset) add ice boundary conditions for LIM3 
    1415   !!---------------------------------------------------------------------- 
    1516 
    … …  
    4243   USE closea           ! closed sea 
    4344   USE bdy_par          ! for lk_bdy 
    44    USE bdyice_lim2      ! unstructured open boundary data  (bdy_ice_lim_2 routine) 
     45   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
    4546 
    4647   USE prtctl           ! Print control                    (prt_ctl routine) 
    … …  
    9697 
    9798      !                          ! overwrite namelist parameter using CPP key information 
    98       IF( Agrif_Root() ) THEN                ! AGRIF zoom 
    99         IF( lk_lim2 )   nn_ice      = 2 
    100         IF( lk_lim3 )   nn_ice      = 3 
    101         IF( lk_cice )   nn_ice      = 4 
    102       ENDIF 
     99      !IF( Agrif_Root() ) THEN                ! AGRIF zoom 
     100      !  IF( lk_lim2 )   nn_ice      = 2 
     101      !  IF( lk_lim3 )   nn_ice      = 3 
     102      !  IF( lk_cice )   nn_ice      = 4 
     103      !ENDIF 
    103104      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration 
    104105          ln_ana      = .TRUE.    
    … …  
    276277         !                                                       
    277278      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )            ! LIM-2 ice model 
    278          IF( lk_bdy )      CALL bdy_ice_lim_2( kt )                  ! BDY boundary condition 
     279         !IF( lk_bdy )      CALL bdy_ice_lim( kt )                   ! clem modif BDY boundary condition 
    279280         !                                                      
    280281      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc )            ! LIM-3 ice model 
     282         !IF( lk_bdy )      CALL bdy_ice_lim( kt )                   ! clem modif BDY boundary condition 
    281283         ! 
    282284      CASE(  4 )   ;       CALL sbc_ice_cice ( kt, nsbc )            ! CICE ice model 
    … …  
    337339      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    338340         CALL iom_put( "empmr" , emp  - rnf )                   ! upward water flux 
    339          CALL iom_put( "empsmr", emps - rnf )                   ! c/d water flux 
     341!!sf     CALL iom_put( "empsmr", emps - rnf )                   ! c/d water flux 
     342         CALL iom_put( "empsmr", emps       )                   ! modif lim3 : salt flux 
    340343         CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux  
    341344         CALL iom_put( "qns"   , qns        )                   ! solar heat flux 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r3294 r3938  
    2222   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2323   USE timing          ! Timing 
     24   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    2425 
    2526   IMPLICIT NONE 
    … …  
    174175                  DO ji = 1, jpi 
    175176                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    176                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    177                         &        / ( sss_m(ji,jj) + 1.e-20   ) 
     177                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )    
    178178                     emps(ji,jj) = emps(ji,jj) + zerp 
    179                      erp( ji,jj) = zerp 
     179                     erp (ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only) 
    180180                  END DO 
    181181               END DO 
    182182               CALL iom_put( "erp", erp )                             ! freshwater flux damping 
    183183               ! 
    184             ELSEIF( nn_sssr == 2 ) THEN               !* Salinity damping term (volume flux, emp and emps) 
     184            ELSEIF( nn_sssr == 2 ) THEN               !* Salinity damping term (volume flux, emp only) 
    185185               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    186186               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    … …  
    190190                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    191191                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    192                         &        / ( sss_m(ji,jj) + 1.e-20   ) 
     192                        &        / MAX(  sss_m(ji,jj), 1.e-20   ) 
    193193                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 
    194                      emp (ji,jj) = emp (ji,jj) + zerp 
    195                      emps(ji,jj) = emps(ji,jj) + zerp 
    196                      erp (ji,jj) = zerp 
     194                     emp(ji,jj) = emp (ji,jj) + zerp 
     195                     erp(ji,jj) = zerp 
    197196                  END DO 
    198197               END DO 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90

    r3294 r3938  
    1616  USE tide_mod 
    1717  USE iom 
     18  USE timing          ! Timing 
    1819 
    1920  IMPLICIT NONE 
    … …  
    5859    NAMELIST/nam_tide/ln_tide_pot,nb_harmo,clname,nn_tide 
    5960 
     61    IF( nn_timing == 1 )  CALL timing_start('sbctide') 
    6062    IF ( kt == nit000 ) THEN 
    6163 
    … …  
    8385       CALL flush(numout) 
    8486    ENDIF 
     87  
    8588 
    8689    ALLOCATE(ntide     (nb_harmo)) 
    … …  
    113116    IF (ln_tide_pot          ) CALL tide_init_potential 
    114117 
     118    IF( nn_timing == 1 )  CALL timing_stop('sbctide') 
     119    ! 
    115120  END SUBROUTINE sbc_tide 
    116121 
    … …  
    122127    INTEGER  :: ji,jj,jk 
    123128    REAL(wp) :: zcons,ztmp1,ztmp2,zlat,zlon 
    124  
    125129 
    126130    DO jk=1,nb_harmo 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r3294 r3938  
    1010   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate 
    1111   !!            3.2  !  2009-04  (G. Madec & NEMO team)  
     12   !!            4.0  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
    1213   !!---------------------------------------------------------------------- 
    1314 
    … …  
    4445   LOGICAL , PUBLIC ::   ln_qsr_2bd = .TRUE.    !: 2 band         light absorption flag 
    4546   LOGICAL , PUBLIC ::   ln_qsr_bio = .FALSE.   !: bio-model      light absorption flag 
     47   LOGICAL , PUBLIC ::   ln_qsr_ice = .TRUE.    !: light penetration for ice-model LIM3 (clem) 
    4648   INTEGER , PUBLIC ::   nn_chldta  = 0         !: use Chlorophyll data (=1) or not (=0) 
    4749   REAL(wp), PUBLIC ::   rn_abs     = 0.58_wp   !: fraction absorbed in the very near surface (RGB & 2 bands) 
    … …  
    100102      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars 
    101103      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         - 
     104      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         - 
    102105      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         - 
    103106      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr 
    … …  
    159162         END DO 
    160163         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution 
     164         ! clem: store attenuation coefficient of the first ocean level 
     165         IF ( ln_qsr_ice ) THEN 
     166            DO jj = 1, jpj 
     167               DO ji = 1, jpi 
     168                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
     169                     oatte(ji,jj) = ( qsr_hc(ji,jj,1) / ( ro0cpr * qsr(ji,jj) ) ) 
     170                     iatte(ji,jj) = oatte(ji,jj) 
     171                  ENDIF 
     172               END DO 
     173            END DO 
     174         ENDIF 
    161175         !                                        ! ============================================== ! 
    162176      ELSE                                        !  Ocean alone :  
    … …  
    217231                  END DO 
    218232               END DO 
     233               ! clem: store attenuation coefficient of the first ocean level 
     234               IF ( ln_qsr_ice ) THEN 
     235                  DO jj = 1, jpj 
     236                     DO ji = 1, jpi 
     237                        zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     ) 
     238                        zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 
     239                        zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
     240                        zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 
     241                        oatte(ji,jj) = ( 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) ) * tmask(ji,jj,2)  
     242                        iatte(ji,jj) = ( 1.0 - ( zzc0 + zzc1 + zcoef + zcoef ) ) * tmask(ji,jj,2) 
     243                     END DO 
     244                  END DO 
     245               ENDIF 
    219246               ! 
    220247               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
    … …  
    228255                  qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:) 
    229256               END DO 
    230             ENDIF 
     257               ! clem: store attenuation coefficient of the first ocean level 
     258               IF ( ln_qsr_ice ) THEN 
     259                  oatte(:,:) = etot3(:,:,1) / ro0cpr 
     260                  iatte(:,:) = oatte(:,:) 
     261               ENDIF 
     262           ENDIF 
    231263 
    232264         ENDIF 
    … …  
    247279                  END DO 
    248280               END DO 
     281               ! clem: store attenuation coefficient of the first ocean level 
     282               IF ( ln_qsr_ice ) THEN 
     283                  DO jj = 1, jpj 
     284                     DO ji = 1, jpi 
     285                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 
     286                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 
     287                        oatte(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / ro0cpr 
     288                        iatte(ji,jj) = oatte(ji,jj) 
     289                     END DO 
     290                  END DO 
     291               ENDIF 
    249292            ELSE                                               !* constant volume: coef. computed one for all 
    250293               DO jk = 1, nksr 
    … …  
    255298                  END DO 
    256299               END DO 
     300               ! clem: store attenuation coefficient of the first ocean level 
     301               IF ( ln_qsr_ice ) THEN 
     302                  oatte(:,:) = etot3(:,:,1) / ro0cpr 
     303                  iatte(:,:) = oatte(:,:) 
     304               ENDIF 
    257305               ! 
    258306            ENDIF 
    … …  
    271319         ! 
    272320      ENDIF 
     321      ! clem: store attenuation coefficient of the first ocean level 
     322      !IF (ln_traqsr) THEN 
     323      !   DO jj = 1, jpj 
     324      !      DO ji = 1, jpi 
     325      !         IF ( qsr(ji,jj) /= 0._wp ) THEN 
     326      !            oatte(ji,jj) = qsr_hc(ji,jj,1) / ( ro0cpr * qsr(ji,jj) ) 
     327      !            iatte(ji,jj) = qsr_hc(ji,jj,1) / ( ro0cpr * qsr(ji,jj) ) 
     328      !         ENDIF 
     329      !      END DO 
     330      !   END DO 
     331      !END IF 
    273332      ! 
    274333      IF( lrst_oce ) THEN   !                  Write in the ocean restart file 
    … …  
    279338         IF(lwp) WRITE(numout,*) '~~~~' 
    280339         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc ) 
    281          ! 
    282340      ENDIF 
    283341 
    … …  
    326384      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
    327385      !! 
    328       NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   & 
     386      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
    329387         &                  nn_chldta, rn_abs, rn_si0, rn_si1 
    330388      !!---------------------------------------------------------------------- 
    … …  
    333391      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
    334392      ! 
     393      ! clem init for oatte and iatte 
     394      oatte(:,:) = 1._wp 
     395      iatte(:,:) = 1._wp 
     396      ! 
    335397      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )  
    336398      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  
    337399      ! 
    338  
    339400      cn_dir = './'       ! directory in which the model is executed 
    340401      ! ... default values (NB: frequency positive => hours, negative => months) 
    … …  
    355416         WRITE(numout,*) '      2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd 
    356417         WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
     418         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice 
    357419         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta 
    358420         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r3294 r3938  
    169169               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem) 
    170170               ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration 
    171                sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal) 
     171               !sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal) 
     172               sbc_tsc(ji,jj,jp_sal) = emps(ji,jj) * zsrau  ! IOVINO + CLEM 
    172173            END DO 
    173174         END DO 
    … …  
    178179               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) 
    179180               ! salinity    : salt flux + concent./dilut. effect (both in emps) 
    180                sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal) 
     181#if defined key_lim3 
     182               sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) + zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_sal) ! IOVINO 
     183#else 
     184               sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal) ! regular expression 
     185#endif 
    181186            END DO 
    182187         END DO 

  • branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/step.F90

    r3294 r3938  
    234234                               CALL ssh_nxt( kstp )         ! sea surface height at next time step 
    235235 
    236       IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics 
     236      IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! global conservation diagnostics 
    237237      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    238238 
     239      IF( lrst_oce .AND. ln_diahsb )   CALL dia_hsb_rst( kstp, 'WRITE' ) 
    239240      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    240241      ! Control and restarts 
Note: See TracChangeset for help on using the changeset viewer.