trunk/dyn3d/fxy.f

SUBROUTINE fxy(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
     yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, &
     xprimp025)

  ! From dyn3d/fxy.F, v 1.1.1.1 2004/05/19 12:53:06
  ! Auteur : P. Le Van
  ! Calcul des longitudes et des latitudes pour une fonction f(x, y)
  ! à tangente sinusoïdale et éventuellement avec zoom.

  USE dimens_m, ONLY : iim, jjm

  IMPLICIT NONE

  REAL, INTENT (OUT) :: rlatu(jjm + 1), yprimu(jjm + 1), rlatv(jjm)
  REAL, INTENT (OUT) :: yprimv(jjm)
  REAL, INTENT (OUT) :: rlatu1(jjm)
  REAL, INTENT (OUT) :: yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
  REAL, INTENT (OUT) :: rlonu(iim + 1), xprimu(iim + 1), rlonv(iim + 1)
  REAL, INTENT (OUT) :: xprimv(iim + 1)
  REAL, INTENT (OUT) :: rlonm025(iim + 1), xprimm025(iim + 1)
  REAL, INTENT (OUT) :: rlonp025(iim + 1)
  REAL, INTENT (OUT) :: xprimp025(iim + 1)

  ! Variables local to the procedure:

  INTEGER i, j

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

  ! Calcul des latitudes et de y'

  DO j = 1, jjm + 1
     rlatu(j) = fy(real(j))
     yprimu(j) = fyprim(real(j))
  END DO

  DO j = 1, jjm
     rlatv(j) = fy(real(j) + 0.5)
     rlatu1(j) = fy(real(j) + 0.25)
     rlatu2(j) = fy(real(j) + 0.75)

     yprimv(j) = fyprim(real(j) + 0.5)
     yprimu1(j) = fyprim(real(j) + 0.25)
     yprimu2(j) = fyprim(real(j) + 0.75)
  END DO

  ! Calcul des longitudes et de x'

  DO i = 1, iim + 1
     rlonv(i) = fx(real(i))
     rlonu(i) = fx(real(i) + 0.5)
     rlonm025(i) = fx(real(i) - 0.25)
     rlonp025(i) = fx(real(i) + 0.25)

     xprimv(i) = fxprim(real(i))
     xprimu(i) = fxprim(real(i) + 0.5)
     xprimm025(i) = fxprim(real(i) - 0.25)
     xprimp025(i) = fxprim(real(i) + 0.25)
  END DO

CONTAINS

  ! From grid/fxy_new.h, v 1.1.1.1 2004/05/19 12:53:05

  REAL FUNCTION ripx(ri)
    ! stretching in x
    USE nr_util, ONLY : pi
    REAL, INTENT (IN) :: ri

    ripx = (ri - 1.) * 2 * pi / REAL(iim)
  end function ripx

  !******************************************************

  REAL FUNCTION fx(ri)
    ! stretching in x
    USE nr_util, ONLY : pi
    USE serre, ONLY : alphax, pxo, transx
    REAL, INTENT (IN) :: ri

    fx = ripx(ri) + transx + alphax * SIN(ripx(ri) + transx - pxo) - pi
  end function fx

  !******************************************************

  REAL FUNCTION fxprim(ri)
    ! stretching in x
    USE nr_util, ONLY : pi
    USE serre, ONLY : alphax, pxo, transx
    REAL, INTENT (IN) :: ri

    fxprim = 2 * pi / REAL(iim) * (1. + alphax * COS(ripx(ri) + transx - pxo))
  end function fxprim

  !******************************************************

  REAL FUNCTION bigy(rj)
    ! stretching in y
    USE nr_util, ONLY : pi
    REAL, INTENT (IN) :: rj

    bigy = 2 * (REAL(jjm + 1) - rj) * pi / jjm
  end function bigy

  !******************************************************

  REAL FUNCTION fy(rj)
    ! stretching in y
    USE nr_util, ONLY : pi
    USE serre, ONLY : alphay, pyo, transy
    REAL, INTENT (IN) :: rj

    fy = (bigy(rj) + transy + alphay * SIN(bigy(rj) + transy - pyo)) / 2 &
         - pi / 2
  end function fy

  !******************************************************

  REAL FUNCTION fyprim(rj)
    ! stretching in y
    USE nr_util, ONLY : pi
    USE serre, ONLY : alphay, pyo, transy
    REAL, INTENT (IN) :: rj

    fyprim = (pi / jjm) * (1. + alphay * COS(bigy(rj) + transy - pyo))
  end function fyprim

