SUBROUTINE RDRGWT(KFILDO,KFILWT,WTNAM,IP18,JDATE, 1 IDPARS,IDWT,IDWTPR,IDWTSV,WT,IREG,NXY,NAREA, 2 IPACK,IWORK, 3 IS0,IS1,IS2,IS4,ND7, 4 L3264B,IER) C C JULY 2017 GLAHN MDL MOS-2000 C C PURPOSE C TO READ ALL IREG REGIONAL WEIGHTS FOR A SET OF EQUATIONS C FOR U755. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFILWT - UNIT NUMBER FOR READING EQUATION WEIGHTS FILE. C (INPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFILWT = UNIT NUMBER FOR READING EQUATION WEIGHTS FILE. C MUST BE GE 42 AND LE 44. (INPUT) C WTNAM = NAME OF FILE CORRESPONDING TO KFILWT. C (CHARACTER*60) (INPUT) C IP18 = INDICATES WHETHER (>0) OR NOT (=0) DIAGNOSTIC C INFO WILL BE WRITTEN TO UNIT IP18. (INPUT) C (L=1,KGP) FOR THIS SET. (OUTPUT) C JDATE(J) = NDATE PARSED INTO ITS 4 COMPONENTS: C J=1 IS YYYY C J=2 IS MM C J=3 IS DD C J=4 IS HH C (INPUT) C IDPARS(J) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C VARIABLE ID'S CORRESPONDING TO ID( ,N) C (J=1,15), (N=1,ND4). C J=1--CCC (CLASS OF VARIABLE), C J=2--FFF (SUBCLASS OF VARIABLE), C J=3--B (BINARY INDICATOR), C J=4--DD (DATA SOURCE, MODEL NUMBER), C J=5--V (VERTICAL APPLICATION), C J=6--LBLBLBLB (BOTTOM OF LAYER, 0 IF ONLY C 1 LAYER), C J=7--LTLTLTLT (TOP OF LAYER), C J=8--T (TRANSFORMATION), C J=9--RR (RUN TIME OFFSET, ALWAYS + AND BACK C IN TIME), C J=10--OT (TIME APPLICATION), C J=11--OH (TIME PERIOD IN HOURS), C J=12--TAU (PROJECTION IN HOURS), C J=13--I (INTERPOLATION TYPE), C J=14--S (SMOOTHING INDICATOR), AND C J=15--G (GRID INDICATOR). C (INPUT) C IDWT(J) = FOUR WORD OF GRID RETURNED (J=1,4). (INPUT) C IDWTPR(J) = IDWT( ) PARSED INTO 15 COMPONENTS. (INPUT) C IDWTSV(J) = SET TO IDWT( ) (J=1,4). (OUTPUT) C WT(J) = THE WEIGHT GRID RETURNED (J=1,NXY). (OUTPUT) C IREG = THE REGION NUMBER OF THE GRID RETURNED. C (INPUT) C NXY = THE SIZE OF THE GRID IN WT( ). (INPUT) C NAREA = THE AREA OVER WHICH THE FORECAST IS MADE: C 1 = CONUS, C 2 = ALASKA, C 3 = HAWAII, C 4 = PUERTO RICO. C IPACK(J) = WORK ARRAY (J=1,NXY). C IWORK(J) = WORK ARRAY (J=1,NXY). C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). (OUTPUT) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). (OUTPUT) C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). (OUTPUT) C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). (OUTPUT) C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND IS4( ). C NOT ALL LOCATIONS ARE USED. (INPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C IERX, RDSNAM,CONSTG C CHARACTER*4 STATE CHARACTER*64 WTNAM C DIMENSION WT(NXY,IREG) DIMENSION IDWT(4),IDWTSV(4),LD(4),JDATE(4) DIMENSION IDWTPR(15) DIMENSION IPACK(NXY),IWORK(NXY) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) C CALL TIMPR(KFILDO,KFILDO,'START RDRGWT ') C C UNTIL NECESSARY OTHERWISE, IT IS ASSUMED THE WEIGHT GRID WANTED C DOES NOT VARY BY PROJECTION, SEASON, OR CYCLE. C C VERIFY THE FORECAST CYCLE = 99, MEANING ALL. IF(IDWTPR(6)/100.NE.99)THEN WRITE(KFILDO,110)IDWTPR(6)/100 110 FORMAT(/' ****CYCLE IN ID FOR REGIONAL WEIGHTS NOT 99,', 1 ' BUT =',I4,' STOP IN RDRGWT AT 110.') CALL W3TAGE('RDRGWT') STOP 110 ENDIF C C VERIFY THE SEASON = 19, MEANING ALL. C IF(MOD(IDWTPR(6),100).NE.19)THEN WRITE(KFILDO,120)MOD(IDWTPR(6),100) 120 FORMAT(/' ****SEASON IN ID FOR REGIONAL WEIGHTS NOT 19,', 1 ' BUT =',I4,' STOP IN RDRGWT AT 120.') CALL W3TAGE('RDRGWT') STOP 120 ENDIF C C VERIFY THE PROJECTION = 999, MEANING ALL. C IF(IDWTPR(12).NE.999)THEN WRITE(KFILDO,130)IDWTPR(12) 130 FORMAT(/' ****PROJECTION IN ID FOR REGIONAL WEIGHTS NOT 999,', 1 ' BUT',I4,' STOP IN RDRGWT AT 130.') CALL W3TAGE('RDRGWT') STOP 130 ENDIF C C VERIFY THE DD IN IDPARS( ) IS EQUAL TO THE DD IN IDWTPR( ). C IF(IDPARS(4).NE.IDWTPR(4))THEN WRITE(KFILDO,140)IDPARS(4),IDWTPR(4) 140 FORMAT(/' ****DD IN IDPARS(4) =',I4, 1 ' DOES NOT MATCH DD IN IDWTPR(4) =',I4, 2 ' STOP IN RDRGWT AT 140.') CALL W3TAGE('RDRGWT') STOP 140 ENDIF C C VERIFY THE AREA IN IDWT( ) MATCHES NAREA. C JAREA=IDWTPR(8) C IF(JAREA.NE.NAREA)THEN WRITE(KFILDO,150)JAREA,NAREA 150 FORMAT(/' ****THE AREA IN IDWT =',I4, 1 ' DOES NOT MATCH NAREA =',I4, 2 ' STOP IN RDRGWT AT 150.') CALL W3TAGE('RDRGWT') STOP 150 ENDIF C C READ ALL REGIONAL WEIGHTS. C DO 170 L=1,IREG LD(1)=IDWT(1) LD(2)=(IDWT(2)/100)*100+L LD(3)=IDWT(3) LD(4)=IDWT(4) CALL CONSTG(KFILDO,KFILWT,WTNAM,LD, 1 IPACK,IWORK,WT(1,L),NXY, 2 IS0,IS1,IS2,IS4,ND7, 3 ISTAV,L3264B,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,160)IER 160 FORMAT(' ****ERROR IN CONSTG FROM RDRGWT AT 160. IER =',I4, 2 '. STOP IN RDRGWT AT 160.') CALL W3TAGE('RDRGWT') STOP 160 ELSE WRITE(KFILDO,161)IREG 161 FORMAT(/' SMOOTHING WEIGHTS READ FOR REGION',I4) ENDIF C 170 CONTINUE C END