1 SUBROUTINE ccsdt_t3a_1_5_1(d_a,k_a_offset,d_c,k_c_offset) 2C $Id$ 3C This is a Fortran77 program generated by Tensor Contraction Engine v.1.0 4C Copyright (c) Battelle & Pacific Northwest National Laboratory (2002) 5C i2 ( h9 h11 h1 p8 )_v + = 1 * v ( h9 h11 h1 p8 )_v 6 IMPLICIT NONE 7#include "global.fh" 8#include "mafdecls.fh" 9#include "sym.fh" 10#include "errquit.fh" 11#include "tce.fh" 12 INTEGER d_a 13 INTEGER k_a_offset 14 INTEGER d_c 15 INTEGER k_c_offset 16 INTEGER NXTASK 17 INTEGER next 18 INTEGER nprocs 19 INTEGER count 20 INTEGER h9b 21 INTEGER h11b 22 INTEGER h1b 23 INTEGER p8b 24 INTEGER dimc 25 INTEGER h9b_1 26 INTEGER h11b_1 27 INTEGER h1b_1 28 INTEGER p8b_1 29 INTEGER dim_common 30 INTEGER dima_sort 31 INTEGER dima 32 INTEGER l_a_sort 33 INTEGER k_a_sort 34 INTEGER l_a 35 INTEGER k_a 36 INTEGER l_c 37 INTEGER k_c 38 LOGICAL ACOLO_1H 39 EXTERNAL NXTASK 40 nprocs = GA_NNODES() 41 count = 0 42 next = NXTASK(nprocs,1) 43 DO h9b = 1,noab 44 DO h11b = h9b,noab 45 DO h1b = 1,noab 46 DO p8b = noab+1,noab+nvab 47 IF (next.eq.count) THEN 48 IF(acolo_1h(h1b)) THEN 49 IF ((.not.restricted).or.(int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b- 50 &1)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p8b-1).ne.8)) THEN 51 IF (int_mb(k_spin+h9b-1)+int_mb(k_spin+h11b-1) .eq. int_mb(k_spin+ 52 &h1b-1)+int_mb(k_spin+p8b-1)) THEN 53 IF (ieor(int_mb(k_sym+h9b-1),ieor(int_mb(k_sym+h11b-1),ieor(int_mb 54 &(k_sym+h1b-1),int_mb(k_sym+p8b-1)))) .eq. irrep_v) THEN 55 dimc = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_mb(k_r 56 &ange+h1b-1) * int_mb(k_range+p8b-1) 57 CALL TCE_RESTRICTED_4(h9b,h11b,h1b,p8b,h9b_1,h11b_1,h1b_1,p8b_1) 58 dim_common = 1 59 dima_sort = int_mb(k_range+h9b-1) * int_mb(k_range+h11b-1) * int_m 60 &b(k_range+h1b-1) * int_mb(k_range+p8b-1) 61 dima = dim_common * dima_sort 62 IF (dima .gt. 0) THEN 63 IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a_sort,k_a_sort)) CALL 64 & ERRQUIT('ccsdt_t3_1_5_1',0,MA_ERR) 65 IF (.not.MA_PUSH_GET(mt_dbl,dima,'noname',l_a,k_a)) CALL ERRQUIT(' 66 &ccsdt_t3_1_5_1',1,MA_ERR) 67 IF ((h1b .le. p8b)) THEN 68 CALL GET_HASH_BLOCK(d_a,dbl_mb(k_a),dima,int_mb(k_a_offset),(p8b_1 69 & - 1 + (noab+nvab) * (h1b_1 - 1 + (noab+nvab) * (h11b_1 - 1 + (noa 70 &b+nvab) * (h9b_1 - 1))))) 71 CALL TCE_SORT_4(dbl_mb(k_a),dbl_mb(k_a_sort),int_mb(k_range+h9b-1) 72 &,int_mb(k_range+h11b-1),int_mb(k_range+h1b-1),int_mb(k_range+p8b-1 73 &),4,3,2,1,1.0d0) 74 END IF 75 IF (.not.MA_POP_STACK(l_a)) CALL ERRQUIT('ccsdt_t3_1_5_1',2,MA_ERR 76 &) 77 IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c)) CALL ERRQUIT(' 78 &ccsdt_t3_1_5_1',3,MA_ERR) 79 CALL TCE_SORT_4(dbl_mb(k_a_sort),dbl_mb(k_c),int_mb(k_range+p8b-1) 80 &,int_mb(k_range+h1b-1),int_mb(k_range+h11b-1),int_mb(k_range+h9b-1 81 &),4,3,2,1,1.0d0) 82 CALL ADD_HASH_BLOCK(d_c,dbl_mb(k_c),dimc,int_mb(k_c_offset),(p8b - 83 & noab - 1 + nvab * (h1b - 1 + noab * (h11b - 1 + noab * (h9b - 1)) 84 &))) 85 IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsdt_t3_1_5_1',4,MA_ERR 86 &) 87 IF (.not.MA_POP_STACK(l_a_sort)) CALL ERRQUIT('ccsdt_t3_1_5_1',5,M 88 &A_ERR) 89 END IF 90 END IF 91 END IF 92 END IF 93 END IF !active 94 next = NXTASK(nprocs,1) 95 END IF 96 count = count + 1 97 END DO 98 END DO 99 END DO 100 END DO 101 next = NXTASK(-nprocs,1) 102 call GA_SYNC() 103 RETURN 104 END 105