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 11408 for NEMO – NEMO

Changeset 11408 for NEMO


Ignore:
Timestamp:
2019-08-06T16:20:43+02:00 (5 years ago)
Author:
dancopsey
Message:

Apply option to scale by sea ice fractions from the last coupling time.

Location:
NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only/src
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only/src/ICE/ice.F90

    r10888 r11408  
    296296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i       !: Ice thickness                           (m) 
    297297   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration) 
     298   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i_last_couple    !: Ice fractional area at last coupling time 
    298299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area                (m) 
    299300   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area               (m) 
  • NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only/src/OCE/SBC/sbc_ice.F90

    r10888 r11408  
    9393    
    9494   ! already defined in ice.F90 for SI3 
    95    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
     95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i               ! Sea ice fraction on categories 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i_last_couple   ! Sea ice fraction on categories at the last coupling point 
    9697   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  h_i, h_s 
    9798 
  • NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only/src/OCE/SBC/sbccpl.F90

    r11370 r11408  
    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 
     
    160164   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent  
    161165 
     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  
     173 
    162174   !                                  !!** namelist namsbc_cpl ** 
    163175   TYPE ::   FLD_C                     !    
     
    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    
     
    210223      !!             ***  FUNCTION sbc_cpl_alloc  *** 
    211224      !!---------------------------------------------------------------------- 
    212       INTEGER :: ierr(4) 
     225      INTEGER :: ierr(5) 
    213226      !!---------------------------------------------------------------------- 
    214227      ierr(:) = 0 
     
    222235      ! 
    223236      IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) )  
     237 
     238      ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(5) )   
    224239 
    225240      sbc_cpl_alloc = MAXVAL( ierr ) 
     
    256271         &                  sn_rcv_iceflx, sn_rcv_co2   , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,   & 
    257272         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl  ,   & 
    258          &                  sn_rcv_ts_ice 
     273         &                  sn_rcv_ts_ice, ln_scale_ice_fluxes 
    259274 
    260275      !!--------------------------------------------------------------------- 
     
    330345         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    331346         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
     347         WRITE(numout,*)'  ln_scale_ice_fluxes                 = ', ln_scale_ice_fluxes 
    332348      ENDIF 
    333349 
     
    815831      END SELECT 
    816832 
     833      ! Initialise ice fractions from last coupling time to zero 
     834       a_i_last_couple(:,:,:) = 0._wp 
     835 
     836 
    817837      !                                                      ! ------------------------- !  
    818838      !                                                      !      Ice Meltponds        !  
     
    16431663      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice 
    16441664      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
     1665      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total 
    16451666      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice    !!gm , zfrqsr_tr_i 
    16461667      !!---------------------------------------------------------------------- 
     
    16631684         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
    16641685         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    1665          zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 
    16661686      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    16671687         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    16681688         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 
    16691689         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
    1670          ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
     1690         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:)          
    16711691      CASE( 'none'      )       ! Not available as for now: needs additional coding below when computing zevap_oce  
    16721692      !                         ! since fields received are not defined with none option 
     
    16751695 
    16761696#if defined key_si3 
     1697 
     1698      ! --- evaporation over ice (kg/m2/s) --- ! 
     1699      zevap_ice_total(:,:) = 0._wp    
     1700      IF (sn_rcv_emp%clcat == 'yes') THEN 
     1701         DO jl=1,jpl 
     1702            IF (ln_scale_ice_fluxes) THEN 
     1703               zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) * a_i_last_couple(:,:,jl) 
     1704            ELSE 
     1705               zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
     1706            ENDIF 
     1707            zevap_ice_total(:,:) = zevap_ice_total(:,:) + zevap_ice(:,:,jl) 
     1708         ENDDO 
     1709      ELSE 
     1710         zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1 ) 
     1711         zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1712      ENDIF 
     1713 
     1714      IF ( TRIM( sn_rcv_emp%cldes == 'conservative' ) THEN 
     1715         ! For conservative case zemp_ice has not been defined yet. Do it now. 
     1716         zemp_ice(:,:) = zevap_ice_total(:,:) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 
     1717      END IF 
     1718 
    16771719      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
    16781720      zsnw(:,:) = 0._wp   ;   CALL ice_thd_snwblow( ziceld, zsnw ) 
     
    16831725 
    16841726      ! --- 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 
     1727      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) 
     1728 
     1729       
     1730 
    16921731 
    16931732      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
     
    17741813      IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
    17751814      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) 
     1815      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average) 
    17771816      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) 
     1817         &                                                        - zevap_ice_total(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average) 
    17791818      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 
    17801819      ! 
     
    18501889         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus )  ! solid precip over ocean + snow melting 
    18511890      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - rLfus )  ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 
    1852 !!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
    1853 !!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhos  ! solid precip over ice 
    18541891       
    18551892      ! --- total non solar flux (including evap/precip) --- ! 
     
    19031940      IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting 
    19041941      IF ( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average) 
    1905       IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 
    1906            &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
     1942      IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:)  ) & 
     1943                                                                         * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
    19071944      IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average) 
    19081945      IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
     
    20152052      !                                                      ! ========================= ! 
    20162053      CASE ('coupled') 
    2017          qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
    2018          qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
     2054         IF (ln_scale_ice_fluxes) THEN 
     2055            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) 
     2056            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) 
     2057         ELSE 
     2058            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
     2059            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
     2060         ENDIF 
    20192061      END SELECT 
    20202062      ! 
     
    22002242         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
    22012243      ENDIF 
     2244 
     2245      ! If this coupling was successful then save ice fraction for use between coupling points.  
     2246      ! This is needed for some calculations where the ice fraction at the last coupling point  
     2247      ! is needed.  
     2248      IF( info == OASIS_Sent     .OR. info == OASIS_ToRest .OR.   &  
     2249                     & info == OASIS_SentOut  .OR. info == OASIS_ToRestOut ) THEN  
     2250         IF ( sn_snd_thick%clcat == 'yes' ) THEN  
     2251           a_i_last_couple(:,:,:) = a_i(:,:,:)  
     2252         ENDIF  
     2253      ENDIF  
    22022254 
    22032255      IF( ssnd(jps_fice1)%laction ) THEN 
Note: See TracChangeset for help on using the changeset viewer.