Changeset 6736 for branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90

Timestamp:

2016-06-24T09:50:27+02:00 (8 years ago)

Author:

jamesharle

Message:

FASTNEt code modifications

File:

• branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90 (modified) (5 diffs)

branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90

@@ -6 +6 @@
    !!  History :  3.3  !  2010-09 (D. Storkey)  Original code
    !!             3.4  !  2011    (D. Storkey) rewrite in preparation for OBC-BDY merge
-   !!             3.5  !  2012    (S. Mocavero, I. Epicoco) Optimization of BDY communications
    !!----------------------------------------------------------------------
 #if defined   key_bdy   &&   defined key_lim2
@@ -54 +53 @@
             CYCLE
          CASE(jp_frs)
-            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy )
+            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) )
          CASE DEFAULT
             CALL ctl_stop( 'bdy_ice_lim_2 : unrecognised option for open boundaries for ice fields' )
@@ -62 +61 @@
    END SUBROUTINE bdy_ice_lim_2
 
-   SUBROUTINE bdy_ice_frs( idx, dta, ib_bdy )
+   SUBROUTINE bdy_ice_frs( idx, dta )
       !!------------------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_ice_frs  ***
@@ -74 +73 @@
       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
       !!
-      INTEGER  ::   jb, jk, jgrd   ! dummy loop indices
+      INTEGER  ::   jb, jgrd   ! dummy loop indices
       INTEGER  ::   ii, ij         ! local scalar
       REAL(wp) ::   zwgt, zwgt1    ! local scalar
@@ -86 +84 @@
       !
       DO jb = 1, idx%nblen(jgrd)
-         DO jk = 1, jpkm1
             ii    = idx%nbi(jb,jgrd)
             ij    = idx%nbj(jb,jgrd)
             zwgt  = idx%nbw(jb,jgrd)
             zwgt1 = 1.e0 - idx%nbw(jb,jgrd)
+#if defined key_lim2_iceconc
+            frld (ii,ij) = ( frld (ii,ij) * zwgt1 + ( 1._wp - dta%frld (jb) ) * zwgt ) * tmask(ii,ij,1)     ! Leads fraction from ice fraction
+#else
             frld (ii,ij) = ( frld (ii,ij) * zwgt1 + dta%frld (jb) * zwgt ) * tmask(ii,ij,1)     ! Leads fraction 
+#endif
             hicif(ii,ij) = ( hicif(ii,ij) * zwgt1 + dta%hicif(jb) * zwgt ) * tmask(ii,ij,1)     ! Ice depth 
             hsnif(ii,ij) = ( hsnif(ii,ij) * zwgt1 + dta%hsnif(jb) * zwgt ) * tmask(ii,ij,1)     ! Snow depth
-         END DO
       END DO 
-      CALL lbc_bdy_lnk( frld, 'T', 1., ib_bdy )                                         ! lateral boundary conditions
-      CALL lbc_bdy_lnk( hicif, 'T', 1., ib_bdy )   ;   CALL lbc_bdy_lnk( hsnif, 'T', 1., ib_bdy )
+      CALL lbc_lnk( frld, 'T', 1. )                                         ! lateral boundary conditions
+      CALL lbc_lnk( hicif, 'T', 1. )   ;   CALL lbc_lnk( hsnif, 'T', 1. )
       !      
       IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs')