Changeset 5026 for branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

Timestamp:

2015-01-14T12:48:38+01:00 (9 years ago)

Author:

timgraham

Message:

First set of changes for multicategory coupling with CICE

File:

• branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (3 diffs)

branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

@@ -43 +43 @@
 #if defined key_cpl_carbon_cycle
    USE p4zflx, ONLY : oce_co2
-#endif
-#if defined key_cice
-   USE ice_domain_size, only: ncat
 #endif
    IMPLICIT NONE
@@ -367 +364 @@
       CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' )
       END SELECT
-
+      !Set the number of categories for coupling of sublimation
+      IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl
+      !
       !                                                      ! ------------------------- !
       !                                                      !     Runoffs & Calving     !   
@@ -1126 +1125 @@
          tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here
          emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)
+#if defined key_cice
+         IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN
+            ! emp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow
+            emp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1)
+            DO jl=1,jpl
+               emp_ice(:,:   ) = emp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl)
+            ENDDO
+            ! latent heat coupled for each category in CICE
+            qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub
+         ELSE
+            ! If CICE has multicategories it still expects coupling fields for
+            ! each even if we treat as a single field
+            ! The latent heat flux is split between the ice categories according
+            ! to the fraction of the ice in each category
+            emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
+            WHERE ( zicefr(:,:) /= 0._wp ) 
+               ztmp(:,:) = 1./zicefr(:,:)
+            ELSEWHERE 
+               ztmp(:,:) = 0.e0
+            END WHERE  
+            DO jl=1,jpl
+               qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub 
+            END DO
+            WHERE ( zicefr(:,:) == 0._wp )  qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub 
+         ENDIF
+#else
          emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
+#endif
             CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation 
          IF( iom_use('hflx_rain_cea') )   &