1c     ********************************************
2c     *                                          *
3c     *            dgemm2c_omp_group             *
4c     *                                          *
5c     ********************************************
6c
7c     Entry - group
8c           - tid,nthr
9c           - n,m,npack,nida2
10c           - A,B
11c           - thrmatrix: private memory
12c           - C: assummed to be zero
13c     Exit - C
14c
15      subroutine dgemm2c_omp_group(group,tid,nthr,n,m,npack2,nida2,
16     >                             A,B,C,thrmatrix)
17      implicit none
18      integer group,tid,nthr,n,m,npack2,nida2
19      real*8 A(*),B(*),C(*),thrmatrix(*)
20
21*     **** local variables ****
22      integer r1,s1,r2,s2,shift1,shift1a,npack2_block,nida2_block,i
23
24
25*     **** define blocking ****
26      s1 = npack2/nthr
27      r1 = mod(npack2,nthr)
28      s2 = nida2/nthr
29      r2 = mod(nida2,nthr)
30      shift1  = 1 + tid*s1 + min(tid,r1)
31      shift1a = 1 + tid*s2 + min(tid,r2)
32      npack2_block = s1
33      nida2_block = s2
34      if (tid.lt.r1) npack2_block = npack2_block + 1
35      if (tid.lt.r2) nida2_block = nida2_block + 1
36
37      call DGEMM('T','N',n,m,npack2_block,
38     >           2.0d0,
39     >           A(shift1),npack2,
40     >           B(shift1),npack2,
41     >           0.0d0,
42     >           thrmatrix,n)
43      if (nida2_block.gt.0) then
44         call DGEMM('T','N',n,m,nida2_block,
45     >              -1.0d0,
46     >              A(shift1a),npack2,
47     >              B(shift1a),npack2,
48     >              1.0d0,
49     >              thrmatrix,n)
50      end if
51
52      if (group.eq.1) then
53!$OMP CRITICAL (group1)
54         call daxpy(n*m,1.0d0,thrmatrix,1,C,1)
55!$OMP END CRITICAL (group1)
56
57      else if (group.eq.2) then
58!$OMP CRITICAL (ggroup2)
59         call daxpy(n*m,1.0d0,thrmatrix,1,C,1)
60!$OMP END CRITICAL (ggroup2)
61
62      else if (group.eq.3) then
63!$OMP CRITICAL (hhhroup3)
64         call daxpy(n*m,1.0d0,thrmatrix,1,C,1)
65!$OMP END CRITICAL (hhhroup3)
66      end if
67
68      return
69      end
70
71
72c     ********************************************
73c     *                                          *
74c     *            dgemm2c0_omp_group            *
75c     *                                          *
76c     ********************************************
77c
78c     Entry - group
79c           - tid,nthr
80c           - n,m,npack
81c           - A,B
82c           - thrmatrix: private memory
83c           - C: assummed to be zero
84c     Exit - C
85c
86      subroutine dgemm2c0_omp_group(group,tid,nthr,n,m,npack2,
87     >                             A,B,C,thrmatrix)
88      implicit none
89      integer group,tid,nthr,n,m,npack2
90      real*8 A(*),B(*),C(*),thrmatrix(*)
91
92*     **** local variables ****
93      integer r1,s1,shift1,npack2_block,i
94
95
96*     **** define blocking ****
97      s1 = npack2/nthr
98      r1 = mod(npack2,nthr)
99      shift1  = 1 + tid*s1 + min(tid,r1)
100      npack2_block = s1
101      if (tid.lt.r1) npack2_block = npack2_block + 1
102
103      call DGEMM('T','N',n,m,npack2_block,
104     >           1.0d0,
105     >           A(shift1),npack2,
106     >           B(shift1),npack2,
107     >           0.0d0,
108     >           thrmatrix,n)
109
110      if (group.eq.1) then
111!$OMP CRITICAL (group1)
112         call daxpy(n*m,1.0d0,thrmatrix,1,C,1)
113!$OMP END CRITICAL (group1)
114
115      else if (group.eq.2) then
116!$OMP CRITICAL (ggroup2)
117         call daxpy(n*m,1.0d0,thrmatrix,1,C,1)
118!$OMP END CRITICAL (ggroup2)
119
120      else if (group.eq.3) then
121!$OMP CRITICAL (hhhroup3)
122         call daxpy(n*m,1.0d0,thrmatrix,1,C,1)
123!$OMP END CRITICAL (hhhroup3)
124      end if
125
126      return
127      end
128