dgoldberg/streamice/streamice_adv_front.F

C $Header: /u/gcmpack/MITgcm_contrib/dgoldberg/streamice/streamice_adv_front.F,v 1.7 2012/10/04 03:45:53 heimbach Exp $
C $Name:  $

#include "STREAMICE_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CBOP
      SUBROUTINE STREAMICE_ADV_FRONT ( 
     & myThid, 
     & time_step,
     & hflux_x_si,
     & hflux_y_si )

C     /============================================================\
C     | SUBROUTINE                                                 |   
C     | o                                                          |
C     |============================================================|
C     |                                                            |
C     \============================================================/
      IMPLICIT NONE

C     === Global variables ===
#include "SIZE.h"
#include "GRID.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "STREAMICE.h"
#include "STREAMICE_ADV.h"
#ifdef ALLOW_AUTODIFF_TAMC
# include "tamc.h"
#endif

      INTEGER myThid
      _RL time_step
      _RL hflux_x_SI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      _RL hflux_y_SI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)

#ifdef ALLOW_STREAMICE

      INTEGER i, j, bi, bj, k, iter_count, iter_rpt
      INTEGER Gi, Gj
      INTEGER new_partial(4)
      INTEGER ikey_front, ikey_1
      _RL iter_flag
      _RL n_flux_1, n_flux_2
      _RL href, rho, partial_vol, tot_flux, hpot
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      _RL hflux_x_SI2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      _RL hflux_y_SI2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)


      rho = streamice_density
cph      iter_count = 0
      iter_flag = 1. _d 0
      iter_rpt = 0

        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          DO j=1-OLy,sNy+OLy
           DO i=1-OLx,sNx+OLx
            hflux_x_SI2(i,j,bi,bj) = 0. _d 0
            hflux_y_SI2(i,j,bi,bj) = 0. _d 0
           ENDDO
          ENDDO
         ENDDO
        ENDDO


      DO iter_count = 0, 3

#ifdef ALLOW_AUTODIFF_TAMC
         ikey_front = (ikey_dynamics-1)*4 + iter_count + 1
CADJ STORE area_shelf_streamice 
CADJ &     = comlev1_stream_front, key = ikey_front
CADJ STORE h_streamice
CADJ &     = comlev1_stream_front, key = ikey_front
CADJ STORE hflux_x_si
CADJ &     = comlev1_stream_front, key = ikey_front
CADJ STORE hflux_x_si2
CADJ &     = comlev1_stream_front, key = ikey_front
CADJ STORE hflux_y_si
CADJ &     = comlev1_stream_front, key = ikey_front
CADJ STORE hflux_y_si2
CADJ &     = comlev1_stream_front, key = ikey_front
CADJ STORE streamice_hmask
CADJ &     = comlev1_stream_front, key = ikey_front
CADJ STORE iter_flag
CADJ &     = comlev1_stream_front, key = ikey_front
#endif

       IF ( iter_flag .GT. 0. ) THEN

       iter_flag = 0. _d 0

       IF (iter_count .gt. 0) then
        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          DO j=1-OLy,sNy+OLy
           DO i=1-OLx,sNx+OLx
            hflux_x_SI(i,j,bi,bj)=hflux_x_SI2(i,j,bi,bj)
            hflux_y_SI(i,j,bi,bj)=hflux_y_SI2(i,j,bi,bj)
            hflux_x_SI2(i,j,bi,bj) = 0. _d 0
            hflux_y_SI2(i,j,bi,bj) = 0. _d 0
           ENDDO
          ENDDO
         ENDDO
        ENDDO        
       ENDIF

!       iter_count = iter_count + 1
       iter_rpt = iter_rpt + 1

       DO bj=myByLo(myThid),myByHi(myThid)
        DO bi=myBxLo(myThid),myBxHi(myThid)

         DO j=1-1,sNy+1
          Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
          IF ((Gj .ge. 1) .and. (Gj .le. Ny)) THEN
           DO i=1-1,sNx+1
            Gi = (myXGlobalLo-1)+(bi-1)*sNx+i

