
CD-Section: Copy KDM Stored LSM Data to/from Internal Scaling Arrays
C A routine is available to copy the LSM data as stored by the keyword
C handling routines to and from a set of internal scaling arrays (SCP)
C which are used to provide temporary storage during a refinement and
C to provide efficient access during scaling.
CD-end

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     LSM_KDMCOPY      **
C**************************
C
C
CD-Routine: Copy LSM parameters to/from internal storage - LSM_KDMCOPY
C This routine is used to copy the current values of the LSM parameters
C as held in the associated KDM arrays to or from the internal scaling
C arrays (SCP) used internally by the scaling and refinement functions 
C of the LSM set of routines.
CD-end
CD-Fortran:
      SUBROUTINE LSM_KDMCOPY (IOPT, IERR, ERRSTR)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Copy LSM parameters to/from Internal Storage
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      INTEGER IOPT
      INTEGER IERR
      CHARACTER*(*) ERRSTR

CD-Parameters:
C  IOPT        i (R)   Flag =1 copy from KDM to internal scaling arrays
C                              (e.g. prior to using any scaling functions)
C                           =2 copy from internal scaling arrays to KDM
C                              (e.g. after refining any scaling parameters)
C  IERR        i (W)   Error flag = 0 OK
C                                 = 1 Error
C  ERRSTR      c (W)   Error string if IERR is non-zero
CD-end
C
C Implementation note: Sets 'markup required' flag
C
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'lsm_flags.finc'
      INCLUDE 'scp.finc'
      INCLUDE 'scps_counters.finc'
      INCLUDE 'other_scale.finc'
      INCLUDE 'abscor_muin.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER KDMSTR
      INTEGER LENSTR      
C
C====== LOCALS:
C
      INTEGER I, J, K, IC
      INTEGER KERR
      INTEGER NUM_INP
      INTEGER ISTAT
      INTEGER ITYP
      INTEGER ND(MAXVARR)
      INTEGER N1, N2, N3, N4, N5, N6
      INTEGER KDX   
      INTEGER IVAL(MAXVARR)               
      INTEGER MAXE
      INTEGER NCOUT
      REAL FVAL(MAXVARR)
      CHARACTER*80 STR
      CHARACTER*80 VALSTR

C     INTEGER I, J, K, IC          ! Temp/loop variables
C     INTEGER KERR                 ! Error return flag
C     INTEGER NUM_INP              ! No. of input values for a variable 
C                                  ! array param.
C     INTEGER ISTAT                ! Parameter status flag
C     INTEGER ITYP                 ! Parameter type
C     INTEGER ND(MAXVARR)          ! No. of decimal places flag(s)
C     INTEGER IRTYP(MAXVARR)       ! Type of number or parameter flag
C     INTEGER NORD                 ! Order of polynomial for normalization
C     INTEGER MGCOEFF      	   ! number of coeff. for global abs. corr.
C     INTEGER NGCOEFF      	   ! number of coeff. for global abs. corr.
C     INTEGER MLCOEFF      	   ! number of coeff. for local abs. corr.
C     INTEGER NLCOEFF      	   ! number of coeff. for local abs. corr.
C     INTEGER N1, N2,..., N9       ! Index counter for SCP
C     INTEGER KDX                  ! Index for KDM calls
C     INTEGER IVAL(MAXVARR)        ! Integer values array
C     INTEGER MAXE                 ! Maximum length for error string
C     INTEGER NCOUT                ! Number of coefficients output
C     REAL FVAL(MAXVARR)           ! Real values array
C     CHARACTER*80 VALSTR          ! Dummy value string
C     CHARACTER*80 ERRSTR          ! Error string
C         
C
C------------------------------------------------------------------------------
C
C====== Set 'markup-required' flag
C
      MARKUP_REQUIRED = .TRUE.
      KDX = KINDX

      MAXE = 80
      IERR = 0
      ERRSTR = ' '
      VALSTR = ' '
