1 /**********************************************************************
2 Occupation_Number_LDA_U.c:
3
4 Occupation_Number_LDA_U.c is a subrutine to calculate occupation
5 number for LDA+U method.
6
7 Log of Occupation_Number_LDA_U.c:
8
9 14/April/2004 -- Released by M.J.Han (MJ)
10 29/Nov /2004 -- Modified by T.Ozaki (AIST)
11 16/Feb /2006 -- a constraint DFT for spin orientation
12 was added by T.Ozaki (AIST)
13 ***********************************************************************/
14
15 #include <stdio.h>
16 #include <stdlib.h>
17 #include <string.h>
18 #include <math.h>
19 #include <time.h>
20 #include "openmx_common.h"
21 #include "mpi.h"
22
23 #ifdef c_complex
24 #include <complex.h>
25 #endif
26
27
28
29 #define SCF_Enhance_OP 9
30 #define quickcalc_flag 0
31
32
33 static void occupation_onsite();
34 static void occupation_full();
35 static void occupation_dual();
36 static void mixing_occupation(int SCF_iter);
37 static void Induce_Orbital_Polarization(int Mc_AN);
38 static void Induce_Orbital_Polarization_Together(int Mc_AN);
39 static void Induce_NC_Orbital_Polarization(int Mc_AN);
40 static void make_v_eff(int SCF_iter, int SucceedReadingDMfile, double dUele);
41 static void make_NC_v_eff(int SCF_iter, int SucceedReadingDMfile, double dUele, double ECE[]);
42 static void Output_Collinear_OcpN();
43 static void Output_NonCollinear_OcpN();
44 static void Calc_dTN( int constraint_flag,
45 dcomplex TN[2][2],
46 dcomplex dTN[2][2][2][2],
47 dcomplex U[2][2],
48 double theta[2], double phi[2] );
49
50 void Calc_dSxyz( dcomplex TN[2][2],
51 dcomplex dSx[2][2],
52 dcomplex dSy[2][2],
53 dcomplex dSz[2][2],
54 double Nup[2], double Ndn[2],
55 double theta[2], double phi[2] );
56
57
Occupation_Number_LDA_U(int SCF_iter,int SucceedReadingDMfile,double dUele,double ECE[],char * mode)58 void Occupation_Number_LDA_U(int SCF_iter, int SucceedReadingDMfile, double dUele, double ECE[], char *mode)
59 {
60 int l1,l2,mul1,mul2,mul3,mul4,m1,m2,to1,to2,to3,to4 ;
61 int Mc_AN,Gc_AN,Cwan,num,l,m,mul,n,k,tno1,tno0;
62 int wan1,wan2,i,j,spin,size1,size2;
63 double sden,tmp0,sum,Uvalue;
64 double Stime_atom, Etime_atom;
65 int numprocs,myid,ID,tag=999;
66
67 /* MPI */
68 MPI_Comm_size(mpi_comm_level1,&numprocs);
69 MPI_Comm_rank(mpi_comm_level1,&myid);
70
71 /****************************************************
72 find DM_onsite
73 ****************************************************/
74
75 /* on site */
76 if (Hub_U_occupation==0){
77 occupation_onsite();
78 }
79
80 /* full */
81 else if (Hub_U_occupation==1){
82 occupation_full();
83 }
84
85 /* dual */
86 else if (Hub_U_occupation==2){
87 occupation_dual();
88 }
89
90 /****************************************************
91 induce orbital polarization if necessary
92 ****************************************************/
93
94 if (SCF_iter<SCF_Enhance_OP && SucceedReadingDMfile==0 && Hub_U_switch==1){
95
96 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
97 if (SpinP_switch==0) Induce_Orbital_Polarization(Mc_AN);
98 else if (SpinP_switch==1) Induce_Orbital_Polarization_Together(Mc_AN);
99 else if (SpinP_switch==3) Induce_NC_Orbital_Polarization(Mc_AN);
100 }
101 }
102
103 /****************************************************
104 mixing of occupation number matrix
105 ****************************************************/
106
107 /*
108 if (SpinP_switch==0) mixing_occupation(SCF_iter);
109 else if (SpinP_switch==1) mixing_occupation(SCF_iter);
110 */
111
112 /****************************************************
113 make v_eff
114 ****************************************************/
115
116 if (SpinP_switch!=3) make_v_eff(SCF_iter, SucceedReadingDMfile, dUele);
117 else make_NC_v_eff(SCF_iter, SucceedReadingDMfile, dUele, ECE);
118
119 /****************************************************
120 write a file, *.DM_onsite
121 ****************************************************/
122
123 if ( strcasecmp(mode,"write")==0 ){
124 if (SpinP_switch!=3) Output_Collinear_OcpN();
125 else Output_NonCollinear_OcpN();
126 }
127
128 }
129
130
131
132
133
134
135
mixing_occupation(int SCF_iter)136 void mixing_occupation(int SCF_iter)
137 {
138 int Mc_AN,Gc_AN,wan1,i,j,spin;
139 double mixw0,mixw1,tmp;
140
141 if (SCF_iter==1){
142 mixw0 = 1.0;
143 mixw1 = 0.0;
144 }
145 else{
146 mixw0 = 1.0;
147 mixw1 = 1.0 - mixw0;
148 }
149
150 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
151
152 Gc_AN = M2G[Mc_AN];
153 wan1 = WhatSpecies[Gc_AN];
154
155 /* collinear */
156
157 if (SpinP_switch!=3){
158
159 if (Cnt_switch==0){
160
161 for (spin=0; spin<=SpinP_switch; spin++){
162 for (i=0; i<Spe_Total_NO[wan1]; i++){
163 for (j=0; j<Spe_Total_NO[wan1]; j++){
164 tmp = mixw0*DM_onsite[0][spin][Mc_AN][i][j]
165 + mixw1*DM_onsite[1][spin][Mc_AN][i][j];
166 DM_onsite[0][spin][Mc_AN][i][j] = tmp;
167 DM_onsite[1][spin][Mc_AN][i][j] = tmp;
168 }
169 }
170 }
171 }
172
173 else {
174
175 for (spin=0; spin<=SpinP_switch; spin++){
176 for (i=0; i<Spe_Total_CNO[wan1]; i++){
177 for (j=0; j<Spe_Total_CNO[wan1]; j++){
178 tmp = mixw0*DM_onsite[0][spin][Mc_AN][i][j]
179 + mixw1*DM_onsite[1][spin][Mc_AN][i][j];
180 DM_onsite[0][spin][Mc_AN][i][j] = tmp;
181 DM_onsite[1][spin][Mc_AN][i][j] = tmp;
182 }
183 }
184 }
185 }
186 }
187
188 /* non-collinear */
189
190 else{
191
192
193 }
194
195 }
196
197 }
198
199
200
201
202
203
204
occupation_onsite()205 void occupation_onsite()
206 {
207 int l1,l2,mul1,mul2,mul3,mul4,m1,m2,to1,to2,to3,to4;
208 int Mc_AN,Gc_AN,Cwan,num,l,m,mul;
209 int wan1,wan2,i,j,spin;
210 double Re11,Re22,Re12,Im12,d1,d2,d3;
211 double theta,phi,sit,cot,sip,cop;
212 double Stime_atom, Etime_atom;
213 double sden,tmp0,sum;
214 int ***Cnt_index;
215
216 /****************************************************
217 allocation of arrays:
218
219 int Cnt_index[List_YOUSO[25]+1]
220 [List_YOUSO[24]]
221 [2*(List_YOUSO[25]+1)+1];
222 ****************************************************/
223
224 Cnt_index = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
225 for (i=0; i<(List_YOUSO[25]+1); i++){
226 Cnt_index[i] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
227 for (j=0; j<List_YOUSO[24]; j++){
228 Cnt_index[i][j] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
229 }
230 }
231
232 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
233
234 dtime(&Stime_atom);
235
236 Gc_AN = M2G[Mc_AN];
237 wan1 = WhatSpecies[Gc_AN];
238
239 /****************************************************
240 if (SpinP_switch!=3)
241
242 collinear case
243 ****************************************************/
244
245 if (SpinP_switch!=3){
246
247 if (Cnt_switch==0){
248
249 for (spin=0; spin<=SpinP_switch; spin++){
250 for (i=0; i<Spe_Total_NO[wan1]; i++){
251 for (j=0; j<Spe_Total_NO[wan1]; j++){
252
253 /* store the DM_onsite --- MJ */
254
255 DM_onsite[0][spin][Mc_AN][i][j] = DM[0][spin][Mc_AN][0][i][j];
256 }
257 }
258 } /* spin */
259 }
260
261 /***********************************
262 Important note:
263
264 In case of orbital optimization,
265 the U potential is applied to
266 the primitive orbital.
267 ***********************************/
268
269 else {
270
271 to3 = 0;
272 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
273 for(mul3=0; mul3<Spe_Num_CBasis[wan1][l1]; mul3++){
274 for(m1=0; m1<(2*l1+1); m1++){
275 Cnt_index[l1][mul3][m1] = to3;
276 to3++;
277 }
278 }
279 }
280
281 for (spin=0; spin<=SpinP_switch; spin++){
282
283 to1 = 0;
284 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
285 for(mul1=0; mul1<Spe_Num_Basis[wan1][l1]; mul1++){
286 for(m1=0; m1<(2*l1+1); m1++){
287
288 to2 = 0;
289 for(l2=0; l2<=Spe_MaxL_Basis[wan1]; l2++){
290 for(mul2=0; mul2<Spe_Num_Basis[wan1][l2]; mul2++){
291 for(m2=0; m2<(2*l2+1); m2++){
292
293 sum = 0.0;
294 for(mul3=0; mul3<Spe_Num_CBasis[wan1][l1]; mul3++){
295 for(mul4=0; mul4<Spe_Num_CBasis[wan1][l2]; mul4++){
296
297 to3 = Cnt_index[l1][mul3][m1];
298 to4 = Cnt_index[l2][mul4][m2];
299
300 sum += CntCoes[Mc_AN][to3][mul1]*CntCoes[Mc_AN][to4][mul2]
301 *DM[0][spin][Mc_AN][0][to3][to4];
302 }
303 }
304
305 /* store the DM_onsite --- MJ */
306 DM_onsite[0][spin][Mc_AN][to1][to2] = sum;
307
308 to2++;
309
310 }
311 }
312 }
313
314 to1++;
315
316 }
317 }
318 }
319
320 }
321
322 } /* else */
323
324 } /* if (SpinP_switch!=3) */
325
326 /****************************************************
327 if (SpinP_switch==3)
328
329 spin non-collinear
330 ****************************************************/
331
332 else {
333
334 for (i=0; i<Spe_Total_NO[wan1]; i++){
335 for (j=0; j<Spe_Total_NO[wan1]; j++){
336
337 /* store NC_OcpN */
338
339 NC_OcpN[0][0][0][Mc_AN][i][j].r = DM[0][0][Mc_AN][0][i][j];
340 NC_OcpN[0][1][1][Mc_AN][i][j].r = DM[0][1][Mc_AN][0][i][j];
341 NC_OcpN[0][0][1][Mc_AN][i][j].r = DM[0][2][Mc_AN][0][i][j];
342 NC_OcpN[0][1][0][Mc_AN][i][j].r = DM[0][2][Mc_AN][0][j][i];
343
344 NC_OcpN[0][0][0][Mc_AN][i][j].i = iDM[0][0][Mc_AN][0][i][j];
345 NC_OcpN[0][1][1][Mc_AN][i][j].i = iDM[0][1][Mc_AN][0][i][j];
346 NC_OcpN[0][0][1][Mc_AN][i][j].i = DM[0][3][Mc_AN][0][i][j];
347 NC_OcpN[0][1][0][Mc_AN][i][j].i =-DM[0][3][Mc_AN][0][j][i];
348 }
349 }
350
351
352 /*
353 printf("Re 00 Gc_AN=%2d\n",Gc_AN);
354 for (i=0; i<Spe_Total_NO[wan1]; i++){
355 for (j=0; j<Spe_Total_NO[wan1]; j++){
356 printf("%8.4f ",NC_OcpN[0][0][0][Mc_AN][i][j].r);
357 }
358 printf("\n");
359 }
360
361 printf("Re 11 Gc_AN=%2d\n",Gc_AN);
362 for (i=0; i<Spe_Total_NO[wan1]; i++){
363 for (j=0; j<Spe_Total_NO[wan1]; j++){
364 printf("%8.4f ",NC_OcpN[0][1][1][Mc_AN][i][j].r);
365 }
366 printf("\n");
367 }
368
369 printf("Re 01 Gc_AN=%2d\n",Gc_AN);
370 for (i=0; i<Spe_Total_NO[wan1]; i++){
371 for (j=0; j<Spe_Total_NO[wan1]; j++){
372 printf("%8.4f ",NC_OcpN[0][0][1][Mc_AN][i][j].r);
373 }
374 printf("\n");
375 }
376
377 printf("Re 10 Gc_AN=%2d\n",Gc_AN);
378 for (i=0; i<Spe_Total_NO[wan1]; i++){
379 for (j=0; j<Spe_Total_NO[wan1]; j++){
380 printf("%8.4f ",NC_OcpN[0][1][0][Mc_AN][i][j].r);
381 }
382 printf("\n");
383 }
384
385 printf("Im 00 Gc_AN=%2d\n",Gc_AN);
386 for (i=0; i<Spe_Total_NO[wan1]; i++){
387 for (j=0; j<Spe_Total_NO[wan1]; j++){
388 printf("%8.4f ",NC_OcpN[0][0][0][Mc_AN][i][j].i);
389 }
390 printf("\n");
391 }
392
393 printf("Im 11 Gc_AN=%2d\n",Gc_AN);
394 for (i=0; i<Spe_Total_NO[wan1]; i++){
395 for (j=0; j<Spe_Total_NO[wan1]; j++){
396 printf("%8.4f ",NC_OcpN[0][1][1][Mc_AN][i][j].i);
397 }
398 printf("\n");
399 }
400
401 printf("Im 01 Gc_AN=%2d\n",Gc_AN);
402 for (i=0; i<Spe_Total_NO[wan1]; i++){
403 for (j=0; j<Spe_Total_NO[wan1]; j++){
404 printf("%8.4f ",NC_OcpN[0][0][1][Mc_AN][i][j].i);
405 }
406 printf("\n");
407 }
408
409 printf("Im 10 Gc_AN=%2d\n",Gc_AN);
410 for (i=0; i<Spe_Total_NO[wan1]; i++){
411 for (j=0; j<Spe_Total_NO[wan1]; j++){
412 printf("%8.4f ",NC_OcpN[0][1][0][Mc_AN][i][j].i);
413 }
414 printf("\n");
415 }
416 */
417
418
419 }
420
421
422
423
424 dtime(&Etime_atom);
425 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
426
427 } /* Mc_AN */
428
429 /****************************************************
430 freeing of arrays:
431
432 int Cnt_index[List_YOUSO[25]+1]
433 [List_YOUSO[24]]
434 [2*(List_YOUSO[25]+1)+1];
435 ****************************************************/
436
437 for (i=0; i<(List_YOUSO[25]+1); i++){
438 for (j=0; j<List_YOUSO[24]; j++){
439 free(Cnt_index[i][j]);
440 }
441 free(Cnt_index[i]);
442 }
443 free(Cnt_index);
444
445 }
446
447
occupation_full()448 void occupation_full()
449 {
450 int l1,l2,mul1,mul2,mul3,mul4,m1,m2,to1,to2,to3,to4 ;
451 int Mc_AN,Gc_AN,Cwan,num,l,m,n,mul,kl,hL_AN,hR_AN;
452 int MR_AN,ML_AN,GR_AN,GL_AN,Rwan,Lwan;
453 int wan1,wan2,i,j,spin,size1,size2;
454 int tno0,tno1,tno2,Hwan,h_AN,Gh_AN,k,p,p0;
455 double Re11,Re22,Re12,Im12,d1,d2,d3;
456 double theta,phi,sit,cot,sip,cop;
457 double *Lsum,*Rsum;
458 double Stime_atom, Etime_atom;
459 double sden,tmp0,sum,ocn;
460 double ReOcn00,ReOcn11,ReOcn01;
461 double ImOcn00,ImOcn11,ImOcn01;
462 double *****DM0;
463 double *****iDM0;
464 double *tmp_array;
465 double *tmp_array2;
466 int ***Cnt_index,*Snd_DM0_Size,*Rcv_DM0_Size;
467 int numprocs,myid,ID,IDS,IDR,tag=999;
468
469 MPI_Status stat;
470 MPI_Request request;
471
472 /* MPI */
473 MPI_Comm_size(mpi_comm_level1,&numprocs);
474 MPI_Comm_rank(mpi_comm_level1,&myid);
475
476 /****************************************************
477 allocation of arrays:
478
479 int Cnt_index[List_YOUSO[25]+1]
480 [List_YOUSO[24]]
481 [2*(List_YOUSO[25]+1)+1];
482
483 double DM0[SpinP_switch+1]
484 [Matomnum+MatomnumF+1]
485 [FNAN[Gc_AN]+1]
486 [Spe_Total_NO[Cwan]]
487 [Spe_Total_NO[Hwan]];
488
489 int Snd_DM0_Size[numprocs];
490 int Rcv_DM0_Size[numprocs];
491
492 double Lsum[List_YOUSO[7]];
493 double Rsum[List_YOUSO[7]];
494 ****************************************************/
495
496 /* Cnt_index */
497
498 Cnt_index = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
499 for (i=0; i<(List_YOUSO[25]+1); i++){
500 Cnt_index[i] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
501 for (j=0; j<List_YOUSO[24]; j++){
502 Cnt_index[i][j] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
503 }
504 }
505
506 /* DM0 */
507
508 DM0 = (double*****)malloc(sizeof(double****)*(SpinP_switch+1));
509 for (k=0; k<=SpinP_switch; k++){
510 DM0[k] = (double****)malloc(sizeof(double***)*(Matomnum+MatomnumF+1));
511 FNAN[0] = 0;
512 for (Mc_AN=0; Mc_AN<=(Matomnum+MatomnumF); Mc_AN++){
513
514 if (Mc_AN==0){
515 Gc_AN = 0;
516 tno0 = 1;
517 }
518 else{
519 Gc_AN = F_M2G[Mc_AN];
520 Cwan = WhatSpecies[Gc_AN];
521 tno0 = Spe_Total_NO[Cwan];
522 }
523
524 DM0[k][Mc_AN] = (double***)malloc(sizeof(double**)*(FNAN[Gc_AN]+1));
525 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
526
527 if (Mc_AN==0){
528 tno1 = 1;
529 }
530 else{
531 Gh_AN = natn[Gc_AN][h_AN];
532 Hwan = WhatSpecies[Gh_AN];
533 tno1 = Spe_Total_NO[Hwan];
534 }
535
536 DM0[k][Mc_AN][h_AN] = (double**)malloc(sizeof(double*)*tno0);
537 for (i=0; i<tno0; i++){
538 DM0[k][Mc_AN][h_AN][i] = (double*)malloc(sizeof(double)*tno1);
539 }
540 }
541 }
542 }
543
544 /* Snd_DM0_Size and Rcv_DM0_Size */
545
546 Snd_DM0_Size = (int*)malloc(sizeof(int)*numprocs);
547 Rcv_DM0_Size = (int*)malloc(sizeof(int)*numprocs);
548
549 /* Lsum and Rsum */
550
551 Lsum = (double*)malloc(sizeof(double)*List_YOUSO[7]);
552 Rsum = (double*)malloc(sizeof(double)*List_YOUSO[7]);
553
554 /****************************************************
555 DM[k][Matomnum] -> DM0
556 ****************************************************/
557
558 for (k=0; k<=SpinP_switch; k++){
559 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
560 Gc_AN = M2G[Mc_AN];
561 wan1 = WhatSpecies[Gc_AN];
562 tno1 = Spe_Total_NO[wan1];
563 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
564 Gh_AN = natn[Gc_AN][h_AN];
565 Hwan = WhatSpecies[Gh_AN];
566 tno2 = Spe_Total_NO[Hwan];
567 for (i=0; i<tno1; i++){
568 for (j=0; j<tno2; j++){
569 DM0[k][Mc_AN][h_AN][i][j] = DM[0][k][Mc_AN][h_AN][i][j];
570 }
571 }
572 }
573 }
574 }
575
576 /****************************************************
577 MPI: DM0
578 ****************************************************/
579
580 /***********************************
581 set data size
582 ************************************/
583
584 for (ID=0; ID<numprocs; ID++){
585
586 IDS = (myid + ID) % numprocs;
587 IDR = (myid - ID + numprocs) % numprocs;
588
589 if (ID!=0){
590 tag = 999;
591
592 /* find data size to send block data */
593 if (F_Snd_Num[IDS]!=0){
594
595 size1 = 0;
596 for (k=0; k<=SpinP_switch; k++){
597 for (n=0; n<F_Snd_Num[IDS]; n++){
598 Mc_AN = Snd_MAN[IDS][n];
599 Gc_AN = Snd_GAN[IDS][n];
600 Cwan = WhatSpecies[Gc_AN];
601 tno1 = Spe_Total_NO[Cwan];
602 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
603 Gh_AN = natn[Gc_AN][h_AN];
604 Hwan = WhatSpecies[Gh_AN];
605 tno2 = Spe_Total_NO[Hwan];
606 size1 += tno1*tno2;
607 }
608 }
609 }
610
611 Snd_DM0_Size[IDS] = size1;
612 MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
613 }
614 else{
615 Snd_DM0_Size[IDS] = 0;
616 }
617
618 /* receiving of size of data */
619
620 if (F_Rcv_Num[IDR]!=0){
621 tag = 999;
622 MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
623 Rcv_DM0_Size[IDR] = size2;
624 }
625 else{
626 Rcv_DM0_Size[IDR] = 0;
627 }
628
629 if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
630
631 }
632 }
633
634 /***********************************
635 data transfer
636 ************************************/
637
638 tag = 999;
639 for (ID=0; ID<numprocs; ID++){
640
641 IDS = (myid + ID) % numprocs;
642 IDR = (myid - ID + numprocs) % numprocs;
643
644 if (ID!=0){
645
646 /*****************************
647 sending of data
648 *****************************/
649
650 if (F_Snd_Num[IDS]!=0){
651
652 size1 = Snd_DM0_Size[IDS];
653
654 /* allocation of array */
655
656 tmp_array = (double*)malloc(sizeof(double)*size1);
657
658 /* multidimentional array to vector array */
659
660 num = 0;
661 for (k=0; k<=SpinP_switch; k++){
662 for (n=0; n<F_Snd_Num[IDS]; n++){
663 Mc_AN = Snd_MAN[IDS][n];
664 Gc_AN = Snd_GAN[IDS][n];
665 Cwan = WhatSpecies[Gc_AN];
666 tno1 = Spe_Total_NO[Cwan];
667 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
668 Gh_AN = natn[Gc_AN][h_AN];
669 Hwan = WhatSpecies[Gh_AN];
670 tno2 = Spe_Total_NO[Hwan];
671 for (i=0; i<tno1; i++){
672 for (j=0; j<tno2; j++){
673 tmp_array[num] = DM0[k][Mc_AN][h_AN][i][j];
674 num++;
675 }
676 }
677 }
678 }
679 }
680
681 MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
682
683 }
684
685 /*****************************
686 receiving of block data
687 *****************************/
688
689 if (F_Rcv_Num[IDR]!=0){
690
691 size2 = Rcv_DM0_Size[IDR];
692
693 /* allocation of array */
694 tmp_array2 = (double*)malloc(sizeof(double)*size2);
695
696 MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
697
698 num = 0;
699 for (k=0; k<=SpinP_switch; k++){
700 Mc_AN = F_TopMAN[IDR] - 1;
701 for (n=0; n<F_Rcv_Num[IDR]; n++){
702 Mc_AN++;
703 Gc_AN = Rcv_GAN[IDR][n];
704 Cwan = WhatSpecies[Gc_AN];
705 tno1 = Spe_Total_NO[Cwan];
706
707 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
708 Gh_AN = natn[Gc_AN][h_AN];
709 Hwan = WhatSpecies[Gh_AN];
710 tno2 = Spe_Total_NO[Hwan];
711 for (i=0; i<tno1; i++){
712 for (j=0; j<tno2; j++){
713 DM0[k][Mc_AN][h_AN][i][j] = tmp_array2[num];
714 num++;
715 }
716 }
717 }
718 }
719 }
720
721 /* freeing of array */
722 free(tmp_array2);
723 }
724
725 if (F_Snd_Num[IDS]!=0){
726 MPI_Wait(&request,&stat);
727 free(tmp_array); /* freeing of array */
728 }
729 }
730 }
731
732 /****************************************************
733 collinear case
734 ****************************************************/
735
736 if (SpinP_switch!=3){
737
738 /****************************************************
739 calculate DM_onsite
740 ****************************************************/
741
742 if (Cnt_switch==0){
743
744 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
745
746 dtime(&Stime_atom);
747
748 Gc_AN = M2G[Mc_AN];
749 wan1 = WhatSpecies[Gc_AN];
750
751 for (spin=0; spin<=SpinP_switch; spin++){
752
753 for (i=0; i<Spe_Total_NO[wan1]; i++){
754 for (j=0; j<Spe_Total_NO[wan1]; j++){
755
756 /* store the DM_onsite --- MJ */
757
758 ocn = 0.0;
759 for (hL_AN=0; hL_AN<=FNAN[Gc_AN]; hL_AN++){
760 GL_AN = natn[Gc_AN][hL_AN];
761 ML_AN = F_G2M[GL_AN];
762 Lwan = WhatSpecies[GL_AN];
763
764 for (hR_AN=0; hR_AN<=FNAN[Gc_AN]; hR_AN++){
765 GR_AN = natn[Gc_AN][hR_AN];
766 MR_AN = F_G2M[GR_AN];
767 Rwan = WhatSpecies[GR_AN];
768 kl = RMI1[Mc_AN][hL_AN][hR_AN];
769
770 if (0<=kl){
771 for (m=0; m<Spe_Total_CNO[Lwan]; m++){
772 for (n=0; n<Spe_Total_CNO[Rwan]; n++){
773 ocn += DM0[spin][ML_AN][kl][m][n]*
774 OLP[0][Mc_AN][hL_AN][i][m]*
775 OLP[0][Mc_AN][hR_AN][j][n];
776 }
777 }
778 }
779 }
780 }
781
782 DM_onsite[0][spin][Mc_AN][i][j] = ocn;
783 }
784 }
785
786 } /* spin */
787
788 dtime(&Etime_atom);
789 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
790
791 } /* Mc_AN */
792 }
793
794 /***********************************
795 In case of orbital optimization
796
797 Important note:
798 In case of orbital optimization,
799 the U potential is applied to
800 the primitive orbital.
801 ***********************************/
802
803 else {
804
805 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
806
807 dtime(&Stime_atom);
808
809 Gc_AN = M2G[Mc_AN];
810 wan1 = WhatSpecies[Gc_AN];
811
812 for (spin=0; spin<=SpinP_switch; spin++){
813 for (i=0; i<Spe_Total_NO[wan1]; i++){
814 for (j=0; j<Spe_Total_NO[wan1]; j++){
815
816 /* store the DM_onsite --- MJ */
817
818 ocn = 0.0;
819 for (hL_AN=0; hL_AN<=FNAN[Gc_AN]; hL_AN++){
820 GL_AN = natn[Gc_AN][hL_AN];
821 ML_AN = F_G2M[GL_AN];
822 Lwan = WhatSpecies[GL_AN];
823
824 for (hR_AN=0; hR_AN<=FNAN[Gc_AN]; hR_AN++){
825 GR_AN = natn[Gc_AN][hR_AN];
826 MR_AN = F_G2M[GR_AN];
827 Rwan = WhatSpecies[GR_AN];
828 kl = RMI1[Mc_AN][hL_AN][hR_AN];
829
830 if (0<=kl){
831
832 for (m=0; m<Spe_Total_CNO[Lwan]; m++){
833 Lsum[m] = 0.0;
834 for (p=0; p<Spe_Specified_Num[Lwan][m]; p++){
835 p0 = Spe_Trans_Orbital[Lwan][m][p];
836 Lsum[m] += CntCoes[ML_AN][m][p]*OLP[0][Mc_AN][hL_AN][i][p0];
837 }
838 }
839
840 for (n=0; n<Spe_Total_CNO[Rwan]; n++){
841 Rsum[n] = 0.0;
842 for (p=0; p<Spe_Specified_Num[Rwan][n]; p++){
843 p0 = Spe_Trans_Orbital[Rwan][n][p];
844 Rsum[n] += CntCoes[MR_AN][n][p]*OLP[0][Mc_AN][hR_AN][j][p0];
845 }
846 }
847
848 for (m=0; m<Spe_Total_CNO[Lwan]; m++){
849 for (n=0; n<Spe_Total_CNO[Rwan]; n++){
850 ocn += DM0[spin][ML_AN][kl][m][n]*Lsum[m]*Rsum[n];
851 }
852 }
853
854 }
855 }
856 }
857
858 DM_onsite[0][spin][Mc_AN][i][j] = ocn;
859
860 }
861 }
862 } /* spin */
863
864 dtime(&Etime_atom);
865 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
866
867 } /* Mc_AN */
868 } /* else */
869
870 } /* if (SpinP_switch!=3) */
871
872 /****************************************************
873 non-collinear case
874 ****************************************************/
875
876 else{
877
878 /* allocation of iDM0 */
879
880 iDM0 = (double*****)malloc(sizeof(double****)*2);
881 for (k=0; k<2; k++){
882 iDM0[k] = (double****)malloc(sizeof(double***)*(Matomnum+MatomnumF+1));
883 FNAN[0] = 0;
884 for (Mc_AN=0; Mc_AN<=(Matomnum+MatomnumF); Mc_AN++){
885
886 if (Mc_AN==0){
887 Gc_AN = 0;
888 tno0 = 1;
889 }
890 else{
891 Gc_AN = F_M2G[Mc_AN];
892 Cwan = WhatSpecies[Gc_AN];
893 tno0 = Spe_Total_NO[Cwan];
894 }
895
896 iDM0[k][Mc_AN] = (double***)malloc(sizeof(double**)*(FNAN[Gc_AN]+1));
897 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
898
899 if (Mc_AN==0){
900 tno1 = 1;
901 }
902 else{
903 Gh_AN = natn[Gc_AN][h_AN];
904 Hwan = WhatSpecies[Gh_AN];
905 tno1 = Spe_Total_NO[Hwan];
906 }
907
908 iDM0[k][Mc_AN][h_AN] = (double**)malloc(sizeof(double*)*tno0);
909 for (i=0; i<tno0; i++){
910 iDM0[k][Mc_AN][h_AN][i] = (double*)malloc(sizeof(double)*tno1);
911 }
912 }
913 }
914 }
915
916 /****************************************************
917 iDM[0][k][Matomnum] -> iDM0
918 ****************************************************/
919
920 for (k=0; k<2; k++){
921 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
922 Gc_AN = M2G[Mc_AN];
923 wan1 = WhatSpecies[Gc_AN];
924 tno1 = Spe_Total_NO[wan1];
925 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
926 Gh_AN = natn[Gc_AN][h_AN];
927 Hwan = WhatSpecies[Gh_AN];
928 tno2 = Spe_Total_NO[Hwan];
929 for (i=0; i<tno1; i++){
930 for (j=0; j<tno2; j++){
931 iDM0[k][Mc_AN][h_AN][i][j] = iDM[0][k][Mc_AN][h_AN][i][j];
932 }
933 }
934 }
935 }
936 }
937
938 /****************************************************
939 MPI: iDM0
940 ****************************************************/
941
942 /***********************************
943 set data size
944 ************************************/
945
946 for (ID=0; ID<numprocs; ID++){
947
948 IDS = (myid + ID) % numprocs;
949 IDR = (myid - ID + numprocs) % numprocs;
950
951 if (ID!=0){
952 tag = 999;
953
954 /* find data size to send block data */
955 if (F_Snd_Num[IDS]!=0){
956
957 size1 = 0;
958 for (k=0; k<2; k++){
959 for (n=0; n<F_Snd_Num[IDS]; n++){
960 Mc_AN = Snd_MAN[IDS][n];
961 Gc_AN = Snd_GAN[IDS][n];
962 Cwan = WhatSpecies[Gc_AN];
963 tno1 = Spe_Total_NO[Cwan];
964 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
965 Gh_AN = natn[Gc_AN][h_AN];
966 Hwan = WhatSpecies[Gh_AN];
967 tno2 = Spe_Total_NO[Hwan];
968 size1 += tno1*tno2;
969 }
970 }
971 }
972
973 Snd_DM0_Size[IDS] = size1;
974 MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
975 }
976 else{
977 Snd_DM0_Size[IDS] = 0;
978 }
979
980 /* receiving of size of data */
981
982 if (F_Rcv_Num[IDR]!=0){
983 MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
984 Rcv_DM0_Size[IDR] = size2;
985 }
986 else{
987 Rcv_DM0_Size[IDR] = 0;
988 }
989
990 if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
991
992 }
993 }
994
995 /***********************************
996 data transfer
997 ************************************/
998
999 tag = 999;
1000 for (ID=0; ID<numprocs; ID++){
1001
1002 IDS = (myid + ID) % numprocs;
1003 IDR = (myid - ID + numprocs) % numprocs;
1004
1005 if (ID!=0){
1006
1007 /*****************************
1008 sending of data
1009 *****************************/
1010
1011 if (F_Snd_Num[IDS]!=0){
1012
1013 size1 = Snd_DM0_Size[IDS];
1014
1015 /* allocation of array */
1016
1017 tmp_array = (double*)malloc(sizeof(double)*size1);
1018
1019 /* multidimentional array to vector array */
1020
1021 num = 0;
1022 for (k=0; k<2; k++){
1023 for (n=0; n<F_Snd_Num[IDS]; n++){
1024 Mc_AN = Snd_MAN[IDS][n];
1025 Gc_AN = Snd_GAN[IDS][n];
1026 Cwan = WhatSpecies[Gc_AN];
1027 tno1 = Spe_Total_NO[Cwan];
1028 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1029 Gh_AN = natn[Gc_AN][h_AN];
1030 Hwan = WhatSpecies[Gh_AN];
1031 tno2 = Spe_Total_NO[Hwan];
1032 for (i=0; i<tno1; i++){
1033 for (j=0; j<tno2; j++){
1034 tmp_array[num] = iDM0[k][Mc_AN][h_AN][i][j];
1035 num++;
1036 }
1037 }
1038 }
1039 }
1040 }
1041
1042 MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
1043
1044 }
1045
1046 /*****************************
1047 receiving of block data
1048 *****************************/
1049
1050 if (F_Rcv_Num[IDR]!=0){
1051
1052 size2 = Rcv_DM0_Size[IDR];
1053
1054 /* allocation of array */
1055 tmp_array2 = (double*)malloc(sizeof(double)*size2);
1056
1057 MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
1058
1059 num = 0;
1060 for (k=0; k<2; k++){
1061 Mc_AN = F_TopMAN[IDR] - 1;
1062 for (n=0; n<F_Rcv_Num[IDR]; n++){
1063 Mc_AN++;
1064 Gc_AN = Rcv_GAN[IDR][n];
1065 Cwan = WhatSpecies[Gc_AN];
1066 tno1 = Spe_Total_NO[Cwan];
1067
1068 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1069 Gh_AN = natn[Gc_AN][h_AN];
1070 Hwan = WhatSpecies[Gh_AN];
1071 tno2 = Spe_Total_NO[Hwan];
1072 for (i=0; i<tno1; i++){
1073 for (j=0; j<tno2; j++){
1074 iDM0[k][Mc_AN][h_AN][i][j] = tmp_array2[num];
1075 num++;
1076 }
1077 }
1078 }
1079 }
1080 }
1081
1082 /* freeing of array */
1083 free(tmp_array2);
1084 }
1085
1086 if (F_Snd_Num[IDS]!=0){
1087 MPI_Wait(&request,&stat);
1088 free(tmp_array); /* freeing of array */
1089 }
1090 }
1091 }
1092
1093 /****************************************************
1094 calculate NC_OcpN
1095 ****************************************************/
1096
1097 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
1098
1099 dtime(&Stime_atom);
1100
1101 Gc_AN = M2G[Mc_AN];
1102 wan1 = WhatSpecies[Gc_AN];
1103
1104 for (i=0; i<Spe_Total_NO[wan1]; i++){
1105 for (j=0; j<Spe_Total_NO[wan1]; j++){
1106
1107 /* store NC_OcpN */
1108
1109 ReOcn00 = 0.0;
1110 ReOcn11 = 0.0;
1111 ReOcn01 = 0.0;
1112
1113 ImOcn00 = 0.0;
1114 ImOcn11 = 0.0;
1115 ImOcn01 = 0.0;
1116
1117 for (hL_AN=0; hL_AN<=FNAN[Gc_AN]; hL_AN++){
1118 GL_AN = natn[Gc_AN][hL_AN];
1119 ML_AN = F_G2M[GL_AN];
1120 Lwan = WhatSpecies[GL_AN];
1121
1122 for (hR_AN=0; hR_AN<=FNAN[Gc_AN]; hR_AN++){
1123 GR_AN = natn[Gc_AN][hR_AN];
1124 MR_AN = F_G2M[GR_AN];
1125 Rwan = WhatSpecies[GR_AN];
1126 kl = RMI1[Mc_AN][hL_AN][hR_AN];
1127
1128 if (0<=kl){
1129 for (m=0; m<Spe_Total_CNO[Lwan]; m++){
1130 for (n=0; n<Spe_Total_CNO[Rwan]; n++){
1131
1132 ReOcn00 += DM0[0][ML_AN][kl][m][n]*
1133 OLP[0][Mc_AN][hL_AN][i][m]*
1134 OLP[0][Mc_AN][hR_AN][j][n];
1135
1136 ReOcn11 += DM0[1][ML_AN][kl][m][n]*
1137 OLP[0][Mc_AN][hL_AN][i][m]*
1138 OLP[0][Mc_AN][hR_AN][j][n];
1139
1140 ReOcn01 += DM0[2][ML_AN][kl][m][n]*
1141 OLP[0][Mc_AN][hL_AN][i][m]*
1142 OLP[0][Mc_AN][hR_AN][j][n];
1143
1144 ImOcn00 +=iDM0[0][ML_AN][kl][m][n]*
1145 OLP[0][Mc_AN][hL_AN][i][m]*
1146 OLP[0][Mc_AN][hR_AN][j][n];
1147
1148 ImOcn11 +=iDM0[1][ML_AN][kl][m][n]*
1149 OLP[0][Mc_AN][hL_AN][i][m]*
1150 OLP[0][Mc_AN][hR_AN][j][n];
1151
1152 ImOcn01 += DM0[3][ML_AN][kl][m][n]*
1153 OLP[0][Mc_AN][hL_AN][i][m]*
1154 OLP[0][Mc_AN][hR_AN][j][n];
1155 }
1156 }
1157 }
1158 }
1159 }
1160
1161 NC_OcpN[0][0][0][Mc_AN][i][j].r = ReOcn00;
1162 NC_OcpN[0][1][1][Mc_AN][i][j].r = ReOcn11;
1163 NC_OcpN[0][0][1][Mc_AN][i][j].r = ReOcn01;
1164 NC_OcpN[0][1][0][Mc_AN][j][i].r = ReOcn01;
1165
1166 NC_OcpN[0][0][0][Mc_AN][i][j].i = ImOcn00;
1167 NC_OcpN[0][1][1][Mc_AN][i][j].i = ImOcn11;
1168 NC_OcpN[0][0][1][Mc_AN][i][j].i = ImOcn01;
1169 NC_OcpN[0][1][0][Mc_AN][j][i].i =-ImOcn01;
1170
1171 }
1172 }
1173
1174 dtime(&Etime_atom);
1175 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
1176
1177
1178
1179
1180 /*
1181 printf("Re 00 Gc_AN=%2d\n",Gc_AN);
1182 for (i=0; i<Spe_Total_NO[wan1]; i++){
1183 for (j=0; j<Spe_Total_NO[wan1]; j++){
1184 printf("%8.4f ",NC_OcpN[0][0][0][Mc_AN][i][j].r);
1185 }
1186 printf("\n");
1187 }
1188
1189 printf("Re 11 Gc_AN=%2d\n",Gc_AN);
1190 for (i=0; i<Spe_Total_NO[wan1]; i++){
1191 for (j=0; j<Spe_Total_NO[wan1]; j++){
1192 printf("%8.4f ",NC_OcpN[0][1][1][Mc_AN][i][j].r);
1193 }
1194 printf("\n");
1195 }
1196
1197 printf("Re 01 Gc_AN=%2d\n",Gc_AN);
1198 for (i=0; i<Spe_Total_NO[wan1]; i++){
1199 for (j=0; j<Spe_Total_NO[wan1]; j++){
1200 printf("%8.4f ",NC_OcpN[0][0][1][Mc_AN][i][j].r);
1201 }
1202 printf("\n");
1203 }
1204
1205 printf("Re 10 Gc_AN=%2d\n",Gc_AN);
1206 for (i=0; i<Spe_Total_NO[wan1]; i++){
1207 for (j=0; j<Spe_Total_NO[wan1]; j++){
1208 printf("%8.4f ",NC_OcpN[0][1][0][Mc_AN][i][j].r);
1209 }
1210 printf("\n");
1211 }
1212
1213 printf("Im 00 Gc_AN=%2d\n",Gc_AN);
1214 for (i=0; i<Spe_Total_NO[wan1]; i++){
1215 for (j=0; j<Spe_Total_NO[wan1]; j++){
1216 printf("%8.4f ",NC_OcpN[0][0][0][Mc_AN][i][j].i);
1217 }
1218 printf("\n");
1219 }
1220
1221 printf("Im 11 Gc_AN=%2d\n",Gc_AN);
1222 for (i=0; i<Spe_Total_NO[wan1]; i++){
1223 for (j=0; j<Spe_Total_NO[wan1]; j++){
1224 printf("%8.4f ",NC_OcpN[0][1][1][Mc_AN][i][j].i);
1225 }
1226 printf("\n");
1227 }
1228
1229 printf("Im 01 Gc_AN=%2d\n",Gc_AN);
1230 for (i=0; i<Spe_Total_NO[wan1]; i++){
1231 for (j=0; j<Spe_Total_NO[wan1]; j++){
1232 printf("%8.4f ",NC_OcpN[0][0][1][Mc_AN][i][j].i);
1233 }
1234 printf("\n");
1235 }
1236
1237 printf("Im 10 Gc_AN=%2d\n",Gc_AN);
1238 for (i=0; i<Spe_Total_NO[wan1]; i++){
1239 for (j=0; j<Spe_Total_NO[wan1]; j++){
1240 printf("%8.4f ",NC_OcpN[0][1][0][Mc_AN][i][j].i);
1241 }
1242 printf("\n");
1243 }
1244
1245 */
1246
1247
1248
1249 } /* Mc_AN */
1250 }
1251
1252 /****************************************************
1253 freeing of arrays:
1254
1255 int Cnt_index[List_YOUSO[25]+1]
1256 [List_YOUSO[24]]
1257 [2*(List_YOUSO[25]+1)+1];
1258
1259 double DM0[SpinP_switch+1]
1260 [Matomnum+MatomnumF+1]
1261 [FNAN[Gc_AN]+1]
1262 [Spe_Total_NO[Cwan]]
1263 [Spe_Total_NO[Hwan]]
1264
1265 int Snd_DM0_Size[numprocs];
1266 int Rcv_DM0_Size[numprocs];
1267 double Lsum[List_YOUSO[7]];
1268 double Rsum[List_YOUSO[7]];
1269 ****************************************************/
1270
1271 /* Cnt_index */
1272
1273 for (i=0; i<(List_YOUSO[25]+1); i++){
1274 for (j=0; j<List_YOUSO[24]; j++){
1275 free(Cnt_index[i][j]);
1276 }
1277 free(Cnt_index[i]);
1278 }
1279 free(Cnt_index);
1280
1281 /* DM0 */
1282
1283 for (k=0; k<=SpinP_switch; k++){
1284 FNAN[0] = 0;
1285 for (Mc_AN=0; Mc_AN<=(Matomnum+MatomnumF); Mc_AN++){
1286
1287 if (Mc_AN==0){
1288 Gc_AN = 0;
1289 tno0 = 1;
1290 }
1291 else{
1292 Gc_AN = F_M2G[Mc_AN];
1293 Cwan = WhatSpecies[Gc_AN];
1294 tno0 = Spe_Total_NO[Cwan];
1295 }
1296
1297 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1298
1299 if (Mc_AN==0){
1300 tno1 = 1;
1301 }
1302 else{
1303 Gh_AN = natn[Gc_AN][h_AN];
1304 Hwan = WhatSpecies[Gh_AN];
1305 tno1 = Spe_Total_NO[Hwan];
1306 }
1307
1308 for (i=0; i<tno0; i++){
1309 free(DM0[k][Mc_AN][h_AN][i]);
1310 }
1311 free(DM0[k][Mc_AN][h_AN]);
1312 }
1313 free(DM0[k][Mc_AN]);
1314 }
1315 free(DM0[k]);
1316 }
1317 free(DM0);
1318
1319 /* Snd_DM0_Size and Rcv_DM0_Size */
1320
1321 free(Snd_DM0_Size);
1322 free(Rcv_DM0_Size);
1323
1324 /* Lsum and Rsum */
1325
1326 free(Lsum);
1327 free(Rsum);
1328
1329 /* freeing of iDM0 */
1330
1331 if (SpinP_switch==3){
1332
1333 for (k=0; k<2; k++){
1334
1335 FNAN[0] = 0;
1336 for (Mc_AN=0; Mc_AN<=(Matomnum+MatomnumF); Mc_AN++){
1337
1338 if (Mc_AN==0){
1339 Gc_AN = 0;
1340 tno0 = 1;
1341 }
1342 else{
1343 Gc_AN = F_M2G[Mc_AN];
1344 Cwan = WhatSpecies[Gc_AN];
1345 tno0 = Spe_Total_NO[Cwan];
1346 }
1347
1348 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1349
1350 if (Mc_AN==0){
1351 tno1 = 1;
1352 }
1353 else{
1354 Gh_AN = natn[Gc_AN][h_AN];
1355 Hwan = WhatSpecies[Gh_AN];
1356 tno1 = Spe_Total_NO[Hwan];
1357 }
1358
1359 for (i=0; i<tno0; i++){
1360 free(iDM0[k][Mc_AN][h_AN][i]);
1361 }
1362 free(iDM0[k][Mc_AN][h_AN]);
1363 }
1364 free(iDM0[k][Mc_AN]);
1365 }
1366 free(iDM0[k]);
1367 }
1368 free(iDM0);
1369 }
1370
1371 }
1372
1373
1374
1375
occupation_dual()1376 void occupation_dual()
1377 {
1378 int l1,l2,mul1,mul2,mul3,mul4,m1,m2,to1,to2,to3,to4 ;
1379 int Mc_AN,Gc_AN,Cwan,num,l,m,n,mul,kl,hL_AN,hR_AN;
1380 int MR_AN,ML_AN,GR_AN,GL_AN,Rwan,Lwan,Mh_AN;
1381 int wan1,wan2,i,j,spin,size1,size2;
1382 int tno0,tno1,tno2,Hwan,h_AN,Gh_AN,k,p,p0;
1383 double Re11,Re22,Re12,Im12,d1,d2,d3;
1384 double theta,phi,sit,cot,sip,cop;
1385 double ReOcn00,ReOcn11,ReOcn01;
1386 double ImOcn00,ImOcn11,ImOcn01;
1387 double **DecMulP,***Primitive_DM;
1388 double *****DM0;
1389 double *****iDM0;
1390 int *Snd_DM0_Size,*Rcv_DM0_Size;
1391 double *tmp_array;
1392 double *tmp_array2;
1393 double Stime_atom, Etime_atom;
1394 double sden,tmp0,sum,ocn;
1395 int ***Cnt_index1,***Cnt_index2;
1396 int numprocs,myid,ID,IDS,IDR,tag=999;
1397
1398 MPI_Status stat;
1399 MPI_Request request;
1400
1401 /* MPI */
1402 MPI_Comm_size(mpi_comm_level1,&numprocs);
1403 MPI_Comm_rank(mpi_comm_level1,&myid);
1404
1405 /****************************************************
1406 allocation of arrays:
1407
1408 int Cnt_index1[List_YOUSO[25]+1]
1409 [List_YOUSO[24]]
1410 [2*(List_YOUSO[25]+1)+1];
1411
1412 int Cnt_index2[List_YOUSO[25]+1]
1413 [List_YOUSO[24]]
1414 [2*(List_YOUSO[25]+1)+1];
1415
1416 double DecMulP[SpinP_switch+1][List_YOUSO[7]];
1417 double Primitive_DM[SpinP_switch+1]
1418 [List_YOUSO[7]]
1419 [List_YOUSO[7]];
1420 ****************************************************/
1421
1422 /* Cnt_index1 and Cnt_index2 */
1423
1424 Cnt_index1 = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
1425 for (i=0; i<(List_YOUSO[25]+1); i++){
1426 Cnt_index1[i] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
1427 for (j=0; j<List_YOUSO[24]; j++){
1428 Cnt_index1[i][j] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
1429 }
1430 }
1431
1432 Cnt_index2 = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
1433 for (i=0; i<(List_YOUSO[25]+1); i++){
1434 Cnt_index2[i] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
1435 for (j=0; j<List_YOUSO[24]; j++){
1436 Cnt_index2[i][j] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
1437 }
1438 }
1439
1440 /* DecMulP */
1441
1442 DecMulP = (double**)malloc(sizeof(double*)*(SpinP_switch+1));
1443 for (spin=0; spin<=SpinP_switch; spin++){
1444 DecMulP[spin] = (double*)malloc(sizeof(double)*List_YOUSO[7]);
1445 }
1446
1447 /* Primitive_DM */
1448
1449 Primitive_DM = (double***)malloc(sizeof(double**)*(SpinP_switch+1));
1450 for (spin=0; spin<=SpinP_switch; spin++){
1451 Primitive_DM[spin] = (double**)malloc(sizeof(double*)*List_YOUSO[7]);
1452 for (i=0; i<List_YOUSO[7]; i++){
1453 Primitive_DM[spin][i] = (double*)malloc(sizeof(double)*List_YOUSO[7]);
1454 }
1455 }
1456
1457 /****************************************************
1458 collinear case
1459 ****************************************************/
1460
1461 if (SpinP_switch!=3){
1462
1463 /****************************************************
1464 calculate DM_onsite
1465 ****************************************************/
1466
1467 if (Cnt_switch==0){
1468
1469 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
1470
1471 dtime(&Stime_atom);
1472
1473 Gc_AN = M2G[Mc_AN];
1474 wan1 = WhatSpecies[Gc_AN];
1475
1476 for (spin=0; spin<=SpinP_switch; spin++){
1477
1478 for (m=0; m<Spe_Total_NO[wan1]; m++){
1479 for (n=0; n<Spe_Total_NO[wan1]; n++){
1480
1481 tmp0 = 0.0;
1482 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1483 Gh_AN = natn[Gc_AN][h_AN];
1484 wan2 = WhatSpecies[Gh_AN];
1485 for (k=0; k<Spe_Total_NO[wan2]; k++){
1486 tmp0 += 0.5*( DM[0][spin][Mc_AN][h_AN][n][k]*OLP[0][Mc_AN][h_AN][m][k]
1487 + DM[0][spin][Mc_AN][h_AN][m][k]*OLP[0][Mc_AN][h_AN][n][k]);
1488 }
1489 }
1490
1491 DM_onsite[0][spin][Mc_AN][m][n] = tmp0;
1492 }
1493 }
1494 } /* spin */
1495
1496 dtime(&Etime_atom);
1497 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
1498
1499 } /* Mc_AN */
1500 }
1501
1502 /***********************************
1503 In case of orbital optimization
1504
1505 Important note:
1506 In case of orbital optimization,
1507 the U potential is applied to
1508 the primitive orbital.
1509 ***********************************/
1510
1511 else {
1512
1513 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
1514
1515 dtime(&Stime_atom);
1516
1517 Gc_AN = M2G[Mc_AN];
1518 wan1 = WhatSpecies[Gc_AN];
1519
1520 to3 = 0;
1521 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
1522 for(mul3=0; mul3<Spe_Num_CBasis[wan1][l1]; mul3++){
1523 for(m1=0; m1<(2*l1+1); m1++){
1524 Cnt_index1[l1][mul3][m1] = to3;
1525 to3++;
1526 }
1527 }
1528 }
1529
1530 for (spin=0; spin<=SpinP_switch; spin++){
1531 for (i=0; i<Spe_Total_NO[wan1]; i++){
1532 for (j=0; j<Spe_Total_NO[wan1]; j++){
1533 DM_onsite[0][spin][Mc_AN][i][j] = 0.0;
1534 }
1535 }
1536 }
1537
1538 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1539
1540 Gh_AN = natn[Gc_AN][h_AN];
1541 Mh_AN = F_G2M[Gh_AN];
1542 wan2 = WhatSpecies[Gh_AN];
1543
1544 to3 = 0;
1545 for(l1=0; l1<=Spe_MaxL_Basis[wan2]; l1++){
1546 for(mul3=0; mul3<Spe_Num_CBasis[wan2][l1]; mul3++){
1547 for(m1=0; m1<(2*l1+1); m1++){
1548 Cnt_index2[l1][mul3][m1] = to3;
1549 to3++;
1550 }
1551 }
1552 }
1553
1554 /* transform DM of contracted to that of primitive orbitals */
1555
1556 for (spin=0; spin<=SpinP_switch; spin++){
1557
1558 to1 = 0;
1559 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
1560 for(mul1=0; mul1<Spe_Num_Basis[wan1][l1]; mul1++){
1561 for(m1=0; m1<(2*l1+1); m1++){
1562
1563 to2 = 0;
1564 for(l2=0; l2<=Spe_MaxL_Basis[wan2]; l2++){
1565 for(mul2=0; mul2<Spe_Num_Basis[wan2][l2]; mul2++){
1566 for(m2=0; m2<(2*l2+1); m2++){
1567
1568 sum = 0.0;
1569 for(mul3=0; mul3<Spe_Num_CBasis[wan1][l1]; mul3++){
1570 for(mul4=0; mul4<Spe_Num_CBasis[wan2][l2]; mul4++){
1571
1572 to3 = Cnt_index1[l1][mul3][m1];
1573 to4 = Cnt_index2[l2][mul4][m2];
1574
1575 sum += CntCoes[Mc_AN][to3][mul1]*CntCoes[Mh_AN][to4][mul2]
1576 *DM[0][spin][Mc_AN][h_AN][to3][to4];
1577 }
1578 }
1579
1580 Primitive_DM[spin][to1][to2] = sum;
1581
1582 to2++;
1583
1584 }
1585 }
1586 }
1587
1588 to1++;
1589
1590 }
1591 }
1592 }
1593 } /* spin */
1594
1595 /* calculate DM_onsite with respect to primitive orbitals */
1596
1597 for (spin=0; spin<=SpinP_switch; spin++){
1598 for (m=0; m<Spe_Total_NO[wan1]; m++){
1599 for (n=0; n<Spe_Total_NO[wan1]; n++){
1600
1601 tmp0 = 0.0;
1602 for (k=0; k<Spe_Total_NO[wan2]; k++){
1603 tmp0 += 0.5*( Primitive_DM[spin][n][k]*OLP[0][Mc_AN][h_AN][m][k]
1604 + Primitive_DM[spin][m][k]*OLP[0][Mc_AN][h_AN][n][k]);
1605 }
1606
1607 DM_onsite[0][spin][Mc_AN][m][n] += tmp0;
1608 }
1609 }
1610 }
1611
1612 } /* h_AN */
1613
1614 dtime(&Etime_atom);
1615 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
1616
1617 } /* Mc_AN */
1618 } /* else */
1619
1620
1621 /*
1622 for (spin=0; spin<=SpinP_switch; spin++){
1623 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
1624 printf("DM_onsite spin=%2d Mc_AN=%2d \n",spin,Mc_AN);
1625
1626 Gc_AN = M2G[Mc_AN];
1627 wan1 = WhatSpecies[Gc_AN];
1628
1629 for (m=0; m<Spe_Total_NO[wan1]; m++){
1630 for (n=0; n<Spe_Total_NO[wan1]; n++){
1631 printf("%8.4f ",DM_onsite[0][spin][Mc_AN][m][n]);
1632 }
1633 printf("\n");
1634 }
1635 }
1636 }
1637 */
1638
1639 /*
1640 for (spin=0; spin<=SpinP_switch; spin++){
1641 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
1642 Gc_AN = M2G[Mc_AN];
1643 wan1 = WhatSpecies[Gc_AN];
1644 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1645 printf("DM spin=%2d Mc_AN=%2d h_AN=%2d\n",spin,Mc_AN,h_AN);
1646 for (m=0; m<Spe_Total_NO[wan1]; m++){
1647 for (n=0; n<Spe_Total_NO[wan1]; n++){
1648 printf("%8.4f ",DM[0][spin][Mc_AN][h_AN][m][n]);
1649 }
1650 printf("\n");
1651 }
1652 }
1653 }
1654 }
1655 */
1656
1657 }
1658
1659 /****************************************************
1660 non-collinear case
1661 ****************************************************/
1662
1663 else{
1664
1665 /* DM0 */
1666
1667 DM0 = (double*****)malloc(sizeof(double****)*(SpinP_switch+1));
1668 for (k=0; k<=SpinP_switch; k++){
1669 DM0[k] = (double****)malloc(sizeof(double***)*(Matomnum+MatomnumF+1));
1670 FNAN[0] = 0;
1671 for (Mc_AN=0; Mc_AN<=(Matomnum+MatomnumF); Mc_AN++){
1672
1673 if (Mc_AN==0){
1674 Gc_AN = 0;
1675 tno0 = 1;
1676 }
1677 else{
1678 Gc_AN = F_M2G[Mc_AN];
1679 Cwan = WhatSpecies[Gc_AN];
1680 tno0 = Spe_Total_NO[Cwan];
1681 }
1682
1683 DM0[k][Mc_AN] = (double***)malloc(sizeof(double**)*(FNAN[Gc_AN]+1));
1684 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1685
1686 if (Mc_AN==0){
1687 tno1 = 1;
1688 }
1689 else{
1690 Gh_AN = natn[Gc_AN][h_AN];
1691 Hwan = WhatSpecies[Gh_AN];
1692 tno1 = Spe_Total_NO[Hwan];
1693 }
1694
1695 DM0[k][Mc_AN][h_AN] = (double**)malloc(sizeof(double*)*tno0);
1696 for (i=0; i<tno0; i++){
1697 DM0[k][Mc_AN][h_AN][i] = (double*)malloc(sizeof(double)*tno1);
1698 }
1699 }
1700 }
1701 }
1702
1703 /* Snd_DM0_Size and Rcv_DM0_Size */
1704
1705 Snd_DM0_Size = (int*)malloc(sizeof(int)*numprocs);
1706 Rcv_DM0_Size = (int*)malloc(sizeof(int)*numprocs);
1707
1708 /****************************************************
1709 DM[k][Matomnum] -> DM0
1710 ****************************************************/
1711
1712 for (k=0; k<=SpinP_switch; k++){
1713 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
1714 Gc_AN = M2G[Mc_AN];
1715 wan1 = WhatSpecies[Gc_AN];
1716 tno1 = Spe_Total_NO[wan1];
1717 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1718 Gh_AN = natn[Gc_AN][h_AN];
1719 Hwan = WhatSpecies[Gh_AN];
1720 tno2 = Spe_Total_NO[Hwan];
1721 for (i=0; i<tno1; i++){
1722 for (j=0; j<tno2; j++){
1723 DM0[k][Mc_AN][h_AN][i][j] = DM[0][k][Mc_AN][h_AN][i][j];
1724 }
1725 }
1726 }
1727 }
1728 }
1729
1730 /****************************************************
1731 MPI: DM0
1732 ****************************************************/
1733
1734 /***********************************
1735 set data size
1736 ************************************/
1737
1738 for (ID=0; ID<numprocs; ID++){
1739
1740 IDS = (myid + ID) % numprocs;
1741 IDR = (myid - ID + numprocs) % numprocs;
1742
1743 if (ID!=0){
1744 tag = 999;
1745
1746 /* find data size to send block data */
1747 if (F_Snd_Num[IDS]!=0){
1748
1749 size1 = 0;
1750 for (k=0; k<=SpinP_switch; k++){
1751 for (n=0; n<F_Snd_Num[IDS]; n++){
1752 Mc_AN = Snd_MAN[IDS][n];
1753 Gc_AN = Snd_GAN[IDS][n];
1754 Cwan = WhatSpecies[Gc_AN];
1755 tno1 = Spe_Total_NO[Cwan];
1756 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1757 Gh_AN = natn[Gc_AN][h_AN];
1758 Hwan = WhatSpecies[Gh_AN];
1759 tno2 = Spe_Total_NO[Hwan];
1760 size1 += tno1*tno2;
1761 }
1762 }
1763 }
1764
1765 Snd_DM0_Size[IDS] = size1;
1766 MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
1767 }
1768 else{
1769 Snd_DM0_Size[IDS] = 0;
1770 }
1771
1772 /* receiving of size of data */
1773
1774 if (F_Rcv_Num[IDR]!=0){
1775 MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
1776 Rcv_DM0_Size[IDR] = size2;
1777 }
1778 else{
1779 Rcv_DM0_Size[IDR] = 0;
1780 }
1781
1782 if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
1783
1784 }
1785 }
1786
1787 /***********************************
1788 data transfer
1789 ************************************/
1790
1791 tag = 999;
1792 for (ID=0; ID<numprocs; ID++){
1793
1794 IDS = (myid + ID) % numprocs;
1795 IDR = (myid - ID + numprocs) % numprocs;
1796
1797 if (ID!=0){
1798
1799 /*****************************
1800 sending of data
1801 *****************************/
1802
1803 if (F_Snd_Num[IDS]!=0){
1804
1805 size1 = Snd_DM0_Size[IDS];
1806
1807 /* allocation of array */
1808
1809 tmp_array = (double*)malloc(sizeof(double)*size1);
1810
1811 /* multidimentional array to vector array */
1812
1813 num = 0;
1814 for (k=0; k<=SpinP_switch; k++){
1815 for (n=0; n<F_Snd_Num[IDS]; n++){
1816 Mc_AN = Snd_MAN[IDS][n];
1817 Gc_AN = Snd_GAN[IDS][n];
1818 Cwan = WhatSpecies[Gc_AN];
1819 tno1 = Spe_Total_NO[Cwan];
1820 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1821 Gh_AN = natn[Gc_AN][h_AN];
1822 Hwan = WhatSpecies[Gh_AN];
1823 tno2 = Spe_Total_NO[Hwan];
1824 for (i=0; i<tno1; i++){
1825 for (j=0; j<tno2; j++){
1826 tmp_array[num] = DM0[k][Mc_AN][h_AN][i][j];
1827 num++;
1828 }
1829 }
1830 }
1831 }
1832 }
1833
1834 MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
1835
1836 }
1837
1838 /*****************************
1839 receiving of block data
1840 *****************************/
1841
1842 if (F_Rcv_Num[IDR]!=0){
1843
1844 size2 = Rcv_DM0_Size[IDR];
1845
1846 /* allocation of array */
1847 tmp_array2 = (double*)malloc(sizeof(double)*size2);
1848
1849 MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
1850
1851 num = 0;
1852 for (k=0; k<=SpinP_switch; k++){
1853 Mc_AN = F_TopMAN[IDR] - 1;
1854 for (n=0; n<F_Rcv_Num[IDR]; n++){
1855 Mc_AN++;
1856 Gc_AN = Rcv_GAN[IDR][n];
1857 Cwan = WhatSpecies[Gc_AN];
1858 tno1 = Spe_Total_NO[Cwan];
1859
1860 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1861 Gh_AN = natn[Gc_AN][h_AN];
1862 Hwan = WhatSpecies[Gh_AN];
1863 tno2 = Spe_Total_NO[Hwan];
1864 for (i=0; i<tno1; i++){
1865 for (j=0; j<tno2; j++){
1866 DM0[k][Mc_AN][h_AN][i][j] = tmp_array2[num];
1867 num++;
1868 }
1869 }
1870 }
1871 }
1872 }
1873
1874 /* freeing of array */
1875 free(tmp_array2);
1876 }
1877
1878 if (F_Snd_Num[IDS]!=0){
1879 MPI_Wait(&request,&stat);
1880 free(tmp_array); /* freeing of array */
1881 }
1882 }
1883 }
1884
1885 /* allocation of iDM0 */
1886
1887 iDM0 = (double*****)malloc(sizeof(double****)*2);
1888 for (k=0; k<2; k++){
1889 iDM0[k] = (double****)malloc(sizeof(double***)*(Matomnum+MatomnumF+1));
1890 FNAN[0] = 0;
1891 for (Mc_AN=0; Mc_AN<=(Matomnum+MatomnumF); Mc_AN++){
1892
1893 if (Mc_AN==0){
1894 Gc_AN = 0;
1895 tno0 = 1;
1896 }
1897 else{
1898 Gc_AN = F_M2G[Mc_AN];
1899 Cwan = WhatSpecies[Gc_AN];
1900 tno0 = Spe_Total_NO[Cwan];
1901 }
1902
1903 iDM0[k][Mc_AN] = (double***)malloc(sizeof(double**)*(FNAN[Gc_AN]+1));
1904 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1905
1906 if (Mc_AN==0){
1907 tno1 = 1;
1908 }
1909 else{
1910 Gh_AN = natn[Gc_AN][h_AN];
1911 Hwan = WhatSpecies[Gh_AN];
1912 tno1 = Spe_Total_NO[Hwan];
1913 }
1914
1915 iDM0[k][Mc_AN][h_AN] = (double**)malloc(sizeof(double*)*tno0);
1916 for (i=0; i<tno0; i++){
1917 iDM0[k][Mc_AN][h_AN][i] = (double*)malloc(sizeof(double)*tno1);
1918 }
1919 }
1920 }
1921 }
1922
1923 /****************************************************
1924 iDM[0][k][Matomnum] -> iDM0
1925 ****************************************************/
1926
1927 for (k=0; k<2; k++){
1928 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
1929 Gc_AN = M2G[Mc_AN];
1930 wan1 = WhatSpecies[Gc_AN];
1931 tno1 = Spe_Total_NO[wan1];
1932 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1933 Gh_AN = natn[Gc_AN][h_AN];
1934 Hwan = WhatSpecies[Gh_AN];
1935 tno2 = Spe_Total_NO[Hwan];
1936 for (i=0; i<tno1; i++){
1937 for (j=0; j<tno2; j++){
1938 iDM0[k][Mc_AN][h_AN][i][j] = iDM[0][k][Mc_AN][h_AN][i][j];
1939 }
1940 }
1941 }
1942 }
1943 }
1944
1945 /****************************************************
1946 MPI: iDM0
1947 ****************************************************/
1948
1949 /***********************************
1950 set data size
1951 ************************************/
1952
1953 for (ID=0; ID<numprocs; ID++){
1954
1955 IDS = (myid + ID) % numprocs;
1956 IDR = (myid - ID + numprocs) % numprocs;
1957
1958 if (ID!=0){
1959 tag = 999;
1960
1961 /* find data size to send block data */
1962 if (F_Snd_Num[IDS]!=0){
1963
1964 size1 = 0;
1965 for (k=0; k<2; k++){
1966 for (n=0; n<F_Snd_Num[IDS]; n++){
1967 Mc_AN = Snd_MAN[IDS][n];
1968 Gc_AN = Snd_GAN[IDS][n];
1969 Cwan = WhatSpecies[Gc_AN];
1970 tno1 = Spe_Total_NO[Cwan];
1971 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
1972 Gh_AN = natn[Gc_AN][h_AN];
1973 Hwan = WhatSpecies[Gh_AN];
1974 tno2 = Spe_Total_NO[Hwan];
1975 size1 += tno1*tno2;
1976 }
1977 }
1978 }
1979
1980 Snd_DM0_Size[IDS] = size1;
1981 MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
1982 }
1983 else{
1984 Snd_DM0_Size[IDS] = 0;
1985 }
1986
1987 /* receiving of size of data */
1988
1989 if (F_Rcv_Num[IDR]!=0){
1990 MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
1991 Rcv_DM0_Size[IDR] = size2;
1992 }
1993 else{
1994 Rcv_DM0_Size[IDR] = 0;
1995 }
1996
1997 if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
1998
1999 }
2000 }
2001
2002 /***********************************
2003 data transfer
2004 ************************************/
2005
2006 tag = 999;
2007 for (ID=0; ID<numprocs; ID++){
2008
2009 IDS = (myid + ID) % numprocs;
2010 IDR = (myid - ID + numprocs) % numprocs;
2011
2012 if (ID!=0){
2013
2014 /*****************************
2015 sending of data
2016 *****************************/
2017
2018 if (F_Snd_Num[IDS]!=0){
2019
2020 size1 = Snd_DM0_Size[IDS];
2021
2022 /* allocation of array */
2023
2024 tmp_array = (double*)malloc(sizeof(double)*size1);
2025
2026 /* multidimentional array to vector array */
2027
2028 num = 0;
2029 for (k=0; k<2; k++){
2030 for (n=0; n<F_Snd_Num[IDS]; n++){
2031 Mc_AN = Snd_MAN[IDS][n];
2032 Gc_AN = Snd_GAN[IDS][n];
2033 Cwan = WhatSpecies[Gc_AN];
2034 tno1 = Spe_Total_NO[Cwan];
2035 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
2036 Gh_AN = natn[Gc_AN][h_AN];
2037 Hwan = WhatSpecies[Gh_AN];
2038 tno2 = Spe_Total_NO[Hwan];
2039 for (i=0; i<tno1; i++){
2040 for (j=0; j<tno2; j++){
2041 tmp_array[num] = iDM0[k][Mc_AN][h_AN][i][j];
2042 num++;
2043 }
2044 }
2045 }
2046 }
2047 }
2048
2049 MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
2050
2051 }
2052
2053 /*****************************
2054 receiving of block data
2055 *****************************/
2056
2057 if (F_Rcv_Num[IDR]!=0){
2058
2059 size2 = Rcv_DM0_Size[IDR];
2060
2061 /* allocation of array */
2062 tmp_array2 = (double*)malloc(sizeof(double)*size2);
2063
2064 MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
2065
2066 num = 0;
2067 for (k=0; k<2; k++){
2068 Mc_AN = F_TopMAN[IDR] - 1;
2069 for (n=0; n<F_Rcv_Num[IDR]; n++){
2070 Mc_AN++;
2071 Gc_AN = Rcv_GAN[IDR][n];
2072 Cwan = WhatSpecies[Gc_AN];
2073 tno1 = Spe_Total_NO[Cwan];
2074
2075 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
2076 Gh_AN = natn[Gc_AN][h_AN];
2077 Hwan = WhatSpecies[Gh_AN];
2078 tno2 = Spe_Total_NO[Hwan];
2079 for (i=0; i<tno1; i++){
2080 for (j=0; j<tno2; j++){
2081 iDM0[k][Mc_AN][h_AN][i][j] = tmp_array2[num];
2082 num++;
2083 }
2084 }
2085 }
2086 }
2087 }
2088
2089 /* freeing of array */
2090 free(tmp_array2);
2091 }
2092
2093 if (F_Snd_Num[IDS]!=0){
2094 MPI_Wait(&request,&stat);
2095 free(tmp_array); /* freeing of array */
2096 }
2097 }
2098 }
2099
2100 /****************************************************
2101 calculate NC_OcpN
2102 ****************************************************/
2103
2104 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
2105
2106 dtime(&Stime_atom);
2107
2108 Gc_AN = M2G[Mc_AN];
2109 wan1 = WhatSpecies[Gc_AN];
2110
2111 for (m=0; m<Spe_Total_NO[wan1]; m++){
2112 for (n=0; n<Spe_Total_NO[wan1]; n++){
2113
2114 ReOcn00 = 0.0;
2115 ReOcn11 = 0.0;
2116 ReOcn01 = 0.0;
2117
2118 ImOcn00 = 0.0;
2119 ImOcn11 = 0.0;
2120 ImOcn01 = 0.0;
2121
2122 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
2123 Gh_AN = natn[Gc_AN][h_AN];
2124 Mh_AN = F_G2M[Gh_AN];
2125 wan2 = WhatSpecies[Gh_AN];
2126 kl = RMI1[Mc_AN][h_AN][0];
2127
2128 for (k=0; k<Spe_Total_NO[wan2]; k++){
2129
2130 ReOcn00 += 0.5*( DM0[0][Mc_AN][h_AN][m][k]*OLP[0][Mc_AN][h_AN][n][k]
2131 + DM0[0][Mh_AN][kl ][k][n]*OLP[0][Mc_AN][h_AN][m][k]);
2132
2133 ReOcn11 += 0.5*( DM0[1][Mc_AN][h_AN][m][k]*OLP[0][Mc_AN][h_AN][n][k]
2134 + DM0[1][Mh_AN][kl ][k][n]*OLP[0][Mc_AN][h_AN][m][k]);
2135
2136 ReOcn01 += 0.5*( DM0[2][Mc_AN][h_AN][m][k]*OLP[0][Mc_AN][h_AN][n][k]
2137 + DM0[2][Mh_AN][kl ][k][n]*OLP[0][Mc_AN][h_AN][m][k]);
2138
2139 ImOcn00 += 0.5*(iDM0[0][Mc_AN][h_AN][m][k]*OLP[0][Mc_AN][h_AN][n][k]
2140 +iDM0[0][Mh_AN][kl ][k][n]*OLP[0][Mc_AN][h_AN][m][k]);
2141
2142 ImOcn11 += 0.5*(iDM0[1][Mc_AN][h_AN][m][k]*OLP[0][Mc_AN][h_AN][n][k]
2143 +iDM0[1][Mh_AN][kl ][k][n]*OLP[0][Mc_AN][h_AN][m][k]);
2144
2145 ImOcn01 += 0.5*( DM0[3][Mc_AN][h_AN][m][k]*OLP[0][Mc_AN][h_AN][n][k]
2146 + DM0[3][Mh_AN][kl ][k][n]*OLP[0][Mc_AN][h_AN][m][k]);
2147
2148 }
2149 }
2150
2151 NC_OcpN[0][0][0][Mc_AN][m][n].r = ReOcn00;
2152 NC_OcpN[0][1][1][Mc_AN][m][n].r = ReOcn11;
2153 NC_OcpN[0][0][1][Mc_AN][m][n].r = ReOcn01;
2154 NC_OcpN[0][1][0][Mc_AN][n][m].r = ReOcn01;
2155
2156 NC_OcpN[0][0][0][Mc_AN][m][n].i = ImOcn00;
2157 NC_OcpN[0][1][1][Mc_AN][m][n].i = ImOcn11;
2158 NC_OcpN[0][0][1][Mc_AN][m][n].i = ImOcn01;
2159 NC_OcpN[0][1][0][Mc_AN][n][m].i =-ImOcn01;
2160 }
2161 }
2162
2163 dtime(&Etime_atom);
2164 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
2165
2166
2167 /*
2168 printf("Re 00 Gc_AN=%2d\n",Gc_AN);
2169 for (i=0; i<Spe_Total_NO[wan1]; i++){
2170 for (j=0; j<Spe_Total_NO[wan1]; j++){
2171 printf("%8.4f ",NC_OcpN[0][0][0][Mc_AN][i][j].r);
2172 }
2173 printf("\n");
2174 }
2175
2176 printf("Re 11 Gc_AN=%2d\n",Gc_AN);
2177 for (i=0; i<Spe_Total_NO[wan1]; i++){
2178 for (j=0; j<Spe_Total_NO[wan1]; j++){
2179 printf("%8.4f ",NC_OcpN[0][1][1][Mc_AN][i][j].r);
2180 }
2181 printf("\n");
2182 }
2183
2184 printf("Re 01 Gc_AN=%2d\n",Gc_AN);
2185 for (i=0; i<Spe_Total_NO[wan1]; i++){
2186 for (j=0; j<Spe_Total_NO[wan1]; j++){
2187 printf("%8.4f ",NC_OcpN[0][0][1][Mc_AN][i][j].r);
2188 }
2189 printf("\n");
2190 }
2191
2192 printf("Re 10 Gc_AN=%2d\n",Gc_AN);
2193 for (i=0; i<Spe_Total_NO[wan1]; i++){
2194 for (j=0; j<Spe_Total_NO[wan1]; j++){
2195 printf("%8.4f ",NC_OcpN[0][1][0][Mc_AN][i][j].r);
2196 }
2197 printf("\n");
2198 }
2199
2200 printf("Im 00 Gc_AN=%2d\n",Gc_AN);
2201 for (i=0; i<Spe_Total_NO[wan1]; i++){
2202 for (j=0; j<Spe_Total_NO[wan1]; j++){
2203 printf("%8.4f ",NC_OcpN[0][0][0][Mc_AN][i][j].i);
2204 }
2205 printf("\n");
2206 }
2207
2208 printf("Im 11 Gc_AN=%2d\n",Gc_AN);
2209 for (i=0; i<Spe_Total_NO[wan1]; i++){
2210 for (j=0; j<Spe_Total_NO[wan1]; j++){
2211 printf("%8.4f ",NC_OcpN[0][1][1][Mc_AN][i][j].i);
2212 }
2213 printf("\n");
2214 }
2215
2216 printf("Im 01 Gc_AN=%2d\n",Gc_AN);
2217 for (i=0; i<Spe_Total_NO[wan1]; i++){
2218 for (j=0; j<Spe_Total_NO[wan1]; j++){
2219 printf("%8.4f ",NC_OcpN[0][0][1][Mc_AN][i][j].i);
2220 }
2221 printf("\n");
2222 }
2223
2224 printf("Im 10 Gc_AN=%2d\n",Gc_AN);
2225 for (i=0; i<Spe_Total_NO[wan1]; i++){
2226 for (j=0; j<Spe_Total_NO[wan1]; j++){
2227 printf("%8.4f ",NC_OcpN[0][1][0][Mc_AN][i][j].i);
2228 }
2229 printf("\n");
2230 }
2231 */
2232
2233
2234 /*
2235 for (spin=0; spin<=SpinP_switch; spin++){
2236 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
2237 Gc_AN = M2G[Mc_AN];
2238 wan1 = WhatSpecies[Gc_AN];
2239 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
2240 printf("DM spin=%2d Mc_AN=%2d h_AN=%2d\n",spin,Mc_AN,h_AN);
2241 for (m=0; m<Spe_Total_NO[wan1]; m++){
2242 for (n=0; n<Spe_Total_NO[wan1]; n++){
2243 printf("%8.4f ",DM[0][spin][Mc_AN][h_AN][m][n]);
2244 }
2245 printf("\n");
2246 }
2247 }
2248 }
2249 }
2250 */
2251
2252 } /* Mc_AN */
2253
2254 /****************************************************
2255 freeing of arrays:
2256 ****************************************************/
2257
2258 /* DM0 */
2259
2260 for (k=0; k<=SpinP_switch; k++){
2261 FNAN[0] = 0;
2262 for (Mc_AN=0; Mc_AN<=(Matomnum+MatomnumF); Mc_AN++){
2263
2264 if (Mc_AN==0){
2265 Gc_AN = 0;
2266 tno0 = 1;
2267 }
2268 else{
2269 Gc_AN = F_M2G[Mc_AN];
2270 Cwan = WhatSpecies[Gc_AN];
2271 tno0 = Spe_Total_NO[Cwan];
2272 }
2273
2274 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
2275
2276 if (Mc_AN==0){
2277 tno1 = 1;
2278 }
2279 else{
2280 Gh_AN = natn[Gc_AN][h_AN];
2281 Hwan = WhatSpecies[Gh_AN];
2282 tno1 = Spe_Total_NO[Hwan];
2283 }
2284
2285 for (i=0; i<tno0; i++){
2286 free(DM0[k][Mc_AN][h_AN][i]);
2287 }
2288 free(DM0[k][Mc_AN][h_AN]);
2289 }
2290 free(DM0[k][Mc_AN]);
2291 }
2292 free(DM0[k]);
2293 }
2294 free(DM0);
2295
2296 /* Snd_DM0_Size and Rcv_DM0_Size */
2297
2298 free(Snd_DM0_Size);
2299 free(Rcv_DM0_Size);
2300
2301 /* iDM0 */
2302
2303 for (k=0; k<2; k++){
2304
2305 FNAN[0] = 0;
2306 for (Mc_AN=0; Mc_AN<=(Matomnum+MatomnumF); Mc_AN++){
2307
2308 if (Mc_AN==0){
2309 Gc_AN = 0;
2310 tno0 = 1;
2311 }
2312 else{
2313 Gc_AN = F_M2G[Mc_AN];
2314 Cwan = WhatSpecies[Gc_AN];
2315 tno0 = Spe_Total_NO[Cwan];
2316 }
2317
2318 for (h_AN=0; h_AN<=FNAN[Gc_AN]; h_AN++){
2319
2320 if (Mc_AN==0){
2321 tno1 = 1;
2322 }
2323 else{
2324 Gh_AN = natn[Gc_AN][h_AN];
2325 Hwan = WhatSpecies[Gh_AN];
2326 tno1 = Spe_Total_NO[Hwan];
2327 }
2328
2329 for (i=0; i<tno0; i++){
2330 free(iDM0[k][Mc_AN][h_AN][i]);
2331 }
2332 free(iDM0[k][Mc_AN][h_AN]);
2333 }
2334 free(iDM0[k][Mc_AN]);
2335 }
2336 free(iDM0[k]);
2337 }
2338 free(iDM0);
2339
2340 }
2341
2342 /****************************************************
2343 freeing of arrays:
2344
2345 int Cnt_index1[List_YOUSO[25]+1]
2346 [List_YOUSO[24]]
2347 [2*(List_YOUSO[25]+1)+1];
2348
2349 int Cnt_index2[List_YOUSO[25]+1]
2350 [List_YOUSO[24]]
2351 [2*(List_YOUSO[25]+1)+1];
2352
2353 double DecMulP[SpinP_switch+1][List_YOUSO[7]];
2354 double Primitive_DM[SpinP_switch+1]
2355 [List_YOUSO[7]]
2356 [List_YOUSO[7]];
2357 ****************************************************/
2358
2359 /* Cnt_index1 and Cnt_index2 */
2360
2361 for (i=0; i<(List_YOUSO[25]+1); i++){
2362 for (j=0; j<List_YOUSO[24]; j++){
2363 free(Cnt_index1[i][j]);
2364 }
2365 free(Cnt_index1[i]);
2366 }
2367 free(Cnt_index1);
2368
2369 for (i=0; i<(List_YOUSO[25]+1); i++){
2370 for (j=0; j<List_YOUSO[24]; j++){
2371 free(Cnt_index2[i][j]);
2372 }
2373 free(Cnt_index2[i]);
2374 }
2375 free(Cnt_index2);
2376
2377 /* DecMulP */
2378
2379 for (spin=0; spin<=SpinP_switch; spin++){
2380 free(DecMulP[spin]);
2381 }
2382 free(DecMulP);
2383
2384 /* Primitive_DM */
2385
2386 for (spin=0; spin<=SpinP_switch; spin++){
2387 for (i=0; i<List_YOUSO[7]; i++){
2388 free(Primitive_DM[spin][i]);
2389 }
2390 free(Primitive_DM[spin]);
2391 }
2392 free(Primitive_DM);
2393
2394 }
2395
2396
2397
2398
2399
Induce_Orbital_Polarization(int Mc_AN)2400 void Induce_Orbital_Polarization(int Mc_AN)
2401 {
2402 int wan1,Gc_AN,spin,spinmax;
2403 int i,j,to1,to2,l1,mul1,m0,m1,m2,m3;
2404 int ***trans_index;
2405 double **a,*ko;
2406 double sum1,tmp1,tmp2;
2407 double toccpn[5];
2408 double Ncut=0.3;
2409 int Ns;
2410
2411 Gc_AN = M2G[Mc_AN];
2412 wan1 = WhatSpecies[Gc_AN];
2413
2414 if (SpinP_switch==0) spinmax = 0;
2415 else spinmax = 1;
2416
2417 /* allocation of arrays */
2418
2419 trans_index = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
2420 for(l1=0; l1<(List_YOUSO[25]+1); l1++){
2421 trans_index[l1] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
2422 for(mul1=0; mul1<List_YOUSO[24]; mul1++){
2423 trans_index[l1][mul1] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
2424 }
2425 }
2426
2427 Ns = 20;
2428
2429 a = (double**)malloc(sizeof(double*)*Ns);
2430 for (i=0; i<Ns; i++){
2431 a[i] = (double*)malloc(sizeof(double)*Ns);
2432 }
2433
2434 ko = (double*)malloc(sizeof(double)*Ns);
2435
2436 /* set trans_index */
2437
2438 to1 = 0;
2439 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
2440 for(mul1=0; mul1<Spe_Num_Basis[wan1][l1]; mul1++){
2441 for(m1=0; m1<(2*l1+1); m1++){
2442 trans_index[l1][mul1][m1] = to1;
2443 to1++;
2444 }
2445 }
2446 }
2447
2448 /*****************************************
2449 induce orbital polaization
2450 *****************************************/
2451
2452 if (OrbPol_flag[Gc_AN]!=0){
2453
2454 mul1 = 0;
2455
2456 for(l1=2; l1<=Spe_MaxL_Basis[wan1]; l1++){
2457 for (spin=0; spin<=spinmax; spin++){
2458
2459 for(m1=0; m1<(2*l1+1); m1++){
2460 for(m2=0; m2<(2*l1+1); m2++){
2461 to1 = trans_index[l1][mul1][m1];
2462 to2 = trans_index[l1][mul1][m2];
2463 a[m1+1][m2+1] = DM[0][spin][Mc_AN][0][to1][to2];
2464 }
2465 }
2466
2467 sum1 = 0.0;
2468 for(m1=0; m1<(2*l1+1); m1++){
2469 sum1 += a[m1+1][m1+1];
2470 }
2471
2472 if (Ncut<sum1){
2473
2474 Eigen_lapack(a,ko,2*l1+1,2*l1+1);
2475
2476 toccpn[spin] = 0.0;
2477
2478 for (m1=0; m1<(2*l1+1); m1++){
2479 toccpn[spin] += ko[m1+1];
2480 }
2481
2482 for (m1=0; m1<(2*l1+1); m1++){
2483 ko[m1+1] = 0.0;
2484 }
2485
2486 /* normal orbital polarization */
2487
2488 if (OrbPol_flag[Gc_AN]==1){
2489
2490 m0 = 2*l1 + 1 - (int)toccpn[spin];
2491 if (m0<0) m0 = 0;
2492
2493 for (m1=2*l1; m0<=m1; m1--){
2494 ko[m1+1] = 1.0;
2495 }
2496
2497 if (0<=(2*l1-(int)toccpn[spin]) ){
2498 ko[2*l1-(int)toccpn[spin]+1] = (double)(toccpn[spin] - (int)toccpn[spin]);
2499 }
2500 }
2501
2502 /* orbital polarization for the first exited state */
2503
2504 else if (OrbPol_flag[Gc_AN]==2){
2505
2506 m0 = 2*l1 + 1 - (int)toccpn[spin];
2507 if (m0<0) m0 = 0;
2508
2509 for (m1=2*l1; m0<=m1; m1--){
2510 ko[m1+1] = 1.0;
2511 }
2512
2513 if (0<=(2*l1-(int)toccpn[spin]) ){
2514 ko[2*l1-(int)toccpn[spin]+1] = (double)(toccpn[spin] - (int)toccpn[spin]);
2515 }
2516
2517 m1 = 2*l1-(int)toccpn[spin]+1;
2518 m2 = 2*l1-(int)toccpn[spin]+2;
2519
2520 if ( 1<=m1 && m1<=(2*l1+1) && 1<=m2 && m2<=(2*l1+1) ){
2521 tmp1 = ko[m1];
2522 tmp2 = ko[m2];
2523 ko[m1] = tmp2;
2524 ko[m2] = tmp1;
2525 }
2526
2527 }
2528
2529 /*
2530 for (m1=0; m1<(2*l1+1); m1++){
2531 printf("Y1 Gc_AN=%2d spin=%2d %15.12f %15.12f\n",Gc_AN,spin,toccpn[spin],ko[m1+1]);
2532 }
2533 */
2534
2535 /* a * ko * a^+ */
2536
2537 for (m1=0; m1<(2*l1+1); m1++){
2538 for (m2=0; m2<(2*l1+1); m2++){
2539
2540 sum1 = 0.0;
2541 for (m3=0; m3<(2*l1+1); m3++){
2542 sum1 += a[m1+1][m3+1]*ko[m3+1]*a[m2+1][m3+1];
2543 }
2544
2545 to1 = trans_index[l1][mul1][m1];
2546 to2 = trans_index[l1][mul1][m2];
2547
2548 DM_onsite[0][spin][Mc_AN][to1][to2] = sum1;
2549 }
2550 }
2551 }
2552 }
2553 }
2554
2555 }
2556
2557 /* freeing of arrays */
2558
2559 for(l1=0; l1<(List_YOUSO[25]+1); l1++){
2560 for(mul1=0; mul1<List_YOUSO[24]; mul1++){
2561 free(trans_index[l1][mul1]);
2562 }
2563 free(trans_index[l1]);
2564 }
2565 free(trans_index);
2566
2567 for (i=0; i<Ns; i++){
2568 free(a[i]);
2569 }
2570 free(a);
2571
2572 free(ko);
2573 }
2574
2575
2576
2577
2578
2579
2580
Induce_Orbital_Polarization_Together(int Mc_AN)2581 void Induce_Orbital_Polarization_Together(int Mc_AN)
2582 {
2583 int wan1,Gc_AN,spin,spinmax;
2584 int i,j,k,to1,to2,l1,mul1,m0,m1,m2,m3;
2585 int ***trans_index;
2586 double **a,*ko;
2587 double sum1,tmp1,tmp2;
2588 double toccpn;
2589 double Ncut=0.3;
2590 int Ns;
2591
2592 Gc_AN = M2G[Mc_AN];
2593 wan1 = WhatSpecies[Gc_AN];
2594
2595 if (SpinP_switch==0) spinmax = 0;
2596 else spinmax = 1;
2597
2598 /* allocation of arrays */
2599
2600 trans_index = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
2601 for(l1=0; l1<(List_YOUSO[25]+1); l1++){
2602 trans_index[l1] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
2603 for(mul1=0; mul1<List_YOUSO[24]; mul1++){
2604 trans_index[l1][mul1] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
2605 }
2606 }
2607
2608 Ns = 4*4*2 + 1;
2609
2610 a = (double**)malloc(sizeof(double*)*Ns);
2611 for (i=0; i<Ns; i++){
2612 a[i] = (double*)malloc(sizeof(double)*Ns);
2613 for (j=0; j<Ns; j++) a[i][j] = 0.0;
2614 }
2615
2616 ko = (double*)malloc(sizeof(double)*Ns);
2617
2618 /* set trans_index */
2619
2620 to1 = 0;
2621 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
2622 for(mul1=0; mul1<Spe_Num_Basis[wan1][l1]; mul1++){
2623 for(m1=0; m1<(2*l1+1); m1++){
2624 trans_index[l1][mul1][m1] = to1;
2625 to1++;
2626 }
2627 }
2628 }
2629
2630 /*****************************************
2631 induce orbital polaization
2632 *****************************************/
2633
2634 if (OrbPol_flag[Gc_AN]!=0){
2635
2636 mul1 = 0;
2637
2638 for(l1=2; l1<=Spe_MaxL_Basis[wan1]; l1++){
2639
2640 k = 2*l1 + 1;
2641
2642 for(m1=0; m1<(2*l1+1); m1++){
2643 for(m2=0; m2<(2*l1+1); m2++){
2644 to1 = trans_index[l1][mul1][m1];
2645 to2 = trans_index[l1][mul1][m2];
2646
2647 /* rnd(1.0e-13) is a prescription to stabilize the lapack routines */
2648 a[m1 +1][m2 +1] = DM[0][0][Mc_AN][0][to1][to2] + rnd(1.0e-13);
2649 a[m1+k+1][m2+k+1] = DM[0][1][Mc_AN][0][to1][to2] + rnd(1.0e-13);
2650 a[m1 +1][m2+k+1] = rnd(1.0e-13);
2651 a[m1+k+1][m2 +1] = rnd(1.0e-13);
2652
2653 }
2654 }
2655
2656 sum1 = 0.0;
2657 for(m1=0; m1<2*k; m1++){
2658 sum1 += a[m1+1][m1+1];
2659 }
2660
2661 if (Ncut<sum1){
2662
2663 Eigen_lapack(a,ko,2*k,2*k);
2664
2665 /*
2666 printf("Col Gc_AN=%2d\n",Gc_AN);fflush(stdout);
2667 for (m1=0; m1<2*k; m1++){
2668 printf("Col m1=%2d %15.12f\n",m1,ko[m1+1]);fflush(stdout);
2669 }
2670 */
2671
2672 toccpn = 0.0;
2673 for (m1=0; m1<2*k; m1++){
2674 toccpn += ko[m1+1];
2675 }
2676
2677 for (m1=0; m1<2*k; m1++){
2678 ko[m1+1] = 0.0;
2679 }
2680
2681 /* normal orbital polarization */
2682
2683 if (OrbPol_flag[Gc_AN]==1){
2684
2685 m0 = 4*l1 + 2 - (int)toccpn;
2686 if (m0<0) m0 = 0;
2687
2688 for (m1=(4*l1+1); m0<=m1; m1--){
2689 ko[m1+1] = 1.0;
2690 }
2691
2692 if (0<=(4*l1+1-(int)toccpn) ){
2693 ko[4*l1-(int)toccpn+1] = (double)(toccpn - (int)toccpn);
2694 }
2695 }
2696
2697 /* orbital polarization for the first exited state */
2698
2699 else if (OrbPol_flag[Gc_AN]==2){
2700 /* not supported */
2701 }
2702
2703 /* a * ko * a^+ */
2704
2705 for (m1=0; m1<2*k; m1++){
2706 for (m2=0; m2<2*k; m2++){
2707
2708 sum1 = 0.0;
2709 for (m3=0; m3<2*k; m3++){
2710 sum1 += a[m1+1][m3+1]*ko[m3+1]*a[m2+1][m3+1];
2711 }
2712
2713 to1 = trans_index[l1][mul1][m1%k];
2714 to2 = trans_index[l1][mul1][m2%k];
2715
2716 if ( (m1/k)==0 && (m2/k)==0 ){
2717 DM_onsite[0][0][Mc_AN][to1][to2] = sum1;
2718 }
2719 else if ( (m1/k)==1 && (m2/k)==1 ){
2720 DM_onsite[0][1][Mc_AN][to1][to2] = sum1;
2721 }
2722
2723 }
2724 }
2725 }
2726 }
2727 }
2728
2729 /* freeing of arrays */
2730
2731 for(l1=0; l1<(List_YOUSO[25]+1); l1++){
2732 for(mul1=0; mul1<List_YOUSO[24]; mul1++){
2733 free(trans_index[l1][mul1]);
2734 }
2735 free(trans_index[l1]);
2736 }
2737 free(trans_index);
2738
2739 for (i=0; i<Ns; i++){
2740 free(a[i]);
2741 }
2742 free(a);
2743
2744 free(ko);
2745 }
2746
2747
2748
2749
2750
Induce_NC_Orbital_Polarization(int Mc_AN)2751 void Induce_NC_Orbital_Polarization(int Mc_AN)
2752 {
2753 int wan1,Gc_AN;
2754 int i,j,k,to1,to2,l1,mul1,m0,m1,m2,m3;
2755 int ***trans_index;
2756 double *ko;
2757 dcomplex **a,sum1;
2758 double tmp1,tmp2;
2759 double toccpn;
2760 double Ncut=0.3;
2761 int Ns;
2762
2763 Gc_AN = M2G[Mc_AN];
2764 wan1 = WhatSpecies[Gc_AN];
2765
2766 /* allocation of arrays */
2767
2768 trans_index = (int***)malloc(sizeof(int**)*(List_YOUSO[25]+1));
2769 for(l1=0; l1<(List_YOUSO[25]+1); l1++){
2770 trans_index[l1] = (int**)malloc(sizeof(int*)*List_YOUSO[24]);
2771 for(mul1=0; mul1<List_YOUSO[24]; mul1++){
2772 trans_index[l1][mul1] = (int*)malloc(sizeof(int)*(2*(List_YOUSO[25]+1)+1));
2773 }
2774 }
2775
2776 Ns = 4*4*2 + 1;
2777
2778 a = (dcomplex**)malloc(sizeof(dcomplex*)*Ns);
2779 for (i=0; i<Ns; i++){
2780 a[i] = (dcomplex*)malloc(sizeof(dcomplex)*Ns);
2781 }
2782
2783 ko = (double*)malloc(sizeof(double)*Ns);
2784
2785 /* set trans_index */
2786
2787 to1 = 0;
2788 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
2789 for(mul1=0; mul1<Spe_Num_Basis[wan1][l1]; mul1++){
2790 for(m1=0; m1<(2*l1+1); m1++){
2791 trans_index[l1][mul1][m1] = to1;
2792 to1++;
2793 }
2794 }
2795 }
2796
2797 /*****************************************
2798 induce orbital polaization
2799 *****************************************/
2800
2801 if (OrbPol_flag[Gc_AN]!=0){
2802
2803 mul1 = 0;
2804
2805 for(l1=2; l1<=Spe_MaxL_Basis[wan1]; l1++){
2806
2807 k = 2*l1 + 1;
2808
2809 for(m1=0; m1<k; m1++){
2810 for(m2=0; m2<k; m2++){
2811 to1 = trans_index[l1][mul1][m1];
2812 to2 = trans_index[l1][mul1][m2];
2813
2814 /* rnd(1.0e-12) is a prescription to stabilize the lapack routines */
2815 a[m1 +1][m2 +1].r = DM[0][0][Mc_AN][0][to1][to2] + rnd(1.0e-12);
2816 a[m1+k+1][m2+k+1].r = DM[0][1][Mc_AN][0][to1][to2] + rnd(1.0e-12);
2817 a[m1 +1][m2+k+1].r = DM[0][2][Mc_AN][0][to1][to2] + rnd(1.0e-12);
2818 a[m1+k+1][m2 +1].r = DM[0][2][Mc_AN][0][to2][to1] + rnd(1.0e-12);
2819
2820 a[m1 +1][m2 +1].i = iDM[0][0][Mc_AN][0][to1][to2] + rnd(1.0e-12);
2821 a[m1+k+1][m2+k+1].i = iDM[0][1][Mc_AN][0][to1][to2] + rnd(1.0e-12);
2822 a[m1 +1][m2+k+1].i = DM[0][3][Mc_AN][0][to1][to2] + rnd(1.0e-12);
2823 a[m1+k+1][m2 +1].i =-DM[0][3][Mc_AN][0][to2][to1] + rnd(1.0e-12);
2824 }
2825 }
2826
2827 tmp1 = 0.0;
2828 for(m1=0; m1<2*k; m1++){
2829 tmp1 += a[m1+1][m1+1].r;
2830 }
2831
2832 if (Ncut<tmp1){
2833
2834 EigenBand_lapack(a, ko, 2*k, 2*k, 1);
2835
2836 /*
2837 printf("NCl Gc_AN=%2d\n",Gc_AN);fflush(stdout);
2838 for (m1=0; m1<2*k; m1++){
2839 printf("NCl m1=%2d %15.12f\n",m1,ko[m1+1]);fflush(stdout);
2840 }
2841 */
2842
2843 toccpn = 0.0;
2844 for (m1=0; m1<2*k; m1++){
2845 toccpn += ko[m1+1];
2846 }
2847
2848 for (m1=0; m1<2*k; m1++){
2849 ko[m1+1] = 0.0;
2850 }
2851
2852 /* normal orbital polarization */
2853
2854 if (OrbPol_flag[Gc_AN]==1){
2855
2856 m0 = 4*l1 + 2 - (int)toccpn;
2857 if (m0<0) m0 = 0;
2858
2859 for (m1=(4*l1+1); m0<=m1; m1--){
2860 ko[m1+1] = 1.0;
2861 }
2862
2863 if (0<=(4*l1+1-(int)toccpn) ){
2864 ko[4*l1+1-(int)toccpn+1] = (double)(toccpn - (int)toccpn);
2865 }
2866 }
2867
2868 /* orbital polarization for the first exited state */
2869
2870 else if (OrbPol_flag[Gc_AN]==2){
2871 /* not supported */
2872 }
2873
2874 /* a * ko * a^+ */
2875
2876 for (m1=0; m1<2*k; m1++){
2877 for (m2=0; m2<2*k; m2++){
2878
2879 sum1.r = 0.0;
2880 sum1.i = 0.0;
2881
2882 for (m3=0; m3<2*k; m3++){
2883 sum1.r += ( a[m1+1][m3+1].r*a[m2+1][m3+1].r + a[m1+1][m3+1].i*a[m2+1][m3+1].i)*ko[m3+1];
2884 sum1.i += (-a[m1+1][m3+1].r*a[m2+1][m3+1].i + a[m1+1][m3+1].i*a[m2+1][m3+1].r)*ko[m3+1];
2885 }
2886
2887 to1 = trans_index[l1][mul1][m1%k];
2888 to2 = trans_index[l1][mul1][m2%k];
2889
2890 NC_OcpN[0][m1/k][m2/k][Mc_AN][to2][to1].r = sum1.r;
2891 NC_OcpN[0][m1/k][m2/k][Mc_AN][to2][to1].i = sum1.i;
2892 }
2893 }
2894 }
2895 }
2896 }
2897
2898 /* freeing of arrays */
2899
2900 for(l1=0; l1<(List_YOUSO[25]+1); l1++){
2901 for(mul1=0; mul1<List_YOUSO[24]; mul1++){
2902 free(trans_index[l1][mul1]);
2903 }
2904 free(trans_index[l1]);
2905 }
2906 free(trans_index);
2907
2908 for (i=0; i<Ns; i++){
2909 free(a[i]);
2910 }
2911 free(a);
2912
2913 free(ko);
2914 }
2915
2916
2917
2918
make_v_eff(int SCF_iter,int SucceedReadingDMfile,double dUele)2919 void make_v_eff(int SCF_iter, int SucceedReadingDMfile, double dUele)
2920 {
2921 int i,j,k,tno0,tno1,tno2,Cwan,Gc_AN,spin;
2922 int Mc_AN,num,n,size1,size2,to1,to2;
2923 int l1,l2,m1,m2,mul1,mul2,wan1;
2924 int *Snd_Size,*Rcv_Size;
2925 int numprocs,myid,ID,IDS,IDR,tag=999;
2926 double *tmp_array;
2927 double *tmp_array2;
2928 double *tmp_array0;
2929 double Stime_atom, Etime_atom;
2930 double Uvalue;
2931
2932 MPI_Status stat;
2933 MPI_Request request;
2934
2935 /* MPI */
2936 MPI_Comm_size(mpi_comm_level1,&numprocs);
2937 MPI_Comm_rank(mpi_comm_level1,&myid);
2938
2939 /* allocations of arrays */
2940
2941 Snd_Size = (int*)malloc(sizeof(int)*numprocs);
2942 Rcv_Size = (int*)malloc(sizeof(int)*numprocs);
2943
2944
2945
2946 /****************************************************
2947
2948 make v_eff
2949
2950 Important note:
2951
2952 In case of orbital optimization,
2953 the U potential is applied to
2954 the primitive orbital.
2955 ****************************************************/
2956
2957 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
2958
2959 dtime(&Stime_atom);
2960
2961 Gc_AN = M2G[Mc_AN];
2962 wan1 = WhatSpecies[Gc_AN];
2963
2964 for (spin=0; spin<=SpinP_switch; spin++){
2965
2966 /* store the v_eff --- MJ */
2967
2968 to1 = 0;
2969 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
2970 for(mul1=0; mul1<Spe_Num_Basis[wan1][l1]; mul1++){
2971 for(m1=0; m1<(2*l1+1); m1++){
2972
2973 to2 = 0;
2974 for(l2=0; l2<=Spe_MaxL_Basis[wan1]; l2++){
2975 for(mul2=0; mul2<Spe_Num_Basis[wan1][l2]; mul2++){
2976 for(m2=0; m2<(2*l2+1); m2++){
2977
2978 if (l1==l2 && mul1==mul2)
2979 Uvalue = Hub_U_Basis[wan1][l1][mul1];
2980 else
2981 Uvalue = 0.0;
2982
2983 if(to1 == to2){
2984 v_eff[spin][Mc_AN][to1][to2]= Uvalue*(0.5 - DM_onsite[0][spin][Mc_AN][to1][to2]);
2985 }
2986 else{
2987 v_eff[spin][Mc_AN][to1][to2]= Uvalue*(0.0 - DM_onsite[0][spin][Mc_AN][to1][to2]);
2988 }
2989
2990 to2++;
2991
2992 } /* mul2 */
2993 } /* m2 */
2994 } /* l2 */
2995
2996 to1++;
2997
2998 } /* mul1 */
2999 } /* m1 */
3000 } /* l1 */
3001 } /* spin */
3002
3003 dtime(&Etime_atom);
3004 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
3005
3006 } /* Mc_AN */
3007
3008 /****************************************************
3009 MPI: v_eff
3010 ****************************************************/
3011
3012 /***********************************
3013 set data size
3014 ************************************/
3015
3016 for (ID=0; ID<numprocs; ID++){
3017
3018 IDS = (myid + ID) % numprocs;
3019 IDR = (myid - ID + numprocs) % numprocs;
3020
3021 if (ID!=0){
3022 tag = 999;
3023
3024 /* find data size to send block data */
3025 if (F_Snd_Num[IDS]!=0){
3026
3027 size1 = 0;
3028 for (k=0; k<=SpinP_switch; k++){
3029 for (n=0; n<F_Snd_Num[IDS]; n++){
3030 Mc_AN = Snd_MAN[IDS][n];
3031 Gc_AN = Snd_GAN[IDS][n];
3032 Cwan = WhatSpecies[Gc_AN];
3033 tno1 = Spe_Total_NO[Cwan];
3034 size1 += tno1*tno1;
3035 }
3036 }
3037
3038 Snd_Size[IDS] = size1;
3039 MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
3040 }
3041 else{
3042 Snd_Size[IDS] = 0;
3043 }
3044
3045 /* receiving of size of data */
3046
3047 if (F_Rcv_Num[IDR]!=0){
3048 MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
3049 Rcv_Size[IDR] = size2;
3050 }
3051 else{
3052 Rcv_Size[IDR] = 0;
3053 }
3054
3055 if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
3056
3057 }
3058 }
3059
3060 /***********************************
3061 data transfer
3062 ************************************/
3063
3064 tag = 999;
3065 for (ID=0; ID<numprocs; ID++){
3066
3067 IDS = (myid + ID) % numprocs;
3068 IDR = (myid - ID + numprocs) % numprocs;
3069
3070 if (ID!=0){
3071
3072 /*****************************
3073 sending of data
3074 *****************************/
3075
3076 if (F_Snd_Num[IDS]!=0){
3077
3078 size1 = Snd_Size[IDS];
3079
3080 /* allocation of array */
3081
3082 tmp_array = (double*)malloc(sizeof(double)*size1);
3083
3084 /* multidimentional array to vector array */
3085
3086 num = 0;
3087 for (k=0; k<=SpinP_switch; k++){
3088 for (n=0; n<F_Snd_Num[IDS]; n++){
3089 Mc_AN = Snd_MAN[IDS][n];
3090 Gc_AN = Snd_GAN[IDS][n];
3091 Cwan = WhatSpecies[Gc_AN];
3092 tno1 = Spe_Total_NO[Cwan];
3093 for (i=0; i<tno1; i++){
3094 for (j=0; j<tno1; j++){
3095 tmp_array[num] = v_eff[k][Mc_AN][i][j];
3096 num++;
3097 }
3098 }
3099 }
3100 }
3101
3102 MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
3103 }
3104
3105 /*****************************
3106 receiving of block data
3107 *****************************/
3108
3109 if (F_Rcv_Num[IDR]!=0){
3110
3111 size2 = Rcv_Size[IDR];
3112
3113 /* allocation of array */
3114 tmp_array2 = (double*)malloc(sizeof(double)*size2);
3115
3116 MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
3117
3118 num = 0;
3119 for (k=0; k<=SpinP_switch; k++){
3120 Mc_AN = F_TopMAN[IDR] - 1;
3121 for (n=0; n<F_Rcv_Num[IDR]; n++){
3122 Mc_AN++;
3123 Gc_AN = Rcv_GAN[IDR][n];
3124 Cwan = WhatSpecies[Gc_AN];
3125 tno1 = Spe_Total_NO[Cwan];
3126 for (i=0; i<tno1; i++){
3127 for (j=0; j<tno1; j++){
3128 v_eff[k][Mc_AN][i][j] = tmp_array2[num];
3129 num++;
3130 }
3131 }
3132 }
3133 }
3134
3135 /* freeing of array */
3136 free(tmp_array2);
3137 }
3138
3139 if (F_Snd_Num[IDS]!=0){
3140 MPI_Wait(&request,&stat);
3141 free(tmp_array); /* freeing of array */
3142 }
3143 }
3144 }
3145
3146 /* freeing of Snd_Size and Rcv_Size */
3147
3148 free(Snd_Size);
3149 free(Rcv_Size);
3150 }
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
make_NC_v_eff(int SCF_iter,int SucceedReadingDMfile,double dUele,double ECE[])3161 void make_NC_v_eff(int SCF_iter, int SucceedReadingDMfile, double dUele, double ECE[])
3162 {
3163 int i,j,k,tno0,tno1,tno2,Cwan,Gc_AN,spin;
3164 int Mc_AN,num,n,size1,size2,to1,to2;
3165 int l1,l2,m1,m2,mul1,mul2,wan1,s1,s2,s3,s4;
3166 int *Snd_Size,*Rcv_Size;
3167 int numprocs,myid,ID,IDS,IDR,tag=999;
3168 double *tmp_array;
3169 double *tmp_array2;
3170 double *tmp_array0;
3171 double Stime_atom, Etime_atom;
3172 double Uvalue,Nup[2],Ndn[2],theta[2],phi[2];
3173 double Nup0,Ndn0;
3174 double A,B,C,L,Lx,Ly,Lz,tmp,tmp1,tmp2;
3175 double sit,cot,sip,cop,Bx,By,Bz,lx,ly,lz,sx,sy,sz;
3176 double My_Ucs,My_Uzs,My_Uzo;
3177 double theta0,phi0;
3178 dcomplex TN[2][2],dTN[2][2][2][2],TN0[2][2],U[2][2];
3179 dcomplex dSx[2][2],dSy[2][2],dSz[2][2];
3180 dcomplex csum1,csum2,ctmp1,ctmp2;
3181
3182 MPI_Status stat;
3183 MPI_Request request;
3184
3185 /* MPI */
3186 MPI_Comm_size(mpi_comm_level1,&numprocs);
3187 MPI_Comm_rank(mpi_comm_level1,&myid);
3188
3189 /* allocations of arrays */
3190
3191 Snd_Size = (int*)malloc(sizeof(int)*numprocs);
3192 Rcv_Size = (int*)malloc(sizeof(int)*numprocs);
3193
3194 /****************************************************
3195 make NC_v_eff
3196 ****************************************************/
3197
3198 My_Ucs = 0.0;
3199 My_Uzs = 0.0;
3200 My_Uzo = 0.0;
3201
3202 for (Mc_AN=1; Mc_AN<=Matomnum; Mc_AN++){
3203
3204 dtime(&Stime_atom);
3205
3206 Gc_AN = M2G[Mc_AN];
3207 wan1 = WhatSpecies[Gc_AN];
3208
3209 /************************************************************
3210 ***********************************************************
3211 ***********************************************************
3212 ***********************************************************
3213
3214 calculate the v_eff for LDA+U
3215
3216 ***********************************************************
3217 ***********************************************************
3218 ***********************************************************
3219 ************************************************************/
3220
3221 to1 = 0;
3222 for(l1=0; l1<=Spe_MaxL_Basis[wan1]; l1++){
3223 for(mul1=0; mul1<Spe_Num_Basis[wan1][l1]; mul1++){
3224 for(m1=0; m1<(2*l1+1); m1++){
3225
3226 to2 = 0;
3227 for(l2=0; l2<=Spe_MaxL_Basis[wan1]; l2++){
3228 for(mul2=0; mul2<Spe_Num_Basis[wan1][l2]; mul2++){
3229 for(m2=0; m2<(2*l2+1); m2++){
3230
3231 if (Hub_U_switch==1){
3232
3233 if (l1==l2 && mul1==mul2)
3234 Uvalue = Hub_U_Basis[wan1][l1][mul1];
3235 else
3236 Uvalue = 0.0;
3237
3238 if(to1==to2){
3239 NC_v_eff[0][0][Mc_AN][to1][to2].r = Uvalue*(0.5 - NC_OcpN[0][0][0][Mc_AN][to2][to1].r);
3240 NC_v_eff[0][0][Mc_AN][to1][to2].i = Uvalue*(0.0 - NC_OcpN[0][0][0][Mc_AN][to2][to1].i);
3241 NC_v_eff[1][1][Mc_AN][to1][to2].r = Uvalue*(0.5 - NC_OcpN[0][1][1][Mc_AN][to2][to1].r);
3242 NC_v_eff[1][1][Mc_AN][to1][to2].i = Uvalue*(0.0 - NC_OcpN[0][1][1][Mc_AN][to2][to1].i);
3243 NC_v_eff[0][1][Mc_AN][to1][to2].r = Uvalue*(0.0 - NC_OcpN[0][1][0][Mc_AN][to2][to1].r);
3244 NC_v_eff[0][1][Mc_AN][to1][to2].i = Uvalue*(0.0 - NC_OcpN[0][1][0][Mc_AN][to2][to1].i);
3245 NC_v_eff[1][0][Mc_AN][to1][to2].r = Uvalue*(0.0 - NC_OcpN[0][0][1][Mc_AN][to2][to1].r);
3246 NC_v_eff[1][0][Mc_AN][to1][to2].i = Uvalue*(0.0 - NC_OcpN[0][0][1][Mc_AN][to2][to1].i);
3247 }
3248 else{
3249 NC_v_eff[0][0][Mc_AN][to1][to2].r = Uvalue*(0.0 - NC_OcpN[0][0][0][Mc_AN][to2][to1].r);
3250 NC_v_eff[0][0][Mc_AN][to1][to2].i = Uvalue*(0.0 - NC_OcpN[0][0][0][Mc_AN][to2][to1].i);
3251 NC_v_eff[1][1][Mc_AN][to1][to2].r = Uvalue*(0.0 - NC_OcpN[0][1][1][Mc_AN][to2][to1].r);
3252 NC_v_eff[1][1][Mc_AN][to1][to2].i = Uvalue*(0.0 - NC_OcpN[0][1][1][Mc_AN][to2][to1].i);
3253 NC_v_eff[0][1][Mc_AN][to1][to2].r = Uvalue*(0.0 - NC_OcpN[0][1][0][Mc_AN][to2][to1].r);
3254 NC_v_eff[0][1][Mc_AN][to1][to2].i = Uvalue*(0.0 - NC_OcpN[0][1][0][Mc_AN][to2][to1].i);
3255 NC_v_eff[1][0][Mc_AN][to1][to2].r = Uvalue*(0.0 - NC_OcpN[0][0][1][Mc_AN][to2][to1].r);
3256 NC_v_eff[1][0][Mc_AN][to1][to2].i = Uvalue*(0.0 - NC_OcpN[0][0][1][Mc_AN][to2][to1].i);
3257 }
3258
3259 } /* if (Hub_U_switch==1) */
3260
3261 /* initialize NC_v_eff */
3262
3263 else {
3264 NC_v_eff[0][0][Mc_AN][to1][to2].r = 0.0;
3265 NC_v_eff[0][0][Mc_AN][to1][to2].i = 0.0;
3266 NC_v_eff[1][1][Mc_AN][to1][to2].r = 0.0;
3267 NC_v_eff[1][1][Mc_AN][to1][to2].i = 0.0;
3268 NC_v_eff[0][1][Mc_AN][to1][to2].r = 0.0;
3269 NC_v_eff[0][1][Mc_AN][to1][to2].i = 0.0;
3270 NC_v_eff[1][0][Mc_AN][to1][to2].r = 0.0;
3271 NC_v_eff[1][0][Mc_AN][to1][to2].i = 0.0;
3272 }
3273
3274 to2++;
3275
3276 } /* mul2 */
3277 } /* m2 */
3278 } /* l2 */
3279
3280 to1++;
3281
3282 } /* mul1 */
3283 } /* m1 */
3284 } /* l1 */
3285
3286 /************************************************************
3287 ***********************************************************
3288 ***********************************************************
3289 ***********************************************************
3290
3291 calculate veff by the constraint DFT which controls
3292 the spin direction but not the magnitude.
3293
3294 ***********************************************************
3295 ***********************************************************
3296 ***********************************************************
3297 ************************************************************/
3298
3299 if (Constraint_NCS_switch==1 && Constraint_SpinAngle[Gc_AN]==1 ){
3300
3301 /* calculate TN */
3302
3303 TN[0][0].r = 0.0;
3304 TN[0][1].r = 0.0;
3305 TN[1][0].r = 0.0;
3306 TN[1][1].r = 0.0;
3307 TN[0][0].i = 0.0;
3308 TN[0][1].i = 0.0;
3309 TN[1][0].i = 0.0;
3310 TN[1][1].i = 0.0;
3311
3312 for (i=0; i<Spe_Total_NO[wan1]; i++){
3313
3314 TN[0][0].r += NC_OcpN[0][0][0][Mc_AN][i][i].r;
3315 TN[0][1].r += NC_OcpN[0][0][1][Mc_AN][i][i].r;
3316 TN[1][0].r += NC_OcpN[0][1][0][Mc_AN][i][i].r;
3317 TN[1][1].r += NC_OcpN[0][1][1][Mc_AN][i][i].r;
3318
3319 /*
3320 conjugate complex of TN due to difference
3321 in the definition between density matrix
3322 and charge density
3323 */
3324
3325 TN[0][0].i -= NC_OcpN[0][0][0][Mc_AN][i][i].i;
3326 TN[0][1].i -= NC_OcpN[0][0][1][Mc_AN][i][i].i;
3327 TN[1][0].i -= NC_OcpN[0][1][0][Mc_AN][i][i].i;
3328 TN[1][1].i -= NC_OcpN[0][1][1][Mc_AN][i][i].i;
3329 }
3330
3331
3332 /*
3333 printf("TN.r Mc_AN=%2d\n",Mc_AN);
3334 for (i=0; i<2; i++){
3335 for (j=0; j<2; j++){
3336 printf("%15.12f ",TN[i][j].r);
3337 }
3338 printf("\n");
3339 }
3340
3341 printf("TN.i Mc_AN=%2d\n",Mc_AN);
3342 for (i=0; i<2; i++){
3343 for (j=0; j<2; j++){
3344 printf("%15.12f ",TN[i][j].i);
3345 }
3346 printf("\n");
3347 }
3348 */
3349
3350 EulerAngle_Spin( 1,
3351 TN[0][0].r, TN[1][1].r,
3352 TN[0][1].r, TN[0][1].i,
3353 TN[1][0].r, TN[1][0].i,
3354 Nup, Ndn, theta, phi );
3355
3356 /* calculate TN0 */
3357
3358 /*
3359 printf("Nup=%15.12f Ndn=%15.12f theta=%15.12f phi=%15.12f\n",Nup[0],Ndn[0],theta[0],phi[0]);
3360 printf("theta =%15.12f phi =%15.12f\n",theta[0]/PI*180.0,phi[0]/PI*180.0);
3361
3362 printf("theta0=%15.12f phi0=%15.12f\n",InitAngle0_Spin[Gc_AN]/PI*180.0,
3363 InitAngle1_Spin[Gc_AN]/PI*180.0);
3364 */
3365
3366 sit = sin(0.5*InitAngle0_Spin[Gc_AN]);
3367 cot = cos(0.5*InitAngle0_Spin[Gc_AN]);
3368 sip = sin(0.5*InitAngle1_Spin[Gc_AN]);
3369 cop = cos(0.5*InitAngle1_Spin[Gc_AN]);
3370
3371 U[0][0].r = cop*cot; U[0][0].i = sip*cot;
3372 U[0][1].r = cop*sit; U[0][1].i =-sip*sit;
3373 U[1][0].r =-cop*sit; U[1][0].i =-sip*sit;
3374 U[1][1].r = cop*cot; U[1][1].i =-sip*cot;
3375
3376 TN0[0][0].r = Nup[0]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3377 + Ndn[0]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3378
3379 TN0[0][0].i = 0.0;
3380
3381 TN0[0][1].r = Nup[0]*( U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i )
3382 + Ndn[0]*( U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i );
3383
3384 TN0[0][1].i = Nup[0]*(-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i )
3385 + Ndn[0]*(-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i );
3386
3387 TN0[1][0].r = Nup[0]*( U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i )
3388 + Ndn[0]*( U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i );
3389
3390 TN0[1][0].i = Nup[0]*(-U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i )
3391 + Ndn[0]*(-U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i );
3392
3393 TN0[1][1].r = Nup[0]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3394 + Ndn[0]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3395
3396 TN0[1][1].i = 0.0;
3397
3398 /* calculate dTN */
3399
3400 Calc_dTN( Constraint_NCS_switch, TN, dTN, U, theta, phi );
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410 /*
3411
3412 {
3413
3414
3415 dcomplex TNA[10][10];
3416 dcomplex TNB[10][10];
3417 dcomplex TNC[10][10];
3418
3419 dcomplex ctmp1,ctmp2;
3420
3421
3422
3423 l1 = 1;
3424 l2 = 0;
3425 tmp1 = 0.0001;
3426 tmp2 = 0.01;
3427
3428
3429 EulerAngle_Spin( 0,
3430 TN[0][0].r, TN[1][1].r,
3431 TN[0][1].r, TN[0][1].i,
3432 TN[1][0].r, TN[1][0].i,
3433 Nup, Ndn, theta, phi );
3434
3435 printf("V0 Nup.r=%15.12f Nup.i=%15.12f\n",Nup[0],Nup[1]);
3436 printf("V0 Ndn.r=%15.12f Ndn.i=%15.12f\n",Ndn[0],Ndn[1]);
3437
3438
3439 sit = sin(0.5*InitAngle0_Spin[Gc_AN]);
3440 cot = cos(0.5*InitAngle0_Spin[Gc_AN]);
3441 sip = sin(0.5*InitAngle1_Spin[Gc_AN]);
3442 cop = cos(0.5*InitAngle1_Spin[Gc_AN]);
3443
3444 U[0][0].r = cop*cot; U[0][0].i = sip*cot;
3445 U[0][1].r = cop*sit; U[0][1].i =-sip*sit;
3446 U[1][0].r =-cop*sit; U[1][0].i =-sip*sit;
3447 U[1][1].r = cop*cot; U[1][1].i =-sip*cot;
3448
3449 TN0[0][0].r = Nup[0]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3450 + Ndn[0]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3451
3452 TN0[0][0].i = Nup[1]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3453 + Ndn[1]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3454
3455 ctmp1.r = U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i;
3456 ctmp1.i =-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i;
3457 ctmp2.r = U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i;
3458 ctmp2.i =-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i;
3459
3460 TN0[0][1].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
3461 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
3462
3463 TN0[0][1].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
3464 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
3465
3466 ctmp1.r = U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i;
3467 ctmp1.i = -U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i;
3468 ctmp2.r = U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i;
3469 ctmp2.i = -U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i;
3470
3471 TN0[1][0].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
3472 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
3473
3474 TN0[1][0].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
3475 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
3476
3477 TN0[1][1].r = Nup[0]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3478 + Ndn[0]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3479
3480 TN0[1][1].i = Nup[1]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3481 + Ndn[1]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3482
3483
3484 Calc_dTN( Constraint_NCS_switch, TN, dTN, U, theta, phi );
3485
3486 printf("1 TN0.r\n");
3487 for (i=0; i<2; i++){
3488 for (j=0; j<2; j++){
3489 printf("%15.12f ",TN0[i][j].r);
3490
3491 TNA[i][j] = TN0[i][j];
3492 }
3493 printf("\n");
3494 }
3495
3496 printf("1 TN0.i\n");
3497 for (i=0; i<2; i++){
3498 for (j=0; j<2; j++){
3499 printf("%15.12f ",TN0[i][j].i);
3500 }
3501 printf("\n");
3502 }
3503
3504
3505
3506
3507 TN[l1][l2].r += tmp1;
3508 TN[l1][l2].i += tmp2;
3509
3510 EulerAngle_Spin( 0,
3511 TN[0][0].r, TN[1][1].r,
3512 TN[0][1].r, TN[0][1].i,
3513 TN[1][0].r, TN[1][0].i,
3514 Nup, Ndn, theta, phi );
3515
3516 printf("V1 Nup.r=%15.12f Nup.i=%15.12f\n",Nup[0],Nup[1]);
3517 printf("V1 Ndn.r=%15.12f Ndn.i=%15.12f\n",Ndn[0],Ndn[1]);
3518
3519
3520 sit = sin(0.5*InitAngle0_Spin[Gc_AN]);
3521 cot = cos(0.5*InitAngle0_Spin[Gc_AN]);
3522 sip = sin(0.5*InitAngle1_Spin[Gc_AN]);
3523 cop = cos(0.5*InitAngle1_Spin[Gc_AN]);
3524
3525 U[0][0].r = cop*cot; U[0][0].i = sip*cot;
3526 U[0][1].r = cop*sit; U[0][1].i =-sip*sit;
3527 U[1][0].r =-cop*sit; U[1][0].i =-sip*sit;
3528 U[1][1].r = cop*cot; U[1][1].i =-sip*cot;
3529
3530
3531
3532 TN0[0][0].r = Nup[0]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3533 + Ndn[0]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3534
3535 TN0[0][0].i = Nup[1]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3536 + Ndn[1]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3537
3538 ctmp1.r = U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i;
3539 ctmp1.i =-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i;
3540 ctmp2.r = U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i;
3541 ctmp2.i =-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i;
3542
3543 TN0[0][1].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
3544 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
3545
3546 TN0[0][1].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
3547 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
3548
3549 ctmp1.r = U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i;
3550 ctmp1.i = -U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i;
3551 ctmp2.r = U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i;
3552 ctmp2.i = -U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i;
3553
3554 TN0[1][0].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
3555 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
3556
3557 TN0[1][0].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
3558 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
3559
3560 TN0[1][1].r = Nup[0]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3561 + Ndn[0]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3562
3563 TN0[1][1].i = Nup[1]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3564 + Ndn[1]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3565
3566
3567
3568
3569
3570
3571
3572 Calc_dTN( Constraint_NCS_switch, TN, dTN, U, theta, phi );
3573
3574 printf("\nanalytical dTN.r\n");
3575 for (i=0; i<2; i++){
3576 for (j=0; j<2; j++){
3577 printf("%15.12f ",dTN[l1][l2][i][j].r);
3578 }
3579 printf("\n");
3580 }
3581
3582 printf("analytical dTN.i\n");
3583 for (i=0; i<2; i++){
3584 for (j=0; j<2; j++){
3585 printf("%15.12f ",dTN[l1][l2][i][j].i);
3586 }
3587 printf("\n");
3588 }
3589
3590
3591
3592
3593
3594
3595 TN[l1][l2].r += tmp1;
3596 TN[l1][l2].i += tmp2;
3597
3598 EulerAngle_Spin( 0,
3599 TN[0][0].r, TN[1][1].r,
3600 TN[0][1].r, TN[0][1].i,
3601 TN[1][0].r, TN[1][0].i,
3602 Nup, Ndn, theta, phi );
3603
3604 printf("V2 Nup.r=%15.12f Nup.i=%15.12f\n",Nup[0],Nup[1]);
3605 printf("V2 Ndn.r=%15.12f Ndn.i=%15.12f\n",Ndn[0],Ndn[1]);
3606
3607
3608 sit = sin(0.5*InitAngle0_Spin[Gc_AN]);
3609 cot = cos(0.5*InitAngle0_Spin[Gc_AN]);
3610 sip = sin(0.5*InitAngle1_Spin[Gc_AN]);
3611 cop = cos(0.5*InitAngle1_Spin[Gc_AN]);
3612
3613 U[0][0].r = cop*cot; U[0][0].i = sip*cot;
3614 U[0][1].r = cop*sit; U[0][1].i =-sip*sit;
3615 U[1][0].r =-cop*sit; U[1][0].i =-sip*sit;
3616 U[1][1].r = cop*cot; U[1][1].i =-sip*cot;
3617
3618
3619
3620
3621 TN0[0][0].r = Nup[0]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3622 + Ndn[0]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3623
3624 TN0[0][0].i = Nup[1]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3625 + Ndn[1]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3626
3627 ctmp1.r = U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i;
3628 ctmp1.i =-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i;
3629 ctmp2.r = U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i;
3630 ctmp2.i =-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i;
3631
3632 TN0[0][1].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
3633 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
3634
3635 TN0[0][1].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
3636 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
3637
3638 ctmp1.r = U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i;
3639 ctmp1.i = -U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i;
3640 ctmp2.r = U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i;
3641 ctmp2.i = -U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i;
3642
3643 TN0[1][0].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
3644 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
3645
3646 TN0[1][0].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
3647 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
3648
3649 TN0[1][1].r = Nup[0]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3650 + Ndn[0]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3651
3652 TN0[1][1].i = Nup[1]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3653 + Ndn[1]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3654
3655
3656
3657
3658
3659
3660 Calc_dTN( Constraint_NCS_switch, TN, dTN, U, theta, phi );
3661
3662
3663
3664
3665 printf("2 TN0.r\n");
3666 for (i=0; i<2; i++){
3667 for (j=0; j<2; j++){
3668 printf("%15.12f ",TN0[i][j].r);
3669 TNB[i][j] = TN0[i][j];
3670
3671 }
3672 printf("\n");
3673 }
3674
3675 printf("2 TN0.i\n");
3676 for (i=0; i<2; i++){
3677 for (j=0; j<2; j++){
3678 printf("%15.12f ",TN0[i][j].i);
3679 }
3680 printf("\n");
3681 }
3682
3683
3684
3685 for (i=0; i<2; i++){
3686 for (j=0; j<2; j++){
3687 TNC[i][j].r = 0.5*(TNB[i][j].r - TNA[i][j].r)/( tmp1*tmp1 + tmp2*tmp2 );
3688 TNC[i][j].i = 0.5*(TNB[i][j].i - TNA[i][j].i)/( tmp1*tmp1 + tmp2*tmp2 );
3689 }
3690 }
3691
3692 printf("\nnumerical dTN0.r\n");
3693 for (i=0; i<2; i++){
3694 for (j=0; j<2; j++){
3695 printf("%15.12f ", tmp1*TNC[i][j].r + tmp2*TNC[i][j].i );
3696 }
3697 printf("\n");
3698 }
3699
3700 printf("numerical dTN0.i\n");
3701 for (i=0; i<2; i++){
3702 for (j=0; j<2; j++){
3703 printf("%15.12f ", tmp1*TNC[i][j].i - tmp2*TNC[i][j].r );
3704 }
3705 printf("\n");
3706 }
3707
3708
3709 }
3710
3711 MPI_Finalize();
3712 exit(0);
3713 */
3714
3715 for (i=0; i<Spe_Total_NO[wan1]; i++){
3716 for (j=0; j<Spe_Total_NO[wan1]; j++){
3717
3718 if (i==j){
3719
3720 for (s1=0; s1<2; s1++){
3721 for (s2=0; s2<2; s2++){
3722
3723 csum1 = Complex(0.0,0.0);
3724
3725 for (s3=0; s3<2; s3++){
3726 for (s4=0; s4<2; s4++){
3727
3728 if (s1==s3 && s2==s4){
3729
3730 ctmp1.r = TN[s3][s4].r - TN0[s3][s4].r;
3731 ctmp1.i = TN[s3][s4].i - TN0[s3][s4].i;
3732 ctmp2.r = 1.0 - dTN[s1][s2][s4][s3].r;
3733 ctmp2.i = - dTN[s1][s2][s4][s3].i;
3734
3735 csum1.r += ctmp1.r*ctmp2.r - ctmp1.i*ctmp2.i;
3736 csum1.i += ctmp1.r*ctmp2.i + ctmp1.i*ctmp2.r;
3737 }
3738 else{
3739
3740 ctmp1.r = TN[s3][s4].r - TN0[s3][s4].r;
3741 ctmp1.i = TN[s3][s4].i - TN0[s3][s4].i;
3742 ctmp2.r = -dTN[s1][s2][s4][s3].r;
3743 ctmp2.i = -dTN[s1][s2][s4][s3].i;
3744
3745 csum1.r += ctmp1.r*ctmp2.r - ctmp1.i*ctmp2.i;
3746 csum1.i += ctmp1.r*ctmp2.i + ctmp1.i*ctmp2.r;
3747 }
3748
3749 } /* s4 */
3750 } /* s3 */
3751
3752
3753 NC_v_eff[s1][s2][Mc_AN][i][j].r += 2.0*Constraint_NCS_V*csum1.r;
3754 NC_v_eff[s1][s2][Mc_AN][i][j].i += 2.0*Constraint_NCS_V*csum1.i;
3755
3756 }
3757 }
3758 }
3759 }
3760 }
3761
3762 /* calculate the penalty functional, Ucs */
3763
3764 tmp1 = 0.0;
3765
3766 for (s1=0; s1<2; s1++){
3767 for (s2=0; s2<2; s2++){
3768
3769 ctmp1.r = TN[s1][s2].r - TN0[s1][s2].r;
3770 ctmp1.i = TN[s1][s2].i - TN0[s1][s2].i;
3771 tmp1 += ctmp1.r*ctmp1.r + ctmp1.i*ctmp1.i;
3772 }
3773 }
3774
3775 My_Ucs += Constraint_NCS_V*tmp1;
3776
3777 /* energy decomposition */
3778
3779 if (Energy_Decomposition_flag==1){
3780
3781 tmp = Constraint_NCS_V*tmp1/(2.0*(double)Spe_Total_NO[wan1]);
3782
3783 for (i=0; i<Spe_Total_NO[wan1]; i++){
3784 DecEcs[0][Mc_AN][i] = tmp;
3785 DecEcs[1][Mc_AN][i] = tmp;
3786 }
3787 }
3788
3789
3790 } /* if (Constraint_NCS_switch==1 && Constraint_SpinAngle[Gc_AN]==1 ) */
3791
3792
3793 /************************************************************
3794 ***********************************************************
3795 ***********************************************************
3796 ***********************************************************
3797
3798 calculate veff by the constraint DFT which controls
3799 both the direction and the magnitude of spin.
3800
3801 ***********************************************************
3802 ***********************************************************
3803 ***********************************************************
3804 ************************************************************/
3805
3806 if (Constraint_NCS_switch==2 && Constraint_SpinAngle[Gc_AN]==1 ){
3807
3808 /* calculate TN */
3809
3810 TN[0][0].r = 0.0;
3811 TN[0][1].r = 0.0;
3812 TN[1][0].r = 0.0;
3813 TN[1][1].r = 0.0;
3814 TN[0][0].i = 0.0;
3815 TN[0][1].i = 0.0;
3816 TN[1][0].i = 0.0;
3817 TN[1][1].i = 0.0;
3818
3819 for (i=0; i<Spe_Total_NO[wan1]; i++){
3820
3821 TN[0][0].r += NC_OcpN[0][0][0][Mc_AN][i][i].r;
3822 TN[0][1].r += NC_OcpN[0][0][1][Mc_AN][i][i].r;
3823 TN[1][0].r += NC_OcpN[0][1][0][Mc_AN][i][i].r;
3824 TN[1][1].r += NC_OcpN[0][1][1][Mc_AN][i][i].r;
3825
3826 /*
3827 conjugate complex of TN due to difference
3828 in the definition between density matrix
3829 and charge density
3830 */
3831
3832 TN[0][0].i -= NC_OcpN[0][0][0][Mc_AN][i][i].i;
3833 TN[0][1].i -= NC_OcpN[0][0][1][Mc_AN][i][i].i;
3834 TN[1][0].i -= NC_OcpN[0][1][0][Mc_AN][i][i].i;
3835 TN[1][1].i -= NC_OcpN[0][1][1][Mc_AN][i][i].i;
3836 }
3837
3838
3839 /*
3840 printf("TN.r Mc_AN=%2d\n",Mc_AN);
3841 for (i=0; i<2; i++){
3842 for (j=0; j<2; j++){
3843 printf("%15.12f ",TN[i][j].r);
3844 }
3845 printf("\n");
3846 }
3847
3848 printf("TN.i Mc_AN=%2d\n",Mc_AN);
3849 for (i=0; i<2; i++){
3850 for (j=0; j<2; j++){
3851 printf("%15.12f ",TN[i][j].i);
3852 }
3853 printf("\n");
3854 }
3855 */
3856
3857 EulerAngle_Spin( 1,
3858 TN[0][0].r, TN[1][1].r,
3859 TN[0][1].r, TN[0][1].i,
3860 TN[1][0].r, TN[1][0].i,
3861 Nup, Ndn, theta, phi );
3862
3863 /**********************
3864 calculate TN0
3865 **********************/
3866
3867 /*
3868 printf("Nup=%15.12f Ndn=%15.12f theta=%15.12f phi=%15.12f\n",Nup[0],Ndn[0],theta[0],phi[0]);
3869 printf("theta =%15.12f phi =%15.12f\n",theta[0]/PI*180.0,phi[0]/PI*180.0);
3870
3871 printf("theta0=%15.12f phi0=%15.12f\n",InitAngle0_Spin[Gc_AN]/PI*180.0,
3872 InitAngle1_Spin[Gc_AN]/PI*180.0);
3873 */
3874
3875 /* constraint which trys to keep the initial magnetic moment */
3876
3877 Nup0 = Nup[0];
3878 Ndn0 = Ndn[0];
3879
3880 Nup[0] = 0.5*(Nup0 + Ndn0 + InitMagneticMoment[Gc_AN]);
3881 Ndn[0] = 0.5*(Nup0 + Ndn0 - InitMagneticMoment[Gc_AN]);
3882
3883 /* calculaion of TN0 */
3884
3885 sit = sin(0.5*InitAngle0_Spin[Gc_AN]);
3886 cot = cos(0.5*InitAngle0_Spin[Gc_AN]);
3887 sip = sin(0.5*InitAngle1_Spin[Gc_AN]);
3888 cop = cos(0.5*InitAngle1_Spin[Gc_AN]);
3889
3890 U[0][0].r = cop*cot; U[0][0].i = sip*cot;
3891 U[0][1].r = cop*sit; U[0][1].i =-sip*sit;
3892 U[1][0].r =-cop*sit; U[1][0].i =-sip*sit;
3893 U[1][1].r = cop*cot; U[1][1].i =-sip*cot;
3894
3895 TN0[0][0].r = Nup[0]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3896 + Ndn[0]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3897
3898 TN0[0][0].i = 0.0;
3899
3900 TN0[0][1].r = Nup[0]*( U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i )
3901 + Ndn[0]*( U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i );
3902
3903 TN0[0][1].i = Nup[0]*(-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i )
3904 + Ndn[0]*(-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i );
3905
3906 TN0[1][0].r = Nup[0]*( U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i )
3907 + Ndn[0]*( U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i );
3908
3909 TN0[1][0].i = Nup[0]*(-U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i )
3910 + Ndn[0]*(-U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i );
3911
3912 TN0[1][1].r = Nup[0]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3913 + Ndn[0]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3914
3915 TN0[1][1].i = 0.0;
3916
3917 /* calculate dTN */
3918
3919 Calc_dTN( Constraint_NCS_switch, TN, dTN, U, theta, phi );
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929 /*
3930
3931 {
3932
3933
3934 dcomplex TNA[10][10];
3935 dcomplex TNB[10][10];
3936 dcomplex TNC[10][10];
3937
3938 dcomplex ctmp1,ctmp2;
3939
3940
3941
3942 l1 = 1;
3943 l2 = 0;
3944 tmp1 = 0.0001;
3945 tmp2 = 0.01;
3946
3947
3948 EulerAngle_Spin( 0,
3949 TN[0][0].r, TN[1][1].r,
3950 TN[0][1].r, TN[0][1].i,
3951 TN[1][0].r, TN[1][0].i,
3952 Nup, Ndn, theta, phi );
3953
3954 printf("V0 Nup.r=%15.12f Nup.i=%15.12f\n",Nup[0],Nup[1]);
3955 printf("V0 Ndn.r=%15.12f Ndn.i=%15.12f\n",Ndn[0],Ndn[1]);
3956
3957
3958 sit = sin(0.5*InitAngle0_Spin[Gc_AN]);
3959 cot = cos(0.5*InitAngle0_Spin[Gc_AN]);
3960 sip = sin(0.5*InitAngle1_Spin[Gc_AN]);
3961 cop = cos(0.5*InitAngle1_Spin[Gc_AN]);
3962
3963 U[0][0].r = cop*cot; U[0][0].i = sip*cot;
3964 U[0][1].r = cop*sit; U[0][1].i =-sip*sit;
3965 U[1][0].r =-cop*sit; U[1][0].i =-sip*sit;
3966 U[1][1].r = cop*cot; U[1][1].i =-sip*cot;
3967
3968 TN0[0][0].r = Nup[0]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3969 + Ndn[0]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3970
3971 TN0[0][0].i = Nup[1]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
3972 + Ndn[1]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
3973
3974 ctmp1.r = U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i;
3975 ctmp1.i =-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i;
3976 ctmp2.r = U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i;
3977 ctmp2.i =-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i;
3978
3979 TN0[0][1].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
3980 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
3981
3982 TN0[0][1].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
3983 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
3984
3985 ctmp1.r = U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i;
3986 ctmp1.i = -U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i;
3987 ctmp2.r = U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i;
3988 ctmp2.i = -U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i;
3989
3990 TN0[1][0].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
3991 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
3992
3993 TN0[1][0].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
3994 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
3995
3996 TN0[1][1].r = Nup[0]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
3997 + Ndn[0]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
3998
3999 TN0[1][1].i = Nup[1]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
4000 + Ndn[1]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
4001
4002
4003 Calc_dTN( Constraint_NCS_switch, TN, dTN, U, theta, phi );
4004
4005 printf("1 TN0.r\n");
4006 for (i=0; i<2; i++){
4007 for (j=0; j<2; j++){
4008 printf("%15.12f ",TN0[i][j].r);
4009
4010 TNA[i][j] = TN0[i][j];
4011 }
4012 printf("\n");
4013 }
4014
4015 printf("1 TN0.i\n");
4016 for (i=0; i<2; i++){
4017 for (j=0; j<2; j++){
4018 printf("%15.12f ",TN0[i][j].i);
4019 }
4020 printf("\n");
4021 }
4022
4023
4024
4025
4026 TN[l1][l2].r += tmp1;
4027 TN[l1][l2].i += tmp2;
4028
4029 EulerAngle_Spin( 0,
4030 TN[0][0].r, TN[1][1].r,
4031 TN[0][1].r, TN[0][1].i,
4032 TN[1][0].r, TN[1][0].i,
4033 Nup, Ndn, theta, phi );
4034
4035 printf("V1 Nup.r=%15.12f Nup.i=%15.12f\n",Nup[0],Nup[1]);
4036 printf("V1 Ndn.r=%15.12f Ndn.i=%15.12f\n",Ndn[0],Ndn[1]);
4037
4038
4039 sit = sin(0.5*InitAngle0_Spin[Gc_AN]);
4040 cot = cos(0.5*InitAngle0_Spin[Gc_AN]);
4041 sip = sin(0.5*InitAngle1_Spin[Gc_AN]);
4042 cop = cos(0.5*InitAngle1_Spin[Gc_AN]);
4043
4044 U[0][0].r = cop*cot; U[0][0].i = sip*cot;
4045 U[0][1].r = cop*sit; U[0][1].i =-sip*sit;
4046 U[1][0].r =-cop*sit; U[1][0].i =-sip*sit;
4047 U[1][1].r = cop*cot; U[1][1].i =-sip*cot;
4048
4049
4050
4051 TN0[0][0].r = Nup[0]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
4052 + Ndn[0]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
4053
4054 TN0[0][0].i = Nup[1]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
4055 + Ndn[1]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
4056
4057 ctmp1.r = U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i;
4058 ctmp1.i =-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i;
4059 ctmp2.r = U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i;
4060 ctmp2.i =-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i;
4061
4062 TN0[0][1].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
4063 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
4064
4065 TN0[0][1].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
4066 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
4067
4068 ctmp1.r = U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i;
4069 ctmp1.i = -U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i;
4070 ctmp2.r = U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i;
4071 ctmp2.i = -U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i;
4072
4073 TN0[1][0].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
4074 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
4075
4076 TN0[1][0].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
4077 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
4078
4079 TN0[1][1].r = Nup[0]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
4080 + Ndn[0]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
4081
4082 TN0[1][1].i = Nup[1]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
4083 + Ndn[1]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
4084
4085
4086
4087
4088
4089
4090
4091 Calc_dTN( Constraint_NCS_switch, TN, dTN, U, theta, phi );
4092
4093 printf("\nanalytical dTN.r\n");
4094 for (i=0; i<2; i++){
4095 for (j=0; j<2; j++){
4096 printf("%15.12f ",dTN[l1][l2][i][j].r);
4097 }
4098 printf("\n");
4099 }
4100
4101 printf("analytical dTN.i\n");
4102 for (i=0; i<2; i++){
4103 for (j=0; j<2; j++){
4104 printf("%15.12f ",dTN[l1][l2][i][j].i);
4105 }
4106 printf("\n");
4107 }
4108
4109
4110
4111
4112
4113
4114 TN[l1][l2].r += tmp1;
4115 TN[l1][l2].i += tmp2;
4116
4117 EulerAngle_Spin( 0,
4118 TN[0][0].r, TN[1][1].r,
4119 TN[0][1].r, TN[0][1].i,
4120 TN[1][0].r, TN[1][0].i,
4121 Nup, Ndn, theta, phi );
4122
4123 printf("V2 Nup.r=%15.12f Nup.i=%15.12f\n",Nup[0],Nup[1]);
4124 printf("V2 Ndn.r=%15.12f Ndn.i=%15.12f\n",Ndn[0],Ndn[1]);
4125
4126
4127 sit = sin(0.5*InitAngle0_Spin[Gc_AN]);
4128 cot = cos(0.5*InitAngle0_Spin[Gc_AN]);
4129 sip = sin(0.5*InitAngle1_Spin[Gc_AN]);
4130 cop = cos(0.5*InitAngle1_Spin[Gc_AN]);
4131
4132 U[0][0].r = cop*cot; U[0][0].i = sip*cot;
4133 U[0][1].r = cop*sit; U[0][1].i =-sip*sit;
4134 U[1][0].r =-cop*sit; U[1][0].i =-sip*sit;
4135 U[1][1].r = cop*cot; U[1][1].i =-sip*cot;
4136
4137
4138
4139
4140 TN0[0][0].r = Nup[0]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
4141 + Ndn[0]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
4142
4143 TN0[0][0].i = Nup[1]*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
4144 + Ndn[1]*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
4145
4146 ctmp1.r = U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i;
4147 ctmp1.i =-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i;
4148 ctmp2.r = U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i;
4149 ctmp2.i =-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i;
4150
4151 TN0[0][1].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
4152 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
4153
4154 TN0[0][1].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
4155 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
4156
4157 ctmp1.r = U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i;
4158 ctmp1.i = -U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i;
4159 ctmp2.r = U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i;
4160 ctmp2.i = -U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i;
4161
4162 TN0[1][0].r = Nup[0]*ctmp1.r - Nup[1]*ctmp1.i
4163 + Ndn[0]*ctmp2.r - Ndn[1]*ctmp2.i;
4164
4165 TN0[1][0].i = Nup[0]*ctmp1.i + Nup[1]*ctmp1.r
4166 + Ndn[0]*ctmp2.i + Ndn[1]*ctmp2.r;
4167
4168 TN0[1][1].r = Nup[0]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
4169 + Ndn[0]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
4170
4171 TN0[1][1].i = Nup[1]*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
4172 + Ndn[1]*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
4173
4174
4175
4176
4177
4178
4179 Calc_dTN( Constraint_NCS_switch, TN, dTN, U, theta, phi );
4180
4181
4182
4183
4184 printf("2 TN0.r\n");
4185 for (i=0; i<2; i++){
4186 for (j=0; j<2; j++){
4187 printf("%15.12f ",TN0[i][j].r);
4188 TNB[i][j] = TN0[i][j];
4189
4190 }
4191 printf("\n");
4192 }
4193
4194 printf("2 TN0.i\n");
4195 for (i=0; i<2; i++){
4196 for (j=0; j<2; j++){
4197 printf("%15.12f ",TN0[i][j].i);
4198 }
4199 printf("\n");
4200 }
4201
4202
4203
4204 for (i=0; i<2; i++){
4205 for (j=0; j<2; j++){
4206 TNC[i][j].r = 0.5*(TNB[i][j].r - TNA[i][j].r)/( tmp1*tmp1 + tmp2*tmp2 );
4207 TNC[i][j].i = 0.5*(TNB[i][j].i - TNA[i][j].i)/( tmp1*tmp1 + tmp2*tmp2 );
4208 }
4209 }
4210
4211 printf("\nnumerical dTN0.r\n");
4212 for (i=0; i<2; i++){
4213 for (j=0; j<2; j++){
4214 printf("%15.12f ", tmp1*TNC[i][j].r + tmp2*TNC[i][j].i );
4215 }
4216 printf("\n");
4217 }
4218
4219 printf("numerical dTN0.i\n");
4220 for (i=0; i<2; i++){
4221 for (j=0; j<2; j++){
4222 printf("%15.12f ", tmp1*TNC[i][j].i - tmp2*TNC[i][j].r );
4223 }
4224 printf("\n");
4225 }
4226
4227
4228 }
4229
4230 MPI_Finalize();
4231 exit(0);
4232 */
4233
4234 for (i=0; i<Spe_Total_NO[wan1]; i++){
4235 for (j=0; j<Spe_Total_NO[wan1]; j++){
4236
4237 if (i==j){
4238
4239 for (s1=0; s1<2; s1++){
4240 for (s2=0; s2<2; s2++){
4241
4242 csum1 = Complex(0.0,0.0);
4243
4244 for (s3=0; s3<2; s3++){
4245 for (s4=0; s4<2; s4++){
4246
4247 if (s1==s3 && s2==s4){
4248
4249 ctmp1.r = TN[s3][s4].r - TN0[s3][s4].r;
4250 ctmp1.i = TN[s3][s4].i - TN0[s3][s4].i;
4251 ctmp2.r = 1.0 - dTN[s1][s2][s4][s3].r;
4252 ctmp2.i = - dTN[s1][s2][s4][s3].i;
4253
4254 csum1.r += ctmp1.r*ctmp2.r - ctmp1.i*ctmp2.i;
4255 csum1.i += ctmp1.r*ctmp2.i + ctmp1.i*ctmp2.r;
4256 }
4257 else{
4258
4259 ctmp1.r = TN[s3][s4].r - TN0[s3][s4].r;
4260 ctmp1.i = TN[s3][s4].i - TN0[s3][s4].i;
4261 ctmp2.r = -dTN[s1][s2][s4][s3].r;
4262 ctmp2.i = -dTN[s1][s2][s4][s3].i;
4263
4264 csum1.r += ctmp1.r*ctmp2.r - ctmp1.i*ctmp2.i;
4265 csum1.i += ctmp1.r*ctmp2.i + ctmp1.i*ctmp2.r;
4266 }
4267
4268 } /* s4 */
4269 } /* s3 */
4270
4271
4272 NC_v_eff[s1][s2][Mc_AN][i][j].r += 2.0*Constraint_NCS_V*csum1.r;
4273 NC_v_eff[s1][s2][Mc_AN][i][j].i += 2.0*Constraint_NCS_V*csum1.i;
4274
4275 }
4276 }
4277 }
4278 }
4279 }
4280
4281 /* calculate the penalty functional, Ucs */
4282
4283 tmp1 = 0.0;
4284
4285 for (s1=0; s1<2; s1++){
4286 for (s2=0; s2<2; s2++){
4287
4288 ctmp1.r = TN[s1][s2].r - TN0[s1][s2].r;
4289 ctmp1.i = TN[s1][s2].i - TN0[s1][s2].i;
4290 tmp1 += ctmp1.r*ctmp1.r + ctmp1.i*ctmp1.i;
4291 }
4292 }
4293
4294 My_Ucs += Constraint_NCS_V*tmp1;
4295
4296 /* energy decomposition */
4297
4298 if (Energy_Decomposition_flag==1){
4299
4300 tmp = Constraint_NCS_V*tmp1/(2.0*(double)Spe_Total_NO[wan1]);
4301
4302 for (i=0; i<Spe_Total_NO[wan1]; i++){
4303 DecEcs[0][Mc_AN][i] = tmp;
4304 DecEcs[1][Mc_AN][i] = tmp;
4305 }
4306 }
4307
4308
4309 } /* if (Constraint_NCS_switch==2 && Constraint_SpinAngle[Gc_AN]==1 ) */
4310
4311 /************************************************************
4312 ***********************************************************
4313 ***********************************************************
4314 ***********************************************************
4315
4316 calculate the v_eff for Zeeman term for spin
4317
4318 ***********************************************************
4319 ***********************************************************
4320 ***********************************************************
4321 ************************************************************/
4322
4323 else if (Zeeman_NCS_switch==1 && Constraint_SpinAngle[Gc_AN]==1 ){
4324
4325 theta0 = InitAngle0_Spin[Gc_AN];
4326 phi0 = InitAngle1_Spin[Gc_AN];
4327
4328 /* calculate TN */
4329
4330 TN[0][0].r = 0.0;
4331 TN[0][1].r = 0.0;
4332 TN[1][0].r = 0.0;
4333 TN[1][1].r = 0.0;
4334 TN[0][0].i = 0.0;
4335 TN[0][1].i = 0.0;
4336 TN[1][0].i = 0.0;
4337 TN[1][1].i = 0.0;
4338
4339 for (i=0; i<Spe_Total_NO[wan1]; i++){
4340
4341 TN[0][0].r += NC_OcpN[0][0][0][Mc_AN][i][i].r;
4342 TN[0][1].r += NC_OcpN[0][0][1][Mc_AN][i][i].r;
4343 TN[1][0].r += NC_OcpN[0][1][0][Mc_AN][i][i].r;
4344 TN[1][1].r += NC_OcpN[0][1][1][Mc_AN][i][i].r;
4345
4346 /*
4347 conjugate complex of TN due to difference
4348 in the definition between density matrix
4349 and charge density
4350 */
4351
4352 TN[0][0].i -= NC_OcpN[0][0][0][Mc_AN][i][i].i;
4353 TN[0][1].i -= NC_OcpN[0][0][1][Mc_AN][i][i].i;
4354 TN[1][0].i -= NC_OcpN[0][1][0][Mc_AN][i][i].i;
4355 TN[1][1].i -= NC_OcpN[0][1][1][Mc_AN][i][i].i;
4356 }
4357
4358 EulerAngle_Spin( 1,
4359 TN[0][0].r, TN[1][1].r,
4360 TN[0][1].r, TN[0][1].i,
4361 TN[1][0].r, TN[1][0].i,
4362 Nup, Ndn, theta, phi );
4363
4364
4365
4366
4367
4368 /*
4369 printf("Nup= %18.15f\n",Nup[0],Nup[1]);
4370 printf("Ndn= %18.15f\n",Ndn[0],Ndn[1]);
4371 printf("theta= %18.15f\n",theta[0],theta[1]);
4372 printf("phi= %18.15f\n",phi[0],phi[1]);
4373 */
4374
4375
4376
4377 /* calculate dSx, dSy, dSz */
4378
4379 dSx[0][0].r = 0.0;
4380 dSx[0][1].r = 0.5;
4381 dSx[1][0].r = 0.5;
4382 dSx[1][1].r = 0.0;
4383
4384 dSx[0][0].i = 0.0;
4385 dSx[0][1].i = 0.0;
4386 dSx[1][0].i = 0.0;
4387 dSx[1][1].i = 0.0;
4388
4389 dSy[0][0].r = 0.0;
4390 dSy[0][1].r = 0.0;
4391 dSy[1][0].r = 0.0;
4392 dSy[1][1].r = 0.0;
4393
4394 dSy[0][0].i = 0.0;
4395 dSy[0][1].i =-0.5; /* causion for the sign */
4396 dSy[1][0].i = 0.5; /* causion for the sign */
4397 dSy[1][1].i = 0.0;
4398
4399 dSz[0][0].r = 0.5;
4400 dSz[0][1].r = 0.0;
4401 dSz[1][0].r = 0.0;
4402 dSz[1][1].r =-0.5;
4403
4404 dSz[0][0].i = 0.0;
4405 dSz[0][1].i = 0.0;
4406 dSz[1][0].i = 0.0;
4407 dSz[1][1].i = 0.0;
4408
4409 /*
4410 Calc_dSxyz( TN, dSx, dSy, dSz, Nup, Ndn, theta, phi );
4411
4412 {
4413
4414 double Sx,Sy,Sz;
4415
4416 Sx = 0.5*(Nup[0] - Ndn[0])*sin(theta[0])*cos(phi[0]);
4417 Sy = 0.5*(Nup[0] - Ndn[0])*sin(theta[0])*sin(phi[0]);
4418 Sz = 0.5*(Nup[0] - Ndn[0])*cos(theta[0]);
4419
4420 printf("Sx=%18.15f\n",Sx);
4421 printf("Sy=%18.15f\n",Sy);
4422 printf("Sz=%18.15f\n",Sz);
4423
4424 printf("Re dSx11=%18.15f\n",dSx[0][0].r);
4425 printf("Re dSx12=%18.15f\n",dSx[0][1].r);
4426 printf("Re dSx21=%18.15f\n",dSx[1][0].r);
4427 printf("Re dSx22=%18.15f\n",dSx[1][1].r);
4428
4429 printf("Im dSx11=%18.15f\n",dSx[0][0].i);
4430 printf("Im dSx12=%18.15f\n",dSx[0][1].i);
4431 printf("Im dSx21=%18.15f\n",dSx[1][0].i);
4432 printf("Im dSx22=%18.15f\n\n",dSx[1][1].i);
4433
4434
4435 printf("Re dSy11=%18.15f\n",dSy[0][0].r);
4436 printf("Re dSy12=%18.15f\n",dSy[0][1].r);
4437 printf("Re dSy21=%18.15f\n",dSy[1][0].r);
4438 printf("Re dSy22=%18.15f\n",dSy[1][1].r);
4439
4440 printf("Im dSy11=%18.15f\n",dSy[0][0].i);
4441 printf("Im dSy12=%18.15f\n",dSy[0][1].i);
4442 printf("Im dSy21=%18.15f\n",dSy[1][0].i);
4443 printf("Im dSy22=%18.15f\n\n",dSy[1][1].i);
4444
4445 printf("Re dSz11=%18.15f\n",dSz[0][0].r);
4446 printf("Re dSz12=%18.15f\n",dSz[0][1].r);
4447 printf("Re dSz21=%18.15f\n",dSz[1][0].r);
4448 printf("Re dSz22=%18.15f\n",dSz[1][1].r);
4449
4450 printf("Im dSz11=%18.15f\n",dSz[0][0].i);
4451 printf("Im dSz12=%18.15f\n",dSz[0][1].i);
4452 printf("Im dSz21=%18.15f\n",dSz[1][0].i);
4453 printf("Im dSz22=%18.15f\n\n",dSz[1][1].i);
4454
4455 }
4456
4457
4458 MPI_Finalize();
4459 exit(0);
4460 */
4461
4462 /* calculate the energy for the Zeeman term for spin, Uzs */
4463
4464 lx = sin(theta0)*cos(phi0);
4465 ly = sin(theta0)*sin(phi0);
4466 lz = cos(theta0);
4467
4468 Bx = -Mag_Field_Spin*lx;
4469 By = -Mag_Field_Spin*ly;
4470 Bz = -Mag_Field_Spin*lz;
4471
4472 sx = 0.5*(TN[0][1].r + TN[1][0].r);
4473 sy = -0.5*(TN[0][1].i - TN[1][0].i);
4474 sz = 0.5*(TN[0][0].r - TN[1][1].r);
4475
4476 My_Uzs += sx*Bx + sy*By + sz*Bz;
4477
4478 /* energy decomposition */
4479
4480 if (Energy_Decomposition_flag==1){
4481
4482 tmp = (sx*Bx + sy*By + sz*Bz)/(2.0*(double)Spe_Total_NO[wan1]);
4483
4484 for (i=0; i<Spe_Total_NO[wan1]; i++){
4485 DecEzs[0][Mc_AN][i] = tmp;
4486 DecEzs[1][Mc_AN][i] = tmp;
4487 }
4488 }
4489
4490 /*
4491 printf("Uzs=%15.12f\n",sx*Bx + sy*By + sz*Bz);
4492
4493 printf("|s|=%18.15f\n",sqrt(sx*sx+sy*sy+sz*sz));
4494 printf("theta=%18.15f %18.15f\n",theta0/PI*180.0,theta[0]/PI*180.0);
4495 printf("phi =%18.15f %18.15f\n",phi0/PI*180.0,phi[0]/PI*180.0);
4496
4497 printf("sx=%18.15f %18.15f\n",sx,0.5*(Nup[0] - Ndn[0])*sin(theta[0])*cos(phi[0]));
4498 printf("sy=%18.15f %18.15f\n",sy,0.5*(Nup[0] - Ndn[0])*sin(theta[0])*sin(phi[0]));
4499 printf("sz=%18.15f %18.15f\n",sz,0.5*(Nup[0] - Ndn[0])*cos(theta[0]));
4500
4501 printf("Bx=%18.15f\n",Bx);
4502 printf("By=%18.15f\n",By);
4503 printf("Bz=%18.15f\n",Bz);
4504 */
4505
4506 /* calculate veff by the Zeeman term for spin magnetic moment */
4507
4508 for (i=0; i<Spe_Total_NO[wan1]; i++){
4509 for (j=0; j<Spe_Total_NO[wan1]; j++){
4510
4511 if (i==j){
4512 for (s1=0; s1<2; s1++){
4513 for (s2=0; s2<2; s2++){
4514
4515 NC_v_eff[s1][s2][Mc_AN][i][j].r += Bx*dSx[s1][s2].r + By*dSy[s1][s2].r + Bz*dSz[s1][s2].r;
4516 NC_v_eff[s1][s2][Mc_AN][i][j].i += Bx*dSx[s1][s2].i + By*dSy[s1][s2].i + Bz*dSz[s1][s2].i;
4517
4518 /*
4519 printf("spin i=%2d j=%2d s1=%2d s2=%2d re=%15.12f im=%15.12f\n",
4520 i,j,s1,s2,
4521 Bx*dSx[s1][s2].r + By*dSy[s1][s2].r + Bz*dSz[s1][s2].r,
4522 Bx*dSx[s1][s2].i + By*dSy[s1][s2].i + Bz*dSz[s1][s2].i );
4523 */
4524
4525
4526 }
4527 }
4528 }
4529 }
4530 }
4531
4532 } /* else if (Zeeman_NCS_switch==1 && Constraint_SpinAngle[Gc_AN]==1 ) */
4533
4534
4535
4536
4537
4538 /************************************************************
4539 ***********************************************************
4540 ***********************************************************
4541 ***********************************************************
4542
4543 calculate the v_eff for Zeeman term for orbital
4544
4545 ***********************************************************
4546 ***********************************************************
4547 ***********************************************************
4548 ************************************************************/
4549
4550 if (Zeeman_NCO_switch==1 && Constraint_SpinAngle[Gc_AN]==1 ){
4551
4552 Gc_AN = M2G[Mc_AN];
4553 Cwan = WhatSpecies[Gc_AN];
4554 tno0 = Spe_Total_NO[Cwan];
4555
4556 theta0 = InitAngle0_Orbital[Gc_AN];
4557 phi0 = InitAngle1_Orbital[Gc_AN];
4558
4559 lx = sin(theta0)*cos(phi0);
4560 ly = sin(theta0)*sin(phi0);
4561 lz = cos(theta0);
4562
4563 Lx = Orbital_Moment_XYZ[Gc_AN][0];
4564 Ly = Orbital_Moment_XYZ[Gc_AN][1];
4565 Lz = Orbital_Moment_XYZ[Gc_AN][2];
4566
4567 L = sqrt(Lx*Lx + Ly*Ly + Lz*Lz);
4568
4569 A = -0.5*Mag_Field_Orbital*lx;
4570 B = -0.5*Mag_Field_Orbital*ly;
4571 C = -0.5*Mag_Field_Orbital*lz;
4572
4573 for (i=0; i<tno0; i++){
4574 for (j=0; j<tno0; j++){
4575
4576 tmp = A*OLP_L[0][Mc_AN][0][i][j]
4577 + B*OLP_L[1][Mc_AN][0][i][j]
4578 + C*OLP_L[2][Mc_AN][0][i][j];
4579
4580 NC_v_eff[0][0][Mc_AN][i][j].i += tmp;
4581 NC_v_eff[1][1][Mc_AN][i][j].i += tmp;
4582
4583 }
4584 }
4585
4586 My_Uzo += A*Lx + B*Ly + C*Lz;
4587
4588 /* energy decomposition */
4589
4590 if (Energy_Decomposition_flag==1){
4591
4592 tmp = (A*Lx + B*Ly + C*Lz)/(2.0*(double)Spe_Total_NO[wan1]);
4593
4594 for (i=0; i<Spe_Total_NO[wan1]; i++){
4595 DecEzo[0][Mc_AN][i] = tmp;
4596 DecEzo[1][Mc_AN][i] = tmp;
4597 }
4598 }
4599
4600 } /* if (Zeeman_NCO_switch==1 && Constraint_SpinAngle[Gc_AN]==1 ) */
4601
4602 /* measure elapsed time */
4603
4604 dtime(&Etime_atom);
4605 time_per_atom[Gc_AN] += Etime_atom - Stime_atom;
4606
4607 } /* Mc_AN */
4608
4609 /****************************************************
4610 MPI: energy contributions
4611 ****************************************************/
4612
4613 MPI_Allreduce(&My_Ucs, &tmp1, 1, MPI_DOUBLE, MPI_SUM, mpi_comm_level1);
4614 ECE[9] = tmp1;
4615
4616 MPI_Allreduce(&My_Uzs, &tmp1, 1, MPI_DOUBLE, MPI_SUM, mpi_comm_level1);
4617 ECE[10] = tmp1;
4618
4619 MPI_Allreduce(&My_Uzo, &tmp1, 1, MPI_DOUBLE, MPI_SUM, mpi_comm_level1);
4620 ECE[11] = tmp1;
4621
4622 /****************************************************
4623 MPI: NC_v_eff
4624 ****************************************************/
4625
4626 /***********************************
4627 set data size
4628 ************************************/
4629
4630 for (ID=0; ID<numprocs; ID++){
4631
4632 IDS = (myid + ID) % numprocs;
4633 IDR = (myid - ID + numprocs) % numprocs;
4634
4635 if (ID!=0){
4636 tag = 999;
4637
4638 /* find data size to send block data */
4639 if (F_Snd_Num[IDS]!=0){
4640
4641 size1 = 0;
4642 for (n=0; n<F_Snd_Num[IDS]; n++){
4643 Mc_AN = Snd_MAN[IDS][n];
4644 Gc_AN = Snd_GAN[IDS][n];
4645 Cwan = WhatSpecies[Gc_AN];
4646 tno1 = Spe_Total_NO[Cwan];
4647 size1 += tno1*tno1;
4648 }
4649 size1 = 8*size1;
4650 Snd_Size[IDS] = size1;
4651 MPI_Isend(&size1, 1, MPI_INT, IDS, tag, mpi_comm_level1, &request);
4652 }
4653 else{
4654 Snd_Size[IDS] = 0;
4655 }
4656
4657 /* receiving of size of data */
4658
4659 if (F_Rcv_Num[IDR]!=0){
4660 MPI_Recv(&size2, 1, MPI_INT, IDR, tag, mpi_comm_level1, &stat);
4661 Rcv_Size[IDR] = size2;
4662 }
4663 else{
4664 Rcv_Size[IDR] = 0;
4665 }
4666
4667 if (F_Snd_Num[IDS]!=0) MPI_Wait(&request,&stat);
4668
4669 }
4670 }
4671
4672 /***********************************
4673 data transfer
4674 ************************************/
4675
4676 tag = 999;
4677 for (ID=0; ID<numprocs; ID++){
4678
4679 IDS = (myid + ID) % numprocs;
4680 IDR = (myid - ID + numprocs) % numprocs;
4681
4682 if (ID!=0){
4683
4684 /*****************************
4685 sending of data
4686 *****************************/
4687
4688 if (F_Snd_Num[IDS]!=0){
4689
4690 size1 = Snd_Size[IDS];
4691
4692 /* allocation of array */
4693
4694 tmp_array = (double*)malloc(sizeof(double)*size1);
4695
4696 /* multidimentional array to vector array */
4697
4698 num = 0;
4699
4700 for (n=0; n<F_Snd_Num[IDS]; n++){
4701 Mc_AN = Snd_MAN[IDS][n];
4702 Gc_AN = Snd_GAN[IDS][n];
4703 Cwan = WhatSpecies[Gc_AN];
4704 tno1 = Spe_Total_NO[Cwan];
4705 for (i=0; i<tno1; i++){
4706 for (j=0; j<tno1; j++){
4707 tmp_array[num] = NC_v_eff[0][0][Mc_AN][i][j].r; num++;
4708 tmp_array[num] = NC_v_eff[0][0][Mc_AN][i][j].i; num++;
4709 tmp_array[num] = NC_v_eff[1][1][Mc_AN][i][j].r; num++;
4710 tmp_array[num] = NC_v_eff[1][1][Mc_AN][i][j].i; num++;
4711 tmp_array[num] = NC_v_eff[0][1][Mc_AN][i][j].r; num++;
4712 tmp_array[num] = NC_v_eff[0][1][Mc_AN][i][j].i; num++;
4713 tmp_array[num] = NC_v_eff[1][0][Mc_AN][i][j].r; num++;
4714 tmp_array[num] = NC_v_eff[1][0][Mc_AN][i][j].i; num++;
4715 }
4716 }
4717 }
4718
4719
4720 MPI_Isend(&tmp_array[0], size1, MPI_DOUBLE, IDS, tag, mpi_comm_level1, &request);
4721 }
4722
4723 /*****************************
4724 receiving of block data
4725 *****************************/
4726
4727 if (F_Rcv_Num[IDR]!=0){
4728
4729 size2 = Rcv_Size[IDR];
4730
4731 /* allocation of array */
4732 tmp_array2 = (double*)malloc(sizeof(double)*size2);
4733
4734 MPI_Recv(&tmp_array2[0], size2, MPI_DOUBLE, IDR, tag, mpi_comm_level1, &stat);
4735
4736 num = 0;
4737 Mc_AN = F_TopMAN[IDR] - 1;
4738 for (n=0; n<F_Rcv_Num[IDR]; n++){
4739 Mc_AN++;
4740 Gc_AN = Rcv_GAN[IDR][n];
4741 Cwan = WhatSpecies[Gc_AN];
4742 tno1 = Spe_Total_NO[Cwan];
4743 for (i=0; i<tno1; i++){
4744 for (j=0; j<tno1; j++){
4745 NC_v_eff[0][0][Mc_AN][i][j].r = tmp_array2[num]; num++;
4746 NC_v_eff[0][0][Mc_AN][i][j].i = tmp_array2[num]; num++;
4747 NC_v_eff[1][1][Mc_AN][i][j].r = tmp_array2[num]; num++;
4748 NC_v_eff[1][1][Mc_AN][i][j].i = tmp_array2[num]; num++;
4749 NC_v_eff[0][1][Mc_AN][i][j].r = tmp_array2[num]; num++;
4750 NC_v_eff[0][1][Mc_AN][i][j].i = tmp_array2[num]; num++;
4751 NC_v_eff[1][0][Mc_AN][i][j].r = tmp_array2[num]; num++;
4752 NC_v_eff[1][0][Mc_AN][i][j].i = tmp_array2[num]; num++;
4753 }
4754 }
4755 }
4756
4757 /* freeing of array */
4758 free(tmp_array2);
4759 }
4760
4761 if (F_Snd_Num[IDS]!=0){
4762 MPI_Wait(&request,&stat);
4763 free(tmp_array); /* freeing of array */
4764 }
4765 }
4766 }
4767
4768 /* freeing of Snd_Size and Rcv_Size */
4769
4770 free(Snd_Size);
4771 free(Rcv_Size);
4772 }
4773
4774
4775
4776
4777
Output_Collinear_OcpN()4778 void Output_Collinear_OcpN()
4779 {
4780 int Gc_AN,l,m,mul,spin,wan1,i,j,k,base;
4781 int tno0,Mc_AN,num,l1,mul1,m1,to1,Ns;
4782 int numprocs,myid,ID,tag=999;
4783 double *tmp_vec;
4784 double sum,ele_max;
4785 FILE *fp_DM_onsite;
4786 char *Name_Angular[20][10];
4787 char *Name_Multiple[20];
4788 char file_DM_onsite[YOUSO10];
4789 double **a,*ko;
4790 char buf[fp_bsize]; /* setvbuf */
4791
4792 MPI_Status stat;
4793 MPI_Request request;
4794
4795 /* MPI */
4796 MPI_Comm_size(mpi_comm_level1,&numprocs);
4797 MPI_Comm_rank(mpi_comm_level1,&myid);
4798
4799 Ns = List_YOUSO[7] + 2;
4800 a = (double**)malloc(sizeof(double*)*Ns);
4801 for (i=0; i<Ns; i++){
4802 a[i] = (double*)malloc(sizeof(double)*Ns);
4803 }
4804
4805 ko = (double*)malloc(sizeof(double)*Ns);
4806
4807 tmp_vec = (double*)malloc(sizeof(double)*Ns*Ns*(SpinP_switch+1));
4808
4809 if ( myid==Host_ID ){
4810
4811 sprintf(file_DM_onsite,"%s%s.DM_onsite",filepath,filename);
4812
4813 if ((fp_DM_onsite = fopen(file_DM_onsite,"w")) != NULL){
4814
4815 #ifdef xt3
4816 setvbuf(fp_DM_onsite,buf,_IOFBF,fp_bsize); /* setvbuf */
4817 #endif
4818
4819 fprintf(fp_DM_onsite,"\n\n\n\n");
4820 fprintf(fp_DM_onsite,"***********************************************************\n");
4821 fprintf(fp_DM_onsite,"***********************************************************\n");
4822 fprintf(fp_DM_onsite," Occupation Number in LDA+U and Constraint DFT \n");
4823 fprintf(fp_DM_onsite," \n");
4824 fprintf(fp_DM_onsite," Eigenvalues and eigenvectors for a matrix consisting \n");
4825 fprintf(fp_DM_onsite," of occupation numbers on each site \n");
4826 fprintf(fp_DM_onsite,"***********************************************************\n");
4827 fprintf(fp_DM_onsite,"***********************************************************\n\n");
4828
4829 /* decomposed Mulliken charge */
4830 Name_Angular[0][0] = "s ";
4831 Name_Angular[1][0] = "px ";
4832 Name_Angular[1][1] = "py ";
4833 Name_Angular[1][2] = "pz ";
4834 Name_Angular[2][0] = "d3z^2-r^2 ";
4835 Name_Angular[2][1] = "dx^2-y^2 ";
4836 Name_Angular[2][2] = "dxy ";
4837 Name_Angular[2][3] = "dxz ";
4838 Name_Angular[2][4] = "dyz ";
4839 Name_Angular[3][0] = "f5z^2-3r^2 ";
4840 Name_Angular[3][1] = "f5xz^2-xr^2";
4841 Name_Angular[3][2] = "f5yz^2-yr^2";
4842 Name_Angular[3][3] = "fzx^2-zy^2 ";
4843 Name_Angular[3][4] = "fxyz ";
4844 Name_Angular[3][5] = "fx^3-3*xy^2";
4845 Name_Angular[3][6] = "f3yx^2-y^3 ";
4846 Name_Angular[4][0] = "g1 ";
4847 Name_Angular[4][1] = "g2 ";
4848 Name_Angular[4][2] = "g3 ";
4849 Name_Angular[4][3] = "g4 ";
4850 Name_Angular[4][4] = "g5 ";
4851 Name_Angular[4][5] = "g6 ";
4852 Name_Angular[4][6] = "g7 ";
4853 Name_Angular[4][7] = "g8 ";
4854 Name_Angular[4][8] = "g9 ";
4855
4856 Name_Multiple[0] = " 0";
4857 Name_Multiple[1] = " 1";
4858 Name_Multiple[2] = " 2";
4859 Name_Multiple[3] = " 3";
4860 Name_Multiple[4] = " 4";
4861 Name_Multiple[5] = " 5";
4862
4863 }
4864 }
4865
4866 for (Gc_AN=1; Gc_AN<=atomnum; Gc_AN++){
4867 wan1 = WhatSpecies[Gc_AN];
4868 ID = G2ID[Gc_AN];
4869 Mc_AN = F_G2M[Gc_AN];
4870
4871 if (myid==ID){
4872
4873 num = 0;
4874 for (spin=0; spin<=SpinP_switch; spin++){
4875 for (i=0; i<Spe_Total_NO[wan1]; i++){
4876 for (j=0; j<Spe_Total_NO[wan1]; j++){
4877 tmp_vec[num] = DM_onsite[0][spin][Mc_AN][i][j];
4878 num++;
4879 }
4880 }
4881 }
4882
4883 if (myid!=Host_ID){
4884 MPI_Isend(&num, 1, MPI_INT, Host_ID, tag, mpi_comm_level1, &request);
4885 MPI_Wait(&request,&stat);
4886 MPI_Isend(&tmp_vec[0], num, MPI_DOUBLE, Host_ID, tag, mpi_comm_level1, &request);
4887 MPI_Wait(&request,&stat);
4888 }
4889 }
4890
4891 else if (myid==Host_ID){
4892 MPI_Recv(&num, 1, MPI_INT, ID, tag, mpi_comm_level1, &stat);
4893 MPI_Recv(&tmp_vec[0], num, MPI_DOUBLE, ID, tag, mpi_comm_level1, &stat);
4894 }
4895
4896
4897 if ( myid==Host_ID ){
4898
4899 fprintf(fp_DM_onsite,"\n %4d %4s\n",Gc_AN,SpeName[wan1]);
4900
4901 num = 0;
4902 for (spin=0; spin<=SpinP_switch; spin++){
4903
4904 fprintf(fp_DM_onsite,"\n spin=%2d\n\n",spin);
4905
4906 ele_max = 0.0;
4907
4908 for (i=0; i<Spe_Total_NO[wan1]; i++){
4909 for (j=0; j<Spe_Total_NO[wan1]; j++){
4910 a[i+1][j+1] = tmp_vec[num];
4911 num++;
4912 if (ele_max<fabs(a[i+1][j+1])) ele_max = fabs(a[i+1][j+1]);
4913 }
4914 }
4915
4916 if (1.0e-13<ele_max){
4917 for (i=0; i<Spe_Total_NO[wan1]; i++){
4918 for (j=0; j<Spe_Total_NO[wan1]; j++){
4919 a[i+1][j+1] = a[i+1][j+1]/ele_max;
4920 }
4921 }
4922 }
4923
4924 Eigen_lapack(a, ko, Spe_Total_NO[wan1], Spe_Total_NO[wan1]);
4925
4926 if (1.0e-13<ele_max){
4927 for (i=0; i<Spe_Total_NO[wan1]; i++){
4928 ko[i+1] = ko[i+1]*ele_max;
4929 }
4930 }
4931
4932 sum = 0.0;
4933 for (i=0; i<Spe_Total_NO[wan1]; i++){
4934 sum += ko[i+1];
4935 }
4936 fprintf(fp_DM_onsite," Sum = %15.12f\n",sum);
4937
4938 base = 8;
4939
4940 for (k=0; k<((Spe_Total_NO[wan1]-1)/base+1); k++){
4941
4942 fprintf(fp_DM_onsite,"\n");
4943 fprintf(fp_DM_onsite," ");
4944 for (i=k*base; i<(k*base+base); i++){
4945 if (i<Spe_Total_NO[wan1]){
4946 fprintf(fp_DM_onsite," %3d ",i+1);
4947 }
4948 }
4949 fprintf(fp_DM_onsite,"\n");
4950
4951 fprintf(fp_DM_onsite," Individual ");
4952
4953 for (i=k*base; i<(k*base+base); i++){
4954 if (i<Spe_Total_NO[wan1]){
4955 fprintf(fp_DM_onsite,"%7.4f ",ko[i+1]);
4956 }
4957 }
4958
4959 fprintf(fp_DM_onsite,"\n\n");
4960
4961 i = 0;
4962 for (l=0; l<=Supported_MaxL; l++){
4963 for (mul=0; mul<Spe_Num_Basis[wan1][l]; mul++){
4964 for (m=0; m<(2*l+1); m++){
4965 fprintf(fp_DM_onsite," %s%s ",Name_Angular[l][m],Name_Multiple[mul]);
4966
4967 for (j=k*base; j<(k*base+base); j++){
4968 if (j<Spe_Total_NO[wan1]){
4969 fprintf(fp_DM_onsite,"%7.4f ",a[i+1][j+1]);
4970 }
4971 }
4972
4973 fprintf(fp_DM_onsite,"\n");
4974 i++;
4975 }
4976 }
4977 }
4978 }
4979
4980
4981 }
4982 }
4983 }
4984
4985 if ( myid==Host_ID ){
4986 fclose(fp_DM_onsite);
4987 }
4988
4989 /* freeing of arrays */
4990
4991 for (i=0; i<Ns; i++){
4992 free(a[i]);
4993 }
4994 free(a);
4995
4996 free(ko);
4997 free(tmp_vec);
4998
4999 }
5000
5001
5002
5003
Output_NonCollinear_OcpN()5004 void Output_NonCollinear_OcpN()
5005 {
5006 int Gc_AN,l,m,mul,spin,wan1,i,j,k;
5007 int tno0,Mc_AN,num,l1,mul1,m1,to1,Ns;
5008 int i1,j1,num0,num1;
5009 int numprocs,myid,ID,tag=999;
5010 double *tmp_vec;
5011 double sum;
5012 FILE *fp_DM_onsite;
5013 char *Name_Angular[Supported_MaxL+1][2*(Supported_MaxL+1)+1];
5014 char *Name_Multiple[20];
5015 char file_DM_onsite[YOUSO10];
5016 dcomplex **a;
5017 double *ko;
5018 char buf[fp_bsize]; /* setvbuf */
5019
5020 MPI_Status stat;
5021 MPI_Request request;
5022
5023 /* MPI */
5024 MPI_Comm_size(mpi_comm_level1,&numprocs);
5025 MPI_Comm_rank(mpi_comm_level1,&myid);
5026
5027 /* allocation of arrays */
5028
5029 Ns = 2*List_YOUSO[7] + 2;
5030 a = (dcomplex**)malloc(sizeof(dcomplex*)*Ns);
5031 for (i=0; i<Ns; i++){
5032 a[i] = (dcomplex*)malloc(sizeof(dcomplex)*Ns);
5033 }
5034
5035 ko = (double*)malloc(sizeof(double)*Ns);
5036
5037 tmp_vec = (double*)malloc(sizeof(double)*Ns*Ns*8);
5038
5039 if ( myid==Host_ID ){
5040
5041 sprintf(file_DM_onsite,"%s%s.DM_onsite",filepath,filename);
5042
5043 if ((fp_DM_onsite = fopen(file_DM_onsite,"w")) != NULL){
5044
5045 #ifdef xt3
5046 setvbuf(fp_DM_onsite,buf,_IOFBF,fp_bsize); /* setvbuf */
5047 #endif
5048
5049 fprintf(fp_DM_onsite,"\n\n\n\n");
5050 fprintf(fp_DM_onsite,"***********************************************************\n");
5051 fprintf(fp_DM_onsite,"***********************************************************\n");
5052 fprintf(fp_DM_onsite," Occupation Number in LDA+U and Constraint DFT \n");
5053 fprintf(fp_DM_onsite," \n");
5054 fprintf(fp_DM_onsite," Eigenvalues and eigenvectors for a matrix consisting \n");
5055 fprintf(fp_DM_onsite," of occupation numbers on each site \n");
5056 fprintf(fp_DM_onsite,"***********************************************************\n");
5057 fprintf(fp_DM_onsite,"***********************************************************\n\n");
5058
5059 Name_Angular[0][0] = "s ";
5060 Name_Angular[1][0] = "px ";
5061 Name_Angular[1][1] = "py ";
5062 Name_Angular[1][2] = "pz ";
5063 Name_Angular[2][0] = "d3z^2-r^2 ";
5064 Name_Angular[2][1] = "dx^2-y^2 ";
5065 Name_Angular[2][2] = "dxy ";
5066 Name_Angular[2][3] = "dxz ";
5067 Name_Angular[2][4] = "dyz ";
5068 Name_Angular[3][0] = "f5z^2-3r^2 ";
5069 Name_Angular[3][1] = "f5xz^2-xr^2";
5070 Name_Angular[3][2] = "f5yz^2-yr^2";
5071 Name_Angular[3][3] = "fzx^2-zy^2 ";
5072 Name_Angular[3][4] = "fxyz ";
5073 Name_Angular[3][5] = "fx^3-3*xy^2";
5074 Name_Angular[3][6] = "f3yx^2-y^3 ";
5075 Name_Angular[4][0] = "g1 ";
5076 Name_Angular[4][1] = "g2 ";
5077 Name_Angular[4][2] = "g3 ";
5078 Name_Angular[4][3] = "g4 ";
5079 Name_Angular[4][4] = "g5 ";
5080 Name_Angular[4][5] = "g6 ";
5081 Name_Angular[4][6] = "g7 ";
5082 Name_Angular[4][7] = "g8 ";
5083 Name_Angular[4][8] = "g9 ";
5084
5085 Name_Multiple[0] = " 0";
5086 Name_Multiple[1] = " 1";
5087 Name_Multiple[2] = " 2";
5088 Name_Multiple[3] = " 3";
5089 Name_Multiple[4] = " 4";
5090 Name_Multiple[5] = " 5";
5091 }
5092 }
5093
5094 for (Gc_AN=1; Gc_AN<=atomnum; Gc_AN++){
5095 wan1 = WhatSpecies[Gc_AN];
5096 ID = G2ID[Gc_AN];
5097 Mc_AN = F_G2M[Gc_AN];
5098
5099 if (myid==ID){
5100
5101 num = 0;
5102 for (i=0; i<Spe_Total_NO[wan1]; i++){
5103 for (j=0; j<Spe_Total_NO[wan1]; j++){
5104 tmp_vec[num] = NC_OcpN[0][0][0][Mc_AN][i][j].r; num++;
5105 tmp_vec[num] = NC_OcpN[0][0][0][Mc_AN][i][j].i; num++;
5106 tmp_vec[num] = NC_OcpN[0][1][1][Mc_AN][i][j].r; num++;
5107 tmp_vec[num] = NC_OcpN[0][1][1][Mc_AN][i][j].i; num++;
5108 tmp_vec[num] = NC_OcpN[0][0][1][Mc_AN][i][j].r; num++;
5109 tmp_vec[num] = NC_OcpN[0][0][1][Mc_AN][i][j].i; num++;
5110 tmp_vec[num] = NC_OcpN[0][1][0][Mc_AN][i][j].r; num++;
5111 tmp_vec[num] = NC_OcpN[0][1][0][Mc_AN][i][j].i; num++;
5112 }
5113 }
5114
5115 if (myid!=Host_ID){
5116 MPI_Isend(&num, 1, MPI_INT, Host_ID, tag, mpi_comm_level1, &request);
5117 MPI_Wait(&request,&stat);
5118 MPI_Isend(&tmp_vec[0], num, MPI_DOUBLE, Host_ID, tag, mpi_comm_level1, &request);
5119 MPI_Wait(&request,&stat);
5120 }
5121 }
5122
5123 else if (myid==Host_ID){
5124 MPI_Recv(&num, 1, MPI_INT, ID, tag, mpi_comm_level1, &stat);
5125 MPI_Recv(&tmp_vec[0], num, MPI_DOUBLE, ID, tag, mpi_comm_level1, &stat);
5126 }
5127
5128 if ( myid==Host_ID ){
5129
5130 fprintf(fp_DM_onsite,"\n%4d %4s\n",Gc_AN,SpeName[wan1]);
5131
5132 k = Spe_Total_NO[wan1];
5133 num = 0;
5134
5135 for (i=0; i<Spe_Total_NO[wan1]; i++){
5136 for (j=0; j<Spe_Total_NO[wan1]; j++){
5137 /* rnd(1.0e-14) is a prescription to stabilize the lapack routines */
5138 a[i +1][j +1].r = tmp_vec[num] + rnd(1.0e-14); num++;
5139 a[i +1][j +1].i = tmp_vec[num] + rnd(1.0e-14); num++;
5140 a[i+k+1][j+k+1].r = tmp_vec[num] + rnd(1.0e-14); num++;
5141 a[i+k+1][j+k+1].i = tmp_vec[num] + rnd(1.0e-14); num++;
5142 a[i +1][j+k+1].r = tmp_vec[num] + rnd(1.0e-14); num++;
5143 a[i +1][j+k+1].i = tmp_vec[num] + rnd(1.0e-14); num++;
5144 a[i+k+1][j +1].r = tmp_vec[num] + rnd(1.0e-14); num++;
5145 a[i+k+1][j +1].i = tmp_vec[num] + rnd(1.0e-14); num++;
5146 }
5147 }
5148
5149 EigenBand_lapack(a, ko, 2*k, 2*k, 1);
5150
5151 sum = 0.0;
5152 for (i=0; i<2*k; i++){
5153 sum += ko[i+1];
5154 }
5155 fprintf(fp_DM_onsite," Sum of occupancy numbers = %15.12f\n",sum);
5156
5157 num0 = 2;
5158 num1 = 2*k/num0 + 1*((2*k)%num0!=0);
5159
5160 for (i=1; i<=num1; i++){
5161 fprintf(fp_DM_onsite,"\n");
5162
5163 for (i1=-2; i1<=0; i1++){
5164
5165 fprintf(fp_DM_onsite," ");
5166
5167 for (j=1; j<=num0; j++){
5168 j1 = num0*(i-1) + j;
5169
5170 if (j1<=2*k){
5171 if (i1==-2){
5172 fprintf(fp_DM_onsite," %4d",j1);
5173 fprintf(fp_DM_onsite," ");
5174 }
5175 else if (i1==-1){
5176 fprintf(fp_DM_onsite," %8.5f",ko[j1]);
5177 fprintf(fp_DM_onsite," ");
5178 }
5179
5180 else if (i1==0){
5181 fprintf(fp_DM_onsite," Re(U)");
5182 fprintf(fp_DM_onsite," Im(U)");
5183 fprintf(fp_DM_onsite," Re(D)");
5184 fprintf(fp_DM_onsite," Im(D)");
5185 }
5186
5187 }
5188 }
5189 fprintf(fp_DM_onsite,"\n");
5190 if (i1==-1) fprintf(fp_DM_onsite,"\n");
5191 if (i1==0) fprintf(fp_DM_onsite,"\n");
5192 }
5193
5194 for (l=0; l<=Supported_MaxL; l++){
5195 for (mul=0; mul<Spe_Num_Basis[wan1][l]; mul++){
5196 for (m=0; m<(2*l+1); m++){
5197
5198 if (l==0 && mul==0 && m==0)
5199 fprintf(fp_DM_onsite,"%4d %3s %s %s",
5200 Gc_AN,SpeName[wan1],Name_Multiple[mul],Name_Angular[l][m]);
5201 else
5202 fprintf(fp_DM_onsite," %s %s",
5203 Name_Multiple[mul],Name_Angular[l][m]);
5204
5205 for (j=1; j<=num0; j++){
5206
5207 j1 = num0*(i-1) + j;
5208
5209 if (0<i1 && j1<=2*k){
5210 fprintf(fp_DM_onsite," %8.5f",a[i1][j1].r);
5211 fprintf(fp_DM_onsite," %8.5f",a[i1][j1].i);
5212 fprintf(fp_DM_onsite," %8.5f",a[i1+k][j1].r);
5213 fprintf(fp_DM_onsite," %8.5f",a[i1+k][j1].i);
5214 }
5215 }
5216
5217 fprintf(fp_DM_onsite,"\n");
5218 if (i1==-1) fprintf(fp_DM_onsite,"\n");
5219 if (i1==0) fprintf(fp_DM_onsite,"\n");
5220
5221 i1++;
5222
5223 }
5224 }
5225 }
5226 }
5227
5228 }
5229 }
5230
5231 if ( myid==Host_ID ){
5232 fclose(fp_DM_onsite);
5233 }
5234
5235 /* freeing of arrays */
5236
5237 for (i=0; i<Ns; i++){
5238 free(a[i]);
5239 }
5240 free(a);
5241
5242 free(ko);
5243 free(tmp_vec);
5244
5245 }
5246
5247
5248
5249
5250
5251
Calc_dTN(int constraint_flag,dcomplex TN[2][2],dcomplex dTN[2][2][2][2],dcomplex U[2][2],double theta[2],double phi[2])5252 void Calc_dTN( int constraint_flag,
5253 dcomplex TN[2][2],
5254 dcomplex dTN[2][2][2][2],
5255 dcomplex U[2][2],
5256 double theta[2], double phi[2] )
5257 {
5258 double dphi0,dtheta0;
5259 dcomplex tmp1,tmp2,tmp3;
5260 dcomplex Nup,Ndn;
5261 dcomplex I0,I1;
5262
5263 #ifdef c_complex
5264 double complex d11,d12,d21,d22;
5265 double complex dphi11,dphi12,dphi21,dphi22;
5266 double complex ctmp1,ctmp2,ctmp3;
5267 double complex cphi,ctheta;
5268 double complex cot,sit,cop,sip;
5269 double complex dtheta11,dtheta12,dtheta21,dtheta22;
5270 double complex dNup11,dNup12,dNup21,dNup22;
5271 double complex dNdn11,dNdn12,dNdn21,dNdn22;
5272 #else
5273 dcomplex d11,d12,d21,d22;
5274 dcomplex dphi11,dphi12,dphi21,dphi22;
5275 dcomplex ctmp1,ctmp2,ctmp3;
5276 dcomplex cphi,ctheta;
5277 dcomplex cot,sit,cop,sip;
5278 dcomplex dtheta11,dtheta12,dtheta21,dtheta22;
5279 dcomplex dNup11,dNup12,dNup21,dNup22;
5280 dcomplex dNdn11,dNdn12,dNdn21,dNdn22;
5281 #endif
5282
5283 dcomplex ctmp4,ctmp5,ctmp6,ctmp7;
5284 dcomplex coe0;
5285 dcomplex ct1,ct2,ct3,ct4,ct5,ct6,ct7,ct8;
5286
5287 I0 = Complex(0.0, 1.0);
5288 I1 = Complex(0.0,-1.0);
5289
5290
5291 #ifdef c_complex
5292 d11 = TN[0][0].r + TN[0][0].i*I;
5293 d12 = TN[0][1].r + TN[0][1].i*I;
5294 d21 = TN[1][0].r + TN[1][0].i*I;
5295 d22 = TN[1][1].r + TN[1][1].i*I;
5296 cphi = phi[0] + phi[1]*I;
5297 ctheta = theta[0] + theta[1]*I;
5298 cot = ccos(ctheta);
5299 sit = csin(ctheta);
5300 cop = ccos(cphi);
5301 sip = csin(cphi);
5302 #else
5303 d11 = TN[0][0];
5304 d12 = TN[0][1];
5305 d21 = TN[1][0];
5306 d22 = TN[1][1];
5307 cphi = Complex(phi[0], phi[1]);
5308 ctheta = Complex(theta[0], theta[1]);
5309 cot = Ccos(ctheta);
5310 sit = Csin(ctheta);
5311 cop = Ccos(cphi);
5312 sip = Csin(cphi);
5313 #endif
5314
5315 /* calculate dphi */
5316
5317 #ifdef c_complex
5318
5319 dphi12 = 0.5*d21/(d12*d21)*I;
5320 dphi21 =-0.5*d12/(d12*d21)*I;
5321
5322 #else
5323
5324 dphi11 = Complex(0.0, 0.0);
5325 dphi22 = Complex(0.0, 0.0);
5326
5327 ctmp1 = Complex(0.0, 0.5);
5328 ctmp2 = Complex(0.0,-0.5);
5329 ctmp3 = Cmul(d12,d21);
5330
5331 ct1 = Cdiv(d21,ctmp3);
5332 ct2 = Cdiv(d12,ctmp3);
5333 dphi12 = Cmul( ctmp1, ct1 );
5334 dphi21 = Cmul( ctmp2, ct2 );
5335
5336 #endif
5337
5338 /*
5339 dphi12 = Cmul( ctmp1, Cdiv(d21,ctmp3) );
5340 dphi21 = Cmul( ctmp2, Cdiv(d12,ctmp3) );
5341 */
5342
5343 /* calculate dtheta */
5344
5345 #ifdef c_complex
5346
5347 ctmp1 = (d11 - d22)*(d11 - d22);
5348 ctmp2 = d12*cexp(I*cphi) + d21*cexp(-I*cphi);
5349 ctmp3 = ctmp1/(ctmp1 + ctmp2*ctmp2);
5350
5351 dtheta11 =-ctmp3*ctmp2/ctmp1;
5352 dtheta22 = ctmp3*ctmp2/ctmp1;
5353 dtheta12 = ctmp3*(cexp( I*cphi) + I*d12*dphi12*cexp(I*cphi) - I*d21*dphi12*cexp(-I*cphi))/(d11 - d22);
5354 dtheta21 = ctmp3*(cexp(-I*cphi) + I*d12*dphi21*cexp(I*cphi) - I*d21*dphi21*cexp(-I*cphi))/(d11 - d22);
5355
5356 #else
5357
5358 ct1 = Csub(d11, d22);
5359 ct2 = Csub(d11, d22);
5360 ctmp1 = Cmul( ct1, ct2 );
5361
5362 ct1 = Cmul(I0,cphi);
5363 ct2 = Cexp(ct1);
5364 ct3 = Cmul(d12, ct2);
5365 ct4 = Cmul(I1,cphi);
5366 ct5 = Cexp(ct4);
5367 ct6 = Cmul(d21, ct5);
5368 ctmp2 = Cadd( ct3, ct6 );
5369
5370 ct1 = Cmul(ctmp2,ctmp2);
5371 ct2 = Cadd(ctmp1, ct1);
5372 ctmp3 = Cdiv( ctmp1, ct2 );
5373
5374 ct1 = Cmul(ctmp3,ctmp2);
5375 ct2 = Cdiv( ct1, ctmp1);
5376 dtheta11 = RCmul(-1.0, ct1 );
5377
5378 ct1 = Cmul(ctmp3,ctmp2);
5379 dtheta22 = Cdiv( ct1, ctmp1);
5380
5381 ct1 = Cmul(I0,cphi);
5382 ctmp4 = Cexp(ct1);
5383
5384 ct1 = Cmul(I0,d12);
5385 ct2 = Cmul(ct1,dphi12);
5386 ct3 = Cmul(I0,cphi);
5387 ct4 = Cexp(ct3);
5388 ctmp5 = Cmul( ct2, ct3 );
5389
5390 ct1 = Cmul(I0,d21);
5391 ct2 = Cmul(ct1,dphi12);
5392 ct3 = Cmul(I1,cphi);
5393 ct4 = Cexp(ct3);
5394 ctmp6 = Cmul( ct2, ct4 );
5395
5396 ct1 = Csub(d11,d22);
5397 ctmp7 = Cdiv(ctmp3, ct1);
5398
5399 ct1 = Cadd(ctmp4,ctmp5);
5400 ct2 = Csub(ct1,ctmp6);
5401 dtheta12 = Cmul(ctmp7, ct2);
5402
5403 ct1 = Cmul(I1,cphi);
5404 ctmp4 = Cexp(ct1);
5405
5406 ct1 = Cmul(I0,d12);
5407 ct2 = Cmul(ct1,dphi21);
5408 ct3 = Cmul(I0,cphi);
5409 ct4 = Cexp(ct3);
5410 ctmp5 = Cmul( ct2, ct4 );
5411
5412 ct1 = Cmul(I0,d21);
5413 ct2 = Cmul(ct1,dphi21);
5414 ct3 = Cmul(I1,cphi);
5415 ct4 = Cexp(ct3);
5416 ctmp6 = Cmul( ct2, ct4 );
5417
5418 ct1 = Csub(d11,d22);
5419 ctmp7 = Cdiv(ctmp3, ct1);
5420
5421 ct1 = Cadd(ctmp4,ctmp5);
5422 ct2 = Csub(ct1,ctmp6);
5423 dtheta21 = Cmul(ctmp7, ct2);
5424
5425 #endif
5426
5427 /*
5428 ctmp1 = Cmul( Csub(d11, d22), Csub(d11, d22) );
5429 ctmp2 = Cadd( Cmul(d12, Cexp(Cmul(I0,cphi))), Cmul(d21, Cexp(Cmul(I1,cphi))) );
5430 ctmp3 = Cdiv( ctmp1, Cadd(ctmp1, Cmul(ctmp2,ctmp2)) );
5431
5432 dtheta11 = RCmul(-1.0, Cdiv( Cmul(ctmp3,ctmp2), ctmp1));
5433 dtheta22 = Cdiv( Cmul(ctmp3,ctmp2), ctmp1);
5434
5435 ctmp4 = Cexp(Cmul(I0,cphi));
5436 ctmp5 = Cmul(Cmul(Cmul(I0,d12),dphi12),Cexp(Cmul(I0,cphi)));
5437 ctmp6 = Cmul(Cmul(Cmul(I0,d21),dphi12),Cexp(Cmul(I1,cphi)));
5438 ctmp7 = Cdiv(ctmp3, Csub(d11,d22));
5439 dtheta12 = Cmul(ctmp7, Csub(Cadd(ctmp4,ctmp5),ctmp6));
5440
5441 ctmp4 = Cexp(Cmul(I1,cphi));
5442 ctmp5 = Cmul(Cmul(Cmul(I0,d12),dphi21),Cexp(Cmul(I0,cphi)));
5443 ctmp6 = Cmul(Cmul(Cmul(I0,d21),dphi21),Cexp(Cmul(I1,cphi)));
5444 ctmp7 = Cdiv(ctmp3, Csub(d11,d22));
5445 dtheta21 = Cmul(ctmp7, Csub(Cadd(ctmp4,ctmp5),ctmp6));
5446 */
5447
5448 /* calculate dNup */
5449
5450 #ifdef c_complex
5451
5452 dNup11 = 0.5*( (1.0+0.0*I) + cot - (d11-d22)*sit*dtheta11
5453 + (d12*cexp(I*cphi)+d21*cexp(-I*cphi))*cot*dtheta11 );
5454
5455 dNup22 = 0.5*( (1.0+0.0*I) - cot - (d11-d22)*sit*dtheta22
5456 + (d12*cexp(I*cphi)+d21*cexp(-I*cphi))*cot*dtheta22 );
5457
5458 dNup12 = 0.5*( cexp(I*cphi)*sit
5459 - (d11-d22)*sit*dtheta12
5460 + I*(d12*cexp(I*cphi) - d21*cexp(-I*cphi))*dphi12*sit
5461 + (d12*cexp(I*cphi) + d21*cexp(-I*cphi))*dtheta12*cot
5462 );
5463
5464 dNup21 = 0.5*( cexp(-I*cphi)*sit
5465 - (d11-d22)*sit*dtheta21
5466 + I*(d12*cexp(I*cphi) - d21*cexp(-I*cphi))*dphi21*sit
5467 + (d12*cexp(I*cphi) + d21*cexp(-I*cphi))*dtheta21*cot
5468 );
5469
5470 #else
5471
5472 ct1 = Complex(1.0, 0.0);
5473 ctmp1 = Cadd(ct1, cot);
5474
5475 ct1 = Csub(d11,d22);
5476 ct2 = Cmul(ct1, sit);
5477 ctmp2 = Cmul( ct2, dtheta11);
5478
5479 ct1 = Cmul(I0,cphi);
5480 ct2 = Cexp(ct1);
5481 ct3 = Cmul(d12,ct2);
5482 ct4 = Cmul(I1,cphi);
5483 ct5 = Cexp(ct4);
5484 ct6 = Cmul(d21,ct5);
5485 ctmp3 = Cadd(ct3, ct6);
5486
5487 ct1 = Cmul(ctmp3,cot);
5488 ctmp4 = Cmul(ct1,dtheta11);
5489
5490 ct1 = Csub(ctmp1, ctmp2);
5491 ct2 = Cadd(ct1,ctmp4);
5492 dNup11 = RCmul(0.5,ct2);
5493
5494 ct1 = Complex(1.0, 0.0);
5495 ctmp1 = Csub(ct1, cot);
5496
5497 ct1 = Csub(d11,d22);
5498 ct2 = Cmul(ct1, sit);
5499 ctmp2 = Cmul(ct2, dtheta22);
5500
5501 ct1 = Cmul(I0,cphi);
5502 ct2 = Cexp(ct1);
5503 ct3 = Cmul(d12,ct2);
5504 ct4 = Cmul(I1,cphi);
5505 ct5 = Cexp(ct4);
5506 ct6 = Cmul(d21,ct5);
5507 ctmp3 = Cadd(ct3,ct6);
5508
5509 ct1 = Cmul(ctmp3,cot);
5510 ctmp4 = Cmul(ct1,dtheta22);
5511
5512 ct1 = Csub(ctmp1, ctmp2);
5513 ct2 = Cadd(ct1,ctmp4);
5514 dNup22 = RCmul(0.5,ct2);
5515
5516 ct1 = Cmul(I0,cphi);
5517 ct2 = Cexp(ct1);
5518 ctmp1 = Cmul(ct2,sit);
5519
5520 ct1 = Csub(d11,d22);
5521 ct2 = Cmul(ct1, sit);
5522 ctmp2 = Cmul(ct2, dtheta12);
5523
5524 ct1 = Cmul(I0,cphi);
5525 ct2 = Cexp(ct1);
5526 ct3 = Cmul(d12,ct2);
5527 ct4 = Cmul(I1,cphi);
5528 ct5 = Cexp(ct4);
5529 ct6 = Cmul(d21,ct5);
5530 ct7 = Csub(ct3,ct6);
5531 ctmp3 = Cmul(I0, ct7);
5532
5533 ct1 = Cmul(ctmp3,sit);
5534 ctmp4 = Cmul(ct1,dphi12);
5535
5536 ct1 = Cmul(I0,cphi);
5537 ct2 = Cexp(ct1);
5538 ct3 = Cmul(d12,ct2);
5539 ct4 = Cmul(I1,cphi);
5540 ct5 = Cexp(ct4);
5541 ct6 = Cmul(d21,ct5);
5542 ctmp5 = Cadd(ct3,ct6);
5543
5544 ct1 = Cmul(ctmp5,cot);
5545 ctmp6 = Cmul(ct1,dtheta12);
5546
5547 ct1 = Csub(ctmp1,ctmp2);
5548 ct2 = Cadd(ct1,ctmp4);
5549 ct3 = Cadd(ct2,ctmp6);
5550 dNup12 = RCmul(0.5,ct3);
5551
5552 ct1 = Cmul(I1,cphi);
5553 ct2 = Cexp(ct1);
5554 ctmp1 = Cmul(ct2,sit);
5555
5556 ct1 = Csub(d11,d22);
5557 ct2 = Cmul(ct1, sit);
5558 ctmp2 = Cmul(ct2, dtheta21);
5559
5560 ct1 = Cmul(I0,cphi);
5561 ct2 = Cexp(ct1);
5562 ct3 = Cmul(d12,ct2);
5563 ct4 = Cmul(I1,cphi);
5564 ct5 = Cexp(ct4);
5565 ct6 = Cmul(d21,ct5);
5566 ct7 = Csub(ct3,ct6);
5567 ctmp3 = Cmul(I0,ct7);
5568
5569 ct1 = Cmul(ctmp3,sit);
5570 ctmp4 = Cmul(ct1,dphi21);
5571
5572 ct1 = Cmul(I0,cphi);
5573 ct2 = Cexp(ct1);
5574 ct3 = Cmul(d21,ct2);
5575 ct4 = Cmul(I0,cphi);
5576 ct5 = Cexp(ct4);
5577 ct6 = Cmul(d12,ct5);
5578 ctmp5 = Cadd( ct5, ct6);
5579
5580 ct1 = Cmul(ctmp5,cot);
5581 ctmp6 = Cmul(ct1,dtheta21);
5582
5583 ct1 = Csub(ctmp1,ctmp2);
5584 ct2 = Cadd(ct1,ctmp4);
5585 ct3 = Cadd(ct2,ctmp6);
5586 dNup21 = RCmul(0.5,ct3);
5587
5588 #endif
5589
5590
5591 /*
5592 ctmp1 = Cadd(Complex(1.0, 0.0), cot);
5593 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta11);
5594 ctmp3 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
5595 ctmp4 = Cmul(Cmul(ctmp3,cot),dtheta11);
5596 dNup11 = RCmul(0.5,Cadd(Csub(ctmp1, ctmp2),ctmp4));
5597
5598 ctmp1 = Csub(Complex(1.0, 0.0), cot);
5599 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta22);
5600 ctmp3 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
5601 ctmp4 = Cmul(Cmul(ctmp3,cot),dtheta22);
5602 dNup22 = RCmul(0.5,Cadd(Csub(ctmp1, ctmp2),ctmp4));
5603
5604 ctmp1 = Cmul(Cexp(Cmul(I0,cphi)),sit);
5605 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta12);
5606 ctmp3 = Cmul(I0,Csub(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi)))));
5607 ctmp4 = Cmul(Cmul(ctmp3,sit),dphi12);
5608 ctmp5 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
5609 ctmp6 = Cmul(Cmul(ctmp5,cot),dtheta12);
5610 dNup12 = RCmul(0.5,Cadd(Cadd(Csub(ctmp1,ctmp2),ctmp4),ctmp6));
5611
5612 ctmp1 = Cmul(Cexp(Cmul(I1,cphi)),sit);
5613 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta21);
5614 ctmp3 = Cmul(I0,Csub(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi)))));
5615 ctmp4 = Cmul(Cmul(ctmp3,sit),dphi21);
5616 ctmp5 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
5617 ctmp6 = Cmul(Cmul(ctmp5,cot),dtheta21);
5618 dNup21 = RCmul(0.5,Cadd(Cadd(Csub(ctmp1,ctmp2),ctmp4),ctmp6));
5619 */
5620
5621
5622
5623 /* calculate dNdn */
5624
5625 #ifdef c_complex
5626
5627 dNdn11 = 0.5*( (1.0+0.0*I) - cot + (d11-d22)*sit*dtheta11
5628 - (d12*cexp(I*cphi)+d21*cexp(-I*cphi))*cot*dtheta11 );
5629
5630 dNdn22 = 0.5*( (1.0+0.0*I) + cot + (d11-d22)*sit*dtheta22
5631 - (d12*cexp(I*cphi)+d21*cexp(-I*cphi))*cot*dtheta22 );
5632
5633 dNdn12 = 0.5*(-cexp(I*cphi)*sit
5634 + (d11-d22)*sit*dtheta12
5635 - I*(d12*cexp(I*cphi) - d21*cexp(-I*cphi))*dphi12*sit
5636 - (d12*cexp(I*cphi) + d21*cexp(-I*cphi))*dtheta12*cot
5637 );
5638
5639 dNdn21 = 0.5*(-cexp(-I*cphi)*sit
5640 + (d11-d22)*sit*dtheta21
5641 - I*(d12*cexp(I*cphi) - d21*cexp(-I*cphi))*dphi21*sit
5642 - (d12*cexp(I*cphi) + d21*cexp(-I*cphi))*dtheta21*cot
5643 );
5644
5645 #else
5646
5647 ct1 = Complex(1.0, 0.0);
5648 ctmp1 = Csub(ct1, cot);
5649
5650 ct1 = Csub(d11,d22);
5651 ct2 = Cmul(ct1,sit);
5652 ctmp2 = Cmul(ct2, dtheta11);
5653
5654 ct1 = Cmul(I0,cphi);
5655 ct2 = Cexp(ct1);
5656 ct3 = Cmul(d12,ct2);
5657 ct4 = Cmul(I1,cphi);
5658 ct5 = Cexp(ct4);
5659 ct6 = Cmul(d21,ct5);
5660 ctmp3 = Cadd(ct3,ct6);
5661
5662 ct1 = Cmul(ctmp3,cot);
5663 ctmp4 = Cmul(ct1,dtheta11);
5664
5665 ct1 = Cadd(ctmp1, ctmp2);
5666 ct2 = Csub(ct1,ctmp4);
5667 dNdn11 = RCmul(0.5,ct2);
5668
5669 ct1 = Complex(1.0, 0.0);
5670 ctmp1 = Cadd(ct1, cot);
5671
5672 ct1 = Csub(d11,d22);
5673 ct2 = Cmul(ct1, sit);
5674 ctmp2 = Cmul(ct2, dtheta22);
5675
5676 ct1 = Cmul(I0,cphi);
5677 ct2 = Cexp(ct1);
5678 ct3 = Cmul(d12,ct2);
5679 ct4 = Cmul(I1,cphi);
5680 ct5 = Cexp(ct4);
5681 ct6 = Cmul(d21,ct5);
5682 ctmp3 = Cadd(ct3,ct6);
5683
5684 ct1 = Cmul(ctmp3,cot);
5685 ctmp4 = Cmul(ct1,dtheta22);
5686
5687 ct1 = Cadd(ctmp1, ctmp2);
5688 ct2 = Csub(ct1,ctmp4);
5689 dNdn22 = RCmul(0.5,ct2);
5690
5691 ct1 = Cmul(I0,cphi);
5692 ct2 = Cexp(ct1);
5693 ctmp1 = Cmul(ct2,sit);
5694
5695 ct1 = Csub(d11,d22);
5696 ct2 = Cmul(ct1, sit);
5697 ctmp2 = Cmul(ct2, dtheta12);
5698
5699 ct1 = Cmul(I0,cphi);
5700 ct2 = Cexp(ct1);
5701 ct3 = Cmul(d12,ct2);
5702 ct4 = Cmul(I1,cphi);
5703 ct5 = Cexp(ct4);
5704 ct6 = Cmul(d21,ct5);
5705 ct7 = Csub(ct3,ct6);
5706 ctmp3 = Cmul(I0,ct7);
5707
5708 ct1 = Cmul(ctmp3,sit);
5709 ctmp4 = Cmul(ct1,dphi12);
5710
5711 ct1 = Cmul(I0,cphi);
5712 ct2 = Cexp(ct1);
5713 ct3 = Cmul(d12,ct2);
5714 ct4 = Cmul(I1,cphi);
5715 ct5 = Cexp(ct4);
5716 ct6 = Cmul(d21,ct5);
5717 ctmp5 = Cadd(ct3,ct6);
5718
5719 ct1 = Cmul(ctmp5,cot);
5720 ctmp6 = Cmul(ct1,dtheta12);
5721
5722 ct1 = Csub(ctmp2,ctmp1);
5723 ct2 = Csub(ct1,ctmp4);
5724 ct3 = Csub(ct2,ctmp6);
5725 dNdn12 = RCmul(0.5,ct3);
5726
5727 ct1 = Cmul(I1,cphi);
5728 ct2 = Cexp(ct1);
5729 ctmp1 = Cmul(ct2,sit);
5730
5731 ct1 = Csub(d11,d22);
5732 ct2 = Cmul(ct1,sit);
5733 ctmp2 = Cmul(ct2, dtheta21);
5734
5735 ct1 = Cmul(I0,cphi);
5736 ct2 = Cexp(ct1);
5737 ct3 = Cmul(d12,ct2);
5738 ct4 = Cmul(I1,cphi);
5739 ct5 = Cexp(ct4);
5740 ct6 = Cmul(d21,ct5);
5741 ct7 = Csub(ct3,ct6);
5742 ctmp3 = Cmul(I0,ct7);
5743
5744 ct1 = Cmul(ctmp3,sit);
5745 ctmp4 = Cmul(ct1,dphi21);
5746
5747 ct1 = Cmul(I0,cphi);
5748 ct2 = Cexp(ct1);
5749 ct3 = Cmul(d12,ct2);
5750 ct4 = Cmul(I1,cphi);
5751 ct5 = Cexp(ct4);
5752 ct6 = Cmul(d21,ct5);
5753 ctmp5 = Cadd(ct3,ct6);
5754
5755 ct1 = Cmul(ctmp5,cot);
5756 ctmp6 = Cmul(ct1,dtheta21);
5757
5758 ct1 = Csub(ctmp2,ctmp1);
5759 ct2 = Csub(ct1,ctmp4);
5760 ct3 = Csub(ct2,ctmp6);
5761 dNdn21 = RCmul(0.5,ct3);
5762
5763 #endif
5764
5765
5766
5767 /*
5768 ctmp1 = Csub(Complex(1.0, 0.0), cot);
5769 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta11);
5770 ctmp3 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
5771 ctmp4 = Cmul(Cmul(ctmp3,cot),dtheta11);
5772 dNdn11 = RCmul(0.5,Csub(Cadd(ctmp1, ctmp2),ctmp4));
5773
5774 ctmp1 = Cadd(Complex(1.0, 0.0), cot);
5775 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta22);
5776 ctmp3 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
5777 ctmp4 = Cmul(Cmul(ctmp3,cot),dtheta22);
5778 dNdn22 = RCmul(0.5,Csub(Cadd(ctmp1, ctmp2),ctmp4));
5779
5780 ctmp1 = Cmul(Cexp(Cmul(I0,cphi)),sit);
5781 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta12);
5782 ctmp3 = Cmul(I0,Csub(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi)))));
5783 ctmp4 = Cmul(Cmul(ctmp3,sit),dphi12);
5784 ctmp5 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
5785 ctmp6 = Cmul(Cmul(ctmp5,cot),dtheta12);
5786 dNdn12 = RCmul(0.5,Csub(Csub(Csub(ctmp2,ctmp1),ctmp4),ctmp6));
5787
5788 ctmp1 = Cmul(Cexp(Cmul(I1,cphi)),sit);
5789 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta21);
5790 ctmp3 = Cmul(I0,Csub(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi)))));
5791 ctmp4 = Cmul(Cmul(ctmp3,sit),dphi21);
5792 ctmp5 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
5793 ctmp6 = Cmul(Cmul(ctmp5,cot),dtheta21);
5794 dNdn21 = RCmul(0.5,Csub(Csub(Csub(ctmp2,ctmp1),ctmp4),ctmp6));
5795 */
5796
5797 /*
5798 printf("dNdn11.r=%15.12f dNdn11.i=%15.12f\n",creal(dNdn11),cimag(dNdn11));
5799 printf("dNdn22.r=%15.12f dNdn22.i=%15.12f\n",creal(dNdn22),cimag(dNdn22));
5800 printf("dNdn12.r=%15.12f dNdn12.i=%15.12f\n",creal(dNdn12),cimag(dNdn12));
5801 printf("dNdn21.r=%15.12f dNdn21.i=%15.12f\n",creal(dNdn21),cimag(dNdn21));
5802 */
5803
5804 /* calculate dTN11 */
5805
5806 #ifdef c_complex
5807
5808 if (constraint_flag==1){
5809 Nup.r = creal(dNup11);
5810 Nup.i = cimag(dNup11);
5811 Ndn.r = creal(dNdn11);
5812 Ndn.i = cimag(dNdn11);
5813 }
5814 else if (constraint_flag==2){
5815 Nup.r = creal(0.5*(dNup11 + dNdn11));
5816 Nup.i = cimag(0.5*(dNup11 + dNdn11));
5817 Ndn.r = creal(0.5*(dNup11 + dNdn11));
5818 Ndn.i = cimag(0.5*(dNup11 + dNdn11));
5819 }
5820
5821 #else
5822
5823 if (constraint_flag==1){
5824 Nup = dNup11;
5825 Ndn = dNdn11;
5826 }
5827 else if (constraint_flag==2){
5828 Nup.r = 0.5*(dNup11.r + dNdn11.r);
5829 Nup.i = 0.5*(dNup11.i + dNdn11.i);
5830 Ndn.r = 0.5*(dNup11.r + dNdn11.r);
5831 Ndn.i = 0.5*(dNup11.i + dNdn11.i);
5832 }
5833
5834 #endif
5835
5836 dTN[0][0][0][0].r = Nup.r*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
5837 + Ndn.r*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
5838
5839 dTN[0][0][0][0].i = 0.0;
5840
5841 dTN[0][0][0][1].r = Nup.r*( U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i )
5842 + Ndn.r*( U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i );
5843
5844 dTN[0][0][0][1].i = Nup.r*(-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i )
5845 + Ndn.r*(-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i );
5846
5847 dTN[0][0][1][0].r = Nup.r*( U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i )
5848 + Ndn.r*( U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i );
5849
5850 dTN[0][0][1][0].i = Nup.r*(-U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i )
5851 + Ndn.r*(-U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i );
5852
5853 dTN[0][0][1][1].r = Nup.r*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
5854 + Ndn.r*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
5855
5856 dTN[0][0][1][1].i = 0.0;
5857
5858 /* calculate dTN22 */
5859
5860 #ifdef c_complex
5861
5862 if (constraint_flag==1){
5863 Nup.r = creal(dNup22);
5864 Nup.i = cimag(dNup22);
5865 Ndn.r = creal(dNdn22);
5866 Ndn.i = cimag(dNdn22);
5867 }
5868 else if (constraint_flag==2){
5869 Nup.r = creal(0.5*(dNup22 + dNdn22));
5870 Nup.i = cimag(0.5*(dNup22 + dNdn22));
5871 Ndn.r = creal(0.5*(dNup22 + dNdn22));
5872 Ndn.i = cimag(0.5*(dNup22 + dNdn22));
5873 }
5874
5875 #else
5876
5877 if (constraint_flag==1){
5878 Nup = dNup22;
5879 Ndn = dNdn22;
5880 }
5881 else if (constraint_flag==2){
5882 Nup.r = 0.5*(dNup22.r + dNdn22.r);
5883 Nup.i = 0.5*(dNup22.i + dNdn22.i);
5884 Ndn.r = 0.5*(dNup22.r + dNdn22.r);
5885 Ndn.i = 0.5*(dNup22.i + dNdn22.i);
5886 }
5887
5888 #endif
5889
5890
5891 dTN[1][1][0][0].r = Nup.r*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
5892 + Ndn.r*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
5893
5894 dTN[1][1][0][0].i = 0.0;
5895
5896 dTN[1][1][0][1].r = Nup.r*( U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i )
5897 + Ndn.r*( U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i );
5898
5899 dTN[1][1][0][1].i = Nup.r*(-U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i )
5900 + Ndn.r*(-U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i );
5901
5902 dTN[1][1][1][0].r = Nup.r*( U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i )
5903 + Ndn.r*( U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i );
5904
5905 dTN[1][1][1][0].i = Nup.r*(-U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i )
5906 + Ndn.r*(-U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i );
5907
5908 dTN[1][1][1][1].r = Nup.r*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
5909 + Ndn.r*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
5910
5911 dTN[1][1][1][1].i = 0.0;
5912
5913 /* calculate dTN12 */
5914
5915 #ifdef c_complex
5916
5917 if (constraint_flag==1){
5918 Nup.r = creal(dNup12);
5919 Nup.i = cimag(dNup12);
5920 Ndn.r = creal(dNdn12);
5921 Ndn.i = cimag(dNdn12);
5922 }
5923 else if (constraint_flag==2){
5924 Nup.r = creal(0.5*(dNup12 + dNdn12));
5925 Nup.i = cimag(0.5*(dNup12 + dNdn12));
5926 Ndn.r = creal(0.5*(dNup12 + dNdn12));
5927 Ndn.i = cimag(0.5*(dNup12 + dNdn12));
5928 }
5929
5930 #else
5931
5932 if (constraint_flag==1){
5933 Nup = dNup12;
5934 Ndn = dNdn12;
5935 }
5936 else if (constraint_flag==2){
5937 Nup.r = 0.5*(dNup12.r + dNdn12.r);
5938 Nup.i = 0.5*(dNup12.i + dNdn12.i);
5939 Ndn.r = 0.5*(dNup12.r + dNdn12.r);
5940 Ndn.i = 0.5*(dNup12.i + dNdn12.i);
5941 }
5942
5943 #endif
5944
5945 dTN[0][1][0][0].r = Nup.r*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
5946 + Ndn.r*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
5947
5948 dTN[0][1][0][0].i = Nup.i*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
5949 + Ndn.i*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
5950
5951 tmp1.r = U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i;
5952 tmp1.i = -U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i;
5953 tmp2.r = U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i;
5954 tmp2.i = -U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i;
5955
5956 dTN[0][1][0][1].r = Nup.r*tmp1.r - Nup.i*tmp1.i
5957 + Ndn.r*tmp2.r - Ndn.i*tmp2.i;
5958
5959 dTN[0][1][0][1].i = Nup.r*tmp1.i + Nup.i*tmp1.r
5960 + Ndn.r*tmp2.i + Ndn.i*tmp2.r;
5961
5962 tmp1.r = U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i;
5963 tmp1.i = -U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i;
5964 tmp2.r = U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i;
5965 tmp2.i = -U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i;
5966
5967 dTN[0][1][1][0].r = Nup.r*tmp1.r - Nup.i*tmp1.i
5968 + Ndn.r*tmp2.r - Ndn.i*tmp2.i;
5969
5970 dTN[0][1][1][0].i = Nup.r*tmp1.i + Nup.i*tmp1.r
5971 + Ndn.r*tmp2.i + Ndn.i*tmp2.r;
5972
5973 dTN[0][1][1][1].r = Nup.r*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
5974 + Ndn.r*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
5975
5976 dTN[0][1][1][1].i = Nup.i*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
5977 + Ndn.i*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
5978
5979 /* calculate dTN21 */
5980
5981 #ifdef c_complex
5982
5983 if (constraint_flag==1){
5984 Nup.r = creal(dNup21);
5985 Nup.i = cimag(dNup21);
5986 Ndn.r = creal(dNdn21);
5987 Ndn.i = cimag(dNdn21);
5988 }
5989 else if (constraint_flag==2){
5990 Nup.r = creal(0.5*(dNup21 + dNdn21));
5991 Nup.i = cimag(0.5*(dNup21 + dNdn21));
5992 Ndn.r = creal(0.5*(dNup21 + dNdn21));
5993 Ndn.i = cimag(0.5*(dNup21 + dNdn21));
5994 }
5995
5996 #else
5997 if (constraint_flag==1){
5998 Nup = dNup21;
5999 Ndn = dNdn21;
6000 }
6001 else if (constraint_flag==2){
6002 Nup.r = 0.5*(dNup21.r + dNdn21.r);
6003 Nup.i = 0.5*(dNup21.i + dNdn21.i);
6004 Ndn.r = 0.5*(dNup21.r + dNdn21.r);
6005 Ndn.i = 0.5*(dNup21.i + dNdn21.i);
6006 }
6007
6008 #endif
6009
6010 dTN[1][0][0][0].r = Nup.r*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
6011 + Ndn.r*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
6012
6013 dTN[1][0][0][0].i = Nup.i*( U[0][0].r*U[0][0].r + U[0][0].i*U[0][0].i )
6014 + Ndn.i*( U[1][0].r*U[1][0].r + U[1][0].i*U[1][0].i );
6015
6016 tmp1.r = U[0][0].r*U[0][1].r + U[0][0].i*U[0][1].i;
6017 tmp1.i = -U[0][0].i*U[0][1].r + U[0][0].r*U[0][1].i;
6018 tmp2.r = U[1][0].r*U[1][1].r + U[1][0].i*U[1][1].i;
6019 tmp2.i = -U[1][0].i*U[1][1].r + U[1][0].r*U[1][1].i;
6020
6021 dTN[1][0][0][1].r = Nup.r*tmp1.r - Nup.i*tmp1.i
6022 + Ndn.r*tmp2.r - Ndn.i*tmp2.i;
6023
6024 dTN[1][0][0][1].i = Nup.r*tmp1.i + Nup.i*tmp1.r
6025 + Ndn.r*tmp2.i + Ndn.i*tmp2.r;
6026
6027 tmp1.r = U[0][1].r*U[0][0].r + U[0][1].i*U[0][0].i;
6028 tmp1.i = -U[0][1].i*U[0][0].r + U[0][1].r*U[0][0].i;
6029 tmp2.r = U[1][1].r*U[1][0].r + U[1][1].i*U[1][0].i;
6030 tmp2.i = -U[1][1].i*U[1][0].r + U[1][1].r*U[1][0].i;
6031
6032 dTN[1][0][1][0].r = Nup.r*tmp1.r - Nup.i*tmp1.i
6033 + Ndn.r*tmp2.r - Ndn.i*tmp2.i;
6034
6035 dTN[1][0][1][0].i = Nup.r*tmp1.i + Nup.i*tmp1.r
6036 + Ndn.r*tmp2.i + Ndn.i*tmp2.r;
6037
6038 dTN[1][0][1][1].r = Nup.r*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
6039 + Ndn.r*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
6040
6041 dTN[1][0][1][1].i = Nup.i*( U[0][1].r*U[0][1].r + U[0][1].i*U[0][1].i )
6042 + Ndn.i*( U[1][1].r*U[1][1].r + U[1][1].i*U[1][1].i );
6043 }
6044
6045
6046
6047
6048
6049
6050
6051
Calc_dSxyz(dcomplex TN[2][2],dcomplex dSx[2][2],dcomplex dSy[2][2],dcomplex dSz[2][2],double Nup[2],double Ndn[2],double theta[2],double phi[2])6052 void Calc_dSxyz( dcomplex TN[2][2],
6053 dcomplex dSx[2][2],
6054 dcomplex dSy[2][2],
6055 dcomplex dSz[2][2],
6056 double Nup[2], double Ndn[2],
6057 double theta[2], double phi[2] )
6058 {
6059 double dphi0,dtheta0;
6060 dcomplex tmp1,tmp2,tmp3;
6061 dcomplex I0,I1;
6062
6063 #ifdef c_complex
6064 double complex d11,d12,d21,d22;
6065 double complex dphi11,dphi12,dphi21,dphi22;
6066 double complex ctmp1,ctmp2,ctmp3;
6067 double complex cphi,ctheta;
6068 double complex cot,sit,cop,sip;
6069 double complex dtheta11,dtheta12,dtheta21,dtheta22;
6070 double complex dNup11,dNup12,dNup21,dNup22;
6071 double complex dNdn11,dNdn12,dNdn21,dNdn22;
6072 double complex dS_dNup,dS_dNdn,dS_dt,dS_dp;
6073 #else
6074 dcomplex d11,d12,d21,d22;
6075 dcomplex dphi11,dphi12,dphi21,dphi22;
6076 dcomplex ctmp1,ctmp2,ctmp3;
6077 dcomplex cphi,ctheta;
6078 dcomplex cot,sit,cop,sip;
6079 dcomplex dtheta11,dtheta12,dtheta21,dtheta22;
6080 dcomplex dNup11,dNup12,dNup21,dNup22;
6081 dcomplex dNdn11,dNdn12,dNdn21,dNdn22;
6082 dcomplex dS_dNup,dS_dNdn,dS_dt,dS_dp;
6083 #endif
6084
6085 dcomplex ctmp4,ctmp5,ctmp6,ctmp7;
6086 dcomplex coe0;
6087 dcomplex ct1,ct2,ct3,ct4,ct5,ct6,ct7,ct8;
6088
6089 I0 = Complex(0.0, 1.0);
6090 I1 = Complex(0.0,-1.0);
6091
6092 #ifdef c_complex
6093 d11 = TN[0][0].r + TN[0][0].i*I;
6094 d12 = TN[0][1].r + TN[0][1].i*I;
6095 d21 = TN[1][0].r + TN[1][0].i*I;
6096 d22 = TN[1][1].r + TN[1][1].i*I;
6097 cphi = phi[0] + phi[1]*I;
6098 ctheta = theta[0] + theta[1]*I;
6099 cot = ccos(ctheta);
6100 sit = csin(ctheta);
6101 cop = ccos(cphi);
6102 sip = csin(cphi);
6103 #else
6104 d11 = TN[0][0];
6105 d12 = TN[0][1];
6106 d21 = TN[1][0];
6107 d22 = TN[1][1];
6108 cphi = Complex(phi[0], phi[1]);
6109 ctheta = Complex(theta[0], theta[1]);
6110 cot = Ccos(ctheta);
6111 sit = Csin(ctheta);
6112 cop = Ccos(cphi);
6113 sip = Csin(cphi);
6114 #endif
6115
6116
6117
6118
6119 /* calculate dphi */
6120
6121 #ifdef c_complex
6122
6123 dphi12 = 0.5*d21/(d12*d21)*I;
6124 dphi21 =-0.5*d12/(d12*d21)*I;
6125
6126 #else
6127
6128 dphi11 = Complex(0.0, 0.0);
6129 dphi22 = Complex(0.0, 0.0);
6130
6131 ctmp1 = Complex(0.0, 0.5);
6132 ctmp2 = Complex(0.0,-0.5);
6133 ctmp3 = Cmul(d12,d21);
6134
6135 ct1 = Cdiv(d21,ctmp3);
6136 ct2 = Cdiv(d12,ctmp3);
6137 dphi12 = Cmul( ctmp1, ct1 );
6138 dphi21 = Cmul( ctmp2, ct2 );
6139
6140 #endif
6141
6142 /*
6143 dphi12 = Cmul( ctmp1, Cdiv(d21,ctmp3) );
6144 dphi21 = Cmul( ctmp2, Cdiv(d12,ctmp3) );
6145 */
6146
6147
6148
6149 /* calculate dtheta */
6150
6151 #ifdef c_complex
6152
6153 ctmp1 = (d11 - d22)*(d11 - d22);
6154 ctmp2 = d12*cexp(I*cphi) + d21*cexp(-I*cphi);
6155 ctmp3 = ctmp1/(ctmp1 + ctmp2*ctmp2);
6156
6157 dtheta11 =-ctmp3*ctmp2/ctmp1;
6158 dtheta22 = ctmp3*ctmp2/ctmp1;
6159 dtheta12 = ctmp3*(cexp( I*cphi) + I*d12*dphi12*cexp(I*cphi) - I*d21*dphi12*cexp(-I*cphi))/(d11 - d22);
6160 dtheta21 = ctmp3*(cexp(-I*cphi) + I*d12*dphi21*cexp(I*cphi) - I*d21*dphi21*cexp(-I*cphi))/(d11 - d22);
6161
6162 #else
6163
6164 ct1 = Csub(d11, d22);
6165 ct2 = Csub(d11, d22);
6166 ctmp1 = Cmul( ct1, ct2 );
6167
6168 ct1 = Cmul(I0,cphi);
6169 ct2 = Cexp(ct1);
6170 ct3 = Cmul(d12, ct2);
6171 ct4 = Cmul(I1,cphi);
6172 ct5 = Cexp(ct4);
6173 ct6 = Cmul(d21, ct5);
6174 ctmp2 = Cadd( ct3, ct6 );
6175
6176 ct1 = Cmul(ctmp2,ctmp2);
6177 ct2 = Cadd(ctmp1, ct1);
6178 ctmp3 = Cdiv( ctmp1, ct2 );
6179
6180 ct1 = Cmul(ctmp3,ctmp2);
6181 ct2 = Cdiv( ct1, ctmp1);
6182 dtheta11 = RCmul(-1.0, ct1 );
6183
6184 ct1 = Cmul(ctmp3,ctmp2);
6185 dtheta22 = Cdiv( ct1, ctmp1);
6186
6187 ct1 = Cmul(I0,cphi);
6188 ctmp4 = Cexp(ct1);
6189
6190 ct1 = Cmul(I0,d12);
6191 ct2 = Cmul(ct1,dphi12);
6192 ct3 = Cmul(I0,cphi);
6193 ct4 = Cexp(ct3);
6194 ctmp5 = Cmul( ct2, ct3 );
6195
6196 ct1 = Cmul(I0,d21);
6197 ct2 = Cmul(ct1,dphi12);
6198 ct3 = Cmul(I1,cphi);
6199 ct4 = Cexp(ct3);
6200 ctmp6 = Cmul( ct2, ct4 );
6201
6202 ct1 = Csub(d11,d22);
6203 ctmp7 = Cdiv(ctmp3, ct1);
6204
6205 ct1 = Cadd(ctmp4,ctmp5);
6206 ct2 = Csub(ct1,ctmp6);
6207 dtheta12 = Cmul(ctmp7, ct2);
6208
6209 ct1 = Cmul(I1,cphi);
6210 ctmp4 = Cexp(ct1);
6211
6212 ct1 = Cmul(I0,d12);
6213 ct2 = Cmul(ct1,dphi21);
6214 ct3 = Cmul(I0,cphi);
6215 ct4 = Cexp(ct3);
6216 ctmp5 = Cmul( ct2, ct4 );
6217
6218 ct1 = Cmul(I0,d21);
6219 ct2 = Cmul(ct1,dphi21);
6220 ct3 = Cmul(I1,cphi);
6221 ct4 = Cexp(ct3);
6222 ctmp6 = Cmul( ct2, ct4 );
6223
6224 ct1 = Csub(d11,d22);
6225 ctmp7 = Cdiv(ctmp3, ct1);
6226
6227 ct1 = Cadd(ctmp4,ctmp5);
6228 ct2 = Csub(ct1,ctmp6);
6229 dtheta21 = Cmul(ctmp7, ct2);
6230
6231 #endif
6232
6233 /*
6234 ctmp1 = Cmul( Csub(d11, d22), Csub(d11, d22) );
6235 ctmp2 = Cadd( Cmul(d12, Cexp(Cmul(I0,cphi))), Cmul(d21, Cexp(Cmul(I1,cphi))) );
6236 ctmp3 = Cdiv( ctmp1, Cadd(ctmp1, Cmul(ctmp2,ctmp2)) );
6237
6238 dtheta11 = RCmul(-1.0, Cdiv( Cmul(ctmp3,ctmp2), ctmp1));
6239 dtheta22 = Cdiv( Cmul(ctmp3,ctmp2), ctmp1);
6240
6241 ctmp4 = Cexp(Cmul(I0,cphi));
6242 ctmp5 = Cmul(Cmul(Cmul(I0,d12),dphi12),Cexp(Cmul(I0,cphi)));
6243 ctmp6 = Cmul(Cmul(Cmul(I0,d21),dphi12),Cexp(Cmul(I1,cphi)));
6244 ctmp7 = Cdiv(ctmp3, Csub(d11,d22));
6245 dtheta12 = Cmul(ctmp7, Csub(Cadd(ctmp4,ctmp5),ctmp6));
6246
6247 ctmp4 = Cexp(Cmul(I1,cphi));
6248 ctmp5 = Cmul(Cmul(Cmul(I0,d12),dphi21),Cexp(Cmul(I0,cphi)));
6249 ctmp6 = Cmul(Cmul(Cmul(I0,d21),dphi21),Cexp(Cmul(I1,cphi)));
6250 ctmp7 = Cdiv(ctmp3, Csub(d11,d22));
6251 dtheta21 = Cmul(ctmp7, Csub(Cadd(ctmp4,ctmp5),ctmp6));
6252 */
6253
6254
6255
6256
6257 /* calculate dNup */
6258
6259 #ifdef c_complex
6260
6261 dNup11 = 0.5*( (1.0+0.0*I) + cot - (d11-d22)*sit*dtheta11
6262 + (d12*cexp(I*cphi)+d21*cexp(-I*cphi))*cot*dtheta11 );
6263
6264 dNup22 = 0.5*( (1.0+0.0*I) - cot - (d11-d22)*sit*dtheta22
6265 + (d12*cexp(I*cphi)+d21*cexp(-I*cphi))*cot*dtheta22 );
6266
6267 dNup12 = 0.5*( cexp(I*cphi)*sit
6268 - (d11-d22)*sit*dtheta12
6269 + I*(d12*cexp(I*cphi) - d21*cexp(-I*cphi))*dphi12*sit
6270 + (d12*cexp(I*cphi) + d21*cexp(-I*cphi))*dtheta12*cot
6271 );
6272
6273 dNup21 = 0.5*( cexp(-I*cphi)*sit
6274 - (d11-d22)*sit*dtheta21
6275 + I*(d12*cexp(I*cphi) - d21*cexp(-I*cphi))*dphi21*sit
6276 + (d12*cexp(I*cphi) + d21*cexp(-I*cphi))*dtheta21*cot
6277 );
6278
6279 #else
6280
6281 ct1 = Complex(1.0, 0.0);
6282 ctmp1 = Cadd(ct1, cot);
6283
6284 ct1 = Csub(d11,d22);
6285 ct2 = Cmul(ct1, sit);
6286 ctmp2 = Cmul( ct2, dtheta11);
6287
6288 ct1 = Cmul(I0,cphi);
6289 ct2 = Cexp(ct1);
6290 ct3 = Cmul(d12,ct2);
6291 ct4 = Cmul(I1,cphi);
6292 ct5 = Cexp(ct4);
6293 ct6 = Cmul(d21,ct5);
6294 ctmp3 = Cadd(ct3, ct6);
6295
6296 ct1 = Cmul(ctmp3,cot);
6297 ctmp4 = Cmul(ct1,dtheta11);
6298
6299 ct1 = Csub(ctmp1, ctmp2);
6300 ct2 = Cadd(ct1,ctmp4);
6301 dNup11 = RCmul(0.5,ct2);
6302
6303 ct1 = Complex(1.0, 0.0);
6304 ctmp1 = Csub(ct1, cot);
6305
6306 ct1 = Csub(d11,d22);
6307 ct2 = Cmul(ct1, sit);
6308 ctmp2 = Cmul(ct2, dtheta22);
6309
6310 ct1 = Cmul(I0,cphi);
6311 ct2 = Cexp(ct1);
6312 ct3 = Cmul(d12,ct2);
6313 ct4 = Cmul(I1,cphi);
6314 ct5 = Cexp(ct4);
6315 ct6 = Cmul(d21,ct5);
6316 ctmp3 = Cadd(ct3,ct6);
6317
6318 ct1 = Cmul(ctmp3,cot);
6319 ctmp4 = Cmul(ct1,dtheta22);
6320
6321 ct1 = Csub(ctmp1, ctmp2);
6322 ct2 = Cadd(ct1,ctmp4);
6323 dNup22 = RCmul(0.5,ct2);
6324
6325 ct1 = Cmul(I0,cphi);
6326 ct2 = Cexp(ct1);
6327 ctmp1 = Cmul(ct2,sit);
6328
6329 ct1 = Csub(d11,d22);
6330 ct2 = Cmul(ct1, sit);
6331 ctmp2 = Cmul(ct2, dtheta12);
6332
6333 ct1 = Cmul(I0,cphi);
6334 ct2 = Cexp(ct1);
6335 ct3 = Cmul(d12,ct2);
6336 ct4 = Cmul(I1,cphi);
6337 ct5 = Cexp(ct4);
6338 ct6 = Cmul(d21,ct5);
6339 ct7 = Csub(ct3,ct6);
6340 ctmp3 = Cmul(I0, ct7);
6341
6342 ct1 = Cmul(ctmp3,sit);
6343 ctmp4 = Cmul(ct1,dphi12);
6344
6345 ct1 = Cmul(I0,cphi);
6346 ct2 = Cexp(ct1);
6347 ct3 = Cmul(d12,ct2);
6348 ct4 = Cmul(I1,cphi);
6349 ct5 = Cexp(ct4);
6350 ct6 = Cmul(d21,ct5);
6351 ctmp5 = Cadd(ct3,ct6);
6352
6353 ct1 = Cmul(ctmp5,cot);
6354 ctmp6 = Cmul(ct1,dtheta12);
6355
6356 ct1 = Csub(ctmp1,ctmp2);
6357 ct2 = Cadd(ct1,ctmp4);
6358 ct3 = Cadd(ct2,ctmp6);
6359 dNup12 = RCmul(0.5,ct3);
6360
6361 ct1 = Cmul(I1,cphi);
6362 ct2 = Cexp(ct1);
6363 ctmp1 = Cmul(ct2,sit);
6364
6365 ct1 = Csub(d11,d22);
6366 ct2 = Cmul(ct1, sit);
6367 ctmp2 = Cmul(ct2, dtheta21);
6368
6369 ct1 = Cmul(I0,cphi);
6370 ct2 = Cexp(ct1);
6371 ct3 = Cmul(d12,ct2);
6372 ct4 = Cmul(I1,cphi);
6373 ct5 = Cexp(ct4);
6374 ct6 = Cmul(d21,ct5);
6375 ct7 = Csub(ct3,ct6);
6376 ctmp3 = Cmul(I0,ct7);
6377
6378 ct1 = Cmul(ctmp3,sit);
6379 ctmp4 = Cmul(ct1,dphi21);
6380
6381 ct1 = Cmul(I0,cphi);
6382 ct2 = Cexp(ct1);
6383 ct3 = Cmul(d21,ct2);
6384 ct4 = Cmul(I0,cphi);
6385 ct5 = Cexp(ct4);
6386 ct6 = Cmul(d12,ct5);
6387 ctmp5 = Cadd( ct5, ct6);
6388
6389 ct1 = Cmul(ctmp5,cot);
6390 ctmp6 = Cmul(ct1,dtheta21);
6391
6392 ct1 = Csub(ctmp1,ctmp2);
6393 ct2 = Cadd(ct1,ctmp4);
6394 ct3 = Cadd(ct2,ctmp6);
6395 dNup21 = RCmul(0.5,ct3);
6396
6397 #endif
6398
6399
6400 /*
6401 ctmp1 = Cadd(Complex(1.0, 0.0), cot);
6402 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta11);
6403 ctmp3 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
6404 ctmp4 = Cmul(Cmul(ctmp3,cot),dtheta11);
6405 dNup11 = RCmul(0.5,Cadd(Csub(ctmp1, ctmp2),ctmp4));
6406
6407 ctmp1 = Csub(Complex(1.0, 0.0), cot);
6408 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta22);
6409 ctmp3 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
6410 ctmp4 = Cmul(Cmul(ctmp3,cot),dtheta22);
6411 dNup22 = RCmul(0.5,Cadd(Csub(ctmp1, ctmp2),ctmp4));
6412
6413 ctmp1 = Cmul(Cexp(Cmul(I0,cphi)),sit);
6414 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta12);
6415 ctmp3 = Cmul(I0,Csub(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi)))));
6416 ctmp4 = Cmul(Cmul(ctmp3,sit),dphi12);
6417 ctmp5 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
6418 ctmp6 = Cmul(Cmul(ctmp5,cot),dtheta12);
6419 dNup12 = RCmul(0.5,Cadd(Cadd(Csub(ctmp1,ctmp2),ctmp4),ctmp6));
6420
6421 ctmp1 = Cmul(Cexp(Cmul(I1,cphi)),sit);
6422 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta21);
6423 ctmp3 = Cmul(I0,Csub(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi)))));
6424 ctmp4 = Cmul(Cmul(ctmp3,sit),dphi21);
6425 ctmp5 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
6426 ctmp6 = Cmul(Cmul(ctmp5,cot),dtheta21);
6427 dNup21 = RCmul(0.5,Cadd(Cadd(Csub(ctmp1,ctmp2),ctmp4),ctmp6));
6428 */
6429
6430
6431
6432
6433 /* calculate dNdn */
6434
6435
6436 #ifdef c_complex
6437
6438 dNdn11 = 0.5*( (1.0+0.0*I) - cot + (d11-d22)*sit*dtheta11
6439 - (d12*cexp(I*cphi)+d21*cexp(-I*cphi))*cot*dtheta11 );
6440
6441 dNdn22 = 0.5*( (1.0+0.0*I) + cot + (d11-d22)*sit*dtheta22
6442 - (d12*cexp(I*cphi)+d21*cexp(-I*cphi))*cot*dtheta22 );
6443
6444 dNdn12 = 0.5*(-cexp(I*cphi)*sit
6445 + (d11-d22)*sit*dtheta12
6446 - I*(d12*cexp(I*cphi) - d21*cexp(-I*cphi))*dphi12*sit
6447 - (d12*cexp(I*cphi) + d21*cexp(-I*cphi))*dtheta12*cot
6448 );
6449
6450 dNdn21 = 0.5*(-cexp(-I*cphi)*sit
6451 + (d11-d22)*sit*dtheta21
6452 - I*(d12*cexp(I*cphi) - d21*cexp(-I*cphi))*dphi21*sit
6453 - (d12*cexp(I*cphi) + d21*cexp(-I*cphi))*dtheta21*cot
6454 );
6455
6456 #else
6457
6458 ct1 = Complex(1.0, 0.0);
6459 ctmp1 = Csub(ct1, cot);
6460
6461 ct1 = Csub(d11,d22);
6462 ct2 = Cmul(ct1,sit);
6463 ctmp2 = Cmul(ct2, dtheta11);
6464
6465 ct1 = Cmul(I0,cphi);
6466 ct2 = Cexp(ct1);
6467 ct3 = Cmul(d12,ct2);
6468 ct4 = Cmul(I1,cphi);
6469 ct5 = Cexp(ct4);
6470 ct6 = Cmul(d21,ct5);
6471 ctmp3 = Cadd(ct3,ct6);
6472
6473 ct1 = Cmul(ctmp3,cot);
6474 ctmp4 = Cmul(ct1,dtheta11);
6475
6476 ct1 = Cadd(ctmp1, ctmp2);
6477 ct2 = Csub(ct1,ctmp4);
6478 dNdn11 = RCmul(0.5,ct2);
6479
6480 ct1 = Complex(1.0, 0.0);
6481 ctmp1 = Cadd(ct1, cot);
6482
6483 ct1 = Csub(d11,d22);
6484 ct2 = Cmul(ct1, sit);
6485 ctmp2 = Cmul(ct2, dtheta22);
6486
6487 ct1 = Cmul(I0,cphi);
6488 ct2 = Cexp(ct1);
6489 ct3 = Cmul(d12,ct2);
6490 ct4 = Cmul(I1,cphi);
6491 ct5 = Cexp(ct4);
6492 ct6 = Cmul(d21,ct5);
6493 ctmp3 = Cadd(ct3,ct6);
6494
6495 ct1 = Cmul(ctmp3,cot);
6496 ctmp4 = Cmul(ct1,dtheta22);
6497
6498 ct1 = Cadd(ctmp1, ctmp2);
6499 ct2 = Csub(ct1,ctmp4);
6500 dNdn22 = RCmul(0.5,ct2);
6501
6502 ct1 = Cmul(I0,cphi);
6503 ct2 = Cexp(ct1);
6504 ctmp1 = Cmul(ct2,sit);
6505
6506 ct1 = Csub(d11,d22);
6507 ct2 = Cmul(ct1, sit);
6508 ctmp2 = Cmul(ct2, dtheta12);
6509
6510 ct1 = Cmul(I0,cphi);
6511 ct2 = Cexp(ct1);
6512 ct3 = Cmul(d12,ct2);
6513 ct4 = Cmul(I1,cphi);
6514 ct5 = Cexp(ct4);
6515 ct6 = Cmul(d21,ct5);
6516 ct7 = Csub(ct3,ct6);
6517 ctmp3 = Cmul(I0,ct7);
6518
6519 ct1 = Cmul(ctmp3,sit);
6520 ctmp4 = Cmul(ct1,dphi12);
6521
6522 ct1 = Cmul(I0,cphi);
6523 ct2 = Cexp(ct1);
6524 ct3 = Cmul(d12,ct2);
6525 ct4 = Cmul(I1,cphi);
6526 ct5 = Cexp(ct4);
6527 ct6 = Cmul(d21,ct5);
6528 ctmp5 = Cadd(ct3,ct6);
6529
6530 ct1 = Cmul(ctmp5,cot);
6531 ctmp6 = Cmul(ct1,dtheta12);
6532
6533 ct1 = Csub(ctmp2,ctmp1);
6534 ct2 = Csub(ct1,ctmp4);
6535 ct3 = Csub(ct2,ctmp6);
6536 dNdn12 = RCmul(0.5,ct3);
6537
6538 ct1 = Cmul(I1,cphi);
6539 ct2 = Cexp(ct1);
6540 ctmp1 = Cmul(ct2,sit);
6541
6542 ct1 = Csub(d11,d22);
6543 ct2 = Cmul(ct1,sit);
6544 ctmp2 = Cmul(ct2, dtheta21);
6545
6546 ct1 = Cmul(I0,cphi);
6547 ct2 = Cexp(ct1);
6548 ct3 = Cmul(d12,ct2);
6549 ct4 = Cmul(I1,cphi);
6550 ct5 = Cexp(ct4);
6551 ct6 = Cmul(d21,ct5);
6552 ct7 = Csub(ct3,ct6);
6553 ctmp3 = Cmul(I0,ct7);
6554
6555 ct1 = Cmul(ctmp3,sit);
6556 ctmp4 = Cmul(ct1,dphi21);
6557
6558 ct1 = Cmul(I0,cphi);
6559 ct2 = Cexp(ct1);
6560 ct3 = Cmul(d12,ct2);
6561 ct4 = Cmul(I1,cphi);
6562 ct5 = Cexp(ct4);
6563 ct6 = Cmul(d21,ct5);
6564 ctmp5 = Cadd(ct3,ct6);
6565
6566 ct1 = Cmul(ctmp5,cot);
6567 ctmp6 = Cmul(ct1,dtheta21);
6568
6569 ct1 = Csub(ctmp2,ctmp1);
6570 ct2 = Csub(ct1,ctmp4);
6571 ct3 = Csub(ct2,ctmp6);
6572 dNdn21 = RCmul(0.5,ct3);
6573
6574 #endif
6575
6576
6577
6578 /*
6579 ctmp1 = Csub(Complex(1.0, 0.0), cot);
6580 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta11);
6581 ctmp3 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
6582 ctmp4 = Cmul(Cmul(ctmp3,cot),dtheta11);
6583 dNdn11 = RCmul(0.5,Csub(Cadd(ctmp1, ctmp2),ctmp4));
6584
6585 ctmp1 = Cadd(Complex(1.0, 0.0), cot);
6586 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta22);
6587 ctmp3 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
6588 ctmp4 = Cmul(Cmul(ctmp3,cot),dtheta22);
6589 dNdn22 = RCmul(0.5,Csub(Cadd(ctmp1, ctmp2),ctmp4));
6590
6591 ctmp1 = Cmul(Cexp(Cmul(I0,cphi)),sit);
6592 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta12);
6593 ctmp3 = Cmul(I0,Csub(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi)))));
6594 ctmp4 = Cmul(Cmul(ctmp3,sit),dphi12);
6595 ctmp5 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
6596 ctmp6 = Cmul(Cmul(ctmp5,cot),dtheta12);
6597 dNdn12 = RCmul(0.5,Csub(Csub(Csub(ctmp2,ctmp1),ctmp4),ctmp6));
6598
6599 ctmp1 = Cmul(Cexp(Cmul(I1,cphi)),sit);
6600 ctmp2 = Cmul(Cmul(Csub(d11,d22), sit), dtheta21);
6601 ctmp3 = Cmul(I0,Csub(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi)))));
6602 ctmp4 = Cmul(Cmul(ctmp3,sit),dphi21);
6603 ctmp5 = Cadd(Cmul(d12,Cexp(Cmul(I0,cphi))),Cmul(d21,Cexp(Cmul(I1,cphi))));
6604 ctmp6 = Cmul(Cmul(ctmp5,cot),dtheta21);
6605 dNdn21 = RCmul(0.5,Csub(Csub(Csub(ctmp2,ctmp1),ctmp4),ctmp6));
6606 */
6607
6608
6609 /*
6610 printf("dNdn11.r=%15.12f dNdn11.i=%15.12f\n",creal(dNdn11),cimag(dNdn11));
6611 printf("dNdn22.r=%15.12f dNdn22.i=%15.12f\n",creal(dNdn22),cimag(dNdn22));
6612 printf("dNdn12.r=%15.12f dNdn12.i=%15.12f\n",creal(dNdn12),cimag(dNdn12));
6613 printf("dNdn21.r=%15.12f dNdn21.i=%15.12f\n",creal(dNdn21),cimag(dNdn21));
6614 */
6615
6616
6617
6618
6619
6620 /*******************************
6621 calculate dSx
6622 *******************************/
6623
6624
6625 #ifdef c_complex
6626
6627 dS_dNup = 0.5*sit*cop;
6628 dS_dNdn =-0.5*sit*cop;
6629
6630 ctmp1 = Nup[0] + Nup[1]*I;
6631 ctmp2 = Ndn[0] + Ndn[1]*I;
6632 dS_dt = 0.5*(ctmp1-ctmp2)*cot*cop;
6633 dS_dp =-0.5*(ctmp1-ctmp2)*sit*sip;
6634
6635 #else
6636
6637 ct1 = Complex(0.5, 0.0);
6638 ct2 = Cmul(ct1, sit);
6639 dS_dNup = Cmul(ct2, cop);
6640
6641 ct1 = Complex(-0.5, 0.0);
6642 ct2 = Cmul(ct1, sit);
6643 dS_dNdn = Cmul(ct2, cop);
6644
6645 ct1 = Complex(0.5, 0.0);
6646 ct2 = Complex(Nup[0], 0.0);
6647 ct3 = Complex(Ndn[0], 0.0);
6648 ct4 = Csub(ct2, ct3);
6649 ct5 = Cmul(ct1, ct4);
6650 ct6 = Cmul(ct5, cot);
6651 ct7 = Cmul(ct6, cop);
6652 dS_dt = ct7;
6653
6654 ct1 = Complex(-0.5, 0.0);
6655 ct2 = Complex(Nup[0], 0.0);
6656 ct3 = Complex(Ndn[0], 0.0);
6657 ct4 = Csub(ct2, ct3);
6658 ct5 = Cmul(ct1, ct4);
6659 ct6 = Cmul(ct5, sit);
6660 ct7 = Cmul(ct6, sip);
6661 dS_dp = ct7;
6662
6663 #endif
6664
6665
6666
6667 #ifdef c_complex
6668
6669 /* dSx11 */
6670
6671 ctmp1 = dS_dNup*dNup11 + dS_dNdn*dNdn11 + dS_dt*dtheta11 + dS_dp*dphi11;
6672 dSx[0][0].r = creal(ctmp1);
6673 dSx[0][0].i = cimag(ctmp1);
6674
6675 /* dSx12 */
6676
6677 ctmp1 = dS_dNup*dNup12 + dS_dNdn*dNdn12 + dS_dt*dtheta12 + dS_dp*dphi12;
6678 dSx[0][1].r = creal(ctmp1);
6679 dSx[0][1].i = cimag(ctmp1);
6680
6681 /* dSx21 */
6682
6683 ctmp1 = dS_dNup*dNup21 + dS_dNdn*dNdn21 + dS_dt*dtheta21 + dS_dp*dphi21;
6684 dSx[1][0].r = creal(ctmp1);
6685 dSx[1][0].i = cimag(ctmp1);
6686
6687 /* dSx22 */
6688
6689 ctmp1 = dS_dNup*dNup22 + dS_dNdn*dNdn22 + dS_dt*dtheta22 + dS_dp*dphi22;
6690 dSx[1][1].r = creal(ctmp1);
6691 dSx[1][1].i = cimag(ctmp1);
6692
6693 #else
6694
6695 /* dSx11 */
6696
6697 ct1 = Cmul(dS_dNup, dNup11);
6698 ct2 = Cmul(dS_dNdn, dNdn11);
6699 ct3 = Cmul(dS_dt, dtheta11);
6700 ct4 = Cmul(dS_dp, dphi11);
6701 ct5 = Cadd(ct1, ct2);
6702 ct6 = Cadd(ct5, ct3);
6703 ct7 = Cadd(ct6, ct4);
6704 dSx[0][0] = ct7;
6705
6706 /* dSx12 */
6707
6708 ct1 = Cmul(dS_dNup, dNup12);
6709 ct2 = Cmul(dS_dNdn, dNdn12);
6710 ct3 = Cmul(dS_dt, dtheta12);
6711 ct4 = Cmul(dS_dp, dphi12);
6712 ct5 = Cadd(ct1, ct2);
6713 ct6 = Cadd(ct5, ct3);
6714 ct7 = Cadd(ct6, ct4);
6715 dSx[0][1] = ct7;
6716
6717 /* dSx21 */
6718
6719 ct1 = Cmul(dS_dNup, dNup21);
6720 ct2 = Cmul(dS_dNdn, dNdn21);
6721 ct3 = Cmul(dS_dt, dtheta21);
6722 ct4 = Cmul(dS_dp, dphi21);
6723 ct5 = Cadd(ct1, ct2);
6724 ct6 = Cadd(ct5, ct3);
6725 ct7 = Cadd(ct6, ct4);
6726 dSx[1][0] = ct7;
6727
6728 /* dSx22 */
6729
6730 ct1 = Cmul(dS_dNup, dNup22);
6731 ct2 = Cmul(dS_dNdn, dNdn22);
6732 ct3 = Cmul(dS_dt, dtheta22);
6733 ct4 = Cmul(dS_dp, dphi22);
6734 ct5 = Cadd(ct1, ct2);
6735 ct6 = Cadd(ct5, ct3);
6736 ct7 = Cadd(ct6, ct4);
6737 dSx[1][1] = ct7;
6738
6739 #endif
6740
6741 /*******************************
6742 calculate dSy
6743 *******************************/
6744
6745 #ifdef c_complex
6746
6747 dS_dNup = 0.5*sit*sip;
6748 dS_dNdn =-0.5*sit*sip;
6749
6750 ctmp1 = Nup[0] + Nup[1]*I;
6751 ctmp2 = Ndn[0] + Ndn[1]*I;
6752 dS_dt = 0.5*(ctmp1-ctmp2)*cot*sip;
6753 dS_dp = 0.5*(ctmp1-ctmp2)*sit*cop;
6754
6755 #else
6756
6757 ct1 = Complex(0.5, 0.0);
6758 ct2 = Cmul(ct1, sit);
6759 dS_dNup = Cmul(ct2, sip);
6760
6761 ct1 = Complex(-0.5, 0.0);
6762 ct2 = Cmul(ct1, sit);
6763 dS_dNdn = Cmul(ct2, sip);
6764
6765 ct1 = Complex(0.5, 0.0);
6766 ct2 = Complex(Nup[0], 0.0);
6767 ct3 = Complex(Ndn[0], 0.0);
6768 ct4 = Csub(ct2, ct3);
6769 ct5 = Cmul(ct1, ct4);
6770 ct6 = Cmul(ct5, cot);
6771 ct7 = Cmul(ct6, sip);
6772 dS_dt = ct7;
6773
6774 ct1 = Complex(0.5, 0.0);
6775 ct2 = Complex(Nup[0], 0.0);
6776 ct3 = Complex(Ndn[0], 0.0);
6777 ct4 = Csub(ct2, ct3);
6778 ct5 = Cmul(ct1, ct4);
6779 ct6 = Cmul(ct5, sit);
6780 ct7 = Cmul(ct6, cop);
6781 dS_dp = ct7;
6782
6783 #endif
6784
6785
6786
6787 #ifdef c_complex
6788
6789 /* dSy11 */
6790
6791 ctmp1 = dS_dNup*dNup11 + dS_dNdn*dNdn11 + dS_dt*dtheta11 + dS_dp*dphi11;
6792 dSy[0][0].r = creal(ctmp1);
6793 dSy[0][0].i = cimag(ctmp1);
6794
6795 /* dSy12 */
6796
6797 ctmp1 = dS_dNup*dNup12 + dS_dNdn*dNdn12 + dS_dt*dtheta12 + dS_dp*dphi12;
6798 dSy[0][1].r = creal(ctmp1);
6799 dSy[0][1].i = cimag(ctmp1);
6800
6801 /* dSy21 */
6802
6803 ctmp1 = dS_dNup*dNup21 + dS_dNdn*dNdn21 + dS_dt*dtheta21 + dS_dp*dphi21;
6804 dSy[1][0].r = creal(ctmp1);
6805 dSy[1][0].i = cimag(ctmp1);
6806
6807 /* dSy22 */
6808
6809 ctmp1 = dS_dNup*dNup22 + dS_dNdn*dNdn22 + dS_dt*dtheta22 + dS_dp*dphi22;
6810 dSy[1][1].r = creal(ctmp1);
6811 dSy[1][1].i = cimag(ctmp1);
6812
6813 #else
6814
6815 /* dSy11 */
6816
6817 ct1 = Cmul(dS_dNup, dNup11);
6818 ct2 = Cmul(dS_dNdn, dNdn11);
6819 ct3 = Cmul(dS_dt, dtheta11);
6820 ct4 = Cmul(dS_dp, dphi11);
6821 ct5 = Cadd(ct1, ct2);
6822 ct6 = Cadd(ct5, ct3);
6823 ct7 = Cadd(ct6, ct4);
6824 dSy[0][0] = ct7;
6825
6826 /* dSy12 */
6827
6828 ct1 = Cmul(dS_dNup, dNup12);
6829 ct2 = Cmul(dS_dNdn, dNdn12);
6830 ct3 = Cmul(dS_dt, dtheta12);
6831 ct4 = Cmul(dS_dp, dphi12);
6832 ct5 = Cadd(ct1, ct2);
6833 ct6 = Cadd(ct5, ct3);
6834 ct7 = Cadd(ct6, ct4);
6835 dSy[0][1] = ct7;
6836
6837 /* dSy21 */
6838
6839 ct1 = Cmul(dS_dNup, dNup21);
6840 ct2 = Cmul(dS_dNdn, dNdn21);
6841 ct3 = Cmul(dS_dt, dtheta21);
6842 ct4 = Cmul(dS_dp, dphi21);
6843 ct5 = Cadd(ct1, ct2);
6844 ct6 = Cadd(ct5, ct3);
6845 ct7 = Cadd(ct6, ct4);
6846 dSy[1][0] = ct7;
6847
6848 /* dSy22 */
6849
6850 ct1 = Cmul(dS_dNup, dNup22);
6851 ct2 = Cmul(dS_dNdn, dNdn22);
6852 ct3 = Cmul(dS_dt, dtheta22);
6853 ct4 = Cmul(dS_dp, dphi22);
6854 ct5 = Cadd(ct1, ct2);
6855 ct6 = Cadd(ct5, ct3);
6856 ct7 = Cadd(ct6, ct4);
6857 dSy[1][1] = ct7;
6858
6859 #endif
6860
6861
6862
6863
6864 /*******************************
6865 calculate dSz
6866 *******************************/
6867
6868 #ifdef c_complex
6869
6870 dS_dNup = 0.5*cot;
6871 dS_dNdn =-0.5*cot;
6872
6873 ctmp1 = Nup[0] + Nup[1]*I;
6874 ctmp2 = Ndn[0] + Ndn[1]*I;
6875 dS_dt =-0.5*(ctmp1-ctmp2)*sit;
6876 dS_dp = 0.0;
6877
6878 #else
6879
6880 ct1 = Complex(0.5, 0.0);
6881 ct2 = Cmul(ct1, cot);
6882 dS_dNup = ct2;
6883
6884 ct1 = Complex(-0.5, 0.0);
6885 ct2 = Cmul(ct1, cot);
6886 dS_dNdn = ct2;
6887
6888 ct1 = Complex(-0.5, 0.0);
6889 ct2 = Complex(Nup[0], 0.0);
6890 ct3 = Complex(Ndn[0], 0.0);
6891 ct4 = Csub(ct2, ct3);
6892 ct5 = Cmul(ct1, ct4);
6893 ct6 = Cmul(ct5, sit);
6894 dS_dt = ct6;
6895
6896 ct1 = Complex(0.0, 0.0);
6897 dS_dp = ct1;
6898
6899 #endif
6900
6901
6902 #ifdef c_complex
6903
6904 /* dSz11 */
6905
6906 ctmp1 = dS_dNup*dNup11 + dS_dNdn*dNdn11 + dS_dt*dtheta11 + dS_dp*dphi11;
6907 dSz[0][0].r = creal(ctmp1);
6908 dSz[0][0].i = cimag(ctmp1);
6909
6910 /* dSz12 */
6911
6912 ctmp1 = dS_dNup*dNup12 + dS_dNdn*dNdn12 + dS_dt*dtheta12 + dS_dp*dphi12;
6913 dSz[0][1].r = creal(ctmp1);
6914 dSz[0][1].i = cimag(ctmp1);
6915
6916 /* dSz21 */
6917
6918 ctmp1 = dS_dNup*dNup21 + dS_dNdn*dNdn21 + dS_dt*dtheta21 + dS_dp*dphi21;
6919 dSz[1][0].r = creal(ctmp1);
6920 dSz[1][0].i = cimag(ctmp1);
6921
6922 /* dSz22 */
6923
6924 ctmp1 = dS_dNup*dNup22 + dS_dNdn*dNdn22 + dS_dt*dtheta22 + dS_dp*dphi22;
6925 dSz[1][1].r = creal(ctmp1);
6926 dSz[1][1].i = cimag(ctmp1);
6927
6928 #else
6929
6930 /* dSz11 */
6931
6932 ct1 = Cmul(dS_dNup, dNup11);
6933 ct2 = Cmul(dS_dNdn, dNdn11);
6934 ct3 = Cmul(dS_dt, dtheta11);
6935 ct4 = Cmul(dS_dp, dphi11);
6936 ct5 = Cadd(ct1, ct2);
6937 ct6 = Cadd(ct5, ct3);
6938 ct7 = Cadd(ct6, ct4);
6939 dSz[0][0] = ct7;
6940
6941 /* dSz12 */
6942
6943 ct1 = Cmul(dS_dNup, dNup12);
6944 ct2 = Cmul(dS_dNdn, dNdn12);
6945 ct3 = Cmul(dS_dt, dtheta12);
6946 ct4 = Cmul(dS_dp, dphi12);
6947 ct5 = Cadd(ct1, ct2);
6948 ct6 = Cadd(ct5, ct3);
6949 ct7 = Cadd(ct6, ct4);
6950 dSz[0][1] = ct7;
6951
6952 /* dSz21 */
6953
6954 ct1 = Cmul(dS_dNup, dNup21);
6955 ct2 = Cmul(dS_dNdn, dNdn21);
6956 ct3 = Cmul(dS_dt, dtheta21);
6957 ct4 = Cmul(dS_dp, dphi21);
6958 ct5 = Cadd(ct1, ct2);
6959 ct6 = Cadd(ct5, ct3);
6960 ct7 = Cadd(ct6, ct4);
6961 dSz[1][0] = ct7;
6962
6963 /* dSz22 */
6964
6965 ct1 = Cmul(dS_dNup, dNup22);
6966 ct2 = Cmul(dS_dNdn, dNdn22);
6967 ct3 = Cmul(dS_dt, dtheta22);
6968 ct4 = Cmul(dS_dp, dphi22);
6969 ct5 = Cadd(ct1, ct2);
6970 ct6 = Cadd(ct5, ct3);
6971 ct7 = Cadd(ct6, ct4);
6972 dSz[1][1] = ct7;
6973
6974 #endif
6975
6976 }
6977