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

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

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

revision 1.1 by heimbach, Mon Nov 11 22:01:21 2002 UTC revision 1.2 by heimbach, Tue Nov 12 20:47:27 2002 UTC
# Line 0  Line 1 
1    C
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
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22