C!hpf$ distribute t(cyclic(3), cyclic) onto p
      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:35)
        INTEGER :: K_MB (0:35)
        INTEGER :: K_MU (0:13)
        INTEGER :: K_MV (0:13)
        
        INTEGER, DIMENSION (0:3, 0:3, 0:3) :: I_A
        INTEGER, DIMENSION (0:1) :: K_PP
        INTEGER :: I_I
        INTEGER :: I_K
        INTEGER, DIMENSION (0:4, 0:1, 0:11) :: I_B
        INTEGER, DIMENSION (0:1) :: K_PQ
        INTEGER :: I_J
        INTEGER, DIMENSION (0:4) :: I_U
        INTEGER, DIMENSION (0:11) :: I_V
        
        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)
        CALL AD_INIT_PROCS (K_HQ, 2, (/2, 3/))
        CALL AD_PROC_COORD (K_HQ, K_PQ)
        
        K_MA = (/67, 0, K_HP, 0, 0, 0, 8, 4, 10, 1, 1, 1, 4, 4, 4, 0, 0,
     * 5, 8, 4, 10, 1, 1, 2, 8, 4, 24, 1, 4, 8, 4, 1, 2, 1, -1, 0/)
        K_MB = (/67, 0, K_HQ, 0, 0, 0, 6, 4, 12, 1, 1, 1, 5, 2, 12, 6, 0
     *, 0, 6, 4, 12, -1, 1, 1, 10, 4, 12, 5, 2, 12, 2, 2, 1, 0, 1, -1/)
        K_MU = (/65, 0, K_HQ, 0, 6, 1, 5, 6, 6, -1, 10, 5, 2, 0/)
        K_MV = (/129, 0, 0, 0, 12, 1, 12, 0, 12, 1, 12, 12, 1, -1/)
        
        DO 10 I_I = 1, 8
          DO 20 I_J = 1, 4
            DO 30 I_K = 1, 10
              IF (K_PP(1) == MOD(I_I-1,2) .AND. K_PP(0) == ((I_K-1)*2+5)
     */8) THEN
                K_V0 = (I_I-1)/2
                K_V1 = I_J-1
                K_V2 = MOD((I_K-1)*2+5,8)/2
                I_A (K_V0,K_V1,K_V2) = I_K+(I_I-1)*100+(I_J-1)*10-1
              ENDIF
              
   30       CONTINUE
   20     CONTINUE
   10   CONTINUE
        DO 40 I_I = 1, 6
          IF (K_PQ(0) == (-(I_I-1)+6)/5) THEN
            K_V0 = MOD((I_I-1)*5,8)
          ENDIF
          
          IF (K_PQ(0) == (-(I_I-1)+6)/5) THEN
            K_V1 = MOD(-(I_I-1)+6,5)
            I_U (K_V1) = K_V0+1
          ENDIF
          
   40   CONTINUE
        DO 50 I_K = 1, 12
          K_V0 = I_K-1
          I_V (K_V0) = (I_K-1)/2+2
          
   50   CONTINUE
        K_T0 = K_PTR;   K_PTR = K_PTR + 6
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_V0 = K_PQ(0)*5
        K_V1 = MIN(-K_V0+6,4)
        K_V2 = MAX(-K_V0+1,0)
        K_T0_0 = K_T0 + (K_V1)
        DO K_0 = K_V1, K_V2, -1
          K_TMP (K_T0_0) = I_U (K_0)-1
          K_T0_0 = K_T0_0 + (-1)
        ENDDO
        
        K_T1 = K_PTR;   K_PTR = K_PTR + 12
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_T1_0 = K_T1
        DO K_0 = 0, 11
          K_TMP (K_T1_0) = I_V (K_0)-1
          K_T1_0 = K_T1_0 + (1)
        ENDDO
        
        K_M0 = K_PTR;   K_PTR = K_PTR + 36
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_TMP (K_M0 : K_M0+11) = (/67, 0, K_HP, 0, 0, 0, -2, 4, -2, 1, 1
     *, 1/)
        K_TMP (K_M0+12 : K_M0+35) = K_MA (12 : 35)
        
        K_M1 = K_PTR;   K_PTR = K_PTR + 14
        IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
        K_TMP (K_M1 : K_M1+13) = (/257, 0, K_HQ, 0, 12, 1, 12, 0, 12, 1,
     * 12, 12, 1, -1/)
        
        CALL AD_GATHER_II (I_B, K_MB, I_A, K_TMP(K_M0), K_TMP(K_T0), K_M
     *U, K_TMP(K_T1), K_TMP(K_M1))
        K_PTR = K_PTR - 68
        
        DO 60 I_I = 1, 6
          DO 70 I_J = 1, 4
            DO 80 I_K = 1, 12
              K_V0 = I_I-1
              
              K_V1 = I_J-1
              
              K_V2 = I_K-1
              
              K_M0 = K_PTR;   K_PTR = K_PTR + 4
              IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
              K_TMP (K_M0 : K_M0+2) = (/256, 0, K_H0/)
              
              K_M1 = K_PTR;   K_PTR = K_PTR + 36
              IF (K_PTR .GT. 300000) CALL AD_STACK_ERR (300000)
              K_TMP (K_M1 : K_M1+11) = (/67, 0, K_HQ, I_I-1, I_J-1, I_K-
     *1, -1, -1, -1, 1, 1, 1/)
              K_TMP (K_M1+12 : K_M1+35) = K_MB (12 : 35)
              
              CALL AD_REMAP_II (K_V3, K_TMP(K_M0), I_B, K_TMP(K_M1))
              K_PTR = K_PTR - 36
              
              IF (K_P0 == 0) THEN
                PRINT "(i3, i3, i3, i10)", K_V0,K_V1,K_V2,K_V3
              ENDIF
              K_PTR = K_PTR - 4
   80       CONTINUE
   70     CONTINUE
   60   CONTINUE
        CALL AD_DELETE_PROCS (K_HP)
        CALL AD_DELETE_PROCS (K_HQ)
        
        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
