Changeset 6200 for branches/UKMO/dev_r5518_med_test/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

Timestamp:

2016-01-04T11:49:32+01:00 (8 years ago)

Author:

frrh

Message:

Merge in branches/UKMO/dev_r5518_coupling_GSI7_GSI8_landice@5797
and MY medusa interface, resolve conflicts in sbccpl and, mysteriously
in sbcice_cice.F90 which frankly should not occur since I am doing nothing in
here!

File:

• branches/UKMO/dev_r5518_med_test/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90 (modified) (5 diffs)

branches/UKMO/dev_r5518_med_test/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

@@ -161 +161 @@
       INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type
       REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2
-      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ztfrz3d
       INTEGER  ::   ji, jj, jl, jk                    ! dummy loop indices
       !!---------------------------------------------------------------------
@@ -174 +174 @@
       jj_off = INT ( (jpjglo - ny_global) / 2 )
 
-#if defined key_nemocice_decomp
-      ! Pass initial SST from NEMO to CICE so ice is initialised correctly if
-      ! there is no restart file.
-      ! Values from a CICE restart file would overwrite this
-      IF ( .NOT. ln_rstart ) THEN    
-         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 
-      ENDIF  
-#endif
-
-! Initialize CICE
+      ! Initialize CICE
       CALL CICE_Initialize
 
-! Do some CICE consistency checks
+      ! Do some CICE consistency checks
       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
          IF ( calc_strair .OR. calc_Tsfc ) THEN
@@ -198 +189 @@
 
 
-! allocate sbc_ice and sbc_cice arrays
-      IF( sbc_ice_alloc()      /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate arrays' )
+      ! allocate sbc_ice and sbc_cice arrays
+      IF( sbc_ice_alloc()      /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_alloc : unable to allocate arrays' )
       IF( sbc_ice_cice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' )
 
-! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart
+      ! Ensure that no temperature points are below freezing if not a NEMO restart
       IF( .NOT. ln_rstart ) THEN
-         tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz)
+
+         CALL wrk_alloc( jpi,jpj,jpk, ztfrz3d ) 
+         DO jk=1,jpk
+            ztfrz3d(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept_n(:,:,jk) )
+         ENDDO
+         tsn(:,:,:,jp_tem) = MAX( tsn(:,:,:,jp_tem), ztfrz3d )
          tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)
-      ENDIF
-
-      fr_iu(:,:)=0.0
-      fr_iv(:,:)=0.0
+         CALL wrk_dealloc( jpi,jpj,jpk, ztfrz3d ) 
+
+#if defined key_nemocice_decomp
+         ! Pass initial SST from NEMO to CICE so ice is initialised correctly if
+         ! there is no restart file.
+         ! Values from a CICE restart file would overwrite this
+         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 
+#endif
+
+      ENDIF  
+
+      ! calculate surface freezing temperature and send to CICE
+      sstfrz(:,:) = eos_fzp(sss_m(:,:), fsdept_n(:,:,1)) 
+      CALL nemo2cice(sstfrz,Tf, 'T', 1. )
 
       CALL cice2nemo(aice,fr_i, 'T', 1. )
@@ -220 +226 @@
 ! T point to U point
 ! T point to V point
+      fr_iu(:,:)=0.0
+      fr_iv(:,:)=0.0
       DO jj=1,jpjm1
          DO ji=1,jpim1
@@ -348 +356 @@
                ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl)
             ENDDO
-         ELSE
-! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow
-            qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub
-! End of temporary code
-            DO jj=1,jpj
-               DO ji=1,jpi
-                  IF (fr_i(ji,jj).eq.0.0) THEN
-                     DO jl=1,ncat
-                        ztmpn(ji,jj,jl)=0.0
-                     ENDDO
-                     ! This will then be conserved in CICE
-                     ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
-                  ELSE
-                     DO jl=1,ncat
-                        ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj)
-                     ENDDO
-                  ENDIF
-               ENDDO
+         ELSE IF (ksbc == jp_purecpl) THEN
+            DO jl=1,ncat
+               ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i(:,:,jl)
             ENDDO
+    ELSE
+           !In coupled mode - qla_ice calculated in sbc_cpl for each category
+           ztmpn(:,:,1:ncat)=qla_ice(:,:,1:ncat)
          ENDIF
          DO jl=1,ncat