Changeset 12785 for NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90

Timestamp:

2020-04-20T20:48:56+02:00 (4 years ago)

Author:

clem

Message:

debug ice evap for the coupling in sbccpl and implement the possibility to read the cloud cover for a more accurate calculation of ice albedo. This functionality is only implemented in the bulk, I leave the task for the coupling to the people who know better (though I put the first bricks already)

File:

• NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90 (modified) (5 diffs)

NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90

@@ -1654 +1654 @@
       !
       INTEGER  ::   ji, jj, jl   ! dummy loop index
-      REAL(wp) ::   ztri         ! local scalar
       REAL(wp), DIMENSION(jpi,jpj)     ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw
       REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice
@@ -1660 +1659 @@
       REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu
+      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri, zcloud_fra
       !!----------------------------------------------------------------------
       !
@@ -1694 +1694 @@
       IF (ln_scale_ice_flux) THEN ! typically met-office requirements
          IF (sn_rcv_emp%clcat == 'yes') THEN
-            WHERE( a_i(:,:,:) > 1.e-10) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
-            ELSEWHERE                   ; zevap_ice(:,:,:) = 0._wp
+            WHERE( a_i(:,:,:) > 1.e-10 )  ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)
+            ELSEWHERE                     ; zevap_ice(:,:,:) = 0._wp
             END WHERE
-            zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:), dim=3 )
+            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
+            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp
+            END WHERE
          ELSE
-            WHERE( picefr(:,:) > 1.e-10) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:)
-            ELSEWHERE                    ; zevap_ice(:,:,1) = 0._wp
+            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:)
+            ELSEWHERE                     ; zevap_ice(:,:,1) = 0._wp
             END WHERE
             zevap_ice_total(:,:) = zevap_ice(:,:,1)
+            DO jl = 2, jpl
+               zevap_ice(:,:,jl) = zevap_ice(:,:,1)
+            ENDDO
          ENDIF
       ELSE
          IF (sn_rcv_emp%clcat == 'yes') THEN
             zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl)
-            zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:), dim=3 )
+            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:)
+            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp
+            END WHERE
          ELSE
             zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1)
             zevap_ice_total(:,:) = zevap_ice(:,:,1)
+            DO jl = 2, jpl
+               zevap_ice(:,:,jl) = zevap_ice(:,:,1)
+            ENDDO
          ENDIF
       ENDIF
@@ -2085 +2095 @@
          ENDIF
       END SELECT
+!!$      !                                                      ! ========================= !
+!!$      SELECT CASE( TRIM( sn_rcv_clouds%cldes ) )             !       cloud fraction      !
+!!$      !                                                      ! ========================= !
+!!$         cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1)
+!!$      END SELECT
+      zcloud_fra(:,:) = cldf_ice   ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
+      IF( ln_mixcpl ) THEN
+         cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:)
+      ELSE
+         cloud_fra(:,:) = zcloud_fra(:,:)
+      ENDIF
       !                                                      ! ========================= !
       !                                                      !      Transmitted Qsr      !   [W/m2]
@@ -2091 +2112 @@
          !
          !                    ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81)
-         ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice    ! surface transmission when hi>10cm (Grenfell Maykut 77)
+         !                    !      should be real cloud fraction instead (as in the bulk) but needs to be read from atm.
+         ztri(:,:) = 0.18 * ( 1.0 - zcloud_fra(:,:) ) + 0.35 * zcloud_fra(:,:)  ! surface transmission when hi>10cm (Grenfell Maykut 77)
          !
-         WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm  
-            zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) )
-         ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (ztri) when hi>10cm
-            zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri
-         ELSEWHERE                                                         ! zero when hs>0
-            zqtr_ice_top(:,:,:) = 0._wp
-         END WHERE
+         DO jl = 1, jpl
+            WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm  
+               zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) )
+            ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm
+               zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:)
+            ELSEWHERE                                                         ! zero when hs>0
+               zqtr_ice_top(:,:,jl) = 0._wp
+            END WHERE
+         ENDDO
          !     
       ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==!