Back to home page

MITgcm

 
 

    


File indexing completed on 2023-09-03 05:10:24 UTC

view on githubraw file Latest commit 74487008 on 2023-09-03 01:50:18 UTC
d7ce0d34f8 Jean*0001 #include "GAD_OPTIONS.h"
7448700841 Mart*0002 #ifdef ALLOW_PTRACERS
                0003 # include "PTRACERS_OPTIONS.h"
                0004 #endif
1574069d50 Mart*0005 #ifdef ALLOW_AUTODIFF
                0006 # include "AUTODIFF_OPTIONS.h"
                0007 #endif
d7ce0d34f8 Jean*0008 
                0009 CBOP
                0010 C !ROUTINE: GAD_SOM_ADV_X
                0011 
                0012 C !INTERFACE: ==========================================================
                0013       SUBROUTINE GAD_SOM_ADV_X(
                0014      I           bi,bj,k, limiter,
b79a2b44f2 Jean*0015      I           overlapOnly, interiorOnly,
                0016      I           N_edge, S_edge, E_edge, W_edge,
72de869c1b Jean*0017      I           deltaTloc, uTrans, maskIn,
d7ce0d34f8 Jean*0018      U           sm_v, sm_o, sm_x, sm_y, sm_z,
                0019      U           sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,
                0020      O           uT,
                0021      I           myThid )
                0022 
                0023 C !DESCRIPTION:
                0024 C  Calculates the area integrated zonal flux due to advection
                0025 C  of a tracer using
                0026 C--
                0027 C        Second-Order Moments Advection of tracer in X-direction
                0028 C        ref: M.J.Prather, 1986, JGR, 91, D6, pp 6671-6681.
                0029 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0030 C      The 3-D grid has dimension  (Nx,Ny,Nz) with corresponding
                0031 C      velocity field (U,V,W).  Parallel subroutine calculate
                0032 C      advection in the Y- and Z- directions.
                0033 C      The moment [Si] are as defined in the text, Sm refers to
                0034 C      the total mass in each grid box
                0035 C      the moments [Fi] are similarly defined and used as temporary
                0036 C      storage for portions of the grid boxes in transit.
                0037 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0038 
                0039 C !USES: ===============================================================
                0040       IMPLICIT NONE
                0041 #include "SIZE.h"
00fdbdcbd5 Jean*0042 #include "EEPARAMS.h"
d7ce0d34f8 Jean*0043 #include "GAD.h"
1574069d50 Mart*0044 #ifdef ALLOW_AUTODIFF_TAMC
                0045 # include "tamc.h"
                0046 #endif
d7ce0d34f8 Jean*0047 
                0048 C !INPUT PARAMETERS: ===================================================
b79a2b44f2 Jean*0049 C  bi,bj         :: tile indices
                0050 C  k             :: vertical level
                0051 C  limiter       :: 0: no limiter ; 1: Prather, 1986 limiter
                0052 C  overlapOnly   :: only update the edges of myTile, but not the interior
                0053 C  interiorOnly  :: only update the interior of myTile, but not the edges
                0054 C [N,S,E,W]_edge :: true if N,S,E,W edge of myTile is an Edge of the cube
                0055 C  uTrans        :: zonal volume transport
72de869c1b Jean*0056 C  maskIn        :: 2-D array Interior mask
b79a2b44f2 Jean*0057 C  myThid        :: my Thread Id. number
d7ce0d34f8 Jean*0058       INTEGER bi,bj,k
                0059       INTEGER limiter
b79a2b44f2 Jean*0060       LOGICAL overlapOnly, interiorOnly
                0061       LOGICAL N_edge, S_edge, E_edge, W_edge
d7ce0d34f8 Jean*0062       _RL deltaTloc
                0063       _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
