Changeset 2834 for branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

Timestamp:

2011-09-13T13:19:25+02:00 (13 years ago)

Author:

charris

Message:

#662 Tidying of sbc_cpl_ice_flx (mainly related to LIM2). There is still scope for cleaning up the use of ice fraction and lead fraction in the sbccpl routines, but best to wait until the LIM3 functionality is properly sorted.

File:

• branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (9 diffs)

branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

@@ -1125 +1125 @@
       USE wrk_nemo, ONLY:   zcptn  => wrk_2d_2   ! rcp * tn(:,:,1)
       USE wrk_nemo, ONLY:   ztmp   => wrk_2d_3   ! temporary array
-      USE wrk_nemo, ONLY:   zsnow  => wrk_2d_4   ! snow precipitation 
-      USE wrk_nemo, ONLY:   zicefr => wrk_2d_5   ! total ice fraction 
+      USE wrk_nemo, ONLY:   zicefr => wrk_2d_4   ! ice fraction 
       !!
       REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1]
@@ -1137 +1136 @@
       !!----------------------------------------------------------------------
 
-      IF( wrk_in_use(2, 2,3,4,5) ) THEN
+      IF( wrk_in_use(2, 2,3,4) ) THEN
          CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable')   ;   RETURN
       ENDIF
@@ -1153 +1152 @@
       SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
       CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
-         sprecip (:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here
-         tprecip (:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here
+         sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here
+         tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here
          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)
          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
-         zsnow(:,:) = frcv(jpr_snow)%z3(:,:,1)
                            CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation 
          IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip. 
@@ -1166 +1164 @@
          emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
          emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
-         zsnow   (:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)
+         sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)
       END SELECT
-#if ! defined key_cice
-      sprecip(:,:) = - emp_ice(:,:)
-#endif
-      CALL iom_put( 'snowpre'    , zsnow                               )   ! Snow
-      CALL iom_put( 'snow_ao_cea', zsnow(:,:         ) * p_frld(:,:) )   ! Snow        over ice-free ocean  (cell average)
-      CALL iom_put( 'snow_ai_cea', zsnow(:,:         ) * zicefr(:,:) )   ! Snow        over sea-ice         (cell average)
+
+      CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow
+      CALL iom_put( 'snow_ao_cea', sprecip(:,:         ) * p_frld(:,:)    )   ! Snow        over ice-free ocean  (cell average)
+      CALL iom_put( 'snow_ai_cea', sprecip(:,:         ) * zicefr(:,:)    )   ! Snow        over sea-ice         (cell average)
       CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
       !   
@@ -1221 +1217 @@
          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
             DO jl=1,jpl
-               ! ** NEED TO MAKE SURE a_i IS PROPERLY SET AND AVAILABLE IN THIS ROUTINE  **
                qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
                qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
@@ -1238 +1233 @@
             &                                                   +          pist(:,:,1)   * zicefr(:,:) ) )
       END SELECT
-      ztmp(:,:) = p_frld(:,:) * zsnow(:,:) * lfus               ! add the latent heat of solid precip. melting
+      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus               ! add the latent heat of solid precip. melting
       qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)                     ! over free ocean 
-      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
+      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
 !!gm
 !!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in 
@@ -1276 +1271 @@
          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
             DO jl=1,jpl
-               ! ** NEED TO MAKE SURE a_i IS PROPERLY SET AND AVAILABLE IN THIS ROUTINE **
                qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
                qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
@@ -1292 +1286 @@
 !       ( see OASIS3 user guide, 5th edition, p39 )
          qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
-            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)   &
+            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       &
             &                     + palbi         (:,:,1) * zicefr(:,:) ) )
       END SELECT
@@ -1320 +1314 @@
       END SELECT
 
-      IF( wrk_not_released(2, 2,3,4,5) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays')
+      IF( wrk_not_released(2, 2,3,4) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays')
       !
    END SUBROUTINE sbc_cpl_ice_flx