1 subroutine rotabc (global, iBC, code) 2c--------------------------------------------------------------------- 3c 4c This subroutine is responsible for rotating 5c the residual and solution vectors for axisymmetric BC's. 6c 7c input: 8c global(nshg,n): global vector to be rotated. 9c code: = 'in' for rotating with the residual 10c = 'out' for rotating the solution 11c 12c note that the cos and sin of the rotation angles are preprocessed and 13c stored in acs(1 and 2) respectively. 14c 15c--------------------------------------------------------------------- 16c 17 use specialBC ! gives us acs, contains (:,1)=cos(theta) (:,2)=sin(theta) 18 include "common.h" 19 20 dimension global(nshg,2), iBC(nshg), 21 & tmp(nshg) 22 23 character*3 code 24 25 if (code .eq. 'in ') then 26 where( btest(iBC,10)) 27 tmp = global(:,1)*acs(:,1) - global(:,2)*acs(:,2) 28 global(:,2) = global(:,1)*acs(:,2) + global(:,2)*acs(:,1) 29 global(:,1) = tmp 30 endwhere 31 else if (code .eq. 'out') then 32 where( btest(iBC,10)) 33 tmp = global(:,1)*acs(:,1) + global(:,2)*acs(:,2) 34 global(:,2) = -global(:,1)*acs(:,2) + global(:,2)*acs(:,1) 35 global(:,1) = tmp 36 endwhere 37 else 38 call error ('rotabc ','code ',0) 39 endif 40 41 return 42 end 43