/[MITgcm]/MITgcm/model/src/the_correction_step.F
ViewVC logotype

Annotation of /MITgcm/model/src/the_correction_step.F

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


Revision 1.15.2.1 - (hide annotations) (download)
Tue Feb 26 16:04:48 2002 UTC (22 years, 3 months ago) by adcroft
Branch: release1
Changes since 1.15: +22 -10 lines
Merging changes on MAIN between checkpoint43 and checkpoint43a-release1mods
Command: cvs -q update -jcheckpoint43 -jcheckpoint43a-release1mods -d -P

These changes are most of the changes between c43 and c44 except those
that occured after "12:45 11 Jan 2002". As far as I can tell it is
checkpoint43 with the following mods:

  o fix bug in mom_vi_del2uv
  o select when filters are applied ; add options to zonal_filter (data.zonfilt)  o gmredi: fix Pb in the adiabatic form ; add options (.e.g. Bolus advection)
  o update AIM experiments (NCEP input files)
  o improve and extend diagnostics (Monitor, TimeAve with NonLin-FrSurf)
  o added some stuff for AD
  o Jamar wet-points

This update does not contain the following mods that are in checkpoint44

  o bug fix in pkg/generic_advdiff/
    - thread related bug, bi,bj arguments in vertical advection routines
  o some changes to pkg/autodiff, pkg/cost, pkg/exf, pkg/ecco,
    verification/carbon and model/src/ related to adjoint
  o some new Matlab scripts for diagnosing model density
    - utils/matlab/dens_poly3.m and ini_poly3.m

The list of exclusions is accurate based on a "cvs diff". The list of
inclusions is based on the record in doc/tag-index which may not be complete.

