Changeset 8962 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO

Timestamp:

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

Author:

clem

Message:

changes to improve test case SASBIPER

Location:

branches/2017/dev_CNRS_2017/NEMOGCM/NEMO

Files:

• LIM_SRC_3/iceforcing.F90 (modified) (1 diff)
• OPA_SRC/SBC/sbcblk.F90 (modified) (2 diffs)
• OPA_SRC/SBC/sbccpl.F90 (modified) (4 diffs)
• OPA_SRC/USR/usrdef_sbc.F90 (modified) (1 diff)

branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/LIM_SRC_3/iceforcing.F90

@@ -139 +139 @@
       !
       CASE( jp_usr )              !--- user defined formulation
-                                  CALL usrdef_sbc_ice_flx( kt )
+                                  CALL usrdef_sbc_ice_flx( kt, h_s, h_i )
       CASE( jp_blk )              !--- bulk formulation
                                   CALL blk_ice_flx    ( t_su, h_s, h_i, alb_ice )    ! 

branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90

@@ -843 +843 @@
       REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      -
       REAL(wp) ::   zztmp, z1_lsub           !   -      -
-      REAL(wp) ::   zfrqsr_tr_i              ! sea ice shortwave fraction transmitted below through the ice
-      REAL(wp) ::   zfr1, zfr2, zfac         ! local variables
+      REAL(wp) ::   zfr1, zfr2               ! local variables
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qlw         ! long wave heat flux over ice
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qsb         ! sensible  heat flux over ice
@@ -951 +950 @@
       END DO
 
-      ! --- absorbed and transmitted shortwave radiation (W/m2) --- !
-      !
-      ! former coding was
-      !     fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
-      !     fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
-
-      ! --- surface transmission parameter (i0, Grenfell Maykut 77) --- !
-      zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            !   standard value
-      zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            !   zfr2 such that zfr1 + zfr2 to equal 1
-
-      qsr_ice_tr(:,:,:) = 0._wp
-
-      DO jl = 1, jpl
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               zfac = MAX( 0._wp , 1._wp - phi(ji,jj,jl) * 10._wp )     !   linear weighting factor: =0 for phi=0, =1 for phi = 0.1
-               zfrqsr_tr_i = zfr1 + zfac * zfr2                         !   below 10 cm, linearly increase zfrqsr_tr_i until 1 at zero thickness
-               !
-               IF ( phs(ji,jj,jl) <= 0._wp ) THEN   ;    zfrqsr_tr_i  = zfr1 + zfac * zfr2
-               ELSE                                 ;    zfrqsr_tr_i  = 0._wp                                  !   snow fully opaque
-               ENDIF
-               !
-               qsr_ice_tr(ji,jj,jl) = zfrqsr_tr_i * qsr_ice(ji,jj,jl)   !   transmitted solar radiation 
-               !
-            END DO
-         END DO
-      END DO
+      ! --- 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
       !
       IF(ln_ctl) THEN

branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

@@ -47 +47 @@
    USE iom            ! NetCDF library
    USE lib_mpp        ! distribued memory computing library
-   USE wrk_nemo       ! work arrays
    USE timing         ! Timing
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
@@ -244 +243 @@
       INTEGER ::   jn          ! dummy loop index
       INTEGER ::   ios, inum   ! Local integer
-      REAL(wp), POINTER, DIMENSION(:,:) ::   zacs, zaos
+      REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos
       !!
       NAMELIST/namsbc_cpl/  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2  ,   & 
@@ -258 +257 @@
       IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_init')
       !
-      CALL wrk_alloc( jpi,jpj,   zacs, zaos )
-
       ! ================================ !
       !      Namelist informations       !
@@ -1028 +1025 @@
       IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq
 
-      CALL wrk_dealloc( jpi,jpj,   zacs, zaos )
       !
       IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_init')

branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90

@@ -229 +229 @@
    END SUBROUTINE usrdef_sbc_ice_tau
 
-   SUBROUTINE usrdef_sbc_ice_flx( kt )
+   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
+      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
    END SUBROUTINE usrdef_sbc_ice_flx