New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3625 for branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90 – NEMO

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

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

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