Changeset 9019 for branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_sbc.F90

Timestamp:

2017-12-13T15:58:53+01:00 (6 years ago)

Author:

timgraham

Message:

Merge of dev_CNRS_2017 into branch

File:

• branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_sbc.F90 (modified) (6 diffs)

branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_sbc.F90

@@ -18 +18 @@
    USE sbc_ice         ! Surface boundary condition: ice fields
    USE phycst          ! physical constants
-   USE ice, ONLY       : pfrld, a_i_b
-   USE limthd_dh       ! for CALL lim_thd_snwblow
+   USE ice, ONLY       : at_i_b, a_i_b
+   USE icethd_dh       ! for CALL ice_thd_snwblow
    !
    USE in_out_manager  ! I/O manager
@@ -25 +25 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
-   USE wrk_nemo
 
    IMPLICIT NONE
@@ -86 +85 @@
       INTEGER, INTENT(in) ::   kt   ! ocean time step
       !!---------------------------------------------------------------------
-      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : SAS_BIPER case: NO stress forcing'
+      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : SAS_BIPER case: constant stress forcing'
       !
-      utau_ice(:,:) = 0._wp
+      utau_ice(:,:) = 1.3_wp   ! <=> 0.5 m/s
       vtau_ice(:,:) = 0._wp
       !
    END SUBROUTINE usrdef_sbc_ice_tau
 
-   SUBROUTINE usrdef_sbc_ice_flx( kt )
+   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE usrdef_sbc_ice_flx  ***
@@ -99 +98 @@
       !! ** Purpose :   provide the surface boundary (flux) condition over sea-ice
       !!---------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), POINTER ::   zsnw       ! snw distribution after wind blowing
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
+      !!
+      REAL(wp) ::   zfr1, zfr2                 ! local variables
+      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing
       !!---------------------------------------------------------------------
-      CALL wrk_alloc( jpi,jpj, zsnw )
       !
       IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : SAS_BIPER case: NO flux forcing'
@@ -120 +122 @@
       ! ice fields deduced from above
       zsnw(:,:) = 1._wp
-      !!CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
+      !!CALL lim_thd_snwblow( at_i_b, zsnw )  ! snow distribution over ice after wind blowing 
       emp_ice  (:,:)   = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
       emp_oce  (:,:)   = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
@@ -130 +132 @@
       ! total fluxes
       emp_tot (:,:) = emp_ice  + emp_oce
-      qns_tot (:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
-      qsr_tot (:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
+      qns_tot (:,:) = at_i_b(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
+      qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
 
-      !--------------------------------------------------------------------
-      ! FRACTIONs of net shortwave radiation which is not absorbed in the
-      ! thin surface layer and penetrates inside the ice cover
-      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 )
-      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
-      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
-
-      CALL wrk_dealloc( jpi,jpj, zsnw )
-
+      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- !
+      zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm
+      zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1
+      !
+      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm  
+         qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )
+      ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm
+         qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) * zfr1
+      ELSEWHERE                                                         ! zero when hs>0
+         qsr_ice_tr(:,:,:) = 0._wp 
+      END WHERE
+          
    END SUBROUTINE usrdef_sbc_ice_flx