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 10288 for NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/ICB/icbthm.F90 – NEMO

Ignore:
Timestamp:
2018-11-07T18:25:49+01:00 (5 years ago)
Author:
francesca
Message:

reduce global communications, see #2010

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/ICB/icbthm.F90

    r9598 r10288  
    3333   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    3434   !! $Id$ 
    35    !! Software governed by the CeCILL licence     (./LICENSE) 
     35   !! Software governed by the CeCILL license (see ./LICENSE) 
    3636   !!---------------------------------------------------------------------- 
    3737CONTAINS 
     
    5050      REAL(wp) ::   zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn 
    5151      REAL(wp) ::   zMv, zMe, zMb, zmelt, zdvo, zdva, zdM, zSs, zdMe, zdMb, zdMv 
    52       REAL(wp) ::   zMnew, zMnew1, zMnew2, zheat 
     52      REAL(wp) ::   zMnew, zMnew1, zMnew2, zheat_hcflux, zheat_latent, z1_12 
    5353      REAL(wp) ::   zMbits, znMbits, zdMbitsE, zdMbitsM, zLbits, zAbits, zMbb 
    5454      REAL(wp) ::   zxi, zyj, zff, z1_rday, z1_e1e2, zdt, z1_dt, z1_dt_e1e2 
     
    5858      ! 
    5959      z1_rday = 1._wp / rday 
     60      z1_12   = 1._wp / 12._wp 
     61      zdt     = berg_dt 
     62      z1_dt   = 1._wp / zdt 
    6063      ! 
    6164      ! we're either going to ignore berg fresh water melt flux and associated heat 
     
    6568      ! 
    6669      berg_grid%floating_melt(:,:) = 0._wp 
     70      ! calving_hflx re-used here as temporary workspace for the heat flux associated with melting 
    6771      berg_grid%calving_hflx(:,:)  = 0._wp 
    6872      ! 
     
    9195         ij  = mj1( ij ) 
    9296         zVol = zT * zW * zL 
    93          zdt = berg_dt   ;   z1_dt = 1._wp / zdt 
    9497 
    9598         ! Environment 
    9699         zdvo = SQRT( (pt%uvel-pt%uo)**2 + (pt%vvel-pt%vo)**2 ) 
    97100         zdva = SQRT( (pt%ua  -pt%uo)**2 + (pt%va  -pt%vo)**2 ) 
    98          zSs  = 1.5 * SQRT( zdva ) + 0.1 * zdva                ! Sea state      (eqn M.A9) 
     101         zSs  = 1.5_wp * SQRT( zdva ) + 0.1_wp * zdva                ! Sea state      (eqn M.A9) 
    99102 
    100103         ! Melt rates in m/s (i.e. division by rday) 
    101          zMv = MAX( 7.62e-3*zSST+1.29e-3*(zSST**2)            , 0._wp ) * z1_rday   ! Buoyant convection at sides (eqn M.A10) 
    102          zMb = MAX( 0.58*(zdvo**0.8)*(zSST+4.0)/(zL**0.2)      , 0._wp ) * z1_rday   ! Basal turbulent melting     (eqn M.A7 ) 
    103          zMe = MAX( 1./12.*(zSST+2.)*zSs*(1+COS(rpi*(zIC**3))) , 0._wp ) * z1_rday   ! Wave erosion                (eqn M.A8 ) 
     104         zMv = MAX( 7.62d-3*zSST+1.29d-3*(zSST**2)                    , 0._wp ) * z1_rday   ! Buoyant convection at sides (eqn M.A10) 
     105         zMb = MAX( 0.58_wp*(zdvo**0.8_wp)*(zSST+4.0_wp)/(zL**0.2_wp) , 0._wp ) * z1_rday   ! Basal turbulent melting     (eqn M.A7 ) 
     106         zMe = MAX( z1_12*(zSST+2.)*zSs*(1._wp+COS(rpi*(zIC**3)))    , 0._wp ) * z1_rday   ! Wave erosion                (eqn M.A8 ) 
    104107 
    105108         IF( ln_operator_splitting ) THEN      ! Operator split update of volume/mass 
    106109            zTn    = MAX( zT - zMb*zdt , 0._wp )         ! new total thickness (m) 
    107110            znVol  = zTn * zW * zL                       ! new volume (m^3) 
    108             zMnew1 = (znVol/zVol) * zM                   ! new mass (kg) 
     111            zMnew1 = ( znVol / zVol ) * zM               ! new mass (kg) 
    109112            zdMb   = zM - zMnew1                         ! mass lost to basal melting (>0) (kg) 
    110113            ! 
     
    112115            zWn    = MAX( zW - zMv*zdt , 0._wp )         ! new width (m) 
    113116            znVol  = zTn * zWn * zLn                     ! new volume (m^3) 
    114             zMnew2 = (znVol/zVol) * zM                   ! new mass (kg) 
     117            zMnew2 = ( znVol / zVol ) * zM               ! new mass (kg) 
    115118            zdMv   = zMnew1 - zMnew2                     ! mass lost to buoyant convection (>0) (kg) 
    116119            ! 
     
    142145            zLbits   = MIN( zL, zW, zT, 40._wp )                                     ! assume bergy bits are smallest dimension or 40 meters 
    143146            zAbits   = ( zMbits / rn_rho_bergs ) / zLbits                            ! Effective bottom area (assuming T=Lbits) 
    144             zMbb     = MAX( 0.58*(zdvo**0.8)*(zSST+2.0)/(zLbits**0.2), 0.) * z1_rday ! Basal turbulent melting (for bits) 
     147            zMbb     = MAX( 0.58_wp*(zdvo**0.8_wp)*(zSST+2._wp) /   & 
     148               &                              ( zLbits**0.2_wp ) , 0._wp ) * z1_rday ! Basal turbulent melting (for bits) 
    145149            zMbb     = rn_rho_bergs * zAbits * zMbb                                  ! in kg/s 
    146150            zdMbitsM = MIN( zMbb*zdt , znMbits )                                     ! bergy bits mass lost to melting (kg) 
     
    163167            zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s 
    164168            berg_grid%floating_melt(ii,ij) = berg_grid%floating_melt(ii,ij) + zmelt    * z1_e1e2    ! kg/m2/s 
    165             zheat = zmelt * pt%heat_density              ! kg/s x J/kg = J/s 
    166             berg_grid%calving_hflx (ii,ij) = berg_grid%calving_hflx (ii,ij) + zheat    * z1_e1e2    ! W/m2 
    167             CALL icb_dia_melt( ii, ij, zMnew, zheat, this%mass_scaling,       & 
     169            !! NB. The src_calving_hflx field is currently hardwired to zero in icb_stp, which means that the 
     170            !!     heat density of the icebergs is zero and the heat content flux to the ocean from iceberg 
     171            !!     melting is always zero. Leaving the term in the code until such a time as this is fixed. DS. 
     172            zheat_hcflux = zmelt * pt%heat_density       ! heat content flux : kg/s x J/kg = J/s 
     173            zheat_latent = - zmelt * rLfus               ! latent heat flux:  kg/s x J/kg = J/s 
     174            berg_grid%calving_hflx (ii,ij) = berg_grid%calving_hflx (ii,ij) + ( zheat_hcflux + zheat_latent ) * z1_e1e2    ! W/m2 
     175            CALL icb_dia_melt( ii, ij, zMnew, zheat_hcflux, zheat_latent, this%mass_scaling,       & 
    168176               &                       zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   & 
    169177               &                       zdMv, z1_dt_e1e2 ) 
     
    211219      IF(.NOT. ln_passive_mode ) THEN 
    212220         emp (:,:) = emp (:,:) - berg_grid%floating_melt(:,:) 
    213 !!       qns (:,:) = qns (:,:) + berg_grid%calving_hflx (:,:)  !!gm heat flux not yet properly coded ==>> need it, SOLVE that! 
     221         qns (:,:) = qns (:,:) + berg_grid%calving_hflx (:,:)   
    214222      ENDIF 
    215223      ! 
Note: See TracChangeset for help on using the changeset viewer.