Changeset 13834

Timestamp:

2020-11-19T19:19:02+01:00 (4 years ago)

Author:

dancopsey

Message:

Merge in changes from NEMO4.0.1 version of this branch.

Location:

NEMO/branches/UKMO/NEMO_4.0.3_penetrating_solar/src/OCE/SBC

Files:

• cpl_oasis3.F90 (modified) (1 diff)
• sbccpl.F90 (modified) (6 diffs)

NEMO/branches/UKMO/NEMO_4.0.3_penetrating_solar/src/OCE/SBC/cpl_oasis3.F90

@@ -66 +66 @@
    INTEGER                    ::   nsnd         ! total number of fields sent 
    INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
-   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=60   ! Maximum number of coupling fields
+   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=61   ! Maximum number of coupling fields
    INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields
    INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields

NEMO/branches/UKMO/NEMO_4.0.3_penetrating_solar/src/OCE/SBC/sbccpl.F90

@@ -120 +120 @@
    INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves
    INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp
-
-   INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received  
+   INTEGER, PARAMETER ::   jpr_qtr    = 61   ! Transmitted solar
+
+   INTEGER, PARAMETER ::   jprcv      = 61   ! total number of fields received
 
    INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere
@@ -192 +193 @@
    TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, &
                     sn_rcv_wdrag, sn_rcv_wfreq
+   ! Transmitted solar
+   TYPE(FLD_C) ::   sn_rcv_qtr
    !                                   ! Other namelist parameters
    INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
@@ -268 +271 @@
          &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  & 
          &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  &
+         &                  sn_rcv_qtr   ,                                                             &
          &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  &
          &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                &
@@ -313 +317 @@
          WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')'
          WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')'
+         WRITE(numout,*)'      transmitted solar               = ', TRIM(sn_rcv_qtr%cldes   ), ' (', TRIM(sn_rcv_qtr%clcat   ), ')'
          WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')'
          WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
@@ -582 +587 @@
          srcv(jpr_topm:jpr_botm)%laction = .TRUE.
       ENDIF
+      !                                                      ! ------------------------- !
+      !                                                      !    transmitted solar      !   
+      !                                                      ! ------------------------- !
+      srcv(jpr_qtr )%clname = 'OQtr'
+      IF( TRIM(sn_rcv_qtr%cldes) == 'coupled' ) THEN
+         IF ( TRIM( sn_rcv_qtr%clcat ) == 'yes' ) THEN
+            srcv(jpr_qtr)%nct = nn_cats_cpl
+         ELSE
+            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtr%clcat should always be set to yes currently' )
+         ENDIF
+         srcv(jpr_qtr)%laction = .TRUE.
+      ENDIF
+
       !                                                      ! ------------------------- !
       !                                                      !    ice skin temperature   !   
@@ -2126 +2144 @@
       ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==!
          !
-         !          ! ===> here we must receive the qtr_ice_top array from the coupler
-         !                 for now just assume zero (fully opaque ice)
-         zqtr_ice_top(:,:,:) = 0._wp
+         SELECT CASE( TRIM( sn_rcv_qtr%cldes ) )
+         !
+         !      ! ===> here we receive the qtr_ice_top array from the coupler
+         CASE ('coupled')
+            IF (ln_scale_ice_fluxes) THEN
+               WHERE( a_i(:,:,:) > 0.0_wp ) zqtr_ice_top(:,:,:) = frcv(jpr_qtr)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
+               WHERE( a_i(:,:,:) <= 0.0_wp ) zqtr_ice_top(:,:,:) = 0.0_wp
+            ELSE
+               zqtr_ice_top(:,:,:) = frcv(jpr_qtr)%z3(:,:,:)
+            ENDIF
+
+         !      if we are not getting this data from the coupler then assume zero (fully opaque ice)
+         CASE ('none')
+            zqtr_ice_top(:,:,:) = 0._wp
+         END SELECT
          !
       ENDIF