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 14301 for NEMO/branches/UKMO/NEMO_4.0.4_penetrating_solar/src/OCE/SBC/sbccpl.F90 – NEMO

Ignore:
Timestamp:
2021-01-13T18:48:59+01:00 (19 months ago)
Author:
dancopsey
Message:

Merged in NEMO4.0.3 version of this branch from revision 13833 to 14248

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.4_penetrating_solar/src/OCE/SBC/sbccpl.F90

    r14075 r14301  
    120120   INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves 
    121121   INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp 
    122  
    123    INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received   
     122   INTEGER, PARAMETER ::   jpr_grnm   = 58   ! Greenland ice mass  
     123   INTEGER, PARAMETER ::   jpr_antm   = 59   ! Antarctic ice mass  
     124   INTEGER, PARAMETER ::   jpr_rnf_1d = 60   ! 1D river runoff  
     125   INTEGER, PARAMETER ::   jpr_qtr    = 61   ! Transmitted solar 
     126 
     127   INTEGER, PARAMETER ::   jprcv      = 61   ! total number of fields received 
    124128 
    125129   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
     
    192196   TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, & 
    193197                    sn_rcv_wdrag, sn_rcv_wfreq 
     198   ! Transmitted solar 
     199   TYPE(FLD_C) ::   sn_rcv_qtr 
    194200   !                                   ! Other namelist parameters 
    195201   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
     
    274280         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  &  
    275281         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  & 
     282         &                  sn_rcv_qtr   ,                                                             & 
    276283         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  & 
    277284         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                & 
     
    319326         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')' 
    320327         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
     328         WRITE(numout,*)'      transmitted solar               = ', TRIM(sn_rcv_qtr%cldes   ), ' (', TRIM(sn_rcv_qtr%clcat   ), ')' 
    321329         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
    322330         WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')'  
     
    588596         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    589597      ENDIF 
     598      !                                                      ! ------------------------- ! 
     599      !                                                      !    transmitted solar      !    
     600      !                                                      ! ------------------------- ! 
     601      srcv(jpr_qtr )%clname = 'OQtr' 
     602      IF( TRIM(sn_rcv_qtr%cldes) == 'coupled' ) THEN 
     603         IF ( TRIM( sn_rcv_qtr%clcat ) == 'yes' ) THEN 
     604            srcv(jpr_qtr)%nct = nn_cats_cpl 
     605         ELSE 
     606            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtr%clcat should always be set to yes currently' ) 
     607         ENDIF 
     608         srcv(jpr_qtr)%laction = .TRUE. 
     609      ENDIF 
     610 
    590611      !                                                      ! ------------------------- ! 
    591612      !                                                      !    ice skin temperature   !    
     
    21322153      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==! 
    21332154         ! 
    2134          !          ! ===> here we must receive the qtr_ice_top array from the coupler 
    2135          !                 for now just assume zero (fully opaque ice) 
    2136          zqtr_ice_top(:,:,:) = 0._wp 
     2155         SELECT CASE( TRIM( sn_rcv_qtr%cldes ) ) 
     2156         ! 
     2157         !      ! ===> here we receive the qtr_ice_top array from the coupler 
     2158         CASE ('coupled') 
     2159            IF (ln_scale_ice_flux) THEN 
     2160               WHERE( a_i(:,:,:) > 0.0_wp ) zqtr_ice_top(:,:,:) = frcv(jpr_qtr)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2161               WHERE( a_i(:,:,:) <= 0.0_wp ) zqtr_ice_top(:,:,:) = 0.0_wp 
     2162            ELSE 
     2163               zqtr_ice_top(:,:,:) = frcv(jpr_qtr)%z3(:,:,:) 
     2164            ENDIF 
     2165 
     2166         !      if we are not getting this data from the coupler then assume zero (fully opaque ice) 
     2167         CASE ('none') 
     2168            zqtr_ice_top(:,:,:) = 0._wp 
     2169         END SELECT 
    21372170         ! 
    21382171      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.