C
C====== Get values of LSM-parameters
C  

      IF (IOPT.EQ.1) THEN

      DO 10 I = 1, MXPAR
         SCP(I) = 0.0
10    CONTINUE  
    
      DO 250 I = 1, MAXPACK*MAXCOEFFS
         SCPLOC(I) = 0.0
250   CONTINUE  

      DO 260 I = 1, MAXRANGE
         PLSCRAN(I) = .FALSE.         
         NORMRAN(I) = .FALSE.
260    CONTINUE  

      DO 310 I = 1, MAXPACK
         LOCDAT(I) = .FALSE.
 310  CONTINUE

      GLOBDAT = .FALSE.

      STR = 'NORM_LAMREF'	
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), 1, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP , ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR) 
      IF (KERR.NE.0) GOTO 810   
      REFNORMLAM = FVAL(1)

      STR = 'ABSCOR_LAMREF'	         
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), 1, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR) 
      IF (KERR.NE.0) GOTO 810    
      REFABSLAM = FVAL(1)

      DO 300 I = 1, NPK
         STR = 'ABSCOR_THICK'	
         CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), I, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR)
         IF (KERR.NE.0) GOTO 810    
         ABSTHICK(I) = FVAL(1)
 300  CONTINUE

      NCSCP(1) = 0

      IC = MAXRANGE*MAXPACK*MAXPLATES
      DO 40 K = 1, MAXRANGE
         DO 50 I = 1, NPK
            DO 60 J = 1, NPL(I)
               STR = 'PLATE_SCALE_'
	       CALL STR_ADDI(STR,K,0)
               CALL KDMF_GETVALUE (KDX, KDMSTR(STR),
     +                   LENSTR(STR), I, J, 
     +                   2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                   NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                   MAXE, KERR)  
               IF (KERR.NE.0) GOTO 810    
	       PLSCALELAMMIN(K) = FVAL(1)
	       PLSCALELAMMAX(K) = FVAL(2)
               SCP((K-1)*MAXPACK*MAXPLATES+(I-1)*
     +                   MAXPLATES+J) = FVAL(3)
               SCP((K-1)*MAXPACK*MAXPLATES+(I-1)*
     +                   MAXPLATES+J+IC) = FVAL(4)
60          CONTINUE
50       CONTINUE
         IF ((FVAL(1).NE.0.0).OR.(FVAL(2).NE.0.0)) THEN
            PLSCRAN(K) = .TRUE.
         END IF
40    CONTINUE

      N1 = 2*MAXPLATES*MAXPACK*MAXRANGE
      NCSCP(2) = N1

      DO 70 I = 1, NPK
         STR = 'IMAGE_SCALE'
         CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), I, 1, 
     +                      2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                      NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                      MAXE, KERR)  
         IF (KERR.NE.0) GOTO 810    
         SCP(N1+I) = FVAL(1)  
70    CONTINUE 
   
      N2 = N1 + MAXPACK
      NCSCP(3) = N2

      DO 80 I = 1, NPK
         STR = 'IMAGE_BFAC'
         CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), I, 1, 
     +                       2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                       NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                       MAXE, KERR)  
         IF (KERR.NE.0) GOTO 810    
         SCP(N2+I) = FVAL(1)
80    CONTINUE 

      N3 = N2 + MAXPACK
      NCSCP(4) = N3

      STR = 'REFSET_SCALE'
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), 1, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR)  
      IF (KERR.NE.0) GOTO 810    
      SCP(N3+1) = FVAL(1)
    
      N4 = N3 + 1
      NCSCP(5) = N4

      STR = 'REFSET_BFAC'	
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), 1, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR)  
      IF (KERR.NE.0) GOTO 810    
      SCP(N4+1) = FVAL(1)

      N5 = N4 + 1       
      NCSCP(6) = N5

      DO 90 I = 1, MAXRANGE
	 STR = 'NORM_COEFF_'
	 CALL STR_ADDI(STR,I,0)
         CALL KDMF_GETVALUE(KDX,KDMSTR(STR),LENSTR(STR),1, 1, 
     +                     2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                     NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                     MAXE, KERR) 
         IF (KERR.NE.0) GOTO 810    
	 NNORM(I) = IVAL(1)+1
         NORMLAMMIN(I) = FVAL(2)      
         NORMLAMMAX(I) = FVAL(3) 
         IF (NUM_INP.GT.3) THEN
      	    DO 100 J = 1, NUM_INP-3
               SCP(N5+J+(I-1)*POLCOEFFS) = FVAL(J+3)
