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

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

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

Revision 1.8 - (hide annotations) (download)
Thu Aug 7 02:31:29 2003 UTC (20 years, 11 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint51f_post, checkpoint51j_post, checkpoint51h_pre, branchpoint-genmake2, checkpoint51i_pre, checkpoint51f_pre, checkpoint51g_post
Branch point for: branch-genmake2
Changes since 1.7: +0 -7 lines 
o Added on-the-fly spatial interpolation capability
    "USE_EXF_INTERPOLATION" to pkg/exf.
  - This is a temporary Cartesian-grid hack until
    the super-duper ESMF coupler becomes available.
  - See verification/global_with_exf/README for usage example.
  - Removed obsolete EXFwindOnBgrid and SEAICEwindOnCgrid
    flags and modified pkg/seaice accordingly.
o Bug fix to pkg/ptracers, pkg/generic_advdiff/gad_calc_rhs.F,
    and pkg/kpp/kpp_transport_ptr.F for dealing with tracer
    non-local transport term.
1 heimbach 1.2 C $Header:
2    
3     #include "SEAICE_OPTIONS.h"
4 dimitri 1.6
5 heimbach 1.2 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 dimitri 1.6
14 heimbach 1.2 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 dimitri 1.6
21 heimbach 1.7 #ifdef ALLOW_AUTODIFF_TAMC
22     # include "tamc.h"
23     #endif
24    
25 heimbach 1.2 C === Routine arguments ===
26     C myThid - Thread no. that called this routine.
27     _RL UICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
28     _RL VICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
29     _RL HEFF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
30     _RL HEFFM (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
31     INTEGER myThid
32     CEndOfInterface
33 dimitri 1.6
34 heimbach 1.2 #ifdef ALLOW_SEAICE
35    
36     C === Local variables ===
37     C i,j,k,bi,bj - Loop counters
38    
39 dimitri 1.3 INTEGER i, j, bi, bj
40     INTEGER K3
41 heimbach 1.2 _RL DELTT
42    
43 dimitri 1.6 _RL UI (1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
44     _RL VI (1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
45     _RL DIFFA(1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
46    
47 heimbach 1.2 C NOW DECIDE IF BACKWARD EULER OR LEAPFROG
48 dimitri 1.3 IF(LAD.EQ.1) THEN
49     C LEAPFROG
50     DELTT=DELTAT*TWO
51     K3=3
52     ELSE
53 heimbach 1.2 C BACKWARD EULER
54 dimitri 1.3 DELTT=DELTAT
55     K3=2
56     ENDIF
57 heimbach 1.2
58     C NOW REARRANGE H'S
59    
60     DO bj=myByLo(myThid),myByHi(myThid)
61     DO bi=myBxLo(myThid),myBxHi(myThid)
62    
63     DO j=1-OLy,sNy+OLy
64     DO i=1-OLx,sNx+OLx
65 dimitri 1.6 UI(I,J,bi,bj)=UICE(I,J,1,bi,bj)
66     VI(I,J,bi,bj)=VICE(I,J,1,bi,bj)
67 heimbach 1.2 ENDDO
68     ENDDO
69    
70     DO j=1-OLy,sNy+OLy
71     DO i=1-OLx,sNx+OLx
72     HEFF(I,J,3,bi,bj)=HEFF(I,J,2,bi,bj)
73     HEFF(I,J,2,bi,bj)=HEFF(I,J,1,bi,bj)
74     ENDDO
75     ENDDO
76    
77     ENDDO
78     ENDDO
79 heimbach 1.7
80     #ifdef ALLOW_AUTODIFF_TAMC
81     CADJ STORE heff = comlev1, key = ikey_dynamics
82     #endif /* ALLOW_AUTODIFF_TAMC */
83 heimbach 1.2
84     C NOW GO THROUGH STANDARD CONSERVATIVE ADVECTION
85     DO bj=myByLo(myThid),myByHi(myThid)
86     DO bi=myBxLo(myThid),myBxHi(myThid)
87     DO J=0,sNy-1
88     DO I=0,sNx-1
89     HEFF(I+1,J+1,1,bi,bj)=HEFF(I+1,J+1,K3,bi,bj)
90     & -DELTT*((HEFF(I+1,J+1,2,bi,bj)+HEFF
91 dimitri 1.6 & (I+2,J+1,2,bi,bj))*(UI(I+2,J+2,bi,bj)+UI(I+2,J+1,bi,bj))-
92 heimbach 1.2 & (HEFF(I+1,J+1,2,bi,bj)+HEFF
93 dimitri 1.6 & (I,J+1,2,bi,bj))*(UI(I+1,J+2,bi,bj)+UI(I+1,J+1,bi,bj)))
94 dimitri 1.3 & *(QUART/(DXTICE(I+1,J,bi,bj)*CSTICE(I,J+1,bi,bj)))
95 heimbach 1.2 & -DELTT*((HEFF(I+1,J+1,2,bi,bj)
96 dimitri 1.6 & +HEFF(I+1,J+2,2,bi,bj))*(VI(I+1,J+2,bi,bj)
97     & +VI(I+2,J+2,bi,bj))*CSUICE(I+1,J+2,bi,bj)
98 heimbach 1.2 & -(HEFF(I+1,J+1,2,bi,bj)+HEFF(I+1,J,2,bi,bj))
99 dimitri 1.6 & *(VI(I+1,J+1,bi,bj)+VI(I+2,J+1,bi,bj))*CSUICE(I+1,J+1,bi,bj))
100     & *(QUART/(DYTICE(I,J+1,bi,bj)*CSTICE(I,J+1,bi,bj)))
101 heimbach 1.2 ENDDO
102     ENDDO
103     ENDDO
104     ENDDO
105    
106     _BARRIER
107 dimitri 1.4 CALL SEAICE_EXCH ( HEFF, myThid )
108 heimbach 1.2 _BARRIER
109    
110 dimitri 1.3 IF (LAD .EQ. 2) THEN
111    
112     C NOW DO BACKWARD EULER CORRECTION
113     DO bj=myByLo(myThid),myByHi(myThid)
114     DO bi=myBxLo(myThid),myBxHi(myThid)
115     DO j=1-OLy,sNy+OLy
116     DO i=1-OLx,sNx+OLx
117     HEFF(I,J,3,bi,bj)=HEFF(I,J,2,bi,bj)
118     HEFF(I,J,2,bi,bj)=HALF*(HEFF(I,J,1,bi,bj)
119     & +HEFF(I,J,2,bi,bj))
120     ENDDO
121     ENDDO
122     ENDDO
123     ENDDO
124 heimbach 1.2
125 dimitri 1.3 C NOW GO THROUGH STANDARD CONSERVATIVE ADVECTION
126     DO bj=myByLo(myThid),myByHi(myThid)
127     DO bi=myBxLo(myThid),myBxHi(myThid)
128     DO J=0,sNy-1
129     DO I=0,sNx-1
130     HEFF(I+1,J+1,1,bi,bj)=HEFF(I+1,J+1,3,bi,bj)
131     & -DELTT*((HEFF(I+1,J+1,2,bi,bj)+HEFF
132 dimitri 1.6 & (I+2,J+1,2,bi,bj))*(UI(I+2,J+2,bi,bj)+UI(I+2,J+1,bi,bj))-
133 dimitri 1.3 & (HEFF(I+1,J+1,2,bi,bj)+HEFF
134 dimitri 1.6 & (I,J+1,2,bi,bj))*(UI(I+1,J+2,bi,bj)+UI(I+1,J+1,bi,bj)))
135 dimitri 1.3 & *(QUART/(DXTICE(I+1,J,bi,bj)*CSTICE(I,J+1,bi,bj)))
136     & -DELTT*((HEFF(I+1,J+1,2,bi,bj)
137 dimitri 1.6 & +HEFF(I+1,J+2,2,bi,bj))*(VI(I+1,J+2,bi,bj)
138     & +VI(I+2,J+2,bi,bj))*CSUICE(I+1,J+2,bi,bj)
139 dimitri 1.3 & -(HEFF(I+1,J+1,2,bi,bj)+HEFF(I+1,J,2,bi,bj))
140 dimitri 1.6 & *(VI(I+1,J+1,bi,bj)+VI(I+2,J+1,bi,bj))
141     & *CSUICE(I+1,J+1,bi,bj))
142     & *(QUART/(DYTICE(I,J+1,bi,bj)*CSTICE(I,J+1,bi,bj)))
143 dimitri 1.3 ENDDO
144     ENDDO
145     ENDDO
146     ENDDO
147    
148     _BARRIER
149 dimitri 1.4 CALL SEAICE_EXCH( HEFF, myThid )
150 dimitri 1.3 _BARRIER
151    
152     C NOW FIX UP H(I,J,2)
153     DO bj=myByLo(myThid),myByHi(myThid)
154     DO bi=myBxLo(myThid),myBxHi(myThid)
155     DO j=1-OLy,sNy+OLy
156     DO i=1-OLx,sNx+OLx
157     HEFF(I,J,2,bi,bj)=HEFF(I,J,3,bi,bj)
158     ENDDO
159     ENDDO
160     ENDDO
161 heimbach 1.2 ENDDO
162    
163 dimitri 1.3 ENDIF
164 heimbach 1.2
165 dimitri 1.3 C NOW DO DIFFUSION ON H(I,J,3)
166     C NOW CALCULATE DIFFUSION COEF ROUGHLY
167 heimbach 1.2 DO bj=myByLo(myThid),myByHi(myThid)
168     DO bi=myBxLo(myThid),myBxHi(myThid)
169     DO j=1-OLy,sNy+OLy
170     DO i=1-OLx,sNx+OLx
171 dimitri 1.6 DIFFA(I,J,bi,bj)=DIFF1*MIN(DXTICE(I,J,bi,bj)
172     & *CSTICE(I,J,bi,bj),DYTICE(I,J,bi,bj))
173 heimbach 1.2 ENDDO
174     ENDDO
175     ENDDO
176     ENDDO
177 dimitri 1.3 CALL DIFFUS(HEFF,DIFFA,HEFFM,DELTT, myThid)
178 heimbach 1.2
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 dimitri 1.3 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 heimbach 1.2 ENDDO
186     ENDDO
187     ENDDO
188     ENDDO
189    
190     C NOW CALCULATE DIFFUSION COEF ROUGHLY
191     DO bj=myByLo(myThid),myByHi(myThid)
192     DO bi=myBxLo(myThid),myBxHi(myThid)
193     DO j=1-OLy,sNy+OLy
194     DO i=1-OLx,sNx+OLx
195 dimitri 1.6 DIFFA(I,J,bi,bj)=-(MIN(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj)
196 heimbach 1.2 & ,DYTICE(I,J,bi,bj)))**2/DELTT
197     ENDDO
198     ENDDO
199     ENDDO
200     ENDDO
201     CALL DIFFUS(HEFF,DIFFA,HEFFM,DELTT, myThid)
202 dimitri 1.3
203 heimbach 1.2 DO bj=myByLo(myThid),myByHi(myThid)
204     DO bi=myBxLo(myThid),myBxHi(myThid)
205     DO j=1-OLy,sNy+OLy
206     DO i=1-OLx,sNx+OLx
207     HEFF(I,J,1,bi,bj)=(HEFF(I,J,1,bi,bj)+HEFF(I,J,3,bi,bj))
208     & *HEFFM(I,J,bi,bj)
209     ENDDO
210     ENDDO
211     ENDDO
212     ENDDO
213    
214 dimitri 1.4 #endif /* ALLOW_SEAICE */
215 heimbach 1.2
216     RETURN
217     END
  ViewVC Help
Powered by ViewVC 1.1.22