SUBROUTINE SETPLN(KFILDO,KFILCP, 1 ID,IDPARS,JD,ISCALD,SMULT,SADD, 2 ORIGIN,CINT,PLAIN,UNITS,ND4,NVRBL,ISTOP,IER) C C APRIL 1998 GLAHN TDL MOS-2000 C MAY 1998 GLAHN CHANGED WHERE GO 200 IS PLACED, AND C ADDED COUNT OF VARIABLES FOUND. C JULY 1998 GLAHN SEARCH MODIFIED FOR AEV VARIABLES C AUGUST 1998 GLAHN "NGM", "ETA", OR "AVN" INSERTED FOR C DD = 6, 7, OR 8 FOR CCC = 2XX C SEPTEMBER 1998 GLAHN ADDED BINARY PREDICTAND ISCALD( ) C APRIL 1999 GLAHN CORRECTED CCC = 2XX DD INSERTION C APRIL 1999 GLAHN ADDED SMOOTHING S2X AND S3X C AUGUST 1999 GLAHN ADDED "MRF" FOR DD = 9 AND DD CHECK C VALUES OF 17, 18, AND 19 FOR BACKUP C APRIL 2000 DALLAVALLE MODIFIED FORMAT STATEMENTS TO C CONFORM TO FORTRAN 90 STANDARDS C ON THE IBM SP C MAY 2000 GLAHN NGM, ETA, AVN, OR MRF WILL BE PLACED C FOR DD = X6, X7, X8, OR X9 FOR CCC=2XX C NOVEMBER 2000 GLAHN DELETED REFERENCE TO SORT16, XCHANG, C FSORT, CKIDS, PRSID, AND BASICP; C COMMENT ADDED IN PURPOSE ABOUT C ISCALD( ) FOR BINARIES C JUNE 2001 DALLAVALLE CHANGED IF TEST TO RETAIN C SCALING FACTOR FOR THRESHOLD C VARIABLES C MAY 2002 GLAHN INCREASED DEFAULT INITIALIZATION OF C PLAIN( ) TO 32 CHARACTERS ABOVE 195 C JULY 2002 GLAHN ADDED TEXT FOR FOURIER OFFSET, C TERRAIN, AND UPSLOPE C SEPTEMBER 2002 GLAHN ADDED LAMP FORECASTS = X5 BELOW 218; C AND NDFD FORECASTS = 84 C OCTOBER 2002 GLAHN CHANGED DD = 84 TO 79 FOR NDFD C FEBRUARY 2003 GLAHN CORRECTION FOR CCC = 010 FOR WRITING C FORMAT 219 AND NOT USING IDPARS(7, ) C AS LEVEL AT FORMATS 205-208 C MARCH 2003 GLAHN ACCOMMODATED SPECIAL CASE CCC=9XX C JUNE 2003 GLAHN ADDED TEST ON CXX = 8XX PUT IN BY C DALLAVALLE IN IBM VERSION JUNE 2001 C JULY 2003 GLAHN UPDATED TREATMENT OF CCC = 409 AND C FOR 005 C AUGUST 2003 GLAHN PUT CLOUD LAYER HEIGHTS IN FRONT OF C BIN CLOUD AMT AND HGT C OCTOBER 2003 GLAHN USED ISCALD( ) = 3 FOR CONSTANTS C (CCC=4XX) ABOVE 209 C NOVEMBER 2003 GLAHN AUGMENTED CLOUD LAYER HEIGHTS IN FRONT C OF BIN CLOUD AMT AND HGT; INSERTED C CEILING HGTS AND TOTAL CLOUD AMOUNT C CATEGORIES C DECEMBER 2003 GLAHN REMOVED WRITE TO FORMAT 2050 C FEBRUARY 2004 GLAHN ACCOMMODATED CXC FOR X = 8 OR 9; C REMOVED REFERENCE TO OBSCURED BIN C MARCH 2004 GLAHN ADDED SCALING = 3 FOR STRATIFICATION C VARIABLES C AUGUST 2004 GLAHN ADDED 40902X C SEPTEMBER 2004 GLAHN CHANGED 409021 TO 005021 C SEPTEMBER 2004 GLAHN PUT MODEL IN PLAIN LANGUAGE PER C IDPARS(4, ) WHEN CCC LE 007 C APRIL 2007 GLAHN ADDED ENS FOR DD=40-76; CHANGED C AVN TO GFS FOR DD=08 AT 215 ONLY C JUNE 2008 GLAHN CHANGED "AND" TO "OR" IN PLACING C LMP FOR DD=5 FOR NON 208XXX; C JUNE 2008 GLAHN MODIFIED FORMATS TO INCLUDE NUMBER C AUGUST 2008 GLAHN AUGMENTED MODEL PLAIN LANG AT 215 C AND 218; COMMENTS C FEBRUARY 2008 GLAHN ADOPTED CCC = 72X FOR HOURLY ANALYSES C AND INSERTED HRY WHEN DD = 85 C APRIL 2009 GLAHN MODS TO NOT OVERRIGHT HEIGHT WITH C MODEL DEFINITION C APRIL 2009 GLAHN MOD TO INSERT "M" FOR "MEAN" AND "PXX" C FOR "XX" PROBABILITY LEVEL FOR EKDMOS C SEPTEMBER 2009 GLAHN MODS FOR SREF MODEL C AUGUST 2012 GLAHN MOD FOR "9" IN "G" POSITION TO EXTEND C "RR" C AUGUST 2012 GLAHN SCREENED OUT FFF = X26 AND X27 FOR C PUTTING IN PROBABILITIES C MARCH 2013 GLAHN IDPARS(8,N) INDICATING ROOTS WILL HAVE C ISCALD(N) INCRASED BY 1; MODIFIED C PURPOSE TO SO REFLECT; REMOVED COMMENT C ABOUT SIMILAR CAPABILITY FOR STANDARD C DEVIATION THAT WAS NOT IN CODE C SEPTEMBER 2014 GLAHN ADDED HRR AND RAP FOR DD = 33 AND 34 C OCTOBER 2014 GLAHN ADDED FOR VIS PROB, LMP, HRR, AND MDL C FOR DD = 51, 52, AND 53, RESPECTIVELY C MLD STANDS FOR MELD OF LAMP AND HRRR C SEPTEMBER 2015 GLAHN ADDED CCC=408 and 407 C APRIL 2016 GLAHN ACCOUNTED FOR VARIABLE CCC = 799 C MAY 2017 GLAHN ADDED HRR FOR 208 060 X 33 C JUNE 2017 GLAHN CHANGED NGM TO MLD FOR CCC = 2XX AND C DD = X6 C C PURPOSE C TO READ PLAIN LANGUAGE AND OTHER INFORMATION ABOUT C THE VARIABLES FROM A FILE, MATCH IT WITH THE VARIABLES, C AND PLACE INTO PLAIN( ), ISCALD( ), SMULT( ), SADD( ), C ORIGIN( ), CINT( ), AND UNITS( ). SOME INSERTIONS ARE C MADE (E.G., B FOR BINARY). WHEN THE VARIABLE IS C LOCATED IN THE LIST, ALL GRID BINARIES ARE GIVEN THE C ISCALD( ) VALUE = 2, AND ALL POINT BINARIES ARE GIVEN THE C ISCALD( ) VALUE = 0 EXCEPT FOR FORECASTS (CCC = 2XX), WHICH C ARE GIVEN ISCALD( ) = 3. THIS CAN BE CHANGED FOR C SPECIFIC VARIABLES BY INSERTING AN EXACT CCCFFFB MATCH C IN THE PLAIN LANGUAGE FILE. NOTE THAT WHEN THE VARIABLE C IS NOT FOUND, THIS SUBSTITUTION FOR BINARIES IS NOT MADE, C AND THE DEFAULT WILL CONTINUE TO BE 0. THE TRANSFORMS C IDPARS(8) = 2, 3, AND 4 ARE ROOTS, AND THE RESULTING C VALUES WILL BE SMALLER THAN THE ORIGINAL DATA WHEN THE C ORIGINAL DATA ARE > 1., SO THE PACKING SCALE FACTOR C WILL BE THAT OF THE BASE VARIABLE PLUS 1. THAT IS, C IF THE PREDICTED VARIABLE IS SCALED TO TENTHS, ITS ROOT C IS SCALED TO HUNDREDTHS. C C WHILE ALL CALLING PROGRAMS MAY NOT NEED ALL OF THIS C INFORMATION, THAT NOT NEEDED CAN BE DISCARDED, AND SETPLN C WILL DO THE JOB FOR ALL PROGRAMS. C C NOTE THAT A MORE SPECIFIC ID SHOULD APPEAR IN THE TABLE C PRIOR TO THE MORE GENERIC. THAT IS, CCCFFFBDD = C 001000006 WILL GET CONSTANTS SPECIFIC TO AN NGM HEIGHT; C 001000007 WILL GET CONSTANTS SPECIFIC TO AN ETA HEIGHT. C IF NEITHER OF THESE "SPECIFIC" IDS ARE PRESENT, THEN C THE GENERIC 001000000 IN THE TABLE WILL BE USED. IF C 001000107 OR 001000507 WERE TO BE PLACED IN THE TABLE, C IT SHOULD BE PRIOR TO THE MORE GENERIC. C C (WHILE SETPLN IS WRITTEN TO DEAL WITH 4-WORD IDS, IT MAY C BE MORE CONVENIENT AS MORE CAPABILITY (MORE CHECKS) IS C ADDED TO DEAL WITH IDPARS( , ) AND TO READ INTO C IDTEMP(15) INSTEAD OF IDTEMP(4).) C C DATA SET USE C KFILDO - DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (OUTPUT) C KFILCP - UNIT NUMBER FROM WHICH TO READ VARIABLE NAMES AND C OTHER ASSOCIATED INFORMATION. IT IS ASSUMED FILE C HAS BEEN OPENED. (INPUT) C C VARIABLES C KFILDO = DEFAULT UNIT NUMBER FOR OUTPUT (PRINT) FILE. C (INPUT) C KFILCP = UNIT NUMBER FROM WHICH TO READ VARIOUS VARIABLE C CONSTANTS AND NAMES. IT IS ASSUMED FILE HAS C BEEN OPENED. (INPUT) C ID(J,N) = THE INTEGER VARIABLE ID'S (J=1,4) (N=1,NVRBL). C (INPUT) C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C VARIABLE ID'S CORRESPONDING TO ID( ,N) (J=1,15), C (N=1,NVRBL). 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 X2 = SREF C X5 = LAMP FORECASTS, C X6 = MOS FROM NGM FORECASTS, C X7 = MOS FROM ETA FORECASTS, C X8 = MOS FROM AVN MODEL FORECASTS C (NOW GFS), C X9 = MOS FROM MRF MODEL FORECASTS, C 51 = LAMP IN LAMP/MERGE C 52 = HRRR IN LAMP/MERGE C 53 = MELD OF LAMP/HRRR IN LAMP/MERGE C 40-75 = INDIVIDUAL ENSEMBLES, ANY MODEL C 74 = MEAN OR OTHER STATISTICS OF SREF C ENSEMBLE MEMBERS C 75 = MEAN OR OTHER STATISTICS OF CANADIAN C ENSEMBLE MEMBERS C 76 = MEAN OR OTHER STATISTICS OF GFS C ENSEMBLE MEMBERS C 77 = SMART TOOL GUIDANCE C 78 = HPC PRODUCTS C 79 = NDFD C 80-83 = AEV DATA C 84 = RTMA C 85 = BCDG HOURLY DATA ANALYSES 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 200 = ENSEMBLE SD C 300 = ENSEMBLE MEAN C 01-100 = PROBABILITY LEVELS OF CDF 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 JD(J,N) = THE BASIC INTEGER VARIABLE ID'S (J=1,4) C THAT SOME PORTIONS PERTAINING TO PROCESSING ARE C OMITTED. JD(1, ) = ID(1, ) EXCEPT C B = IDPARS(3, ) IS OMITTED. THE REST OF C JD( , ) IS DEFINED DIFFERENTLY IN DIFFERENT C PROGRAMS. ONLY JD(1, ) IS USED IN SETPLN. C (INPUT) C ISCALD(N) = THE SCALING CONSTANT TO USE WHEN PACKING THE C INTERPOLATED DATA (N=1,ND4). (OUTPUT) C SMULT(N) = THE MULTIPLICATIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). (OUTPUT) C ARRAY. (OUTPUT) C SADD(N) = THE ADDITIVE FACTOR WHEN CONTOURING OR C GRIDPRINTING THE DATA (N=1,ND4). (OUTPUT) C PLAIN(N) = THE PLAIN LANGUAGE DESCRIPTION OF THE VARIABLES C (N=1,ND4). (CHARACTER*32) (OUTPUT) C UNITS(N) = THE UNITS OF THE DATA THAT APPLY AFTER C MULTIPLYING BY SMULT(N) AND ADDING SADD(N) C (N=1,ND4). (CHARACTER*12) (OUTPUT) C ORIGIN(N) = THE CONTOUR ORIGIN, APPLIES TO THE UNITS IN C UNITS(N) (N=1,ND4). (OUTPUT) C CINT(N) = THE CONTOUR INTERVAL, APPLIES TO THE UNITS IN C UNITS(N) (N=1,ND4). (OUTPUT) C ND4 = MAXIMUM NUMBER OF VARIABLES THAT CAN BE DEALT C WITH IN ONE RUN. SECOND DIMENSION OF ID( , ) C AND IDPARS( , ). (INPUT) C NVRBL = THE NUMBER OF VARIABLES. (INPUT) C ISTOP = INCREASED BY 1 WHENEVER AN ERROR IS ENCOUNTERED. C (INPUT-OUTPUT) C IER = STATUS RETURN. (OUTPUT) C 0 = GOOD RETURN. C IDTEMP(J) = READ FROM VARIABLE CONSTANT FILE (J=1,4). C CORRESPONDS TO ID(J, ) OR JD(J, ) FOR PURPOSES C OF MATCHING INFORMATION FROM THE CONSTANT C FILE WITH THE VARIABLES. (INTERNAL) C PLAINT = PLAIN LANGUAGE TO STORE IN PLAIN( ). C (CHARACTER*32) (INTERNAL) C ISCALT = SCALING PARAMETER TO STORE IN ISCALD( ). C (INTERNAL) C SMULTT = MULTIPLICATIVE FACTOR TO STORE IN SMULT( ). C (INTERNAL) C SADDT = ADDITIVE FACTOR TO STORE IN SADD( ). C (INTERNAL) C CONTT = CONTOUR INTERVAL TO STORE IN CINT( ). C (INTERNAL) C ORIGNT = ORIGIN WHEN CONTOURING TO STORE IN ORIGIN( ). C (INTERNAL) C UNITST = UNITS OF VARIABLE TO STORE IN UNITS( ). C (CHARACTER*12) (INTERNAL) C NERR = COUNTS ERRORS FOR PURPOSES OF KNOWING WHEN TO C PRINT DIAGNOSTICS. (INTERNAL) C JDD(N) = TEMPORARY ARRAY TO KEEP TRACK OF WHICH VARIABLES C IN ID( , ) HAVE BEEN FOUND AND PROCESSED. C (INTERNAL) C NFOUND = KEEPS COUNT OF VARIABLES FOUND SO FILE C MAY NOT HAVE TO BE COMPLETELY READ. C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES CALLED C NONE C CHARACTER*12 UNITS(ND4),UNITST CHARACTER*32 PLAIN(ND4),PLAINT C DIMENSION ID(4,ND4),IDPARS(15,ND4),JD(4,ND4), 1 ISCALD(ND4),SMULT(ND4),SADD(ND4), 2 ORIGIN(ND4),CINT(ND4) DIMENSION JDD(ND4) C NOTE THAT JDD( ) IS AN AUTOMATIC ARRAY. DIMENSION IDTEMP(4) C D CALL TIMPR(KFILDO,KFILDO,'START SETPLN ') IER=0 NFOUND=0 C C SET VALUES TO DEFAULT IN CASE THE VARIABLE IS NOT FOUND C ON THE VARIABLE CONSTANT FILE. ALSO, ZERO THE JDD( ) C ARRAY. C DO 195 N=1,NVRBL ISCALD(N)=0 SMULT(N)=1. SADD(N)=0. PLAIN(N)=' NO VARIABLE MATCH ' UNITS(N)=' ' ORIGIN(N)=0. CINT(N)=5. JDD(N)=0 195 CONTINUE C C READ VARIABLE PLAIN LANGUAGE NAMES, ETC. FROM VARIABLE C CONSTANT FILE AND MATCH WITH THE VARIABLES. IT IS ASSUMED C THE FILE HAS BEEN OPENED. C D WRITE(KFILDO,199)((ID(J,N),J=1,4),N=1,NVRBL) D199 FORMAT(/' PLAIN LANGUAGE VARIABLE INFORMATION TO BE', D 1 ' MATCHED WITH VARIABLES.'/(' ',4I12)) 200 READ(KFILCP,201,IOSTAT=IOS,ERR=202,END=215)(IDTEMP(J),J=1,4), 1 PLAINT,ISCALT,SMULTT,SADDT,CONTT,ORIGNT,UNITST 201 FORMAT(3(I9,1X),I3,2X,A32,I3,F11.4,F10.4,F9.2,F8.2,2X,A12) D WRITE(KFILDO,2010)(IDTEMP(J),J=1,4), D 1 PLAINT,ISCALT,SMULTT,SADDT,CONTT,ORIGNT,UNITST D2010 FORMAT(1X,3(I9,1X),I3,2X,A32,I2,F10.3,F9.3,F9.2,F8.2,2X,A12) GO TO 204 C 202 WRITE(KFILDO,203)IOS 203 FORMAT(/,' **** ERROR READING VARIABLE CONSTANT FILE.', 1 ' IOSTAT=',I5,'. READING OF FILE ABANDONED.') ISTOP=ISTOP+1 GO TO 215 C 204 DO 210 N=1,NVRBL IF(JDD(N).NE.0)GO TO 210 C JDD( ) KEEPS TRACK OF WHICH VARIABLES HAVE BEEN C FOUND AND PROCESSED. C C EXEMPT STRATIFICATION VARIABLES CCC=9XX FROM SEARCH. C IF(IDPARS(1,N)/100.EQ.9)THEN NFOUND=NFOUND+1 JDD(N)=1 ISCALD(N)=3 C BECAUSE OF ITS GENERIC NATURE (SPECIFIC COMBINATIONS C ARE SEARCHED FOR), TO BE SAVE, PACK WITH SCALE = 3. C NORMALLY, THIS WILL NEVER BE USED, BECAUSE THESE C VARIABLES ARE COMPUTED ON THE FLY IN U602, U700, U900. PLAIN(N)=' STRATIFICATION VARIABLE ' GO TO 210 ENDIF C C EXEMPT MATCHING VARIABLE X = 8 OR 9 IN CXC, BUT EXEMPT C THE LOOKBACK VARIABLE 799 FROM THE TEST. C ICXC=(IDPARS(1,N)-(IDPARS(1,N)/100)*100)/10 C IF(ICXC.EQ.8.OR.ICXC.EQ.9.AND.IDPARS(1,N).NE.799)THEN NFOUND=NFOUND+1 JDD(N)=1 PLAIN(N)=' MATCHING VARIABLE ' GO TO 210 ENDIF C C NEVER USE A VARIABLE FROM THE FILE THAT IS A BINARY C UNLESS THE ID(1, ) IS ALSO THE SAME TYPE OF BINARY. C IXY=(IDTEMP(1)-(IDTEMP(1)/1000)*1000)/100 C ISOLATES B IN IDTEMP(1). IF(IXY.NE.0)THEN IF(IDPARS(3,N).NE.IXY)GO TO 210 ENDIF C C CHECK THE FULL ID(1). C IF(IDTEMP(1).EQ.ID(1,N))GO TO 2040 C C CHECK THE FULL ID(1) EXCEPT FOR B. C IF((IDTEMP(1)/1000)*1000+(IDTEMP(1)-(IDTEMP(1)/100)*100).EQ. 1 JD(1,N))GO TO 2040 C C TEST FOR FINE SCALE TERRAIN AND TERRAIN UPSLOPE. THIS C REQUIRES CCCF3F. C IF((IDTEMP(1)/1000000.EQ.409.AND.IDPARS(1,N).EQ.409).OR. 1 (IDTEMP(1)/1000000.EQ.407.AND.IDPARS(1,N).EQ.407).OR. 2 (IDTEMP(1)/1000000.EQ.408.AND.IDPARS(1,N).EQ.408))THEN ICCCFFF=IDTEMP(1)/1000 ICCC=ICCCFFF/1000 IFFF=ICCCFFF-ICCC*1000 C C TEST FOR THE MAP PROJECTION DIGIT. IT MUST BE GE 3. C IF(IFFF/100.GE.3.AND.IDPARS(2,N)/100.GE.3)THEN C C TEST FOR THE UPSLOPE DIGITS. BOTH MUST BE 0 OR BOTH C BE NOT ZERO. C IF(IFFF-(IFFF/10)*10.EQ.0.AND. 1 IDPARS(2,N)-(IDPARS(2,N)/10)*10.EQ.0)GO TO 2040 IF(IFFF-(IFFF/10)*10.NE.0.AND. 1 IDPARS(2,N)-(IDPARS(2,N)/10)*10.NE.0)GO TO 2040 ENDIF C ENDIF C C TEST FOR TERRAIN UPSLOPE WIND. C IF(IDTEMP(1)/1000000.EQ.005.AND.IDPARS(1,N).EQ.005.AND. 1 (IDTEMP(1)-(IDTEMP(1)/1000000)*1000000)/100000.GE.3.AND. 2 IDPARS(2,N)/100.GE.3)GO TO 2040 C THE MAP PROJECTION MUST BE IN THE FIRST DIGIT OF FFF; C 3, 5, AND 7 ARE ACCOMMODATED. C C CHECK THE FIRST ID SANS THE MODEL NUMBER AND BINARY. C HOWEVER, DO THIS CHECK ONLY WHEN DD = 0. C IF(IDTEMP(1)-(IDTEMP(1)/100)*100.NE.0)GO TO 210 C ISOLATES MODEL NUMBER DD IN IDTEMP(1). C IF(IDTEMP(1)/1000.EQ.JD(1,N)/1000)GO TO 2040 C WHEN THE ABOVE TEST IS MET THE FULL CCCFFF IS THE SAME. C IF(IDTEMP(1)/10000000.EQ.JD(1,N)/10000000.AND. 1 IDTEMP(1)/100000000.EQ.3)GO TO 2040 C WHEN THE ABOVE TEST IS MET, THIS IS A COMBINATION OF MODELS, C AND DISCRIMINATION IS MADE ON THE MIDDLE DIGIT OF THE CCC. IF(IDTEMP(1)/1000000.EQ.407.AND.IDPARS(1,N).EQ.407)GO TO 2040 IF(IDTEMP(1)/1000000.EQ.408.AND.IDPARS(1,N).EQ.408)GO TO 2040 GO TO 210 C 2040 NFOUND=NFOUND+1 JDD(N)=1 ISCALD(N)=ISCALT SMULT(N)=SMULTT SADD(N)=SADDT D IXX=(IDTEMP(1)/1000)*1000+(IDTEMP(1)-(IDTEMP(1)/100)*100) D WRITE(KFILDO,2041)N,ID(1,N),IXX,PLAIN(N) D2041 FORMAT(' SETPLN AT 2041, VARIABLE NO.',I4,2I12,2X,A32) PLAIN(N)=PLAINT D WRITE(KFILDO,2041)N,ID(1,N),IXX,PLAIN(N) UNITS(N)=UNITST ORIGIN(N)=ORIGNT CINT(N)=CONTT C C THE FOLLOWING TAKES CARE OF THE AEV ARCHIVE. THE MOS C FORECASTS HAVE A "MODEL NUMBER" OF 80; THE LOCALS C HAVE A MODEL NUMBER OF 81; AND THE OBS HAVE A MODEL C NUMBER OF 82. IN SOME CASES, THE OBS HAVE THE SAME C CCCFFF AS A SIMILAR OB NOT FROM AEV, SO THE MODEL C NUMBER IS LEFT IN THE TABLE. C MODNO=IDTEMP(1)-(IDTEMP(1)/100)*100 C D WRITE(KFILDO,2045)IDTEMP(1),MODNO,ID(1,N),IDPARS(4,N) D2045 FORMAT(' SETPLN AT 2045--IDTEMP(1),MODNO,ID(1,N),IDPARS(4,N)', D 1 4I12) C IF(MODNO.GE.80.AND.MODNO.LE.82)GO TO 2085 C C THE FOLLOWING PUTS CLOUD LAYER HEIGHTS IN FRONT OF C CCC = 008, 708, AND 208 FOR FFF/10 = 35 AND 37 C FROM LLLL AND UUUU FOR DD = X5 AND 0. C IF((IDPARS(1,N).EQ.008.OR. 1 IDPARS(1,N).EQ.708.OR. 2 IDPARS(1,N).EQ.208).AND. 3 (IDPARS(2,N)/10.EQ.35.OR. 4 IDPARS(2,N)/10.EQ.37))THEN C IF((MOD(IDPARS(4,N),10).EQ.5.AND.IDPARS(4,N).LT.40).OR. 1 IDPARS(4,N).EQ.0)THEN C DD = X5 IS LAMP WHEN DD LT 40; 00 IS OBS. C IF(IDPARS(7,N).LT.10)THEN WRITE(PLAIN(N)(1:7),2047,IOSTAT=IOS,ERR=209) 1 IDPARS(6,N),IDPARS(7,N) 2047 FORMAT(I5.1,'-',I1) ELSEIF(IDPARS(7,N).LT.100)THEN WRITE(PLAIN(N)(3:7),2048,IOSTAT=IOS,ERR=209) 1 IDPARS(6,N),IDPARS(7,N) 2048 FORMAT(I2,'-',I2) ELSEIF(IDPARS(6,N).LT.100)THEN WRITE(PLAIN(N)(2:7),2049,IOSTAT=IOS,ERR=209) 1 IDPARS(6,N),IDPARS(7,N) 2049 FORMAT(I2,'-',I3) ELSE WRITE(PLAIN(N)(1:7),205,IOSTAT=IOS,ERR=209) 1 IDPARS(6,N) 205 FORMAT(I3,'-999') ENDIF C IF(IDPARS(3,N).EQ.1)THEN C IF(ID(4,N)/1000.EQ.1500000)THEN PLAIN(N)(20:28)='(CPFSBOX)' C ELSEIF(ID(4,N)/1000.EQ.500000)THEN PLAIN(N)(20:27)='(PFSBOX)' C ELSEIF(ID(4,N)/1000.EQ.150001)THEN PLAIN(N)(20:26)='(FSBOX)' ELSEIF(ID(4,N)/1000.EQ.250001)THEN PLAIN(N)(20:25)='(SBOX)' ELSEIF(ID(4,N)/1000.EQ.450001)THEN PLAIN(N)(20:24)='(BOX)' ELSEIF(ID(4,N)/1000.EQ.750001)THEN PLAIN(N)(20:23)='(OX)' ELSEIF(ID(4,N)/1000.EQ.850001)THEN PLAIN(N)(20:22)='(X)' ENDIF C ELSEIF(IDPARS(3,N).EQ.2)THEN C IF(ID(4,N)/1000.EQ.1500000)THEN PLAIN(N)(20:26)='(U)' ELSEIF(ID(4,N)/1000.EQ.500000)THEN PLAIN(N)(20:22)='(UC)' ELSEIF(ID(4,N)/1000.EQ.250001)THEN PLAIN(N)(20:24)='(UCF)' ELSEIF(ID(4,N)/1000.EQ.450001)THEN PLAIN(N)(20:25)='(UCFS)' ELSEIF(ID(4,N)/1000.EQ.750001)THEN PLAIN(N)(20:26)='(UCFSB)' ENDIF C ELSEIF(IDPARS(3,N).EQ.3.OR.IDPARS(3,N).EQ.0)THEN C IF(ID(4,N)/1000.EQ.1500000)THEN PLAIN(N)(20:22)='(U)' ELSEIF(ID(4,N)/1000.EQ.500000)THEN PLAIN(N)(20:22)='(C)' ELSEIF(ID(4,N)/1000.EQ.150001)THEN PLAIN(N)(20:22)='(P)' ELSEIF(ID(4,N)/1000.EQ.250001)THEN PLAIN(N)(20:22)='(F)' ELSEIF(ID(4,N)/1000.EQ.450001.OR. 1 ID(4,N)/1000.EQ.400001)THEN PLAIN(N)(20:22)='(S)' ELSEIF(ID(4,N)/1000.EQ.750001.OR. 1 ID(4,N)/1000.EQ.700001)THEN PLAIN(N)(20:22)='(B)' ELSEIF(ID(4,N)/1000.EQ.850001.OR. 1 ID(4,N)/1000.EQ.800001)THEN PLAIN(N)(20:22)='(O)' ELSEIF(ID(4,N)/1000.EQ.999904.OR. 1 ID(4,N)/1000.EQ.999905)THEN PLAIN(N)(20:22)='(X)' ENDIF C ENDIF C ENDIF C ENDIF C C THE FOLLOWING TAKES CARE OF THE CASE WHERE ONLY ONE LEVEL C IS INVOLVED AND IT IS NOT THE CLOUD BINS TREATED ABOVE. C THE LEVEL IS ADDED TO THE BASIC DEFINITION C OF THE FIELD IN PLAIN( ). DOES NOT APPLY TO SIN/COS, C CCC = 010. C IF(IDPARS(1,N).NE.010)THEN C C THE FOLLOWING INSERTS CEILING HEIGHTS. C IF(IDPARS(1,N)/100.EQ.2.AND.IDPARS(2,N).EQ.050)THEN C IF(ID(4,N).EQ.150001000)THEN PLAIN(N)(16:25)='(0-100) ' ELSEIF(ID(4,N).EQ.450001000)THEN PLAIN(N)(16:25)='(2-400) ' ELSEIF(ID(4,N).EQ.950001000)THEN PLAIN(N)(16:25)='(5-900) ' ELSEIF(ID(4,N).EQ.195002000)THEN PLAIN(N)(16:25)='(10-1900) ' ELSEIF(ID(4,N).EQ.305002000)THEN PLAIN(N)(16:25)='(20-3000) ' ELSEIF(ID(4,N).EQ.655002000)THEN PLAIN(N)(16:25)='(31-6500) ' ELSEIF(ID(4,N).EQ.120503000)THEN PLAIN(N)(16:25)='(66-12000)' ELSEIF(ID(4,N).EQ.999905000)THEN PLAIN(N)(16:25)='(>12000) ' ELSEIF(ID(4,N).EQ.999995000)THEN PLAIN(N)(16:25)='(>12000) ' ENDIF C C THE FOLLOWING INSERTS SKY COVER CATEGORIES. C ELSEIF(IDPARS(1,N)/100.EQ.2.AND.IDPARS(2,N).EQ.350)THEN C IF(ID(4,N).EQ.150001000)THEN PLAIN(N)(20:26)='(CLR) ' ELSEIF(ID(4,N).EQ.250001000)THEN PLAIN(N)(20:26)='(FEW) ' ELSEIF(ID(4,N).EQ.400001000)THEN PLAIN(N)(20:26)='(SCT) ' ELSEIF(ID(4,N).EQ.700001000)THEN PLAIN(N)(20:26)='(BKN) ' ELSEIF(ID(4,N).EQ.999905000)THEN PLAIN(N)(20:26)='(OVC) ' ELSEIF(ID(4,N).EQ.999995000)THEN PLAIN(N)(20:26)='(OVC) ' ENDIF C ENDIF C IF(IDPARS(5,N).EQ.0.AND.IDPARS(6,N).EQ.0.AND. 1 PLAIN(N)(1:4).EQ.' ')THEN C*** BELOW STATEMENTS REMOVED 12/8/03. WHAT WAS PURPOSE? C*** MESSED UP CLOUD BIN HEIGHTS ABOVE. C*** REINSTATED 4/13/09 WITH ADDITIONAL CHECK. WRITE(PLAIN(N)(1:4),2050,IOSTAT=IOS,ERR=209)IDPARS(7,N) 2050 FORMAT(I4.0) C BECAUSE NO LEADING ZEROS ARE INSERTED, A ZERO WILL C BE INSERTED AS A BLANK. C C THE FOLLOWING TAKES CARE OF THE VERTICAL PROCESSING STEP C WHEN IDPARS(5,N) NE 0. C ELSE IF(IDPARS(5,N).EQ.1)THEN WRITE(PLAIN(N)(1:10),206,IOSTAT=IOS,ERR=209) 1 IDPARS(7,N),IDPARS(6,N) 206 FORMAT(I4,'-',I4,' ') PLAIN(N)(11:32)=PLAINT(6:27) ORIGIN(N)=0. SADD(N)=0. C MOST ORIGIN( )'S WILL BE AT 0. FOR TEMPERATURE, WHEN THE C VALUES ARE IN ABSOLUTE, A CONVENIENT ORIGIN IS -273, BUT C WHEN THE DIFFERENCE IS TAKEN, 0 IS A BETTER VALUE. ELSE IF(IDPARS(5,N).EQ.2)THEN WRITE(PLAIN(N)(1:10),207,IOSTAT=IOS,ERR=209) 1 IDPARS(7,N),IDPARS(6,N) 207 FORMAT(I4,'+',I4,' ') PLAIN(N)(11:32)=PLAINT(6:27) ORIGIN(N)=2.*ORIGIN(N) SADD(N)=2.*SADD(N) C MOST ORIGIN( )'S WILL BE AT 0. FOR TEMPERATURE, WHEN THE C VALUES ARE IN ABSOLUTE, A CONVENIENT ORIGIN IS -273, BUT C WHEN THE SUM IS TAKEN, DOUBLE THAT IS A BETTER VALUE. ELSE IF(IDPARS(5,N).EQ.3)THEN WRITE(PLAIN(N)(1:10),208,IOSTAT=IOS,ERR=209) 1 IDPARS(7,N),IDPARS(6,N) 208 FORMAT(I4,'A',I4,' ') PLAIN(N)(11:32)=PLAINT(6:27) ENDIF C ENDIF C C PUT IN "L" WHEN THERE IS A TIME LAG VARIABLE, C (IDPARS(10, ) NE 0. C IF(IDPARS(10,N).NE.0) 1 WRITE(PLAIN(N)(24:25),2080,IOSTAT=IOS,ERR=209)IDPARS(10,N) 2080 FORMAT('L',I1) C C NOW INSERT VALUES MORE APPROPRIATE FOR GRID BINARIES. C NOTE THAT THE CONTOURING IS DONE AFTER THE GRID BINARY C IS MADE AND SMOOTHING IS DONE. ALSO, NOTE THAT THE ORIGIN C AND CONTOUR INTERVAL ARE IN REFERENCE TO THE ORIGINAL C VALUES, NOT AFTER APPLICATION OF SMULT( ) AND SADD( ). C IF(IDPARS(3,N).NE.5)GO TO 2085 SMULT(N)=100. SADD(N)=0. PLAIN(N)(28:29)='GB' UNITS(N)=' ' ORIGIN(N)=.50 CINT(N)=.25 IF(IDTEMP(1)/100.EQ.ID(1,N)/100)GO TO 210 C WHEN THE ABOVE TEST IS MET THE FULL CCCFFFB IS THE SAME C AND ISCALD IS USED AS READ. OTHERWISE, SET ISCALD( ) = 2 C AS THE DEFAULT FOR THIS GRID BINARY. ISCALD(N)=2 GO TO 210 C C PUT IN POINT BINARY INDICATOR IF NEEDED AND OTHER C VALUES MORE APPROPRIATE FOR POINT BINARIES. C 2085 IF(IDPARS(3,N).EQ.0.OR. 1 IDPARS(3,N).GT.4)GO TO 210 SMULT(N)=1. SADD(N)=0. PLAIN(N)(29:29)='B' UNITS(N)=' ' ORIGIN(N)=.50 CINT(N)=1. C C THE SREF RELATIVE FREQUENCIES OF CATEGORIES OF CEILING C HEIGHT IN HUNDREDS OF FEET AND VISIBILITY IN MILES C HAVE A B = 2, BUT ARE NOT BINARY. SET THE INDICATER TO "RF". C THE UNITS ARE RF. C IF(ID(1,N)/100.EQ.0080702.OR. 1 ID(1,N)/100.EQ.0081302)THEN SMULT(N)=100. PLAIN(N)(28:29)='RF' ORIGIN(N)=.0 CINT(N)=10. C C THE SREF RELATIVE FREQUENCIES OF CATEGORIES OF CEILING C HEIGHT AND VISIBILITY IN METERS HAVE A B = 2, BUT ARE NOT C BINARY. SET THE INDICATER TO "RF". THE UNITS ARE RF X 100. C ELSEIF(ID(1,N)/100.EQ.0080712.OR. 1 ID(1,N)/100.EQ.0081312)THEN SMULT(N)=1. PLAIN(N)(28:29)='RF' ORIGIN(N)=.0 CINT(N)=10. ENDIF C IF(IDTEMP(1)/100.EQ.ID(1,N)/100)GO TO 210 C WHEN THE ABOVE TEST IS MET THE FULL CCCFFFB IS THE SAME C AND ISCALD IS USED AS READ. OTHERWISE, SET ISCALD( ) = 0 C AS THE DEFAULT FOR THIS POINT BINARY, EXCEPT FOR FORECASTS C (CCC = 2XX), WHICH ARE GIVEN ISCALD( ) = 3. NOTE THAT C SINCE THIS IS A POINT (VECTOR) VARIABLE, VARIABLES DEALING C WITH A GRID (E.G., SMULT( )) ARE NOT NEEDED. THE TEST C FOR 8 AND 4 BELOW RETAINS A SCALING FACTOR OF 3 FOR THRESHOLD C VALUES (CCC = 8XX) AND CONSTANTS (CCC = 4XX). C IF((IDTEMP(1)/100000000.EQ.2).OR. 1 (IDTEMP(1)/100000000.EQ.8).OR. 2 (IDTEMP(1)/100000000.EQ.4))THEN ISCALD(N)=3 ELSE ISCALD(N)=0 ENDIF C GO TO 210 C 209 WRITE(KFILDO,2090)IOS 2090 FORMAT(/,' ****ERROR ON INTERNAL WRITE IN SETPLN AT 209', 1 ' IOSTAT=',I5,'. PROCEEDING.') ISTOP=ISTOP+1 210 CONTINUE C C NOTE THAT ALL VARIABLES ARE CHECKED EVEN AFTER A MATCH C IS FOUND BECAUSE THERE MIGHT BE MORE THAN ONE MATCH. IF(NFOUND.LT.NVRBL)GO TO 200 C C NOW INSERT OTHER INDICATORS. C THIS IS A SEPARATE LOOP IN CASE A MATCH WAS C NOT FOUND. IT DOES NOT DEPEND ON THE CONSTANT C FILE, SO CAN BE OUTSIDE THE LOOP ABOVE. C 215 DO 220 N=1,NVRBL C PUT IN MODEL ACCORDING TO DD FOR CCC = 001-008. C (CHANGED FROM 001-007 TO 001-008 9/19/09 FOR SREF C CEILING HEIGHT AND VISIBILITY) C IF(IDPARS(1,N).LE.008.OR.IDPARS(1,N).EQ.799)THEN C THE 799 IS THE LOOKBACK DUMMY; IT WILL HAVE A MODEL C NUMBER. C IF(PLAIN(N)(2:4).EQ.' ')THEN C INSERT ONLY IF BLANK. THIS LEAVES OPTION FOR C SPECIFIC PLAIN LANGUAGE IN THE TABLE. C IF(IDPARS(4,N).EQ.2)THEN PLAIN(N)(2:4)='SRF' ELSEIF(IDPARS(4,N).EQ.5)THEN PLAIN(N)(2:4)='LMP' ELSEIF(IDPARS(4,N).EQ.6)THEN PLAIN(N)(2:4)='NGM' ELSEIF(IDPARS(4,N).EQ.7)THEN PLAIN(N)(2:4)='ETA' ELSEIF(IDPARS(4,N).EQ.8)THEN PLAIN(N)(2:4)='GFS' ELSEIF(IDPARS(4,N).EQ.9)THEN PLAIN(N)(2:4)='MRF' ELSEIF(IDPARS(4,N).GE.40.AND. 1 IDPARS(4,N).LE.76)THEN PLAIN(N)(2:4)='ENS' ELSEIF(IDPARS(4,N).EQ.77)THEN PLAIN(N)(2:4)='SMT' ELSEIF(IDPARS(4,N).EQ.78)THEN PLAIN(N)(2:4)='HPC' ELSEIF(IDPARS(4,N).EQ.79)THEN PLAIN(N)(2:4)='NDF' ELSEIF(IDPARS(4,N).GE.80.AND. 1 IDPARS(4,N).LE.83)THEN PLAIN(N)(2:4)='AEV' ELSEIF(IDPARS(4,N).EQ.84)THEN PLAIN(N)(2:4)='RTM' ELSEIF(IDPARS(4,N).EQ.33)THEN PLAIN(N)(2:4)='HRR' ELSEIF(IDPARS(4,N).EQ.34)THEN PLAIN(N)(2:4)='RAP' ENDIF C ENDIF C ENDIF C C PUT IN 'HRY' FOR HOURLY ANALYSES. ASSUMES CCC = 72X C AND DD = 85. C IF(IDPARS(1,N)/10.EQ.72)THEN C IF(PLAIN(N)(2:4).EQ.' ')THEN C INSERT ONLY IF BLANK. THIS LEAVES OPTION FOR C SPECIFIC PLAIN LANGUAGE IN THE TABLE. C IF(IDPARS(4,N).EQ.85)THEN PLAIN(N)(2:4)='HRY' ENDIF C ENDIF C ENDIF C C PUT IN SMOOTHING INDICATOR IN PLAIN LANGUAGE IF NEEDED. C IF(IDPARS(14,N).EQ.1)THEN PLAIN(N)(30:32)='S5 ' ELSEIF(IDPARS(14,N).EQ.2)THEN PLAIN(N)(30:32)='S9 ' ELSEIF(IDPARS(14,N).EQ.3)THEN PLAIN(N)(30:32)='S25' ELSEIF(IDPARS(14,N).EQ.4)THEN PLAIN(N)(30:32)='S2X' ELSEIF(IDPARS(14,N).EQ.5)THEN PLAIN(N)(30:32)='S3X' ELSEIF(IDPARS(14,N).GE.6)THEN PLAIN(N)(30:32)='???' ENDIF C C PUT IN A "T" IN PLAIN LANGUAGE IF A TRANSFORM IS MADE, C AND ELIMINATE UNITS. C IF(IDPARS(8,N).EQ.0)GO TO 218 IF(IDPARS(15,N).EQ.9)GO TO 218 C A "9" IN THE "G" POSITION OVERRIDES THE "T" AND C IDPARS(8, ) IS PART OF THE RR. (ADDED 8/9/12) PLAIN(N)(27:27)='T' UNITS(N)=' ' C IF(IDPARS(8,N).EQ.2.OR.IDPARS(8,N).EQ.3.OR.IDPARS(8,N).EQ.4)THEN ISCALD(N)=ISCALD(N)+1 C ROOTS OF VALUES ARE SMALLER THAN THE ORIGINAL NUMBERS. C SCALING BY +1 WILL ALLOW REASONABLE RECOVERY OF C ORIGINAL VALUE. LIKELY THIS WILL BE FOR MODEL PRECIP C ORIGINALLY IN MM SCALED TO TENTHS. ENDIF C C PUT A "D1" FOR 1-DIMENSIONAL LINEARIZATION OR A "D2" FOR C 2-DIMENSIONAL LINEARIZATION WHEN NEEDED. THIS IS BASED C ON RANGE OF CCC. C 218 IF(IDPARS(1,N).GE.500.AND.IDPARS(1,N).LE.599)THEN PLAIN(N)(26:27)='D1' ELSEIF(IDPARS(1,N).GE.600.AND.IDPARS(1,N).LE.699)THEN PLAIN(N)(26:27)='D2' C C INSERT "ENS', "NDF", "LMP", "NGM", "ETA", "GFS", "MRF", C OR "SRF" FOR MODEL NUMBERS DD = 40-76, 79, 5, 6, 7, 8, 9, C OR 2, RESPECTIVELY, FOR MOS AND NDFD FORECASTS CCC = 2XX. C ELSEIF(IDPARS(1,N).GE.200.AND.IDPARS(1,N).LE.299)THEN C IF(IDPARS(4,N).EQ.79)THEN PLAIN(N)(2:4)='NDF' ELSEIF(IDPARS(4,N).EQ.51.AND.IDPARS(2,N).EQ.130)THEN PLAIN(N)(2:4)='LMP' ELSEIF(IDPARS(4,N).EQ.52.AND.IDPARS(2,N).EQ.130)THEN PLAIN(N)(2:4)='HRR' ELSEIF(IDPARS(4,N).EQ.53.AND.IDPARS(2,N).EQ.130)THEN PLAIN(N)(2:4)='MLD' ELSEIF(IDPARS(4,N).EQ.53.AND.IDPARS(2,N).EQ.070)THEN PLAIN(N)(2:4)='MLD' ELSEIF(IDPARS(4,N).EQ.53.AND.IDPARS(2,N).EQ.071)THEN PLAIN(N)(2:4)='MLD' ELSEIF(IDPARS(4,N).EQ.51.AND.IDPARS(2,N).EQ.131)THEN PLAIN(N)(2:4)='LMP' ELSEIF(IDPARS(4,N).EQ.52.AND.IDPARS(2,N).EQ.131)THEN PLAIN(N)(2:4)='HRR' ELSEIF(IDPARS(4,N).EQ.33.AND.IDPARS(2,N).EQ.060)THEN PLAIN(N)(2:4)='HRR' ELSEIF(IDPARS(4,N).EQ.53.AND.IDPARS(2,N).EQ.131)THEN PLAIN(N)(2:4)='MLD' ELSEIF(IDPARS(4,N).GE.40.AND.IDPARS(4,N).LE.76)THEN PLAIN(N)(2:4)='ENS' ELSEIF(IDPARS(4,N)-(IDPARS(4,N)/10)*10.EQ.2)THEN PLAIN(N)(2:4)='SRF' ELSEIF(IDPARS(4,N)-(IDPARS(4,N)/10)*10.EQ.5)THEN C IF(IDPARS(1,N).NE.208.OR.(IDPARS(2,N)/10.NE.35.AND. 1 IDPARS(2,N)/10.NE.37))THEN C INFORMATION ON CLOUD LAYERS HAS BEEN PLACED C WHEN CCCFFF = 20835X AND 20837X. PLAIN(N)(2:4)='LMP' ENDIF C ELSEIF(IDPARS(4,N)-(IDPARS(4,N)/10)*10.EQ.6)THEN CCCCC PLAIN(N)(2:4)='NGM' PLAIN(N)(2:4)='MLD' ELSEIF(IDPARS(4,N)-(IDPARS(4,N)/10)*10.EQ.7)THEN PLAIN(N)(2:4)='ETA' ELSEIF(IDPARS(4,N)-(IDPARS(4,N)/10)*10.EQ.8)THEN PLAIN(N)(2:4)='GFS' ELSEIF(IDPARS(4,N)-(IDPARS(4,N)/10)*10.EQ.9)THEN PLAIN(N)(2:4)='MRF' ENDIF C C INSERT "M" FOR "MEAN" AND "PXX" FOR "XX" PROBABILITY C LEVEL FOR EKDMOS. C LPROB=IDPARS(6,N)-(IDPARS(6,N)/100)*100 C IF(IDPARS(2,N)-(IDPARS(2,N)/100)*100.NE.26.AND. 1 IDPARS(2,N)-(IDPARS(2,N)/100)*100.NE.27)THEN C RUNNING AVERAGES HAVE IDPARS(2) = 26 AND 27, AND ARE C NOT EKD MOS, BUT HAVE NUMBER OF DAYS IN IDPARS(6, ). C IF(IDPARS(6,N)/100.EQ.3)THEN PLAIN(N)(30:30)='M' ELSEIF(LPROB.GT.0.AND.LPROB.LE.99)THEN PLAIN(N)(30:30)='P' WRITE(PLAIN(N)(31:32),2183,IOSTAT=IOS,ERR=2190)LPROB 2183 FORMAT(I2.2) ENDIF C ENDIF C C PLACE TERRAIN RELATED PARAMETERS FOR CCC = 409, 408, and c 407. NOTE THAT FFF = XFF FOR ONLY X = 0, 3, 5, AND 7 ARE C ACCOMMODATED. C ELSEIF(IDPARS(1,N).EQ.409.OR. 1 IDPARS(1,N).EQ.408.OR. 2 IDPARS(1,N).EQ.407)THEN IMAP=IDPARS(2,N)/100 IMESH=IDPARS(2,N)/10-IMAP*10 ISLOP=IDPARS(2,N)-IMAP*100-IMESH*10 C PLAIN(N)(26:26)='C' C C THE TESTS BELOW ARE FOR THE LAMP TERRAIN AND ITS C CHANGE. THAT IS, THE CHANGE BETWEEN WHERE THE C TRAJECTORY CAME FROM AND THE FINAL LOCATION. C FFF = 02X IS ACCOMMODATED, WHERE X = 0,7. C IF(IMAP.EQ.0)THEN C IF(IMESH.EQ.2)THEN C IF(ISLOP.EQ.0)THEN PLAIN(N)(6:25)='TERR HGT127 95KM ' ENDIF C ENDIF C C THE TESTS BELOW ARE FOR THE FINE SCALE TERRAIN TO WHICH THE C PARAMETERS IN FFF = XYZ APPLY. THIS TERRAIN IS NOT C ASSOCIATED WITH A PARTICULAR MODEL C ELSEIF(IMAP.EQ.3)THEN PLAIN(N)(24:25)='LM' ELSEIF(IMAP.EQ.5)THEN PLAIN(N)(24:25)='PS' ELSEIF(IMAP.EQ.7)THEN PLAIN(N)(24:25)='MC' ELSEIF(IMAP.GE.3)THEN PLAIN(N)(24:25)='??' ENDIF C C THE TESTS BELOW PLACE THE MESH LENGTH IN TERMS OF BEDIENTS. C IMAP VALUES OF 0, 1, AND 2 ARE AVAILABLE FOR OTHER USES. C IF(IMAP.GE.3)THEN C IF(IMESH.EQ.0)THEN PLAIN(N)(17:22)=' 1/4B' ELSEIF(IMESH.EQ.1)THEN PLAIN(N)(17:22)=' 1/8B' ELSEIF(IMESH.EQ.2)THEN PLAIN(N)(17:22)=' 1/16B' ELSEIF(IMESH.EQ.3)THEN PLAIN(N)(17:22)=' 1/32B' ELSEIF(IMESH.EQ.4)THEN PLAIN(N)(17:22)=' 1/64B' ELSEIF(IMESH.EQ.5)THEN PLAIN(N)(17:22)='1/128B' ELSEIF(IMESH.EQ.6)THEN PLAIN(N)(17:22)='1/256B' ELSEIF(IMESH.GE.7)THEN PLAIN(N)(17:22)=' ???B' ENDIF C ENDIF C C THE TESTS BELOW ARE FOR THE SLOPE DESIGNATORS ISLOP = 1 C FOR WEST AND 2 FOR SOUTH, POSITIVELY ORIENTED THAT WAY C (THE SAME AS FOR METEOROLOGICAL WIND CONVENTION). C DOES NOT APPLY TO 40902X. C IF(IMAP.NE.0.AND. 1 (IDPARS(1,N).NE.408.AND.IDPARS(1,N).NE.407))THEN C THIS DOES NOT PERTAIN TO FFF = 407 OR 408. C IF(ISLOP.EQ.1)THEN PLAIN(N)(14:15)='WS' ELSEIF(ISLOP.EQ.2)THEN PLAIN(N)(14:15)='SS' ELSEIF(ISLOP.GE.3)THEN PLAIN(N)(14:15)='??' ENDIF C ENDIF C C PLACE UPSLOPE RELATED PARAMETERS. NOTE THAT THIS APPLIES C TO ONLY THE FFF = XYZ FINE SCALE GRIDS. THE FIRST C 3 LOCATIONS ARE NOT FILLED WITH "NDF" LIKE THEY ARE C WITH TERRAIN (BUT COULD EASILY BE). C ELSEIF(IDPARS(1,N).EQ.005)THEN IMAP=IDPARS(2,N)/100 IMESH=IDPARS(2,N)/10-IMAP*10 ISMTH=IDPARS(2,N)-IMAP*100-IMESH*10 C IF(IMAP.EQ.0)THEN C IF(IMESH.EQ.2)THEN C IF(ISMTH.EQ.1)THEN IHR=IDPARS(12,N) C IF(IHR.EQ.0)THEN PLAIN(N)(6:25)='TERR HGT 95KM CHANGE' ELSE PLAIN(N)(6:26)='TERR HGT 95KM -H CH' WRITE(PLAIN(N)(20:21),2185,IOSTAT=IOS,ERR=2190)IHR 2185 FORMAT(I2) ENDIF C ENDIF C ENDIF ELSEIF(IMAP.GE.3)THEN C IF(IMAP.EQ.3)THEN PLAIN(N)(20:21)='LM' ELSEIF(IMAP.EQ.5)THEN PLAIN(N)(20:21)='PS' ELSEIF(IMAP.EQ.7)THEN PLAIN(N)(20:21)='MC' ELSEIF(IMAP.GE.3)THEN PLAIN(N)(20:21)='??' ENDIF C IF(IMESH.EQ.0)THEN PLAIN(N)(13:18)=' 1/4B' ELSEIF(IMESH.EQ.1)THEN PLAIN(N)(13:18)=' 1/8B' ELSEIF(IMESH.EQ.2)THEN PLAIN(N)(13:18)=' 1/16B' ELSEIF(IMESH.EQ.3)THEN PLAIN(N)(13:18)=' 1/32B' ELSEIF(IMESH.EQ.4)THEN PLAIN(N)(13:18)=' 1/64B' ELSEIF(IMESH.EQ.5)THEN PLAIN(N)(13:18)='1/128B' ELSEIF(IMESH.EQ.6)THEN PLAIN(N)(13:18)='1/256B' ELSEIF(IMESH.GE.7)THEN PLAIN(N)(13:18)=' ???B' ENDIF C IF(ISMTH.EQ.1.OR.ISMTH.EQ.6)THEN PLAIN(N)(23:28)='WS5 ' ELSEIF(ISMTH.EQ.2.OR.ISMTH.EQ.7)THEN PLAIN(N)(23:28)='WS9 ' ELSEIF(ISMTH.EQ.3.OR.ISMTH.EQ.8)THEN PLAIN(N)(23:28)='WS25 ' ELSEIF(ISMTH.EQ.4.OR.ISMTH.EQ.9)THEN PLAIN(N)(23:28)='WS25*2' ENDIF C ENDIF C C PUT A "C" FOR "CONSTANT" DATA WHEN NEEDED. THIS IS BASED C ON A RANGE OF CCC. MUST BE BELOW USE OF CCC = 409 ABOVE. C ELSEIF(IDPARS(1,N).GE.400.AND.IDPARS(1,N).LE.499)THEN C NOTE THE LT 499 (NOT LE) TO ADAPT TO CCC = 499 IN C U171 TO SIGNIFY NO STRATIFICATION VARIABLE. PLAIN(N)(26:26)='C' C C PLACE SINE/COSINE OFFSET. C ELSEIF(IDPARS(1,N).EQ.010)THEN C IF(IDPARS(7,N).NE.0)THEN PLAIN(N)(22:30)='+ DAYS' WRITE(PLAIN(N)(23:25),219,IOSTAT=IOS,ERR=2190)IDPARS(7,N) 219 FORMAT(I3) ENDIF C ENDIF C GO TO 220 C 2190 WRITE(KFILDO,2191)IOS 2191 FORMAT(/,' ****ERROR ON INTERNAL WRITE IN SETPLN AT 2190', 1 ' IOSTAT=',I5,'. PROCEEDING.') ISTOP=ISTOP+1 220 CONTINUE C IF(NFOUND.LT.NVRBL)THEN WRITE(KFILDO,221)NFOUND,NVRBL,KFILCP 221 FORMAT(/,' ****ONLY',I4,' OF THE',I4,' VARIABLES ', 1 'IDENTIFIED IN CONSTANT FILE ON UNIT NO.',I3,'.') ISTOP=ISTOP+1 ENDIF C RETURN END