100         CONTINUE	
         END IF
         IF ((FVAL(2).NE.0.0).OR.(FVAL(3).NE.0.0)) THEN
            NORMRAN(I) = .TRUE.
         END IF
         IF ((FVAL(2).EQ.0.0).AND.(FVAL(3).EQ.0.0)) THEN
            NRAN = I-1
            GO TO 240
         END IF 
90    CONTINUE	

 240  N6 = N5 + POLCOEFFS*MAXRANGE
      NCSCP(7) = N6

      STR = 'ABSCOR_GLOBAL'
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), 1, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR)  
      IF (KERR.NE.0) GOTO 810    
      IOPTABSG = IVAL(1)
      NABSG = IVAL(2)+1
      MABSG = IVAL(3)+1
      IF (IVAL(1).EQ.1) THEN
         GLOBMINPSI = 0.0
         GLOBMAXPSI = 0.0
         GLOBMINNU = 0.0
         GLOBMAXNU = 0.0
         IF (NUM_INP.GE.4) GLOBMINPSI = FVAL(4)
         IF (NUM_INP.GE.5) GLOBMAXPSI = FVAL(5)
         IF (NUM_INP.GE.6) GLOBMINNU = FVAL(6)
         IF (NUM_INP.GE.7) GLOBMAXNU = FVAL(7)
         IF (FVAL(5).NE.0.0.AND.FVAL(7).NE.0.0) GLOBDAT = .TRUE.
         IF (NUM_INP.GT.7) THEN
            DO 290 J = 1, NUM_INP-7
               SCP(N6+J) = FVAL(J+7)
 290        CONTINUE	
         END IF
      ELSE
         IF (IVAL(1).EQ.2) THEN
            IF (NUM_INP.GT.3) THEN
               DO 130 J = 1, NUM_INP-3
                  SCP(N6+J) = FVAL(J+3)
 130           CONTINUE	
            END IF
         END IF
      END IF

      DO 110 I = 1, NPK	
         STR = 'ABSCOR_LOCAL'
         CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), I, 1, 
     +                       2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                       NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                       MAXE, KERR) 
         IF (KERR.NE.0) GOTO 810    
         NABSL(I) = IVAL(1)+1
         MABSL(I) = IVAL(2)+1
         LOCMINPSI(I) = FVAL(3)
         LOCMAXPSI(I) = FVAL(4)
         LOCMINNU(I) = FVAL(5)
         LOCMAXNU(I) = FVAL(6)
         IF (FVAL(4).NE.0.0.AND.FVAL(6).NE.0.0) LOCDAT(I) = .TRUE.
         IF (NUM_INP.GT.6) THEN
            DO 120 J = 1, NUM_INP-6
               SCPLOC(J+(I-1)*MAXCOEFFS) = FVAL(J+6)
120         CONTINUE	
         END IF    
