← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/tce/ccsd/ccsd_t1.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
http://bugs.debian.org/696361
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/tce/ccsd/ccsd_t1.F
1
1
      SUBROUTINE ccsd_t1(d_f1,d_i0,d_t1,d_t2,d_v2,k_f1_offset,k_i0_offse
2
2
     &t,k_t1_offset,k_t2_offset,k_v2_offset)
3
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
3
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
4
4
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
5
5
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
6
6
C     i0 ( p2 h1 )_f + = 1 * f ( p2 h1 )_f                                                         DONE
125
125
 
126
126
 
127
127
      SUBROUTINE ccsd_t1_1(d_a,k_a_offset,d_c,k_c_offset)
128
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
128
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
129
129
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
130
130
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
131
131
C     i0 ( p2 h1 )_f + = 1 * f ( p2 h1 )_f
147
147
      next = NXTASK(nprocs, 1)
148
148
      DO p2b = noab+1,noab+nvab
149
149
       DO h1b = 1,noab
150
 
        IF (next.eq.count) THEN
151
150
         IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)
152
151
     1                            +int_mb(k_spin+h1b-1).ne.4)) THEN
153
152
          IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN
154
153
           IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)) 
155
154
     1         .eq. irrep_f) THEN
 
155
        IF (next.eq.count) THEN
156
156
            dimc = int_mb(k_range+p2b-1) * int_mb(k_range+h1b-1)
157
157
            CALL TCE_RESTRICTED_2(p2b,h1b,p2b_1,h1b_1)
158
158
            dim_common = 1
170
170
             IF (.not.MA_POP_STACK(l_a)) 
171
171
     1            CALL ERRQUIT('ccsd_t1_1',5,MA_ERR)
172
172
            END IF
 
173
         next = NXTASK(nprocs, 1)
 
174
        END IF
 
175
        count = count + 1
173
176
           END IF
174
177
          END IF
175
178
         END IF
176
 
         next = NXTASK(nprocs, 1)
177
 
        END IF
178
 
        count = count + 1
179
179
       END DO
180
180
      END DO
181
181
      next = NXTASK(-nprocs, 1)
187
187
 
188
188
 
189
189
      SUBROUTINE ccsd_t1_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset)
190
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
190
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
191
191
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
192
192
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
193
193
C     i0 ( p2 h1 )_tf + = -1 * Sum ( h7 ) * t ( p2 h7 )_t * i1 ( h7 h1 )_f
211
211
      next = NXTASK(nprocs, 1)
212
212
      DO p2b = noab+1,noab+nvab
213
213
       DO h1b = 1,noab
214
 
        IF (next.eq.count) THEN
 
214
ccx        IF (next.eq.count) THEN
215
215
         IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)
216
216
     1                            +int_mb(k_spin+h1b-1).ne.4)) THEN
217
217
          IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN
218
218
           IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)).eq.
219
219
     1         ieor(irrep_t,irrep_f)) THEN
 
220
        IF (next.eq.count) THEN
220
221
            dimc = int_mb(k_range+p2b-1) * int_mb(k_range+h1b-1)
221
222
            IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs))
222
223
     1           CALL ERRQUIT('ccsd_t1_2',0,MA_ERR)
272
273
     1           CALL ERRQUIT('ccsd_t1_2',10,MA_ERR)
273
274
            IF (.not.MA_POP_STACK(l_cs))
274
275
     1           CALL ERRQUIT('ccsd_t1_2',11,MA_ERR)
 
276
         next = NXTASK(nprocs, 1)
 
277
        END IF
 
278
        count = count + 1
275
279
           END IF
276
280
          END IF
277
281
         END IF
278
 
         next = NXTASK(nprocs, 1)
279
 
        END IF
280
 
        count = count + 1
281
282
       END DO
282
283
      END DO
283
284
      next = NXTASK(-nprocs, 1)
289
290
 
290
291
 
291
292
      SUBROUTINE ccsd_t1_2_1(d_a,k_a_offset,d_c,k_c_offset)
292
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
293
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
293
294
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
294
295
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
295
296
C     i1 ( h7 h1 )_f + = 1 * f ( h7 h1 )_f
311
312
      next = NXTASK(nprocs, 1)
312
313
      DO h7b = 1,noab
313
314
       DO h1b = 1,noab
314
 
        IF (next.eq.count) THEN
315
315
         IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)
316
316
     1                            +int_mb(k_spin+h1b-1).ne.4)) THEN
317
317
          IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+h1b-1)) THEN
318
318
           IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+h1b-1)) 
319
319
     1         .eq. irrep_f) THEN
 
320
        IF (next.eq.count) THEN
320
321
            dimc = int_mb(k_range+h7b-1) * int_mb(k_range+h1b-1)
