SUBROUTINE IPXETAS(IDIR, IGDTNUMI, IGDTLEN, IGDTMPLI, NPTS_INPUT, & BITMAP_INPUT, DATA_INPUT, IGDTNUMO, IGDTMPLO, & NPTS_OUTPUT, BITMAP_OUTPUT, DATA_OUTPUT, IRET) !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! ! $Revision: 74917 $ ! ! SUBPROGRAM: IPXETAS EXPAND OR CONTRACT ETA GRIDS ! PRGMMR: IREDELL ORG: W/NMC23 DATE: 96-04-10 ! ! ABSTRACT: THIS SUBPROGRAM TRANSFORMS BETWEEN THE STAGGERED ETA GRIDS ! AS USED IN THE ETA MODEL AND FOR NATIVE GRID TRANSMISSION ! AND THEIR FULL EXPANSION AS USED FOR GENERAL INTERPOLATION ! AND GRAPHICS. THE ETA GRIDS ARE ROTATED LATITUDE-LONGITUDE ! GRIDS STAGGERED AS DEFINED BY THE ARAKAWA E-GRID, THAT IS ! WITH MASS DATA POINTS ALTERNATING WITH WIND DATA POINTS. ! ! PROGRAM HISTORY LOG: ! 96-04-10 IREDELL ! 2015-07-14 GAYNO MAKE GRIB 2 COMPLIANT. REPLACE 4-PT ! INTERPOLATION WITH CALL TO IPOLATES. ! ! USAGE: CALL IPXETAS(IDIR, IGDTNUMI, IGDTLEN, IGDTMPLI, NPTS_INPUT, & ! BITMAP_INPUT, DATA_INPUT, IGDTNUMO, IGDTMPLO, & ! NPTS_OUTPUT, BITMAP_OUTPUT, DATA_OUTPUT, IRET) ! ! INPUT ARGUMENT LIST: ! IDIR - INTEGER TRANSFORM OPTION ! ( 0 TO EXPAND STAGGERED FIELDS TO FULL FIELDS) ! (-1 TO CONTRACT FULL MASS FIELDS TO STAGGERED FIELDS) ! (-2 TO CONTRACT FULL WIND FIELDS TO STAGGERED FIELDS) ! IGDTNUMI - INTEGER GRID DEFINITION TEMPLATE NUMBER - INPUT GRID. ! CORRESPONDS TO THE GFLD%IGDTNUM COMPONENT OF THE ! NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE. MUST ! BE = 1 (FOR A ROTATED LAT/LON GRID.) ! IGDTLEN - INTEGER NUMBER OF ELEMENTS OF THE GRID DEFINITION ! TEMPLATE ARRAY - SAME FOR INPUT AND OUTPUT GRIDS ! (=22) WHICH ARE BOTH ROTATED LAT/LON GRIDS. ! CORRESPONDS TO THE GFLD%IGDTLEN COMPONENT ! OF THE NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE. ! IGDTMPLI - INTEGER (IGDTLEN) GRID DEFINITION TEMPLATE ARRAY - ! INPUT GRID. CORRESPONDS TO THE GFLD%IGDTMPL COMPONENT ! OF THE NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE ! (SECTION 3 INFO): ! (1): SHAPE OF EARTH, OCTET 15 ! (2): SCALE FACTOR OF SPHERICAL EARTH RADIUS, ! OCTET 16 ! (3): SCALED VALUE OF RADIUS OF SPHERICAL EARTH, ! OCTETS 17-20 ! (4): SCALE FACTOR OF MAJOR AXIS OF ELLIPTICAL EARTH, ! OCTET 21 ! (5): SCALED VALUE OF MAJOR AXIS OF ELLIPTICAL EARTH, ! OCTETS 22-25 ! (6): SCALE FACTOR OF MINOR AXIS OF ELLIPTICAL EARTH, ! OCTET 26 ! (7): SCALED VALUE OF MINOR AXIS OF ELLIPTICAL EARTH, ! OCTETS 27-30 ! (8): NUMBER OF POINTS ALONG A PARALLEL, OCTS 31-34 ! (9): NUMBER OF POINTS ALONG A MERIDIAN, OCTS 35-38 ! (10): BASIC ANGLE OF INITIAL PRODUCTION DOMAIN, ! OCTETS 39-42 ! (11): SUBDIVISIONS OF BASIC ANGLE, OCTETS 43-46 ! (12): LATITUDE OF FIRST GRID POINT, OCTETS 47-50 ! (13): LONGITUDE OF FIRST GRID POINT, OCTETS 51-54 ! (14): RESOLUTION AND COMPONENT FLAGS, OCTET 55 ! (15): LATITUDE OF LAST GRID POINT, OCTETS 56-59 ! (16): LONGITUDE OF LAST GRID POINT, OCTETS 60-63 ! (17): I-DIRECTION INCREMENT, OCTETS 64-67 ! (18): J-DIRECTION INCREMENT, OCTETS 68-71 ! (19): SCANNING MODE, OCTET 72 ! (20): LATITUDE OF SOUTHERN POLE OF PROJECTION, ! OCTETS 73-76 ! (21): LONGITUDE OF SOUTHERN POLE OF PROJECTION, ! OCTETS 77-80 ! (22): ANGLE OF ROTATION OF PROJECTION, OCTS 81-84 ! NPTS_INPUT - INTEGER NUMBER POINTS INPUT GRID ! BITMAP_INPUT - LOGICAL (NPTS_INPUT) INPUT GRID BITMAP ! DATA_INPUT - REAL (NPTS_INPUT) INPUT GRID DATA ! NPTS_OUTPUT - INTEGER NUMBER POINTS OUTPUT GRID. THE J-DIMENSION ! OF THE INPUT AND OUTPUT GRIDS ARE THE SAME. ! WHEN GOING FROM A STAGGERED TO A FULL GRID THE ! I-DIMENSION INCREASES TO IDIM*2-1. WHEN GOING ! FROM FULL TO STAGGERED THE I-DIMENSION DECREASES ! TO (IDIM+1)/2. ! ! OUTPUT ARGUMENT LIST: ! IGDTNUMO - INTEGER GRID DEFINITION TEMPLATE NUMBER - OUTPUT GRID. ! CORRESPONDS TO THE GFLD%IGDTNUM COMPONENT OF THE ! NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE. ! SAME AS IGDTNUMI (=1 FOR A ROTATED LAT/LON GRID). ! IGDTMPLO - INTEGER (IGDTLEN) GRID DEFINITION TEMPLATE ARRAY - ! OUTPUT GRID. CORRESPONDS TO THE GFLD%IGDTMPL COMPONENT ! OF THE NCEP G2 LIBRARY GRIDMOD DATA STRUCTURE. ! ARRAY DEFINITIONS SAME AS "IGDTMPLI" ! BITMAP_OUTPUT - LOGICAL (NPTS_OUTUT) OUTPUT GRID BITMAP ! DATA_OUTPUT - REAL (NPTS_OUTPUT) OUTPUT GRID DATA ! IRET - INTEGER RETURN CODE ! 0 SUCCESSFUL TRANSFORMATION ! NON-0 INVALID GRID SPECS OR PROBLEM IN IPOLATES ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! !$$$ IMPLICIT NONE ! INTEGER, INTENT(IN ) :: IDIR INTEGER, INTENT(IN ) :: IGDTNUMI, IGDTLEN INTEGER, INTENT(IN ) :: IGDTMPLI(IGDTLEN) INTEGER, INTENT(IN ) :: NPTS_INPUT, NPTS_OUTPUT INTEGER, INTENT( OUT) :: IGDTNUMO INTEGER, INTENT( OUT) :: IGDTMPLO(IGDTLEN) INTEGER, INTENT( OUT) :: IRET LOGICAL(KIND=1), INTENT(IN ) :: BITMAP_INPUT(NPTS_INPUT) LOGICAL(KIND=1), INTENT( OUT) :: BITMAP_OUTPUT(NPTS_OUTPUT) REAL, INTENT(IN ) :: DATA_INPUT(NPTS_INPUT) REAL, INTENT( OUT) :: DATA_OUTPUT(NPTS_OUTPUT) INTEGER :: SCAN_MODE, ISCALE, IP, IPOPT(20) INTEGER :: IBI(1), IBO(1), J, KM, NO REAL :: DLONS REAL, ALLOCATABLE :: OUTPUT_RLAT(:), OUTPUT_RLON(:) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IRET = 0 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! ROUTINE ONLY WORKS FOR ROTATED LAT/LON GRIDS. IF (IGDTNUMI/=1) THEN IRET=1 RETURN ENDIF ! SCAN_MODE=IGDTMPLI(19) IF((SCAN_MODE==68.OR.SCAN_MODE==72).AND.(IDIR<-2.OR.IDIR>-1))THEN IGDTNUMO=IGDTNUMI IGDTMPLO=IGDTMPLI IGDTMPLO(19)=64 IGDTMPLO(8)=IGDTMPLO(8)*2-1 IF((IGDTMPLO(8)*IGDTMPLO(9))/=NPTS_OUTPUT)THEN IRET=3 RETURN ENDIF ISCALE=IGDTMPLO(10)*IGDTMPLO(11) IF(ISCALE==0) ISCALE=10**6 DLONS=FLOAT(IGDTMPLO(17))/FLOAT(ISCALE) DLONS=DLONS*0.5 IGDTMPLO(17)=NINT(DLONS*FLOAT(ISCALE)) ELSEIF(SCAN_MODE==64.AND.IDIR==-1)THEN ! FULL TO H-GRID IGDTNUMO=IGDTNUMI IGDTMPLO=IGDTMPLI IGDTMPLO(19)=68 IGDTMPLO(8)=(IGDTMPLO(8)+1)/2 IF((IGDTMPLO(8)*IGDTMPLO(9))/=NPTS_OUTPUT)THEN IRET=3 RETURN ENDIF ISCALE=IGDTMPLO(10)*IGDTMPLO(11) IF(ISCALE==0) ISCALE=10**6 DLONS=FLOAT(IGDTMPLO(17))/FLOAT(ISCALE) DLONS=DLONS*2.0 IGDTMPLO(17)=NINT(DLONS*FLOAT(ISCALE)) ELSEIF(SCAN_MODE==64.AND.IDIR==-2)THEN ! FULL TO V-GRID IGDTNUMO=IGDTNUMI IGDTMPLO=IGDTMPLI IGDTMPLO(19)=72 IGDTMPLO(8)=(IGDTMPLO(8)+1)/2 IF((IGDTMPLO(8)*IGDTMPLO(9))/=NPTS_OUTPUT)THEN IRET=3 RETURN ENDIF ISCALE=IGDTMPLO(10)*IGDTMPLO(11) IF(ISCALE==0) ISCALE=10**6 DLONS=FLOAT(IGDTMPLO(17))/FLOAT(ISCALE) DLONS=DLONS*2.0 IGDTMPLO(17)=NINT(DLONS*FLOAT(ISCALE)) ELSE IRET=2 RETURN ENDIF KM=1 IP=0 IPOPT=0 IBI=1 IBO=0 ALLOCATE(OUTPUT_RLAT(NPTS_OUTPUT)) ALLOCATE(OUTPUT_RLON(NPTS_OUTPUT)) CALL IPOLATES(IP, IPOPT, IGDTNUMI, IGDTMPLI, IGDTLEN, & IGDTNUMO, IGDTMPLO, IGDTLEN, & NPTS_INPUT, NPTS_OUTPUT, KM, IBI, BITMAP_INPUT, DATA_INPUT, & NO, OUTPUT_RLAT, OUTPUT_RLON, IBO, BITMAP_OUTPUT, DATA_OUTPUT, IRET) DEALLOCATE(OUTPUT_RLAT, OUTPUT_RLON) IF(IRET /= 0)THEN PRINT*,'- PROBLEM IN IPOLATES: ', IRET RETURN ENDIF ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! REPLACE ANY UNDEFINED POINTS ALONG THE LEFT AND RIGHT EDGES. DO J=1, IGDTMPLO(9) BITMAP_OUTPUT(J*IGDTMPLO(8))=BITMAP_OUTPUT(J*IGDTMPLO(8)-1) DATA_OUTPUT(J*IGDTMPLO(8))=DATA_OUTPUT(J*IGDTMPLO(8)-1) BITMAP_OUTPUT((J-1)*IGDTMPLO(8)+1)=BITMAP_OUTPUT((J-1)*IGDTMPLO(8)+2) DATA_OUTPUT((J-1)*IGDTMPLO(8)+1)=DATA_OUTPUT((J-1)*IGDTMPLO(8)+2) ENDDO RETURN ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END SUBROUTINE IPXETAS