110   CONTINUE	    
           
      STR = 'COVER_FACTOR'
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), 1, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR)  
      IF (KERR.NE.0) GOTO 810    
      COVFAC = FVAL(1)

      STR = 'POL_TYPE'	
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR), LENSTR(STR), 1, 1, 
     +                    7, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR)
      IF (KERR.NE.0) GOTO 810
      CALL CCPUPC(VALSTR)
      IF(VALSTR.EQ.'XRAY') RADTYPE = 1 
      IF(VALSTR.EQ.'NEUTRON') RADTYPE = 2
      
      STR = 'POL_FAC'	
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), 1, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR) 
      IF (KERR.NE.0) GOTO 810    
      POLFAC = FVAL(1)

      STR = 'ABSCOR_MU'	
      CALL KDMF_GETVALUE (KDX, KDMSTR(STR),LENSTR(STR), 1, 1, 
     +                    2, KDMSTR(VALSTR), FVAL, ND, IVAL, 
     +                    NUM_INP, ISTAT, ITYP, KDMSTR(ERRSTR), 
     +                    MAXE, KERR) 
      IF (KERR.NE.0) GOTO 810 
      MUINPUT = NUM_INP
      IF (MUINPUT.LE.2) THEN
         MUTABLE(1) = FVAL(1)
         MUTABLE(2) = FVAL(2)
      ELSE
         DO 270 I = 1, MUINPUT-1, 2  
            MUTABLE(I) = FVAL(I)
            IF(MUTABLE(I).LT.MUTABLE(I-2)) GO TO 280
            MUTABLE(I+1) = FVAL(I+1)
 270     CONTINUE
      END IF

      RETURN

      END IF

      
C
C======  Set values for LSM-parameters
C  
      IF (IOPT.EQ.2) THEN

      STR = 'NORM_LAMREF'	
      FVAL(1) = REFNORMLAM 
      CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), 0, 0, 
     +          KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 1,
     +          KDMSTR(ERRSTR), MAXE, KERR)
      IF (KERR.NE.0) GOTO 810   

      STR = 'ABSCOR_LAMREF'	
      FVAL(1) = REFABSLAM        
      CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), 0, 0, 
     +                    KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 1,
     +                    KDMSTR(ERRSTR), MAXE, KERR)
      IF (KERR.NE.0) GOTO 810   

      N1 = MAXPLATES*MAXPACK*MAXRANGE

      DO 140 K = 1, MAXRANGE
         DO 150 I = 1, NPK
            DO 160 J = 1, NPL(I)
               STR = 'PLATE_SCALE_'
	       CALL STR_ADDI(STR,K,0)
	       FVAL(1) = PLSCALELAMMIN(K)
	       FVAL(2) = PLSCALELAMMAX(K)
	       FVAL(3) = SCP((K-1)*MAXPACK*MAXPLATES+(I-1)*MAXPLATES+J) 
	       FVAL(4) = SCP((K-1)*MAXPACK*MAXPLATES+(I-1)*MAXPLATES+J+
     +                   N1)
               CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), I, J, 
     +                    KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 1,
     +                    KDMSTR(ERRSTR), MAXE, KERR)
               IF (KERR.NE.0) GOTO 810   
160          CONTINUE
150       CONTINUE
140   CONTINUE

      N1 = 2*MAXPLATES*MAXPACK*MAXRANGE

      DO 170 I = 1, NPK
         STR = 'IMAGE_SCALE'
	 FVAL(1) = SCP(N1+I)
         CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), I, 0, 
     +              KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 1,
     +              KDMSTR(ERRSTR), MAXE, KERR)
         IF (KERR.NE.0) GOTO 810    
170    CONTINUE 
   
      N2 = N1 + MAXPACK

      DO 180 I = 1, NPK
         STR = 'IMAGE_BFAC'
         FVAL(1) = SCP(N2+I)
         CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), I, 0, 
     +              KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 1,
     +              KDMSTR(ERRSTR), MAXE, KERR)
         IF (KERR.NE.0) GOTO 810    
