libf/dyn3d/fxy.f90

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	SUBROUTINE fxy(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
2	yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, &
3	xprimp025)
4
5	! 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
10	USE dimens_m, ONLY : iim, jjm
11
12	IMPLICIT NONE
13
14	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
24	! Variables local to the procedure:
25
26	INTEGER i, j
27
28	!------------------------------------------------------------
29
30	! Calcul des latitudes et de y'
31
32	DO j = 1, jjm + 1
33	rlatu(j) = fy(real(j))
34	yprimu(j) = fyprim(real(j))
35	END DO
36
37	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
42	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
47	! Calcul des longitudes et de x'
48
49	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
55	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
61	CONTAINS
62
63	! 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	USE nr_util, ONLY : pi
68	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	USE nr_util, ONLY : pi
78	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	USE nr_util, ONLY : pi
89	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	USE nr_util, ONLY : pi
100	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	USE nr_util, ONLY : pi
110	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	USE nr_util, ONLY : pi
122	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