dgoldberg/streamice/streamice_adv_front.F

C $Header: /u/gcmpack/MITgcm_contrib/dgoldberg/streamice/streamice_adv_front.F,v 1.3 2012/05/03 15:52:06 dgoldberg Exp $
C $Name:  $

#include "STREAMICE_OPTIONS.h"

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

CBOP
      SUBROUTINE STREAMICE_ADV_FRONT ( myThid, time_step )

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

#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

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

      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
cph          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
     &         + sNx*(j-1)
     &         + sNx*sNy*act1
     &         + sNx*sNy*max1*act2
     &         + sNx*sNy*max1*max2*act3
     &         + sNx*sNy*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

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