📄 mycompsub_cmplex.f
字号:
c**********************************************************************cc**********************************************************************cc*** compute c(i)=c1(i)+c2(i) where c,c1, and c2 are all complexc*** arrays. subroutine mysomme (c1,c2,c,nvecs) implicit none integer*4 nvecs,i real*8 c1(2*nvecs),c2(2*nvecs),c(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c1(i) + c2(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c(i)+c1(i) where c, and c1 are all complex arrays. subroutine mysommein (c,c1,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c(i) + c1(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c(i)+c1(i)+c2(i) where c,c1, and c2 are all complexc*** arrays. subroutine mysomme2in (c1,c2,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c(i) + c1(i) + c2(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c(i)+c1(i)+c2(i)+c3(i) where c,c1,c2, and c3 are all c*** complex arrays. subroutine mysomme3in (c1,c2,c3,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),c3(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c(i) + c1(i) + c2(i) + c3(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c(i)+c1(i)+c2(i)+c3(i)+c4(i) where c,c1,c2,c3, and c4c*** are all complex arrays. subroutine mysomme4in (c1,c2,c3,c4,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),c3(2*nvecs) real*8 c4(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c(i) + c1(i) + c2(i) + c3(i) + c4(i) 100 continue return endc**********************************************************************cc**** compute c1 = c1 + c2 where c1 and c2 are both complex arrays ****c subroutine mysomme3 (c1,c2,c3,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),c3(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c1(i) + c2(i) + c3(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c1(i)+c2(i)+c3(i)+c4(i) where c,c1,c2,c3, and c4c*** are all complex arrays. subroutine mysomme4 (c1,c2,c3,c4,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),c3(2*nvecs) real*8 c4(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c1(i) + c2(i) + c3(i) + c4(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c1(i)+c2(i)+c3(i)+c4(i)+c5(i) where c,c1,c2,c3,c4 c*** and c5 are all complex arrays. subroutine mysomme5 (c1,c2,c3,c4,c5,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),c3(2*nvecs) real*8 c4(2*nvecs),c5(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c1(i) + c2(i) + c3(i) + c4(i) + c5(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c1(i)-c2(i) where c,c1, and c2 are all complex arrays. subroutine mydiffr (c1,c2,c,nvecs) implicit none integer*4 nvecs,i real*8 c1(2*nvecs),c2(2*nvecs),c(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c1(i) - c2(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c(i)-c1(i) where c and c2 are complex arrays. subroutine mydiffrin (c,c1,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c(i) - c1(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c(i)-c1(i)-c2(i) where c,c1, and c2 are all complex c*** arrays. subroutine mydiffr2in (c,c1,c2,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c(i) - c1(i) - c2(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c1(i)+c2(i)-c3(i) where c,c1,c2 and c3 are all complexc*** arrays. subroutine mysomme2diffr (c1,c2,c,c3,nvecs) implicit none integer*4 nvecs,i real*8 c1(2*nvecs),c2(2*nvecs),c(2*nvecs),c3(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c1(i) + c2(i) - c3(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c1(i)+c2(i)+c3(i)-c4(i) where c,c1,c2,c3 and c4 arec*** all complex arrays. subroutine mysomme3diffr (c1,c2,c3,c,c4,nvecs) implicit none integer*4 nvecs,i real*8 c1(2*nvecs),c2(2*nvecs),c(2*nvecs) real*8 c3(2*nvecs),c4(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c1(i) + c2(i) + c3(i) - c4(i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i)=c3(i)-(c1(i)+c2(i)) where c,c1,c2 and c3 are all c*** complex arrays. subroutine mysommediffr2 (c1,c2,c,c3,nvecs) implicit none integer*4 nvecs,i real*8 c1(2*nvecs),c2(2*nvecs),c(2*nvecs),c3(2*nvecs) do 100 i = 1, 2*nvecs c(i) = c3(i) - c1(i) - c2(i) 100 continue return endc**********************************************************************cc*********** multiply an complex array with a complex constant ********c subroutine mymult (c,z,cr,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),z(2),cr(2*nvecs) do 100 i = 1, nvecs cr(2*i-1) = c(2*i-1)*z(1) - c(2*i)*z(2) cr(2*i) = c(2*i-1)*z(2) + c(2*i)*z(1) 100 continue return endc**********************************************************************cc*********** multiply an complex array with a complex constant ********c subroutine mymultin (c,z,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),z(2),cx,cy do 100 i = 1, nvecs cx = c(2*i-1) cy = c(2*i) c(2*i-1) = cx*z(1) - cy*z(2) c(2*i) = cx*z(2) + cy*z(1) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i) = z*(c1(i)-c2(i)) where c, c1, and c2 are complexc*** arrays and z is a complex constant. subroutine mydiffrmult (c1,c2,c,z,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),z(2),cx,cy do 100 i = 1, nvecs cx = c1(2*i-1)-c2(2*i-1) cy = c1(2*i)-c2(2*i) c(2*i-1) = cx*z(1) - cy*z(2) c(2*i) = cx*z(2) + cy*z(1) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i) = z*(c1(i)+c2(i)) where c, c1, and c2 are complexc*** arrays and z is a complex constant. subroutine mysommemult (c1,c2,c,z,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),z(2),cx,cy do 100 i = 1, nvecs cx = c1(2*i-1)+c2(2*i-1) cy = c1(2*i)+c2(2*i) c(2*i-1) = cx*z(1) - cy*z(2) c(2*i) = cx*z(2) + cy*z(1) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i) = z*c1(i)-c2(i) where c, c1, and c2 are complexc*** arrays and z is a complex constant. subroutine mymultdiffr (c1,z,c2,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),z(2) do 100 i = 1, nvecs c(2*i-1) = c1(2*i-1)*z(1) - c1(2*i)*z(2) - c2(2*i-1) c(2*i) = c1(2*i-1)*z(2) + c1(2*i)*z(1) - c2(2*i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i) = z*c1(i)+c2(i) where c, c1, and c2 are complexc*** arrays and z is a complex constant. subroutine mymultsomme (c1,z,c2,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),z(2) do 100 i = 1, nvecs c(2*i-1) = c1(2*i-1)*z(1) - c1(2*i)*z(2) + c2(2*i-1) c(2*i) = c1(2*i-1)*z(2) + c1(2*i)*z(1) + c2(2*i) 100 continue return endc**********************************************************************cc**********************************************************************cc*** compute c(i) = c(i)+z*c1(i) where c and c1 are complexc*** arrays and z is a complex constant. subroutine mymultsommein (c1,z,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),z(2) do 100 i = 1, nvecs c(2*i-1) = c(2*i-1) + c1(2*i-1)*z(1) - c1(2*i)*z(2) c(2*i) = c(2*i) + c1(2*i-1)*z(2) + c1(2*i)*z(1) 100 continue return endc**********************************************************************cc********* multiply a complex array with another complex array ********c subroutine myprod (c1,c2,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs) do 100 i = 1, nvecs c(2*i-1) = c1(2*i-1)*c2(2*i-1) - c1(2*i)*c2(2*i) c(2*i) = c1(2*i-1)*c2(2*i) + c1(2*i)*c2(2*i-1) 100 continue return endc**********************************************************************cc***** compute c1 = c1*c2 where c1 and c2 are both complex arrays. ****c subroutine myprodin (c,c1,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),cx,cy do 100 i = 1, nvecs cx = c(2*i-1) cy = c(2*i) c(2*i-1) = cx*c1(2*i-1) - cy*c1(2*i) c(2*i) = cx*c1(2*i) + cy*c1(2*i-1) 100 continue return endc**********************************************************************cc********* multiply a complex array with another complex array ********c subroutine myprod3 (c1,c2,c3,c,nvecs) implicit none integer*4 nvecs,i real*8 c(2*nvecs),c1(2*nvecs),c2(2*nvecs),c3(2*nvecs) real*8 cxcom,cycom do 100 i = 1, nvecs cxcom = c1(2*i-1)*c2(2*i-1) - c1(2*i)*c2(2*i) cycom = c1(2*i-1)*c2(2*i) + c1(2*i)*c2(2*i-1) c(2*i-1) = cxcom*c3(2*i-1) - cycom*c2(2*i) c(2*i) = cxcom*c3(2*i) + cycom*c3(2*i-1) 100 continue return endc**********************************************************************cc***************** form scalar product of 2 complex arrays ************c subroutine myscalconj (c1,c2,ps,nvecs) integer*4 nvecs,i real*8 c1(2*nvecs),c2(2*nvecs),ps(2) ps(1) = 0.0 ps(2) = 0.0c dir$l -novector do 100 i = 1, nvecs ps(1) = ps(1) + c1(2*i-1)*c2(2*i-1) + c1(2*i)*c2(2*i) ps(2) = ps(2) - c1(2*i-1)*c2(2*i) + c1(2*i)*c2(2*i-1) 100 continue return end
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -