/[MITgcm]/MITgcm/pkg/seaice/advect.F
ViewVC logotype

Contents of /MITgcm/pkg/seaice/advect.F

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

Revision 1.2 - (show annotations) (download)
Tue Nov 12 20:47:27 2002 UTC (21 years, 7 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint47a_post, checkpoint47
Changes since 1.1: +195 -0 lines 
Merging from release1_p8 branch:
o New package: pkg/seaice
  Sea ice model by D. Menemenlis (JPL) and Jinlun Zhang (Seattle).
  The sea-ice code is based on Hibler (1979-1980).
  Two sea-ice dynamic solvers, ADI and LSR, are included.
  In addition to computing prognostic sea-ice variables and diagnosing
  the forcing/external data fields that drive the ocean model,
  SEAICE_MODEL also sets theta to the freezing point under sea-ice.
  The implied surface heat flux is then stored in variable
  surfaceTendencyTice, which is needed by KPP package (kpp_calc.F and
  kpp_transport_t.F) to diagnose surface buoyancy fluxes and for the
  non-local transport term.  Because this call precedes model
  thermodynamics, temperature under sea-ice may not be "exactly" at
  the freezing point by the time theta is dumped or time-averaged.
1 C $Header:
2
3 #include "SEAICE_OPTIONS.h"
4
5 CStartOfInterface
6 SUBROUTINE advect( UICE,VICE,HEFF,HEFFM,myThid )
7 C /==========================================================\
8 C | SUBROUTINE advect |
9 C | o Calculate ice advection |
10 C |==========================================================|
11 C \==========================================================/
12 IMPLICIT NONE
13
14 C === Global variables ===
15 #include "SIZE.h"
16 #include "EEPARAMS.h"
17 #include "PARAMS.h"
18 #include "SEAICE_PARAMS.h"
19 #include "SEAICE_GRID.h"
20
21 C === Routine arguments ===
22 C myThid - Thread no. that called this routine.
23 _RL UICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
24 _RL VICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
25 _RL HEFF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
26 _RL HEFFM (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
27 INTEGER myThid
28 CEndOfInterface
29
30 #ifdef ALLOW_SEAICE
31
32 C === Local variables ===
33 C i,j,k,bi,bj - Loop counters
34
35 INTEGER i, j, k, bi, bj
36 INTEGER K2, K3, LL, KD
37 _RL DELTT
38
39 _RL UI (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
40 _RL VI (1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
41 _RL DIFFA(1-OLx:sNx+OLx, 1-OLy:sNy+OLy)
42
43 C NOW DECIDE IF BACKWARD EULER OR LEAPFROG
44 LL=LAD
45 IF(LL.EQ.1) GO TO 100
46 C BACKWARD EULER
47 DELTT=DELTAT
48 K3=2
49 K2=2
50 GO TO 101
51 C LEAPFROG
52 100 DELTT=DELTAT*2.0
53 K3=3
54 K2=2
55 101 CONTINUE
56
57 C NOW REARRANGE H'S
58
59 DO bj=myByLo(myThid),myByHi(myThid)
60 DO bi=myBxLo(myThid),myBxHi(myThid)
61
62 DO j=1-OLy,sNy+OLy
63 DO i=1-OLx,sNx+OLx
64 UI(I,J)=UICE(I,J,1,bi,bj)
65 VI(I,J)=VICE(I,J,1,bi,bj)
66 ENDDO
67 ENDDO
68
69 DO j=1-OLy,sNy+OLy
70 DO i=1-OLx,sNx+OLx
71 HEFF(I,J,3,bi,bj)=HEFF(I,J,2,bi,bj)
72 HEFF(I,J,2,bi,bj)=HEFF(I,J,1,bi,bj)
73 ENDDO
74 ENDDO
75
76 ENDDO
77 ENDDO
78
79 202 CONTINUE
80
81 C NOW GO THROUGH STANDARD CONSERVATIVE ADVECTION
82 DO bj=myByLo(myThid),myByHi(myThid)
83 DO bi=myBxLo(myThid),myBxHi(myThid)
84 DO J=0,sNy-1
85 DO I=0,sNx-1
86 HEFF(I+1,J+1,1,bi,bj)=HEFF(I+1,J+1,K3,bi,bj)
87 & -DELTT*((HEFF(I+1,J+1,2,bi,bj)+HEFF
88 & (I+2,J+1,2,bi,bj))*(UI(I+1,J+1)+UI(I+1,J))-
89 & (HEFF(I+1,J+1,2,bi,bj)+HEFF
90 & (I,J+1,2,bi,bj))*(UI(I,J+1)+UI(I,J)))
91 & *(0.25/(DXTICE(I+1,J,bi,bj)*CSTICE(I,J+1,bi,bj)))
92 & -DELTT*((HEFF(I+1,J+1,2,bi,bj)
93 & +HEFF(I+1,J+2,2,bi,bj))*(VI(I,J+1)
94 & +VI(I+1,J+1)*CSUICE(I,J+1,bi,bj)
95 & -(HEFF(I+1,J+1,2,bi,bj)+HEFF(I+1,J,2,bi,bj))
96 & *(VI(I,J)+VI(I+1,J))*CSUICE(I,J,bi,bj))
97 & *(0.25/(DYTICE(I,J+1,bi,bj)*CSTICE(I,J+1,bi,bj))))
98 ENDDO
99 ENDDO
100 ENDDO
101 ENDDO
102
103 _BARRIER
104 CALL EXCH_RL( HEFF, OLx, OLx, OLy, OLy, 3, OLx, OLy,
105 I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
106 _BARRIER
107
108 C NOW DECIDE IF DONE
109 IF(LL.EQ.2) GO TO 99
110 IF (LL.EQ.3) GO TO 89
111 GO TO 102
112 89 CONTINUE
113
114 C NOW FIX UP H(I,J,2)
115 DO bj=myByLo(myThid),myByHi(myThid)
116 DO bi=myBxLo(myThid),myBxHi(myThid)
117 DO j=1-OLy,sNy+OLy
118 DO i=1-OLx,sNx+OLx
119 HEFF(I,J,2,bi,bj)=HEFF(I,J,3,bi,bj)
120 ENDDO
121 ENDDO
122 ENDDO
123 ENDDO
124
125 GO TO 102
126 99 CONTINUE
127
128 C NOW DO BACKWARD EULER CORRECTION
129 DO bj=myByLo(myThid),myByHi(myThid)
130 DO bi=myBxLo(myThid),myBxHi(myThid)
131 DO j=1-OLy,sNy+OLy
132 DO i=1-OLx,sNx+OLx
133 HEFF(I,J,3,bi,bj)=HEFF(I,J,2,bi,bj)
134 HEFF(I,J,2,bi,bj)=0.5*(HEFF(I,J,1,bi,bj)
135 & +HEFF(I,J,2,bi,bj))
136 ENDDO
137 ENDDO
138 ENDDO
139 ENDDO
140
141 LL=3
142 K3=3
143 GO TO 202
144 102 CONTINUE
145 C NOW DO DIFFUSION ON H(I,J,K3)
146 DO 240 KD=1,2
147 GO TO (241,242),KD
148 241 CONTINUE
149
150 C NOW CALCULATE DIFFUSION COEF ROUGHLY
151 DO bj=myByLo(myThid),myByHi(myThid)
152 DO bi=myBxLo(myThid),myBxHi(myThid)
153 DO j=1-OLy,sNy+OLy
154 DO i=1-OLx,sNx+OLx
155 DIFFA(I,J)=DIFF1*MIN(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj)
156 & ,DYTICE(I,J,bi,bj))
157 ENDDO
158 ENDDO
159 ENDDO
160 ENDDO
161 CALL DIFFUS(HEFF,DIFFA,HEFFM,DELTT, myThid)
162 GO TO 243
163 242 CONTINUE
164
165 C NOW CALCULATE DIFFUSION COEF ROUGHLY
166 DO bj=myByLo(myThid),myByHi(myThid)
167 DO bi=myBxLo(myThid),myBxHi(myThid)
168 DO j=1-OLy,sNy+OLy
169 DO i=1-OLx,sNx+OLx
170 DIFFA(I,J)=-(MIN(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj)
171 & ,DYTICE(I,J,bi,bj)))**2/DELTT
172 ENDDO
173 ENDDO
174 ENDDO
175 ENDDO
176 CALL DIFFUS(HEFF,DIFFA,HEFFM,DELTT, myThid)
177 243 CONTINUE
178
179 DO bj=myByLo(myThid),myByHi(myThid)
180 DO bi=myBxLo(myThid),myBxHi(myThid)
181 DO j=1-OLy,sNy+OLy
182 DO i=1-OLx,sNx+OLx
183 HEFF(I,J,1,bi,bj)=(HEFF(I,J,1,bi,bj)+HEFF(I,J,3,bi,bj))
184 & *HEFFM(I,J,bi,bj)
185 ENDDO
186 ENDDO
187 ENDDO
188 ENDDO
189
190 240 CONTINUE
191
192 #endif ALLOW_SEAICE
193
194 RETURN
195 END
  ViewVC Help
Powered by ViewVC 1.1.22