      PROGRAM GSOMGAH                                                                                                               
C     PROGRAM GSOMGAH (SSLNSP,       SSTEMP,       SSVORT,       SSDIV,         J2                                                  
C    1                               GSOMEG,       INPUT,       OUTPUT, )       J2                                                  
C    2          TAPE11=SSLNSP,TAPE12=SSTEMP,TAPE13=SSVORT,TAPE14=SSDIV,                                                             
C    3                        TAPE15=GSOMEG, TAPE5=INPUT, TAPE6=OUTPUT)                                                             
C     -----------------------------------------------------------------         J2                                                  
C                                                                               J2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       J2                                                  
C     FEB 15/94 - F.MAJAESS (REVISE FOR TRUNCATIONS > 99)                                                                           
C     JAN 13/93 - E. CHAN  (DECODE LEVELS IN 8-WORD LABEL)                                                                          
C     JUL 13/92 - E. CHAN  (DIMENSION SELECTED VARIABLES AS REAL*8)                                                                 
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JAN 24/91 - M.LAZARE, F.MAJAESS                                                                                               
C                                                                               J2                                                  
CGSOMGAH - CONVERTS ETA (SIGMA/HYBRID) LEVEL Q,D FILES TO VERTICAL              J1                                                  
C                                                         MOTION        3  1 C GJ1                                                  
C                                                                               J3                                                  
CAUTHORS - M.LAZARE AND F.MAJAESS.                                              J3                                                  
C                                                                               J3                                                  
CPURPOSE - COMPUTES A GRID FILE OF VERTICAL MOTION (DP/DT) FROM                 J3                                                  
C          ETA (SIGMA/HYBRID) LEVEL SPECTRAL FILES OF VORTICITY                 J3                                                  
C          AND DIVERGENCE.                                                      J3                                                  
C          NOTE - INPUT IS SPECTRAL, OUTPUT IS GAUSSIAN GRIDS,                  J3                                                  
C                 ALL GLOBAL.                                                   J3                                                  
C                                                                               J3                                                  
CINPUT FILES...                                                                 J3                                                  
C                                                                               J3                                                  
C      SSLNSP = SPECTRAL LN(SF PRES) ON ETA (SIGMA/HYBRID) LEVELS               J3                                                  
C      SSTEMP = SPECTRAL TEMPERATURE ON ETA (SIGMA/HYBRID) LEVELS               J3                                                  
C      SSVORT = SPECTRAL VORTICITY   ON ETA (SIGMA/HYBRID) LEVELS               J3                                                  
C      SSDIV  = SPECTRAL DIVERGENCE  ON ETA (SIGMA/HYBRID) LEVELS               J3                                                  
C                                                                               J3                                                  
COUTPUT FILE...                                                                 J3                                                  
C                                                                               J3                                                  
C      GSOMEG = GRIDS OF VERTICAL MOTION OMEGA (DP/DT) AT MID-LAYER             J3                                                  
C               POSITIONS. UNITS ARE NEWTONS/M**2/SEC.                          J3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               J5                                                  
C      ILG   = LENGTH OF A GAUSSIAN GRID ROW (LT."MAXLG")                       J5                                                  
C      ILAT  = NUMBER OF GAUSSIAN LATITUDES.                                    J5                                                  
C      KPACK = OUTPUT PACKING DENSITY (0 DEFAULT TO 4)                          J5                                                  
C      ICCORD= 4H SIG/4H ETA FOR SIGMA/ETA VERTICAL COORDINATE                  J5                                                  
C      PTOIT = PRESSURE (PA) OF THE RIGID LID OF THE MODEL                      J5                                                  
C      LAY   = ARRANGEMENT TYPE OF INTERFACES WITH RESPECT TO MID_LAYERS        J5                                                  
C            = 0    , SAME AS LAY=2 FOR MOMENTUM AND LAY=4 FOR THERMODYNAMICS,  J5                                                  
C                     (UPWARD COMPATIBILTY WITH EARLIER VERSIONS OF GCM)        J5                                                  
C            = 1 / 2, LAYER INTERFACE PLACED AT AN EQUAL SIGMA/GEOMETRIC        J5                                                  
C                     DISTANCE FROM THE MIDDLE OF THE ADJACENT LAYERS           J5                                                  
C            = 3 / 4, BASE LAYERS EXTRAPOLATED SO THAT THE MIDDLE OF THE        J5                                                  
C                     LAYERS ARE AT THE CENTRE OF THE SIGMA/GEOMETRIC LAYERS    J5                                                  
C                                                                               J5                                                  
CEXAMPLE OF INPUT CARD...                                                       J5                                                  
C                                                                               J5                                                  
C* GSOMGAH   64   52    0  SIG        0.    0                                   J5                                                  
C---------------------------------------------------------------------------                                                        
C                                                                                                                                   
C     * COMPLEX MULTILEVEL ARRAY FOR SURFACE PRESSURE,VORTICITY AND                                                                 
C     * DIVERGENCE SPECTRAL COEFFICIENTS, IN THAT ORDER IN SP.                                                                      
C     * SP((1+2*ILEV)*LA),T(LA),ES(LA),TRAC(LA*ILEV)                                                                                
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMPLEX SP                                                                                                                    
C     COMPLEX T,ES,TRAC                                                                                                             
      COMMON /SPEC/ SP(431145)                                                                                                      
      DIMENSION T(2145),ES(2145),TRAC(214500)                                                                                       
                                                                                                                                    
