Changeset 14424

Timestamp:

2021-02-09T19:18:32+01:00 (3 years ago)

Author:

dancopsey

Message:

Process ocean mean ocean fluxes instead of grid box mean ocean fluxes.

File:

• NEMO/branches/UKMO/NEMO_4.0.4_ocean_mean_fluxes/src/OCE/SBC/sbccpl.F90 (modified) (15 diffs)

NEMO/branches/UKMO/NEMO_4.0.4_ocean_mean_fluxes/src/OCE/SBC/sbccpl.F90

@@ -213 +213 @@
 #if defined key_si3 || defined key_cice
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i_last_couple !: Ice fractional area at last coupling time
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   leads_last_couple !: Leads fractional area at last coupling time
 #endif
 
@@ -233 +234 @@
       !!             ***  FUNCTION sbc_cpl_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER :: ierr(5)
+      INTEGER :: ierr(6)
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -245 +246 @@
 #if defined key_si3 || defined key_cice
       ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) )
+      ALLOCATE( leads_last_couple(jpi,jpj) , STAT=ierr(5) )
 #endif
       !
-      IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) )
+      IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(6) )
 
       sbc_cpl_alloc = MAXVAL( ierr )
@@ -868 +870 @@
 #if defined key_si3 || defined key_cice
        a_i_last_couple(:,:,:) = 0._wp
+       leads_last_couple(:,:) = 1._wp
 #endif
       !                                                      ! ------------------------- ! 
@@ -1176 +1179 @@
          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
       END DO
+
+      ! Find out the leads fraction at the last coupling point
+      leads_last_couple(:,:) = SUM(a_i_last_couple(:,:,:), dim=3)
 
       !                                                      ! ========================= !
@@ -1443 +1449 @@
             SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
             CASE( 'conservative' )
-               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
+               zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) * leads_last_couple(:,:) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
             CASE( 'oce only', 'oce and ice' )
                zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
@@ -1468 +1474 @@
          !
          !                                                       ! non solar heat flux over the ocean (qns)
-         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+         IF(      srcv(jpr_qnsoce)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) * leads_last_couple(:,:)
          ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
          ELSE                                       ;   zqns(:,:) = 0._wp
@@ -1487 +1493 @@
 
          !                                                       ! solar flux over the ocean          (qsr)
-         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
+         IF     ( srcv(jpr_qsroce)%laction ) THEN   ;   zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) * leads_last_couple(:,:)
          ELSE IF( srcv(jpr_qsrmix)%laction ) then   ;   zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
          ELSE                                       ;   zqsr(:,:) = 0._wp
@@ -1728 +1734 @@
          zsprecip(:,:) =   frcv(jpr_snow)%z3(:,:,1)                  ! May need to ensure positive here
          ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here
-         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)
+         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) * leads_last_couple(:,:) - ztprecip(:,:)
       CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
          zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
@@ -1787 +1793 @@
 
       ! --- evaporation over ocean (used later for qemp) --- !
-      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:)
+      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) * leads_last_couple(:,:) - zevap_ice_total(:,:) * picefr(:,:)
 
       ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0
@@ -1874 +1880 @@
       IF( iom_use('rain_ao_cea') )   CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:)         )  ! liquid precipitation over ocean (cell average)
       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)
-      IF( iom_use('evap_ao_cea') )   CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  &
+      IF( iom_use('evap_ao_cea') )   CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) * leads_last_couple(:,:)  &
          &                                                         - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)
       ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf
@@ -1892 +1898 @@
          ! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE
          ! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1)
-         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) * ziceld(:,:) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 )
+         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) * leads_last_couple(:,:) + SUM( zqns_ice(:,:,:) * a_i_last_couple(:,:,:), dim=3 )
          
       CASE( 'conservative' )     ! the required fields are directly provided
@@ -2019 +2025 @@
       IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )   ! latent heat from icebergs melting
       IF ( iom_use(   'hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average)
-      IF ( iom_use(   'hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) )  &
+      IF ( iom_use(   'hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) * leads_last_couple(:,:) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) )  &
            &                         * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average)
       IF ( iom_use(   'hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' ,    sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  &                    ! heat flux from all precip (cell avg)
@@ -2032 +2038 @@
       !                                                      ! ========================= !
       CASE( 'oce only' )
-         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) * ziceld(:,:)
+         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) * leads_last_couple(:,:)
 
          ! For the Met Office the only sea ice solar flux is the transmitted qsr which is added onto zqsr_ice
@@ -2134 +2140 @@
             ! Add retrieved transmitted solar radiation onto the ice and total solar radiation
             zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:)
-            zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 )
+            zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i_last_couple(:,:,:), dim=3 )
 
          !      if we are not getting this data from the coupler then assume zero (fully opaque ice)