File indexing completed on 2024-01-13 06:10:33 UTC
view on githubraw file Latest commit 005af54e on 2024-01-12 20:10:27 UTC
42c525bfb4 Alis*0001 #include "OBCS_OPTIONS.h"
6b47d550f4 Mart*0002 #ifdef ALLOW_CTRL
0003 # include "CTRL_OPTIONS.h"
0004 #endif /* ALLOW_CTRL */
42c525bfb4 Alis*0005
20c0bcbffa Jean*0006
0007
0008
0009
3a86c9b47d Oliv*0010 SUBROUTINE OBCS_CALC( futureTime, futureIter,
d20216bb48 Jean*0011 & uVel, vVel, wVel, theta, salt,
42c525bfb4 Alis*0012 & myThid )
20c0bcbffa Jean*0013
0014
8d129534f3 Jean*0015
20c0bcbffa Jean*0016
0017
0018
8d129534f3 Jean*0019
20c0bcbffa Jean*0020
0021
42c525bfb4 Alis*0022 IMPLICIT NONE
0023
0024
0025 #include "SIZE.h"
0026 #include "EEPARAMS.h"
0027 #include "PARAMS.h"
d20216bb48 Jean*0028 #include "GRID.h"
9b4f2a04e2 Jean*0029 #include "OBCS_PARAMS.h"
0030 #include "OBCS_GRID.h"
0031 #include "OBCS_FIELDS.h"
e9741b789e Jean*0032 #ifdef ALLOW_PTRACERS
c95bde00d7 Jean*0033 # include "PTRACERS_SIZE.h"
0034 # include "PTRACERS_PARAMS.h"
0035 # include "PTRACERS_FIELDS.h"
0036 # include "OBCS_PTRACERS.h"
ee1c912a22 Mart*0037 #endif /* ALLOW_PTRACERS */
c95bde00d7 Jean*0038 #ifdef ALLOW_NEST_CHILD
0039 # include "NEST_CHILD.h"
0040 #endif /* ALLOW_NEST_CHILD */
42c525bfb4 Alis*0041
20c0bcbffa Jean*0042
42c525bfb4 Alis*0043
9b578525b5 Jean*0044 INTEGER futureIter
42c525bfb4 Alis*0045 _RL futureTime
0046 _RL uVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0047 _RL vVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0048 _RL wVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0049 _RL theta(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0050 _RL salt (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
0051 INTEGER myThid
0052
0053 #ifdef ALLOW_OBCS
0054
20c0bcbffa Jean*0055
b80b3b6765 Jean*0056
74019f026d Jean*0057
b80b3b6765 Jean*0058
0059
005af54e38 Jean*0060 INTEGER bi, bj, k
0061 #if (defined ALLOW_OBCS_EAST ) || (defined ALLOW_OBCS_WEST )
0062 INTEGER j
0063 #endif
0064 #if (defined ALLOW_OBCS_NORTH) || (defined ALLOW_OBCS_SOUTH)
0065 INTEGER i
0066 #endif
ee1c912a22 Mart*0067 #ifdef ALLOW_PTRACERS
74019f026d Jean*0068 INTEGER I_obc, J_obc
b80b3b6765 Jean*0069 CHARACTER*(MAX_LEN_MBUF) msgBuf
ee1c912a22 Mart*0070 INTEGER iTracer
0071 #endif /* ALLOW_PTRACERS */
0072
c95bde00d7 Jean*0073
42c525bfb4 Alis*0074
abb214f17f Alis*0075 #ifdef ALLOW_DEBUG
b56dc74750 Jean*0076 IF (debugMode) CALL DEBUG_ENTER('OBCS_CALC',myThid)
abb214f17f Alis*0077 #endif
0078
3a86c9b47d Oliv*0079 DO bj=myByLo(myThid),myByHi(myThid)
0080 DO bi=myBxLo(myThid),myBxHi(myThid)
0081
c95bde00d7 Jean*0082 #ifdef ALLOW_NEST_CHILD
0083 IF ( useNEST_CHILD ) THEN
0084 IF ( PASSI.LT.2 ) THEN
0085 CALL NEST_CHILD_RECV ( myThid )
0086 ENDIF
0087 ENDIF
0088 #endif /* ALLOW_NEST_CHILD */
0089
0090
0091
96bbd4e2a5 Patr*0092 #ifdef ALLOW_OBCS_EAST
42c525bfb4 Alis*0093
abb214f17f Alis*0094 #ifdef ALLOW_DEBUG
b56dc74750 Jean*0095 IF (debugMode) CALL DEBUG_MSG('OBCS_CALC: East',myThid)
abb214f17f Alis*0096 #endif
42c525bfb4 Alis*0097 IF (useOrlanskiEast) THEN
96bbd4e2a5 Patr*0098 #ifdef ALLOW_ORLANSKI
42c525bfb4 Alis*0099 CALL ORLANSKI_EAST(
d20216bb48 Jean*0100 & bi, bj, futureTime,
0101 & uVel, vVel, wVel, theta, salt,
42c525bfb4 Alis*0102 & myThid )
96bbd4e2a5 Patr*0103 #endif
c95bde00d7 Jean*0104 #ifdef ALLOW_NEST_CHILD
0105 ELSEIF ( useNEST_CHILD ) THEN
0106 DO k=1,Nr
74019f026d Jean*0107 DO j=1-OLy,sNy+OLy
0108 IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
c95bde00d7 Jean*0109 OBEu(j,k,bi,bj)= U_F1(j,k,2)
0110 OBEv(j,k,bi,bj)= V_F1(j,k,2)
0111 OBEt(j,k,bi,bj)= T_F1(j,k,2)
0112 OBEs(j,k,bi,bj)= S_F1(j,k,2)
0113 #ifdef NONLIN_FRSURF
0114 OBEeta(j,bi,bj)= ETA_F1(j,1,2)
0115 #endif
0116 ENDIF
0117 ENDDO
0118 ENDDO
0119 #endif /* ALLOW_NEST_CHILD */
42c525bfb4 Alis*0120 ELSE
74019f026d Jean*0121 DO k=1,Nr
0122 DO j=1-OLy,sNy+OLy
0123 IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
0124 OBEu(j,k,bi,bj)=0.
0125 OBEv(j,k,bi,bj)=0.
0126 OBEt(j,k,bi,bj)=tRef(k)
0127 OBEs(j,k,bi,bj)=sRef(k)
42c525bfb4 Alis*0128 #ifdef ALLOW_NONHYDROSTATIC
74019f026d Jean*0129 OBEw(j,k,bi,bj)=0.
42c525bfb4 Alis*0130 #endif
7af3d6f22c Jean*0131 #ifdef NONLIN_FRSURF
74019f026d Jean*0132 OBEeta(j,bi,bj)=0.
7af3d6f22c Jean*0133 #endif
174cf6d3c0 Alis*0134 ENDIF
42c525bfb4 Alis*0135 ENDDO
0136 ENDDO
0137 ENDIF
f45edb9e81 Patr*0138 #endif /* ALLOW_OBCS_EAST */
96bbd4e2a5 Patr*0139
c95bde00d7 Jean*0140
96bbd4e2a5 Patr*0141
0142 #ifdef ALLOW_OBCS_WEST
42c525bfb4 Alis*0143
abb214f17f Alis*0144 #ifdef ALLOW_DEBUG
b56dc74750 Jean*0145 IF (debugMode) CALL DEBUG_MSG('OBCS_CALC: West',myThid)
abb214f17f Alis*0146 #endif
42c525bfb4 Alis*0147 IF (useOrlanskiWest) THEN
96bbd4e2a5 Patr*0148 #ifdef ALLOW_ORLANSKI
42c525bfb4 Alis*0149 CALL ORLANSKI_WEST(
d20216bb48 Jean*0150 & bi, bj, futureTime,
0151 & uVel, vVel, wVel, theta, salt,
42c525bfb4 Alis*0152 & myThid )
96bbd4e2a5 Patr*0153 #endif
c95bde00d7 Jean*0154 #ifdef ALLOW_NEST_CHILD
0155 ELSEIF ( useNEST_CHILD ) THEN
0156 DO k=1,Nr
74019f026d Jean*0157 DO j=1-OLy,sNy+OLy
0158 IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
c95bde00d7 Jean*0159 OBWu(j,k,bi,bj)= U_F1(j,k,1)
0160 OBWv(j,k,bi,bj)= V_F1(j,k,1)
0161 OBWt(j,k,bi,bj)= T_F1(j,k,1)
0162 OBWs(j,k,bi,bj)= S_F1(j,k,1)
0163 #ifdef NONLIN_FRSURF
0164 OBWeta(j,bi,bj)= ETA_F1(j,1,1)
0165 #endif
0166 ENDIF
0167 ENDDO
0168 ENDDO
0169 #endif /* ALLOW_NEST_CHILD */
42c525bfb4 Alis*0170 ELSE
74019f026d Jean*0171 DO k=1,Nr
0172 DO j=1-OLy,sNy+OLy
0173 IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
0174 OBWu(j,k,bi,bj)=0.
0175 OBWv(j,k,bi,bj)=0.
0176 OBWt(j,k,bi,bj)=tRef(k)
0177 OBWs(j,k,bi,bj)=sRef(k)
42c525bfb4 Alis*0178 #ifdef ALLOW_NONHYDROSTATIC
74019f026d Jean*0179 OBWw(j,k,bi,bj)=0.
d20216bb48 Jean*0180 #endif
7af3d6f22c Jean*0181 #ifdef NONLIN_FRSURF
74019f026d Jean*0182 OBWeta(j,bi,bj)=0.
7af3d6f22c Jean*0183 #endif
96bbd4e2a5 Patr*0184 ENDIF
0185 ENDDO
0186 ENDDO
0187 ENDIF
0188 #endif /* ALLOW_OBCS_WEST */
0189
c95bde00d7 Jean*0190
96bbd4e2a5 Patr*0191
0192 #ifdef ALLOW_OBCS_NORTH
174cf6d3c0 Alis*0193
abb214f17f Alis*0194 #ifdef ALLOW_DEBUG
b56dc74750 Jean*0195 IF (debugMode) CALL DEBUG_MSG('OBCS_CALC: North',myThid)
abb214f17f Alis*0196 #endif
42c525bfb4 Alis*0197 IF (useOrlanskiNorth) THEN
96bbd4e2a5 Patr*0198 #ifdef ALLOW_ORLANSKI
42c525bfb4 Alis*0199 CALL ORLANSKI_NORTH(
d20216bb48 Jean*0200 & bi, bj, futureTime,
0201 & uVel, vVel, wVel, theta, salt,
42c525bfb4 Alis*0202 & myThid )
96bbd4e2a5 Patr*0203 #endif
42c525bfb4 Alis*0204 ELSE
74019f026d Jean*0205 DO k=1,Nr
0206 DO i=1-OLx,sNx+OLx
0207 IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
0208 OBNv(i,k,bi,bj)=0.
0209 OBNu(i,k,bi,bj)=0.
0210 OBNt(i,k,bi,bj)=tRef(k)
0211 OBNs(i,k,bi,bj)=sRef(k)
42c525bfb4 Alis*0212 #ifdef ALLOW_NONHYDROSTATIC
74019f026d Jean*0213 OBNw(i,k,bi,bj)=0.
42c525bfb4 Alis*0214 #endif
7af3d6f22c Jean*0215 #ifdef NONLIN_FRSURF
74019f026d Jean*0216 OBNeta(i,bi,bj)=0.
7af3d6f22c Jean*0217 #endif
174cf6d3c0 Alis*0218 ENDIF
42c525bfb4 Alis*0219 ENDDO
0220 ENDDO
0221 ENDIF
f45edb9e81 Patr*0222 #endif /* ALLOW_OBCS_NORTH */
96bbd4e2a5 Patr*0223
c95bde00d7 Jean*0224
96bbd4e2a5 Patr*0225
0226 #ifdef ALLOW_OBCS_SOUTH
174cf6d3c0 Alis*0227
abb214f17f Alis*0228 #ifdef ALLOW_DEBUG
b56dc74750 Jean*0229 IF (debugMode) CALL DEBUG_MSG('OBCS_CALC: South',myThid)
abb214f17f Alis*0230 #endif
d20216bb48 Jean*0231 IF (useOrlanskiSouth) THEN
96bbd4e2a5 Patr*0232 #ifdef ALLOW_ORLANSKI
42c525bfb4 Alis*0233 CALL ORLANSKI_SOUTH(
d20216bb48 Jean*0234 & bi, bj, futureTime,
0235 & uVel, vVel, wVel, theta, salt,
42c525bfb4 Alis*0236 & myThid )
96bbd4e2a5 Patr*0237 #endif
42c525bfb4 Alis*0238 ELSE
74019f026d Jean*0239 DO k=1,Nr
0240 DO i=1-OLx,sNx+OLx
0241 IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
0242 OBSu(i,k,bi,bj)=0.
0243 OBSv(i,k,bi,bj)=0.
0244 OBSt(i,k,bi,bj)=tRef(k)
0245 OBSs(i,k,bi,bj)=sRef(k)
42c525bfb4 Alis*0246 #ifdef ALLOW_NONHYDROSTATIC
74019f026d Jean*0247 OBSw(i,k,bi,bj)=0.
42c525bfb4 Alis*0248 #endif
7af3d6f22c Jean*0249 #ifdef NONLIN_FRSURF
74019f026d Jean*0250 OBSeta(i,bi,bj)=0.
7af3d6f22c Jean*0251 #endif
174cf6d3c0 Alis*0252 ENDIF
42c525bfb4 Alis*0253 ENDDO
0254 ENDDO
0255 ENDIF
f45edb9e81 Patr*0256 #endif /* ALLOW_OBCS_SOUTH */
42c525bfb4 Alis*0257
c95bde00d7 Jean*0258
0259
ee1c912a22 Mart*0260 #ifdef ALLOW_PTRACERS
0261 IF ( usePTRACERS ) THEN
0262
0263
d20216bb48 Jean*0264
0265
0266
ee1c912a22 Mart*0267
d20216bb48 Jean*0268
ee1c912a22 Mart*0269
0270
0271
0272 # ifdef ALLOW_OBCS_EAST
0273
0274 # ifdef ALLOW_DEBUG
b56dc74750 Jean*0275 IF (debugMode)
ee1c912a22 Mart*0276 & CALL DEBUG_MSG('OBCS_CALC: East, pTracers',myThid)
0277 # endif
0278 IF (useOrlanskiEast) THEN
0279 WRITE(msgBuf,'(A)')
0280 & 'OBCS_CALC: ERROR: useOrlanskiEast Rad OBC with'
e39300f034 Jean*0281 CALL PRINT_ERROR( msgBuf, myThid )
ee1c912a22 Mart*0282 WRITE(msgBuf,'(A)')
0283 & 'OBCS_CALC: ERROR: pTracers not yet implemented'
e39300f034 Jean*0284 CALL PRINT_ERROR( msgBuf, myThid )
ee1c912a22 Mart*0285 STOP 'ABNORMAL END: S/R OBCS_CALC'
0286 ELSE
0287 DO iTracer=1,PTRACERS_numInUse
74019f026d Jean*0288 DO k=1,Nr
0289 DO j=1-OLy,sNy+OLy
0290 IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
0291 I_obc = OB_Ie(j,bi,bj)
0292 OBEptr(j,k,bi,bj,iTracer) =
0293 & pTracer(I_obc-1,j,k,bi,bj,iTracer)
0294 & *_maskW(I_obc,j,k,bi,bj)
ee1c912a22 Mart*0295 ENDIF
0296 ENDDO
0297 ENDDO
0298 ENDDO
0299 ENDIF
0300 # endif /* ALLOW_OBCS_EAST */
0301
0302
0303
0304 # ifdef ALLOW_OBCS_WEST
0305
0306 # ifdef ALLOW_DEBUG
b56dc74750 Jean*0307 IF (debugMode)
ee1c912a22 Mart*0308 & CALL DEBUG_MSG('OBCS_CALC: West, pTracers',myThid)
0309 # endif
0310 IF (useOrlanskiWest) THEN
0311 WRITE(msgBuf,'(A)')
0312 & 'OBCS_CALC: ERROR: useOrlanskiWest Rad OBC with'
e39300f034 Jean*0313 CALL PRINT_ERROR( msgBuf, myThid )
ee1c912a22 Mart*0314 WRITE(msgBuf,'(A)')
0315 & 'OBCS_CALC: ERROR: pTracers not yet implemented'
e39300f034 Jean*0316 CALL PRINT_ERROR( msgBuf, myThid )
ee1c912a22 Mart*0317 STOP 'ABNORMAL END: S/R OBCS_CALC'
0318 ELSE
0319 DO iTracer=1,PTRACERS_numInUse
74019f026d Jean*0320 DO k=1,Nr
0321 DO j=1-OLy,sNy+OLy
0322 IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
0323 I_obc = OB_Iw(j,bi,bj)
0324 OBWptr(j,k,bi,bj,iTracer) =
0325 & pTracer(I_obc+1,j,k,bi,bj,iTracer)
0326 & *_maskW(I_obc+1,j,k,bi,bj)
ee1c912a22 Mart*0327 ENDIF
0328 ENDDO
0329 ENDDO
0330 ENDDO
0331 ENDIF
0332 # endif /* ALLOW_OBCS_WEST */
0333
0334
0335
0336 # ifdef ALLOW_OBCS_NORTH
0337
0338 # ifdef ALLOW_DEBUG
b56dc74750 Jean*0339 IF (debugMode)
ee1c912a22 Mart*0340 & CALL DEBUG_MSG('OBCS_CALC: North, pTracers',myThid)
0341 # endif
0342 IF (useOrlanskiNorth) THEN
0343 WRITE(msgBuf,'(A)')
0344 & 'OBCS_CALC: ERROR: useOrlanskiNorth Rad OBC with'
e39300f034 Jean*0345 CALL PRINT_ERROR( msgBuf, myThid )
ee1c912a22 Mart*0346 WRITE(msgBuf,'(A)')
0347 & 'OBCS_CALC: ERROR: pTracers not yet implemented'
e39300f034 Jean*0348 CALL PRINT_ERROR( msgBuf, myThid )
ee1c912a22 Mart*0349 STOP 'ABNORMAL END: S/R OBCS_CALC'
0350 ELSE
0351 DO iTracer=1,PTRACERS_numInUse
74019f026d Jean*0352 DO k=1,Nr
0353 DO i=1-OLx,sNx+OLx
0354 IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
0355 J_obc = OB_Jn(i,bi,bj)
0356 OBNptr(i,k,bi,bj,iTracer) =
0357 & pTracer(i,J_obc-1,k,bi,bj,iTracer)
0358 & *_maskS(i,J_obc,k,bi,bj)
ee1c912a22 Mart*0359 ENDIF
0360 ENDDO
0361 ENDDO
0362 ENDDO
0363 ENDIF
0364 # endif /* ALLOW_OBCS_NORTH */
0365
0366
0367
0368 # ifdef ALLOW_OBCS_SOUTH
0369
0370 # ifdef ALLOW_DEBUG
b56dc74750 Jean*0371 IF (debugMode)
ee1c912a22 Mart*0372 & CALL DEBUG_MSG('OBCS_CALC: South, pTracers',myThid)
0373 #endif
d20216bb48 Jean*0374 IF (useOrlanskiSouth) THEN
ee1c912a22 Mart*0375 WRITE(msgBuf,'(A)')
0376 & 'OBCS_CALC: ERROR: useOrlanskiSouth Rad OBC with'
e39300f034 Jean*0377 CALL PRINT_ERROR( msgBuf, myThid )
ee1c912a22 Mart*0378 WRITE(msgBuf,'(A)')
0379 & 'OBCS_CALC: ERROR: pTracers not yet implemented'
e39300f034 Jean*0380 CALL PRINT_ERROR( msgBuf, myThid )
ee1c912a22 Mart*0381 STOP 'ABNORMAL END: S/R OBCS_CALC'
0382 ELSE
0383 DO iTracer=1,PTRACERS_numInUse
74019f026d Jean*0384 DO k=1,Nr
0385 DO i=1-OLx,sNx+OLx
0386 IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
0387 J_obc = OB_Js(i,bi,bj)
0388 OBSptr(i,k,bi,bj,iTracer) =
0389 & pTracer(i,J_obc+1,k,bi,bj,iTracer)
0390 & *_maskS(i,J_obc+1,k,bi,bj)
ee1c912a22 Mart*0391 ENDIF
0392 ENDDO
0393 ENDDO
0394 ENDDO
0395 ENDIF
0396 # endif /* ALLOW_OBCS_SOUTH */
0397
d20216bb48 Jean*0398 ENDIF
ee1c912a22 Mart*0399 #endif /* ALLOW_PTRACERS */
96bbd4e2a5 Patr*0400
3a86c9b47d Oliv*0401
b80b3b6765 Jean*0402 ENDDO
3a86c9b47d Oliv*0403 ENDDO
0404
c95bde00d7 Jean*0405
f45edb9e81 Patr*0406
d7c9b04d79 Patr*0407 #ifdef ALLOW_OBCS_PRESCRIBE
0408 IF (useOBCSprescribe) THEN
0409
abb214f17f Alis*0410 #ifdef ALLOW_DEBUG
b56dc74750 Jean*0411 IF (debugMode) CALL DEBUG_CALL('OBCS_PRESCRIBE_READ',myThid)
abb214f17f Alis*0412 #endif
e39300f034 Jean*0413 CALL OBCS_PRESCRIBE_READ( futureTime, futureIter, myThid )
d7c9b04d79 Patr*0414 ENDIF
f45edb9e81 Patr*0415 #endif /* ALLOW_OBCS_PRESCRIBE */
0416
0417
6b47d550f4 Mart*0418
0419
0420 #ifdef ALLOW_CTRL
0421 IF ( useCTRL ) THEN
0422 # ifdef ALLOW_OBCSN_CONTROL
005af54e38 Jean*0423 CALL CTRL_GETOBCSN ( futureTime, futureIter, myThid )
6b47d550f4 Mart*0424 # endif
0425 # ifdef ALLOW_OBCSS_CONTROL
005af54e38 Jean*0426 CALL CTRL_GETOBCSS ( futureTime, futureIter, myThid )
6b47d550f4 Mart*0427 # endif
0428 # ifdef ALLOW_OBCSW_CONTROL
0429 CALL CTRL_GETOBCSW ( futureTime, futureIter, myThid )
0430 # endif
0431 # ifdef ALLOW_OBCSE_CONTROL
0432 CALL CTRL_GETOBCSE ( futureTime, futureIter, myThid )
0433 # endif
0434 ENDIF
0435 #endif /* ALLOW_CTRL */
0436
0437
c95bde00d7 Jean*0438
b2cb1ccb9a Mart*0439 #ifdef ALLOW_OBCS_STEVENS
0440
0441
0442
0443 IF (useStevensNorth.OR.useStevensSouth.OR.
0444 & useStevensEast.OR.useStevensWest) THEN
0445 #ifdef ALLOW_DEBUG
b56dc74750 Jean*0446 IF (debugMode) CALL DEBUG_CALL('OBCS_CALC_STEVENS',myThid)
b2cb1ccb9a Mart*0447 #endif
0448 CALL OBCS_CALC_STEVENS( futureTime, futureIter, myThid )
0449 ENDIF
0450 #endif /* ALLOW_OBCS_STEVENS */
c95bde00d7 Jean*0451
abb214f17f Alis*0452 #ifdef ALLOW_DEBUG
b56dc74750 Jean*0453 IF (debugMode) CALL DEBUG_LEAVE('OBCS_CALC',myThid)
abb214f17f Alis*0454 #endif
c95bde00d7 Jean*0455 #endif /* ALLOW_OBCS */
0456
42c525bfb4 Alis*0457 RETURN
0458 END