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 14898 – NEMO

Changeset 14898


Ignore:
Timestamp:
2021-05-24T17:40:43+02:00 (3 years ago)
Author:
dancopsey
Message:

Make iceberg top melt a combination of sea ice top melt and ocean solar.

Location:
NEMO/branches/UKMO/NEMO_4.0.4_bouncing_icebergs/src/OCE/ICB
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.4_bouncing_icebergs/src/OCE/ICB/icb_oce.F90

    r14880 r14898  
    8686   ! particularly for MPP when iceberg can lie inside T grid but outside U, V, or f grid 
    8787   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   uo_e, vo_e 
    88    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e, tt_e, fr_e, ss_e, qt_e 
     88   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ff_e, tt_e, fr_e, ss_e, qsr_e, qml_e 
    8989   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e 
    9090   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e 
     
    178178         &      ff_e(0:jpi+1,0:jpj+1) , fr_e(0:jpi+1,0:jpj+1)  ,   & 
    179179         &      tt_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,   & 
    180          &      ss_e(0:jpi+1,0:jpj+1) , qt_e(0:jpi+1,0:jpj+1) ,   &  
     180         &      ss_e(0:jpi+1,0:jpj+1) , qsr_e(0:jpi+1,0:jpj+1) ,   &  
     181         &      qml_e(0:jpi+1,0:jpj+1) ,                           & 
    181182         &      first_width(nclasses) , first_length(nclasses) ,   & 
    182183         &      src_calving (jpi,jpj) ,                            & 
  • NEMO/branches/UKMO/NEMO_4.0.4_bouncing_icebergs/src/OCE/ICB/icbdyn.F90

    r14880 r14898  
    269269      ! 
    270270      INTEGER  ::   itloop 
    271       REAL(wp) ::   zuo, zui, zua, zuwave, zssh_x, zsst, zcn, zhi, zsss, pqt 
     271      REAL(wp) ::   zuo, zui, zua, zuwave, zssh_x, zsst, zcn, zhi, zsss, psr, pml 
    272272      REAL(wp) ::   zvo, zvi, zva, zvwave, zssh_y 
    273273      REAL(wp) ::   zff, zT, zD, zW, zL, zM, zF 
     
    282282      nknberg = berg%number(1) 
    283283      CALL icb_utl_interp( pxi, pe1, zuo, zui, zua, zssh_x,                     & 
    284          &                 pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff, zsss, pqt ) 
     284         &                 pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff, zsss, psr, pml ) 
    285285 
    286286      zM = berg%current_point%mass 
  • NEMO/branches/UKMO/NEMO_4.0.4_bouncing_icebergs/src/OCE/ICB/icbini.F90

    r14880 r14898  
    8080      ff_e(:,:) = 0._wp   ;   tt_e(:,:) = 0._wp   ; 
    8181      fr_e(:,:) = 0._wp   ;   ss_e(:,:) = 0._wp   ; 
    82       qt_e(:,:) = 0._wp 
     82      qsr_e(:,:) = 0._wp  ;   qml_e(:,:) = 0._wp  ; 
    8383#if defined key_si3 
    8484      hi_e(:,:) = 0._wp   ; 
  • NEMO/branches/UKMO/NEMO_4.0.4_bouncing_icebergs/src/OCE/ICB/icbthm.F90

    r14880 r14898  
    5151      INTEGER  ::   ii, ij 
    5252      REAL(wp) ::   zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn 
    53       REAL(wp) ::   zqt, pqt 
     53      REAL(wp) ::   zqsr, pqsr, zqml, pqml 
    5454      REAL(wp) ::   zSSS, zfzpt 
    5555      REAL(wp) ::   zMv, zMe, zMb, zmelt, zdvo, zdva, zdM, zSs, zdMe, zdMb, zdMv, zMt 
     
    8888         CALL icb_utl_interp( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x,   & 
    8989            &                 pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y,   & 
    90             &                 pt%sst, pt%cn, pt%hi, zff, pt%sss, pqt ) 
     90            &                 pt%sst, pt%cn, pt%hi, zff, pt%sss, pqsr, pqml ) 
    9191         ! 
    9292         zSST = pt%sst 
    9393         zSSS = pt%sss 
    94          zqt = MAX( pqt, 0._wp )                        ! Net surface heat flux 
     94         zqsr = MAX( pqsr, 0._wp )                        ! Downward oceanic surface solar flux 
     95         zqml = MAX( pqml, 0._wp )                        ! Sea ice top melt 
    9596         CALL eos_fzp(zSSS,zfzpt)                       ! freezing point 
    9697         zIC  = MIN( 1._wp, pt%cn + rn_sicn_shift )     ! Shift sea-ice concentration       !!gm ??? 
     
    123124         ENDIF 
    124125         zMe = MAX( z1_12*(zSST+2.)*zSs*(1._wp+COS(rpi*(zIC**3)))     , 0._wp ) * z1_rday      ! Wave erosion                (eqn M.A8 ) 
    125          zMt = MIN( (zqt*(1.0_wp - zIC)*0.25_wp + zqt*zIC) / (rLfus * rhoi) , 1.0E-7_wp )      ! Top melt by surface heat flux. Assuming surface heat flux 
    126                                                                                                ! involved in melting is a quarter of that going into the 
    127                                                                                                ! ocean but all of that going into sea ice. Apply a maximum 
    128                                                                                                ! amount of melt of 1E-7 m/s to keep 
    129                                                                                                ! this term lower than the other terms when the berg is in 
    130                                                                                                ! mid ocean. 
     126 
     127         ! Energy involved in top melt is a combination of 10% of solar flux (for portion of grid box that is ocean) and 
     128         ! 100% of sea ice top melt (for portion of grid box that is sea ice). Apply a maximum amount of melt of 5E-6 m/s 
     129         ! to keep this term lower than the other terms when the berg is in mid ocean. 
     130         zMt = MIN( (zqsr*0.1_wp + zqml) / (rLfus * rhoi) , 5.0E-6_wp ) 
    131131 
    132132         IF( ln_operator_splitting ) THEN      ! Operator split update of volume/mass 
     
    174174            zdMbitsM = MIN( zMbb*zdt , znMbits )                                     ! bergy bits mass lost to melting (kg) 
    175175            znMbits  = znMbits-zdMbitsM                                              ! remove mass lost to bergy bits melt 
    176             IF( zMnew == 0._wp ) THEN                                                ! if parent berg has completely melted then 
     176            IF( zMnew <= 0._wp ) THEN                                                ! if parent berg has completely melted then 
    177177               zdMbitsM = zdMbitsM + znMbits                                         ! instantly melt all the bergy bits 
    178178               znMbits  = 0._wp 
  • NEMO/branches/UKMO/NEMO_4.0.4_bouncing_icebergs/src/OCE/ICB/icbutl.F90

    r14880 r14898  
    2323   USE sbc_oce                             ! ocean surface boundary conditions 
    2424#if defined key_si3 
    25    USE ice,    ONLY: u_ice, v_ice, hm_i, qt_atm_oi    ! SI3 variables 
     25   USE ice,    ONLY: u_ice, v_ice, hm_i, a_i    ! SI3 variables 
    2626   USE icevar                              ! ice_var_sshdyn 
    27    USE sbc_ice, ONLY: snwice_mass, snwice_mass_b 
     27   USE sbc_ice, ONLY: snwice_mass, snwice_mass_b, qsr_oce, qml_ice 
    2828#endif 
    2929 
     
    7878      ua_e(1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    7979      va_e(1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 
    80       qt_e(1:jpi,1:jpj) = qt_atm_oi(:,:) 
     80      qsr_e(1:jpi,1:jpj) = qsr_oce(:,:) 
     81      qml_e(1:jpi,1:jpj) = SUM(qml_ice(:,:,:) * a_i(:,:,:), dim=3 ) 
    8182      ! 
    8283      CALL lbc_lnk_icb( 'icbutl', uo_e, 'U', -1._wp, 1, 1 ) 
     
    8889      CALL lbc_lnk_icb( 'icbutl', tt_e, 'T', +1._wp, 1, 1 ) 
    8990      CALL lbc_lnk_icb( 'icbutl', ss_e, 'T', +1._wp, 1, 1 ) 
    90       CALL lbc_lnk_icb( 'icbutl', qt_e, 'T', +1._wp, 1, 1 ) 
     91      CALL lbc_lnk_icb( 'icbutl', qsr_e, 'T', +1._wp, 1, 1 ) 
     92      CALL lbc_lnk_icb( 'icbutl', qml_e, 'T', +1._wp, 1, 1 ) 
    9193#if defined key_si3 
    9294      hi_e(1:jpi, 1:jpj) = hm_i (:,:)   
     
    111113   SUBROUTINE icb_utl_interp( pi, pe1, puo, pui, pua, pssh_i,   & 
    112114      &                       pj, pe2, pvo, pvi, pva, pssh_j,   & 
    113       &                       psst, pcn, phi, pff, psss, pqt        ) 
     115      &                       psst, pcn, phi, pff, psss, pqsr, pqml        ) 
    114116      !!---------------------------------------------------------------------- 
    115117      !!                  ***  ROUTINE icb_utl_interp  *** 
     
    133135      REAL(wp), INTENT(  out) ::   pssh_i, pssh_j                 ! ssh i- & j-gradients 
    134136      REAL(wp), INTENT(  out) ::   psst, pcn, phi, pff, psss      ! SST, ice concentration, ice thickness, Coriolis, SSS 
    135       REAL(wp), INTENT(  out) ::   pqt                            ! Net surface solar radiation 
     137      REAL(wp), INTENT(  out) ::   pqsr, pqml                     ! Ocean solar and sea ice top melt 
    136138      ! 
    137139      REAL(wp) ::   zcd, zmod       ! local scalars 
     
    147149      pcn  = icb_utl_bilin_h( fr_e, pi, pj, 'T', .true.   )    ! ice concentration 
    148150      pff  = icb_utl_bilin_h( ff_e, pi, pj, 'F', .false.  )    ! Coriolis parameter 
    149       pqt  = icb_utl_bilin_h( qt_e, pi, pj, 'T', .true.   )    ! Total surface shortwave 
     151      pqsr  = icb_utl_bilin_h( qsr_e, pi, pj, 'T', .true.   )  ! Ocean surface solar 
     152      pqml  = icb_utl_bilin_h( qml_e, pi, pj, 'T', .true.   )  ! Sea ice top melt 
    150153      ! 
    151154      pua  = icb_utl_bilin_h( ua_e, pi, pj, 'U', .true.   )    ! 10m wind 
Note: See TracChangeset for help on using the changeset viewer.