#include "dims.h"
      SUBROUTINE ROTATE
      use cons_module,only: imax,imaxp2,imaxp4,kmaxp1
      implicit none
C     ****
C     ****     ROTATES LAMDAS
C     ****
#include "params.h"
#include "fcom.h"
#include "vscr.h"
#include "index.h"
#include "buff.h"
#include "phys.h"
#include "trgm.h"
!
! Local:
      integer :: nlxxk,nlyyk,nlxyk,nlyxk,k,i
!
      NLXXK=NLXX-1
      NLYYK=NLYY-1
      NLXYK=NLXY-1
      NLYXK=NLYX-1
      DO 1 K=1,KMAXP1
      NLXXK=NLXXK+1
      NLYYK=NLYYK+1
      NLXYK=NLXYK+1
      NLYXK=NLYXK+1
      DO 1 I=1,IMAXP4
C     ****
C     ****     S1=LAMXX, S2=LAMYY
C     ****
      S1(I,K)=F(I,NLXXK)*(1.-SN2DEC(I,J))+F(I,NLYYK)*SN2DEC(I,J)
      S2(I,K)=F(I,NLYYK)*(1.-SN2DEC(I,J))+F(I,NLXXK)*SN2DEC(I,J)
C     ****
C     ****     LAMYX, LAMXY, LAMXX, LAMYY
C     ****
      F(I,NLYXK)=F(I,NLXYK) - (F(I,NLYYK) - F(I,NLXXK))*SNCSDC(I,J)
      F(I,NLXYK)=F(I,NLXYK) + (F(I,NLYYK) - F(I,NLXXK))*SNCSDC(I,J)
      F(I,NLXXK)=S1(I,K)
      F(I,NLYYK)=S2(I,K)
    1 CONTINUE

!     call addfsech('LXX',' ',' ',f(1,nlxx),zimxp,zkmxp,zkmxp,j)
!     call addfsech('LYY',' ',' ',f(1,nlyy),zimxp,zkmxp,zkmxp,j)
!     call addfsech('LXY',' ',' ',f(1,nlxy),zimxp,zkmxp,zkmxp,j)
!     call addfsech('LYX',' ',' ',f(1,nlyx),zimxp,zkmxp,zkmxp,j)

C     ****
C     ****     PERIODIC POINTS FOR LAMDAS
C     ****
      NLXXK = NLXX-1
      DO I = 1,2
        DO K = 1,4*KMAXP1
          F(I,NLXXK+K) = F(I+IMAX,NLXXK+K)
          F(I+IMAXP2,NLXXK+K) = F(I+2,NLXXK+K)
        ENDDO
      ENDDO

      call addfsech('LXX',' ',' ',f(1,nlxx),zimxp,zkmxp,zkmxp,j)
      call addfsech('LYY',' ',' ',f(1,nlyy),zimxp,zkmxp,zkmxp,j)
      call addfsech('LXY',' ',' ',f(1,nlxy),zimxp,zkmxp,zkmxp,j)
      call addfsech('LYX',' ',' ',f(1,nlyx),zimxp,zkmxp,zkmxp,j)

      RETURN
      END
C