321
322
            CALL TCE_RESTRICTED_2(h7b,h1b,h7b_1,h1b_1)
322
323
            dim_common = 1
347
348
             IF (.not.MA_POP_STACK(l_as))
348
349
     1            CALL ERRQUIT('ccsd_t1_2_1',5,MA_ERR)
349
350
            END IF
 
351
         next = NXTASK(nprocs, 1)
 
352
         END IF
 
353
         count = count + 1
350
354
           END IF
351
355
          END IF
352
356
         END IF
353
 
         next = NXTASK(nprocs, 1)
354
 
        END IF
355
 
        count = count + 1
356
357
       END DO
357
358
      END DO
358
359
      next = NXTASK(-nprocs, 1)
364
365
 
365
366
 
366
367
      SUBROUTINE OFFSET_ccsd_t1_2_1(l_a_offset,k_a_offset,size)
367
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
368
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
368
369
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
369
370
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
370
371
C     i1 ( h7 h1 )_f
425
426
 
426
427
      SUBROUTINE ccsd_t1_2_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
427
428
     &t)
428
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
429
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
429
430
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
430
431
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
431
432
C     i1 ( h7 h1 )_ft + = 1 * Sum ( p3 ) * t ( p3 h1 )_t * i2 ( h7 p3 )_f
449
450
      next = NXTASK(nprocs, 1)
450
451
      DO h7b = 1,noab
451
452
       DO h1b = 1,noab
452
 
        IF (next.eq.count) THEN
453
453
         IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)
454
454
     1                            +int_mb(k_spin+h1b-1).ne.4)) THEN
455
455
          IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+h1b-1)) THEN
456
456
           IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+h1b-1)) 
457
457
     1         .eq. ieor(irrep_f,irrep_t)) THEN
 
458
        IF (next.eq.count) THEN
458
459
            dimc = int_mb(k_range+h7b-1) * int_mb(k_range+h1b-1)
459
460
            IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_c,k_c))
460
461
     1           CALL ERRQUIT('ccsd_t1_2_2',0,MA_ERR)
503
504
     1           int_mb(k_c_offset),(h1b - 1 + noab * (h7b - 1)))
504
505
            IF (.not.MA_POP_STACK(l_c))
505
506
     1           CALL ERRQUIT('ccsd_t1_2_2',10,MA_ERR)
 
507
        next = NXTASK(nprocs, 1)
 
508
        END IF
 
509
        count = count + 1
506
510
           END IF
507
511
          END IF
508
512
         END IF
509
 
         next = NXTASK(nprocs, 1)
510
 
        END IF
511
 
        count = count + 1
512
513
       END DO
513
514
      END DO
514
515
      next = NXTASK(-nprocs, 1)
520
521
 
521
522
 
522
523
      SUBROUTINE ccsd_t1_2_2_1(d_a,k_a_offset,d_c,k_c_offset)
523
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
524
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
524
525
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
525
526
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
526
527
C     i2 ( h7 p3 )_f + = 1 * f ( h7 p3 )_f
542
543
      next = NXTASK(nprocs, 1)
543
544
      DO h7b = 1,noab
544
545
       DO p3b = noab+1,noab+nvab
545
 
        IF (next.eq.count) THEN
546
546
         IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)
547
547
     1                            +int_mb(k_spin+p3b-1).ne.4)) THEN
548
548
          IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+p3b-1)) THEN
549
549
           IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+p3b-1))
550
550
     1         .eq. irrep_f) THEN
 
551
        IF (next.eq.count) THEN
551
552
            dimc = int_mb(k_range+h7b-1) * int_mb(k_range+p3b-1)
552
553
            CALL TCE_RESTRICTED_2(h7b,p3b,h7b_1,p3b_1)
553
554
            IF (dimc .gt. 0) THEN
562
563
             IF (.not.MA_POP_STACK(l_a))
563
564
     1            CALL ERRQUIT('ccsd_t1_2_2_1',5,MA_ERR)
564
565
            END IF
 
566
        next = NXTASK(nprocs, 1)
 
567
        END IF
 
568
        count = count + 1
565
569
           END IF
566
570
          END IF
567
571
         END IF
568
 
         next = NXTASK(nprocs, 1)
569
 
        END IF
570
 
        count = count + 1
571
572
       END DO
572
573
      END DO
573
574
      next = NXTASK(-nprocs, 1)
579
580
 
580
581
 
581
582
      SUBROUTINE OFFSET_ccsd_t1_2_2_1(l_a_offset,k_a_offset,size)
582
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
583
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
583
584
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
584
585
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
585
586
C     i2 ( h7 p3 )_f
640
641
 