C     * WORKS ARRAYS.                                                                                                               
C     * ALP(LA+LM),DALP(LA+LM),DELALP(LA+LM),EPSI(LA+LM),                                                                           
C     * GGOM((ILG+1)*ILAT*ILEV)                                                                                                     
                                                                                                                                    
      REAL*8 ALP(2210),DALP(2210),DELALP(2210),EPSI(2210)                                                                           
      COMMON/BLANCK/GGOM(1852800)                                                                                                   
                                                                                                                                    
C     * MULTILEVEL WORK ARRAY FOR SLICE VALUES OF PRESSG, P, C,                                                                     
C     * PSDPG, UG, VG AND PSDLG, IN THAT ORDER IN SLICE.                                                                            
C     * SLICE(MAXLG,(4*ILEV+3))                                                                                                     
C     * TG(MAXLG),ESG(MAXLG),TRACG(ILEV*MAXLG),OMEGAG(MAXLG*ILEV)                                                                   
                                                                                                                                    
      REAL SLICE(194,403)                                                                                                           
      REAL TG(194),ESG(194),TRACG(19400)                                                                                            
      REAL OMEGAG(19400)                                                                                                            
                                                                                                                                    
C     * WORK FIELDS.                                                                                                                
C     * TRIGS(MAXLG),LSR(2,LM+1),LETA(ILEV),...                                                                                     
                                                                                                                                    
      LOGICAL OK,LVECT                                                                                                              
      REAL TRIGS(194),SHBJ1(194),DB(100),D2B(100),                                                                                  
     1     SG(100),SH(100),SGB(100),SHB(100),ACG(100),BCG(100),                                                                     
     2     AG(100),BG(100),AH (100),BH (100),ACH(100),BCH(100)                                                                      
      INTEGER LSR(2,66),LETA(100),LETT(100),LEVP(100),                                                                              
     1        LEVC(100),IFAX(10)                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
                                                                                                                                    
C     * WRKS((ILG+2)*64)                                                                                                            
                                                                                                                                    
      REAL*8 SL(96),CL(96),WL(96),WOSSL(96),RADL(96)                                                                                
      COMMON/SCM1/ WRKS(12416)                                                                                                      
      COMMON /PARAMS/ WW,TW,RAYON,ASQ,GRAV,RGAS,RGOCP,RGOASQ,CPRES                                                                  
      COMMON /PARAMS/ RGASV,CPRESV                                                                                                  
      COMMON /HTCP/   T1S,T2S,AI,BI,AW,BW,SLP                                                                                       
      COMMON /EPS/    A,B,EPS1,EPS2                                                                                                 
      COMMON /GAMS/   EPSS,CAPA                                                                                                     
      COMMON /ADJPCP/ HC,HF,HM,AA,DEPTH,LHEAT,MOIADJ,MOIFLX                                                                         
      COMMON /EPSICE/ AICE,BICE,TICE,QMIN                                                                                           
                                                                                                                                    
