dgoldberg/streamice/streamice_init_varia.F

C $Header: /u/gcmpack/MITgcm_contrib/dgoldberg/streamice/streamice_init_varia.F,v 1.1 2012/03/29 15:59:21 heimbach Exp $
C $Name:  $

#include "STREAMICE_OPTIONS.h"

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

CBOP
      SUBROUTINE STREAMICE_INIT_VARIA( myThid )
C     /============================================================\
C     | SUBROUTINE STREAMICE_INIT_VARIA                             |
C     | o Routine to initialize STREAMICE variables.                |
C     |============================================================|
C     | Initialize STREAMICE parameters and variables.              |
C     \============================================================/
      IMPLICIT NONE

C     === Global variables ===
#include "SIZE.h"
#include "GRID.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "STREAMICE.h"
#include "STREAMICE_CG.h"
#include "STREAMICE_ADV.h"

C     === Routine arguments ===
C     myThid -  Number of this instance of STREAMICE_INIT_VARIA
      INTEGER myThid
CEndOfInterface

#ifdef ALLOW_STREAMICE
C     === Local variables ===
C     I,J,bi,bj - Loop counters
      INTEGER i, j, k, bi, bj, Gi, Gj
      INTEGER col_y, col_x
      _RL slope_pos, c1
      CHARACTER*(MAX_LEN_MBUF) msgBuf
CEOP

C     ZERO OUT FLOATING POINT ARRAYS

      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
        DO j=1-Oly,sNy+Oly
         DO i=1-Olx,sNx+Olx
          H_streamIce(i,j,bi,bj) = 0. _d 0
          U_streamice(i,j,bi,bj) = 0. _d 0
          V_streamice(i,j,bi,bj) = 0. _d 0
          visc_streamice(i,j,bi,bj) = 0. _d 0
          tau_beta_eff_streamice(i,j,bi,bj) = 0. _d 0
          float_frac_streamice(i,j,bi,bj) = 0. _d 0
          base_el_streamice(i,j,bi,bj) = 0. _d 0
          surf_el_streamice(i,j,bi,bj) = 0. _d 0
          area_shelf_streamice(i,j,bi,bj) = 0. _d 0
          mass_ice_streamice(i,j,bi,bj) = 0. _d 0
          C_basal_friction(i,j,bi,bj) = C_basal_fric_const
#ifdef ALLOW_AUTODIFF_TAMC
          ru_old_si(i,j,bi,bj) = 0. _d 0
          rv_old_si(i,j,bi,bj) = 0. _d 0
          zu_old_si(i,j,bi,bj) = 0. _d 0
          zv_old_si(i,j,bi,bj) = 0. _d 0
          h_after_uflux_SI(i,j,bi,bj) = 0. _d 0
#endif
         ENDDO
        ENDDO
       ENDDO
      ENDDO

      DO j = 1-oly, sNy+oly
       DO i = 1-olx, sNx+olx
        DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)
cc          DO k=1,4
           DO col_x=-1,1
            DO col_y=-1,1
             streamice_cg_A1(i,j,bi,bj,col_x,col_y)=0.0
             streamice_cg_A2(i,j,bi,bj,col_x,col_y)=0.0
             streamice_cg_A3(i,j,bi,bj,col_x,col_y)=0.0
             streamice_cg_A4(i,j,bi,bj,col_x,col_y)=0.0
            ENDDO
           ENDDO
cc          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO

C     INIT. INTEGER ARRAYS

      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
        DO j=1-Oly,sNy+Oly
         DO i=1-Olx,sNx+Olx
          STREAMICE_hmask(i,j,bi,bj) = -1.0
          STREAMICE_umask(i,j,bi,bj) = 0.0
          STREAMICE_vmask(i,j,bi,bj) = 0.0
          STREAMICE_ufacemask(i,j,bi,bj) = 0.0
          STREAMICE_vfacemask(i,j,bi,bj) = 0.0
          STREAMICE_float_cond(i,j,bi,bj) = 0.0
         ENDDO
        ENDDO
       ENDDO
      ENDDO

!ph      SELECT CASE (TRIM(STREAMICEthickInit))
    
      IF ( STREAMICEthickInit.EQ.'PARAM' ) THEN

      WRITE(msgBuf,'(A)') 'initializing analytic thickness'
      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                    SQUEEZE_RIGHT , 1)

       slope_pos = shelf_edge_pos - shelf_flat_width
       c1 = 0.0 
       IF (shelf_slope_scale .GT. 0.0) THEN
        c1 = 1.0 / shelf_slope_scale
       ENDIF

       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)
         DO j=1,sNy
          DO i=1,sNx
           Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
           Gj = (myYGlobalLo-1)+(bj-1)*sNy+j

           
           
           IF ((Gi.lt.Nx).and.(Gj.lt.Ny)) THEN
            
