      PROGRAM SPINVL                                                                                                                
C     PROGRAM SPINVL (SPIN,       SPOUT,       OUTPUT,                  )       E2                                                  
C    1          TAPE1=SPIN, TAPE2=SPOUT, TAPE6=OUTPUT)                                                                              
C     ------------------------------------------------                          E2                                                  
C                                                                               E2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       E2                                                  
C     FEB 25/94 - J. SHENG (BASED ON SPLINV)                                                                                        
C                                                                               E2                                                  
CSPINVL  - MULTIPLY SPECTRAL FILE BY -A**2/(N*(N+1))                    1  1   GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - J.SHENG                                                              E3                                                  
C                                                                               E3                                                  
CPURPOSE - COMPUTES THE INVERSE LAPLACIAN OF A GLOBAL SPECTRAL FILE             E3                                                  
C          BY MULTIPLYING EACH COEFF BY -A*A/(N*(N+1))                          E3                                                  
C          WHERE, A IS THE RADIUS OF THE EARTH                                  E3                                                  
C          AND    N IS THE DEGREE OF THE ASSOCIATED LEGENDRE POLYNOMIAL.        E3                                                  
C          NOTE - ALL THE INPUT RECORDS ARE SUPPOSED TO HAVE THE SAME           E3                                                  
C                 SPECTRAL DIMENSIONS.                                          E3                                                  
C                                                                               E3                                                  
CINPUT FILE...                                                                  E3                                                  
C                                                                               E3                                                  
C      SPIN  = GLOBAL SPECTRAL FIELDS                                           E3                                                  
C                                                                               E3                                                  
COUTPUT FILE...                                                                 E3                                                  
C                                                                               E3                                                  
C      SPOUT = CORRESPONDING FILE OF INVERSE LAPLACIAN OF SPIN.                 E3                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
      COMPLEX F(2210)                                                                                                               
      DIMENSION LSR(2,66),SCAL(2210)                                                                                                
                                                                                                                                    
      COMMON /ICOM/IBUF(8),IDAT(4420)                                                                                               
      DATA MAXX/4420/                                                                                                               
                                                                                                                                    
C-----------------------------------------------------------------------                                                            
      NF   = 3                                                                                                                      
      CALL JCLPNT(NF,1,2,6)                                                                                                         
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
                                                                                                                                    
      A      = 6371000.E0                                                                                                           
      ASQ    = A*A                                                                                                                  
      NRECS  = 0                                                                                                                    
                                                                                                                                    
C     * READ IN DATA.                                                                                                               
                                                                                                                                    
100   CALL GETFLD2(1,F,NC4TO8("SPEC"),-1,-1,-1,IBUF,MAXX,OK)                                                                        
          IF (.NOT.OK)                                         THEN                                                                 
              IF (NRECS.EQ.0) CALL                 XIT('SPINVL',-1)                                                                 
              WRITE(6,6030) IBUF                                                                                                    
              WRITE(6,6020) NRECS                                                                                                   
              CALL                                 XIT('SPINVL',0)                                                                  
          ENDIF                                                                                                                     
                                                                                                                                    
C         * CALCULATE MULTIPLICATIVE CONSTANTS ONCE AND FOR ALL.                                                                    
                                                                                                                                    
          IF (NRECS.EQ.0)                                      THEN                                                                 
              WRITE(6,6030) IBUF                                                                                                    
              CALL DIMGT(LSR,LA,LR,LM,KTR,IBUF(7))                                                                                  
                                                                                                                                    
              DO 200 M=1,LM                                                                                                         
                  NN                     = LSR(1,M+1)-LSR(1,M)                                                                      
                  DO 200 J=1,NN                                                                                                     
                      N                  = M+J-2                                                                                    
                      DEN                = FLOAT(N*(N+1))                                                                           
                      SCAL(LSR(1,M)-1+J) = DEN/ASQ                                                                                  
  200         CONTINUE                                                                                                              
                                                                                                                                    
              DO 250 L=2,LA                                                                                                         
                  SCAL(L) = -1.E0/SCAL(L)                                                                                           
  250         CONTINUE                                                                                                              
          ENDIF                                                                                                                     
                                                                                                                                    
C         * DO THE CONVERSION.                                                                                                      
                                                                                                                                    
          F(1) = CMPLX(0.0E0,0.0E0)                                                                                                 
          DO 300 L=2,LA                                                                                                             
              F(L) = CMPLX( REAL(F(L))*SCAL(L),  IMAG(F(L))*SCAL(L))                                                                
  300     CONTINUE                                                                                                                  
                                                                                                                                    
C         * SAVE RECORD UNDER THE NAME INVL.                                                                                        
                                                                                                                                    
          IBUF(3) = NC4TO8("INVL")                                                                                                  
          CALL PUTFLD2 (2,F,IBUF,MAXX)                                                                                              
          NRECS   = NRECS+1                                                                                                         
                                                                                                                                    
      GOTO 100                                                                                                                      
C-----------------------------------------------------------------------                                                            
6020  FORMAT('0SPINVL COMPUTED ',I5,' RECORDS')                                                                                     
6030  FORMAT(2X,A4,I10,1X,A4,I10,4I6)                                                                                               
      END                                                                                                                           
