/[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.3 - (show annotations) (download)
Thu Dec 5 08:43:02 2002 UTC (21 years, 7 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint47e_post, checkpoint47c_post, checkpoint48e_post, checkpoint48b_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint48d_pre, checkpoint47i_post, checkpoint47d_post, checkpoint48d_post, checkpoint47g_post, checkpoint48a_post, checkpoint47j_post, branch-exfmods-tag, checkpoint48c_post, checkpoint47b_post, checkpoint47f_post, checkpoint48, checkpoint47h_post
Branch point for: c24_e25_ice, branch-exfmods-curt, ecco-branch
Changes since 1.2: +71 -56 lines 
checkpoint47b_post
Merging from release1_p9:
o pkg/seaice
  - removed GOTO's and added taf directives
  - double precision constants to reduce the g77 (Linux)
    to F77 (SGI) differences reported in release1_p8
o tools/genmake
  - added SGI options
o verification/testscript
  - updated to that of checkpoint47a_post
o verification/global_ocean.90x40x15/input/eedata
  - modified for SGI f77 compatibility
o verification/lab_sea
  - added description of sea-ice model
  - added missing matlab routines
  - added test of thermodynamics parallelization
Modified Files:
   doc/tag-index pkg/seaice/SEAICE_FFIELDS.h
   pkg/seaice/SEAICE_PARAMS.h pkg/seaice/adi.F
   pkg/seaice/advect.F pkg/seaice/budget.F pkg/seaice/diffus.F
   pkg/seaice/dynsolver.F pkg/seaice/groatb.F pkg/seaice/growth.F
   pkg/seaice/lsr.F pkg/seaice/ostres.F
   pkg/seaice/seaice_do_diags.F pkg/seaice/seaice_get_forcing.F
   pkg/seaice/seaice_init.F pkg/seaice/seaice_model.F
   pkg/seaice/seaice_readparms.F tools/genmake
   verification/global_ocean.90x40x15/input/eedata
   verification/lab_sea/README
   verification/lab_sea/matlab/lookat_exp1.m
   verification/lab_sea/matlab/lookat_exp2.m
   verification/lab_sea/matlab/lookat_exp3.m
   verification/lab_sea/matlab/lookat_exp4.m
   verification/lab_sea/matlab/lookat_exp5.m
   verification/lab_sea/matlab/lookat_exp6.m
   verification/lab_sea/results/AREAtave.0000000010.data
   verification/lab_sea/results/HEFFtave.0000000010.data
   verification/lab_sea/results/UICEtave.0000000010.data
   verification/lab_sea/results/VICEtave.0000000010.data
   verification/lab_sea/results/output.txt
Added Files:
   verification/lab_sea/seaice.ps
   verification/lab_sea/matlab/lookat_exp7.m
   verification/lab_sea/matlab/mmax.m
   verification/lab_sea/matlab/mypcolor.m
   verification/lab_sea/matlab/myquiver.m
   verification/lab_sea/matlab/readbin.m
   verification/lab_sea/matlab/wysiwyg.m
Removed Files:
   verification/lab_sea/code/KPP_OPTIONS.h
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, bi, bj
36 INTEGER K3
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 IF(LAD.EQ.1) THEN
45 C LEAPFROG
46 DELTT=DELTAT*TWO
47 K3=3
48 ELSE
49 C BACKWARD EULER
50 DELTT=DELTAT
51 K3=2
52 ENDIF
53
54 C NOW REARRANGE H'S
55
56 DO bj=myByLo(myThid),myByHi(myThid)
57 DO bi=myBxLo(myThid),myBxHi(myThid)
58
59 DO j=1-OLy,sNy+OLy
60 DO i=1-OLx,sNx+OLx
61 UI(I,J)=UICE(I,J,1,bi,bj)
62 VI(I,J)=VICE(I,J,1,bi,bj)
63 ENDDO
64 ENDDO
65
66 DO j=1-OLy,sNy+OLy
67 DO i=1-OLx,sNx+OLx
68 HEFF(I,J,3,bi,bj)=HEFF(I,J,2,bi,bj)
69 HEFF(I,J,2,bi,bj)=HEFF(I,J,1,bi,bj)
70 ENDDO
71 ENDDO
72
73 ENDDO
74 ENDDO
75
76 C NOW GO THROUGH STANDARD CONSERVATIVE ADVECTION
77 DO bj=myByLo(myThid),myByHi(myThid)
78 DO bi=myBxLo(myThid),myBxHi(myThid)
79 DO J=0,sNy-1
80 DO I=0,sNx-1
81 HEFF(I+1,J+1,1,bi,bj)=HEFF(I+1,J+1,K3,bi,bj)
82 & -DELTT*((HEFF(I+1,J+1,2,bi,bj)+HEFF
83 & (I+2,J+1,2,bi,bj))*(UI(I+1,J+1)+UI(I+1,J))-
84 & (HEFF(I+1,J+1,2,bi,bj)+HEFF
85 & (I,J+1,2,bi,bj))*(UI(I,J+1)+UI(I,J)))
86 & *(QUART/(DXTICE(I+1,J,bi,bj)*CSTICE(I,J+1,bi,bj)))
87 & -DELTT*((HEFF(I+1,J+1,2,bi,bj)
88 & +HEFF(I+1,J+2,2,bi,bj))*(VI(I,J+1)
89 & +VI(I+1,J+1)*CSUICE(I,J+1,bi,bj)
90 & -(HEFF(I+1,J+1,2,bi,bj)+HEFF(I+1,J,2,bi,bj))
91 & *(VI(I,J)+VI(I+1,J))*CSUICE(I,J,bi,bj))
92 & *(QUART/(DYTICE(I,J+1,bi,bj)*CSTICE(I,J+1,bi,bj))))
93 ENDDO
94 ENDDO
95 ENDDO
96 ENDDO
97
98 _BARRIER
99 CALL EXCH_RL( HEFF, OLx, OLx, OLy, OLy, 3, OLx, OLy,
100 I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
101 _BARRIER
102
103 IF (LAD .EQ. 2) THEN
104
105 C NOW DO BACKWARD EULER CORRECTION
106 DO bj=myByLo(myThid),myByHi(myThid)
107 DO bi=myBxLo(myThid),myBxHi(myThid)
108 DO j=1-OLy,sNy+OLy
109 DO i=1-OLx,sNx+OLx
110 HEFF(I,J,3,bi,bj)=HEFF(I,J,2,bi,bj)
111 HEFF(I,J,2,bi,bj)=HALF*(HEFF(I,J,1,bi,bj)
112 & +HEFF(I,J,2,bi,bj))
113 ENDDO
114 ENDDO
115 ENDDO
116 ENDDO
117
118 C NOW GO THROUGH STANDARD CONSERVATIVE ADVECTION
119 DO bj=myByLo(myThid),myByHi(myThid)
120 DO bi=myBxLo(myThid),myBxHi(myThid)
121 DO J=0,sNy-1
122 DO I=0,sNx-1
123 HEFF(I+1,J+1,1,bi,bj)=HEFF(I+1,J+1,3,bi,bj)
124 & -DELTT*((HEFF(I+1,J+1,2,bi,bj)+HEFF
125 & (I+2,J+1,2,bi,bj))*(UI(I+1,J+1)+UI(I+1,J))-
126 & (HEFF(I+1,J+1,2,bi,bj)+HEFF
127 & (I,J+1,2,bi,bj))*(UI(I,J+1)+UI(I,J)))
128 & *(QUART/(DXTICE(I+1,J,bi,bj)*CSTICE(I,J+1,bi,bj)))
129 & -DELTT*((HEFF(I+1,J+1,2,bi,bj)
130 & +HEFF(I+1,J+2,2,bi,bj))*(VI(I,J+1)
131 & +VI(I+1,J+1)*CSUICE(I,J+1,bi,bj)
132 & -(HEFF(I+1,J+1,2,bi,bj)+HEFF(I+1,J,2,bi,bj))
133 & *(VI(I,J)+VI(I+1,J))*CSUICE(I,J,bi,bj))
134 & *(QUART/(DYTICE(I,J+1,bi,bj)*CSTICE(I,J+1,bi,bj))))
135 ENDDO
136 ENDDO
137 ENDDO
138 ENDDO
139
140 _BARRIER
141 CALL EXCH_RL( HEFF, OLx, OLx, OLy, OLy, 3, OLx, OLy,
142 I FORWARD_SIMULATION, EXCH_UPDATE_CORNERS, myThid )
143 _BARRIER
144
145 C NOW FIX UP H(I,J,2)
146 DO bj=myByLo(myThid),myByHi(myThid)
147 DO bi=myBxLo(myThid),myBxHi(myThid)
148 DO j=1-OLy,sNy+OLy
149 DO i=1-OLx,sNx+OLx
150 HEFF(I,J,2,bi,bj)=HEFF(I,J,3,bi,bj)
151 ENDDO
152 ENDDO
153 ENDDO
154 ENDDO
155
156 ENDIF
157
158 C NOW DO DIFFUSION ON H(I,J,3)
159 C NOW CALCULATE DIFFUSION COEF ROUGHLY
160 DO bj=myByLo(myThid),myByHi(myThid)
161 DO bi=myBxLo(myThid),myBxHi(myThid)
162 DO j=1-OLy,sNy+OLy
163 DO i=1-OLx,sNx+OLx
164 DIFFA(I,J)=DIFF1*MIN(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj)
165 & ,DYTICE(I,J,bi,bj))
166 ENDDO
167 ENDDO
168 ENDDO
169 ENDDO
170 CALL DIFFUS(HEFF,DIFFA,HEFFM,DELTT, myThid)
171
172 DO bj=myByLo(myThid),myByHi(myThid)
173 DO bi=myBxLo(myThid),myBxHi(myThid)
174 DO j=1-OLy,sNy+OLy
175 DO i=1-OLx,sNx+OLx
176 HEFF(I,J,1,bi,bj)=(HEFF(I,J,1,bi,bj)+HEFF(I,J,3,bi,bj))
177 & *HEFFM(I,J,bi,bj)
178 ENDDO
179 ENDDO
180 ENDDO
181 ENDDO
182
183 C NOW CALCULATE DIFFUSION COEF ROUGHLY
184 DO bj=myByLo(myThid),myByHi(myThid)
185 DO bi=myBxLo(myThid),myBxHi(myThid)
186 DO j=1-OLy,sNy+OLy
187 DO i=1-OLx,sNx+OLx
188 DIFFA(I,J)=-(MIN(DXTICE(I,J,bi,bj)*CSTICE(I,J,bi,bj)
189 & ,DYTICE(I,J,bi,bj)))**2/DELTT
190 ENDDO
191 ENDDO
192 ENDDO
193 ENDDO
194 CALL DIFFUS(HEFF,DIFFA,HEFFM,DELTT, myThid)
195
196 DO bj=myByLo(myThid),myByHi(myThid)
197 DO bi=myBxLo(myThid),myBxHi(myThid)
198 DO j=1-OLy,sNy+OLy
199 DO i=1-OLx,sNx+OLx
200 HEFF(I,J,1,bi,bj)=(HEFF(I,J,1,bi,bj)+HEFF(I,J,3,bi,bj))
201 & *HEFFM(I,J,bi,bj)
202 ENDDO
203 ENDDO
204 ENDDO
205 ENDDO
206
207 #endif ALLOW_SEAICE
208
209 RETURN
210 END
  ViewVC Help
Powered by ViewVC 1.1.22