641
642
      SUBROUTINE ccsd_t1_2_2_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_off
642
643
     &set)
643
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
644
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
644
645
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
645
646
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
646
647
C     i2 ( h7 p3 )_vt + = -1 * Sum ( h6 p5 ) * t ( p5 h6 )_t * v ( h6 h7 p3 p5 )_v
664
665
      next = NXTASK(nprocs, 1)
665
666
      DO h7b = 1,noab
666
667
       DO p3b = noab+1,noab+nvab
667
 
        IF (next.eq.count) THEN
668
668
         IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)
669
669
     1                            +int_mb(k_spin+p3b-1).ne.4)) THEN
670
670
          IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+p3b-1)) THEN
671
671
           IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+p3b-1)) 
672
672
     1         .eq. ieor(irrep_v,irrep_t)) THEN
 
673
        IF (next.eq.count) THEN
673
674
            dimc = int_mb(k_range+h7b-1) * int_mb(k_range+p3b-1)
674
675
            IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs))
675
676
     1           CALL ERRQUIT('ccsd_t1_2_2_2',0,MA_ERR)
804
805
     1           CALL ERRQUIT('ccsd_t1_2_2_2',10,MA_ERR)
805
806
            IF (.not.MA_POP_STACK(l_cs))
806
807
     1           CALL ERRQUIT('ccsd_t1_2_2_2',11,MA_ERR)
 
808
        next = NXTASK(nprocs, 1)
 
809
        END IF
 
810
        count = count + 1
807
811
           END IF
808
812
          END IF
809
813
         END IF
810
 
         next = NXTASK(nprocs, 1)
811
 
        END IF
812
 
        count = count + 1
813
814
       END DO
814
815
      END DO
815
816
      next = NXTASK(-nprocs, 1)
818
819
      END
819
820
      SUBROUTINE ccsd_t1_2_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
820
821
     &t)
821
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
822
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
822
823
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
823
824
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
824
825
C     i1 ( h7 h1 )_vt + = -1 * Sum ( h5 p4 ) * t ( p4 h5 )_t * v ( h5 h7 h1 p4 )_v
872
873
      next = NXTASK(nprocs, 1)
873
874
      DO h7b = 1,noab
874
875
      DO h1b = 1,noab
875
 
      IF (next.eq.count) THEN
876
876
      IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h1b-1
877
877
     &).ne.4)) THEN
878
878
      IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+h1b-1)) THEN
879
879
      IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
880
880
     &v,irrep_t)) THEN
 
881
      IF (next.eq.count) THEN
881
882
      dimc = int_mb(k_range+h7b-1) * int_mb(k_range+h1b-1)
882
883
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs)) CALL
883
884
     & ERRQUIT('ccsd_t1_2_3',0,MA_ERR)
961
962
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsd_t1_2_3',10,MA_ERR)
962
963
      IF (.not.MA_POP_STACK(l_cs)) CALL ERRQUIT('ccsd_t1_2_3',11,MA_
963
964
     &ERR)
964
 
      END IF
965
 
      END IF
966
 
      END IF
967
965
      next = NXTASK(nprocs, 1)
968
966
      END IF
969
967
      count = count + 1
 
968
      END IF
 
969
      END IF
 
970
      END IF
970
971
      END DO
971
972
      END DO
972
973
      next = NXTASK(-nprocs, 1)
975
976
      END
976
977
      SUBROUTINE ccsd_t1_2_4(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
977
978
     &t)
978
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
979
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
979
980
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
980
981
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
981
982
C     i1 ( h7 h1 )_vt + = -1/2 * Sum ( h5 p3 p4 ) * t ( p3 p4 h1 h5 )_t * v ( h5 h7 p3 p4 )_v
1036
1037
      next = NXTASK(nprocs, 1)
1037
1038
      DO h7b = 1,noab
1038
1039
      DO h1b = 1,noab
1039
 
      IF (next.eq.count) THEN
1040
1040
      IF ((.not.restricted).or.(int_mb(k_spin+h7b-1)+int_mb(k_spin+h1b-1
1041
1041
     &).ne.4)) THEN
1042
1042
      IF (int_mb(k_spin+h7b-1) .eq. int_mb(k_spin+h1b-1)) THEN
1043
1043
      IF (ieor(int_mb(k_sym+h7b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
1044
1044
     &v,irrep_t)) THEN
 
1045
      IF (next.eq.count) THEN
1045
1046
      dimc = int_mb(k_range+h7b-1) * int_mb(k_range+h1b-1)
1046
1047
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs)) CALL
1047
1048
     & ERRQUIT('ccsd_t1_2_4',0,MA_ERR)
