/[MITgcm]/MITgcm_contrib/dgoldberg/streamice/streamice_advect_thickness_y.F
ViewVC logotype

Annotation of /MITgcm_contrib/dgoldberg/streamice/streamice_advect_thickness_y.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Wed May 2 02:36:01 2012 UTC (13 years, 2 months ago) by heimbach
Branch: MAIN
Various updates to streamice code

1 heimbach 1.1 C $Header: /u/gcmpack/MITgcm/pkg/streamice/streamice_init_varia.F,v 1.6 2011/06/29 16:24:10 dng Exp $
2     C $Name: $
3    
4     #include "STREAMICE_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8    
9     SUBROUTINE STREAMICE_ADVECT_THICKNESS_Y ( myThid ,
10     O hflux_y ,
11     O h ,
12     I time_step )
13    
14     IMPLICIT NONE
15    
16     C O hflux_y ! flux per unit width across face
17     C O h
18     C I time_step
19    
20     C === Global variables ===
21     #include "SIZE.h"
22     #include "GRID.h"
23     #include "EEPARAMS.h"
24     #include "PARAMS.h"
25     #include "STREAMICE.h"
26    
27     INTEGER myThid
28     _RL hflux_y (1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
29     _RL h (1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
30     _RL time_step
31    
32     #ifdef ALLOW_STREAMICE
33    
34     C LOCAL VARIABLES
35    
36     INTEGER i, j, bi, bj, Gi, Gj, k
37     _RL vface, phi
38     _RL stencil (-1:1)
39     LOGICAL H0_valid ! there are valid cells to calculate a
40     ! slope-limited 2nd order flux
41     _RL SLOPE_LIMITER
42     external SLOPE_LIMITER
43    
44     DO bj=myByLo(myThid),myByHi(myThid)
45     DO bi=myBxLo(myThid),myBxHi(myThid)
46     DO j=1-1,sNy+2
47     Gj = (myYGlobalLo-1)+(bj-1)*sNy+j
48     DO i=1-2,sNx+2
49     Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
50     IF ((Gi.ge.1) .and. (Gi.le.Nx)) THEN
51     C THESE ARRAY BOUNDS INSURE THAT AFTER THIS STEP,
52     C VALUES WILL BE RELIABLE 1 GRID CELLS OUT IN THE
53     C Y DIRECTION
54     IF ((STREAMICE_hmask(i,j,bi,bj).eq.1.0) .or.
55     & ((STREAMICE_hmask(i,j-1,bi,bj).eq.1.0) .and.
56     & (STREAMICE_hmask(i,j,bi,bj).ne.1.0))) THEN
57    
58     IF (STREAMICE_vfacemask(i,j,bi,bj).eq.4.0) THEN
59     hflux_y (i,j,bi,bj) = v_flux_bdry_SI (i,j,bi,bj)
60     ELSE
61    
62     vface = .5 *
63     & (V_streamice(i,j,bi,bj)+V_streamice(i+1,j,bi,bj))
64    
65     IF (vface .gt. 0. _d 0) THEN
66     DO k=-1,1
67     stencil (k) = h(i,j+k-1,bi,bj)
68     ENDDO
69     IF ((STREAMICE_hmask(i,j,bi,bj).eq.1.0) .and.
70     & (STREAMICE_hmask(i,j-2,bi,bj).eq.1.0)) H0_valid=.true.
71    
72     IF ((Gj.eq.1).and.(STREAMICE_hmask(i,j-1,bi,bj).eq.3.0))
73     & THEN ! we are at western bdry and there is a thick. bdry cond
74     hflux_y (i,j,bi,bj) = h(i,j-1,bi,bj) * vface
75     ELSEIF (H0_valid) THEN
76     phi = SLOPE_LIMITER (
77     & stencil(0)-stencil(-1),
78     & stencil(1)-stencil(0))
79     hflux_y (i,j,bi,bj) = vface *
80     & (stencil(0) - phi * .5 * (stencil(0)-stencil(1)))
81     ELSE ! one of the two cells needed for a HO scheme is missing, use FO scheme
82     hflux_y (i,j,bi,bj) = vface * stencil(0)
83     ENDIF
84     ELSE ! uface <= 0
85     DO k=-1,1
86     stencil (k) = h(i,j-k,bi,bj)
87     ENDDO
88     IF ((STREAMICE_hmask(i,j-1,bi,bj).eq.1.0) .and.
89     & (STREAMICE_hmask(i,j+1,bi,bj).eq.1.0)) H0_valid=.true.
90    
91     IF ((Gj.eq.Ny).and.(STREAMICE_hmask(i,j+1,bi,bj).eq.3.0))
92     & THEN ! we are at western bdry and there is a thick. bdry cond
93     hflux_y (i,j,bi,bj) = h(i,j+1,bi,bj) * vface
94     ELSEIF (H0_valid) THEN
95     phi = SLOPE_LIMITER (
96     & stencil(0)-stencil(-1),
97     & stencil(1)-stencil(0))
98     hflux_y (i,j,bi,bj) = vface *
99     & (stencil(0) - phi * .5 * (stencil(0)-stencil(1)))
100     ELSE ! one of the two cells needed for a HO scheme is missing, use FO scheme
101     hflux_y (i,j,bi,bj) = vface * stencil(0)
102     ENDIF
103    
104     ENDIF ! uface 0
105    
106     ENDIF
107     ENDIF
108     ENDIF
109     ENDDO
110     ENDDO
111     ENDDO
112     ENDDO
113    
114     C X-FLUXES AT CELL BOUNDARIES CALCULATED; NOW TAKE FLUX DIVERGENCE TO INCREMENT THICKNESS
115    
116    
117    
118     DO bj=myByLo(myThid),myByHi(myThid)
119     DO bi=myBxLo(myThid),myBxHi(myThid)
120     DO j=1-1,sNy+1
121     DO i=1-2,sNx+2
122     Gi = (myXGlobalLo-1)+(bi-1)*sNx+i
123     IF ((Gi .ge. 1) .and. (Gi .le. Nx)) THEN
124     IF (STREAMICE_hmask(i,j,bi,bj).eq.1.0) THEN
125     h(i,j,bi,bj) = h(i,j,bi,bj) - time_step *
126     & (hflux_y(i,j+1,bi,bj)*dxG(i,j+1,bi,bj) -
127     & hflux_y(i,j,bi,bj)*dxG(i,j,bi,bj)) *
128     & recip_rA (i,j,bi,bj)
129     ENDIF
130     ENDIF
131     ENDDO
132     ENDDO
133     ENDDO
134     ENDDO
135    
136     ! CALL WRITE_FLD_XY_RL ("h_after_yflux","",
137     ! & h, 0, myThid)
138    
139     #endif
140     RETURN
141     END SUBROUTINE STREAMICE_ADVECT_THICKNESS_Y
142    
143    

  ViewVC Help
Powered by ViewVC 1.1.22