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 9271 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90 – NEMO

Ignore:
Timestamp:
2018-01-19T18:56:15+01:00 (6 years ago)
Author:
clem
Message:

first steps for having more than 1 snow layers in the ice (in theory). There is still icethd_dh.F90 routine to change

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/LIM_SRC_3/icedyn_rdgrft.F90

    r9169 r9271  
    570570      REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1 
    571571      REAL(wp)                  ::   airft1, oirft1, aprft1 
    572       REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, esrdg  ! area etc of new ridges 
    573       REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, esrft  ! area etc of rafted ice 
     572      REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg  ! area etc of new ridges 
     573      REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft  ! area etc of rafted ice 
    574574      ! 
    575575      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges 
     
    577577      REAL(wp), DIMENSION(jpij) ::   z1_ai            ! 1 / a 
    578578      ! 
    579       REAL(wp), DIMENSION(jpij,nlay_i) ::   eirft     ! ice energy of rafting ice 
     579      REAL(wp), DIMENSION(jpij,nlay_s) ::   esrft     ! snow energy of rafting ice 
     580      REAL(wp), DIMENSION(jpij,nlay_i) ::   eirft     ! ice  energy of rafting ice 
     581      REAL(wp), DIMENSION(jpij,nlay_s) ::   esrdg     ! enth*volume of new ridges       
    580582      REAL(wp), DIMENSION(jpij,nlay_i) ::   eirdg     ! enth*volume of new ridges 
    581583      !!------------------------------------------------------------------- 
     
    633635               oirdg1     = oa_i_2d(ji,jl1)   * afrdg 
    634636               oirdg2(ji) = oa_i_2d(ji,jl1)   * afrdg * hi_hrdg(ji,jl1)  
    635                esrdg(ji)  = ze_s_2d(ji,1,jl1) * afrdg 
    636637 
    637638               virft(ji)  = v_i_2d (ji,jl1)   * afrft 
     
    640641               oirft1     = oa_i_2d(ji,jl1)   * afrft  
    641642               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft  
    642                esrft(ji)  = ze_s_2d(ji,1,jl1) * afrft 
    643643 
    644644               IF ( ln_pnd_H12 ) THEN 
     
    663663               wfx_snw_dyn_1d(ji) = wfx_snw_dyn_1d(ji) + ( rhosn * vsrdg(ji) * ( 1._wp - rn_fsnwrdg )   &   ! fresh water source for ocean 
    664664                  &                                      + rhosn * vsrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice 
    665  
    666                hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ( - esrdg(ji) * ( 1._wp - rn_fsnwrdg )   &                 ! heat sink for ocean (<0, W.m-2) 
    667                   &                                - esrft(ji) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice 
    668665 
    669666               ! Put the melt pond water into the ocean 
     
    697694                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 
    698695               ENDIF 
    699                ze_s_2d(ji,1,jl1) = ze_s_2d(ji,1,jl1) - esrdg (ji) - esrft (ji) 
    700696            ENDIF 
    701697 
    702698         END DO ! ji 
    703699 
     700         ! special loop for e_s because of layers jk 
     701         DO jk = 1, nlay_s 
     702            DO ji = 1, npti 
     703               IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN 
     704                  ! Compute ridging /rafting fractions 
     705                  afrdg = aridge(ji,jl1) * closing_gross(ji) * rdt_ice * z1_ai(ji) 
     706                  afrft = araft (ji,jl1) * closing_gross(ji) * rdt_ice * z1_ai(ji) 
     707                  ! Compute ridging ice and new ridges for es 
     708                  esrdg(ji,jk) = ze_s_2d (ji,jk,jl1) * afrdg 
     709                  esrft(ji,jk) = ze_s_2d (ji,jk,jl1) * afrft 
     710                  ! Put the snow lost by ridging into the ocean 
     711                  hfx_dyn_1d(ji) = hfx_dyn_1d(ji) + ( - esrdg(ji,jk) * ( 1._wp - rn_fsnwrdg )   &                 ! heat sink for ocean (<0, W.m-2) 
     712                     &                                - esrft(ji,jk) * ( 1._wp - rn_fsnwrft ) ) * r1_rdtice 
     713                  ! Update jl1 
     714                  ze_s_2d(ji,jk,jl1) = ze_s_2d(ji,jk,jl1) * ( 1._wp - afrdg - afrft )  
     715               ENDIF 
     716            END DO 
     717         END DO 
     718                   
    704719         ! special loop for e_i because of layers jk 
    705720         DO jk = 1, nlay_i 
     
    754769                  sv_i_2d(ji,jl2) = sv_i_2d(ji,jl2) + ( sirdg2(ji) * fvol(ji) + sirft (ji) * zswitch(ji) ) 
    755770                  v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji)  +  & 
    756                      &                                    vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 
     771                     &                                  vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 
    757772                  IF ( ln_pnd_H12 ) THEN 
    758773                     v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   & 
     
    761776                        &                                   + aprft2(ji) * rn_fpndrft * zswitch(ji)   ) 
    762777                  ENDIF 
    763                   ze_s_2d(ji,1,jl2) = ze_s_2d(ji,1,jl2) + ( esrdg (ji) * rn_fsnwrdg * fvol(ji)  +  & 
    764                      &                                      esrft (ji) * rn_fsnwrft * zswitch(ji) ) 
    765778                   
    766779               ENDIF 
    767780 
    768781            END DO 
    769  
     782            ! for snow enthalpy 
     783            DO jk = 1, nlay_s 
     784               DO ji = 1, npti 
     785                  IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp )   & 
     786                     &   ze_s_2d(ji,jk,jl2) = ze_s_2d(ji,jk,jl2) + ( esrdg(ji,jk) * rn_fsnwrdg * fvol(ji)  +  & 
     787                     &                                               esrft(ji,jk) * rn_fsnwrft * zswitch(ji) ) 
     788               END DO 
     789            END DO 
     790            ! for ice enthalpy 
    770791            DO jk = 1, nlay_i 
    771792               DO ji = 1, npti 
Note: See TracChangeset for help on using the changeset viewer.