      PROGRAM SETDIV                                                                                                                
C     PROGRAM SETDIV (SERIES,       SET,       OUT,       OUTPUT,       )       C2                                                  
C    1          TAPE1=SERIES, TAPE2=SET, TAPE3=OUT, TAPE6=OUTPUT)                                                                   
C     -----------------------------------------------------------               C2                                                  
C                                                                               C2                                                  
C     SEP 21/09 - D. YANG (BASED ON SETMLT)                                     C2                                                  
C                                                                               C2                                                  
CSETDIV - DIVIDES FIRST FILE BY FIRST MULTI-LEVEL SET IN SECOND FILE    2  1    C1                                                  
C                                                                               C3                                                  
CAUTHOR - D. YANG                                                               C3                                                  
C                                                                               C3                                                  
CPURPOSE- DIVIDES A SERIES OF MULTI-LEVEL SETS (X) IN FILE 'SERIES' BY THE      C3                                                  
C         FIRST MULTI-LEVEL SET (Y) IN FILE 'SET' HAVING THE SAME VERTICAL      C3                                                  
C         STRUCTURE. THE RESULTS (Z=X/Y) ARE PUT IN FILE 'OUT'.                 C3                                                  
C         NOTE: (X/0=0).                                                        C3                                                  
C               THE DIVISION IS DONE LEVEL BY LEVEL.                            C3                                                  
C               MAXIMUM NUMBER OF LEVELS IS $L$.                                C3                                                  
C                                                                               C3                                                  
CINPUT FILES...                                                                 C3                                                  
C                                                                               C3                                                  
C      SERIES = SERIES OF MULTI-LEVEL SETS (DATA MAY BE REAL OR COMPLEX)        C3                                                  
C      SET    = INPUT FILE CONTAINING THE SET TO BE MULTIPLIED TO SERIES        C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C      OUT    = RESULT OF DIVISION                                              C3                                                  
C                                                                               C3                                                  
C----------------------------------------------------------------------                                                             
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/SET(1852800),F(18528)                                                                                           
                                                                                                                                    
      LOGICAL OK,SPEC                                                                                                               
      INTEGER LEV(100),KBUF(8)                                                                                                      
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      DATA MAXX,MAXG,MAXL / 18528,1852800,100/                                                                                      
C----------------------------------------------------------------------                                                             
      NF=4                                                                                                                          
      CALL JCLPNT(NF,1,2,3,6)                                                                                                       
      IF(NF.LT.4) CALL                             XIT('SETDIV',-1)                                                                 
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
                                                                                                                                    
C     * FIND FROM FILE 'SET' THE NUMBER OF LEVELS, TYPE OF DATA, ETC...                                                             
                                                                                                                                    
      CALL FILEV(LEV,NLEV,IBUF,2)                                                                                                   
      IF (NLEV.EQ.0) THEN                                                                                                           
         WRITE(6,6010)                                                                                                              
         CALL                                      XIT('SETDIV',-2)                                                                 
      ENDIF                                                                                                                         
      IF (NLEV.GT.MAXL) CALL                       XIT('SETDIV',-3)                                                                 
      WRITE(6,6005) (LEV(L),L=1,NLEV)                                                                                               
      KIND=IBUF(1)                                                                                                                  
      NAME=IBUF(3)                                                                                                                  
      SPEC=(KIND.EQ.NC4TO8("SPEC").OR.KIND.EQ.NC4TO8("FOUR"))                                                                       
      DO 50 I=1,8                                                                                                                   
         KBUF(I)=IBUF(I)                                                                                                            
 50   CONTINUE                                                                                                                      
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      IF (SPEC) NWDS=NWDS*2                                                                                                         
      NSETS=0                                                                                                                       
      IF (NWDS*NLEV.LE.MAXG) GOTO 900                                                                                               
                                                                                                                                    
C******************************************************************                                                                 
C     * CASE WHERE THE SINGLE SET DOESN'T FIT INTO ARRAY SET.                                                                       
C     * DO ONE LEVEL AT A TIME.                                                                                                     
                                                                                                                                    
 110  DO 130 L=1,NLEV                                                                                                               
                                                                                                                                    