72de869c1b Jean*0064       _RS maskIn(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
d7ce0d34f8 Jean*0065       INTEGER myThid
                0066 
                0067 C !OUTPUT PARAMETERS: ==================================================
                0068 C  sm_v         :: volume of grid cell
                0069 C  sm_o         :: tracer content of grid cell (zero order moment)
                0070 C  sm_x,y,z     :: 1rst order moment of tracer distribution, in x,y,z direction
                0071 C  sm_xx,yy,zz  ::  2nd order moment of tracer distribution, in x,y,z direction
                0072 C  sm_xy,xz,yz  ::  2nd order moment of tracer distr., in cross direction xy,xz,yz
                0073 C  uT           :: zonal advective flux
                0074       _RL sm_v  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0075       _RL sm_o  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0076       _RL sm_x  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0077       _RL sm_y  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0078       _RL sm_z  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0079       _RL sm_xx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0080       _RL sm_yy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0081       _RL sm_zz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0082       _RL sm_xy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0083       _RL sm_xz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0084       _RL sm_yz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0085       _RL uT    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0086 
7448700841 Mart*0087 #if ( defined GAD_ALLOW_TS_SOM_ADV || defined PTRACERS_ALLOW_DYN_STATE )
d7ce0d34f8 Jean*0088 C !LOCAL VARIABLES: ====================================================
b79a2b44f2 Jean*0089 C  i,j           :: loop indices
                0090 C  uLoc          :: volume transported (per time step)
                0091 C [iMin,iMax]Upd :: loop range to update tracer field
                0092 C [jMin,jMax]Upd :: loop range to update tracer field
                0093 C  nbStrips      :: number of strips (if region to update is splitted)
00fdbdcbd5 Jean*0094       _RL three
d7ce0d34f8 Jean*0095       PARAMETER( three = 3. _d 0 )
                0096       INTEGER i,j
b79a2b44f2 Jean*0097       INTEGER ns, nbStrips
                0098       INTEGER iMinUpd(2), iMaxUpd(2), jMinUpd(2), jMaxUpd(2)
9822905e7f Jean*0099       _RL  recip_dT
d7ce0d34f8 Jean*0100       _RL  slpmax, s1max, s1new, s2new
                0101       _RL  uLoc, alf1, alf1q, alpmn
                0102       _RL  alfp, alpq, alp1, locTp
                0103       _RL  alfn, alnq, aln1, locTn
                0104       _RL  alp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0105       _RL  aln  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0106       _RL  fp_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0107       _RL  fn_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0108       _RL  fp_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0109       _RL  fn_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0110       _RL  fp_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0111       _RL  fn_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0112       _RL  fp_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0113       _RL  fn_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0114       _RL  fp_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0115       _RL  fn_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0116       _RL  fp_xx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0117       _RL  fn_xx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0118       _RL  fp_yy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0119       _RL  fn_yy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0120       _RL  fp_zz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0121       _RL  fn_zz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0122       _RL  fp_xy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0123       _RL  fn_xy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0124       _RL  fp_xz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0125       _RL  fn_xz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0126       _RL  fp_yz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0127       _RL  fn_yz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0128 CEOP
                0129 
1574069d50 Mart*0130 #ifdef ALLOW_AUTODIFF_TAMC
                0131 CADJ INIT somtape_x = COMMON, 2
                0132 #endif
9822905e7f Jean*0133       recip_dT = 0.
00fdbdcbd5 Jean*0134       IF ( deltaTloc.GT.zeroRL ) recip_dT = 1.0 _d 0 / deltaTloc
9822905e7f Jean*0135 
b79a2b44f2 Jean*0136 C-    Set loop ranges for updating tracer field (splitted in 2 strips)
                0137       nbStrips   = 1
72de869c1b Jean*0138       iMinUpd(1) = 1-OLx+1
                0139       iMaxUpd(1) = sNx+OLx-1
                0140       jMinUpd(1) = 1-OLy
                0141       jMaxUpd(1) = sNy+OLy
b79a2b44f2 Jean*0142       IF ( overlapOnly ) THEN
                0143 C     update in overlap-Only
                0144         IF ( W_edge ) iMinUpd(1) = 1
                0145         IF ( E_edge ) iMaxUpd(1) = sNx
                0146         IF ( S_edge ) THEN
72de869c1b Jean*0147           jMinUpd(1) = 1-OLy
b79a2b44f2 Jean*0148           jMaxUpd(1) = 0
                0149         ENDIF
                0150         IF ( N_edge ) THEN
                0151           IF ( S_edge ) nbStrips = 2
                0152           jMinUpd(nbStrips) = sNy+1
72de869c1b Jean*0153           jMaxUpd(nbStrips) = sNy+OLy
b79a2b44f2 Jean*0154         ENDIF
                0155       ELSE
                0156 C     do not only update the overlap
                0157         IF ( interiorOnly .AND. S_edge ) jMinUpd(1) = 1
                0158         IF ( interiorOnly .AND. N_edge ) jMaxUpd(1) = sNy
                0159       ENDIF
                0160 
                0161 C--   start 1rst loop on strip number "ns"
                0162       DO ns=1,nbStrips
                0163 
d7ce0d34f8 Jean*0164       IF ( limiter.EQ.1 ) THEN
1574069d50 Mart*0165 #ifdef ALLOW_AUTODIFF_TAMC
7448700841 Mart*0166 CADJ STORE sm_o,sm_x,sm_xx,sm_xy,sm_xz
1574069d50 Mart*0167 CADJ &     = somtape_x, key = ns, kind = isbyte
                0168 #endif
b79a2b44f2 Jean*0169        DO j=jMinUpd(ns),jMaxUpd(ns)
                0170         DO i=iMinUpd(1)-1,iMaxUpd(1)+1
d7ce0d34f8 Jean*0171 C     If flux-limiting transport is to be applied, place limits on
                0172 C     appropriate moments before transport.
                0173          slpmax = 0.
00fdbdcbd5 Jean*0174          IF ( sm_o(i,j).GT.zeroRL ) slpmax = sm_o(i,j)
d7ce0d34f8 Jean*0175          s1max = slpmax*1.5 _d 0
                0176          s1new = MIN(  s1max, MAX(-s1max,sm_x(i,j)) )
                0177          s2new = MIN( (slpmax+slpmax-ABS(s1new)/three),
                0178      &                MAX(ABS(s1new)-slpmax,sm_xx(i,j))  )
                0179          sm_xy(i,j) = MIN( slpmax, MAX(-slpmax,sm_xy(i,j)) )
                0180          sm_xz(i,j) = MIN( slpmax, MAX(-slpmax,sm_xz(i,j)) )
a5a86b736b Jean*0181          sm_x (i,j) = s1new
                0182          sm_xx(i,j) = s2new
d7ce0d34f8 Jean*0183         ENDDO
                0184        ENDDO
                0185       ENDIF
                0186 
1574069d50 Mart*0187 #ifdef ALLOW_AUTODIFF_TAMC
                0188 CADJ STORE sm_o,sm_v,sm_x,sm_xx,sm_xy,sm_xz,sm_y,sm_yy,sm_yz,sm_z,sm_zz
                0189 CADJ &     = somtape_x, key = ns, kind = isbyte
                0190 #endif
d7ce0d34f8 Jean*0191 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0192 C---  part.1 : calculate flux for all moments
b79a2b44f2 Jean*0193       DO j=jMinUpd(ns),jMaxUpd(ns)
                0194        DO i=iMinUpd(1),iMaxUpd(1)+1
d7ce0d34f8 Jean*0195         uLoc = uTrans(i,j)*deltaTloc
                0196 C--    Flux from (i-1) to (i) when U>0 (i.e., take right side of box i-1)
00fdbdcbd5 Jean*0197         fp_v (i,j) = MAX( zeroRL,  uLoc )
d7ce0d34f8 Jean*0198         alp  (i,j) = fp_v(i,j)/sm_v(i-1,j)
                0199         alpq       = alp(i,j)*alp(i,j)
                0200         alp1       = 1. _d 0 - alp(i,j)
                0201 C-     Create temporary moments/masses for partial boxes in transit
                0202 C       use same indexing as velocity, "p" for positive U
                0203         fp_o (i,j) = alp(i,j)*( sm_o(i-1,j) + alp1*sm_x(i-1,j)
                0204      &                        + alp1*(alp1-alp(i,j))*sm_xx(i-1,j)
                0205      &                        )
                0206         fp_x (i,j) = alpq    *( sm_x(i-1,j) + three*alp1*sm_xx(i-1,j) )
                0207         fp_xx(i,j) = alp(i,j)*alpq*sm_xx(i-1,j)
                0208         fp_y (i,j) = alp(i,j)*( sm_y(i-1,j) + alp1*sm_xy(i-1,j) )
                0209         fp_z (i,j) = alp(i,j)*( sm_z(i-1,j) + alp1*sm_xz(i-1,j) )
                0210         fp_xy(i,j) = alpq    *sm_xy(i-1,j)
                0211         fp_xz(i,j) = alpq    *sm_xz(i-1,j)
                0212         fp_yy(i,j) = alp(i,j)*sm_yy(i-1,j)
                0213         fp_zz(i,j) = alp(i,j)*sm_zz(i-1,j)
                0214         fp_yz(i,j) = alp(i,j)*sm_yz(i-1,j)
                0215 C--    Flux from (i) to (i-1) when U<0 (i.e., take left side of box i)
00fdbdcbd5 Jean*0216         fn_v (i,j) = MAX( zeroRL, -uLoc )
d7ce0d34f8 Jean*0217         aln  (i,j) = fn_v(i,j)/sm_v( i ,j)
                0218         alnq       = aln(i,j)*aln(i,j)
                0219         aln1       = 1. _d 0 - aln(i,j)
                0220 C-     Create temporary moments/masses for partial boxes in transit
                0221 C       use same indexing as velocity, "n" for negative U
                0222         fn_o (i,j) = aln(i,j)*( sm_o( i ,j) - aln1*sm_x( i ,j)
                0223      &                        + aln1*(aln1-aln(i,j))*sm_xx( i ,j)
                0224      &                        )
                0225         fn_x (i,j) = alnq    *( sm_x( i ,j) - three*aln1*sm_xx( i ,j) )
                0226         fn_xx(i,j) = aln(i,j)*alnq*sm_xx( i ,j)
                0227         fn_y (i,j) = aln(i,j)*( sm_y( i ,j) - aln1*sm_xy( i ,j) )
                0228         fn_z (i,j) = aln(i,j)*( sm_z( i ,j) - aln1*sm_xz( i ,j) )
                0229         fn_xy(i,j) = alnq    *sm_xy( i ,j)
                0230         fn_xz(i,j) = alnq    *sm_xz( i ,j)
                0231         fn_yy(i,j) = aln(i,j)*sm_yy( i ,j)
                0232         fn_zz(i,j) = aln(i,j)*sm_zz( i ,j)
                0233         fn_yz(i,j) = aln(i,j)*sm_yz( i ,j)
                0234 C--    Save zero-order flux:
9822905e7f Jean*0235         uT(i,j) = ( fp_o(i,j) - fn_o(i,j) )*recip_dT
d7ce0d34f8 Jean*0236        ENDDO
                0237       ENDDO
                0238 
b79a2b44f2 Jean*0239 C--   end 1rst loop on strip number "ns"
                0240 c     ENDDO
                0241 
1574069d50 Mart*0242 #ifdef ALLOW_AUTODIFF_TAMC
7448700841 Mart*0243 CADJ STORE sm_o,sm_v,sm_x,sm_y,sm_z,sm_xx,sm_xy,sm_xz
1574069d50 Mart*0244 CADJ &     = somtape_x, key = ns, kind = isbyte
                0245 #endif
d7ce0d34f8 Jean*0246 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
b79a2b44f2 Jean*0247 C--   start 2nd loop on strip number "ns"
                0248 c     DO ns=1,nbStrips
                0249 
d7ce0d34f8 Jean*0250 C---  part.2 : re-adjust moments remaining in the box
                0251 C      take off from grid box (i): negative U(i) and positive U(i+1)
b79a2b44f2 Jean*0252       DO j=jMinUpd(ns),jMaxUpd(ns)
                0253        DO i=iMinUpd(1),iMaxUpd(1)
72de869c1b Jean*0254 #ifdef ALLOW_OBCS
00fdbdcbd5 Jean*0255         IF ( maskIn(i,j).NE.zeroRS ) THEN
72de869c1b Jean*0256 #endif /* ALLOW_OBCS */
d7ce0d34f8 Jean*0257         alf1  = 1. _d 0 - aln(i,j) - alp(i+1,j)
                0258         alf1q = alf1*alf1
                0259         alpmn = alp(i+1,j) - aln(i,j)
                0260         sm_v (i,j) = sm_v (i,j) - fn_v (i,j) - fp_v (i+1,j)
                0261         sm_o (i,j) = sm_o (i,j) - fn_o (i,j) - fp_o (i+1,j)
                0262         sm_x (i,j) = alf1q*( sm_x(i,j) - three*alpmn*sm_xx(i,j) )
                0263         sm_xx(i,j) = alf1*alf1q*sm_xx(i,j)
                0264         sm_xy(i,j) = alf1q*sm_xy(i,j)
                0265         sm_xz(i,j) = alf1q*sm_xz(i,j)
                0266         sm_y (i,j) = sm_y (i,j) - fn_y (i,j) - fp_y (i+1,j)
                0267         sm_yy(i,j) = sm_yy(i,j) - fn_yy(i,j) - fp_yy(i+1,j)
                0268         sm_z (i,j) = sm_z (i,j) - fn_z (i,j) - fp_z (i+1,j)
                0269         sm_zz(i,j) = sm_zz(i,j) - fn_zz(i,j) - fp_zz(i+1,j)
                0270         sm_yz(i,j) = sm_yz(i,j) - fn_yz(i,j) - fp_yz(i+1,j)
72de869c1b Jean*0271 #ifdef ALLOW_OBCS
                0272         ENDIF
                0273 #endif /* ALLOW_OBCS */
d7ce0d34f8 Jean*0274        ENDDO
                0275       ENDDO
                0276 
                0277 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0278 C---  part.3 : Put the temporary moments into appropriate neighboring boxes
                0279 C      add into grid box (i): positive U(i) and negative U(i+1)
b79a2b44f2 Jean*0280       DO j=jMinUpd(ns),jMaxUpd(ns)
                0281        DO i=iMinUpd(1),iMaxUpd(1)
72de869c1b Jean*0282 #ifdef ALLOW_OBCS
00fdbdcbd5 Jean*0283         IF ( maskIn(i,j).NE.zeroRS ) THEN
72de869c1b Jean*0284 #endif /* ALLOW_OBCS */
d7ce0d34f8 Jean*0285         sm_v (i,j) = sm_v (i,j) + fp_v (i,j) + fn_v (i+1,j)
                0286         alfp = fp_v( i ,j)/sm_v(i,j)
                0287         alfn = fn_v(i+1,j)/sm_v(i,j)
                0288         alf1 = 1. _d 0 - alfp - alfn
                0289         alp1 = 1. _d 0 - alfp
                0290         aln1 = 1. _d 0 - alfn
                0291         alpmn = alfp - alfn
                0292         locTp = alfp*sm_o(i,j) - alp1*fp_o(i,j)
                0293         locTn = alfn*sm_o(i,j) - aln1*fn_o(i+1,j)
                0294         sm_xx(i,j) = alf1*alf1*sm_xx(i,j) + alfp*alfp*fp_xx(i,j)
                0295      &                                    + alfn*alfn*fn_xx(i+1,j)
                0296      &   - 5. _d 0*(-alpmn*alf1*sm_x(i,j) + alfp*alp1*fp_x(i,j)
                0297      &                                    - alfn*aln1*fn_x(i+1,j)
00fdbdcbd5 Jean*0298      &             + twoRL*alfp*alfn*sm_o(i,j) + (alp1-alfp)*locTp
                0299      &                                         + (aln1-alfn)*locTn
d7ce0d34f8 Jean*0300      &             )
                0301         sm_xy(i,j) = alf1*sm_xy(i,j) + alfp*fp_xy(i,j)
                0302      &                               + alfn*fn_xy(i+1,j)
                0303      &     + three*( alpmn*sm_y(i,j) - alp1*fp_y(i,j)
                0304      &                               + aln1*fn_y(i+1,j)
                0305      &             )
                0306         sm_xz(i,j) = alf1*sm_xz(i,j) + alfp*fp_xz(i,j)
                0307      &                               + alfn*fn_xz(i+1,j)
                0308      &     + three*( alpmn*sm_z(i,j) - alp1*fp_z(i,j)
                0309      &                               + aln1*fn_z(i+1,j)
                0310      &             )
                0311         sm_x (i,j) = alf1*sm_x(i,j) + alfp*fp_x(i,j) + alfn*fn_x(i+1,j)
                0312      &             + three*( locTp - locTn )
                0313         sm_o (i,j) = sm_o (i,j) + fp_o (i,j) + fn_o (i+1,j)
                0314         sm_y (i,j) = sm_y (i,j) + fp_y (i,j) + fn_y (i+1,j)
                0315         sm_yy(i,j) = sm_yy(i,j) + fp_yy(i,j) + fn_yy(i+1,j)
                0316         sm_z (i,j) = sm_z (i,j) + fp_z (i,j) + fn_z (i+1,j)
                0317         sm_zz(i,j) = sm_zz(i,j) + fp_zz(i,j) + fn_zz(i+1,j)
                0318         sm_yz(i,j) = sm_yz(i,j) + fp_yz(i,j) + fn_yz(i+1,j)
72de869c1b Jean*0319 #ifdef ALLOW_OBCS
                0320         ENDIF
                0321 #endif /* ALLOW_OBCS */
d7ce0d34f8 Jean*0322        ENDDO
                0323       ENDDO
                0324 
b79a2b44f2 Jean*0325 C--   end 2nd loop on strip number "ns"
                0326       ENDDO
7448700841 Mart*0327 #endif /* GAD_ALLOW_TS_SOM_ADV or PTRACERS_ALLOW_DYN_STATE */
b79a2b44f2 Jean*0328 
d7ce0d34f8 Jean*0329       RETURN
                0330       END