forked from erget/wgrib2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ipxetas.f
executable file
·159 lines (159 loc) · 5.69 KB
/
ipxetas.f
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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
C-----------------------------------------------------------------------
SUBROUTINE IPXETAS(IDIR,M1,M2,KM,KGDS1,F1,KGDS2,F2,IRET)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: IPXETAS EXPAND OR CONTRACT ETA GRIDS
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-04-10
C
C ABSTRACT: THIS SUBPROGRAM TRANSFORMS BETWEEN THE STAGGERED ETA GRIDS
C AS USED IN THE ETA MODEL AND FOR NATIVE GRID TRANSMISSION
C AND THEIR FULL EXPANSION AS USED FOR GENERAL INTERPOLATION
C AND GRAPHICS. THE ETA GRIDS ARE ROTATED LATITUDE-LONGITUDE
C GRIDS STAGGERED AS DEFINED BY THE ARAKAWA E-GRID, THAT IS
C WITH MASS DATA POINTS ALTERNATING WITH WIND DATA POINTS.
C THE EXPANSION OF THE FIELDS IS DONE BY 4-POINT AVERAGING.
C
C PROGRAM HISTORY LOG:
C 96-04-10 IREDELL
C
C USAGE: CALL IPXETAS(IDIR,M1,M2,KM,KGDS1,F1,KGDS2,F2,IRET)
C
C INPUT ARGUMENT LIST:
C IDIR - INTEGER TRANSFORM OPTION
C (+1 TO EXPAND STAGGERED MASS FIELDS TO FULL FIELDS)
C (+2 TO EXPAND STAGGERED WIND FIELDS TO FULL FIELDS)
C (-1 TO CONTRACT FULL MASS FIELDS TO STAGGERED FIELDS)
C (-2 TO CONTRACT FULL WIND FIELDS TO STAGGERED FIELDS)
C M1 - INTEGER SKIP NUMBER BETWEEN STAGGERED GRID FIELDS
C M2 - INTEGER SKIP NUMBER BETWEEN FULL GRID FIELDS
C KM - INTEGER NUMBER OF FIELDS TO TRANSFORM
C KGDS1 - INTEGER (200) GDS PARMS OF STAGGERED GRID IF IDIR>0
C F1 - REAL (M1,KM) STAGGERED GRID FIELDS IF IDIR>0
C KGDS2 - INTEGER (200) GDS PARMS OF FULL GRID IF IDIR<0
C F2 - REAL (M2,KM) FULL GRID FIELDS IF IDIR<0
C
C OUTPUT ARGUMENT LIST:
C KGDS1 - INTEGER (200) GDS PARMS OF STAGGERED GRID IF IDIR<0
C F1 - REAL (M1,KM) STAGGERED GRID FIELDS IF IDIR<0
C KGDS2 - INTEGER (200) GDS PARMS OF FULL GRID IF IDIR>0
C F2 - REAL (M2,KM) FULL GRID FIELDS IF IDIR>0
C IRET - INTEGER RETURN CODE
C 0 SUCCESSFUL TRANSFORMATION
C 1 IMPROPER GRID SPECIFICATION
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C
C$$$
INTEGER KGDS1(200),KGDS2(200)
REAL F1(M1,KM),F2(M2,KM)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C TRANSFORM GDS
IRET=0
C EXPAND STAGGERED GDS TO FULL GDS
IF(IDIR.GT.0.AND.KGDS1(1).EQ.201) THEN
KGDS2(1:22)=KGDS1(1:22)
KGDS2(1)=202
KGDS2(7)=KGDS1(7)*2-1
KGDS2(2)=KGDS2(7)*KGDS2(8)
C CONTRACT FULL GDS TO STAGGERED GDS
ELSEIF(IDIR.LT.0.AND.KGDS2(1).EQ.202) THEN
KGDS1(1:22)=KGDS2(1:22)
KGDS1(1)=201
KGDS1(7)=KGDS2(7)/2+1
KGDS1(2)=KGDS1(7)*KGDS1(8)-KGDS1(8)/2
ELSE
IRET=1
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C TRANSFORM FIELDS
IF(IRET.EQ.0) THEN
IM=KGDS2(7)
JM=KGDS2(8)
NM=(IM*JM+1)/2
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C EXPAND STAGGERED MASS FIELDS TO FULL MASS FIELDS
IF(IDIR.EQ.1) THEN
DO K=1,KM
DO N=1,NM
F2(N*2-1,K)=F1(N,K)
ENDDO
DO N=1,IM*JM-NM
F2(N*2,K)=0
W=0
C COLLECT DATA POINT TO THE SOUTH OF VACANT POINT
IF(N-IM/2.GE.1) THEN
F2(N*2,K)=F2(N*2,K)+F1(N-IM/2,K)
W=W+1
ENDIF
C COLLECT DATA POINT TO THE WEST OF VACANT POINT
IF(MOD(N,IM).NE.IM/2+1) THEN
F2(N*2,K)=F2(N*2,K)+F1(N,K)
W=W+1
ENDIF
C COLLECT DATA POINT TO THE EAST OF VACANT POINT
IF(MOD(N,IM).NE.0) THEN
F2(N*2,K)=F2(N*2,K)+F1(N+1,K)
W=W+1
ENDIF
C COLLECT DATA POINT TO THE NORTH OF VACANT POINT
IF(N+1+IM/2.LE.NM) THEN
F2(N*2,K)=F2(N*2,K)+F1(N+1+IM/2,K)
W=W+1
ENDIF
F2(N*2,K)=F2(N*2,K)/W
ENDDO
ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C EXPAND STAGGERED WIND FIELDS TO FULL WIND FIELDS
ELSEIF(IDIR.EQ.2) THEN
DO K=1,KM
DO N=1,IM*JM-NM
F2(N*2,K)=F1(N,K)
ENDDO
DO N=1,NM
F2(N*2-1,K)=0
W=0
C COLLECT DATA POINT TO THE SOUTH OF VACANT POINT
IF(N-1-IM/2.GE.1) THEN
F2(N*2-1,K)=F2(N*2-1,K)+F1(N-1-IM/2,K)
W=W+1
ENDIF
C COLLECT DATA POINT TO THE WEST OF VACANT POINT
IF(MOD(N,IM).NE.1) THEN
F2(N*2-1,K)=F2(N*2-1,K)+F1(N-1,K)
W=W+1
ENDIF
C COLLECT DATA POINT TO THE EAST OF VACANT POINT
IF(MOD(N,IM).NE.IM/2+1) THEN
F2(N*2-1,K)=F2(N*2-1,K)+F1(N,K)
W=W+1
ENDIF
C COLLECT DATA POINT TO THE NORTH OF VACANT POINT
IF(N+IM/2.LE.IM*JM-NM) THEN
F2(N*2-1,K)=F2(N*2-1,K)+F1(N+IM/2,K)
W=W+1
ENDIF
F2(N*2-1,K)=F2(N*2-1,K)/W
ENDDO
ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C CONTRACT FULL MASS FIELDS TO STAGGERED MASS FIELDS
ELSEIF(IDIR.EQ.-1) THEN
DO K=1,KM
DO N=1,NM
F1(N,K)=F2(N*2-1,K)
ENDDO
ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C CONTRACT FULL WIND FIELDS TO STAGGERED WIND FIELDS
ELSEIF(IDIR.EQ.-2) THEN
DO K=1,KM
DO N=1,IM*JM-NM
F1(N,K)=F2(N*2,K)
ENDDO
ENDDO
ENDIF
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END