      PROGRAM ENSDEV                                                                                                                
C     PROGRAM ENSDEV (MERG,        AVG,       DEV,       OUTPUT,        )       C2                                                  
C    1          TAPE1=MERG,  TAPE2=AVG, TAPE3=DEV, TAPE6=OUTPUT)                                                                    
C     ---------------------------------------------------------                 C2                                                  
C                                                                               C2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       C2                                                  
C     JUN 16/93 - S.PIGGOTT                                                                                                         
C                                                                               C2                                                  
CENSDEV  - COMPUTES DEVIATIONS FROM ENSEMBLE AVERAGES.                  2  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR  - S.PIGGOTT                                                            C3                                                  
C                                                                               C3                                                  
CPURPOSE - COMPUTES DEVIATIONS FROM ENSEMBLE AVERAGES USING FILES GENERATED BY  C3                                                  
C          THE ENSMERG AND ENSAVG PROGRAMS.                                     C3                                                  
C                                                                               C3                                                  
C          THE DEVIATIONS ARE CALCULATED BY SUBTRACTING EACH ENSEMBLE AVERAGED  C3                                                  
C          SET (OUTPUT OF THE ENSAVG PROGRAM) FROM ITS CORRESPONDING SETS IN    C3                                                  
C          THE OUTPUT FILE OF PROGRAM ENSMERG. (SEE THE ENSMERG AND ENSAVG      C3                                                  
C          PROGRAMS)                                                            C3                                                  
C                                                                               C3                                                  
CINPUT FILES...                                                                 C3                                                  
C                                                                               C3                                                  
C   MERG = MERGED FILE (OUTPUT OF ENSMERG PROGRAM) CONTAINING TIME LEVELS       C3                                                  
C          TAKEN ACROSS SEVERAL ORIGINAL FILES.                                 C3                                                  
C                                                                               C3                                                  
C    AVG = A SERIES OF SINGLE/MULTI-LEVEL ENSEMBLE AVERAGED SETS (OUTPUT OF     C3                                                  
C          ENSAVG PROGRAM). EACH SET IS THE AVERAGE OVER ALL THE SETS AT A      C3                                                  
C          PARTICULAR TIME LEVEL IN THE ABOVE MERGED FILE.                      C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C    DEV = DEVIATION FILE, CONTAINING THE DEVIATIONS FROM THE ENSEMBLE          C3                                                  
C          AVERAGES. THIS FILE WILL BE STRUCTURALLY IDENTICAL TO FILE MERG.     C3                                                  
C                                                                               C3                                                  
C          NOTE: IBOUT(2) IS ASSIGNED A POSITIVE 9-DIGIT LABEL:                 C3                                                  
C                                                                               C3                                                  
C                TTTFFFNNN                                                      C3                                                  
C                                                                               C3                                                  
C                TTT = TIME LEVEL NUMBER                                        C3                                                  
C                FFF = ORIGINAL FILE NUMBER                                     C3                                                  
C                NNN = THE TOTAL NUMBER OF ORIGINAL FILES                       C3                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK,DUN,SPEC                                                                                                           
      INTEGER KBUF(8)                                                                                                               
      INTEGER TIME,BASE                                                                                                             
C                                                                                                                                   
      COMMON/BLANCK/A(65341),G(6534100)                                                                                             
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
      COMMON/JCOM/JBUF(8),JDAT(65341)                                                                                               
      COMMON/MACHTYP/ MACHINE,INTSIZE                                                                                               
C                                                                                                                                   
      DATA MAXX/65341/,MAXLBIJ/6534100/                                                                                             
C-------------------------------------------------------------------------------                                                    
      NF=4                                                                                                                          
      CALL JCLPNT(NF,1,2,3,6)                                                                                                       
      IF(NF.LT.4) CALL                             XIT(' ENSDEV',-1)                                                                
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      MAXLEN=MAXX+8                                                                                                                 
C                                                                                                                                   
C     * NRA   = THE NUMBER OF RECORDS READ FROM FILE AVG.                                                                           
C     * NRM   = THE NUMBER OF RECORDS READ FROM FILE MERG                                                                           
C     *         EQUAL TO THE NUMBER OF RECORDS SENT TO THE OUTPUT FILE                                                              
C     * NRSET = THE NUMBER OF RECORDS READ FROM THE CURRENT SET OF FILE AVG.                                                        
C     * NTIM  = THE TIME LEVEL NUMBER.                                                                                              
C                                                                                                                                   
      NRA=0                                                                                                                         
      NRM=0                                                                                                                         
      NRSET=0                                                                                                                       
      NTIM=0                                                                                                                        
      DUN=.FALSE.                                                                                                                   
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * CHECK INPUT FILE MERG.                                                                                                      
C                                                                                                                                   
      CALL FBUFFIN(-1,IBUF,-8,K,LEN)                                                                                                
      IF(K.GE.0) CALL                              XIT(' ENSDEV',-2)                                                                