1 adcroft 1.15.2.1 C $Header: /u/gcmpack/MITgcm/model/src/the_correction_step.F,v 1.16 2001/12/11 14:58:46 jmc Exp $
2 jmc 1.13 C Tag $Name: $
3 adcroft 1.2
4     #include "CPP_OPTIONS.h"
5    
6 cnh 1.14 CBOP
7     C !ROUTINE: THE_CORRECTION_STEP
8     C !INTERFACE:
9 adcroft 1.2 SUBROUTINE THE_CORRECTION_STEP(myTime, myIter, myThid)
10 cnh 1.14 C !DESCRIPTION: \bv
11     C *==========================================================*
12     C | SUBROUTINE THE_CORRECTION_STEP
13     C *==========================================================*
14     C |1rst Part : Update U,V,T,S.
15     C |
16     C | The arrays used for time stepping are cycled.
17     C | Tracers:
18     C | T(n) = Gt(n-1)
19     C | Gt(n-1) = Gt(n)
20     C | Momentum:
21     C | V(n) = Gv(n-1) - dt * grad Eta
22     C | Gv(n-1) = Gv(n)
23     C |
24     C |part1: update U,V,T,S
25     C | U*,V* (contained in gUnm1,gVnm1) have the surface
26     C | pressure gradient term added and the result stored
27     C | in U,V (contained in uVel, vVel)
28     C | T* (contained in gTnm1) is copied to T (theta)
29     C | S* (contained in gSnm1) is copied to S (salt)
30     C |
31     C |part2: Adjustments.
32     C | o Filter U,V,T,S (Shapiro Filter, Zonal_Filter)
33     C | o Convective Adjustment
34     C | o Compute again Eta (exact volume conservation)
35     C | o Diagmnostic of state variables (Time average)
36     C *==========================================================*
37     C \ev
38    
39     C !USES:
40 adcroft 1.2 IMPLICIT NONE
41     C == Global variables ===
42     #include "SIZE.h"
43     #include "EEPARAMS.h"
44     #include "PARAMS.h"
45     #include "DYNVARS.h"
46 heimbach 1.12 #ifdef ALLOW_PASSIVE_TRACER
47 heimbach 1.11 #include "TR1.h"
48 heimbach 1.12 #endif
49 adcroft 1.15.2.1
50     #ifdef ALLOW_SHAP_FILT
51     #include "SHAP_FILT.h"
52     #endif
53     #ifdef ALLOW_ZONAL_FILT
54     #include "ZONAL_FILT.h"
55     #endif
56    
57 heimbach 1.7 #ifdef ALLOW_AUTODIFF_TAMC
58     #include "tamc.h"
59     #include "tamc_keys.h"
60     #endif /* ALLOW_AUTODIFF_TAMC */
61    
62 cnh 1.14 C !INPUT/OUTPUT PARAMETERS:
63 adcroft 1.2 C == Routine arguments ==
64     C myTime - Current time in simulation
65     C myIter - Current iteration number in simulation
66     C myThid - Thread number for this instance of the routine.
67     _RL myTime
68     INTEGER myIter
69     INTEGER myThid
70    
71 cnh 1.14 C !LOCAL VARIABLES:
72 adcroft 1.2 C == Local variables
73 jmc 1.6 _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
74     _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
75 adcroft 1.2 INTEGER iMin,iMax
76     INTEGER jMin,jMax
77     INTEGER bi,bj
78     INTEGER k,i,j
79    
80 cnh 1.14 CEOP
81 adcroft 1.9
82 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
83     DO bi=myBxLo(myThid),myBxHi(myThid)
84 heimbach 1.7
85     #ifdef ALLOW_AUTODIFF_TAMC
86     act1 = bi - myBxLo(myThid)
87     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
88     act2 = bj - myByLo(myThid)
89     max2 = myByHi(myThid) - myByLo(myThid) + 1
90     act3 = myThid - 1
91     max3 = nTx*nTy
92     act4 = ikey_dynamics - 1
93     ikey = (act1 + 1) + act2*max1
94     & + act3*max1*max2
95     & + act4*max1*max2*max3
96     #endif /* ALLOW_AUTODIFF_TAMC */
97 adcroft 1.2
98     C-- Set up work arrays that need valid initial values
99     DO j=1-OLy,sNy+OLy
100     DO i=1-OLx,sNx+OLx
101 jmc 1.6 phiSurfX(i,j)=0.
102     phiSurfY(i,j)=0.
103 adcroft 1.2 ENDDO
104     ENDDO
105    
106     C Loop range: Gradients of Eta are evaluated so valid
107     C range is all but first row and column in overlaps.
108     iMin = 1-OLx+1
109     iMax = sNx+OLx
110     jMin = 1-OLy+1
111     jMax = sNy+OLy
112    
113 jmc 1.6 C- Calculate gradient of surface Potentiel
114     CALL CALC_GRAD_PHI_SURF(
115 adcroft 1.2 I bi,bj,iMin,iMax,jMin,jMax,
116 jmc 1.5 I etaN,
117 jmc 1.6 O phiSurfX,phiSurfY,
118 adcroft 1.2 I myThid )
119    
120     C-- Loop over all layers, top to bottom
121     DO K=1,Nr
122    
123 heimbach 1.8 #ifdef ALLOW_AUTODIFF_TAMC
124     kkey = (ikey-1)*Nr + k
125     #endif
126    
127 adcroft 1.2 C- Update velocity fields: V(n) = V** - dt * grad Eta
128 adcroft 1.3 IF (momStepping)
129     & CALL CORRECTION_STEP(
130 adcroft 1.2 I bi,bj,iMin,iMax,jMin,jMax,K,
131 jmc 1.6 I phiSurfX,phiSurfY,myTime,myThid )
132 adcroft 1.2
133     C- Update tracer fields: T(n) = T**, Gt(n-1) = Gt(n)
134     IF (tempStepping)
135     & CALL CYCLE_TRACER(
136     I bi,bj,iMin,iMax,jMin,jMax,K,
137     U theta,gT,gTNm1,
138     I myTime,myThid )
139     IF (saltStepping)
140     & CALL CYCLE_TRACER(
141     I bi,bj,iMin,iMax,jMin,jMax,K,
142     U salt,gS,gSNm1,
143 heimbach 1.11 I myTime,myThid )
144 heimbach 1.12 #ifdef ALLOW_PASSIVE_TRACER
145 heimbach 1.11 IF (tr1Stepping)
146     & CALL CYCLE_TRACER(
147     I bi,bj,iMin,iMax,jMin,jMax,K,
148     U Tr1,gTr1,gTr1Nm1,
149 adcroft 1.2 I myTime,myThid )
150 heimbach 1.12 #endif
151 adcroft 1.2
152     #ifdef ALLOW_OBCS
153     #ifdef ALLOW_AUTODIFF_TAMC
154 heimbach 1.8 CADJ STORE uvel (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
155     CADJ STORE vvel (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
156     CADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
157     CADJ STORE salt (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
158 heimbach 1.15 #ifdef ALLOW_PASSIVE_TRACER
159     CADJ STORE tr1 (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
160     #endif
161 adcroft 1.2 #endif /* ALLOW_AUTODIFF_TAMC */
162     IF (useOBCS) THEN
163     CALL OBCS_APPLY_UV(bi,bj,K,uVel,vVel,myThid)
164     ENDIF
165     #endif /* ALLOW_OBCS */
166    
167     C-- End DO K=1,Nr
168     ENDDO
169    
170 adcroft 1.9 C-- End of 1rst bi,bj loop
171     ENDDO
172     ENDDO
173    
174     C--- 2nd Part : Adjustment.
175     C
176     C Static stability is calculated and the tracers are
177     C convective adjusted where statically unstable.
178    
179 adcroft 1.15.2.1 C-- Filter (and exchange)
180 adcroft 1.9 #ifdef ALLOW_SHAP_FILT
181     IF (useSHAP_FILT) THEN
182 adcroft 1.15.2.1 IF ( .NOT.shap_filt_uvStar )
183     & CALL SHAP_FILT_APPLY_UV( uVel, vVel, myTime, myIter, myThid )
184    
185     IF ( .NOT.(staggerTimeStep .AND. shap_filt_TrStagg) )
186     & CALL SHAP_FILT_APPLY_TS( theta,salt, myTime, myIter, myThid )
187 adcroft 1.9 ENDIF
188     #endif
189     #ifdef ALLOW_ZONAL_FILT
190 adcroft 1.15.2.1 IF (useZONAL_FILT) THEN
191     IF ( .NOT.zonal_filt_uvStar )
192     & CALL ZONAL_FILT_APPLY_UV( uVel, vVel, myThid )
193    
194     IF ( .NOT.(staggerTimeStep .AND. zonal_filt_TrStagg) )
195     & CALL ZONAL_FILT_APPLY_TS( theta, salt, myThid )
196    
197 adcroft 1.9 ENDIF
198     #endif
199    
200     DO bj=myByLo(myThid),myByHi(myThid)
201     DO bi=myBxLo(myThid),myBxHi(myThid)
202    
203 adcroft 1.2 C-- Convectively adjust new fields to be statically stable
204 adcroft 1.9 iMin = 1-OLx+1
205     iMax = sNx+OLx
206     jMin = 1-OLy+1
207     jMax = sNy+OLy
208 adcroft 1.2 CALL CONVECTIVE_ADJUSTMENT(
209     I bi, bj, iMin, iMax, jMin, jMax,
210     I myTime, myIter, myThid )
211 jmc 1.4
212 adcroft 1.9 #ifdef EXACT_CONSERV
213     IF (exactConserv) THEN
214     C-- Compute again "eta" to satisfy exactly the total Volume Conservation :
215 jmc 1.13 CALL CALC_EXACT_ETA( .TRUE., bi,bj, uVel,vVel,
216 adcroft 1.9 I myTime, myIter, myThid )
217     ENDIF
218     #endif /* EXACT_CONSERV */
219    
220 jmc 1.5 #ifdef ALLOW_TIMEAVE
221 jmc 1.4 IF (taveFreq.GT.0.) THEN
222 jmc 1.5 CALL TIMEAVE_STATVARS(myTime, myIter, bi, bj, myThid)
223 jmc 1.4 ENDIF
224 jmc 1.5 #endif /* ALLOW_TIMEAVE */
225 adcroft 1.2
226 adcroft 1.9 C-- End of 2nd bi,bj loop
227 adcroft 1.2 ENDDO
228     ENDDO
229 adcroft 1.9
230     #ifdef EXACT_CONSERV
231 jmc 1.13 IF (exactConserv .AND. implicDiv2Dflow .NE. 0. _d 0)
232     & _EXCH_XY_R8(etaN, myThid )
233 adcroft 1.9 #endif /* EXACT_CONSERV */
234 adcroft 1.2
235     RETURN
236     END

  ViewVC Help
Powered by ViewVC 1.1.22