PROGRAM MODWGTS C$$$ MAIN PROGRAM DOCUMENTATION BLOCK C . . . . C MAIN PROGRAM: WGTMKR MAKE INTERP WGTS FOR PRODUCT GENERATOR C PRGMMR: BALDWIN/BRILL ORG: NP22 DATE: 97-12-01 C C ABSTRACT: AWPRGN PRODUCES FILES THAT HAVE BEEN INTERPOLATED (USING C IPLIB) TO VARIOUS OUTPUT GRIDS WITH OPTIONAL WMO HEADERS. AWPRGN C READS THROUGH A MASTER INPUT GRIB FILE, DETERMINES WHAT GRIDS TO C INTERPOLATE TO, PERFORMS PRE- AND POST-INTERPOLATION SMOOTHING, C PACKS THE DATA INTO GRIB, ADDS A WMO HEADER, THEN WRITES THE C PACKED DATA TO AN OUTPUT FILE. AN INPUT CONTROL FILE DETERMINES C THE OUTPUT GRID NUMBER, WMO HEADER TYPE, OUTPUT FILE NAME, PACKING C PRECISION, AND NUMBER OF PRE- AND POST-INTERPOLATION SMOOTHING C PASSES FOR EACH GRIB FIELD THAT IS DESIRED FOR POSTING. THE C MASTER INPUT GRID SHOULD BE LARGE ENOUGH TO ENCOMPASS ALL OF THE C REQUESTED OUTPUT GRIDS, AND ALSO SHOULD CONTAIN ALL OF THE C GRIB PARAMETERS REQUIRED, SINCE AWPRGN DOES NOT PROVIDE C AND DIAGNOSTIC CALCULATIONS. C C PROGRAM HISTORY LOG: C 97-12-01 BALDWIN, ORIGINATOR C BRILL C C USAGE: MAIN PROGRAM C C INPUT FILES: C C OUTPUT FILES: C C UNIT 51 - INTERPOLATION WEIGHTS C C SUBPROGRAMS CALLED: C UNIQUE: C POLATWGT - COMPUTE INTERPOLATION WEIGHTS C LIBRARY: C W3LIB: W3FI72 C IPLIB: MAKGDS, IPXETAS C SPLIB: (FOR INTERPOLATION) C C EXIT STATES: C COND = 1 - NORMAL EXIT C C ATTRIBUTES: C LANGUAGE: FORTRAN C MACHINE : CRAY J-916 C C$$$ C C INTERP WGTS GENERATOR C C IMAXIN, JJMAXIN ARE MAX DIMENSIONS OF INPUT GRID C IMAXOT, JJMAXOT ARE MAX DIMENSIONS OF OUTPUT GRID C PARAMETER(IMAXIN=350,JJMAXIN=570,JMAXIN=IMAXIN*JJMAXIN) PARAMETER(IMAXOT=550,JJMAXOT=450,JMAXOT=IMAXOT*JJMAXOT) INTEGER KGDSIN(22),KGDSIN2(22),KGDSOUT(22) INTEGER N11(JMAXOT),N21(JMAXOT), & N12(JMAXOT),N22(JMAXOT), & NPP(JMAXOT,25) INTEGER NV11(JMAXOT),NV21(JMAXOT), & NV12(JMAXOT),NV22(JMAXOT) REAL RLAT(JMAXOT),RLON(JMAXOT) REAL CROT(JMAXOT),SROT(JMAXOT) REAL W11(JMAXOT),W21(JMAXOT), & W12(JMAXOT),W22(JMAXOT) REAL WV11(JMAXOT),WV21(JMAXOT), & WV12(JMAXOT),WV22(JMAXOT) REAL C11(JMAXOT),C21(JMAXOT), & C12(JMAXOT),C22(JMAXOT) REAL S11(JMAXOT),S21(JMAXOT), & S12(JMAXOT),S22(JMAXOT) INTEGER KGDSINx(22),KGDSIN2x(22),KGDSOUTx(22) INTEGER N11x(JMAXOT),N21x(JMAXOT), & N12x(JMAXOT),N22x(JMAXOT), & NPPx(JMAXOT,25) INTEGER NV11x(JMAXOT),NV21x(JMAXOT), & NV12x(JMAXOT),NV22x(JMAXOT) REAL RLATx(JMAXOT),RLONx(JMAXOT) REAL CROTx(JMAXOT),SROTx(JMAXOT) REAL W11x(JMAXOT),W21x(JMAXOT), & W12x(JMAXOT),W22x(JMAXOT) REAL WV11x(JMAXOT),WV21x(JMAXOT), & WV12x(JMAXOT),WV22x(JMAXOT) REAL C11x(JMAXOT),C21x(JMAXOT), & C12x(JMAXOT),C22x(JMAXOT) REAL S11x(JMAXOT),S21x(JMAXOT), & S12x(JMAXOT),S22x(JMAXOT) LUNOUT=11 LUNOUTx=12 LUNO=51 C C READ ORIGINAL WEIGHTS C cg216 NOUT=139*107 NOUT=54*47 NO=NOUT C READ(LUNOUT) KGRIDOT,NOUT READ(LUNOUT) (KGDSOUT(I),I=1,22) print *,KGRIDOT,NOU,(KGDSOUT(I),I=1,22) READ(LUNOUT) (N11(I),I=1,NOUT) READ(LUNOUT) (N12(I),I=1,NOUT) READ(LUNOUT) (N21(I),I=1,NOUT) READ(LUNOUT) (N22(I),I=1,NOUT) READ(LUNOUT) (NV11(I),I=1,NOUT) READ(LUNOUT) (NV12(I),I=1,NOUT) READ(LUNOUT) (NV21(I),I=1,NOUT) READ(LUNOUT) (NV22(I),I=1,NOUT) READ(LUNOUT) (C11(I),I=1,NOUT) READ(LUNOUT) (C12(I),I=1,NOUT) READ(LUNOUT) (C21(I),I=1,NOUT) READ(LUNOUT) (C22(I),I=1,NOUT) READ(LUNOUT) (S11(I),I=1,NOUT) READ(LUNOUT) (S12(I),I=1,NOUT) READ(LUNOUT) (S21(I),I=1,NOUT) READ(LUNOUT) (S22(I),I=1,NOUT) READ(LUNOUT) (W11(I),I=1,NOUT) READ(LUNOUT) (W12(I),I=1,NOUT) READ(LUNOUT) (W21(I),I=1,NOUT) READ(LUNOUT) (W22(I),I=1,NOUT) READ(LUNOUT) (WV11(I),I=1,NOUT) READ(LUNOUT) (WV12(I),I=1,NOUT) READ(LUNOUT) (WV21(I),I=1,NOUT) READ(LUNOUT) (WV22(I),I=1,NOUT) READ(LUNOUT) (RLAT(I),I=1,NOUT) READ(LUNOUT) (RLON(I),I=1,NOUT) READ(LUNOUT) (SROT(I),I=1,NOUT) READ(LUNOUT) (CROT(I),I=1,NOUT) READ(LUNOUT) ((NPP(I,J),I=1,NOUT),J=1,25) C C READ OLD WEIGHTS AND PUT ZEROED OUT POINTS IN NEW C WEIGHTS TO REPRODUCE GRIB BIT MAP C READ(LUNOUTx) KGRIDOT,NOUT READ(LUNOUTx) (KGDSOUTx(I),I=1,22) print *,KGRIDOT,NOU,(KGDSOUTx(I),I=1,22) READ(LUNOUTx) (N11x(I),I=1,NOUT) READ(LUNOUTx) (N12x(I),I=1,NOUT) READ(LUNOUTx) (N21x(I),I=1,NOUT) READ(LUNOUTx) (N22x(I),I=1,NOUT) READ(LUNOUTx) (NV11x(I),I=1,NOUT) READ(LUNOUTx) (NV12x(I),I=1,NOUT) READ(LUNOUTx) (NV21x(I),I=1,NOUT) READ(LUNOUTx) (NV22x(I),I=1,NOUT) READ(LUNOUTx) (C11x(I),I=1,NOUT) READ(LUNOUTx) (C12x(I),I=1,NOUT) READ(LUNOUTx) (C21x(I),I=1,NOUT) READ(LUNOUTx) (C22x(I),I=1,NOUT) READ(LUNOUTx) (S11x(I),I=1,NOUT) READ(LUNOUTx) (S12x(I),I=1,NOUT) READ(LUNOUTx) (S21x(I),I=1,NOUT) READ(LUNOUTx) (S22x(I),I=1,NOUT) READ(LUNOUTx) (W11x(I),I=1,NOUT) READ(LUNOUTx) (W12x(I),I=1,NOUT) READ(LUNOUTx) (W21x(I),I=1,NOUT) READ(LUNOUTx) (W22x(I),I=1,NOUT) READ(LUNOUTx) (WV11x(I),I=1,NOUT) READ(LUNOUTx) (WV12x(I),I=1,NOUT) READ(LUNOUTx) (WV21x(I),I=1,NOUT) READ(LUNOUTx) (WV22x(I),I=1,NOUT) READ(LUNOUTx) (RLATx(I),I=1,NOUT) READ(LUNOUTx) (RLONx(I),I=1,NOUT) READ(LUNOUTx) (SROTx(I),I=1,NOUT) READ(LUNOUTx) (CROTx(I),I=1,NOUT) READ(LUNOUTx) ((NPPx(I,J),I=1,NOUT),J=1,25) C DO K = 1, NOUT IF(N11x(K).EQ.0) THEN N11(K) = 0.0 N12(K) = 0.0 N21(K) = 0.0 N22(K) = 0.0 print *,'mass point zeroed out ',nout,rlat(k), & rlon(k) ENDIF IF(NV11x(K).EQ.0) THEN NV11(K) = 0.0 NV12(K) = 0.0 NV21(K) = 0.0 NV22(K) = 0.0 print *,'wind point zeroed out ',nout,rlat(k), & rlon(k) ENDIF C ICOUNT = 0 C DO IC = 1, 25 IF(NPPx(K,IC).EQ.0) ICOUNT = ICOUNT + 1 ENDDO C IF(ICOUNT.GE.13) THEN DO IC = 1,13 NPP(NOUT,IC) = 0 ENDDO print *,'precip zeroed out ',nout,rlat(k), & rlon(k) ENDIF ENDDO C C WRITE OUT MODIFIED WEIGHTS C WRITE(LUNO) KGRIDOT,NOUT WRITE(LUNO) (KGDSOUT(I),I=1,22) WRITE(LUNO) (N11(I),I=1,NOUT) WRITE(LUNO) (N12(I),I=1,NOUT) WRITE(LUNO) (N21(I),I=1,NOUT) WRITE(LUNO) (N22(I),I=1,NOUT) WRITE(LUNO) (NV11(I),I=1,NOUT) WRITE(LUNO) (NV12(I),I=1,NOUT) WRITE(LUNO) (NV21(I),I=1,NOUT) WRITE(LUNO) (NV22(I),I=1,NOUT) WRITE(LUNO) (C11(I),I=1,NOUT) WRITE(LUNO) (C12(I),I=1,NOUT) WRITE(LUNO) (C21(I),I=1,NOUT) WRITE(LUNO) (C22(I),I=1,NOUT) WRITE(LUNO) (S11(I),I=1,NOUT) WRITE(LUNO) (S12(I),I=1,NOUT) WRITE(LUNO) (S21(I),I=1,NOUT) WRITE(LUNO) (S22(I),I=1,NOUT) WRITE(LUNO) (W11(I),I=1,NOUT) WRITE(LUNO) (W12(I),I=1,NOUT) WRITE(LUNO) (W21(I),I=1,NOUT) WRITE(LUNO) (W22(I),I=1,NOUT) WRITE(LUNO) (WV11(I),I=1,NOUT) WRITE(LUNO) (WV12(I),I=1,NOUT) WRITE(LUNO) (WV21(I),I=1,NOUT) WRITE(LUNO) (WV22(I),I=1,NOUT) WRITE(LUNO) (RLAT(I),I=1,NOUT) WRITE(LUNO) (RLON(I),I=1,NOUT) WRITE(LUNO) (SROT(I),I=1,NOUT) WRITE(LUNO) (CROT(I),I=1,NOUT) WRITE(LUNO) ((NPP(I,J),I=1,NOUT),J=1,25) STOP END