END SUBROUTINE fxy
1	guez	7	SUBROUTINE fxy(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
2			yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, &
3			xprimp025)
4	guez	3
5	guez	7	! From dyn3d/fxy.F, v 1.1.1.1 2004/05/19 12:53:06
6			! Auteur : P. Le Van
7			! Calcul des longitudes et des latitudes pour une fonction f(x, y)
8			! à tangente sinusoïdale et éventuellement avec zoom.
9	guez	3
10	guez	7	USE dimens_m, ONLY : iim, jjm
11	guez	3
12	guez	7	IMPLICIT NONE
13	guez	3
14	guez	7	REAL, INTENT (OUT) :: rlatu(jjm + 1), yprimu(jjm + 1), rlatv(jjm)
15			REAL, INTENT (OUT) :: yprimv(jjm)
16			REAL, INTENT (OUT) :: rlatu1(jjm)
17			REAL, INTENT (OUT) :: yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
18			REAL, INTENT (OUT) :: rlonu(iim + 1), xprimu(iim + 1), rlonv(iim + 1)
19			REAL, INTENT (OUT) :: xprimv(iim + 1)
20			REAL, INTENT (OUT) :: rlonm025(iim + 1), xprimm025(iim + 1)
21			REAL, INTENT (OUT) :: rlonp025(iim + 1)
22			REAL, INTENT (OUT) :: xprimp025(iim + 1)
23	guez	3
24	guez	7	! Variables local to the procedure:
25	guez	3
26	guez	7	INTEGER i, j
27	guez	3
28	guez	7	!------------------------------------------------------------
29	guez	3
30	guez	7	! Calcul des latitudes et de y'
31	guez	3
32	guez	7	DO j = 1, jjm + 1
33			rlatu(j) = fy(real(j))
34			yprimu(j) = fyprim(real(j))
35			END DO
36	guez	3
37	guez	7	DO j = 1, jjm
38			rlatv(j) = fy(real(j) + 0.5)
39			rlatu1(j) = fy(real(j) + 0.25)
40			rlatu2(j) = fy(real(j) + 0.75)
41	guez	3
42	guez	7	yprimv(j) = fyprim(real(j) + 0.5)
43			yprimu1(j) = fyprim(real(j) + 0.25)
44			yprimu2(j) = fyprim(real(j) + 0.75)
45			END DO
46	guez	3
47	guez	7	! Calcul des longitudes et de x'
48	guez	3
49	guez	7	DO i = 1, iim + 1
50			rlonv(i) = fx(real(i))
51			rlonu(i) = fx(real(i) + 0.5)
52			rlonm025(i) = fx(real(i) - 0.25)
53			rlonp025(i) = fx(real(i) + 0.25)
54	guez	3
55	guez	7	xprimv(i) = fxprim(real(i))
56			xprimu(i) = fxprim(real(i) + 0.5)
57			xprimm025(i) = fxprim(real(i) - 0.25)
58			xprimp025(i) = fxprim(real(i) + 0.25)
59			END DO
60	guez	3
61	guez	7	CONTAINS
62	guez	3
63	guez	7	! From grid/fxy_new.h, v 1.1.1.1 2004/05/19 12:53:05
64
65			REAL FUNCTION ripx(ri)
66			! stretching in x
67	guez	39	USE nr_util, ONLY : pi
68	guez	7	REAL, INTENT (IN) :: ri
69
70			ripx = (ri - 1.) * 2 * pi / REAL(iim)
71			end function ripx
72
73			!******************************************************
74
75			REAL FUNCTION fx(ri)
76			! stretching in x
77	guez	39	USE nr_util, ONLY : pi
78	guez	7	USE serre, ONLY : alphax, pxo, transx
79			REAL, INTENT (IN) :: ri
80
81			fx = ripx(ri) + transx + alphax * SIN(ripx(ri) + transx - pxo) - pi
82			end function fx
83
84			!******************************************************
85
86			REAL FUNCTION fxprim(ri)
87			! stretching in x
88	guez	39	USE nr_util, ONLY : pi
89	guez	7	USE serre, ONLY : alphax, pxo, transx
90			REAL, INTENT (IN) :: ri
91
92			fxprim = 2 * pi / REAL(iim) * (1. + alphax * COS(ripx(ri) + transx - pxo))
93			end function fxprim
94
95			!******************************************************
96
97			REAL FUNCTION bigy(rj)
98			! stretching in y
99	guez	39	USE nr_util, ONLY : pi
100	guez	7	REAL, INTENT (IN) :: rj
101
102			bigy = 2 * (REAL(jjm + 1) - rj) * pi / jjm
103			end function bigy
104
105			!******************************************************
106
107			REAL FUNCTION fy(rj)
108			! stretching in y
109	guez	39	USE nr_util, ONLY : pi
110	guez	7	USE serre, ONLY : alphay, pyo, transy
111			REAL, INTENT (IN) :: rj
112
113			fy = (bigy(rj) + transy + alphay * SIN(bigy(rj) + transy - pyo)) / 2 &
114			- pi / 2
115			end function fy
116
117			!******************************************************
118
119			REAL FUNCTION fyprim(rj)
120			! stretching in y
121	guez	39	USE nr_util, ONLY : pi
122	guez	7	USE serre, ONLY : alphay, pyo, transy
123			REAL, INTENT (IN) :: rj
124
125			fyprim = (pi / jjm) * (1. + alphay * COS(bigy(rj) + transy - pyo))
126			end function fyprim
127
128			END SUBROUTINE fxy