************************************************************************ ************************************************************************ * * Subroutine ORTHO * * Function: * Set matrix for conversion between crystallographic and * orthogonal frame * * Comments: * Adapted from CCP4 routine RBFRO1 * * Arguments: * Cell (i) unit cell parameters * Ortcod (i) orthogonalization code: * ortcod = 1 > a // xo c* // zo * = 2 > b // xo a* // zo * = 3 > c // xo b* // zo * = 4 > hex a+b // xo c* // zo * = 5 > a* // xo c // zo * = 6 > a // xo b* // yo * Way (i) direction of conversion: * way = DEORT > orthogonal to crystallographic * way = TOORT > crystallographic to orthogonal * Rort (o) (de)orthogonalization matrix * Errcod (o) error code * errcod = 0 - no error * errcod = 1 - illegal orthogonalization code * errcod = 2 - matrix inversion error * errcod = 3 - illegal WAY string * * * History: * Written December 12 1991 (from CCP4 s/r RBFRO1) S. Knight ************************************************************************ subroutine ortho ( cell , ortcod , way , rort , errcod ) implicit none * Arguments real cell( 6 ) integer ortcod character*(*) way real rort( 3,3 ) integer errcod * Local variables real dtor real r( 3,3 ) real a , b , c , alpha , beta , gamma real sina , cosa , sinb , cosb , sing , cosg real cosas , cosbs , cosgs , sinas , sinbs , sings parameter ( dtor = 3.141592/180. ) *=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= * Init error code errcod = 0 * Initiate useful constants a = cell(1) b = cell(2) c = cell(3) alpha = cell(4) * dtor beta = cell(5) * dtor gamma = cell(6) * dtor sina = sin ( alpha ) cosa = cos ( alpha ) sinb = sin ( beta ) cosb = cos ( beta ) sing = sin ( gamma ) cosg = cos ( gamma ) cosas = ( cosg * cosb - cosa ) / ( sinb * sing ) cosbs = ( cosa * cosg - cosb ) / ( sina * sing ) cosgs = ( cosa * cosb - cosg ) / ( sina * sinb ) sinas = sqrt ( 1.0 - cosas * cosas ) sinbs = sqrt ( 1.0 - cosbs * cosbs ) sings = sqrt ( 1.0 - cosgs * cosgs ) * Init matrix call matclr ( r , 3 , 3 ) * * Calculate matrix (fractional crystallographic to Angstrom orthogonal) * if ( ortcod .eq. 1 ) then * XO along a Zo along c* r(1,1) = a r(1,2) = b * cosg r(1,3) = c * cosb r(2,2) = b * sing r(2,3) = -c * sinb * cosas r(3,3) = c * sinb * sinas else if ( ortcod .eq. 2 ) then * XO along b Zo along a* r(3,1) = a * sing * sinbs r(1,1) = a * cosg r(1,2) = b r(1,3) = c * cosa r(2,1) = -a * sing * cosbs r(2,3) = c * sina else if ( ortcod .eq. 3 ) then * XO along c Zo along b* r(2,1) = a * sinb r(2,2) = -b * sina * cosgs r(3,2) = b * sina * sings r(1,1) = a * cosb r(1,2) = b * cosa r(1,3) = c else if ( ortcod .eq. 4 ) then * trigonal only - XO along a+b YO along a-b Zo along c* r(3,3) = c r(1,1) = a / 2.0 r(1,2) = a / 2.0 r(2,1) = -a * sing r(2,2) = a * sing else if ( ortcod .eq. 5 ) then * XO along a* ZO along c r(1,1) = a * sinb * sings r(3,1) = a * cosb r(3,2) = b * cosa r(3,3) = c r(2,1) = -a * sinb * cosgs r(2,2) = b * sina else if ( ortcod .eq. 6 ) then * XO along a Yo along b* r(1,1) = a r(1,2) = b * cosg r(1,3) = c * cosb r(2,2) = b * sing * sinas r(3,2) = -b * sing * cosas r(3,3) = c * sinb else errcod = 1 endif * Copy matrix if crystallographic to orthogonal wanted * Invert matrix if orthogonal to crystallographic wanted if ( way .eq. 'TOORT' ) then call matcop ( r , rort , 3 , 3 ) else if ( way .eq. 'DEORT' ) then call matinv ( r , rort , errcod ) if ( errcod .ne. 0 ) errcod = 2 else errcod = 3 endif return *=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= end