dgoldberg/streamice/streamice_init_varia.F

C $Header: /u/gcmpack/MITgcm_contrib/dgoldberg/streamice/streamice_init_varia.F,v 1.2 2012/07/19 18:46:56 dgoldberg 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
          BDOT_streamice(i,j,bi,bj) = 0. _d 0
          C_basal_friction(i,j,bi,bj) = C_basal_fric_const
          A_glen(i,j,bi,bj) = A_glen_isothermal
#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


             ENDIF
            ENDIF
           ENDIF  
          ENDDO
         ENDDO
        ENDDO
       ENDDO


      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.3	C $Header: /u/gcmpack/MITgcm_contrib/dgoldberg/streamice/streamice_init_varia.F,v 1.2 2012/07/19 18:46:56 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_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	dgoldberg	1.3	BDOT_streamice(i,j,bi,bj) = 0. _d 0
58	heimbach	1.1	C_basal_friction(i,j,bi,bj) = C_basal_fric_const
59	dgoldberg	1.3	A_glen(i,j,bi,bj) = A_glen_isothermal
60	heimbach	1.1	#ifdef ALLOW_AUTODIFF_TAMC
61			ru_old_si(i,j,bi,bj) = 0. _d 0
62			rv_old_si(i,j,bi,bj) = 0. _d 0
63			zu_old_si(i,j,bi,bj) = 0. _d 0
64			zv_old_si(i,j,bi,bj) = 0. _d 0
65			h_after_uflux_SI(i,j,bi,bj) = 0. _d 0
66			#endif
67			ENDDO
68			ENDDO
69			ENDDO
70			ENDDO
71
72			DO j = 1-oly, sNy+oly
73			DO i = 1-olx, sNx+olx
74			DO bj = myByLo(myThid), myByHi(myThid)
75			DO bi = myBxLo(myThid), myBxHi(myThid)
76			cc DO k=1,4
77			DO col_x=-1,1
78			DO col_y=-1,1
79			streamice_cg_A1(i,j,bi,bj,col_x,col_y)=0.0
80			streamice_cg_A2(i,j,bi,bj,col_x,col_y)=0.0
81			streamice_cg_A3(i,j,bi,bj,col_x,col_y)=0.0
82			streamice_cg_A4(i,j,bi,bj,col_x,col_y)=0.0
83			ENDDO
84			ENDDO
85			cc ENDDO
86			ENDDO
87			ENDDO
88			ENDDO
89			ENDDO
90
91			C INIT. INTEGER ARRAYS
92
93			DO bj = myByLo(myThid), myByHi(myThid)
94			DO bi = myBxLo(myThid), myBxHi(myThid)
95			DO j=1-Oly,sNy+Oly
96			DO i=1-Olx,sNx+Olx
97			STREAMICE_hmask(i,j,bi,bj) = -1.0
98			STREAMICE_umask(i,j,bi,bj) = 0.0
99			STREAMICE_vmask(i,j,bi,bj) = 0.0
100			STREAMICE_ufacemask(i,j,bi,bj) = 0.0
101			STREAMICE_vfacemask(i,j,bi,bj) = 0.0
102			STREAMICE_float_cond(i,j,bi,bj) = 0.0
103			ENDDO
104			ENDDO
105			ENDDO
106			ENDDO
107
108			!ph SELECT CASE (TRIM(STREAMICEthickInit))
109
110			IF ( STREAMICEthickInit.EQ.'PARAM' ) THEN
111
112			WRITE(msgBuf,'(A)') 'initializing analytic thickness'
113			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
114			& SQUEEZE_RIGHT , 1)
115
116			slope_pos = shelf_edge_pos - shelf_flat_width
117			c1 = 0.0
118			IF (shelf_slope_scale .GT. 0.0) THEN
119			c1 = 1.0 / shelf_slope_scale
120			ENDIF
121
122			DO bj = myByLo(myThid), myByHi(myThid)
123			DO bi = myBxLo(myThid), myBxHi(myThid)
124			DO j=1,sNy
125			DO i=1,sNx
126			Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
127			Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
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
162			ENDIF
163			ENDIF
164			ENDIF
165			ENDDO
166			ENDDO
167			ENDDO
168			ENDDO
169
170	dgoldberg	1.3
171	heimbach	1.1
172			ELSE IF ( STREAMICEthickInit.EQ.'FILE' ) THEN
173
174			IF ( STREAMICEthickFile .NE. ' ' ) THEN
175			_BARRIER
176			C The 0 is the "iteration" argument. The ' ' is an empty suffix
177			CALL READ_FLD_XY_RS( STREAMICEthickFile, ' ', H_streamice,
178			& 0, myThid )
179			DO bj = myByLo(myThid), myByHi(myThid)
180			DO bi = myBxLo(myThid), myBxHi(myThid)
181			DO j=1,sNy
182			DO i=1,sNx
183			Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
184			Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
185			IF ((Gi.lt.Nx).and.(Gj.lt.Ny)) THEN
186			IF (H_streamice(i,j,bi,bj).GT.0. _d 0) THEN
187			area_shelf_streamice(i,j,bi,bj) = rA(i,j,bi,bj)
188			STREAMICE_hmask(i,j,bi,bj) = 1.0
189			ELSE
190			area_shelf_streamice(i,j,bi,bj) = 0. _d 0
191			STREAMICE_hmask(i,j,bi,bj) = 0. _d 0
192			ENDIF
193			ENDIF
194			ENDDO
195			ENDDO
196			ENDDO
197			ENDDO
198			ELSE
199			WRITE(msgBuf,'(A)') 'INIT THICKNESS - FILENAME MISSING'
200			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
201			& SQUEEZE_RIGHT , 1)
202			ENDIF
203
204			ELSE
205
206			WRITE(msgBuf,'(A)') 'INIT THICKNESS - NOT IMPLENTED'
207			CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
208			& SQUEEZE_RIGHT , 1)
209			ENDIF
210
211			CALL STREAMICE_UPD_FFRAC_UNCOUPLED ( myThid )
212
213			_EXCH_XY_RL(H_streamice, myThid )
214			_EXCH_XY_RL(STREAMICE_hmask, myThid )
215			_EXCH_XY_RL(area_shelf_streamice, myThid )
216
217			CALL WRITE_FLD_XY_RL ( "H_streamice", "init",
218			& H_streamIce, 0, myThid )
219			CALL WRITE_FLD_XY_RL ( "area_shelf_streamice", "init",
220			& area_shelf_streamice, 0, myThid )
221			CALL WRITE_FLD_XY_RL ( "STREAMICE_hmask", "init",
222			& STREAMICE_hmask, 0, myThid )
223
224	dgoldberg	1.2	! CALL STREAMICE_VELMASK_UPD (myThid)
225			! CALL STREAMICE_UPD_FFRAC_UNCOUPLED ( myThid )
226			! CALL STREAMICE_VEL_SOLVE( myThid )
227	heimbach	1.1
228			CALL WRITE_FLD_XY_RL ( "U_init", "",
229			& U_streamice, 0, myThid )
230			CALL WRITE_FLD_XY_RL ( "V_init", "",
231			& V_streamice, 0, myThid )
232
233			! CALL WRITE_FULLARRAY_RL ("H",H_streamice,1,0,0,1,0,myThid)
234			! CALL WRITE_FULLARRAY_RL ("hmask",STREAMICE_hmask,1,0,0,1,0,myThid)
235			! CALL WRITE_FULLARRAY_RL ("umask",STREAMICE_umask,1,0,0,1,0,myThid)
236
237			#endif /* ALLOW_STREAMICE */
238
239			RETURN
240			END
241