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	guez	78
91	guez	7	! stretching in x
92	guez	39	USE nr_util, ONLY : pi
93	guez	7	USE serre, ONLY : alphax, pxo, transx
94			REAL, INTENT (IN) :: ri
95
96			fx = ripx(ri) + transx + alphax * SIN(ripx(ri) + transx - pxo) - pi
97	guez	78
98	guez	7	end function fx
99
100			!******************************************************
101
102			REAL FUNCTION fxprim(ri)
103	guez	57
104	guez	7	! stretching in x
105	guez	57
106	guez	39	USE nr_util, ONLY : pi
107	guez	7	USE serre, ONLY : alphax, pxo, transx
108	guez	57	USE dimens_m, ONLY : iim
109
110	guez	7	REAL, INTENT (IN) :: ri
111
112			fxprim = 2 * pi / REAL(iim) * (1. + alphax * COS(ripx(ri) + transx - pxo))
113	guez	57
114	guez	7	end function fxprim
115
116			!******************************************************
117
118			REAL FUNCTION bigy(rj)
119	guez	78
120	guez	7	! stretching in y
121	guez	39	USE nr_util, ONLY : pi
122	guez	57	USE dimens_m, ONLY : jjm
123	guez	7	REAL, INTENT (IN) :: rj
124
125			bigy = 2 * (REAL(jjm + 1) - rj) * pi / jjm
126	guez	78
127	guez	7	end function bigy
128
129			!******************************************************
130
131			REAL FUNCTION fy(rj)
132	guez	78
133	guez	7	! stretching in y
134	guez	39	USE nr_util, ONLY : pi
135	guez	7	USE serre, ONLY : alphay, pyo, transy
136			REAL, INTENT (IN) :: rj
137
138			fy = (bigy(rj) + transy + alphay * SIN(bigy(rj) + transy - pyo)) / 2 &
139			- pi / 2
140	guez	78
141	guez	7	end function fy
142
143			!******************************************************
144
145			REAL FUNCTION fyprim(rj)
146	guez	57
147	guez	7	! stretching in y
148	guez	57
149	guez	39	USE nr_util, ONLY : pi
150	guez	7	USE serre, ONLY : alphay, pyo, transy
151	guez	57	USE dimens_m, ONLY : jjm
152
153	guez	7	REAL, INTENT (IN) :: rj
154
155			fyprim = (pi / jjm) * (1. + alphay * COS(bigy(rj) + transy - pyo))
156	guez	57
157	guez	7	end function fyprim
158
159	guez	57	end module fxy_m