C     * THE FOLLOWING ARRAYS ARE FOR FUNCTIONS OF (ILG,ILEV).                                                                       
                                                                                                                                    
      REAL SGJ   (19400),SGBJ  (19400),DSGJ  (19400),                                                                               
     1     SHJ   (19400),SHBJ  (19400),DSHJ  (19400),                                                                               
     2     A1SGJ (19400),B1SGJ (19400),D1SGJ (19400),                                                                               
     3     A2SGJ (19400),B2SGJ (19400),D2SGJ (19400),                                                                               
     4     DLNSGJ(19400),VGRPSJ(19400)                                                                                              
                                                                                                                                    
C     * THE FOLLOWING IS A WORKING ARRAY FUNCTION OF ILG.                                                                           
                                                                                                                                    
      REAL SSDRJK(194)                                                                                                              
                                                                                                                                    
C     * THE FOLLOWING IS A WORKING ARRAY FUNCTION OF ILEV.                                                                          
C                                                                                                                                   
      COMPLEX P2(100)                                                                                                               
                                                                                                                                    
C     * ALFMOD AND LVECT SHOULD BE THE SAME AS IN THE GCM.                                                                          
                                                                                                                                    
      DATA ALFMOD/1.0E0/                                                                                                            
      DATA LVECT/.TRUE./                                                                                                            
                                                                                                                                    
C     * MAXLG/ILG+2, MAXX/ILG+1*ILAT/, MAXSP/LA/, MAXMSP/LA*ILEV/, MAXL/ILEV/                                                       
                                                                                                                                    
      DATA MAXLG/194/, MAXX/18528/, MAXSP/2145/, MAXMSP/214500/                                                                     
      DATA MAXL/100/                                                                                                                
C---------------------------------------------------------------------                                                              
      NFF=7                                                                                                                         
      CALL JCLPNT(NFF,11,12,13,14,15,5,6)                                                                                           
      DO 110 N=11,15                                                                                                                
  110 REWIND N                                                                                                                      
                                                                                                                                    
C     * READ-IN DIRECTIVE CARD.                                                                                                     
                                                                                                                                    
      READ(5,5010,END=905) ILG,ILAT,KPACK,ICOORD,PTOIT,LAY                      J4                                                  
      IF(ILG.GT.(MAXLG-2)) ILG=MAXLG-2                                                                                              
      IF(KPACK.EQ.0) KPACK=4                                                                                                        
      IF(ICOORD.EQ.NC4TO8("    ")) ICOORD=NC4TO8(" SIG")                                                                            
      IF(ICOORD.EQ.NC4TO8(" SIG")) THEN                                                                                             
        PTOIT=MAX(PTOIT,0.00E0)                                                                                                     
      ELSE                                                                                                                          
        PTOIT=MAX(PTOIT, 0.100E-09)                                                                                                 
      ENDIF                                                                                                                         
      ILG1=ILG+1                                                                                                                    
      ILH=MAXLG/2                                                                                                                   
      ILATH=ILAT/2                                                                                                                  
      WRITE(6,6000) ICOORD,PTOIT,LAY                                                                                                
      WRITE(6,6010) ILG1,ILAT                                                                                                       
                                                                                                                                    
C     * GET ETA LEVELS FROM VORT FILE.                                                                                              
                                                                                                                                    
      CALL FILEV(LETA,ILEV,IBUF,13)                                                                                                 
      IF((ILEV.LT.1).OR.(ILEV.GT.MAXL)) CALL       XIT('GSOMGAH',-1)                                                                
      WRITE(6,6015) ILEV,(LETA(L), L=1,ILEV)                                                                                        
C                                                                                                                                   
      CALL LVDCODE(SG,LETA,ILEV)                                                                                                    
      DO 115 L=1,ILEV                                                                                                               
        SG(L)=SG(L)*0.001E0                                                                                                         
  115 CONTINUE                                                                                                                      
                                                                                                                                    
