model/src/ini_linear_phisurf.F

C $Header: /u/gcmpack/MITgcm/model/src/ini_linear_phisurf.F,v 1.23 2013/11/22 01:07:11 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: INI_LINEAR_PHISURF
C     !INTERFACE:
      SUBROUTINE INI_LINEAR_PHISURF( myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE INI_LINEAR_PHISURF
C     | o Initialise the Linear Relation Phi_surf(eta)
C     *==========================================================*
C     | Initialise -Buoyancy at surface level (Bo_surf)
C     |  to setup the Linear relation: Phi_surf(eta)=Bo_surf*eta
C     | Initialise phi0surf = starting point for integrating
C     |                       phiHyd (= phiHyd at r=RoSurf)
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "SURFACE.h"

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     myThid :: my Thread Id number
      INTEGER myThid

C     == Local variables in common ==
C     topoHloc had to be in common for multi threading but no longer
C     needed since MDSIO now allows (2009/06/07) to write local arrays

C     !LOCAL VARIABLES:
C     === Local variables ===
C     topoHloc  :: Temporary array used to write surface topography
C     bi,bj  :: tile indices
C     i,j,k  :: Loop counters
      _RS topoHloc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      INTEGER bi, bj
      INTEGER i, j, k
      _RL     pLoc, rhoLoc
      _RL     dPIdp
CEOP

C--   Initialisation
#ifdef ALLOW_AUTODIFF
      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
        DO j=1-OLy,sNy+OLy
         DO i=1-OLx,sNx+OLx
           Bo_surf(i,j,bi,bj)  = 0. _d 0
           recip_Bo(i,j,bi,bj) = 0. _d 0
         ENDDO
        ENDDO
       ENDDO
      ENDDO
#endif /* ALLOW_AUTODIFF */

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C-- Initialise -Buoyancy at surface level : Bo_surf
C   Bo_surf is defined as d/dr(Phi_surf) and set to g/z2rUnit with
C     z2rUnit = conversion factor from z-unit to r-unit: [z] * z2rUnit = [r]
C   an accurate formulation includes P_surf and T,S_ref effects on rho_surf:
C    (setting uniformLin_PhiSurf=.FALSE.):
C    z-coord (z2rUnit=1): Bo_surf = - Buoyancy
C                                 = g * rho_surf(Tref,Sref,pSurf_0)/rho_0
C    p-coord (z2rUnit=rho*g): Bo_surf = 1/rho(Tref(ksurf),pSurf_0)
C   Note: on Phi_surf splitting : Non-linear Time-dependent effects on B_surf
C   [through eta & (T-tRef)_surf] are included in PhiHyd rather than in Bo_surf
C--
      IF ( usingZCoords ) THEN
C-  gBaro = gravity (except for External mode test with reduced gravity)
        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          DO j=1-OLy,sNy+OLy
           DO i=1-OLx,sNx+OLx
             Bo_surf(i,j,bi,bj) = gBaro
             recip_Bo(i,j,bi,bj) = 1. _d 0 / gBaro
           ENDDO
          ENDDO
         ENDDO
        ENDDO
      ELSEIF ( uniformLin_PhiSurf ) THEN
C-  use a linear (in ps) uniform relation : Phi'_surf = 1/rhoConst * ps'_surf
        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          DO j=1-OLy,sNy+OLy
           DO i=1-OLx,sNx+OLx
c            Bo_surf(i,j,bi,bj)  = rVel2wUnit(1)*gravity
c            recip_Bo(i,j,bi,bj) = wUnit2rVel(1)*recip_gravity
             Bo_surf(i,j,bi,bj)  = recip_rhoConst
             recip_Bo(i,j,bi,bj) = rhoConst
           ENDDO
          ENDDO
         ENDDO
        ENDDO
      ELSEIF ( fluidIsWater ) THEN
C--   More precise than uniformLin_PhiSurf case but inconsistent
C     with nonlinFreeSurf=4 in CALC_PHI_HYD (eta contribution to phiHyd)
        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          DO j=1-OLy,sNy+OLy
           DO i=1-OLx,sNx+OLx
            IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
     &          .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
             pLoc = Ro_surf(i,j,bi,bj)
#ifdef ALLOW_OPENAD
             CALL FIND_RHO_SCALAR(
     I            tRef(kSurfC(i,j,bi,bj)),
     I            sRef(kSurfC(i,j,bi,bj)),
     I            pLoc,
     O            rhoLoc, myThid )
#else /* ALLOW_OPENAD */
             k = kSurfC(i,j,bi,bj)
             CALL FIND_RHO_SCALAR(
     I            tRef(k), sRef(k), pLoc,
     O            rhoLoc, myThid )
#endif /* ALLOW_OPENAD */
             IF ( rhoLoc .EQ. 0. _d 0 ) THEN
              Bo_surf(i,j,bi,bj) = 0. _d 0
             ELSE
              Bo_surf(i,j,bi,bj) = 1. _d 0/rhoLoc
             ENDIF
             recip_Bo(i,j,bi,bj) =  rhoLoc
            ELSE
              Bo_surf(i,j,bi,bj)  = 0. _d 0
              recip_Bo(i,j,bi,bj) = 0. _d 0
            ENDIF
           ENDDO
          ENDDO
         ENDDO
        ENDDO
      ELSEIF ( fluidIsAir ) THEN
C-  use a linearized (in ps) Non-uniform relation : Bo_surf(Po_surf,tRef_surf)
C    Bo = d/d_p(Phi_surf) = tRef_surf*d/d_p(PI) ; PI = Cp*(p/Po)^kappa
C   and atm_Cp*atm_kappa = atm_Rd
        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          IF ( select_rStar.GE.1 .OR. selectSigmaCoord.GE.1 ) THEN
C-      isothermal (theta=const) reference state
           DO j=1-OLy,sNy+OLy
            DO i=1-OLx,sNx+OLx
             IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
     &          .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
              dPIdp = (atm_Rd/atm_Po)*
     &         (Ro_surf(i,j,bi,bj)/atm_Po)**(atm_kappa-1. _d 0)
              Bo_surf(i,j,bi,bj) = dPIdp*thetaConst
              recip_Bo(i,j,bi,bj) = 1. _d 0 / Bo_surf(i,j,bi,bj)
             ELSE
              Bo_surf(i,j,bi,bj) = 0.
              recip_Bo(i,j,bi,bj) = 0.
             ENDIF
            ENDDO
           ENDDO
          ELSE
C-      horizontally uniform (tRef) reference state
           DO j=1-OLy,sNy+OLy
            DO i=1-OLx,sNx+OLx
             IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
     &          .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
              dPIdp = (atm_Rd/atm_Po)*
     &         (Ro_surf(i,j,bi,bj)/atm_Po)**(atm_kappa-1. _d 0)
              Bo_surf(i,j,bi,bj) = dPIdp*tRef(kSurfC(i,j,bi,bj))
              recip_Bo(i,j,bi,bj) = 1. _d 0 / Bo_surf(i,j,bi,bj)
             ELSE
              Bo_surf(i,j,bi,bj) = 0.
              recip_Bo(i,j,bi,bj) = 0.
             ENDIF
            ENDDO
           ENDDO
          ENDIF
         ENDDO
        ENDDO
      ELSE
        STOP 'INI_LINEAR_PHISURF: We should never reach this point!'
      ENDIF

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C--   Update overlap regions (jmc: is it really needed ?)
c     _EXCH_XY_RL(Bo_surf, myThid)
c     _EXCH_XY_RL(recip_Bo, myThid)

      IF ( usingPCoords .AND. .NOT.uniformLin_PhiSurf ) THEN
        CALL WRITE_FLD_XY_RL( 'Bo_surf',' ',Bo_surf,0,myThid)
      ENDIF

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C--   Initialise phi0surf: used for atmos. surf. P-loading (ocean, z-coord)
C                               or topographic geopotential anom. (p-coord)

        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          DO j=1-OLy,sNy+OLy
           DO i=1-OLx,sNx+OLx
             phi0surf(i,j,bi,bj) = 0.
           ENDDO
          ENDDO
         ENDDO
        ENDDO

      IF ( fluidIsAir .AND. topoFile.NE.' ' ) THEN

#ifdef ALLOW_AUTODIFF
         STOP 'CANNOT PRESENTLY USE THIS OPTION WITH ADJOINT'
#else

C--   Compute topoH = PhiRef(Po_surf)/g ; is different from original
C      topoZ(read from file) because of truncation of Po_surf.
C     NOTE: not clear for now which topoZ needs to be saved in common block
C--   AND set phi0surf = starting point for integrating Geopotential;

        CALL INI_P_GROUND( -2,
     O                     topoHloc,
     I                     Ro_surf, myThid )

       IF (selectFindRoSurf.NE.0) THEN
        _EXCH_XY_RS(phi0surf, myThid)
        CALL WRITE_FLD_XY_RS( 'phi0surf',' ',phi0surf,0,myThid)
       ENDIF

        CALL WRITE_FLD_XY_RS( 'topo_H',' ',topoHloc,0,myThid)

#endif /* ALLOW_AUTODIFF */

      ENDIF

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
      RETURN
      END
1	jmc	1.24	C $Header: /u/gcmpack/MITgcm/model/src/ini_linear_phisurf.F,v 1.23 2013/11/22 01:07:11 jmc Exp $
2	jmc	1.1	C $Name: $
3
4	jmc	1.22	#include "PACKAGES_CONFIG.h"
5	jmc	1.1	#include "CPP_OPTIONS.h"
6
7	cnh	1.3	CBOP
8			C !ROUTINE: INI_LINEAR_PHISURF
9			C !INTERFACE:
10	jmc	1.1	SUBROUTINE INI_LINEAR_PHISURF( myThid )
11	cnh	1.3
12			C !DESCRIPTION: \bv
13			C ==========================================================
14	jmc	1.13	C \| SUBROUTINE INI_LINEAR_PHISURF
15			C \| o Initialise the Linear Relation Phi_surf(eta)
16	cnh	1.3	C ==========================================================
17	jmc	1.18	C \| Initialise -Buoyancy at surface level (Bo_surf)
18	jmc	1.13	C \| to setup the Linear relation: Phi_surf(eta)=Bo_surf*eta
19			C \| Initialise phi0surf = starting point for integrating
20	jmc	1.7	C \| phiHyd (= phiHyd at r=RoSurf)
21	cnh	1.3	C ==========================================================
22			C \ev
23
24			C !USES:
25	jmc	1.1	IMPLICIT NONE
26			C === Global variables ===
27			#include "SIZE.h"
28			#include "EEPARAMS.h"
29			#include "PARAMS.h"
30			#include "GRID.h"
31			#include "SURFACE.h"
32
33	cnh	1.3	C !INPUT/OUTPUT PARAMETERS:
34	jmc	1.1	C === Routine arguments ===
35	jmc	1.21	C myThid :: my Thread Id number
36	jmc	1.1	INTEGER myThid
37
38	jmc	1.9	C == Local variables in common ==
39	jmc	1.17	C topoHloc had to be in common for multi threading but no longer
40			C needed since MDSIO now allows (2009/06/07) to write local arrays
41	jmc	1.9
42	cnh	1.3	C !LOCAL VARIABLES:
43	jmc	1.1	C === Local variables ===
44	jmc	1.17	C topoHloc :: Temporary array used to write surface topography
45	jmc	1.16	C bi,bj :: tile indices
46	jmc	1.19	C i,j,k :: Loop counters
47	jmc	1.16	_RS topoHloc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
48	jmc	1.1	INTEGER bi, bj
49	jmc	1.19	INTEGER i, j, k
50	jmc	1.11	_RL pLoc, rhoLoc
51	jmc	1.1	_RL dPIdp
52	cnh	1.3	CEOP
53	heimbach	1.6
54	jmc	1.19	C-- Initialisation
55	jmc	1.22	#ifdef ALLOW_AUTODIFF
56	heimbach	1.6	DO bj=myByLo(myThid),myByHi(myThid)
57			DO bi=myBxLo(myThid),myBxHi(myThid)
58	jmc	1.20	DO j=1-OLy,sNy+OLy
59			DO i=1-OLx,sNx+OLx
60	jmc	1.19	Bo_surf(i,j,bi,bj) = 0. _d 0
61			recip_Bo(i,j,bi,bj) = 0. _d 0
62	heimbach	1.6	ENDDO
63			ENDDO
64	jmc	1.20	ENDDO
65			ENDDO
66	jmc	1.22	#endif /* ALLOW_AUTODIFF */
67	jmc	1.17
68			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
69
70	jmc	1.18	C-- Initialise -Buoyancy at surface level : Bo_surf
71	jmc	1.13	C Bo_surf is defined as d/dr(Phi_surf) and set to g/z2rUnit with
72			C z2rUnit = conversion factor from z-unit to r-unit: [z] * z2rUnit = [r]
73			C an accurate formulation includes P_surf and T,S_ref effects on rho_surf:
74	jmc	1.1	C (setting uniformLin_PhiSurf=.FALSE.):
75	jmc	1.18	C z-coord (z2rUnit=1): Bo_surf = - Buoyancy
76	jmc	1.13	C = g * rho_surf(Tref,Sref,pSurf_0)/rho_0
77			C p-coord (z2rUnit=rho*g): Bo_surf = 1/rho(Tref(ksurf),pSurf_0)
78			C Note: on Phi_surf splitting : Non-linear Time-dependent effects on B_surf
79			C [through eta & (T-tRef)_surf] are included in PhiHyd rather than in Bo_surf
80	jmc	1.1	C--
81	jmc	1.21	IF ( usingZCoords ) THEN
82	jmc	1.1	C- gBaro = gravity (except for External mode test with reduced gravity)
83			DO bj=myByLo(myThid),myByHi(myThid)
84			DO bi=myBxLo(myThid),myBxHi(myThid)
85	jmc	1.24	DO j=1-OLy,sNy+OLy
86			DO i=1-OLx,sNx+OLx
87			Bo_surf(i,j,bi,bj) = gBaro
88			recip_Bo(i,j,bi,bj) = 1. _d 0 / gBaro
89	jmc	1.1	ENDDO
90			ENDDO
91			ENDDO
92			ENDDO
93			ELSEIF ( uniformLin_PhiSurf ) THEN
94			C- use a linear (in ps) uniform relation : Phi'_surf = 1/rhoConst * ps'_surf
95			DO bj=myByLo(myThid),myByHi(myThid)
96			DO bi=myBxLo(myThid),myBxHi(myThid)
97	jmc	1.24	DO j=1-OLy,sNy+OLy
98			DO i=1-OLx,sNx+OLx
99			c Bo_surf(i,j,bi,bj) = rVel2wUnit(1)*gravity
100			c recip_Bo(i,j,bi,bj) = wUnit2rVel(1)*recip_gravity
101			Bo_surf(i,j,bi,bj) = recip_rhoConst
102			recip_Bo(i,j,bi,bj) = rhoConst
103	jmc	1.1	ENDDO
104			ENDDO
105			ENDDO
106			ENDDO
107	jmc	1.21	ELSEIF ( fluidIsWater ) THEN
108	jmc	1.24	C-- More precise than uniformLin_PhiSurf case but inconsistent
109			C with nonlinFreeSurf=4 in CALC_PHI_HYD (eta contribution to phiHyd)
110	mlosch	1.4	DO bj=myByLo(myThid),myByHi(myThid)
111			DO bi=myBxLo(myThid),myBxHi(myThid)
112	jmc	1.24	DO j=1-OLy,sNy+OLy
113			DO i=1-OLx,sNx+OLx
114			IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
115			& .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
116			pLoc = Ro_surf(i,j,bi,bj)
117	jmc	1.23	#ifdef ALLOW_OPENAD
118			CALL FIND_RHO_SCALAR(
119	jmc	1.24	I tRef(kSurfC(i,j,bi,bj)),
120			I sRef(kSurfC(i,j,bi,bj)),
121	jmc	1.23	I pLoc,
122			O rhoLoc, myThid )
123			#else /* ALLOW_OPENAD */
124	jmc	1.24	k = kSurfC(i,j,bi,bj)
125	jmc	1.13	CALL FIND_RHO_SCALAR(
126	jmc	1.11	I tRef(k), sRef(k), pLoc,
127			O rhoLoc, myThid )
128	jmc	1.23	#endif /* ALLOW_OPENAD */
129	jmc	1.13	IF ( rhoLoc .EQ. 0. _d 0 ) THEN
130	jmc	1.24	Bo_surf(i,j,bi,bj) = 0. _d 0
131	jmc	1.13	ELSE
132	jmc	1.24	Bo_surf(i,j,bi,bj) = 1. _d 0/rhoLoc
133	jmc	1.13	ENDIF
134	jmc	1.24	recip_Bo(i,j,bi,bj) = rhoLoc
135	mlosch	1.4	ELSE
136	jmc	1.24	Bo_surf(i,j,bi,bj) = 0. _d 0
137			recip_Bo(i,j,bi,bj) = 0. _d 0
138	mlosch	1.4	ENDIF
139			ENDDO
140			ENDDO
141			ENDDO
142			ENDDO
143	jmc	1.21	ELSEIF ( fluidIsAir ) THEN
144	jmc	1.1	C- use a linearized (in ps) Non-uniform relation : Bo_surf(Po_surf,tRef_surf)
145	jmc	1.24	C Bo = d/d_p(Phi_surf) = tRef_surfd/d_p(PI) ; PI = Cp(p/Po)^kappa
146			C and atm_Cp*atm_kappa = atm_Rd
147	jmc	1.1	DO bj=myByLo(myThid),myByHi(myThid)
148			DO bi=myBxLo(myThid),myBxHi(myThid)
149	jmc	1.24	IF ( select_rStar.GE.1 .OR. selectSigmaCoord.GE.1 ) THEN
150			C- isothermal (theta=const) reference state
151			DO j=1-OLy,sNy+OLy
152			DO i=1-OLx,sNx+OLx
153			IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
154			& .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
155			dPIdp = (atm_Rd/atm_Po)*
156			& (Ro_surf(i,j,bi,bj)/atm_Po)**(atm_kappa-1. _d 0)
157			Bo_surf(i,j,bi,bj) = dPIdp*thetaConst
158			recip_Bo(i,j,bi,bj) = 1. _d 0 / Bo_surf(i,j,bi,bj)
159			ELSE
160			Bo_surf(i,j,bi,bj) = 0.
161			recip_Bo(i,j,bi,bj) = 0.
162			ENDIF
163			ENDDO
164			ENDDO
165			ELSE
166			C- horizontally uniform (tRef) reference state
167			DO j=1-OLy,sNy+OLy
168			DO i=1-OLx,sNx+OLx
169			IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
170			& .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
171			dPIdp = (atm_Rd/atm_Po)*
172			& (Ro_surf(i,j,bi,bj)/atm_Po)**(atm_kappa-1. _d 0)
173			Bo_surf(i,j,bi,bj) = dPIdp*tRef(kSurfC(i,j,bi,bj))
174			recip_Bo(i,j,bi,bj) = 1. _d 0 / Bo_surf(i,j,bi,bj)
175			ELSE
176			Bo_surf(i,j,bi,bj) = 0.
177			recip_Bo(i,j,bi,bj) = 0.
178			ENDIF
179			ENDDO
180	jmc	1.1	ENDDO
181	jmc	1.24	ENDIF
182	jmc	1.1	ENDDO
183			ENDDO
184	mlosch	1.4	ELSE
185			STOP 'INI_LINEAR_PHISURF: We should never reach this point!'
186	jmc	1.1	ENDIF
187
188			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
189
190	jmc	1.13	C-- Update overlap regions (jmc: is it really needed ?)
191	jmc	1.24	c _EXCH_XY_RL(Bo_surf, myThid)
192			c _EXCH_XY_RL(recip_Bo, myThid)
193	jmc	1.1
194	jmc	1.21	IF ( usingPCoords .AND. .NOT.uniformLin_PhiSurf ) THEN
195	jmc	1.13	CALL WRITE_FLD_XY_RL( 'Bo_surf',' ',Bo_surf,0,myThid)
196	jmc	1.1	ENDIF
197
198	jmc	1.7	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
199
200	jmc	1.13	C-- Initialise phi0surf: used for atmos. surf. P-loading (ocean, z-coord)
201	jmc	1.7	C or topographic geopotential anom. (p-coord)
202
203			DO bj=myByLo(myThid),myByHi(myThid)
204			DO bi=myBxLo(myThid),myBxHi(myThid)
205	jmc	1.24	DO j=1-OLy,sNy+OLy
206			DO i=1-OLx,sNx+OLx
207			phi0surf(i,j,bi,bj) = 0.
208	jmc	1.7	ENDDO
209			ENDDO
210			ENDDO
211			ENDDO
212
213	jmc	1.21	IF ( fluidIsAir .AND. topoFile.NE.' ' ) THEN
214	jmc	1.7
215	jmc	1.22	#ifdef ALLOW_AUTODIFF
216	heimbach	1.8	STOP 'CANNOT PRESENTLY USE THIS OPTION WITH ADJOINT'
217			#else
218
219	jmc	1.13	C-- Compute topoH = PhiRef(Po_surf)/g ; is different from original
220	jmc	1.9	C topoZ(read from file) because of truncation of Po_surf.
221			C NOTE: not clear for now which topoZ needs to be saved in common block
222			C-- AND set phi0surf = starting point for integrating Geopotential;
223
224	jmc	1.13	CALL INI_P_GROUND( -2,
225			O topoHloc,
226	jmc	1.7	I Ro_surf, myThid )
227
228	jmc	1.9	IF (selectFindRoSurf.NE.0) THEN
229	jmc	1.7	_EXCH_XY_RS(phi0surf, myThid)
230	jmc	1.13	CALL WRITE_FLD_XY_RS( 'phi0surf',' ',phi0surf,0,myThid)
231	jmc	1.9	ENDIF
232	heimbach	1.8
233	jmc	1.12	CALL WRITE_FLD_XY_RS( 'topo_H',' ',topoHloc,0,myThid)
234
235	jmc	1.22	#endif /* ALLOW_AUTODIFF */
236	jmc	1.7
237			ENDIF
238
239			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
240	jmc	1.1	RETURN
241			END