      PROGRAM VBASD                                                                                                                 
C     PROGRAM VBASD (VBIAS,       SD,       OUTPUT,                     )       H2                                                  
C    1         TAPE1=VBIAS, TAPE2=SD, TAPE6=OUTPUT)                                                                                 
C     ---------------------------------------------                             H2                                                  
C                                                                               H2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       H2                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JAN 25/85 - F. ZWIERS                                                                                                         
C                                                                               H2                                                  
CVBASD   - COMPUTES AN ESTIMATE OF POPULATION STANDARD DEVIATION                H1                                                  
C           FROM THE MEAN SQUARED DEVIATION.                            1  1    H1                                                  
C                                                                               H3                                                  
CAUTHOR  - F. ZWIERS                                                            H3                                                  
C                                                                               H3                                                  
CPURPOSE - COMPUTES AN ESTIMATE OF POPULATION STANDARD DEVIATION                H3                                                  
C          FROM THE MEAN SQUARED DEVIATION.                                     H3                                                  
C                                                                               H3                                                  
CINPUT FILE...                                                                  H3                                                  
C                                                                               H3                                                  
C      VBIAS = FILE OF GRIDS OR ZONAL PROFILES OF BIASED ESTIMATES OF           H3                                                  
C              VARIANCE ( SUMS OF SQUARED DEVIATIONS DIVIDED BY N ).            H3                                                  
C              IT IS ASSUMED THAT WORD 2 OF THE LABEL CONTAINS N.               H3                                                  
C                                                                               H3                                                  
COUTPUT FILE...                                                                 H3                                                  
C                                                                               H3                                                  
C       SD   = FILE OF GRIDS OR ZONAL PROFILES OF SQUARE ROOTS OF               H3                                                  
C              UNBIASED ESTIMATES OF THE VARIANCE (IE, THE SQUARE ROOT          H3                                                  
C              OF THE SUM OF SQUARED DEVIATIONS DIVIDED BY N-1)                 H3                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
      DIMENSION X(18528)                                                                                                            
      COMMON /ICOM/IBUF(8),IDAT(18528)                                                                                              
      DATA MAXX/18528/                                                                                                              
C     DATA NCOV/4H COV/,NSD/4H  SD/                                                                                                 
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      NCOV=NC4TO8(" COV")                                                                                                           
      NSD=NC4TO8("  SD")                                                                                                            
      NF=3                                                                                                                          
      CALL JCLPNT(NF,1,2,6)                                                                                                         
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      NREC=0                                                                                                                        
  100 CONTINUE                                                                                                                      
         CALL GETFLD2(1,X,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                 
         IF(.NOT.OK)THEN                                                                                                            
            IF(NREC.EQ.0)THEN                                                                                                       
               WRITE(6,6010)                                                                                                        
               CALL                                XIT('VBASD',-1)                                                                  
            ELSE                                                                                                                    
               CALL                                XIT('VBASD',0)                                                                   
            ENDIF                                                                                                                   
         ENDIF                                                                                                                      
         IF(IBUF(3).NE.NCOV)THEN                                                                                                    
            WRITE(6,6020)                                                                                                           
            CALL                                   XIT('VBASD',-2)                                                                  
         ENDIF                                                                                                                      
         NWDS=IBUF(5)*IBUF(6)                                                                                                       
         N=IBUF(2)                                                                                                                  
         IF(N.LE.1)THEN                                                                                                             
            NREC=NREC+1                                                                                                             
            WRITE(6,6030) NREC,IBUF                                                                                                 
            CALL                                   XIT('VBASD',-3)                                                                  
         ENDIF                                                                                                                      
         FACT=SQRT(FLOAT(N)/FLOAT(N-1))                                                                                             
         DO 150 I=1,NWDS                                                                                                            
            X(I)=FACT*SQRT(X(I))                                                                                                    
  150    CONTINUE                                                                                                                   
         IBUF(3)=NSD                                                                                                                
         CALL PUTFLD2(2,X,IBUF,MAXX)                                                                                                
         NREC=NREC+1                                                                                                                
         GOTO 100                                                                                                                   
C                                                                                                                                   
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
 6010 FORMAT('0INPUT FILE OF BIASED VARIANCE ESTIMATES WAS EMPTY.')                                                                 
 6020 FORMAT('0AN INPUT RECORD DOES NOT APPEAR TO CONTAIN VARIANCES.'/                                                              
     1       ' NAME IS NOT "COV".')                                                                                                 
 6030 FORMAT('0VARIANCES IN RECORD ',I5,' COMPUTED FROM ONLY ONE',                                                                  
     1       ' OBSERVATION - UNABLE TO COMPUTE STANDARD DEVIATION.'/                                                                
     2       ' LABEL:',1X,A4,I10,1X,A4,5I10)                                                                                        
      END                                                                                                                           