1148
1149
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsd_t1_2_4',10,MA_ERR)
1149
1150
      IF (.not.MA_POP_STACK(l_cs)) CALL ERRQUIT('ccsd_t1_2_4',11,MA_
1150
1151
     &ERR)
1151
 
      END IF
1152
 
      END IF
1153
 
      END IF
1154
1152
      next = NXTASK(nprocs, 1)
1155
1153
      END IF
1156
1154
      count = count + 1
 
1155
      END IF
 
1156
      END IF
 
1157
      END IF
1157
1158
      END DO
1158
1159
      END DO
1159
1160
      next = NXTASK(-nprocs, 1)
1166
1167
 
1167
1168
 
1168
1169
      SUBROUTINE ccsd_t1_3(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset)
1169
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1170
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1170
1171
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1171
1172
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1172
1173
C     i0 ( p2 h1 )_tf + = 1 * Sum ( p3 ) * t ( p3 h1 )_t * i1 ( p2 p3 )_f
1194
1195
      next = NXTASK(nprocs, 1)
1195
1196
      DO p2b = noab+1,noab+nvab
1196
1197
       DO h1b = 1,noab
1197
 
        IF (next.eq.count) THEN
1198
1198
         IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)
1199
1199
     1                            +int_mb(k_spin+h1b-1).ne.4)) THEN
1200
1200
          IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN
1201
1201
           IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)) .eq. 
1202
1202
     1         ieor(irrep_t,irrep_f)) THEN
 
1203
        IF (next.eq.count) THEN
1203
1204
            dimc = int_mb(k_range+p2b-1) * int_mb(k_range+h1b-1)
1204
1205
            IF (.not.MA_PUSH_GET(mt_dbl,dimc,'c',l_c,k_c))
1205
1206
     1           CALL ERRQUIT('ccsd_t1_3',0,MA_ERR)
1258
1259
     2           (h1b - 1 + noab * (p2b - noab - 1)))
1259
1260
            IF (.not.MA_POP_STACK(l_c))
1260
1261
     1           CALL ERRQUIT('ccsd_t1_3',10,MA_ERR)
 
1262
        next = NXTASK(nprocs, 1)
 
1263
        END IF
 
1264
        count = count + 1
1261
1265
           END IF
1262
1266
          END IF
1263
1267
         END IF
1264
 
         next = NXTASK(nprocs, 1)
1265
 
        END IF
1266
 
        count = count + 1
1267
1268
       END DO
1268
1269
      END DO
1269
1270
      next = NXTASK(-nprocs, 1)
1277
1278
 
1278
1279
 
1279
1280
      SUBROUTINE ccsd_t1_3_1(d_a,k_a_offset,d_c,k_c_offset)
1280
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1281
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1281
1282
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1282
1283
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1283
1284
C     i1 ( p2 p3 )_f + = 1 * f ( p2 p3 )_f
1299
1300
      next = NXTASK(nprocs, 1)
1300
1301
      DO p2b = noab+1,noab+nvab
1301
1302
       DO p3b = noab+1,noab+nvab
1302
 
        IF (next.eq.count) THEN
1303
1303
         IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)
1304
1304
     1                            +int_mb(k_spin+p3b-1).ne.4)) THEN
1305
1305
          IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+p3b-1)) THEN
1306
1306
           IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+p3b-1)) 
1307
1307
     1         .eq. irrep_f) THEN
 
1308
        IF (next.eq.count) THEN
1308
1309
            CALL TCE_RESTRICTED_2(p2b,p3b,p2b_1,p3b_1)
1309
1310
            dima = int_mb(k_range+p2b-1) * int_mb(k_range+p3b-1)
1310
1311
            IF (dima .gt. 0) THEN
1319
1320
             IF (.not.MA_POP_STACK(l_a)) 
1320
1321
     1            CALL ERRQUIT('ccsd_t1_3_1',5,MA_ERR)
1321
1322
            END IF
 
1323
        next = NXTASK(nprocs, 1)
 
1324
        END IF
 
1325
        count = count + 1
1322
1326
           END IF
1323
1327
          END IF
1324
1328
         END IF
1325
 
        next = NXTASK(nprocs, 1)
1326
 
        END IF
1327
 
       count = count + 1
1328
1329
       END DO
1329
1330
      END DO
1330
1331
      next = NXTASK(-nprocs, 1)
1337
1338
 
1338
1339
 
1339
1340
      SUBROUTINE OFFSET_ccsd_t1_3_1(l_a_offset,k_a_offset,size)
1340
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1341
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1341
1342
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1342
1343
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1343
1344
C     i1 ( p2 p3 )_f
1393
1394
      END
1394
1395
      SUBROUTINE ccsd_t1_3_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
1395
1396
     &t)
