1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
C Copyright 1981-2007 ECMWF
C
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C
SUBROUTINE RPHI( DATA, NM, WORK, SLON)
C
C---->
C**** RPHI
C
C Purpose
C -------
C
C Rotates spectral coefficients by longitude.
C
C
C Interface
C ---------
C
C CALL RPHI(DATA,NM,WORK,SLON)
C
C Input
C -----
C
C DATA = Input spectral field of REAL*8s of size (NM+1)*(NM+2).
C NM = Triangular truncation (e.g. 106)
C WORK = Work space of size at least 2*(NM+1).
C SLON = Rotation angle (REAL*8).
C (degrees, positive => rotate west to east).
C
C Output
C ------
C
C Transformed fields are returned in data.
C
C
C Method
C ------
C
C See reference below.
C
C
C Externals
C ---------
C
C None.
C
C
C Author
C ------
C
C R.McGrath and P.Lynch HIRLAM
C
C
C Reference.
C ----------
C
C "Spectral synthesis on rotated and regular grids"
C by P.Lynch and R.McGrath (Irish Meteorological Service).
C
C
C Modifications
C -------------
C
C J.D.Chambers ECMWF October 1995
C Reformat and put into clearcase.
C
C ------------------------------------------------------------------
C----<
C
IMPLICIT NONE
C
#include "jparams.h"
C
C Function arguments
COMPLEX*16 DATA
COMPLEX*16 WORK
DIMENSION DATA(*), WORK(*)
REAL*8 SLON
INTEGER NM
C
C Parameters
INTEGER JPROUTINE
PARAMETER (JPROUTINE = 26000 )
C
C Local variables
COMPLEX*16 CC
INTEGER I, IPMN, NS, M, J
REAL*8 RAD, XLON
C
C ------------------------------------------------------------------
C* Section 1. Initialise
C ------------------------------------------------------------------
C
100 CONTINUE
C
IPMN = ((NM+1)*(NM+2))/2
RAD = 180.0/PPI
XLON = -SLON/RAD
C
C ------------------------------------------------------------------
C* Section 2. Transform the fields.
C ------------------------------------------------------------------
C
200 CONTINUE
C
NS = 1
CC = (1.0,0.0)
C
DO 215 M = 1,NM+1
DO 210 J = NS,NS+NM-M+1
WORK(J) = CC
210 CONTINUE
C
NS = J
CC = CEXP(CMPLX(0.0,REAL(XLON*M)))
215 CONTINUE
C
C Transform fields in output array.
DO 220 J = 1,IPMN
DATA(J) = WORK(J)*DATA(J)
220 CONTINUE
C
C ------------------------------------------------------------------
C* Section 9. Return.
C ------------------------------------------------------------------
C
900 CONTINUE
C
RETURN
END
|
