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 12370 for NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/OCE/SBC/sbccpl.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T13:09:31+01:00 (4 years ago)
Author:
dancopsey
Message:

Add coupling changes.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0_add_pond_lids_prints/src/OCE/SBC/sbccpl.F90

    r10888 r12370  
    4848   USE lib_mpp        ! distribued memory computing library 
    4949   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     50 
     51#if defined key_oasis3  
     52   USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut  
     53#endif  
    5054 
    5155   IMPLICIT NONE 
     
    152156   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level  
    153157   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 
    154    INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area 
     158   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area fraction 
    155159   INTEGER, PARAMETER ::   jps_ht_p   = 35   ! meltpond thickness 
    156160   INTEGER, PARAMETER ::   jps_kice   = 36   ! sea ice effective conductivity 
     
    159163 
    160164   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent  
     165 
     166#if ! defined key_oasis3  
     167   ! Dummy variables to enable compilation when oasis3 is not being used  
     168   INTEGER                    ::   OASIS_Sent        = -1  
     169   INTEGER                    ::   OASIS_SentOut     = -1  
     170   INTEGER                    ::   OASIS_ToRest      = -1  
     171   INTEGER                    ::   OASIS_ToRestOut   = -1  
     172#endif  
    161173 
    162174   !                                  !!** namelist namsbc_cpl ** 
     
    184196   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models 
    185197                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     198   LOGICAL     ::   ln_scale_ice_fluxes   ! Scale sea ice fluxes by the sea ice fractions at the previous coupling point 
    186199   TYPE ::   DYNARR      
    187200      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3    
     
    256269         &                  sn_rcv_iceflx, sn_rcv_co2   , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,   & 
    257270         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl  ,   & 
    258          &                  sn_rcv_ts_ice 
     271         &                  sn_rcv_ts_ice, ln_scale_ice_fluxes 
    259272 
    260273      !!--------------------------------------------------------------------- 
     
    330343         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    331344         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
     345         WRITE(numout,*)'  ln_scale_ice_fluxes                 = ', ln_scale_ice_fluxes 
    332346      ENDIF 
    333347 
     
    815829      END SELECT 
    816830 
     831      ! Initialise ice fractions from last coupling time to zero 
     832       a_i_last_couple(:,:,:) = 0._wp 
     833 
     834 
    817835      !                                                      ! ------------------------- !  
    818836      !                                                      !      Ice Meltponds        !  
     
    16431661      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice 
    16441662      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
     1663      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total, ztmp1 
    16451664      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice    !!gm , zfrqsr_tr_i 
    16461665      !!---------------------------------------------------------------------- 
     
    16631682         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
    16641683         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    1665          zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 
    16661684      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    16671685         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    16681686         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 
    16691687         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
    1670          ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
     1688         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)          
    16711689      CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce  
    16721690      !                         ! since fields received are not defined with none option 
     
    16751693 
    16761694#if defined key_si3 
     1695 
     1696      ! --- evaporation over ice (kg/m2/s) --- ! 
     1697      zevap_ice_total(:,:) = 0._wp    
     1698      IF (sn_rcv_emp%clcat == 'yes') THEN 
     1699         DO jl=1,jpl 
     1700            IF (ln_scale_ice_fluxes) THEN 
     1701               zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) * a_i_last_couple(:,:,jl) 
     1702            ELSE 
     1703               zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
     1704            ENDIF 
     1705            zevap_ice_total(:,:) = zevap_ice_total(:,:) + zevap_ice(:,:,jl) 
     1706         ENDDO 
     1707      ELSE 
     1708         zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1 ) 
     1709         zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1710      ENDIF 
     1711 
     1712      IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 
     1713         ! For conservative case zemp_ice has not been defined yet. Do it now. 
     1714         zemp_ice(:,:) = zevap_ice_total(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 
     1715      END IF 
     1716 
    16771717      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
    16781718      zsnw(:,:) = 0._wp   ;   CALL ice_thd_snwblow( ziceld, zsnw ) 
     
    16831723 
    16841724      ! --- evaporation over ocean (used later for qemp) --- ! 
    1685       zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 
    1686  
    1687       ! --- evaporation over ice (kg/m2/s) --- ! 
    1688       DO jl=1,jpl 
    1689          IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
    1690          ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF 
    1691       ENDDO 
     1725      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) 
     1726 
     1727       
     1728 
    16921729 
    16931730      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
     
    17271764         sprecip (:,:)   = zsprecip (:,:) 
    17281765         tprecip (:,:)   = ztprecip (:,:) 
    1729          evap_ice(:,:,:) = zevap_ice(:,:,:) 
     1766         IF (ln_scale_ice_fluxes) THEN 
     1767            ! Convert from grid box means to sea ice means 
     1768            WHERE( a_i(:,:,:) > 0.0_wp ) evap_ice(:,:,:) = zevap_ice(:,:,:) / a_i(:,:,:) 
     1769            WHERE( a_i(:,:,:) <= 0.0_wp ) evap_ice(:,:,:) = 0.0 
     1770         ELSE 
     1771            evap_ice(:,:,:) = zevap_ice(:,:,:) 
     1772         ENDIF 
    17301773         DO jl = 1, jpl 
    17311774            devap_ice(:,:,jl) = zdevap_ice(:,:) 
     
    17741817      IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
    17751818      IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
    1776       IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average) 
     1819      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average) 
    17771820      IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  & 
    1778          &                                                        - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average) 
     1821         &                                                        - zevap_ice_total(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average) 
    17791822      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 
    17801823      ! 
     
    17841827      CASE( 'oce only' )         ! the required field is directly provided 
    17851828         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1829         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 
     1830         ! here so the only flux is the ocean only one. 
     1831         zqns_ice(:,:,:) = 0._wp  
    17861832      CASE( 'conservative' )     ! the required fields are directly provided 
    17871833         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
     
    18471893         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus )  ! solid precip over ocean + snow melting 
    18481894      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - rLfus )  ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 
    1849 !!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
    1850 !!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice 
    18511895       
    18521896      ! --- total non solar flux (including evap/precip) --- ! 
     
    19001944      IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting 
    19011945      IF ( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average) 
    1902       IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 
    1903            &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
     1946      IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:)  ) & 
     1947                                                                         * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
    19041948      IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average) 
    19051949      IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
     
    19141958      CASE( 'oce only' ) 
    19151959         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1960         ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 
     1961         ! here so the only flux is the ocean only one. 
     1962         zqsr_ice(:,:,:) = 0._wp 
    19161963      CASE( 'conservative' ) 
    19171964         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     
    19922039            ENDDO 
    19932040         ENDIF 
     2041      CASE( 'none'      )  
     2042         zdqns_ice(:,:,:) = 0._wp 
    19942043      END SELECT 
    19952044       
     
    20072056      !                                                      ! ========================= ! 
    20082057      CASE ('coupled') 
    2009          qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
    2010          qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
     2058         IF (ln_scale_ice_fluxes) THEN 
     2059            WHERE( a_i(:,:,:) > 0.0_wp ) qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2060            WHERE( a_i(:,:,:) <= 0.0_wp ) qml_ice(:,:,:) = 0.0_wp 
     2061            WHERE( a_i(:,:,:) > 0.0_wp ) qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2062            WHERE( a_i(:,:,:) <= 0.0_wp ) qcn_ice(:,:,:) = 0.0_wp 
     2063         ELSE 
     2064            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
     2065            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
     2066         ENDIF 
    20112067      END SELECT 
    20122068      ! 
     
    20982154               SELECT CASE( sn_snd_temp%clcat )  
    20992155               CASE( 'yes' )     
    2100                   ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)  
     2156                  ztmp3(:,:,1:jpl) = t_i(:,:,1,1:jpl) * a_i(:,:,1:jpl)  
    21012157               CASE( 'no' )  
    21022158                  ztmp3(:,:,:) = 0.0  
     
    21922248         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
    21932249      ENDIF 
     2250 
     2251      ! If this coupling was successful then save ice fraction for use between coupling points.  
     2252      ! This is needed for some calculations where the ice fraction at the last coupling point  
     2253      ! is needed.  
     2254      IF( info == OASIS_Sent     .OR. info == OASIS_ToRest .OR.   &  
     2255                     & info == OASIS_SentOut  .OR. info == OASIS_ToRestOut ) THEN  
     2256         IF ( sn_snd_thick%clcat == 'yes' ) THEN  
     2257           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 
     2258         ENDIF 
     2259      ENDIF     
    21942260 
    21952261      IF( ssnd(jps_fice1)%laction ) THEN 
     
    22502316      !                                                      !      Ice melt ponds       !  
    22512317      !                                                      ! ------------------------- ! 
    2252       ! needed by Met Office 
     2318      ! needed by Met Office - 1) fraction of ponded ice; 2) local/actual pond depth 
    22532319      IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN  
    22542320         SELECT CASE( sn_snd_mpnd%cldes)   
     
    22562322            SELECT CASE( sn_snd_mpnd%clcat )   
    22572323            CASE( 'yes' )   
    2258                ztmp3(:,:,1:jpl) =  a_ip(:,:,1:jpl) 
    2259                ztmp4(:,:,1:jpl) =  v_ip(:,:,1:jpl)   
     2324               ztmp3(:,:,1:jpl) =  a_ip_frac(:,:,1:jpl) 
     2325               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl) 
    22602326            CASE( 'no' )   
    22612327               ztmp3(:,:,:) = 0.0   
    22622328               ztmp4(:,:,:) = 0.0   
    22632329               DO jl=1,jpl   
    2264                  ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl)   
    2265                  ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)  
     2330                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 
     2331                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 
    22662332               ENDDO   
    22672333            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )   
Note: See TracChangeset for help on using the changeset viewer.