C     * ...       AND  FROM TEMP FILE.                                                                                              
                                                                                                                                    
      CALL FILEV(LETT,ILVT,IBUF,12)                                                                                                 
      IF(ILVT.NE.ILEV) CALL                        XIT('GSOMGAH',-2)                                                                
      WRITE(6,6017) ILEV,(LETT(L), L=1,ILEV)                                                                                        
C                                                                                                                                   
      CALL LVDCODE(SH,LETT,ILEV)                                                                                                    
      DO 120 L=1,ILEV                                                                                                               
        SH(L)=SH(L)*0.001E0                                                                                                         
  120 CONTINUE                                                                                                                      
                                                                                                                                    
C     * COMPUTE BASE LAYERS FROM MID-LAYERS                                                                                         
                                                                                                                                    
      CALL BASCAL (SGB,SHB,SG,SH,ILEV,LAY)                                                                                          
                                                                                                                                    
C     * DEFINE PARAMETERS OF THE VERTICAL DISCRETIZATION                                                                            
                                                                                                                                    
      CALL COORDAB (ACG,BCG,ILEV,SG ,ICOORD,PTOIT)                                                                                  
      CALL COORDAB (ACH,BCH,ILEV,SH ,ICOORD,PTOIT)                                                                                  
      CALL COORDAB (AG ,BG ,ILEV,SGB,ICOORD,PTOIT)                                                                                  
      CALL COORDAB (AH ,BH ,ILEV,SHB,ICOORD,PTOIT)                                                                                  
                                                                                                                                    
      CALL COORDDB (DB, D2B, BG, BH, ILEV)                                                                                          
                                                                                                                                    
C     * GET THERMODYNAMIC CONSTANTS                                                                                                 
                                                                                                                                    
      CALL SPWCON7(FVORT,PI)                                                                                                        
                                                                                                                                    
C     * CALCULATE POINTERS                                                                                                          
                                                                                                                                    
      IP=2                                                                                                                          
      IC=IP+ILEV                                                                                                                    
      IT=IC+ILEV                                                                                                                    
      IU=IT+1                                                                                                                       
      IV=IU+ILEV                                                                                                                    
      IL=IV+ILEV                                                                                                                    
                                                                                                                                    
C     * CALCULATE CONSTANTS.                                                                                                        
                                                                                                                                    
      LRLMT=IBUF(7)                                                                                                                 
C     IF(LRLMT.LT.100) LRLMT=1000*IBUF(5)+10*IBUF(6)                                                                                
      IF(LRLMT.LT.100) CALL FXLRLMT (LRLMT,IBUF(5),IBUF(6),0)                                                                       
      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)                                                                                            
      CALL PRLRLMT (LA,LR,LM,KTR,LRLMT)                                                                                             
      IF(LA.GT.MAXSP) CALL                         XIT('GSOMGAH',-3)                                                                
      IF(LA*ILEV.GT.MAXMSP) CALL                   XIT('GSOMGAH',-4)                                                                
      ISP=LA+1                                                                                                                      
      ISC=(ILEV+1)*LA+1                                                                                                             
                                                                                                                                    
      CALL EPSCAL(EPSI,LSR,LM)                                                                                                      
      CALL GAUSSG(ILATH,SL,WL,CL,RADL,WOSSL)                                                                                        
      CALL  TRIGL(ILATH,SL,WL,CL,RADL,WOSSL)                                                                                        
      CALL FTSETUP(TRIGS,IFAX,ILG)                                                                                                  