180   CONTINUE 

      N3 = N2 + MAXPACK

      STR = 'REFSET_SCALE'
      FVAL(1) = SCP(N3+1)
      CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), 0, 0, 
     +              KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 1,
     +              KDMSTR(ERRSTR), MAXE, KERR)
      IF (KERR.NE.0) GOTO 810    
    
      N4 = N3 + 1

      STR = 'REFSET_BFAC'	
      FVAL(1) = SCP(N4+1)
      CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), 0, 0, 
     +              KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 1,
     +              KDMSTR(ERRSTR), MAXE, KERR)
      IF (KERR.NE.0) GOTO 810    

      N5 = N4 + 1       

      DO 190 I = 1, NRAN
	 STR = 'NORM_COEFF_'
	 CALL STR_ADDI(STR,I,0)
         IVAL(1) = NNORM(I)-1
         FVAL(2) = NORMLAMMIN(I) 
         FVAL(3) = NORMLAMMAX(I)
      	 DO 200 J = 1, POLCOEFFS
	    FVAL(J+3) = SCP(N5+J+(I-1)*POLCOEFFS)
200      CONTINUE
         CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), 0, 0, 
     +              KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 
     +              IVAL(1)+4, KDMSTR(ERRSTR), MAXE, KERR)
         IF (KERR.NE.0) GOTO 810    
190   CONTINUE	

      N6 = N5 + POLCOEFFS*MAXRANGE

      DO 210 I = 1, NPK	
         STR = 'ABSCOR_LOCAL'
	 IVAL(1) = NABSL(I)-1
	 IVAL(2) = MABSL(I)-1
         FVAL(3) = LOCMINPSI(I) 
         FVAL(4) = LOCMAXPSI(I)
         FVAL(5) = LOCMINNU(I)
         FVAL(6) = LOCMAXNU(I) 
         DO 220 J = 1, MAXCOEFFS
	    FVAL(J+6) = SCPLOC(J+(I-1)*MAXCOEFFS)
220      CONTINUE	
         CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), I, 0, 
     +              KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 
     +              (IVAL(1)+1)*(IVAL(2)+1)-1+6, KDMSTR(ERRSTR), MAXE, 
     +              KERR)
         IF (KERR.NE.0) GOTO 810    
210   CONTINUE	

      STR = 'ABSCOR_GLOBAL'
      IVAL(1) = IOPTABSG
      IVAL(2) = NABSG-1
      IVAL(3) = MABSG-1
      IF (IVAL(1).EQ.1) THEN
         FVAL(4) = GLOBMINPSI 
         FVAL(5) = GLOBMAXPSI 
         FVAL(6) = GLOBMINNU 
         FVAL(7) = GLOBMAXNU 
         DO 390 J = 1, MAXCOEFFS
            FVAL(J+7) = SCP(N6+J) 
 390     CONTINUE	
      ELSE
         IF (IVAL(1).EQ.2) THEN
            DO 230 J = 1, MAXCOEFFS
	       FVAL(J+3) = SCP(N6+J) 
230         CONTINUE	
         END IF
      END IF
      IF (IVAL(1).EQ.1)  NCOUT =  (IVAL(2)+1)*(IVAL(3)+1) + 6  
      IF (IVAL(1).EQ.2)  NCOUT =  2*(IVAL(2)+1)*(IVAL(3)+1) + 1 
      CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), 0, 0, 
     +              KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 
     +              NCOUT, KDMSTR(ERRSTR), MAXE, KERR)
      IF (KERR.NE.0) GOTO 810    
       
      STR = 'COVER_FACTOR'
      FVAL(1) = COVFAC 
      CALL KDMF_SETVALUE (KDX, KDMSTR(STR), LENSTR(STR), 0, 0, 
     +              KDMSTR(VALSTR), LENSTR(VALSTR), IVAL, FVAL, 1,
     +              KDMSTR(ERRSTR), MAXE, KERR)
      IF (KERR.NE.0) GOTO 810    
 
      END IF

      RETURN

 810  ERRSTR = 'Error code'
      CALL STR_ADDI (ERRSTR, KERR, 1)
      CALL STR_ADDS (ERRSTR, 
     +  'from kdmf_get/setvalue for parameters', 1)
      CALL STR_ADDS (ERRSTR, STR, 1)
      IERR = 1
      RETURN

 280  ERRSTR = 'Lambda-Values for mu-list not in ascending order'
      IERR = 1 

      RETURN

      END