C             IF (flow_dir .EQ. 2.0) THEN
            IF (.TRUE.) THEN
             IF (xC(i-1,j,bi,bj).GE.shelf_edge_pos) THEN
              area_shelf_streamice(i,j,bi,bj) = 0. _d 0
              STREAMICE_hmask(i,j,bi,bj) = 0. _d 0
             ELSE

              IF (xC(i,j,bi,bj).GT.slope_pos) THEN
               H_streamice (i,j,bi,bj) = shelf_min_draft
              ELSE
               H_streamice (i,j,bi,bj) = (shelf_min_draft + 
     &          (shelf_max_draft - shelf_min_draft) * 
     &          min (1.0, (c1*(slope_pos-xC(i,j,bi,bj)))**2))
              ENDIF

              IF (xC(i,j,bi,bj).GT.shelf_edge_pos) THEN
               area_shelf_streamice(i,j,bi,bj) = rA(i,j,bi,bj) *
     &          (shelf_edge_pos-xG(i,j,bi,bj)) /
     &          (xG(i+1,j,bi,bj)-xG(i,j,bi,bj))
               IF (area_shelf_streamice(i,j,bi,bj).gt. 0._d 0) THEN
                STREAMICE_hmask(i,j,bi,bj) = 2.0
               ELSE
                STREAMICE_hmask(i,j,bi,bj) = 0.0
                H_streamice(i,j,bi,bj) = 0.0
               ENDIF
              ELSE
               area_shelf_streamice(i,j,bi,bj) = rA(i,j,bi,bj) 
               STREAMICE_hmask(i,j,bi,bj) = 1.0
              ENDIF

c              WRITE(msgBuf,'(A,I3,I3,E9.2)') 'thickness',
c     &          i,j,shelf_edge_pos
c              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
c     &                    SQUEEZE_RIGHT , 1)

             ENDIF
            ENDIF
           ENDIF  
          ENDDO
         ENDDO
        ENDDO
       ENDDO

!        DO bj = myByLo(myThid), myByHi(myThid)
!         DO bi = myBxLo(myThid), myBxHi(myThid)
!          DO j=1,sNy
!           DO i=1,sNx
!            STREAMICE_dummy_array(i,j,bi,bj) =
!      &      REAL(STREAMICE_hmask(i,j,bi,bj))
!            WRITE(msgBuf,'(F3.0)') STREAMICE_dummy_array(i,j,bi,bj)
!            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
!      &                    SQUEEZE_RIGHT , 1)
!           ENDDO
!          ENDDO
!         ENDDO
!        ENDDO
!        
!        CALL WRITE_FLD_XY_RL("STREAMICE_hmask"," ",
!      &    STREAMICE_dummy_array,0,myThid)    
!        CALL WRITE_FLD_XY_RL("h_streamice"," ",
!      &    H_streamice,0,myThid) 

      ELSE IF ( STREAMICEthickInit.EQ.'FILE' ) THEN

       IF ( STREAMICEthickFile .NE. ' ' ) THEN
        _BARRIER
C The 0 is the "iteration" argument. The ' ' is an empty suffix
        CALL READ_FLD_XY_RS( STREAMICEthickFile, ' ', H_streamice,
     &      0, myThid )
        DO bj = myByLo(myThid), myByHi(myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)
          DO j=1,sNy
           DO i=1,sNx
            Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
            Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
            IF ((Gi.lt.Nx).and.(Gj.lt.Ny)) THEN
             IF (H_streamice(i,j,bi,bj).GT.0. _d 0) THEN
              area_shelf_streamice(i,j,bi,bj) = rA(i,j,bi,bj)
              STREAMICE_hmask(i,j,bi,bj) = 1.0
             ELSE
              area_shelf_streamice(i,j,bi,bj) = 0. _d 0
              STREAMICE_hmask(i,j,bi,bj) = 0. _d 0
             ENDIF
            ENDIF
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ELSE
        WRITE(msgBuf,'(A)') 'INIT THICKNESS - FILENAME MISSING'
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                    SQUEEZE_RIGHT , 1)
       ENDIF
      
      ELSE

       WRITE(msgBuf,'(A)') 'INIT THICKNESS - NOT IMPLENTED'
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                    SQUEEZE_RIGHT , 1)
      ENDIF

      CALL STREAMICE_UPD_FFRAC_UNCOUPLED ( myThid )    

      _EXCH_XY_RL(H_streamice, myThid )
      _EXCH_XY_RL(STREAMICE_hmask, myThid )
      _EXCH_XY_RL(area_shelf_streamice, myThid )

      CALL WRITE_FLD_XY_RL ( "H_streamice", "init", 
     & H_streamIce, 0, myThid )
      CALL WRITE_FLD_XY_RL ( "area_shelf_streamice", "init", 
     & area_shelf_streamice, 0, myThid )
      CALL WRITE_FLD_XY_RL ( "STREAMICE_hmask", "init", 
     & STREAMICE_hmask, 0, myThid )