1396
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1397
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1397
1398
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1398
1399
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1399
1400
C     i1 ( p2 p3 )_vt + = -1 * Sum ( h5 p4 ) * t ( p4 h5 )_t * v ( h5 p2 p3 p4 )_v
1447
1448
      next = NXTASK(nprocs, 1)
1448
1449
      DO p2b = noab+1,noab+nvab
1449
1450
      DO p3b = noab+1,noab+nvab
1450
 
      IF (next.eq.count) THEN
1451
1451
      IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)+int_mb(k_spin+p3b-1
1452
1452
     &).ne.4)) THEN
1453
1453
      IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+p3b-1)) THEN
1454
1454
      IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+p3b-1)) .eq. ieor(irrep_
1455
1455
     &v,irrep_t)) THEN
 
1456
      IF (next.eq.count) THEN
1456
1457
      dimc = int_mb(k_range+p2b-1) * int_mb(k_range+p3b-1)
1457
1458
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs)) CALL
1458
1459
     & ERRQUIT('ccsd_t1_3_2',0,MA_ERR)
1536
1537
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsd_t1_3_2',10,MA_ERR)
1537
1538
      IF (.not.MA_POP_STACK(l_cs)) CALL ERRQUIT('ccsd_t1_3_2',11,MA_
1538
1539
     &ERR)
1539
 
      END IF
1540
 
      END IF
1541
 
      END IF
1542
1540
      next = NXTASK(nprocs, 1)
1543
1541
      END IF
1544
1542
      count = count + 1
 
1543
      END IF
 
1544
      END IF
 
1545
      END IF
1545
1546
      END DO
1546
1547
      END DO
1547
1548
      next = NXTASK(-nprocs, 1)
1549
1550
      RETURN
1550
1551
      END
1551
1552
      SUBROUTINE ccsd_t1_4(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset)
1552
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1553
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1553
1554
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1554
1555
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1555
1556
C     i0 ( p2 h1 )_vt + = -1 * Sum ( h4 p3 ) * t ( p3 h4 )_t * v ( h4 p2 h1 p3 )_v
1603
1604
      next = NXTASK(nprocs, 1)
1604
1605
      DO p2b = noab+1,noab+nvab
1605
1606
      DO h1b = 1,noab
1606
 
      IF (next.eq.count) THEN
1607
1607
      IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)+int_mb(k_spin+h1b-1
1608
1608
     &).ne.4)) THEN
1609
1609
      IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN
1610
1610
      IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
1611
1611
     &v,irrep_t)) THEN
 
1612
      IF (next.eq.count) THEN
1612
1613
      dimc = int_mb(k_range+p2b-1) * int_mb(k_range+h1b-1)
1613
1614
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs)) CALL
1614
1615
     & ERRQUIT('ccsd_t1_4',0,MA_ERR)
1677
1678
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsd_t1_4',10,MA_ERR)
1678
1679
      IF (.not.MA_POP_STACK(l_cs)) CALL ERRQUIT('ccsd_t1_4',11,MA_ER
1679
1680
     &R)
1680
 
      END IF
1681
 
      END IF
1682
 
      END IF
1683
1681
      next = NXTASK(nprocs, 1)
1684
1682
      END IF
1685
1683
      count = count + 1
 
1684
      END IF
 
1685
      END IF
 
1686
      END IF
1686
1687
      END DO
1687
1688
      END DO
1688
1689
      next = NXTASK(-nprocs, 1)
1694
1695
 
1695
1696
 
1696
1697
      SUBROUTINE ccsd_t1_5(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset)
1697
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1698
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1698
1699
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1699
1700
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1700
1701
C     i0 ( p2 h1 )_tf + = 1 * Sum ( p7 h8 ) * t ( p2 p7 h1 h8 )_t * i1 ( h8 p7 )_f
1717
1718
      next = NXTASK(nprocs, 1)
1718
1719
      DO p2b = noab+1,noab+nvab
1719
1720
       DO h1b = 1,noab
1720
 
        IF (next.eq.count) THEN
1721
1721
         IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)
1722
1722
     1                            +int_mb(k_spin+h1b-1).ne.4)) THEN
1723
1723
          IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN
1724
1724
           IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)) 
1725
1725
     1         .eq. ieor(irrep_t,irrep_f)) THEN
 
1726
         IF (next.eq.count) THEN
1726
1727
            dimc = int_mb(k_range+p2b-1) * int_mb(k_range+h1b-1)
1727
1728
            IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs))
1728
1729
     1           CALL ERRQUIT('ccsd_t1_5',0,MA_ERR)
1820
1821
     1           CALL ERRQUIT('ccsd_t1_5',10,MA_ERR)
1821
1822
            IF (.not.MA_POP_STACK(l_cs))