#ifdef ALLOW_AUTODIFF_TAMC
          act1 = bi - myBxLo(myThid)
          max1 = myBxHi(myThid) - myBxLo(myThid) + 1
          act2 = bj - myByLo(myThid)
          max2 = myByHi(myThid) - myByLo(myThid) + 1
          act3 = myThid - 1
          max3 = nTx*nTy
          act4 = ikey_front - 1
          ikey_1 = i + 1
     &         + (sNx+2)*(j)
     &         + (sNx+2)*(sNy+2)*act1
     &         + (sNx+2)*(sNy+2)*max1*act2
     &         + (sNx+2)*(sNy+2)*max1*max2*act3
     &         + (sNx+2)*(sNy+2)*max1*max2*max3*act4
CADJ STORE area_shelf_streamice(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
CADJ STORE h_streamice(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
CADJ STORE hflux_x_si(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
CADJ STORE hflux_y_si(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
CADJ STORE streamice_hmask(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
#endif

            IF ((Gi .ge. 1) .and. (Gi .le. Nx) .and.
     &          (STREAMICE_Hmask(i,j,bi,bj).eq.0.0 .or.
     &           STREAMICE_Hmask(i,j,bi,bj).eq.2.0)) THEN
             n_flux_1 = 0. _d 0
             href = 0. _d 0
             tot_flux = 0. _d 0

#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE hflux_x_SI(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
#endif
             IF (hflux_x_SI(i,j,bi,bj).gt. 0. _d 0) THEN
              n_flux_1 = n_flux_1 + 1. _d 0
              href = href + H_streamice(i-1,j,bi,bj)
              tot_flux = tot_flux + hflux_x_SI(i,j,bi,bj) * 
     &         dxG(i,j,bi,bj) * time_step
              hflux_x_SI(i,j,bi,bj) = 0. _d 0
             ENDIF

#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE hflux_x_SI(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
#endif
             IF (hflux_x_SI(i+1,j,bi,bj).lt. 0. _d 0) THEN
              n_flux_1 = n_flux_1 + 1. _d 0
              href = href + H_streamice(i+1,j,bi,bj)
              tot_flux = tot_flux - hflux_x_SI(i+1,j,bi,bj) * 
     &         dxG(i+1,j,bi,bj) * time_step
              hflux_x_SI(i+1,j,bi,bj) = 0. _d 0
             ENDIF

#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE hflux_y_SI(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
#endif
             IF (hflux_y_SI(i,j,bi,bj).gt. 0. _d 0) THEN
              n_flux_1 = n_flux_1 + 1. _d 0
              href = href + H_streamice(i,j-1,bi,bj)
              tot_flux = tot_flux + hflux_y_SI(i,j,bi,bj) * 
     &         dyG(i,j,bi,bj) * time_step
              hflux_y_SI(i,j,bi,bj) = 0. _d 0
             ENDIF

#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE hflux_y_SI(i,j,bi,bj)
CADJ &     = comlev1_stream_ij, key = ikey_1
#endif
             IF (hflux_y_SI(i,j+1,bi,bj).lt. 0. _d 0) THEN
              n_flux_1 = n_flux_1 + 1. _d 0
              href = href + H_streamice(i,j+1,bi,bj)
              tot_flux = tot_flux - hflux_y_SI(i,j+1,bi,bj) * 
     &         dyG(i,j+1,bi,bj) * time_step
              hflux_y_SI(i,j+1,bi,bj) = 0. _d 0
             ENDIF
 
             IF (n_flux_1 .gt. 0.) THEN

              href = href / n_flux_1
              partial_vol = H_streamice (i,j,bi,bj) * 
     &         area_shelf_streamice (i,j,bi,bj) + tot_flux
              hpot = partial_vol * recip_rA(i,j,bi,bj)
              
              IF (hpot .eq. href) THEN ! cell is exactly covered, no overflow
                STREAMICE_hmask (i,j,bi,bj) = 1.0
                H_streamice (i,j,bi,bj) = href
                area_shelf_streamice(i,j,bi,bj) = 
     &           rA(i,j,bi,bj)
              ELSEIF (hpot .lt. href) THEN ! cell still unfilled


               STREAMICE_hmask (i,j,bi,bj) = 2.0
               area_shelf_streamice (i,j,bi,bj) = partial_vol / href
               H_streamice (i,j,bi,bj) = href
              ELSE ! cell is filled - do overflow


               STREAMICE_hmask (i,j,bi,bj) = 1.0
               area_shelf_streamice(i,j,bi,bj) = 
     &           rA(i,j,bi,bj)

               
               partial_vol = partial_vol - href * rA(i,j,bi,bj)

               iter_flag  = 1. _d 0

               n_flux_2 = 0. _d 0 ; 
               DO k=1,4
                new_partial (:) = 0
               ENDDO

               DO k=1,2
                IF (STREAMICE_ufacemask(i-1+k,j,bi,bj).eq.2.0) THEN  ! at a permanent calving boundary - no advance allowed
                   n_flux_2 = n_flux_2 + 1. _d 0
                ELSEIF (STREAMICE_hmask(i+2*k-3,j,bi,bj).eq.0 _d 0) THEN ! adjacent cell is completely ice free
                   n_flux_2 = n_flux_2 + 1. _d 0
                   new_partial (k) = 1
                ENDIF
               ENDDO
               DO k=1,2
                IF (STREAMICE_vfacemask (i,j-1+k,bi,bj).eq.2.0) THEN
                    n_flux_2 = n_flux_2 + 1. _d 0
                ELSEIF (STREAMICE_hmask(i,j+2*k-3,bi,bj).eq.0 _d 0) THEN
                    n_flux_2 = n_flux_2 + 1. _d 0
                    new_partial (k+2) = 1
                ENDIF
               ENDDO

               IF (n_flux_2 .eq. 0.) THEN ! there is nowhere to put the extra ice!
                H_streamice(i,j,bi,bj) = href + partial_vol *
     &             recip_rA(i,j,bi,bj)
               ELSE
                H_streamice(i,j,bi,bj) = href

                DO k=1,2
                 IF (new_partial(k) .eq. 1) THEN
                  hflux_x_SI2(i-1+k,j,bi,bj) = 
     &             partial_vol/time_step/n_flux_2/
     &               dxG(i-1+k,j,bi,bj)
                 ENDIF
                ENDDO

                DO k=1,2
                 IF (new_partial(k+2) .eq. 1) THEN
                  hflux_y_SI2(i,j-1+k,bi,bj) = 
     &             partial_vol/time_step/n_flux_2/
     &               dxG(i,j-1+k,bi,bj)
                 ENDIF
                ENDDO

               ENDIF
              ENDIF
             ENDIF

            ENDIF
           ENDDO
          ENDIF
         ENDDO
c
        ENDDO
       ENDDO
c
      ENDIF
      ENDDO

      IF (iter_rpt.gt.1) THEN
       WRITE(msgBuf,'(A,I5,A)') 'FRONT ADVANCE: ',iter_rpt,
     &  ' ITERATIONS'
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                     SQUEEZE_RIGHT , 1)       
      ENDIF


#endif
      RETURN
      END
1	dgoldberg	1.8	C $Header: /u/gcmpack/MITgcm_contrib/dgoldberg/streamice/streamice_adv_front.F,v 1.7 2012/10/04 03:45:53 heimbach Exp $
2	heimbach	1.1	C $Name: $
3
4			#include "STREAMICE_OPTIONS.h"
5
6			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7
8			CBOP
9	dgoldberg	1.8	SUBROUTINE STREAMICE_ADV_FRONT (
10			& myThid,
11			& time_step,
12			& hflux_x_si,
13			& hflux_y_si )
14	heimbach	1.1
15			C /============================================================\
16			C \| SUBROUTINE \|
17			C \| o \|
18			C \|============================================================\|
19			C \| \|
20			C \============================================================/
21			IMPLICIT NONE
22
23			C === Global variables ===
24			#include "SIZE.h"
25			#include "GRID.h"
26			#include "EEPARAMS.h"
27			#include "PARAMS.h"
28			#include "STREAMICE.h"
29			#include "STREAMICE_ADV.h"
30	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
31			# include "tamc.h"
32			#endif
33	heimbach	1.1
34			INTEGER myThid
35			_RL time_step
36	dgoldberg	1.8	_RL hflux_x_SI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
37			_RL hflux_y_SI (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
38	heimbach	1.1
39			#ifdef ALLOW_STREAMICE
40
41	dgoldberg	1.3	INTEGER i, j, bi, bj, k, iter_count, iter_rpt
42	heimbach	1.1	INTEGER Gi, Gj
43			INTEGER new_partial(4)
44	heimbach	1.2	INTEGER ikey_front, ikey_1
45			_RL iter_flag
46			_RL n_flux_1, n_flux_2
47	heimbach	1.1	_RL href, rho, partial_vol, tot_flux, hpot
48	dgoldberg	1.4	CHARACTER*(MAX_LEN_MBUF) msgBuf
49	dgoldberg	1.8	_RL hflux_x_SI2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
50			_RL hflux_y_SI2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
51
52	heimbach	1.1
53			rho = streamice_density
54	heimbach	1.2	cph iter_count = 0
55			iter_flag = 1. _d 0
56	dgoldberg	1.3	iter_rpt = 0
57	heimbach	1.2
58	dgoldberg	1.8	DO bj=myByLo(myThid),myByHi(myThid)
59			DO bi=myBxLo(myThid),myBxHi(myThid)
60			DO j=1-OLy,sNy+OLy
61			DO i=1-OLx,sNx+OLx
62			hflux_x_SI2(i,j,bi,bj) = 0. _d 0
63			hflux_y_SI2(i,j,bi,bj) = 0. _d 0
64			ENDDO
65			ENDDO
66			ENDDO
67			ENDDO
68
69
70	heimbach	1.2	DO iter_count = 0, 3
71
72			#ifdef ALLOW_AUTODIFF_TAMC
73			ikey_front = (ikey_dynamics-1)*4 + iter_count + 1
74			CADJ STORE area_shelf_streamice
75			CADJ & = comlev1_stream_front, key = ikey_front
76			CADJ STORE h_streamice
77			CADJ & = comlev1_stream_front, key = ikey_front
78			CADJ STORE hflux_x_si
79			CADJ & = comlev1_stream_front, key = ikey_front
80			CADJ STORE hflux_x_si2
81			CADJ & = comlev1_stream_front, key = ikey_front
82			CADJ STORE hflux_y_si
83			CADJ & = comlev1_stream_front, key = ikey_front
84			CADJ STORE hflux_y_si2
85			CADJ & = comlev1_stream_front, key = ikey_front
86			CADJ STORE streamice_hmask
87			CADJ & = comlev1_stream_front, key = ikey_front
88			CADJ STORE iter_flag
89			CADJ & = comlev1_stream_front, key = ikey_front
90			#endif
91	heimbach	1.1
92	heimbach	1.2	IF ( iter_flag .GT. 0. ) THEN
93
94			iter_flag = 0. _d 0
95	heimbach	1.1
96			IF (iter_count .gt. 0) then
97			DO bj=myByLo(myThid),myByHi(myThid)
98			DO bi=myBxLo(myThid),myBxHi(myThid)
99			DO j=1-OLy,sNy+OLy
100			DO i=1-OLx,sNx+OLx
101			hflux_x_SI(i,j,bi,bj)=hflux_x_SI2(i,j,bi,bj)
102			hflux_y_SI(i,j,bi,bj)=hflux_y_SI2(i,j,bi,bj)
103			hflux_x_SI2(i,j,bi,bj) = 0. _d 0
104			hflux_y_SI2(i,j,bi,bj) = 0. _d 0
105			ENDDO
106			ENDDO
107			ENDDO
108			ENDDO
109			ENDIF
110
111	heimbach	1.2	! iter_count = iter_count + 1
112	dgoldberg	1.3	iter_rpt = iter_rpt + 1
113	heimbach	1.1
114			DO bj=myByLo(myThid),myByHi(myThid)
115			DO bi=myBxLo(myThid),myBxHi(myThid)
116	heimbach	1.2
117	heimbach	1.1	DO j=1-1,sNy+1
118			Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
119	heimbach	1.7	IF ((Gj .ge. 1) .and. (Gj .le. Ny)) THEN
120	heimbach	1.1	DO i=1-1,sNx+1
121			Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
122	heimbach	1.2
123			#ifdef ALLOW_AUTODIFF_TAMC
124			act1 = bi - myBxLo(myThid)
125			max1 = myBxHi(myThid) - myBxLo(myThid) + 1
126			act2 = bj - myByLo(myThid)
127			max2 = myByHi(myThid) - myByLo(myThid) + 1
128			act3 = myThid - 1
129			max3 = nTx*nTy
130			act4 = ikey_front - 1
131	dgoldberg	1.6	ikey_1 = i + 1
132			& + (sNx+2)*(j)
133	heimbach	1.5	& + (sNx+2)(sNy+2)act1
134			& + (sNx+2)(sNy+2)max1*act2
135			& + (sNx+2)(sNy+2)max1max2act3
136			& + (sNx+2)(sNy+2)max1max2max3*act4
137	heimbach	1.2	CADJ STORE area_shelf_streamice(i,j,bi,bj)
138			CADJ & = comlev1_stream_ij, key = ikey_1
139			CADJ STORE h_streamice(i,j,bi,bj)
140			CADJ & = comlev1_stream_ij, key = ikey_1
141			CADJ STORE hflux_x_si(i,j,bi,bj)
142			CADJ & = comlev1_stream_ij, key = ikey_1
143			CADJ STORE hflux_y_si(i,j,bi,bj)
144			CADJ & = comlev1_stream_ij, key = ikey_1
145			CADJ STORE streamice_hmask(i,j,bi,bj)
146			CADJ & = comlev1_stream_ij, key = ikey_1
147			#endif
148
149	heimbach	1.7	IF ((Gi .ge. 1) .and. (Gi .le. Nx) .and.
150			& (STREAMICE_Hmask(i,j,bi,bj).eq.0.0 .or.
151	heimbach	1.1	& STREAMICE_Hmask(i,j,bi,bj).eq.2.0)) THEN
152	heimbach	1.2	n_flux_1 = 0. _d 0
153	heimbach	1.1	href = 0. _d 0
154			tot_flux = 0. _d 0
155
156	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
157			CADJ STORE hflux_x_SI(i,j,bi,bj)
158			CADJ & = comlev1_stream_ij, key = ikey_1
159			#endif
160	heimbach	1.1	IF (hflux_x_SI(i,j,bi,bj).gt. 0. _d 0) THEN
161	heimbach	1.2	n_flux_1 = n_flux_1 + 1. _d 0
162	heimbach	1.1	href = href + H_streamice(i-1,j,bi,bj)
163			tot_flux = tot_flux + hflux_x_SI(i,j,bi,bj) *
164			& dxG(i,j,bi,bj) * time_step
165			hflux_x_SI(i,j,bi,bj) = 0. _d 0
166			ENDIF
167
168	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
169			CADJ STORE hflux_x_SI(i,j,bi,bj)
170			CADJ & = comlev1_stream_ij, key = ikey_1
171			#endif
172	heimbach	1.1	IF (hflux_x_SI(i+1,j,bi,bj).lt. 0. _d 0) THEN
173	heimbach	1.2	n_flux_1 = n_flux_1 + 1. _d 0
174	heimbach	1.1	href = href + H_streamice(i+1,j,bi,bj)
175			tot_flux = tot_flux - hflux_x_SI(i+1,j,bi,bj) *
176			& dxG(i+1,j,bi,bj) * time_step
177			hflux_x_SI(i+1,j,bi,bj) = 0. _d 0
178			ENDIF
179
180	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
181			CADJ STORE hflux_y_SI(i,j,bi,bj)
182			CADJ & = comlev1_stream_ij, key = ikey_1
183			#endif
184	heimbach	1.1	IF (hflux_y_SI(i,j,bi,bj).gt. 0. _d 0) THEN
185	heimbach	1.2	n_flux_1 = n_flux_1 + 1. _d 0
186	heimbach	1.1	href = href + H_streamice(i,j-1,bi,bj)
187			tot_flux = tot_flux + hflux_y_SI(i,j,bi,bj) *
188			& dyG(i,j,bi,bj) * time_step
189			hflux_y_SI(i,j,bi,bj) = 0. _d 0
190			ENDIF
191
192	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
193			CADJ STORE hflux_y_SI(i,j,bi,bj)
194			CADJ & = comlev1_stream_ij, key = ikey_1
195			#endif
196	heimbach	1.1	IF (hflux_y_SI(i,j+1,bi,bj).lt. 0. _d 0) THEN
197	heimbach	1.2	n_flux_1 = n_flux_1 + 1. _d 0
198	heimbach	1.1	href = href + H_streamice(i,j+1,bi,bj)
199			tot_flux = tot_flux - hflux_y_SI(i,j+1,bi,bj) *
200			& dyG(i,j+1,bi,bj) * time_step
201			hflux_y_SI(i,j+1,bi,bj) = 0. _d 0
202			ENDIF
203
204	heimbach	1.2	IF (n_flux_1 .gt. 0.) THEN
205	heimbach	1.1
206	heimbach	1.2	href = href / n_flux_1
207	heimbach	1.1	partial_vol = H_streamice (i,j,bi,bj) *
208			& area_shelf_streamice (i,j,bi,bj) + tot_flux
209			hpot = partial_vol * recip_rA(i,j,bi,bj)
210
211			IF (hpot .eq. href) THEN ! cell is exactly covered, no overflow
212			STREAMICE_hmask (i,j,bi,bj) = 1.0
213			H_streamice (i,j,bi,bj) = href
214			area_shelf_streamice(i,j,bi,bj) =
215			& rA(i,j,bi,bj)
216			ELSEIF (hpot .lt. href) THEN ! cell still unfilled
217
218	dgoldberg	1.4
219	heimbach	1.1
220			STREAMICE_hmask (i,j,bi,bj) = 2.0
221			area_shelf_streamice (i,j,bi,bj) = partial_vol / href
222			H_streamice (i,j,bi,bj) = href
223			ELSE ! cell is filled - do overflow
224
225
226			STREAMICE_hmask (i,j,bi,bj) = 1.0
227			area_shelf_streamice(i,j,bi,bj) =
228			& rA(i,j,bi,bj)
229
230
231			partial_vol = partial_vol - href * rA(i,j,bi,bj)
232
233	heimbach	1.2	iter_flag = 1. _d 0
234	heimbach	1.1
235	heimbach	1.2	n_flux_2 = 0. _d 0 ;
236	heimbach	1.1	DO k=1,4
237			new_partial (:) = 0
238			ENDDO
239
240			DO k=1,2
241			IF (STREAMICE_ufacemask(i-1+k,j,bi,bj).eq.2.0) THEN ! at a permanent calving boundary - no advance allowed
242	heimbach	1.2	n_flux_2 = n_flux_2 + 1. _d 0
243	heimbach	1.1	ELSEIF (STREAMICE_hmask(i+2*k-3,j,bi,bj).eq.0 _d 0) THEN ! adjacent cell is completely ice free
244	heimbach	1.2	n_flux_2 = n_flux_2 + 1. _d 0
245	heimbach	1.1	new_partial (k) = 1
246			ENDIF
247			ENDDO
248			DO k=1,2
249			IF (STREAMICE_vfacemask (i,j-1+k,bi,bj).eq.2.0) THEN
250	heimbach	1.2	n_flux_2 = n_flux_2 + 1. _d 0
251	heimbach	1.1	ELSEIF (STREAMICE_hmask(i,j+2*k-3,bi,bj).eq.0 _d 0) THEN
252	heimbach	1.2	n_flux_2 = n_flux_2 + 1. _d 0
253	heimbach	1.1	new_partial (k+2) = 1
254			ENDIF
255			ENDDO
256
257	heimbach	1.2	IF (n_flux_2 .eq. 0.) THEN ! there is nowhere to put the extra ice!
258	heimbach	1.1	H_streamice(i,j,bi,bj) = href + partial_vol *
259			& recip_rA(i,j,bi,bj)
260			ELSE
261			H_streamice(i,j,bi,bj) = href
262
263			DO k=1,2
264			IF (new_partial(k) .eq. 1) THEN
265			hflux_x_SI2(i-1+k,j,bi,bj) =
266	heimbach	1.2	& partial_vol/time_step/n_flux_2/
267	heimbach	1.1	& dxG(i-1+k,j,bi,bj)
268			ENDIF
269			ENDDO
270
271			DO k=1,2
272			IF (new_partial(k+2) .eq. 1) THEN
273			hflux_y_SI2(i,j-1+k,bi,bj) =
274	heimbach	1.2	& partial_vol/time_step/n_flux_2/
275	heimbach	1.1	& dxG(i,j-1+k,bi,bj)
276			ENDIF
277			ENDDO
278
279			ENDIF
280			ENDIF
281			ENDIF
282	heimbach	1.2
283	heimbach	1.1	ENDIF
284			ENDDO
285	heimbach	1.7	ENDIF
286	heimbach	1.1	ENDDO
287	heimbach	1.2	c
288	heimbach	1.1	ENDDO
289			ENDDO
290	heimbach	1.2	c
291			ENDIF
292	heimbach	1.1	ENDDO
293
294	dgoldberg	1.3	IF (iter_rpt.gt.1) THEN
295	dgoldberg	1.4	WRITE(msgBuf,'(A,I5,A)') 'FRONT ADVANCE: ',iter_rpt,
296			& ' ITERATIONS'
297			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
298			& SQUEEZE_RIGHT , 1)
299	dgoldberg	1.3	ENDIF
300	heimbach	1.1
301
302
303			#endif
304			RETURN
305			END