trunk/dyn3d/fxy.f

module fxy_m

  IMPLICIT NONE

  private
  public fxy

contains

  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

    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

  END SUBROUTINE fxy

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

  ! 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
    USE dimens_m, ONLY : iim

    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
    USE dimens_m, ONLY : iim

    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
    USE dimens_m, ONLY : jjm
    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
    USE dimens_m, ONLY : jjm

    REAL, INTENT (IN) :: rj

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

  end function fyprim

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