NCEPLIBS-ip 4.0.0
ipxetas.f90
1 SUBROUTINE ipxetas(IDIR, IGDTNUMI, IGDTLEN, IGDTMPLI, NPTS_INPUT, &
2 BITMAP_INPUT, DATA_INPUT, IGDTNUMO, IGDTMPLO, &
3 NPTS_OUTPUT, BITMAP_OUTPUT, DATA_OUTPUT, IRET)
4!$$$ SUBPROGRAM DOCUMENTATION BLOCK
5!
6! SUBPROGRAM: IPXETAS EXPAND OR CONTRACT ETA GRIDS
7! PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-04-10
8!
9! ABSTRACT: THIS SUBPROGRAM TRANSFORMS BETWEEN THE STAGGERED ETA GRIDS
10! AS USED IN THE ETA MODEL AND FOR NATIVE GRID TRANSMISSION
11! AND THEIR FULL EXPANSION AS USED FOR GENERAL INTERPOLATION
12! AND GRAPHICS. THE ETA GRIDS ARE ROTATED LATITUDE-LONGITUDE
13! GRIDS STAGGERED AS DEFINED BY THE ARAKAWA E-GRID, THAT IS
14! WITH MASS DATA POINTS ALTERNATING WITH WIND DATA POINTS.
15!
16! PROGRAM HISTORY LOG:
17! 96-04-10 IREDELL
18! 2015-07-14 GAYNO MAKE GRIB 2 COMPLIANT. REPLACE 4-PT
19! INTERPOLATION WITH CALL TO IPOLATES.
20!
21! USAGE: CALL IPXETAS(IDIR, IGDTNUMI, IGDTLEN, IGDTMPLI, NPTS_INPUT, &
22! BITMAP_INPUT, DATA_INPUT, IGDTNUMO, IGDTMPLO, &
23! NPTS_OUTPUT, BITMAP_OUTPUT, DATA_OUTPUT, IRET)
24!
25! INPUT ARGUMENT LIST:
26! IDIR - INTEGER TRANSFORM OPTION
27! ( 0 TO EXPAND STAGGERED FIELDS TO FULL FIELDS)
28! (-1 TO CONTRACT FULL MASS FIELDS TO STAGGERED FIELDS)
29! (-2 TO CONTRACT FULL WIND FIELDS TO STAGGERED FIELDS)
30! IGDTNUMI - INTEGER GRID DEFINITION TEMPLATE NUMBER - INPUT GRID.
31! CORRESPONDS TO THE GFLD%IGDTNUM COMPONENT OF THE
32! NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE. MUST
33! BE = 1 (FOR A ROTATED LAT/LON GRID.)
34! IGDTLEN - INTEGER NUMBER OF ELEMENTS OF THE GRID DEFINITION
35! TEMPLATE ARRAY - SAME FOR INPUT AND OUTPUT GRIDS
36! (=22) WHICH ARE BOTH ROTATED LAT/LON GRIDS.
37! CORRESPONDS TO THE GFLD%IGDTLEN COMPONENT
38! OF THE NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE.
39! IGDTMPLI - INTEGER (IGDTLEN) GRID DEFINITION TEMPLATE ARRAY -
40! INPUT GRID. CORRESPONDS TO THE GFLD%IGDTMPL COMPONENT
41! OF THE NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE
42! (SECTION 3 INFO):
43! (1): SHAPE OF EARTH, OCTET 15
44! (2): SCALE FACTOR OF SPHERICAL EARTH RADIUS,
45! OCTET 16
46! (3): SCALED VALUE OF RADIUS OF SPHERICAL EARTH,
47! OCTETS 17-20
48! (4): SCALE FACTOR OF MAJOR AXIS OF ELLIPTICAL EARTH,
49! OCTET 21
50! (5): SCALED VALUE OF MAJOR AXIS OF ELLIPTICAL EARTH,
51! OCTETS 22-25
52! (6): SCALE FACTOR OF MINOR AXIS OF ELLIPTICAL EARTH,
53! OCTET 26
54! (7): SCALED VALUE OF MINOR AXIS OF ELLIPTICAL EARTH,
55! OCTETS 27-30
56! (8): NUMBER OF POINTS ALONG A PARALLEL, OCTS 31-34
57! (9): NUMBER OF POINTS ALONG A MERIDIAN, OCTS 35-38
58! (10): BASIC ANGLE OF INITIAL PRODUCTION DOMAIN,
59! OCTETS 39-42
60! (11): SUBDIVISIONS OF BASIC ANGLE, OCTETS 43-46
61! (12): LATITUDE OF FIRST GRID POINT, OCTETS 47-50
62! (13): LONGITUDE OF FIRST GRID POINT, OCTETS 51-54
63! (14): RESOLUTION AND COMPONENT FLAGS, OCTET 55
64! (15): LATITUDE OF LAST GRID POINT, OCTETS 56-59
65! (16): LONGITUDE OF LAST GRID POINT, OCTETS 60-63
66! (17): I-DIRECTION INCREMENT, OCTETS 64-67
67! (18): J-DIRECTION INCREMENT, OCTETS 68-71
68! (19): SCANNING MODE, OCTET 72
69! (20): LATITUDE OF SOUTHERN POLE OF PROJECTION,
70! OCTETS 73-76
71! (21): LONGITUDE OF SOUTHERN POLE OF PROJECTION,
72! OCTETS 77-80
73! (22): ANGLE OF ROTATION OF PROJECTION, OCTS 81-84
74! NPTS_INPUT - INTEGER NUMBER POINTS INPUT GRID
75! BITMAP_INPUT - LOGICAL (NPTS_INPUT) INPUT GRID BITMAP
76! DATA_INPUT - REAL (NPTS_INPUT) INPUT GRID DATA
77! NPTS_OUTPUT - INTEGER NUMBER POINTS OUTPUT GRID. THE J-DIMENSION
78! OF THE INPUT AND OUTPUT GRIDS ARE THE SAME.
79! WHEN GOING FROM A STAGGERED TO A FULL GRID THE
80! I-DIMENSION INCREASES TO IDIM*2-1. WHEN GOING
81! FROM FULL TO STAGGERED THE I-DIMENSION DECREASES
82! TO (IDIM+1)/2.
83!
84! OUTPUT ARGUMENT LIST:
85! IGDTNUMO - INTEGER GRID DEFINITION TEMPLATE NUMBER - OUTPUT GRID.
86! CORRESPONDS TO THE GFLD%IGDTNUM COMPONENT OF THE
87! NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE.
88! SAME AS IGDTNUMI (=1 FOR A ROTATED LAT/LON GRID).
89! IGDTMPLO - INTEGER (IGDTLEN) GRID DEFINITION TEMPLATE ARRAY -
90! OUTPUT GRID. CORRESPONDS TO THE GFLD%IGDTMPL COMPONENT
91! OF THE NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE.
92! ARRAY DEFINITIONS SAME AS "IGDTMPLI"
93! BITMAP_OUTPUT - LOGICAL (NPTS_OUTUT) OUTPUT GRID BITMAP
94! DATA_OUTPUT - REAL (NPTS_OUTPUT) OUTPUT GRID DATA
95! IRET - INTEGER RETURN CODE
96! 0 SUCCESSFUL TRANSFORMATION
97! NON-0 INVALID GRID SPECS OR PROBLEM IN IPOLATES
98!
99! ATTRIBUTES:
100! LANGUAGE: FORTRAN 90
101!
102!$$$
103 IMPLICIT NONE
104!
105 INTEGER, INTENT(IN ) :: IDIR
106 INTEGER, INTENT(IN ) :: IGDTNUMI, IGDTLEN
107 INTEGER, INTENT(IN ) :: IGDTMPLI(IGDTLEN)
108 INTEGER, INTENT(IN ) :: NPTS_INPUT, NPTS_OUTPUT
109 INTEGER, INTENT( OUT) :: IGDTNUMO
110 INTEGER, INTENT( OUT) :: IGDTMPLO(IGDTLEN)
111 INTEGER, INTENT( OUT) :: IRET
112
113 LOGICAL(KIND=1), INTENT(IN ) :: BITMAP_INPUT(NPTS_INPUT)
114 LOGICAL(KIND=1), INTENT( OUT) :: BITMAP_OUTPUT(NPTS_OUTPUT)
115
116 REAL, INTENT(IN ) :: DATA_INPUT(NPTS_INPUT)
117 REAL, INTENT( OUT) :: DATA_OUTPUT(NPTS_OUTPUT)
118
119 INTEGER :: SCAN_MODE, ISCALE, IP, IPOPT(20)
120 INTEGER :: IBI(1), IBO(1), J, KM, NO
121
122 REAL :: DLONS
123 REAL, ALLOCATABLE :: OUTPUT_RLAT(:), OUTPUT_RLON(:)
124! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
125 iret = 0
126! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
127! ROUTINE ONLY WORKS FOR ROTATED LAT/LON GRIDS.
128 IF (igdtnumi/=1) THEN
129 iret=1
130 RETURN
131 ENDIF
132!
133 scan_mode=igdtmpli(19)
134 IF((scan_mode==68.OR.scan_mode==72).AND.(idir<-2.OR.idir>-1))THEN
135 igdtnumo=igdtnumi
136 igdtmplo=igdtmpli
137 igdtmplo(19)=64
138 igdtmplo(8)=igdtmplo(8)*2-1
139 IF((igdtmplo(8)*igdtmplo(9))/=npts_output)THEN
140 iret=3
141 RETURN
142 ENDIF
143 iscale=igdtmplo(10)*igdtmplo(11)
144 IF(iscale==0) iscale=10**6
145 dlons=float(igdtmplo(17))/float(iscale)
146 dlons=dlons*0.5
147 igdtmplo(17)=nint(dlons*float(iscale))
148 ELSEIF(scan_mode==64.AND.idir==-1)THEN ! FULL TO H-GRID
149 igdtnumo=igdtnumi
150 igdtmplo=igdtmpli
151 igdtmplo(19)=68
152 igdtmplo(8)=(igdtmplo(8)+1)/2
153 IF((igdtmplo(8)*igdtmplo(9))/=npts_output)THEN
154 iret=3
155 RETURN
156 ENDIF
157 iscale=igdtmplo(10)*igdtmplo(11)
158 IF(iscale==0) iscale=10**6
159 dlons=float(igdtmplo(17))/float(iscale)
160 dlons=dlons*2.0
161 igdtmplo(17)=nint(dlons*float(iscale))
162 ELSEIF(scan_mode==64.AND.idir==-2)THEN ! FULL TO V-GRID
163 igdtnumo=igdtnumi
164 igdtmplo=igdtmpli
165 igdtmplo(19)=72
166 igdtmplo(8)=(igdtmplo(8)+1)/2
167 IF((igdtmplo(8)*igdtmplo(9))/=npts_output)THEN
168 iret=3
169 RETURN
170 ENDIF
171 iscale=igdtmplo(10)*igdtmplo(11)
172 IF(iscale==0) iscale=10**6
173 dlons=float(igdtmplo(17))/float(iscale)
174 dlons=dlons*2.0
175 igdtmplo(17)=nint(dlons*float(iscale))
176 ELSE
177 iret=2
178 RETURN
179 ENDIF
180
181 km=1
182 ip=0
183 ipopt=0
184 ibi=1
185 ibo=0
186
187 ALLOCATE(output_rlat(npts_output))
188 ALLOCATE(output_rlon(npts_output))
189
190 CALL ipolates(ip, ipopt, igdtnumi, igdtmpli, igdtlen, &
191 igdtnumo, igdtmplo, igdtlen, &
192 npts_input, npts_output, km, ibi, bitmap_input, data_input, &
193 no, output_rlat, output_rlon, ibo, bitmap_output, data_output, iret)
194
195 DEALLOCATE(output_rlat, output_rlon)
196
197 IF(iret /= 0)THEN
198 print*,'- PROBLEM IN IPOLATES: ', iret
199 RETURN
200 ENDIF
201
202! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
203! REPLACE ANY UNDEFINED POINTS ALONG THE LEFT AND RIGHT EDGES.
204 DO j=1, igdtmplo(9)
205 bitmap_output(j*igdtmplo(8))=bitmap_output(j*igdtmplo(8)-1)
206 data_output(j*igdtmplo(8))=data_output(j*igdtmplo(8)-1)
207 bitmap_output((j-1)*igdtmplo(8)+1)=bitmap_output((j-1)*igdtmplo(8)+2)
208 data_output((j-1)*igdtmplo(8)+1)=data_output((j-1)*igdtmplo(8)+2)
209 ENDDO
210
211 RETURN
212! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
213 END SUBROUTINE ipxetas