Changeset 8962 for branches/2017/dev_CNRS_2017/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_sbc.F90

Timestamp:

2017-12-08T16:15:25+01:00 (6 years ago)

Author:

clem

Message:

changes to improve test case SASBIPER

File:

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

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

@@ -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
@@ -93 +92 @@
    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'
@@ -133 +135 @@
       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