      SUBROUTINE AD_MAIN ()
        IMPLICIT INTEGER (I-K), REAL (R-T), DOUBLE PRECISION (D-F), COMP
     *LEX (X-Z), CHARACTER (A-C), LOGICAL (L-N)
        
        INTEGER :: K_MA (0:24)
        INTEGER :: K_MS (0:15)
        
        INTEGER, DIMENSION (0:1) :: K_PP
        INTEGER, DIMENSION (0:3, 0:3) :: I_A
        INTEGER, DIMENSION (0:2) :: I_S
        INTEGER :: I_I
        INTEGER :: I_J
        
        LOGICAL  N_FIRSTCALL
        DATA     N_FIRSTCALL /.TRUE./
        INTEGER  ::  K_Q, K_H0, K_H1, K_H2, K_H3, K_H4, K_H5, K_H6, K_H7
     *, K_P0, K_P1 (0:0), K_P2 (0:1), K_P3 (0:2), K_P4 (0:3), K_P5 (0:4)
     *, K_P6 (0:5), K_P7 (0:6)
        COMMON /Q_PROCS/ K_Q, K_H0, K_H1, K_H2, K_H3, K_H4, K_H5, K_H6, 
     *K_H7, K_P0, K_P1, K_P2, K_P3, K_P4, K_P5, K_P6, K_P7
        
        INTEGER           ::  K_PTR, K_Z, K_TMP (0 : 299999)
        REAL              ::  T_TMP (0 : 299999)
        DOUBLE PRECISION  ::  F_TMP (0 : 149999)
        COMPLEX           ::  Z_TMP (0 : 149999)
        LOGICAL           ::  N_TMP (0 : 299999)
        EQUIVALENCE (K_TMP, T_TMP, F_TMP, Z_TMP, N_TMP)
        COMMON /Q_STACK/ K_PTR, K_Z, K_TMP
        
        K_PTR = 0
        
        CALL AD_INIT_PROCS (K_H1, 1, (/1/))
        CALL AD_PROC_COORD (K_H1, K_P1)
        CALL AD_INIT_PROCS (K_H2, 2, (/1, 1/))
        CALL AD_PROC_COORD (K_H2, K_P2)
        CALL AD_INIT_PROCS (K_H3, 3, (/1, 1, 1/))
        CALL AD_PROC_COORD (K_H3, K_P3)
        CALL AD_INIT_PROCS (K_H4, 4, (/1, 1, 1, 1/))
        CALL AD_PROC_COORD (K_H4, K_P4)
        CALL AD_INIT_PROCS (K_H5, 5, (/1, 1, 1, 1, 1/))
        CALL AD_PROC_COORD (K_H5, K_P5)
        CALL AD_INIT_PROCS (K_H6, 6, (/1, 1, 1, 1, 1, 1/))
        CALL AD_PROC_COORD (K_H6, K_P6)
        CALL AD_INIT_PROCS (K_H7, 7, (/1, 1, 1, 1, 1, 1, 1/))
        CALL AD_PROC_COORD (K_H7, K_P7)
        CALL AD_INIT_PROCS (K_HP, 2, (/3, 2/))
        CALL AD_PROC_COORD (K_HP, K_PP)
        
        K_MA = (/66, 0, K_HP, 0, 0, 6, 6, 1, 1, 4, 4, 5, 4, 6, 6, 3, 5, 
     *30, 30, 10, 10, 2, 4, 0, 1/)
        K_MS = (/73, 0, K_HP, 0, 6, 1, 3, 3, 6, 4, 30, 10, 2, 0, 0, 1/)
        
        DO 10 I_I = 1, 6
          DO 20 I_J = 1, 6
            IF (K_PP(0) == ((I_I-1)*3+5)/10 .AND. K_PP(1) == MOD(((I_J-1
     *)*5+4)/10,2)) THEN
              K_V0 = MOD((I_I-1)*3+5,10)/3
              K_V1 = MOD((I_J-1)*5+4,10)/5+((I_J-1)*5+4)/20*2
              I_A (K_V0,K_V1) = I_I*10+I_J
            ENDIF
            
   20     CONTINUE
   10   CONTINUE
        DO 30 I_I = 1, 6
          IF (K_PP(1) == 0 .AND. K_PP(0) == ((I_I-1)*4+3)/10) THEN
            K_V0 = MOD((I_I-1)*4+3,10)/4
            I_S (K_V0) = I_I-1
          ENDIF
          
   30   CONTINUE
        IF (K_P0 == 0) THEN
          PRINT "(' s...')"
        ENDIF
        K_T0 = K_PTR;   K_PTR = K_PTR + 6
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_M0 = K_PTR;   K_PTR = K_PTR + 14
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_TMP (K_M0 : K_M0+13) = (/257, 0, K_H0, 0, 6, 1, 6, 0, 6, 1, 6,
     * 6, 1, -1/)
        
        CALL AD_REMAP_II (K_TMP(K_T0), K_TMP(K_M0), I_S, K_MS)
        
        IF (K_P0 == 0) THEN
          PRINT "(10i4)", K_TMP(K_T0:K_T0+(5))
        ENDIF
        K_PTR = K_PTR - 20
        IF (K_P0 == 0) THEN
          PRINT "(' a...')"
        ENDIF
        DO 40 I_I = 1, 6
          K_T0 = K_PTR;   K_PTR = K_PTR + 6
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_M0 = K_PTR;   K_PTR = K_PTR + 14
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_TMP (K_M0 : K_M0+13) = (/257, 0, K_H0, 0, 6, 1, 6, 0, 6, 1, 
     *6, 6, 1, -1/)
          
          K_M1 = K_PTR;   K_PTR = K_PTR + 26
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_TMP (K_M1 : K_M1+8) = (/66, 0, K_HP, I_I-1, 0, -1, 6, 1, 1/)
          K_TMP (K_M1+9 : K_M1+24) = K_MA (9 : 24)
          
          CALL AD_REMAP_II (K_TMP(K_T0), K_TMP(K_M0), I_A, K_TMP(K_M1))
          K_PTR = K_PTR - 26
          
          IF (K_P0 == 0) THEN
            PRINT "(10i4)", K_TMP(K_T0:K_T0+(5))
          ENDIF
          K_PTR = K_PTR - 20
   40   CONTINUE
        K_T0 = K_PTR;   K_PTR = K_PTR + 16
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_T1 = K_PTR;   K_PTR = K_PTR + 4
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_M0 = K_PTR;   K_PTR = K_PTR + 14
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_TMP (K_M0 : K_M0+13) = (/65, 0, K_HP, 0, 6, 1, 4, 4, 6, 5, 30,
     * 10, 4, 1/)
        
        CALL AD_REMAP_II (K_TMP(K_T1), K_TMP(K_M0), I_S, K_MS)
        
        CALL AD_CSHIFT_A_I (K_TMP(K_T0), K_MA, I_A, K_MA, K_TMP(K_T1), K
     *_TMP(K_M0), 1)
        K_PTR = K_PTR - 18
        
        DO K_C1 = 0, 1
          K_V0 = K_PP(0)*10
          K_V1 = MAX((K_V0-3)/3,0)
          K_V2 = (-K_V0+K_V1*3+5)/3
          K_V3 = (K_C1*2+K_PP(1))*10
          K_V4 = MAX(K_V3/5,0)
          K_V5 = K_C1*2+(-K_V3+K_V4*5+4)/5
          K_V6 = MIN(-K_V0+20,9)/3
          K_V7 = K_C1*2+MIN(-K_V3+29,9)/5
          K_T0_1 = K_T0 + (K_V2+K_V5*4)
          DO K_1 = K_V5, K_V7
            K_T0_0 = K_T0_1
            DO K_0 = K_V2, K_V6
              I_A (K_0,K_1) = K_TMP (K_T0_0)
              K_T0_0 = K_T0_0 + (1)
            ENDDO
            K_T0_1 = K_T0_1 + (4)
          ENDDO
        ENDDO
        
        K_PTR = K_PTR - 16
        IF (K_P0 == 0) THEN
          PRINT "(' cshift...')"
        ENDIF
        DO 50 I_I = 1, 6
          K_T0 = K_PTR;   K_PTR = K_PTR + 6
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_M0 = K_PTR;   K_PTR = K_PTR + 14
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_TMP (K_M0 : K_M0+13) = (/257, 0, K_H0, 0, 6, 1, 6, 0, 6, 1, 
     *6, 6, 1, -1/)
          
          K_M1 = K_PTR;   K_PTR = K_PTR + 26
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_TMP (K_M1 : K_M1+8) = (/66, 0, K_HP, I_I-1, 0, -1, 6, 1, 1/)
          K_TMP (K_M1+9 : K_M1+24) = K_MA (9 : 24)
          
          CALL AD_REMAP_II (K_TMP(K_T0), K_TMP(K_M0), I_A, K_TMP(K_M1))
          K_PTR = K_PTR - 26
          
          IF (K_P0 == 0) THEN
            PRINT "(10i4)", K_TMP(K_T0:K_T0+(5))
          ENDIF
          K_PTR = K_PTR - 20
   50   CONTINUE
        K_T0 = K_PTR;   K_PTR = K_PTR + 16
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_T1 = K_PTR;   K_PTR = K_PTR + 4
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_M0 = K_PTR;   K_PTR = K_PTR + 14
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_TMP (K_M0 : K_M0+13) = (/65, 0, K_HP, 0, 6, 1, 4, 5, 6, 3, 30,
     * 10, 2, 0/)
        
        CALL AD_REMAP_II (K_TMP(K_T1), K_TMP(K_M0), I_S, K_MS)
        
        CALL AD_CSHIFT_A_I (K_TMP(K_T0), K_MA, I_A, K_MA, K_TMP(K_T1), K
     *_TMP(K_M0), 2)
        K_PTR = K_PTR - 18
        
        DO K_C1 = 0, 1
          K_V0 = K_PP(0)*10
          K_V1 = MAX((K_V0-3)/3,0)
          K_V2 = (-K_V0+K_V1*3+5)/3
          K_V3 = (K_C1*2+K_PP(1))*10
          K_V4 = MAX(K_V3/5,0)
          K_V5 = K_C1*2+(-K_V3+K_V4*5+4)/5
          K_V6 = MIN(-K_V0+20,9)/3
          K_V7 = K_C1*2+MIN(-K_V3+29,9)/5
          K_T0_1 = K_T0 + (K_V2+K_V5*4)
          DO K_1 = K_V5, K_V7
            K_T0_0 = K_T0_1
            DO K_0 = K_V2, K_V6
              I_A (K_0,K_1) = K_TMP (K_T0_0)
              K_T0_0 = K_T0_0 + (1)
            ENDDO
            K_T0_1 = K_T0_1 + (4)
          ENDDO
        ENDDO
        
        K_PTR = K_PTR - 16
        IF (K_P0 == 0) THEN
          PRINT "(' cshift...')"
        ENDIF
        DO 60 I_I = 1, 6
          K_T0 = K_PTR;   K_PTR = K_PTR + 6
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_M0 = K_PTR;   K_PTR = K_PTR + 14
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_TMP (K_M0 : K_M0+13) = (/257, 0, K_H0, 0, 6, 1, 6, 0, 6, 1, 
     *6, 6, 1, -1/)
          
          K_M1 = K_PTR;   K_PTR = K_PTR + 26
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_TMP (K_M1 : K_M1+8) = (/66, 0, K_HP, I_I-1, 0, -1, 6, 1, 1/)
          K_TMP (K_M1+9 : K_M1+24) = K_MA (9 : 24)
          
          CALL AD_REMAP_II (K_TMP(K_T0), K_TMP(K_M0), I_A, K_TMP(K_M1))
          K_PTR = K_PTR - 26
          
          IF (K_P0 == 0) THEN
            PRINT "(10i4)", K_TMP(K_T0:K_T0+(5))
          ENDIF
          K_PTR = K_PTR - 20
   60   CONTINUE
        K_T0 = K_PTR;   K_PTR = K_PTR + 16
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_T1 = K_PTR;   K_PTR = K_PTR + 4
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_T2 = K_PTR;   K_PTR = K_PTR + 4
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_M0 = K_PTR;   K_PTR = K_PTR + 14
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_TMP (K_M0 : K_M0+13) = (/65, 0, K_HP, 0, 6, 1, 4, 4, 6, 5, 30,
     * 10, 4, 1/)
        
        CALL AD_REMAP_II (K_TMP(K_T2), K_TMP(K_M0), I_S, K_MS)
        
        DO K_C0 = 0, 1
          K_V0 = (K_C0*2+K_PP(1))*10
          K_V1 = MAX(K_V0/5,0)
          K_V2 = K_C0*2+(-K_V0+K_V1*5+4)/5
          K_V3 = -K_V2+K_C0*2+MIN(-K_V0+29,9)/5
          K_T2_0 = K_T2 + (K_V2)
          K_T1_0 = K_T1 + (K_V2)
          DO K_0 = 0, K_V3
            K_TMP (K_T1_0) = -K_TMP (K_T2_0)
            K_T2_0 = K_T2_0 + (1)
            K_T1_0 = K_T1_0 + (1)
          ENDDO
        ENDDO
        
        CALL AD_CSHIFT_A_I (K_TMP(K_T0), K_MA, I_A, K_MA, K_TMP(K_T1), K
     *_TMP(K_M0), 1)
        K_PTR = K_PTR - 22
        
        DO K_C1 = 0, 1
          K_V0 = K_PP(0)*10
          K_V1 = MAX((K_V0-3)/3,0)
          K_V2 = (-K_V0+K_V1*3+5)/3
          K_V3 = (K_C1*2+K_PP(1))*10
          K_V4 = MAX(K_V3/5,0)
          K_V5 = K_C1*2+(-K_V3+K_V4*5+4)/5
          K_V6 = MIN(-K_V0+20,9)/3
          K_V7 = K_C1*2+MIN(-K_V3+29,9)/5
          K_T0_1 = K_T0 + (K_V2+K_V5*4)
          DO K_1 = K_V5, K_V7
            K_T0_0 = K_T0_1
            DO K_0 = K_V2, K_V6
              I_A (K_0,K_1) = K_TMP (K_T0_0)
              K_T0_0 = K_T0_0 + (1)
            ENDDO
            K_T0_1 = K_T0_1 + (4)
          ENDDO
        ENDDO
        
        K_PTR = K_PTR - 16
        IF (K_P0 == 0) THEN
          PRINT "(' cshift...')"
        ENDIF
        DO 70 I_I = 1, 6
          K_T0 = K_PTR;   K_PTR = K_PTR + 6
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_M0 = K_PTR;   K_PTR = K_PTR + 14
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_TMP (K_M0 : K_M0+13) = (/257, 0, K_H0, 0, 6, 1, 6, 0, 6, 1, 
     *6, 6, 1, -1/)
          
          K_M1 = K_PTR;   K_PTR = K_PTR + 26
          IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
          K_TMP (K_M1 : K_M1+8) = (/66, 0, K_HP, I_I-1, 0, -1, 6, 1, 1/)
          K_TMP (K_M1+9 : K_M1+24) = K_MA (9 : 24)
          
          CALL AD_REMAP_II (K_TMP(K_T0), K_TMP(K_M0), I_A, K_TMP(K_M1))
          K_PTR = K_PTR - 26
          
          IF (K_P0 == 0) THEN
            PRINT "(10i4)", K_TMP(K_T0:K_T0+(5))
          ENDIF
          K_PTR = K_PTR - 20
   70   CONTINUE
        CALL AD_DELETE_PROCS (K_HP)
        
        CALL AD_DELETE_PROCS (K_H7)
        CALL AD_DELETE_PROCS (K_H6)
        CALL AD_DELETE_PROCS (K_H5)
        CALL AD_DELETE_PROCS (K_H4)
        CALL AD_DELETE_PROCS (K_H3)
        CALL AD_DELETE_PROCS (K_H2)
        CALL AD_DELETE_PROCS (K_H1)
        CALL AD_DELETE_PROCS (K_H0)
        
      END