C---------------------------------------------------------------------                                                              
C     * GET LN(SF PRES) FOR THE NEXT STEP. CONVERT MB TO N/M**2.                                                                    
                                                                                                                                    
      NSETS=0                                                                                                                       
  150 CALL GETFLD2(11,SP,NC4TO8("SPEC"),-1,NC4TO8("LNSP"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK)THEN                                                                                                               
        IF(NSETS.EQ.0)THEN                                                                                                          
          CALL                                     XIT('GSOMGAH',-5)                                                                
        ELSE                                                                                                                        
          WRITE(6,6030) NSETS                                                                                                       
          CALL                                     XIT('GSOMGAH',0)                                                                 
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
      IF(NSETS.EQ.0) CALL PRTLAB (IBUF)                                                                                             
      SP(1)=SP(1)+LOG(100.E0)*SQRT(2.E0)                                                                                            
                                                                                                                                    
C     * GET ILEV LEVELS OF VORTICITY AND DIVERGENCE.                                                                                
                                                                                                                                    
      NST= IBUF(2)                                                                                                                  
      CALL GETSET2 (13,SP(ISP),LEVP,ILEV,IBUF,MAXX,OK)                                                                              
      IF(.NOT.OK.OR.IBUF(2).NE.NST.OR.ILEV.GT.MAXL)                                                                                 
     1  CALL                                       XIT('GSOMGAH',-6)                                                                
      IF(NSETS.EQ.0) CALL PRTLAB (IBUF)                                                                                             
      CALL GETSET2 (14,SP(ISC),LEVC,ILEV,IBUF,MAXX,OK)                                                                              
      IF(.NOT.OK.OR.IBUF(2).NE.NST.OR.ILEV.GT.MAXL)                                                                                 
     1  CALL                                       XIT('GSOMGAH',-7)                                                                
      IF(NSETS.EQ.0) CALL PRTLAB (IBUF)                                                                                             
      DO 170 L=1,ILEV                                                                                                               
        IF(LEVP(L).NE.LETA(L).OR.LEVC(L).NE.LETA(L))                                                                                
     1       CALL                                  XIT('GSOMGAH',-L-20)                                                             
  170 CONTINUE                                                                                                                      
      IF(NSETS.EQ.0) THEN                                                                                                           
        WRITE(6,6025) ILEV,(LETT(L),L=1,ILEV)                                                                                       
      ENDIF                                                                                                                         
C---------------------------------------------------------------------                                                              
C     * CALCULATE PSI,CHI FROM VORT,DIV.                                                                                            
                                                                                                                                    
      CALL QDTFPC(SP(ISP),SP(ISC),SP(ISP),SP(ISC),                                                                                  
     1            LA,LSR,LM,ILEV,-1)                                                                                                
C                                                                                                                                   
C     *****************                                                                                                             
C     * LATITUDE LOOP *                                                                                                             
C     *****************                                                                                                             
C                                                                                                                                   
                                                                                                                                    
      DO 390 J=1,ILAT                                                                                                               
                                                                                                                                    
C     * COMPUTE ALP,DALP AND DELALP.                                                                                                
                                                                                                                                    
      CALL ALPST2(ALP,LSR,LM,SL(J),EPSI)                                                                                            
      CALL ALPDY2(DALP,ALP,LSR,LM,EPSI)                                                                                             
      CALL ALPDL2(DELALP,ALP,LSR,LM)                                                                                                
                                                                                                                                    
C     * COMPUTE GRID POINT VALUES FROM SPECTRAL COEFF.                                                                              
C     * (MOISTURE, TEMPERATURE AND TRACER ARE TURNED OFF).                                                                          
                                                                                                                                    
      CALL MHEXP5(SLICE(1,IP),SLICE(1,IC),SLICE(1,IU),SLICE(1,IV),                                                                  
     1            TG,ESG, SLICE(1,IL),SLICE(1,IT),SLICE, ILH, ILG,                                                                  
     2            SP(ISP),SP(ISC),T,ES,SP,LA,LSR,LM,ILEV, 0,P2, 0,                                                                  
     3            FVORT,ALP,DALP,DELALP,WRKS,IFAX,TRIGS,TRACG,TRAC,                                                                 
     4            0,1,LVECT)                                                                                                        
                                                                                                                                    
      DO 320 IK=1,ILG                                                                                                               
        SLICE(IK,1)=EXP(SLICE(IK,1))                                                                                                
  320 CONTINUE                                                                                                                      
                                                                                                                                    
C     * CALCULATE THE POSITION OF BASE/CENTRE LAYERS FOR THE PHYSICS.                                                               
                                                                                                                                    
      CALL LEVCAL2 (SGBJ,SHBJ,SGJ,SHJ,DSGJ,DSHJ,SHBJ1,                                                                              
     1              AG,BG,AH,BH,ACG,BCG,ACH,BCH,SLICE,                                                                              
     2              ILEV,ILEV+1,2*ILH,ILG,J,PTOIT)                                                                                  
                                                                                                                                    
                                                                                                                                    
C       * CALCULATE VERTICAL DISCRETIZATION PARAMETERS.                                                                             
                                                                                                                                    
        CALL SIGCALH (DSGJ,DSHJ,DLNSGJ,                                                                                             
     1                D1SGJ,A1SGJ,B1SGJ,                                                                                            
     2                D2SGJ,A2SGJ,B2SGJ,                                                                                            
     3                2*ILH,ILG,ILEV,                                                                                               
     4                PTOIT,                                                                                                        
     5                SLICE,AG,BG,AH,BH,ALFMOD)                                                                                     
                                                                                                                                    
C       * CONVERT WIND IMAGES, D(PS)/DX AND D(PS)/DY TO REAL VALUES.                                                                
                                                                                                                                    
        CALL IMAVRAI(SLICE(1,IU),SLICE(1,IV),SLICE(1,IL),SLICE(1,IT),                                                               
     1                                    CL(J),2*ILH,ILG,ILEV,RAYON)                                                               
                                                                                                                                    
C       * COMPUTE THE VERTICAL MOTION (NEWTONS PER SQ METER PER SEC)                                                                
C       * AT MID LAYERS.                                                                                                            
                                                                                                                                    
        CALL OMEGA3 (OMEGAG,SLICE(1,IC),SLICE(1,IU),SLICE(1,IV),                                                                    
     1               SLICE(1,IL),SLICE(1,IT),SLICE,                                                                                 
     2               SHJ, DSGJ, DSHJ, DLNSGJ,                                                                                       
     3               A1SGJ, B1SGJ, A2SGJ, B2SGJ,                                                                                    
     4               DB, VGRPSJ, SSDRJK, 2*ILH, ILG, ILEV)                                                                          
                                                                                                                                    
C                                                                                                                                   
C     * TRANSFER VERTICAL SLICE FOR LATITUDE J IN OMEGAG                                                                            
C     * TO THE MULTILEVEL GAUSSIAN GRID ARRAY GGOM.                                                                                 
                                                                                                                                    
      CALL IGGSL (GGOM,ILG1,ILAT,ILEV, OMEGAG,2*ILH,ILG, J)                                                                         
  390 CONTINUE                                                                                                                      
C---------------------------------------------------------------------                                                              
C     * WRITE OUT OMEGA ON GAUSSIAN GRIDS.                                                                                          
                                                                                                                                    
      CALL SETLAB(IBUF,NC4TO8("GRID"),NST,NC4TO8("OMEG"),0,                                                                         
     +                                   ILG1,ILAT,0,KPACK)                                                                         
      CALL PUTSET2(15,GGOM,LETT,ILEV,IBUF,MAXX)                                                                                     
      IF(NSETS.EQ.0) CALL PRTLAB (IBUF)                                                                                             
      NSETS=NSETS+1                                                                                                                 
      GO TO 150                                                                                                                     
                                                                                                                                    
C     * E.O.F. ON INPUT.                                                                                                            
                                                                                                                                    
  905 CALL                                         XIT('GSOMGAH',-8)                                                                
C--------------------------------------------------------------------                                                               
 5010 FORMAT(10X,3I5,1X,A4,E10.0,I5)                                            J4                                                  
 6000 FORMAT('0COORD= ',A4,', P.LID (PA)= ',E10.3,                                                                                  
     1                     ', INTRPL. TYPE= ',I2)                                                                                   
 6010 FORMAT('0GRID SIZE =',2I6)                                                                                                    
 6015 FORMAT(' INPUT NUMBER OF MOMENTUM       MID-LAYER POSITIONS = ',                                                              
     1       I5,' AT:',/,(10X,20I5))                                                                                                
 6017 FORMAT(' INPUT NUMBER OF THERMODYNAMICS MID-LAYER POSITIONS = ',                                                              
     1       I5,' AT:',/,(10X,20I5))                                                                                                
 6025 FORMAT(' OMEGA ON ',I3,' SIGMA LEVELS AT (*1000):',/,(15X,20I5))                                                              
 6030 FORMAT('0',I5,' SETS OF OMEGA COMPUTED')                                                                                      
      END                                                                                                                           