1822
1823
     1           CALL ERRQUIT('ccsd_t1_5',11,MA_ERR)
 
1824
        next = NXTASK(nprocs, 1)
 
1825
        END IF
 
1826
        count = count + 1
1823
1827
           END IF
1824
1828
          END IF
1825
1829
         END IF
1826
 
         next = NXTASK(nprocs, 1)
1827
 
        END IF
1828
 
        count = count + 1
1829
1830
       END DO
1830
1831
      END DO
1831
1832
      next = NXTASK(-nprocs, 1)
1839
1840
 
1840
1841
 
1841
1842
      SUBROUTINE ccsd_t1_5_1(d_a,k_a_offset,d_c,k_c_offset)
1842
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1843
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1843
1844
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1844
1845
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1845
1846
C     i1 ( h8 p7 )_f + = 1 * f ( h8 p7 )_f
1861
1862
      next = NXTASK(nprocs, 1)
1862
1863
      DO h8b = 1,noab
1863
1864
       DO p7b = noab+1,noab+nvab
1864
 
        IF (next.eq.count) THEN
1865
1865
         IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)
1866
1866
     1                            +int_mb(k_spin+p7b-1).ne.4)) THEN
1867
1867
          IF (int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+p7b-1)) THEN
1868
1868
           IF (ieor(int_mb(k_sym+h8b-1),int_mb(k_sym+p7b-1)) 
1869
1869
     1         .eq. irrep_f) THEN
 
1870
         IF (next.eq.count) THEN
1870
1871
            dimc = int_mb(k_range+h8b-1) * int_mb(k_range+p7b-1)
1871
1872
            CALL TCE_RESTRICTED_2(h8b,p7b,h8b_1,p7b_1)
1872
1873
            IF (dimc .gt. 0) THEN
1881
1882
             IF (.not.MA_POP_STACK(l_a))
1882
1883
     1            CALL ERRQUIT('ccsd_t1_5_1',5,MA_ERR)
1883
1884
            END IF
 
1885
         next = NXTASK(nprocs, 1)
 
1886
         END IF
 
1887
         count = count + 1
1884
1888
           END IF
1885
1889
          END IF
1886
1890
         END IF
1887
 
         next = NXTASK(nprocs, 1)
1888
 
        END IF
1889
 
        count = count + 1
1890
1891
       END DO
1891
1892
      END DO
1892
1893
      next = NXTASK(-nprocs, 1)
1898
1899
 
1899
1900
 
1900
1901
      SUBROUTINE OFFSET_ccsd_t1_5_1(l_a_offset,k_a_offset,size)
1901
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1902
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1902
1903
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1903
1904
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1904
1905
C     i1 ( h8 p7 )_f
1954
1955
      END
1955
1956
      SUBROUTINE ccsd_t1_5_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
1956
1957
     &t)
1957
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
1958
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
1958
1959
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
1959
1960
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
1960
1961
C     i1 ( h8 p7 )_vt + = 1 * Sum ( h6 p5 ) * t ( p5 h6 )_t * v ( h6 h8 p5 p7 )_v
2008
2009
      next = NXTASK(nprocs, 1)
2009
2010
      DO h8b = 1,noab
2010
2011
      DO p7b = noab+1,noab+nvab
2011
 
      IF (next.eq.count) THEN
2012
2012
      IF ((.not.restricted).or.(int_mb(k_spin+h8b-1)+int_mb(k_spin+p7b-1
2013
2013
     &).ne.4)) THEN
2014
2014
      IF (int_mb(k_spin+h8b-1) .eq. int_mb(k_spin+p7b-1)) THEN
2015
2015
      IF (ieor(int_mb(k_sym+h8b-1),int_mb(k_sym+p7b-1)) .eq. ieor(irrep_
2016
2016
     &v,irrep_t)) THEN
 
2017
      IF (next.eq.count) THEN
2017
2018
      dimc = int_mb(k_range+h8b-1) * int_mb(k_range+p7b-1)
2018
2019
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs)) CALL
2019
2020
     & ERRQUIT('ccsd_t1_5_2',0,MA_ERR)
2127
2128
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsd_t1_5_2',10,MA_ERR)
2128
2129
      IF (.not.MA_POP_STACK(l_cs)) CALL ERRQUIT('ccsd_t1_5_2',11,MA_
2129
2130
     &ERR)
2130
 
      END IF
2131
 
      END IF
2132
 
      END IF
2133
2131
      next = NXTASK(nprocs, 1)
2134
2132
      END IF
2135
2133
      count = count + 1
 
2134
      END IF
 
2135
      END IF
 
2136
      END IF
2136
2137
      END DO
2137
2138
      END DO
2138
2139
      next = NXTASK(-nprocs, 1)