!       CALL STREAMICE_VELMASK_UPD (myThid)
!       CALL STREAMICE_UPD_FFRAC_UNCOUPLED ( myThid )
!       CALL STREAMICE_VEL_SOLVE( myThid )

      CALL WRITE_FLD_XY_RL ( "U_init", "", 
     &   U_streamice, 0, myThid )
      CALL WRITE_FLD_XY_RL ( "V_init", "", 
     &   V_streamice, 0, myThid )

!       CALL WRITE_FULLARRAY_RL ("H",H_streamice,1,0,0,1,0,myThid)
!       CALL WRITE_FULLARRAY_RL ("hmask",STREAMICE_hmask,1,0,0,1,0,myThid)
!       CALL WRITE_FULLARRAY_RL ("umask",STREAMICE_umask,1,0,0,1,0,myThid)
      
#endif /* ALLOW_STREAMICE */

      RETURN
      END

1	dgoldberg	1.2	C $Header: /u/gcmpack/MITgcm_contrib/dgoldberg/streamice/streamice_init_varia.F,v 1.1 2012/03/29 15:59:21 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			SUBROUTINE STREAMICE_INIT_VARIA( myThid )
10			C /============================================================\
11			C \| SUBROUTINE STREAMICE_INIT_VARIA \|
12			C \| o Routine to initialize STREAMICE variables. \|
13			C \|============================================================\|
14			C \| Initialize STREAMICE parameters and variables. \|
15			C \============================================================/
16			IMPLICIT NONE
17
18			C === Global variables ===
19			#include "SIZE.h"
20			#include "GRID.h"
21			#include "EEPARAMS.h"
22			#include "PARAMS.h"
23			#include "STREAMICE.h"
24			#include "STREAMICE_CG.h"
25			#include "STREAMICE_ADV.h"
26
27			C === Routine arguments ===
28			C myThid - Number of this instance of STREAMICE_INIT_VARIA
29			INTEGER myThid
30			CEndOfInterface
31
32			#ifdef ALLOW_STREAMICE
33			C === Local variables ===
34			C I,J,bi,bj - Loop counters
35			INTEGER i, j, k, bi, bj, Gi, Gj
36			INTEGER col_y, col_x
37			_RL slope_pos, c1
38			CHARACTER*(MAX_LEN_MBUF) msgBuf
39			CEOP
40
41			C ZERO OUT FLOATING POINT ARRAYS
42
43			DO bj = myByLo(myThid), myByHi(myThid)
44			DO bi = myBxLo(myThid), myBxHi(myThid)
45			DO j=1-Oly,sNy+Oly
46			DO i=1-Olx,sNx+Olx
47			H_streamIce(i,j,bi,bj) = 0. _d 0
48			U_streamice(i,j,bi,bj) = 0. _d 0
49			V_streamice(i,j,bi,bj) = 0. _d 0
50			visc_streamice(i,j,bi,bj) = 0. _d 0
51			tau_beta_eff_streamice(i,j,bi,bj) = 0. _d 0
52			float_frac_streamice(i,j,bi,bj) = 0. _d 0
53			base_el_streamice(i,j,bi,bj) = 0. _d 0
54			surf_el_streamice(i,j,bi,bj) = 0. _d 0
55			area_shelf_streamice(i,j,bi,bj) = 0. _d 0
56			mass_ice_streamice(i,j,bi,bj) = 0. _d 0
57			C_basal_friction(i,j,bi,bj) = C_basal_fric_const
58			#ifdef ALLOW_AUTODIFF_TAMC
59			ru_old_si(i,j,bi,bj) = 0. _d 0
60			rv_old_si(i,j,bi,bj) = 0. _d 0
61			zu_old_si(i,j,bi,bj) = 0. _d 0
62			zv_old_si(i,j,bi,bj) = 0. _d 0
63			h_after_uflux_SI(i,j,bi,bj) = 0. _d 0
64			#endif
65			ENDDO
66			ENDDO
67			ENDDO
68			ENDDO
69
70			DO j = 1-oly, sNy+oly
71			DO i = 1-olx, sNx+olx
72			DO bj = myByLo(myThid), myByHi(myThid)
73			DO bi = myBxLo(myThid), myBxHi(myThid)
74			cc DO k=1,4
75			DO col_x=-1,1
76			DO col_y=-1,1
77			streamice_cg_A1(i,j,bi,bj,col_x,col_y)=0.0
78			streamice_cg_A2(i,j,bi,bj,col_x,col_y)=0.0
79			streamice_cg_A3(i,j,bi,bj,col_x,col_y)=0.0
80			streamice_cg_A4(i,j,bi,bj,col_x,col_y)=0.0
81			ENDDO
82			ENDDO
83			cc ENDDO
84			ENDDO
85			ENDDO
86			ENDDO
87			ENDDO
88
89			C INIT. INTEGER ARRAYS
90
91			DO bj = myByLo(myThid), myByHi(myThid)
92			DO bi = myBxLo(myThid), myBxHi(myThid)
93			DO j=1-Oly,sNy+Oly
94			DO i=1-Olx,sNx+Olx
95			STREAMICE_hmask(i,j,bi,bj) = -1.0
96			STREAMICE_umask(i,j,bi,bj) = 0.0
97			STREAMICE_vmask(i,j,bi,bj) = 0.0
98			STREAMICE_ufacemask(i,j,bi,bj) = 0.0
99			STREAMICE_vfacemask(i,j,bi,bj) = 0.0
100			STREAMICE_float_cond(i,j,bi,bj) = 0.0
101			ENDDO
102			ENDDO
103			ENDDO
104			ENDDO
105
106			!ph SELECT CASE (TRIM(STREAMICEthickInit))
107
108			IF ( STREAMICEthickInit.EQ.'PARAM' ) THEN
109
110			WRITE(msgBuf,'(A)') 'initializing analytic thickness'
111			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
112			& SQUEEZE_RIGHT , 1)
113
114			slope_pos = shelf_edge_pos - shelf_flat_width
115			c1 = 0.0
116			IF (shelf_slope_scale .GT. 0.0) THEN
117			c1 = 1.0 / shelf_slope_scale
118			ENDIF
119
120			DO bj = myByLo(myThid), myByHi(myThid)
121			DO bi = myBxLo(myThid), myBxHi(myThid)
122			DO j=1,sNy
123			DO i=1,sNx
124			Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
125			Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
126
127
128
129			IF ((Gi.lt.Nx).and.(Gj.lt.Ny)) THEN
130
131			C IF (flow_dir .EQ. 2.0) THEN
132			IF (.TRUE.) THEN
133			IF (xC(i-1,j,bi,bj).GE.shelf_edge_pos) THEN
134			area_shelf_streamice(i,j,bi,bj) = 0. _d 0
135			STREAMICE_hmask(i,j,bi,bj) = 0. _d 0
136			ELSE
137
138			IF (xC(i,j,bi,bj).GT.slope_pos) THEN
139			H_streamice (i,j,bi,bj) = shelf_min_draft
140			ELSE
141			H_streamice (i,j,bi,bj) = (shelf_min_draft +
142			& (shelf_max_draft - shelf_min_draft) *
143			& min (1.0, (c1(slope_pos-xC(i,j,bi,bj)))*2))
144			ENDIF
145
146			IF (xC(i,j,bi,bj).GT.shelf_edge_pos) THEN
147			area_shelf_streamice(i,j,bi,bj) = rA(i,j,bi,bj) *
148			& (shelf_edge_pos-xG(i,j,bi,bj)) /
149			& (xG(i+1,j,bi,bj)-xG(i,j,bi,bj))
150			IF (area_shelf_streamice(i,j,bi,bj).gt. 0._d 0) THEN
151			STREAMICE_hmask(i,j,bi,bj) = 2.0
152			ELSE
153			STREAMICE_hmask(i,j,bi,bj) = 0.0
154			H_streamice(i,j,bi,bj) = 0.0
155			ENDIF
156			ELSE
157			area_shelf_streamice(i,j,bi,bj) = rA(i,j,bi,bj)
158			STREAMICE_hmask(i,j,bi,bj) = 1.0
159			ENDIF
160
161			c WRITE(msgBuf,'(A,I3,I3,E9.2)') 'thickness',
162			c & i,j,shelf_edge_pos
163			c CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
164			c & SQUEEZE_RIGHT , 1)
165
166			ENDIF
167			ENDIF
168			ENDIF
169			ENDDO
170			ENDDO
171			ENDDO
172			ENDDO
173
174			! DO bj = myByLo(myThid), myByHi(myThid)
175			! DO bi = myBxLo(myThid), myBxHi(myThid)
176			! DO j=1,sNy
177			! DO i=1,sNx
178			! STREAMICE_dummy_array(i,j,bi,bj) =
179			! & REAL(STREAMICE_hmask(i,j,bi,bj))
180			! WRITE(msgBuf,'(F3.0)') STREAMICE_dummy_array(i,j,bi,bj)
181			! CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
182			! & SQUEEZE_RIGHT , 1)
183			! ENDDO
184			! ENDDO
185			! ENDDO
186			! ENDDO
187			!
188			! CALL WRITE_FLD_XY_RL("STREAMICE_hmask"," ",
189			! & STREAMICE_dummy_array,0,myThid)
190			! CALL WRITE_FLD_XY_RL("h_streamice"," ",
191			! & H_streamice,0,myThid)
192
193			ELSE IF ( STREAMICEthickInit.EQ.'FILE' ) THEN
194
195			IF ( STREAMICEthickFile .NE. ' ' ) THEN
196			_BARRIER
197			C The 0 is the "iteration" argument. The ' ' is an empty suffix
198			CALL READ_FLD_XY_RS( STREAMICEthickFile, ' ', H_streamice,
199			& 0, myThid )
200			DO bj = myByLo(myThid), myByHi(myThid)
201			DO bi = myBxLo(myThid), myBxHi(myThid)
202			DO j=1,sNy
203			DO i=1,sNx
204			Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
205			Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
206			IF ((Gi.lt.Nx).and.(Gj.lt.Ny)) THEN
207			IF (H_streamice(i,j,bi,bj).GT.0. _d 0) THEN
208			area_shelf_streamice(i,j,bi,bj) = rA(i,j,bi,bj)
209			STREAMICE_hmask(i,j,bi,bj) = 1.0
210			ELSE
211			area_shelf_streamice(i,j,bi,bj) = 0. _d 0
212			STREAMICE_hmask(i,j,bi,bj) = 0. _d 0
213			ENDIF
214			ENDIF
215			ENDDO
216			ENDDO
217			ENDDO
218			ENDDO
219			ELSE
220			WRITE(msgBuf,'(A)') 'INIT THICKNESS - FILENAME MISSING'
221			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
222			& SQUEEZE_RIGHT , 1)
223			ENDIF
224
225			ELSE
226
227			WRITE(msgBuf,'(A)') 'INIT THICKNESS - NOT IMPLENTED'
228			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
229			& SQUEEZE_RIGHT , 1)
230			ENDIF
231
232			CALL STREAMICE_UPD_FFRAC_UNCOUPLED ( myThid )
233
234			_EXCH_XY_RL(H_streamice, myThid )
235			_EXCH_XY_RL(STREAMICE_hmask, myThid )
236			_EXCH_XY_RL(area_shelf_streamice, myThid )
237
238			CALL WRITE_FLD_XY_RL ( "H_streamice", "init",
239			& H_streamIce, 0, myThid )
240			CALL WRITE_FLD_XY_RL ( "area_shelf_streamice", "init",
241			& area_shelf_streamice, 0, myThid )
242			CALL WRITE_FLD_XY_RL ( "STREAMICE_hmask", "init",
243			& STREAMICE_hmask, 0, myThid )
244
245	dgoldberg	1.2	! CALL STREAMICE_VELMASK_UPD (myThid)
246			! CALL STREAMICE_UPD_FFRAC_UNCOUPLED ( myThid )
247			! CALL STREAMICE_VEL_SOLVE( myThid )
248	heimbach	1.1
249			CALL WRITE_FLD_XY_RL ( "U_init", "",
250			& U_streamice, 0, myThid )
251			CALL WRITE_FLD_XY_RL ( "V_init", "",
252			& V_streamice, 0, myThid )
253
254			! CALL WRITE_FULLARRAY_RL ("H",H_streamice,1,0,0,1,0,myThid)
255			! CALL WRITE_FULLARRAY_RL ("hmask",STREAMICE_hmask,1,0,0,1,0,myThid)
256			! CALL WRITE_FULLARRAY_RL ("umask",STREAMICE_umask,1,0,0,1,0,myThid)
257
258			#endif /* ALLOW_STREAMICE */
259
260			RETURN
261			END
262