trunk/dyn3d/principal_cshift.f

module principal_cshift_m

  implicit none

contains

  subroutine principal_cshift(is2, xlon, xprimm)

    ! Add or subtract 2 pi so that xlon is near [-pi, pi], then cshift
    ! so that xlon is in ascending order. Make the same cshift on
    ! xprimm.

    USE dimens_m, ONLY: iim
    use dynetat0_m, only: clon
    use nr_util, only: twopi

    integer, intent(in):: is2
    real, intent(inout):: xlon(:), xprimm(:) ! (iim + 1)

    !-----------------------------------------------------

    if (is2 /= 0) then
       IF (clon <= 0.) THEN
          IF (is2 /= 1) THEN
             xlon(:is2 - 1) = xlon(:is2 - 1) + twopi
             xlon(:iim) = cshift(xlon(:iim), shift = is2 - 1)
             xprimm(:iim) = cshift(xprimm(:iim), shift = is2 - 1)
          END IF
       else
          xlon(is2 + 1:iim) = xlon(is2 + 1:iim) - twopi
          xlon(:iim) = cshift(xlon(:iim), shift = is2)
          xprimm(:iim) = cshift(xprimm(:iim), shift = is2)
       end IF
    end if

    xlon(iim + 1) = xlon(1) + twopi
    xprimm(iim + 1) = xprimm(1)

  end subroutine principal_cshift

end module principal_cshift_m
1	module principal_cshift_m
2
3	implicit none
4
5	contains
6
7	subroutine principal_cshift(is2, xlon, xprimm)
8
9	! Add or subtract 2 pi so that xlon is near [-pi, pi], then cshift
10	! so that xlon is in ascending order. Make the same cshift on
11	! xprimm.
12
13	USE dimens_m, ONLY: iim
14	use dynetat0_m, only: clon
15	use nr_util, only: twopi
16
17	integer, intent(in):: is2
18	real, intent(inout):: xlon(:), xprimm(:) ! (iim + 1)
19
20	!-----------------------------------------------------
21
22	if (is2 /= 0) then
23	IF (clon <= 0.) THEN
24	IF (is2 /= 1) THEN
25	xlon(:is2 - 1) = xlon(:is2 - 1) + twopi
26	xlon(:iim) = cshift(xlon(:iim), shift = is2 - 1)
27	xprimm(:iim) = cshift(xprimm(:iim), shift = is2 - 1)
28	END IF
29	else
30	xlon(is2 + 1:iim) = xlon(is2 + 1:iim) - twopi
31	xlon(:iim) = cshift(xlon(:iim), shift = is2)
32	xprimm(:iim) = cshift(xprimm(:iim), shift = is2)
33	end IF
34	end if
35
36	xlon(iim + 1) = xlon(1) + twopi
37	xprimm(iim + 1) = xprimm(1)
38
39	end subroutine principal_cshift
40
41	end module principal_cshift_m