2140
2141
      RETURN
2141
2142
      END
2142
2143
      SUBROUTINE ccsd_t1_6(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset)
2143
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
2144
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
2144
2145
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2145
2146
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2146
2147
C     i0 ( p2 h1 )_vt + = -1/2 * Sum ( h4 h5 p3 ) * t ( p2 p3 h4 h5 )_t * i1 ( h4 h5 h1 p3 )_v
2201
2202
      next = NXTASK(nprocs, 1)
2202
2203
      DO p2b = noab+1,noab+nvab
2203
2204
      DO h1b = 1,noab
2204
 
      IF (next.eq.count) THEN
2205
2205
      IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)+int_mb(k_spin+h1b-1
2206
2206
     &).ne.4)) THEN
2207
2207
      IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN
2208
2208
      IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)) .eq. ieor(irrep_
2209
2209
     &v,irrep_t)) THEN
 
2210
      IF (next.eq.count) THEN
2210
2211
      dimc = int_mb(k_range+p2b-1) * int_mb(k_range+h1b-1)
2211
2212
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs)) CALL
2212
2213
     & ERRQUIT('ccsd_t1_6',0,MA_ERR)
2290
2291
      IF (.not.MA_POP_STACK(l_c)) CALL ERRQUIT('ccsd_t1_6',10,MA_ERR)
2291
2292
      IF (.not.MA_POP_STACK(l_cs)) CALL ERRQUIT('ccsd_t1_6',11,MA_ER
2292
2293
     &R)
2293
 
      END IF
2294
 
      END IF
2295
 
      END IF
2296
2294
      next = NXTASK(nprocs, 1)
2297
2295
      END IF
2298
2296
      count = count + 1
 
2297
      END IF
 
2298
      END IF
 
2299
      END IF
2299
2300
      END DO
2300
2301
      END DO
2301
2302
      next = NXTASK(-nprocs, 1)
2308
2309
 
2309
2310
 
2310
2311
      SUBROUTINE ccsd_t1_6_1(d_a,k_a_offset,d_c,k_c_offset)
2311
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
2312
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
2312
2313
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2313
2314
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2314
2315
C     i1 ( h4 h5 h1 p3 )_v + = 1 * v ( h4 h5 h1 p3 )_v
2332
2333
       DO h5b = h4b,noab
2333
2334
        DO h1b = 1,noab
2334
2335
         DO p3b = noab+1,noab+nvab
2335
 
          IF (next.eq.count) THEN
2336
2336
           IF ((.not.restricted).or.(int_mb(k_spin+h4b-1)
2337
2337
     1          +int_mb(k_spin+h5b-1)+int_mb(k_spin+h1b-1)
2338
2338
     2          +int_mb(k_spin+p3b-1).ne.8)) THEN
2341
2341
             IF (ieor(int_mb(k_sym+h4b-1),ieor(int_mb(k_sym+h5b-1),
2342
2342
     1           ieor(int_mb(k_sym+h1b-1),int_mb(k_sym+p3b-1)))) 
2343
2343
     2           .eq. irrep_v) THEN
 
2344
          IF (next.eq.count) THEN
2344
2345
              dimc = int_mb(k_range+h4b-1) * int_mb(k_range+h5b-1) 
2345
2346
     1             * int_mb(k_range+h1b-1) * int_mb(k_range+p3b-1)