C                                                                                                                                   
C     * MAKE SURE THE FILE IS A MERGED FILE FROM THE ENSMERG                                                                        
C     * PROGRAM (IBUF(2) IS NEGATIVE IN SUCH A FILE).                                                                               
C                                                                                                                                   
      IF(IBUF(2).GE.0) CALL                        XIT(' ENSDEV',-3)                                                                
C                                                                                                                                   
C     * GET THE NUMBER OF SETS PER TIME LEVEL IN THE FILE FROM IBUF(2).                                                             
C     * (SEE THE ENSMERG PROGRAM FOR AN EXPLANATION OF THE IBUF(2) OF                                                               
C     * THE MERGED FILE.)                                                                                                           
C                                                                                                                                   
      LAB2=IABS(IBUF(2))                                                                                                            
      NNN=MOD(LAB2,1000)                                                                                                            
C                                                                                                                                   
C     * WRITE OUT THE FIRST 8 WORD LABEL OF FILE MERG TO UNIT 6.                                                                    
C                                                                                                                                   
      WRITE(6,6010)                                                                                                                 
      CALL PRTLAB(IBUF)                                                                                                             
      REWIND 1                                                                                                                      
C                                                                                                                                   
C-----------------------------------------------------------------------------                                                      
C     * CHECK INPUT FILE AVG AND SET THE VALUE OF NWDS.                                                                             
C     * SET TIME EQUAL TO JBUF(2). TIME IS USED LATER IN THE PROGRAM                                                                
C     * TO DETECT THE BEGINNING OF THE NEXT SET IN FILE AVG.                                                                        
C                                                                                                                                   
      CALL FBUFFIN(-2,JBUF,-8,K,LEN)                                                                                                
      IF(K.GE.0) CALL                              XIT(' ENSDEV',-4)                                                                
      NWDS=JBUF(5)*JBUF(6)                                                                                                          
      KIND=JBUF(1)                                                                                                                  
      SPEC=(KIND.EQ.NC4TO8("FOUR").OR.KIND.EQ.NC4TO8("SPEC"))                                                                       
      IF(SPEC) NWDS=NWDS*2                                                                                                          
      TIME=JBUF(2)                                                                                                                  
C                                                                                                                                   
C     * WRITE OUT THE FIRST 8 WORD LABEL OF FILE AVG TO UNIT 6.                                                                     
C                                                                                                                                   
      WRITE(6,6020)                                                                                                                 
      CALL PRTLAB(JBUF)                                                                                                             
      REWIND 2                                                                                                                      
C                                                                                                                                   
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * DURING THE FIRST PASS OF THE FOLLOWING LOOP, THE FIRST                                                                      
C     * SINGLE/MULTI-LEVEL SET IS READ FROM FILE AVG INTO ARRAY G.                                                                  
C     * THIS SET OF RECORDS IS SUBTRACTED FROM EACH SET IN THE FIRST                                                                
C     * TIME LEVEL OF THE MERGED FILE. THE RESULT IS A TIME LEVEL OF                                                                
C     * DEVIATIONS WHICH IS COPIED TO THE OUTPUT FILE.                                                                              
C     * THIS PROCESS (THIS LOOP) IS REPEATED FOR EVERY SINGLE/MULTI-LEVEL                                                           
C     * SET IN AVG (FOR EVERY TIME LEVEL IN MERG).                                                                                  
C                                                                                                                                   
C     * INCREMENT NTIM AND INITIALIZE NRSET TO 0 AT THE BEGINNING OF                                                                
C     * EACH PASS.                                                                                                                  
C                                                                                                                                   
  100 CONTINUE                                                                                                                      
C                                                                                                                                   
C                                                                                                                                   
      NTIM=NTIM+1                                                                                                                   
      NRSET=0                                                                                                                       
C                                                                                                                                   
C     * DURING ONE PASS OF THE FOLLOWING LOOP, ONE RECORD IS TAKEN FROM                                                             
C     * FILE AVG AND PUT INTO ARRAY G. THIS IS DONE CONTINUALLY UNTIL                                                               
C     * G HOLDS THE WHOLE CURRENT SINGLE/MULTI-LEVEL SET, DURING ONE PASS OF                                                        
C     * THE ABOVE LOOP.                                                                                                             
C                                                                                                                                   
  200 CONTINUE                                                                                                                      
      IF( (NRSET+1)*NWDS .GT. MAXLBIJ ) THEN                                                                                        
        WRITE(6,6090)                                                                                                               
        CALL                                       XIT(' ENSDEV',-5)                                                                
      ENDIF                                                                                                                         
      BASE=(NRSET)*NWDS+1                                                                                                           
      CALL GETFLD2(2,G(BASE),-1,-1,-1,-1,JBUF,MAXX,OK)                                                                              
