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 12252 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_adv_pra.F90 – NEMO

Ignore:
Timestamp:
2019-12-14T14:57:23+01:00 (4 years ago)
Author:
smasson
Message:

rev12240_dev_r11943_MERGE_2019: same as [12251], merge trunk 12072:12248, all sette tests ok, GYRE_PISCES, AMM12, ISOMIP, VORTEX intentical to 12236

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_adv_pra.F90

    r11812 r12252  
    5454CONTAINS 
    5555 
    56    SUBROUTINE ice_dyn_adv_pra( kt, pu_ice, pv_ice,  & 
     56   SUBROUTINE ice_dyn_adv_pra(         kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip,  & 
    5757      &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
    5858      !!---------------------------------------------------------------------- 
     
    7070      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pu_ice     ! ice i-velocity 
    7171      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pv_ice     ! ice j-velocity 
     72      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   ph_i       ! ice thickness 
     73      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   ph_s       ! snw thickness 
     74      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   ph_ip      ! ice pond thickness 
    7275      REAL(wp), DIMENSION(:,:)    , INTENT(inout) ::   pato_i     ! open water area 
    7376      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i       ! ice volume 
     
    8790      REAL(wp), DIMENSION(jpi,jpj)            ::   zati1, zati2 
    8891      REAL(wp), DIMENSION(jpi,jpj)            ::   zudy, zvdx 
     92      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zhi_max, zhs_max, zhip_max 
    8993      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zarea 
    9094      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ice, z0snw, z0ai, z0smi, z0oi 
     
    9599      ! 
    96100      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 
     101      ! 
     102      ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 
     103      DO jl = 1, jpl 
     104         DO jj = 2, jpjm1 
     105            DO ji = fs_2, fs_jpim1 
     106               zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
     107                  &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
     108                  &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 
     109                  &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 
     110               zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), & 
     111                  &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), & 
     112                  &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 
     113                  &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 
     114               zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), & 
     115                  &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), & 
     116                  &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
     117                  &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
     118            END DO 
     119         END DO 
     120      END DO 
     121      CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 
    97122      ! 
    98123      ! --- If ice drift is too fast, use  subtime steps for advection (CFL test for stability) --- ! 
     
    239264         !     (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
    240265         CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     266         ! 
     267         ! --- Make sure ice thickness is not too big --- ! 
     268         !     (because ice thickness can be too large where ice concentration is very small) 
     269         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
    241270         ! 
    242271         ! --- Ensure snow load is not too big --- ! 
     
    588617      ! 
    589618   END SUBROUTINE adv_y 
     619 
     620 
     621   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     622      !!------------------------------------------------------------------- 
     623      !!                  ***  ROUTINE Hbig  *** 
     624      !! 
     625      !! ** Purpose : Thickness correction in case advection scheme creates 
     626      !!              abnormally tick ice or snow 
     627      !! 
     628      !! ** Method  : 1- check whether ice thickness is larger than the surrounding 9-points 
     629      !!                 (before advection) and reduce it by adapting ice concentration 
     630      !!              2- check whether snow thickness is larger than the surrounding 9-points 
     631      !!                 (before advection) and reduce it by sending the excess in the ocean 
     632      !! 
     633      !! ** input   : Max thickness of the surrounding 9-points 
     634      !!------------------------------------------------------------------- 
     635      REAL(wp)                    , INTENT(in   ) ::   pdt                          ! tracer time-step 
     636      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max   ! max ice thick from surrounding 9-pts 
     637      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip 
     638      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s 
     639      ! 
     640      INTEGER  ::   ji, jj, jl         ! dummy loop indices 
     641      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zfra 
     642      !!------------------------------------------------------------------- 
     643      ! 
     644      z1_dt = 1._wp / pdt 
     645      ! 
     646      DO jl = 1, jpl 
     647 
     648         DO jj = 1, jpj 
     649            DO ji = 1, jpi 
     650               IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     651                  ! 
     652                  !                               ! -- check h_ip -- ! 
     653                  ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
     654                  IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     655                     zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
     656                     IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
     657                        pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 
     658                     ENDIF 
     659                  ENDIF 
     660                  ! 
     661                  !                               ! -- check h_i -- ! 
     662                  ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 
     663                  zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 
     664                  IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     665                     pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) )   !-- bound h_i to hi_max (99 m) 
     666                  ENDIF 
     667                  ! 
     668                  !                               ! -- check h_s -- ! 
     669                  ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 
     670                  zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 
     671                  IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     672                     zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 
     673                     ! 
     674                     wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 
     675                     hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     676                     ! 
     677                     pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
     678                     pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 
     679                  ENDIF            
     680                  !                   
     681               ENDIF 
     682            END DO 
     683         END DO 
     684      END DO  
     685      ! 
     686   END SUBROUTINE Hbig 
    590687 
    591688 
Note: See TracChangeset for help on using the changeset viewer.