2346
2347
              CALL TCE_RESTRICTED_4(h4b,h5b,h1b,p3b,
2368
2369
               IF (.not.MA_POP_STACK(l_a))
2369
2370
     1              CALL ERRQUIT('ccsd_t1_6_1',5,MA_ERR)
2370
2371
              END IF
2371
 
             END IF
2372
 
            END IF
2373
 
           END IF
2374
 
           next = NXTASK(nprocs, 1)
 
2372
          next = NXTASK(nprocs, 1)
2375
2373
          END IF
2376
2374
          count = count + 1
 
2375
             END IF
 
2376
            END IF
 
2377
           END IF
2377
2378
         END DO
2378
2379
        END DO
2379
2380
       END DO
2387
2388
 
2388
2389
 
2389
2390
      SUBROUTINE OFFSET_ccsd_t1_6_1(l_a_offset,k_a_offset,size)
2390
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
2391
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
2391
2392
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2392
2393
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2393
2394
C     i1 ( h4 h5 h1 p3 )_v
2457
2458
      END
2458
2459
      SUBROUTINE ccsd_t1_6_2(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offse
2459
2460
     &t)
2460
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
2461
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
2461
2462
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2462
2463
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2463
2464
C     i1 ( h4 h5 h1 p3 )_vt + = -1 * Sum ( p6 ) * t ( p6 h1 )_t * v ( h4 h5 p3 p6 )_v
2514
2515
      DO h5b = h4b,noab
2515
2516
      DO h1b = 1,noab
2516
2517
      DO p3b = noab+1,noab+nvab
2517
 
      IF (next.eq.count) THEN
2518
2518
      IF ((.not.restricted).or.(int_mb(k_spin+h4b-1)+int_mb(k_spin+h5b-1
2519
2519
     &)+int_mb(k_spin+h1b-1)+int_mb(k_spin+p3b-1).ne.8)) THEN
2520
2520
      IF (int_mb(k_spin+h4b-1)+int_mb(k_spin+h5b-1) .eq. int_mb(k_spin+h
2522
2522
      IF (ieor(int_mb(k_sym+h4b-1),ieor(int_mb(k_sym+h5b-1),ieor(int_mb(
2523
2523
     &k_sym+h1b-1),int_mb(k_sym+p3b-1)))) .eq. ieor(irrep_v,irrep_t)) TH
2524
2524
     &EN
 
2525
      IF (next.eq.count) THEN
2525
2526
      dimc = int_mb(k_range+h4b-1) * int_mb(k_range+h5b-1) * int_mb(k_ra
2526
2527
     &nge+h1b-1) * int_mb(k_range+p3b-1)
2527
2528
      IF (.not.MA_PUSH_GET(mt_dbl,dimc,'noname',l_cs,k_cs)) CALL
2606
2607
     1     CALL ERRQUIT('ccsd_t1_6_2',10,MA_ERR)
2607
2608
      IF (.not.MA_POP_STACK(l_cs))
2608
2609
     1     CALL ERRQUIT('ccsd_t1_6_2',11,MA_ERR)
2609
 
      END IF
2610
 
      END IF
2611
 
      END IF
2612
2610
      next = NXTASK(nprocs, 1)
2613
2611
      END IF
2614
2612
      count = count + 1
 
2613
      END IF
 
2614
      END IF
 
2615
      END IF
2615
2616
      END DO
2616
2617
      END DO
2617
2618
      END DO
2627
2628
 
2628
2629
 
2629
2630
      SUBROUTINE ccsd_t1_7(d_a,k_a_offset,d_b,k_b_offset,d_c,k_c_offset)
2630
 
C     $Id: ccsd_t1.F 19699 2010-10-29 17:07:13Z d3y133 $
 
2631
C     $Id: ccsd_t1.F 23632 2013-02-25 23:01:51Z kowalski $
2631
2632
C     This is a Fortran77 program generated by Tensor Contraction Engine v.1.0
2632
2633
C     Copyright (c) Battelle & Pacific Northwest National Laboratory (2002)
2633
2634
C     i0 ( p2 h1 )_vt + = -1/2 * Sum ( h5 p3 p4 ) * t ( p3 p4 h1 h5 )_t * v ( h5 p2 p3 p4 )_v
2656
2657
      next = NXTASK(nprocs, 1)
2657
2658
      DO p2b = noab+1,noab+nvab
2658
2659
       DO h1b = 1,noab
2659
 
        IF (next.eq.count) THEN
2660
2660
         IF ((.not.restricted).or.(int_mb(k_spin+p2b-1)
2661
2661
     1                            +int_mb(k_spin+h1b-1).ne.4)) THEN
2662
2662
          IF (int_mb(k_spin+p2b-1) .eq. int_mb(k_spin+h1b-1)) THEN
2663
2663
           IF (ieor(int_mb(k_sym+p2b-1),int_mb(k_sym+h1b-1)) 
2664
2664
     1         .eq. ieor(irrep_v,irrep_t)) THEN
 
2665
        IF (next.eq.count) THEN
2665
2666
            dimc = int_mb(k_range+p2b-1) * int_mb(k_range+h1b-1)
2666
2667
            IF (.not.MA_PUSH_GET(mt_dbl,dimc,'c',l_c,k_c)) 
2667
2668
     1           CALL ERRQUIT('ccsd_t1_7',0,MA_ERR)
2761
2762
     2           (h1b - 1 + noab * (p2b - noab - 1)))
2762
2763
            IF (.not.MA_POP_STACK(l_c))
2763
2764
     1           CALL ERRQUIT('ccsd_t1_7',10,MA_ERR)
 
2765
         next = NXTASK(nprocs, 1)
 
2766
        END IF
 
2767
        count = count + 1
2764
2768
           END IF
2765
2769
          END IF
2766
2770
         END IF
2767
 
         next = NXTASK(nprocs, 1)
2768
 
        END IF
2769
 
        count = count + 1
2770
2771
       END DO
2771
2772
      END DO
2772
2773
      next = NXTASK(-nprocs, 1)