C                                                                                                                                   
C     * IF THE END OF THE FILE IS ENCOUNTERED THEN SET LOGICAL VARIABLE DUN                                                         
C     * TRUE AND GOTO 400 TO GET THE CORRESPONDING TIME LEVEL FROM MERG                                                             
C     * AND COMPUTE THE FINAL ENSEMBLE DEVIATIONS.                                                                                  
C     * AFTER THEY ARE CALCULATED AND OUTPUTTED VARIABLE DUN WILL SIGNAL                                                            
C     * THE PROGRAM TO STOP.                                                                                                        
C                                                                                                                                   
      IF(.NOT.OK) THEN                                                                                                              
        IF(NRA.EQ.0) CALL                          XIT(' ENSDEV',-6)                                                                
        DUN=.TRUE.                                                                                                                  
        GOTO 400                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * PUT THE 8 WORD LABEL IN KBUF DURING THE FIRST PASS OF THE                                                                   
C     * PRESENT SET OF FILE AVG FOR LATER COMPARISON WITH CORRESPONDING                                                             
C     * SETS FROM FILE MERG.                                                                                                        
C                                                                                                                                   
      IF(NRSET.EQ.0) THEN                                                                                                           
        DO 300 M=1,8                                                                                                                
          KBUF(M)=JBUF(M)                                                                                                           
  300   CONTINUE                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * DECIDE IF THE CURRENT RECORD STARTS A NEW SET.                                                                              
C     * A NEW SET IS REACHED IN FILE AVG WHEN JBUF(2) CHANGES FROM                                                                  
C     * ONE RECORD TO THE NEXT.(SEE THE ENSAVG PROGRAM FOR AN EXPLANATION                                                           
C     * OF THE JBUF(2) OF THE AVG FILE.)                                                                                            
C                                                                                                                                   
C     * IF A NEW SET HAS BEEN REACHED THEN GOTO 400 TO GET THE                                                                      
C     * CORRESPONDING TIME LEVEL FROM FILE MERG AND TO CALCULATE                                                                    
C     * THE DEVIATIONS FOR THAT TIME LEVEL..                                                                                        
C                                                                                                                                   
      IF(JBUF(2).NE.TIME) THEN                                                                                                      
        TIME=JBUF(2)                                                                                                                
        BACKSPACE 2                                                                                                                 
        BACKSPACE 2                                                                                                                 
        GOTO 400                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * INCREMENT NRA AND NRSET AND GOTO 200 TO GET THE NEXT RECORD                                                                 
C     * FROM FILE AVG.                                                                                                              
C                                                                                                                                   
      NRSET=NRSET+1                                                                                                                 
      NRA=NRA+1                                                                                                                     
      GOTO 200                                                                                                                      
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * THIS PART OF THE PROGRAM GETS SETS (ONE BY ONE) FROM A PARTICULAR                                                           
C     * TIME LEVEL IN FILE MERG AND CALCULATES THEIR DEVIATIONS FROM THE                                                            
C     * CORRESPONDING ENSEMBLE AVERAGED SET WHICH HAS BEEN READ INTO                                                                
C     * ARRAY G FROM FILE AVG. THE DEVIATIONS ARE COPIED TO THE OUTPUT FILE.                                                        
C                                                                                                                                   
  400 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * DURING ONE PASS OF THE 500 DO LOOP, ONE SINGLE/MULTI-LEVEL SET                                                              
C     * IS READ FROM THE MERGED FILE, LEVEL BY LEVEL, AND ITS                                                                       
C     * DEVIATIONS ARE CALCULATED AND COPIED TO THE OUTPUT FILE.                                                                    
C     * THIS IS DONE ONCE FOR EVERY SET IN THE TIME LEVEL (NNN TIMES).                                                              
C                                                                                                                                   
      DO 500 M=1,NNN                                                                                                                
