1 |
C $Header: /u/gcmpack/MITgcm/pkg/opps/opps_interface.F,v 1.3 2005/04/27 14:10:06 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "OPPS_OPTIONS.h" |
5 |
|
6 |
CBOP |
7 |
C !ROUTINE: OPPS_INTERFACE |
8 |
C !INTERFACE: |
9 |
SUBROUTINE OPPS_INTERFACE( |
10 |
I bi, bj, iMin, iMax, jMin, jMax, |
11 |
I myTime, myIter, myThid ) |
12 |
C !DESCRIPTION: \bv |
13 |
C *================================================================* |
14 |
C | SUBROUTINE OPPS_INTERFACE | |
15 |
C | o Driver for OPPS mixing scheme that can be called | |
16 |
C | instead of convective_adjustment. | |
17 |
C | Reference: Paluszkiewicz+Romea, Dynamics of Atmospheres and | |
18 |
C | Oceans (1997) 26, pp. 95-130 | |
19 |
C | o Support for passive tracers by joint treatment of | |
20 |
C | active (theta, salt) and passive tracers. The array | |
21 |
C | tracerLoc(Nr,2+PTRACERS_num) contains | |
22 |
C | theta = tracerLoc(:,1), | |
23 |
C | salt = tracerLoc(:,2), and | |
24 |
C | ptracers = tracerLoc(:,3:PTRACERS_num+2). For this to | |
25 |
C | work, the routine opps_calc had to be modified | |
26 |
C | considerably. opps_calc is based on nlopps.F but there is | |
27 |
C | is little left of the original (see opps_calc.F) | |
28 |
C *================================================================* |
29 |
C \ev |
30 |
|
31 |
C !USES: |
32 |
IMPLICIT NONE |
33 |
C == Global data == |
34 |
#include "SIZE.h" |
35 |
#include "EEPARAMS.h" |
36 |
#include "PARAMS.h" |
37 |
#include "DYNVARS.h" |
38 |
#include "GRID.h" |
39 |
#include "OPPS.h" |
40 |
#ifdef ALLOW_PTRACERS |
41 |
#include "PTRACERS_SIZE.h" |
42 |
#include "PTRACERS_PARAMS.h" |
43 |
#include "PTRACERS_FIELDS.h" |
44 |
#endif |
45 |
|
46 |
C !INPUT/OUTPUT PARAMETERS: |
47 |
C == Routine arguments == |
48 |
C bi,bj,iMin,iMax,jMin,jMax,K - Loop counters |
49 |
C myTime - Current time in simulation |
50 |
C myIter - Current iteration in simulation |
51 |
C myThid - Thread number of this instance of S/R CONVECT |
52 |
INTEGER bi,bj,iMin,iMax,jMin,jMax |
53 |
_RL myTime |
54 |
INTEGER myIter |
55 |
INTEGER myThid |
56 |
|
57 |
#ifdef ALLOW_OPPS |
58 |
|
59 |
C !LOCAL VARIABLES: |
60 |
C == Local variables == |
61 |
C msgBuf - Informational/error meesage buffer |
62 |
INTEGER nTracer |
63 |
#ifdef ALLOW_PTRACERS |
64 |
PARAMETER( nTracer = 2+PTRACERS_num ) |
65 |
#else /* not ALLOW_PTRACERS */ |
66 |
PARAMETER( nTracer = 2 ) |
67 |
#endif /* ALLOW_PTRACERS */ |
68 |
INTEGER i, j, K, kSurface, kMax, ktr, nTracerInUse |
69 |
_RL tMin, tMax, sMin, sMax |
70 |
_RL tMinNew, tMaxNew, sMinNew, sMaxNew |
71 |
_RL thetaLoc(Nr), saltLoc(Nr), wVelLoc(Nr) |
72 |
_RL tracerLoc(Nr,nTracer) |
73 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
74 |
CEOP |
75 |
|
76 |
C initialization |
77 |
#ifdef ALLOW_PTRACERS |
78 |
nTracerInUse = 2+PTRACERS_numInUse |
79 |
#else |
80 |
nTracerInUse = 2 |
81 |
#endif /* ALLOW_PTRACERS */ |
82 |
tMax = -1. _d 23 |
83 |
tMin = 1. _d 23 |
84 |
sMax = -1. _d 23 |
85 |
sMin = 1. _d 23 |
86 |
tMaxNew = -1. _d 23 |
87 |
tMinNew = 1. _d 23 |
88 |
sMaxNew = -1. _d 23 |
89 |
sMinNew = 1. _d 23 |
90 |
tMinNew = 1. _d 23 |
91 |
IF ( buoyancyRelation .eq. 'OCEANIC' ) THEN |
92 |
kSurface = 1 |
93 |
ELSEIF ( buoyancyRelation .eq. 'OCEANICP' ) THEN |
94 |
kSurface = Nr |
95 |
ELSEIF ( buoyancyRelation .eq. 'ATMOSPHERIC' ) THEN |
96 |
kSurface = Nr |
97 |
ELSE |
98 |
STOP 'OPPS_INTERFACE: We should never reach this point' |
99 |
ENDIF |
100 |
C re-initialize convection counter |
101 |
DO k=1,Nr |
102 |
DO J=1-Oly,sNy+Oly |
103 |
DO I=1-Olx,sNx+Olx |
104 |
OPPSconvectCount(I,J,K,bi,bj) = 0. _d 0 |
105 |
ENDDO |
106 |
ENDDO |
107 |
ENDDO |
108 |
|
109 |
C |
110 |
DO J=jMin,jMax |
111 |
DO I=iMin,iMax |
112 |
IF ( hFacC(I,J,kSurface,bi,bj) .gt. 0. _d 0 ) THEN |
113 |
IF ( useGCMwVel ) THEN |
114 |
DO K=1,Nr |
115 |
tracerLoc(K,1) = theta(I,J,K,bi,bj) |
116 |
tracerLoc(K,2) = salt(I,J,K,bi,bj) |
117 |
wVelLoc(K) = wVel(I,J,K,bi,bj) |
118 |
ENDDO |
119 |
ELSE |
120 |
DO K=1,Nr |
121 |
tracerLoc(K,1) = theta(I,J,K,bi,bj) |
122 |
tracerLoc(K,2) = salt(I,J,K,bi,bj) |
123 |
wVelLoc(K) = - VERTICAL_VELOCITY |
124 |
ENDDO |
125 |
ENDIF |
126 |
#ifdef ALLOW_PTRACERS |
127 |
DO ktr = 3, nTracerInUse |
128 |
DO K=1,Nr |
129 |
tracerLoc(K,ktr) = ptracer(I,J,K,bi,bj,ktr-2) |
130 |
ENDDO |
131 |
ENDDO |
132 |
#endif /* ALLOW_PTRACERS */ |
133 |
#ifdef ALLOW_OPPS_DEBUG |
134 |
IF ( OPPSdebugLevel .GE. debLevA ) THEN |
135 |
C determine range of temperature and salinity |
136 |
tMax = -1. d 23 |
137 |
tMin = 1. d 23 |
138 |
sMax = -1. d 23 |
139 |
sMin = 1. d 23 |
140 |
DO K=1,Nr |
141 |
tMax = MAX(tracerLoc(K,1),tMax) |
142 |
tMin = MAX(tracerLoc(K,1),tMin) |
143 |
sMax = MAX(tracerLoc(K,2),sMax) |
144 |
sMin = MAX(tracerLoc(K,2),sMin) |
145 |
ENDDO |
146 |
ENDIF |
147 |
#endif /* ALLOW_OPPS_DEBUG */ |
148 |
kMax = kLowC(I,J,bi,bj) |
149 |
CALL OPPS_CALC( |
150 |
U tracerLoc, |
151 |
I wVelLoc,kMax,nTracer,nTracerInUse, |
152 |
I I,J,bi,bj,myTime,myIter,myThid) |
153 |
#ifdef ALLOW_OPPS_DEBUG |
154 |
IF ( OPPSdebugLevel .GE. debLevA ) THEN |
155 |
C determine range of temperature and salinity |
156 |
tMaxNew = -1. d 23 |
157 |
tMinNew = 1. d 23 |
158 |
sMaxNew = -1. d 23 |
159 |
sMinNew = 1. d 23 |
160 |
DO K=1,Nr |
161 |
tMaxNew = MAX(tracerLoc(K,1),tMaxNew) |
162 |
tMinNew = MAX(tracerLoc(K,1),tMinNew) |
163 |
sMaxNew = MAX(tracerLoc(K,2),sMaxNew) |
164 |
sMinNew = MAX(tracerLoc(K,2),sMinNew) |
165 |
ENDDO |
166 |
IF ( tMaxNew.GT.tMax .OR. tMinNew.LT.tMin .OR. |
167 |
& sMaxNew.GT.sMax .OR. sMinNew.LT.sMIN ) THEN |
168 |
WRITE(msgBuf,'(A,A)') 'OPPS_INTERFACE: theta or S-range is', |
169 |
& ' larger than before mixing' |
170 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
171 |
& SQUEEZE_RIGHT , 1) |
172 |
WRITE(msgBuf,'(A,2I5)') ' for (i,j) = ', I,J |
173 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
174 |
& SQUEEZE_RIGHT , 1) |
175 |
ENDIF |
176 |
ENDIF |
177 |
#endif /* ALLOW_OPPS_DEBUG */ |
178 |
DO K=1,Nr |
179 |
theta(I,J,K,bi,bj) = tracerLoc(K,1) |
180 |
salt(I,J,K,bi,bj) = tracerLoc(K,2) |
181 |
ENDDO |
182 |
#ifdef ALLOW_PTRACERS |
183 |
DO ktr = 3, nTracerInUse |
184 |
DO K=1,Nr |
185 |
ptracer(I,J,K,bi,bj,ktr-2) = tracerLoc(K,ktr) |
186 |
ENDDO |
187 |
ENDDO |
188 |
#endif /* ALLOW_PTRACERS */ |
189 |
ENDIF |
190 |
ENDDO |
191 |
ENDDO |
192 |
#endif /* ALLOW_OPPS */ |
193 |
|
194 |
RETURN |
195 |
END |