/[MITgcm]/MITgcm_contrib/lab_sea_test/advect.F
ViewVC logotype

Annotation of /MITgcm_contrib/lab_sea_test/advect.F

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

Revision 1.1 - (hide annotations) (download)
Mon Jul 12 01:00:20 2004 UTC (21 years, 3 months ago) by dimitri
Branch: MAIN
CVS Tags: HEAD 
added my_min_max for pkg/seaice routines
1 dimitri 1.1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/advect.F,v 1.10 2004/05/05 00:23:37 dimitri Exp $
2     C $Name: $
3    
4     #include "SEAICE_OPTIONS.h"
5    
6     CStartOfInterface
7     SUBROUTINE advect( UICE,VICE,HEFF,HEFFM,myThid )
8     C /==========================================================\
9     C | SUBROUTINE advect |
10     C | o Calculate ice advection |
11     C |==========================================================|
12     C \==========================================================/
13     IMPLICIT NONE
14    
15     C === Global variables ===
16     #include "SIZE.h"
17     #include "EEPARAMS.h"
18     #include "PARAMS.h"
19     #include "SEAICE_PARAMS.h"
20     #include "SEAICE_GRID.h"
21    
22     #ifdef ALLOW_AUTODIFF_TAMC
23     # include "tamc.h"
24     #endif
25    
26     C === Routine arguments ===
27     C myThid - Thread no. that called this routine.
28     _RL UICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
29     _RL VICE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
30     _RL HEFF (1-OLx:sNx+OLx,1-OLy:sNy+OLy,3,nSx,nSy)
31     _RL HEFFM (1-OLx:sNx+OLx,1-OLy:sNy+OLy, nSx,nSy)
32     INTEGER myThid
33     CEndOfInterface
34    
35     #ifdef ALLOW_SEAICE
36    
37     C === Local variables ===
38     C i,j,k,bi,bj - Loop counters
39    
40     INTEGER i, j, bi, bj
41     INTEGER K3
42     _RL DELTT
43    
44     _RL UI (1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
45     _RL VI (1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
46     _RL DIFFA(1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
47    
48     _RL mymin_R8, mymax_R8
49     external mymin_R8, mymax_R8
50    
51     C NOW DECIDE IF BACKWARD EULER OR LEAPFROG
52     IF(LAD.EQ.1) THEN
53     C LEAPFROG
54     DELTT=SEAICE_deltaTtherm*TWO
55     K3=3
56     ELSE
57     C BACKWARD EULER
58     DELTT=SEAICE_deltaTtherm
59     K3=2
60     ENDIF
61    
62     C NOW REARRANGE H'S
63    
64     DO bj=myByLo(myThid),myByHi(myThid)
65     DO bi=myBxLo(myThid),myBxHi(myThid)
66    
67     DO j=1-OLy,sNy+OLy
68     DO i=1-OLx,sNx+OLx
69     UI(I,J,bi,bj)=UICE(I,J,1,bi,bj)
70     VI(I,J,bi,bj)=VICE(I,J,1,bi,bj)
71     ENDDO
72     ENDDO
73    
74     DO j=1-OLy,sNy+OLy
75     DO i=1-OLx,sNx+OLx
76     HEFF(I,J,3,bi,bj)=HEFF(I,J,2,bi,bj)
77     HEFF(I,J,2,bi,bj)=HEFF(I,J,1,bi,bj)
78     ENDDO
79     ENDDO
80    
81     ENDDO
82     ENDDO
83    
84     #ifdef ALLOW_AUTODIFF_TAMC
85     CADJ STORE heff = comlev1, key = ikey_dynamics
86     #endif /* ALLOW_AUTODIFF_TAMC */
87    
88     C NOW GO THROUGH STANDARD CONSERVATIVE ADVECTION
89     DO bj=myByLo(myThid),myByHi(myThid)
90     DO bi=myBxLo(myThid),myBxHi(myThid)
91     DO J=0,sNy-1
92     DO I=0,sNx-1
93     HEFF(I+1,J+1,1,bi,bj)=HEFF(I+1,J+1,K3,bi,bj)
94     & -DELTT*((HEFF(I+1,J+1,2,bi,bj)+HEFF
95     & (I+2,J+1,2,bi,bj))*(UI(I+2,J+2,bi,bj)+UI(I+2,J+1,bi,bj))-
96     & (HEFF(I+1,J+1,2,bi,bj)+HEFF
97     & (I,J+1,2,bi,bj))*(UI(I+1,J+2,bi,bj)+UI(I+1,J+1,bi,bj)))
98     & *(QUART/(DXTICE(I+1,J,bi,bj)*CSTICE(I,J+1,bi,bj)))
99     & -DELTT*((HEFF(I+1,J+1,2,bi,bj)
100     & +HEFF(I+1,J+2,2,bi,bj))*(VI(I+1,J+2,bi,bj)
101     & +VI(I+2,J+2,bi,bj))*CSUICE(I+1,J+2,bi,bj)
102     & -(HEFF(I+1,J+1,2,bi,bj)+HEFF(I+1,J,2,bi,bj))
103     & *(VI(I+1,J+1,bi,bj)+VI(I+2,J+1,bi,bj))*CSUICE(I+1,J+1,bi,bj))
104     & *(QUART/(DYTICE(I,J+1,bi,bj)*CSTICE(I,J+1,bi,bj)))
105     ENDDO
106     ENDDO
107     ENDDO
108     ENDDO
109    
110     _BARRIER
111     CALL SEAICE_EXCH ( HEFF, myThid )
112     _BARRIER
113    
114     IF (LAD .EQ. 2) THEN
115    
116     C NOW DO BACKWARD EULER CORRECTION
117     DO bj=myByLo(myThid),myByHi(myThid)
118     DO bi=myBxLo(myThid),myBxHi(myThid)
119     DO j=1-OLy,sNy+OLy
120     DO i=1-OLx,sNx+OLx
121     HEFF(I,J,3,bi,bj)=HEFF(I,J,2,bi,bj)
122     HEFF(I,J,2,bi,bj)=HALF*(HEFF(I,J,1,bi,bj)
123     & +HEFF(I,J,2,bi,bj))
124     ENDDO
125     ENDDO
126     ENDDO
127     ENDDO
128    
129     C NOW GO THROUGH STANDARD CONSERVATIVE ADVECTION
130     DO bj=myByLo(myThid),myByHi(myThid)
131     DO bi=myBxLo(myThid),myBxHi(myThid)
132     DO J=0,sNy-1
133     DO I=0,sNx-1
134     HEFF(I+1,J+1,1,bi,bj)=HEFF(I+1,J+1,3,bi,bj)
135     & -DELTT*((HEFF(I+1,J+1,2,bi,bj)+HEFF
136     & (I+2,J+1,2,bi,bj))*(UI(I+2,J+2,bi,bj)+UI(I+2,J+1,bi,bj))-
137     & (HEFF(I+1,J+1,2,bi,bj)+HEFF
138     & (I,J+1,2,bi,bj))*(UI(I+1,J+2,bi,bj)+UI(I+1,J+1,bi,bj)))
139     & *(QUART/(DXTICE(I+1,J,bi,bj)*CSTICE(I,J+1,bi,bj)))
140     & -DELTT*((HEFF(I+1,J+1,2,bi,bj)
141     & +HEFF(I+1,J+2,2,bi,bj))*(VI(I+1,J+2,bi,bj)
142     & +VI(I+2,J+2,bi,bj))*CSUICE(I+1,J+2,bi,bj)
143     & -(HEFF(I+1,J+1,2,bi,bj)+HEFF(I+1,J,2,bi,bj))
144     & *(VI(I+1,J+1,bi,bj)+VI(I+2,J+1,bi,bj))
145     & *CSUICE(I+1,J+1,bi,bj))
146     & *(QUART/(DYTICE(I,J+1,bi,bj)*CSTICE(I,J+1,bi,bj)))
147     ENDDO
148     ENDDO
149     ENDDO
150     ENDDO
151    
152     _BARRIER
153     CALL SEAICE_EXCH( HEFF, myThid )
154     _BARRIER
155    
156     C NOW FIX UP H(I,J,2)
157     DO bj=myByLo(myThid),myByHi(myThid)
158     DO bi=myBxLo(myThid),myBxHi(myThid)
159     DO j=1-OLy,sNy+OLy
160     DO i=1-OLx,sNx+OLx
161     HEFF(I,J,2,bi,bj)=HEFF(I,J,3,bi,bj)
162     ENDDO
163     ENDDO
164     ENDDO
165     ENDDO
166    
167     ENDIF
168    
169     C NOW DO DIFFUSION ON H(I,J,3)
170     C NOW CALCULATE DIFFUSION COEF ROUGHLY
171     DO bj=myByLo(myThid),myByHi(myThid)
172     DO bi=myBxLo(myThid),myBxHi(myThid)
173     DO j=1-OLy,sNy+OLy
174     DO i=1-OLx,sNx+OLx
175     DIFFA(I,J,bi,bj)=DIFF1*MYMIN_R8(DXTICE(I,J,bi,bj)
176     & *CSTICE(I,J,bi,bj),DYTICE(I,J,bi,bj))
177     ENDDO
178     ENDDO
179     ENDDO
180     ENDDO
181     CALL DIFFUS(HEFF,DIFFA,HEFFM,DELTT, myThid)
182    
183     DO bj=myByLo(myThid),myByHi(myThid)
184     DO bi=myBxLo(myThid),myBxHi(myThid)
185     DO j=1-OLy,sNy+OLy
186     DO i=1-OLx,sNx+OLx
187     HEFF(I,J,1,bi,bj)=(HEFF(I,J,1,bi,bj)+HEFF(I,J,3,bi,bj))
188     & *HEFFM(I,J,bi,bj)
189     ENDDO
190     ENDDO
191     ENDDO
192     ENDDO
193    
194     C NOW CALCULATE DIFFUSION COEF ROUGHLY
195     DO bj=myByLo(myThid),myByHi(myThid)
196     DO bi=myBxLo(myThid),myBxHi(myThid)
197     DO j=1-OLy,sNy+OLy
198     DO i=1-OLx,sNx+OLx
199     DIFFA(I,J,bi,bj)=-(MYMIN_R8(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj)
200     & ,DYTICE(I,J,bi,bj)))**2/DELTT
201     ENDDO
202     ENDDO
203     ENDDO
204     ENDDO
205     CALL DIFFUS(HEFF,DIFFA,HEFFM,DELTT, myThid)
206    
207     DO bj=myByLo(myThid),myByHi(myThid)
208     DO bi=myBxLo(myThid),myBxHi(myThid)
209     DO j=1-OLy,sNy+OLy
210     DO i=1-OLx,sNx+OLx
211     HEFF(I,J,1,bi,bj)=(HEFF(I,J,1,bi,bj)+HEFF(I,J,3,bi,bj))
212     & *HEFFM(I,J,bi,bj)
213     ENDDO
214     ENDDO
215     ENDDO
216     ENDDO
217    
218     #endif /* ALLOW_SEAICE */
219    
220     RETURN
221     END
  ViewVC Help
Powered by ViewVC 1.1.22