C       * GET THE FIELD FROM FILE 'SET' FOR LEVEL LEV(L).                                                                           
                                                                                                                                    
         REWIND 2                                                                                                                   
         CALL GETFLD2(2,SET,-1,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                           
         IF (.NOT.OK) THEN                                                                                                          
            WRITE(6,6015) NAME,LEV(L)                                                                                               
            CALL                                   XIT('SETDIV',-30)                                                                
         ENDIF                                                                                                                      
                                                                                                                                    
C     * GET DATA FROM FILE 'SERIES' FOR LEVEL LEV(L) AND CHECK THE LABEL.                                                           
                                                                                                                                    
         CALL GETFLD2(1,F,KIND,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                           
         IF (.NOT.OK) THEN                                                                                                          
            IF (L.EQ.1.AND.NSET.NE.0) GO TO 940                                                                                     
            WRITE(6,6015) NAME,LEV(L)                                                                                               
            CALL                                   XIT('SETDIV',-50)                                                                
         ENDIF                                                                                                                      
         CALL CMPLBL(0,IBUF,0,KBUF,OK)                                                                                              
         IF (.NOT.OK) THEN                                                                                                          
            WRITE(6,6025) KBUF,IBUF                                                                                                 
            CALL                                   XIT('SETDIV',-70)                                                                
         ENDIF                                                                                                                      
         IF (NSETS.EQ.0) WRITE(6,6025) IBUF                                                                                         
                                                                                                                                    
C     * CALCULATE AND WRITE ONTO FILE 'OUT' THE RESULT.                                                                             
         DO 120 I=1,NWDS                                                                                                            
            IF(SET(I).EQ.0.E0) THEN                                                                                                 
              F(I)=0.E0                                                                                                             
            ELSE                                                                                                                    
              F(I)=F(I)/SET(I)                                                                                                      
            ENDIF                                                                                                                   
 120     CONTINUE                                                                                                                   
         CALL PUTFLD2(3,F,IBUF,MAXX)                                                                                                
 130  CONTINUE                                                                                                                      
      NSETS=NSETS+1                                                                                                                 
      GO TO 110                                                                                                                     
C*********************************************************************                                                              
C     * CASE WHERE ARRAY SET IS BIG ENOUGH TO HOLD ONE FULL SET.                                                                    
C     * READ THE FULL SET INTO ARRAY SET.                                                                                           
C     * STOP IF THE FILE IS EMPTY.                                                                                                  
 900  DO 905 L=1,NLEV                                                                                                               
         IW=(L-1)*NWDS+1                                                                                                            
         CALL GETFLD2(2,SET(IW),-1,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                       
         IF (.NOT.OK) THEN                                                                                                          
            WRITE(6,6015) NAME,LEV(L)                                                                                               
            CALL                                   XIT('SETDIV',-4)                                                                 
         ENDIF                                                                                                                      
 905  CONTINUE                                                                                                                      
 910   DO 930 L=1,NLEV                                                                                                              
                                                                                                                                    
C     * GET THE NEXT FIELD FROM FILE 'SERIES' AND CHECK THE LABEL.                                                                  
         CALL GETFLD2(1,F,KIND,-1,-1,LEV(L),IBUF,MAXX,OK)                                                                           
         IF (.NOT.OK) THEN                                                                                                          
            IF (L.EQ.1.AND.NSETS.NE.0) GO TO 940                                                                                    
            WRITE(6,6015) NAME,LEV(L)                                                                                               
            CALL                                   XIT('SETDIV',-5)                                                                 
         ENDIF                                                                                                                      
         CALL CMPLBL(0,IBUF,0,KBUF,OK)                                                                                              
         IF (.NOT.OK) THEN                                                                                                          
            WRITE(6,6025) KBUF,IBUF                                                                                                 
            CALL                                   XIT('SETDIV',-6)                                                                 
         ENDIF                                                                                                                      
         IF (NSETS.EQ.0) WRITE(6,6025) IBUF                                                                                         
C     * CALCULATE AND WRITE ONTO FILE 'OUT' THE RESULT.                                                                             
         IW=(L-1)*NWDS                                                                                                              
         DO 920 I=1,NWDS                                                                                                            
            IF(SET(IW+I).EQ.0.E0) THEN                                                                                              
              F(I)=0.E0                                                                                                             
            ELSE                                                                                                                    
              F(I)=F(I)/SET(IW+I)                                                                                                   
            ENDIF                                                                                                                   
 920     CONTINUE                                                                                                                   
                                                                                                                                    
         CALL PUTFLD2(3,F,IBUF,MAXX)                                                                                                
 930   CONTINUE                                                                                                                     
      NSETS=NSETS+1                                                                                                                 
                                                                                                                                    
      GO TO 910                                                                                                                     
 940  WRITE(6,6030) NSETS,NAME                                                                                                      
      CALL                                         XIT('SETDIV',0)                                                                  
C---------------------------------------------------------------------                                                              
 6005 FORMAT('0LEVELS =',20I5)                                                                                                      
 6010 FORMAT('0..SINGLE-SET FILE IS EMPTY')                                                                                         
 6015 FORMAT('0..FILE INCOMPLETE - NAME, L=',2X,A4,I5)                                                                              
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
 6030 FORMAT('0SETDIV READ',I5,'  SETS OF  ',A4/)                                                                                   
       END                                                                                                                          