C                                                                                                                                   
C       * DURING ONE PASS OF THE 600 DO LOOP, ONE LEVEL IS READ FROM                                                                
C       * THE MERGED FILE AND ITS DEVIATIONS ARE CALCULATED AND COPIED                                                              
C       * TO THE OUTPUT FILE. THIS IS DONE ONCE FOR EVERY LEVEL IN                                                                  
C       * THE CURRENT SET (NRSET TIMES).                                                                                            
C                                                                                                                                   
        DO 600 L=1,NRSET                                                                                                            
          CALL GETFLD2(1,A,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                
          IF (.NOT.OK) CALL                        XIT( 'ENSDEV',-7)                                                                
C                                                                                                                                   
C         * COMPARE THE LABEL SAVED IN KBUF FROM FILE AVG TO THE ONES AT                                                            
C         * THE BEGINNING OF EACH CORRESPONDING SET IN FILE MERG.  IF THE                                                           
C         * RECORDS IN MERG HAVE DIFFERENT SIZE OR TYPE OR HAVE A DIFFERENT                                                         
C         * VARIABLE NAME THEN EXIT THE PROGRAM.                                                                                    
C                                                                                                                                   
          IF(L.EQ.1) THEN                                                                                                           
            CALL CMPLBL(0,KBUF,0,IBUF,OK)                                                                                           
            IF(.NOT.OK.OR.KBUF(3).NE.IBUF(3)) THEN                                                                                  
              CALL PRTLAB(KBUF)                                                                                                     
              CALL PRTLAB(IBUF)                                                                                                     
              CALL                                 XIT( 'ENSDEV',-8)                                                                
            ENDIF                                                                                                                   
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * SUBTRACT CORRESPONDING DATA IN ARRAY G FROM ARRAY A TO GIVE                                                             
C         * THE DEVIATIONS.                                                                                                         
C                                                                                                                                   
          DO 700 I=1,NWDS                                                                                                           
            K=(L-1)*NWDS+I                                                                                                          
            A(I)=A(I)-G(K)                                                                                                          
  700     CONTINUE                                                                                                                  
C                                                                                                                                   
C         * SEND THE DEVIATIONS TO THE OUTPUT FILE.                                                                                 
C         * IBUF(2) IS ASSIGNED A 9 DIGIT LABEL INDICATING THE TIME LEVEL NUMBER,                                                   
C         * THE ORIGINAL FILE NUMBER AND THE TOTAL NUMBER OF ORIGINAL FILES.                                                        
C                                                                                                                                   
          IBUF(2)=NTIM*1000000+M*1000+NNN                                                                                           
          CALL PUTFLD2(3,A,IBUF,MAXX)                                                                                               
          NRM=NRM+1                                                                                                                 
C                                                                                                                                   
  600   CONTINUE                                                                                                                    
  500 CONTINUE                                                                                                                      
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     * IF THE FLAG DUN IS TRUE THEN WRITE PROGRAM STATISTICS TO                                                                    
C     * OUTPUT AND EXIT THE PROGRAM. OTHERWISE GOTO 100 TO GET THE                                                                  
C     * NEXT SET OF RECORDS FROM THE AVG FILE.                                                                                      
C                                                                                                                                   
      IF(DUN) THEN                                                                                                                  
        WRITE(6,6030) NTIM,NNN                                                                                                      
        WRITE(6,6040) NRM                                                                                                           
        WRITE(6,6050) NTIM                                                                                                          
        WRITE(6,6060) NRA                                                                                                           
        WRITE(6,6070) NTIM,NNN                                                                                                      
        WRITE(6,6080) NRM                                                                                                           
        CALL                                       XIT(' ENSDEV',0)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
      GOTO 100                                                                                                                      
C-------------------------------------------------------------------------------                                                    
 6010 FORMAT('0  FIRST RECORD OF INPUT FILE 1:')                                                                                    
 6020 FORMAT('0  FIRST RECORD OF INPUT FILE 2:')                                                                                    
 6030 FORMAT('0  INPUT FILE 1 CONTAINS ',I7,' TIME LEVELS FROM ',                                                                   
     1        I7,' ORIGINAL FILES.')                                                                                                
 6040 FORMAT('0',I7,' RECORDS READ FROM INPUT FILE 1.')                                                                             
 6050 FORMAT('0  INPUT FILE 2 CONTAINS ',I6,' ENSEMBLE AVERAGED,',                                                                  
     1       ' SINGLE/MULTI-LEVEL SETS.')                                                                                           
 6060 FORMAT('0',I7,' RECORDS READ FROM INPUT FILE 2.')                                                                             
 6070 FORMAT('0  THE OUTPUT FILE CONTAINS ',I7,' TIME LEVELS OF ',                                                                  
     1       'DEVIATIONS',/,'   FOR ',I7,' ORIGINAL FILES.')                                                                        
 6080 FORMAT('0',I7,' RECORDS IN THE OUTPUT FILE.')                                                                                 
 6090 FORMAT('0 INSUFFICIENT ARRAY SIZE.')                                                                                          
      END                                                                                                                           
