SUBROUTINE AWND15M(KFILDO,KFIL10,KFILOG,IP16,IP22,I4XXDG, 1 NDATE,IBACKN,U10,V10,U51,V51,U,V,FD9,ND2X3, 2 NCEPNO,LAMPNO,NPROJ,ORIENT,XLAT, 3 NXL,NYL,NXPL,NYPL,ALATL,ALONL, 4 MESHB,MESHLD,IOPT, 5 CAFSM,IDWND,COMB,IWCOMB,LCOMBO, 6 NX,NY,NXP,NYP,MESHW,ITRPLQ,NPROJH, 7 LSTORE,ND9,LITEMS, 8 IS0,IS1,IS2,IS4,ND7, 9 DATA,IPACK,IWORK,ND5,MINPK, A CORE,ND10,NBLOCK,NFETCH,MISTOT, B JTOTBY,JTOTRC, C L3264B,L3264W,ISTOP,IER) C C OCTOBER 2001 GLAHN TDL LAMP-2000 C ADAPTED FOR CLAM FROM ADVWND C DECEMBER 2001 GLAHN CHANGED MESH TO MESHW C DECEMBER 2001 GLAHN ELIMINATED WRITING HEIGHTS C TO INTERNAL STORAGE C JANUARY 2002 GLAHN ADDED LASTMS TO CALL C APRIL 2002 GLAHN REPLACED MESHW WITH XMENHW IN C COMPUTATION OF POL2EQ AND CONST C MAY 2002 GLAHN CORRECTED CALL TO MSHXMS C MAY 2002 GLAHN CHANGED MESHW TO MESHLD IN C CALCULATION OF RATIO C JUNE 2002 GLAHN MODIFIED TO SMOOTH ON EITHER A C 1 OR 1/2 BEDIENT GRID INSTEAD C OF A 1/2 OR 1/4 C JUNE 2002 GHIRARDELLI MODIFIED TO WRITE OUT ADDITIONAL C GRIDS, SUCH AS THE MAP SCALE FACTOR, C AND THE ADVECTIVE WINDS IN M/S, TO THE C DISPOSABLE GRID FILE. C JULY 2002 GHIRARDELLI MODIFIED TO USE AVN MODEL WINDS C INSTEAD OF GEOSTROPHIC LAMP OR AVN C WINDS ALSO REMOVED SINPHI AND LASTMS C SEPTEMBER 2002 GHIRARDELLI MODIFIED TO PACK INTERMEDIATE C WINDS WITH NDATE INSTEAD OF JDATE C NOVEMBER 2002 GHIRARDELLI MODIFIED TO FIX THE IBACKN C FEATURE. IT WAS GOING BACK 0 HOURS, C THEN 6 HOURS, THEN 12 HOURS FROM THE C LAST CHECKED DATE INSTEAD OF FROM C THE ORIGINAL NCEP DATE C NOVEMBER 2002 GHIRARDELLI MODIFIED THE "BASE" IDS FOR THE C INTERMEDIATE WINDS (LSTIUID AND C LSTIVID). THESE IDS AS PREVIOUSLY C DESIGNED, WOULD HAVE OVERLAPPED WITH C THE IDS FOR THE FINAL ADVECTIVE WINDS C IF THE USER RAN WITH MORE THAN C 10 COMBOS OF WINDS C NOVEMBER 2002 GHIRARDELLI CHANGED THE SMOOTHING FROM THE C 25 POINT SMOOTHER TO THE 5 POINT C SMOOTHER C DECEMBER 2002 GLAHN ELIMINATED AUTOMATIC ARRAYS FDMS( ) C AND FDSINS( ), AND CREATED ALLOCATABLE C FDMS( ); COMMENTS TO 72 CHARACTERS C DECEMBER 2002 GLAHN MODIFIED TO WRITE INTERPOLATED C WINDS WITH GETFLD1; ELIMINATED C MINPKD; WRITING ADVECTIVE WINDS C WITH A LARGE GROUP SIZE; REMOVED C IF TEST ABOVE 335 AND 435 LOOPS C DECEMBER 2002 RUDACK MODIFIED FORMAT STATEMENTS TO ADHERE C TO THE F90 COMPILER STANDARDS FOUND ON C THE IBM SYSTEM C FEBRUARY 2003 GLAHN MADE IBACKN COMMENT THE SAME AS IN C FIRST GUESS ROUTINES; SPELL CHECK C JULY 2003 GLAHN CHANGED WHERE IFIRST IS UPDATED C AUGUST 2012 RUDACK ADDED AN ADDITIONAL PLAIN LANGUAGE C CHARACTER VARIABLE TO THE CALLING C ARGUMENT LIST FOR SUBROUTINE "PAWING." C THIS MODIFICATION WAS NECESSARY TO C KEEP PACE WITH CHANGES MADE BY THE MOS C GROUP TO SUBROUTINE "PAWING." C MARCH 2024 SAMPLATSKY THIS COPY OF AWND OPERATES ON C 15 MINUTE TIME STEPS INSTEAD OF ONE C HOUR. NAME CHANGED TO AWND15M. C C PURPOSE C TO COMPUTE THE ADVECTIVE WINDS FOR THE CLAM MODEL. C ADAPTED FROM A354 AND CALLED ROUTINES. COMPUTES ONLY C AS MANY WINDS AS WILL BE NEEDED FOR THE PROJECTIONS C CALCULATED. GRIDDED OUTPUT IS TO THE INTERNAL RANDOM C ACCESS FILE AND TO THE DISPOSABLE FILE AS DESIRED. C C NCEP GRIDS HAVE DD = NCEPNO. WHEN NCEP GRIDS ARE C WRITTEN WITH PAWING TO INTERNAL STORAGE OR WITH PATOTG C TO UNIT KFILOG, THEY ARE WRITTEN WITH DD = NCEPNO, C DATE/TIME = JDATE, AND TAU EQUAL TO THE NCEP TAU; THIS C HAPPENS IF ONLY TIME INTERPOLATION OR TRANSFER TO ANOTHER C GRID IS DONE. IF OTHER PROCESSING, NAMELY SMOOTHING, C IS DONE, THE RESULTING GRIDS ARE WRITTEN WITH DD = LAMPNO, C DATE/TIME = NDATE, THE PROPER SMOOTHING PARAMETER, C AND THE LAMP TAU. RAW GRIDS ACCESSED THROUGH GETFLD1 C ARE WRITTEN TO THE INTERNAL STORAGE SYSTEM IF THEY C DO NOT ALREADY EXIST AND TO THE DISPOSABLE FILE AND C ARE GRIDPRINTED AS DESIRED. THE SMOOTHED FIELDS ARE C NOT WRITTEN ANYWHERE. C C THE NCEP GRIDS ARE INITIALLY AVAILABLE ONLY FOR C PROJECTIONS EVERY 3 HOURS. WHEN ACCESSING THE GRIDS, c THE NEEDED HOUR IS SEARCHED FOR FIRST; WHEN FOUND, c IT IS USED. WHEN NOT FOUND, TWO NCEP GRIDS MUST BE c ACCESSED AND INTERPOLATION DONE. THE INTERPOLATED C GRID IS WRITTEN TO INTERNAL STORAGE WITH GETFLD1, C STILL ON THE NCEP GRID. C C (IN THE OLDER VERSION, AVSLY IN A451 READS 500-MB C AND 1000 MB HEIGHTS, EVIDENTLY ON A 1/4 BEDIENT GRID. C IT SEEMS THE 500 MB HEIGHTS ARE NOT SMOOTHED AND THE C 1000 MB HEIGHTS ARE SMOOTHED ON 25 POINTS ON A C 1/4 BEDIENT GRID. THIS FORMULATION IS EVIDENTLY FOR C BOTH THE SLYH AND CLAM MODELS. GENERALLY,THE HARDCOPY C DOCUMENTATION JUST SAYS THE WINDS ARE COMPUTED FROM C GEOSTROPHIC 500 AND 1000 MB WINDS, BUT IN ONE PLACE C IT STATES THE 1000 MB WINDS ARE SMOOTHED [GLAHN AND C UNGER, MWR 114, P 1320] BUT DOESN'T SAY HOW MUCH.) C C CAFSM(J) IS THE NUMBER OF TIMES THE NCEP WINDS ARE C SMOOTHED ON A 1-BEDIENT GRID FOR PURPOSES OF COMPUTING C ADVECTING WINDS (J=5-8). AS AN ADDED FEATURE C IF CAFSM(J) GE 10, THEN THE NUMBER OF SMOOTHINGS = C CAFSM(J)-10 AND APPLIES TO A 1/2 BEDIENT GRID. C C CALLED SUBROUTINE UVWND WILL REDUCE STRONG WINDS C ACCORDING TO CFILTX = CAFSM(10). C C IF NO ON-TIME FIELDS ARE AVAILABLE, IBACKN CYCLES AT C 6-HOURLY INCREMENTS ARE TRIED. IF A PORTION OF FIELDS C IS AVAILABLE, BUT NOT ALL, THE ADVECTING WINDS CAN C COME FROM TW0 (OR MORE DEPENDING ON IBACKN) DIFFERENT C RUNS. THIS IS UNLIKELY, AND THE DAMAGE WOULD PROBABLY C BE SLIGHT, ESPECIALLY BECAUSE OF THE USUAL SMOOTHING. C BECAUSE OF THE ORDER ACCESSED, THE FIRST FIELDS WOULD C BE FROM THE 1ST AVAILABLE RUN, AND THE LATTER ONES FROM C AN OLDER RUN. NOTE THAT ONCE THE SWITCH IN RUN TIME C IS MADE, THE SWITCH IS NOT MADE BACK. THAT IS, ONE C MISSING NEEDED FIELD COULD CAUSE A PERMANENT SWITCH. C C FOR INTERNAL STORAGE, TO KEEP CP TIME TO A MINIMUM, C ONE LARGE GROUP IS USED IN PACKING; FOR WRITING TO C EXTERNAL FILES, MINPK IS USED AS THE GROUP SIZE. C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFIL10 - UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT/OUTPUT) C KFILOG - UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. (OUTPUT) C IP16 - UNIT NUMBER FOR INDICATING WHEN A RECORD IS C WRITTEN TO THE SEQUENTIAL FILE. (OUTPUT) C IP22 - UNIT NUMBER FOR GRIDPRINTING. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C KFIL10 = UNIT NUMBER FOR INTERNAL RANDOM ACCESS STORAGE. C (INPUT) C KFILOG = UNIT NUMBER FOR DISPOSABLE TDLPACK GRIDPOINT C OUTPUT. THIS IS FOR DIFFERENT PASSES OF THE C ANALYSES AND THEIR SMOOTHINGS. (INPUT) C IP16 = INDICATES WHETHER (>0) OR NOT (=0) C A STATEMENT WILL BE OUTPUT TO IP16 C WHEN A SEQUENTIAL FILE IS WRITTEN THROUGH C PAWOTG. (INPUT) C IP22 = UNIT NUMBER FOR GRIDPRINTING. (INPUT) C I4XXDG = 1 = DISPOSABLE GRIDS ARE TO BE WRITTEN TO C FILE KFILOG; 0 OTHERWISE. THESE ARE WRITTEN C TO THE SUBSETTED AREA. (INPUT) C NDATE = THE DATE/TIME OF THE RUN. (INPUT) C IBACKN = NUMBER OF 6-H CYCLES TO LOOK BACK FOR NCEP C FORECAST (IBACKN = 1 MEANS CURRENT (MOST C RECENT) CYCLE PLUS THE ONE 6 HOURS BEFORE). C (INPUT) C U10(J) = WEIGHTED AND SUMMED U WINDS (J=1,NX*NY). C THEY ARE CONSIDERED INTERMEDIATE WINDS USED C ONLY FOR PRINTING TO THE DISPOSABLE GRID. THEY C ARE GRID-ORIENTED, SMOOTHED (IF DESIRED), C AVERAGED AS INDICATED IN U454 CN FILES, AND IN C UNITS OF M/S. THEY ARE BASICALLY THE ADVECTIVE C WINDS, IN UNITS THAT GEMPAK CAN PROCESS. C FOR CHECKOUT ONLY. (INTERNAL) C V10(J) = WEIGHTED AND SUMMED V WINDS (J=1,NX*NY). SEE C U10 ABOVE FOR A FULL DESCRIPTION. (INTERNAL) C U51(J) = WORK ARRAY (J=1,N*NY). U WINDS ARE C INTERPOLATED LINEARLY AS NEEDED FROM THE C PROJECTIONS AVAILABLE (IN GETFLD1) AND WRITTEN C TO MOS-2000 INTERNAL STORAGE. (INTERNAL) C V51(J) = WORK ARRAY (J=1,N*NY). V WINDS ARE C INTERPOLATED LINEARLY AS NEEDED FROM THE C PROJECTIONS AVAILABLE (IN GETFLD1) AND WRITTEN C TO MOS-2000 INTERNAL STORAGE. (INTERNAL) C U(J), V(J) = WINDS IN GRID UNITS PER HALF HOUR C (J=1,NX*NY). COMPUTED FROM WEIGHTED AND SUMMED C MODEL WINDS. (INTERNAL) C FD9(J) = WORK ARRAY (J=1,ND2X3). (INTERNAL) C ND2X3 = THE DIMENSION OF SEVERAL ARRAYS = ND2*ND3 IN C DRIVER. (INPUT) C NCEPNO = EXPECTED NCEP INPUT MODEL NUMBER. (INPUT) C LAMPNO = LAMP OUTPUT MODEL NUMBER AND EXPECTED LAMP C INPUT MODEL NUMBER. (INPUT) C NPROJ = NUMBER OF MAP PROJECTION TO WHICH THIS GRID C APPLIES. C 5 = POLAR STEREOGRAPHIC. C (INPUT) C ORIENT = ORIENTATION OF GRID IN WEST LONGITUDE. (INPUT) C XLAT = NORTH LATITUDE AT WHICH GRIDLENGTH IS SPECIFIED C IN DEGREES. (INPUT) C NXL = THE SIZE OF THE PRIMARY GRID FOR THIS RUN C IN THE X DIRECTION IN 1/B BEDIENT UNITS. C NYL = THE SIZE OF THE PRIMARY GRID FOR THIS RUN C IN THE Y DIRECTION IN 1/B BEDIENT UNITS. C NXPL = POLE POSITION OF THE PRIMARY GRID FOR THIS RUN C IN RELATION TO LOWER LEFT CORNER OF GRID AT C (1,1) IN THE X DIRECTION IN 1/B BEDIENT UNITS. C NYPL = POLE POSITION OF THE PRIMARY GRID FOR THIS RUN C IN RELATION TO LOWER LEFT CORNER OF GRID AT C (1,1) IN THE Y DIRECTION IN 1/B BEDIENT UNITS. C ALATL = NORTH LATITUDE IN DEGREES OF LOWER LEFT CORNER C POINT OF A 1/4 B GRID OF THE SIZE ETC. C SPECIFIED BY NXL, NYL, NXPL, AND NYPL. (INPUT) C ALONL = WEST LONGITUDE OF IN DEGREES OF LOWER LEFT C CORNER POINT OF A 1/4 B GRID OF THE SIZE ETC. C SPECIFIED BY NXL, NYL, NXPL, AND NYPL. (INPUT) C MESHB = THE NOMINAL MESH LENGTH OF 1/4 BEDIENT GRID. C 1/4 BEDIENT AT 60 N IS 95.25 KM WHICH IS ABOUT C 80 KM OVER THE U.S. MESH = 80 CORRESPONDS TO C 95.25 STORED WITH THE GRIDS. NXL, NYL, ETC. C ARE IN RELATION TO THIS. C MESHLD = NOMINAL MESH LENGTH OF QUALITY CONTROL C (SUBSETTED) GRID FOR EITHER CONTINUOUS OR C DISCONTINUOUS VARIABLES, DEPENDING ON INPUT. C (INPUT) C IOPT(J) = SUBSETTING VALUES USED IN GRIDPRINTING (J=1,8) C IN RELATION TO THE SUBSETTED AREA MESH LENGTH C MESHLD. (INPUT) C CAFSM(J) = VALUES PERTAINING TO VARIABLE BEING PROCESSED: C J = 1--WEIGHTING FOR NCEP 1000-MB WINDS C J = 2--WEIGHTING FOR NCEP 850-MB WINDS C J = 3--WEIGHTING FOR NCEP 700-MB WINDS C J = 4--WEIGHTING FOR NCEP 500-MB WINDS C J = 5--SMOOTHING FACTOR FOR NCEP 1000-MB WINDS C J = 6--SMOOTHING FACTOR FOR NCEP 850-MB WINDS C J = 7--SMOOTHING FACTOR FOR NCEP 700-MB WINDS C J = 8--SMOOTHING FACTOR FOR NCEP 500-MB WINDS C J = 9--MESH LENGTH FOR WIND COMPUTATION, MESHW C J = 10--CFILTX = THE FRACTION OF THE SPEED C REDUCTION OF HIGH WINDS TO APPLY. C FOR FULL APPLICATION, CFILTX = 1. C FOR NO REDUCTION, CFILTX = 0. C (INPUT) C IDWND(J) = ID FOR THE ADVECTIVE U-WIND (J=1) AND V-WIND C (J=2) RETURNED. (OUTPUT) C COMB(J,L) = THE COMBINATIONS OF CHARACTERISTICS FOR WHICH C WINDS ARE COMPUTED (J=1,10) (L=1,20). SEE C CAFSM(J) FOR DESCRIPTION OF THE 10 ELEMENTS. C 20 COMBINATIONS ARE PROVIDED FOR. (OUTPUT) C IWCOMB(J,L) = THE U (J=1) AND V (J=2) ADVECTIVE WIND IDS FOR C THE COMBINATIONS OF FACTORS IN COMB( ,L), C (L=1,20). (OUTPUT) C LCOMBO = THE NUMBER OF ITEMS IN COMB( , ) AND C IWCOMB( , ) MAXIMUM OF 20. (INPUT/OUTPUT) C NX,NY = DIMENSIONS OF THE GRID AT MESH LENGTH MESHW. C (INPUT/OUTPUT) C NXP,NYP = POLE POSITION OF THE GRID AT THE CURRENT C NX, NY, AND MESHW. (INPUT/OUTPUT) C MESHW = THE NOMINAL MESH LENGTH OF THE GRID BEING DEALT C WITH WHOSE DIMENSIONS ARE NX AND NY. C (INPUT/OUTPUT) C ITRPLQ(J) = TYPE OF INTERPOLATION TO GO FROM ONE MESH C LENGTH TO ONE OF HALF THAT MESH LENGTH. C 1 = BILINEAR C 2 = BIQUADRATIC C (INPUT) C NPROJH = THE MAXIMUM NUMBER OF PROJECTIONS TO MAKE C FORECASTS FOR IN HOURLY INCREMENTS. (INPUT) C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). C L=1,4--THE 4 ID'S FOR THE DATA. C L=5 --LOCATION OF STORED DATA. WHEN IN CORE, C THIS IS THE LOCATION IN CORE( ) WHERE C THE DATA START. WHEN ON DISK, C THIS IS MINUS THE RECORD NUMBER WHERE C THE DATA START. C L=6 --THE NUMBER OF 4-BYTE WORDS STORED. C L=7 --2 FOR DATA PACKED IN TDLPACK, 1 FOR NOT. C L=8 --THE DATE/TIME OF THE DATA IN FORMAT C YYYYMMDDHH. C L=9 --NUMBER OF TIMES DATA HAVE BEEN RETRIEVED. C L=10 --NUMBER OF THE SLAB IN DIR( , ,L) AND C IN NGRIDC( ,L) DEFINING THE C CHARACTERISTICS OF THIS GRID. C L=11 --THE NUMBER OF THE FIRST VARIABLE IN THE C LIST IN ID( ,N) (N=1,NPRED) FOR C WHICH THIS VARIABLE IS NEEDED, WHEN IT C DOES NOT NEED TO BE STORED AFTER DAY 1. C WHEN THE VARIABLE MUST BE STORED (TO BE C ACCESSED THROUGH OPTION) FOR ALL DAYS, C ID(11,N) IS 7777 + THE NUMBER OF THE C FIRST VARIABLE IN THE LIST FOR WHICH C THIS VARIABLE IS NEEDED. C L=12 --USED INITIALLY IN ESTABLISHING C MSTORE( , ). LATER USED AS A WAY OF C DETERMINING WHETHER TO KEEP THIS VARIABLE. C (INPUT) C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ). C SECOND DIMENSION OF LSTORE( , ). (INPUT) C LITEMS = THE NUMBER OF ITEMS IN LSTORE( , ). (INPUT) C IS0(J) = MOS-2000 GRIB SECTION 0 ID'S (J=1,4). C (INTERNAL) C IS1(J) = MOS-2000 GRIB SECTION 1 ID'S (J=1,21+). C (INTERNAL) C IS2(J) = MOS-2000 GRIB SECTION 2 ID'S (J=1,12). C (INTERNAL) C IS4(J) = MOS-2000 GRIB SECTION 4 ID'S (J=1,4). C (INTERNAL) C ND7 = DIMENSION OF IS0( ), IS1( ), IS2( ), AND C IS4( ). (INPUT) C DATA(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C IPACK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C IWORK(J) = WORK ARRAY (J=1,ND5). (INTERNAL) C ND5 = DIMENSION OF IPACK( ), IWORK( ), AND DATA( ). C (INPUT) C MINPK = MINIMUM GROUP SIZE WHEN PACKING THE DATA. C (INPUT) C CORE(J) = SPACE ALLOCATED FOR SAVING PACKED GRIDPOINT C FIELDS (J=1,ND10). WHEN THIS SPACE IS C EXHAUSTED, SCRATCH DISK WILL BE USED. THIS C IS THE SPACE USED FOR THE MOS-2000 INTERNAL C RANDOM ACCESS SYSTEM. (INPUT) C ND10 = THE MEMORY IN WORDS ALLOCATED TO THE SAVING OF C DATA CORE( ). WHEN THIS SPACE IS EXHAUSTED, C SCRATCH DISK WILL BE USED. (INPUT) C NBLOCK = BLOCK SIZE IN WORDS OF INTERNAL MOS-2000 DISK C STORAGE. (INPUT) C NFETCH = NUMBER OF TIMES GFETCH HAS BEEN ACCESSED. C (OUTPUT) C MISTOT = TOTAL NUMBER OF TIMES A MISSING INDICATOR C HAS BEEN ENCOUNTERED IN UNPACKING GRIDS WHEN C COMPUTING VARIABLES. (INPUT/OUTPUT) C JTOTBY = THE TOTAL NUMBER OF BYTES ON THE FILE ASSOCIATED C WITH UNIT NO. KFILOG. (INPUT/OUTPUT) C JTOTRC = THE TOTAL NUMBER OF RECORDS IN THE FILE ON UNIT C NUMBER KFILOG. (INPUT/OUTPUT) C L3264B = INTEGER WORD LENGTH IN BITS OF MACHINE BEING C USED (EITHER 32 OR 64). (INPUT). C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C (INPUT) C ISTOP = INCREMENTED BY 1 WHENEVER AN ERROR IS C ENCOUNTERED. (INPUT/OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 777 = FATAL ERROR C SEE CALLED ROUTINES FOR OTHER VALUES. C ANY NON ZERO VALUE WILL CLOSE OUT THIS C DATE/TIME IN U150. (OUTPUT) C PLIU = PLAIN LANGUAGE FOR PACKING INTERMEDIATE C ADVECTIVE U WINDS. (CHARACTER*32) (INTERNAL) C PLIV = PLAIN LANGUAGE FOR PACKING INTERMEDIATE C ADVECTIVE V WINDS. (CHARACTER*32) (INTERNAL) C PLU = PLAIN LANGUAGE FOR PACKING ADVECTIVE U WINDS. C (CHARACTER*32) (INTERNAL) C PLV = PLAIN LANGUAGE FOR PACKING ADVECTIVE V WINDS. C (CHARACTER*32) (INTERNAL) C IPLIU(I) = EQUIVALENCED TO PLIU( ) (I=1,4). (INTERNAL) C IPLIV(I) = EQUIVALENCED TO PLIV( ) (I=1,4). (INTERNAL) C IPLU(I) = EQUIVALENCED TO PLU( ) (I=1,4). (INTERNAL) C IPLV(I) = EQUIVALENCED TO PLV( ) (I=1,4). (INTERNAL) C PLNCPU(J) = PLAIN LANGUAGE FOR PACKING AVN MODEL U WINDS C FOR EACH 4 VARIABLES (J=1,4). (CHARACTER*32) C (INTERNAL) C PLNCPV(J) = PLAIN LANGUAGE FOR PACKING AVN MODEL V WINDS C FOR EACH 4 VARIABLES (J=1,4). (CHARACTER*32) C (INTERNAL) C IPLNCPU(I,J) = EQUIVALENCED TO PLNCPU( ) (I=1,4) (J=1,4). C (INTERNAL) C IPLNCPV(I,J) = EQUIVALENCED TO PLNCPV( ) (I=1,4) (J=1,4). C (INTERNAL) C IWICOMB(J,L) = THE U (J=1) AND V (J=2) INTERMEDIATE ADVECTIVE C WIND IDS FOR THE COMBINATIONS OF FACTORS IN C COMB( ,L), (L=1,20). (INTERNAL) C LSTUID(J) = BASE VALUE OF ID OF ADVECTIVE U-WIND (J=1) AND C V-WIND WIND (J=2). THE VALUES IN THE C CORRESPONDING IDWND(J) = LSTUID(J)+LCOMBO*1000, C AND LCOMBO IS THE NUMBER OF THE WIND C COMBINATION. (INTERNAL) C IDNCPU(I,J) = FIRST 2 WORDS OF U WIND ID (I=1,2) FOR C 4 LEVELS (J=1,4), FOR C J = 1--NCEP 1000-MB U WINDS C J = 2--NCEP 850-MB U WINDS C J = 3--NCEP 700-MB U WINDS C J = 4--NCEP 500-MB U WINDS C (INTERNAL) C IDNCPV(I,J) = FIRST 2 WORDS OF V WIND ID (I=1,2) FOR C 4 LEVELS (J=1,4), FOR C J = 1--NCEP 1000-MB V WINDS C J = 2--NCEP 850-MB V WINDS C J = 3--NCEP 700-MB V WINDS C J = 4--NCEP 500-MB V WINDS C (INTERNAL) C NSLAB = RETURNED BY GETFLD1; NOT USED. (INTERNAL) C MESHS = MESHW AS READ IN. MESHW MAY CHANGE; MESHS WILL C NOT. (INTERNAL) C STATE = VARIABLE SET TO STATEMENT NUMBER TO INDICATE C WHERE AN ERROR OCCURRED. (CHARACTER*4) C (INTERNAL) C MESHXB = THE MESH LENGTH OF EITHER A 1-BEDIENT OR C 1/2-BEDIENT GRID. (INTERNAL) C KDATE = NDATE BACKED UP BY INCREMENTS OF 6 HOURS. C (INTERNAL) C JDATE = THE DATE/TIME OF THE NCEP RUN NEEDED. C (INTERNAL) C NHR = THE HOUR OF THE DATE/TIME KDATE. (INTERNAL) C ISCALD = SCALING PARAMETER FOR WRITING U- AND C V-ADVECTIVE WINDS TO INTERNAL RANDOM ACCESS C FILE AND TO FILD KFILOG. (INTERNAL) C NRATIO = MESHB/MESHLD. (INTERNAL) C FDMS( ) = MAP SCALE FACTOR. ALTHOUGH THE SPACE FOR C FDMS( ) IS RETAINED, IT SEEMS THE SAVE STATEMENT C HAS TO BE USED TO PRESERVE THE DATA IN FDMS( ). C (ALLOCATABLE) (INTERNAL) C IFIRST = INITIALLY SET TO ZERO. USED TO COMPUTE C MAP FACTOR ONLY ONCE PER RUN. C IDIWND(J) = ID FOR THE INTERMEDIATE ADVECTIVE U-WIND (J=1) C AND V-WIND (J=2). (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C PAWING, PRTGR, TIMPR, PRSID1, GETFLD115, SMTH5, SIZEGR, C UVWND2, DATPRS, UPDAT, TRNSFR, CUT, MSHXMS, IJLLPS, PAWOTG, C PSMAPF C CHARACTER*4 STATE CHARACTER*32 PLNCPU(4),PLNCPV(4),PLU,PLV,PLIU,PLIV,PLMF CHARACTER*72 TITLT/' '/ C DIMENSION U10(ND2X3),V10(ND2X3),U51(ND2X3),V51(ND2X3) DIMENSION U(ND2X3),V(ND2X3) DIMENSION FD9(ND2X3) DIMENSION IPACK(ND5),DATA(ND5),IWORK(ND5) DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7) DIMENSION LSTORE(12,ND9) DIMENSION CORE(ND10) DIMENSION CAFSM(10),IDWND(2),COMB(10,20),IWCOMB(2,20), 1 IWICOMB(2,20),IDIWND(2), 2 IDNCPU(2,4),IDNCPV(2,4),IPLNCPU(4,4),IPLNCPV(4,4), 3 IPLU(4),IPLV(4),IPLIU(4),IPLIV(4),IPLMF(4) DIMENSION LD(4),LDPARS(15),IOPT(8),MDATE(4) C ALLOCATABLE FDMS(:) SAVE FDMS C EQUIVALENCE (PLNCPU,IPLNCPU), 1 (PLNCPV,IPLNCPV), 2 (PLU,IPLU),(PLV,IPLV), 3 (PLIU,IPLIU),(PLIV,IPLIV), 4 (PLMF,IPLMF) C DATA IDNCPU /004020003, 1000, ! RAP WIND ID 1 004020003, 850, 2 004020003, 700, 3 004020003, 500/ C DATA IDNCPV /004120003, 1000, ! RAP WIND ID 1 004120003, 850, 2 004120003, 700, 3 004120003, 500/ C DATA PLNCPU /' NCEP 1000-MB U WIND ', 1 ' NCEP 850-MB U WIND ', 2 ' NCEP 700-MB U WIND ', 3 ' NCEP 500-MB U WIND '/ C DATA PLNCPV /' NCEP 1000-MB V WIND ', 1 ' NCEP 850-MB V WIND ', 2 ' NCEP 700-MB V WIND ', 3 ' NCEP 500-MB V WIND '/ C DATA PLU /' -H ADVECTIVE U-WIND '/, 1 PLV /' -H ADVECTIVE V-WIND '/ C DATA PLIU /' -H INTERMED U-WIND '/, 1 PLIV /' -H INTERMED V-WIND '/, 2 PLMF /' -H CODE MAP FACTOR '/ C DATA LSTUID/004199005/, 1 LSTVID/004399005/ C DATA LSTIUID/004599005/, 1 LSTIVID/004799005/ C DATA IFIRST/0/ C IER=0 C D CALL TIMPR(KFILDO,KFILDO,'START AWND15M ') C IF(IFIRST.EQ.0)THEN C ALLOCATION SHOULD ONLY OCCUR ONCE. IFIRST IS SET = 1 C LATER AFTER COMPUTATION OF FDMS( ). ALLOCATE (FDMS(ND2X3),STAT=IOS) IFIRST=1 C IFIRST IS UPDATED HERE BECAUSE IF AWND15M WERE LEFT BECAUSE C OF AN ERROR AND REENTERED AGAIN, ALLOCATION WILL CAUSE C A STOP 101. THIS WOULD PRECLUDE "SKIPPING" A BAD C DATE. D WRITE(KFILDO,100) D100 FORMAT(/' IN SCOPXA ALLOCATING FDMS IN AWND15M.') C IF(IOS.EQ.1)THEN WRITE(KFILDO,101) 101 FORMAT(/' ****ALLOCATION OF FDMS( , ) FAILED IN AWND15M,', 1 ' AT 101. ARRAY ALREADY ALLOCATED.') STOP 101 ELSEIF(IOS.EQ.2)THEN WRITE(KFILDO,102) 102 FORMAT(/' ****ALLOCATION OF FDMS( , ) FAILED IN SCOPXA', 1 ' AT 102. ARRAY NOT ALLOCATED.') STOP 102 ENDIF C ENDIF C C PUT DATE/TIME INTO TITLT(46:61). FIRST PARSE IT INTO C MDATE( ). C TITLT(41:45)=' FOR ' CALL DATPRS(KFILDO,NDATE,MDATE) JMIN=0 STATE=' 103' WRITE(TITLT(46:61),103,IOSTAT=IOS,ERR=900)(MDATE(J),J=1,4),JMIN 103 FORMAT(I4,1X,I2.2,1X,I2.2,1X,2I2.2,1X) C C SAVE MESHW. C MESHS=MESHW C C DEFINE VALUES FOR TDLPACK AND NRATIO FOR PRTGR. C NCHAR=32 C 32 CHARACTERS OF PLAIN LANGUAGE ARE PACKED. XMISSP=0. XMISSS=0. ITAUM=0 NSEQ=0 ISCALD=2 NRATIO=MESHB/MESHLD C THE VALUES OF WINDS IN UNITS PER HALF HOUR AND TRAJECTORY C END POINTS INCREASE WITH MESHW. USING NRATIO IN CALL TO C PRTGR COMPENSATES. C C FIND THE COMBINATION OF WINDS NEEDED AND THE IDS C FOR THEM. C DO 114 J=1,LCOMBO C THE FIRST TIME THROUGH, LCOMBO = 0. THIS IS OK. C DO 113 M=1,10 IF(CAFSM(M).NE.COMB(M,J))GO TO 114 113 CONTINUE C C AT THIS POINT, THE COMBINATION OF WINDS WANTED C FOR VARIABLE BEING TREATED IS THE SAME AS THE C COMBINATION COMB( ,J). 20 COMBINATIONS ARE ALLOWED. C THE FINAL WIND IDS ARE IN IWCOMB( ,J). C THE INTERMEDIATE WIND IDS ARE IN IWCOMB( ,J). C IDWND(1)=IWCOMB(1,J) IDWND(2)=IWCOMB(2,J) IDIWND(1)=IWICOMB(1,J) IDIWND(2)=IWICOMB(2,J) C GO TO 600 C ALL WINDS ARE COMPUTED FOR THIS VARIABLE. THEIR C IDS ARE IN IDWND( ). C 114 CONTINUE C C INSERT A NEW COMBINATION OF WINDS INTO COMB( , ). C LCOMBO=LCOMBO+1 C IF(LCOMBO.GT.20)THEN WRITE(KFILDO,1145)((COMB(L,M),M=1,10),L=1,LCOMBO-1) 1145 FORMAT(/' ****LCOMBO EXCEEDS 20 IN AWND15M.', 1 ' THE 10 VALUES IN EACH OF THE 20 USED ARE:'/ 2 (' ',10F8.2)) LCOMBO=LCOMBO-1 ISTOP=ISTOP+1 IER=777 GO TO 600 ENDIF C DO 1147 M=1,10 COMB(M,LCOMBO)=CAFSM(M) 1147 CONTINUE C IDWND(1)=LSTUID+LCOMBO*1000 IDWND(2)=LSTVID+LCOMBO*1000 IDIWND(1)=LSTIUID+LCOMBO*1000 IDIWND(2)=LSTIVID+LCOMBO*1000 C IDWND( ) PERTAINS TO THE VARIABLE BEING ADDRESSED IN C THE CALLING PROGRAM. IWCOMB(1,LCOMBO)=IDWND(1) IWCOMB(2,LCOMBO)=IDWND(2) IWICOMB(1,LCOMBO)=IDIWND(1) IWICOMB(2,LCOMBO)=IDIWND(2) C IWCOMB( ,LCOMBO) PERTAINS TO THE COMBINATION OF WINDS NEEDED C IN COMB( ,LCOMBO). C C AT THIS POINT, A NEW COMBINATION OF WINDS MUST BE C ACCESSED. ITERATE AS NECESSARY OVER IBACKN CYCLES. C KDATE=NDATE C DO 520 KCYCLE=0,IBACKN C IBACKN = 1 MEANS IT WILL LOOK BACK 1 CYCLE. C CALL UPDAT(NDATE,-KCYCLE*6,KDATE) ! GFS CALL UPDAT(NDATE,-KCYCLE,IDATE) ! RAP/HRRR C KDATE STEPS BACK FROM THE LAMP RUN DATE/TIME NDATE IN C 6-HR CHUNKS. THIS ASSUMES AN NCEP RUN EACH 6 HOURS. C IF RUNS ARE AVAILABLE ONLY EVERY 12 HOURS, THIS WILL C BE OK AS LONG AS IBACKN IS LARGE ENOUGH (IBACKN REFERS C TO EACH 6 HOURS). C NHR=KDATE-(KDATE/100)*100 C NHR IS THE HOUR OF DATE/TIME KDATE. C JDATE=KDATE-MOD(NHR,6) C JDATE IS THE DATE/TIME OF THE NCEP RUN NEEDED. NDATE C CAN BE FOR ANY HOUR; JDATE CAN BE ONLY FOR EACH 6 HOURS. C C ITERATE OVER NPROJ PROJECTIONS, PLUS INITIAL TIME. NOTE C THAT IF AN ERROR OCCURS IN GETTING A FIELD IN THE DO 500 C LOOP, THE DO 520 LOOP IS INCREMENTED AND THE DO 500 LOOP C RESTARTS. HOWEVER, FIELDS IN INTERNAL STORAGE MAY HAVE THE C SAME ID. THIS WILL MIX RUNS, BUT SHOULD RARELY HAPPEN AND C NOT BE VERY IMPORTANT ANYWAY. C DO 500 LP=0,NPROJH C THE ZERO PROJECTION IS NEEDED. C C GET WINDS IN U51( ) AND V51( ) AT MESH LENGTH MESHW C FOR EACH OF NPROJH PROJECTIONS; THESE WILL BE LINEARLY C INTERPOLATED WHERE NECESSARY FROM 3-HOURLY PROJECTIONS FROM C THE NCEP RUNS AT 00, 06, 12, AND 18Z. THESE HOURLY C WINDS WILL BE STORED IN THE MOS-2000 INTERNAL RANDOM ACCESS C FILE. THEN, CUT TO 1/2 BEDIENT GRID IF DESIRED, SMOOTH C OVER 5 POINTS, INTERPOLATE TO CURRENT GRID, AND WEIGHT AND C SUM IN U( ) AND V( ). C DO 116 J=1,NX*NY U10(J)=0. V10(J)=0. U(J)=0. V(J)=0. 116 CONTINUE C C UP TO 4 WINDS CAN CONTRIBUTE. C DO 440 J=1,4 C IF(CAFSM(J).EQ.0.)GO TO 440 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C OBTAIN NCEP U WINDS C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C SET LD(1) AND LD(2). C LD(1)=(IDNCPU(1,J)/100)*100+NCEPNO C LD(2)=IDNCPU(2,J) C C DATE AND CYCLE DIFFER FOR NCEP AND LAMP. THIS IS NCEP. C C LD(3)=MOD(NHR,6)+KCYCLE*6+LP LD(3)=KCYCLE+LP/4 C IDATE=JDATE C LD(4)=0 C C***D WRITE(KFILDO,1169)J,(CAFSM(L),L=1,10),(LD(L),L=1,4) C***D1169 FORMAT(/' IN AWND15M AT 1169--J,(CAFSM(L),L=1,10)', C***D 1 '(LD(L),L=1,4)'/' ',I4,10F6.2,4I12) CALL PRSID1(KFILDO,LD,LDPARS) C*********NOTE GETFLD1 CALL GETFLD115(KFILDO,KFIL10,LD,IDATE,LP, C CALL GETFLD(KFILDO,KFIL10,LD,IDATE, 1 U51,FD9,ND2X3, 2 NCEPNO,LAMPNO,NPROJ,ORIENT,XLAT, 3 NXL,NYL,NXPL,NYPL,ALATL,ALONL,MESHB, 4 NX,NY,MESHW,ITRPLQ, 5 LSTORE,LITEMS,ND9, 6 IS0,IS1,IS2,IS4,ND7, 7 IPACK,IWORK,ND5, 8 CORE,ND10,NBLOCK,NFETCH,MISTOT,NSLAB, 9 L3264B,IER) C GETFLD115 WRITES THE INTERMEDIATE INTERPOLATED WINDS C PACKED WITH ONE LARGE GROUP. IF(IER.NE.0)THEN C GO TO 520 C FOR NCEP FIELDS, TRY ANOTHER CYCLE. ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C PACK THE NCEP U WINDS TO DISP GRID IF C C DESIRED C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C GRIDPOINT WHEN I4XXDG NE 0 AND IP22 NE 0. C IF(I4XXDG.NE.0.AND.(KFILOG.GT.0.OR.IP22.GT.0))THEN C NXG=NX NYG=NY NXPG=NXP NYPG=NYP MESHG=MESHW C NXG, ETC. ARE NECESSARY BECAUSE SIZEGR CHANGE THEM, AND C NX, ETC. MUST BE RETAINED. CALL TRNSFR(U51,FD9,NX*NY) CALL SIZEGR(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 MESHG,MESHLD,ITRPLQ,ND2X3) C THE SAME INTERPOLATION IS USED (IF NEEDED) AS FOR OTHER C USES IN U450. THE PROJECTION IS WRITTEN WITH REFERENCE C TO THE NCEP DATE/TIME. C IF(IP22.NE.0)THEN STATE=' 150' TITLT(1:40)=' -H U WIND M/S ( ) ' WRITE(TITLT(1:2),150,IOSTAT=IOS,ERR=900)LP 150 FORMAT(I2) STATE=' 151' WRITE(TITLT(19:37),151,IOSTAT=IOS,ERR=900)LD(1),LD(2) 151 FORMAT(I9.9,1X,I9.9) TITLT(62:72)=' ' CALL PRTGR(IP22,FD9,NXG,NYG, 1 10./NRATIO,0.,1.,0.,IOPT,TITLT,IER) C CONTOUR AT 10 M/S INTERVALS AT 1/4 BEDIENT MESH. C IF(IER.NE.0)THEN C ERROR GRIDPRINTING NOT COUNTED AS FATAL. ISTOP=ISTOP+1 IF(IP22.NE.KFILDO)WRITE(KFILDO,152) 152 FORMAT(/' ****OVERFLOW ERROR IN PRTGR FROM AWND15M,', 1 ' SEE FILE ON IP22, NONFATAL') ENDIF C ENDIF C XMISSP=0. C C THE GRID IN FD9( ) IS ALWAYS AT MESH LENGTH MESHLD AS A C RESULT OF SIZEGR, WHICH IS WHAT IS WANTED FOR THE C DISPOSABLE GRID. NOW CUT THE GRID TO THE DISPOSABLE C AREA. C NXD=IOPT(3)-IOPT(2)+1 NYD=IOPT(5)-IOPT(4)+1 C NXD AND NYD ARE THE CUT (DISPOSABLE) GRID DIMENSIONS. NXPD=NXPG-IOPT(2)+1 NYPD=NYPG-IOPT(4)+1 C NXPD AND NYPD ARE THE X AND Y POLE POSITIONS FOR THE C CUT (DISPOSABLE) GRID. CALL CUT(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 FD9,NXD,NYD,NXPD,NYPD) CALL MSHXMS(KFILDO,MESHLD,XMESHN,XMESHLD) C SUBROUTINE MSHXMS COMPUTES XMESHLD FROM MESHLD. CALL IJLLPS(1.,1.,XMESHLD,ORIENT,XLAT, 1 FLOAT(NXPD),FLOAT(NYPD),ALATD,ALOND) C ALATD AND ALOND ARE THE LL LAT/LON GRID POSITION. ALATD=NINT(ALATD*1000)/1000. ALOND=NINT(ALOND*1000)/1000. C ROUND LAT AND LON TO 3 DECIMAL PLACES TO AGREE WITH C LFM ARCHIVE. CALL PAWOTG(KFILDO,KFILOG,IP16,JDATE, 1 LD,LDPARS(12),ITAUM,NCEPNO,NSEQ,ISCALD, 2 NPROJ,ALATD,ALOND,ORIENT,MESHLD,XLAT,NXD,NYD, 3 FD9,DATA,IWORK,IPACK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLNCPU(1,J),PLNCPU(J),NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR WRITING DISPOSABLE GRIDS NOT COUNTED AS FATAL. C ENDIF C C SMOOTH THIS FIELD AS DESIRED. C IF(CAFSM(J+4).EQ.0)GO TO 230 C C THIN GRID TO 1/2 OR 1 BEDIENT. THE NX, NY, NXP, AND NYP C ARE ADJUSTED ACCORDINGLY. UNFORTUNATELY, THE USUAL GRID C BEING USED HAS A POLE POSITION THAT IS NON-INTEGER C ON A 1-BEDIENT GRID. THEREFORE, THE NXP AND NYP C RETURNED FROM SIZEGR ARE INCORRECT. SINCE THE C CUT GRID IS ONLY USED FOR SMOOTHING, WHICH DOES C NOT REQUIRE THE POLE POSITION, AND IS THEN PUT BACK C ON THE LAMP GRID, NXP AND NYP ARE SAVED IN NXPS AND C NYPS AND NXP AND NYP ARE RESTORED AFTER THE SECOND C CALL TO SIZEGR. C NSMX=NINT(CAFSM(J+4)) C IF(NSMX.LT.10)THEN MESNXB=MESHB*4 ELSE MESNXB=MESHB*2 ENDIF C C MESNXB IS THE 1/2-BEDIENT OR 1 BEDIENT MESH LENGTH. NXPS=NXP NYPS=NYP CALL SIZEGR(KFILDO,U51,NX,NY,NXP,NYP, 1 MESHW,MESNXB,1,ND2X3) C MESHW IS NOW THE SAME AS MESNXB. C C SMOOTH OVER 5 POINTS NSMX TIMES. THE RESULT IS IN U51( ); C FD9( , ) IS USED AS A WORK ARRAY. C DO 200 M=1,MOD(NSMX,10) CALL SMTH5(KFILDO,U51,FD9,NX,NY) 200 CONTINUE C C INTERPOLATE TO LAMP GRID OF MESH LENGTH MESHW. THE NX, NY, C NXP, AND NYP ARE ADJUSTED ACCORDINGLY. BIQUADRATIC C INTERPOLATION IS USED. C CALL SIZEGR(KFILDO,U51,NX,NY,NXP,NYP, 1 MESHW,MESHS,2,ND2X3) C MESHW IS NOW ITS ORIGINAL ENTRY VALUE. NXP=NXPS NYP=NYPS C SEE COMMENTS ABOVE FOR WHY NXP AND NYP ARE RESTORED TO C NXPS AND NYPS. C C FIELD HAS BEEN RETRIEVED AND SMOOTHED. ADD WEIGHTED FIELD C TO SUM. C 230 CWT=CAFSM(J) C DO 335 M=1,NX*NY U(M)=U(M)+U51(M)*CWT 335 CONTINUE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C OBTAIN NCEP V WINDS C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C SET LD(1) AND LD(2). C LD(1)=(IDNCPV(1,J)/100)*100+NCEPNO C LD(2)=IDNCPV(2,J) C C DATE AND CYCLE DIFFER FOR NCEP AND LAMP. THIS IS NCEP. C C LD(3)=MOD(NHR,6)+KCYCLE*6+LP LD(3)=KCYCLE+LP/4 C IDATE=JDATE C LD(4)=0 C C***D WRITE(KFILDO,3419)J,(CAFSM(L),L=1,10),(LD(L),L=1,4) C***D3419 FORMAT(/' IN AWND15M AT 3419--J,(CAFSM(L),L=1,10)', C***D 1 '(LD(L),L=1,4)'/' ',I4,10F6.2,4I12) CALL PRSID1(KFILDO,LD,LDPARS) C*********NOTE GETFLD1 CALL GETFLD115(KFILDO,KFIL10,LD,IDATE,LP, C CALL GETFLD(KFILDO,KFIL10,LD,IDATE, 1 V51,FD9,ND2X3, 2 NCEPNO,LAMPNO,NPROJ,ORIENT,XLAT, 3 NXL,NYL,NXPL,NYPL,ALATL,ALONL,MESHB, 4 NX,NY,MESHW,ITRPLQ, 5 LSTORE,LITEMS,ND9, 6 IS0,IS1,IS2,IS4,ND7, 7 IPACK,IWORK,ND5, 8 CORE,ND10,NBLOCK,NFETCH,MISTOT,NSLAB, 9 L3264B,IER) C GETFLD1 WRITES THE INTERMEDIATE INTERPOLATED WINDS C PACKED WITH ONE LARGE GROUP. IF(IER.NE.0)THEN C GO TO 520 C FOR NCEP FIELDS, TRY ANOTHER CYCLE. ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C PACK THE NCEP V WINDS TO DISP GRID IF C C DESIRED C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C GRIDPOINT WHEN I4XXDG NE 0 AND IP22 NE 0. C IF(I4XXDG.NE.0.AND.(KFILOG.GT.0.OR.IP22.GT.0))THEN C NXG=NX NYG=NY NXPG=NXP NYPG=NYP MESHG=MESHW C NXG, ETC. ARE NECESSARY BECAUSE SIZEGR CHANGE THEM, AND C NX, ETC. MUST BE RETAINED. CALL TRNSFR(V51,FD9,NX*NY) CALL SIZEGR(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 MESHG,MESHLD,ITRPLQ,ND2X3) C THE SAME INTERPOLATION IS USED (IF NEEDED) AS FOR OTHER C USES IN U450. THE PROJECTION IS WRITTEN WITH REFERENCE C TO THE NCEP DATE/TIME. C IF(IP22.NE.0)THEN STATE=' 350' TITLT(1:40)=' -H V WIND M/S ( ) ' WRITE(TITLT(1:2),350,IOSTAT=IOS,ERR=900)LP 350 FORMAT(I2) STATE=' 351' WRITE(TITLT(19:37),351,IOSTAT=IOS,ERR=900)LD(1),LD(2) 351 FORMAT(I9.9,1X,I9.9) TITLT(62:72)=' ' CALL PRTGR(IP22,FD9,NXG,NYG, 1 10./NRATIO,0.,1.,0.,IOPT,TITLT,IER) C CONTOUR AT 10 M/S INTERVALS AT 1/4 BEDIENT MESH. C IF(IER.NE.0)THEN C ERROR GRIDPRINTING NOT COUNTED AS FATAL. ISTOP=ISTOP+1 IF(IP22.NE.KFILDO)WRITE(KFILDO,152) ENDIF C ENDIF C XMISSP=0. C C THE GRID IN FD9( ) IS ALWAYS AT MESH LENGTH MESHLD AS A C RESULT OF SIZEGR, WHICH IS WHAT IS WANTED FOR THE C DISPOSABLE GRID. NOW CUT THE GRID TO THE DISPOSABLE C AREA. C NXD=IOPT(3)-IOPT(2)+1 NYD=IOPT(5)-IOPT(4)+1 C NXD AND NYD ARE THE CUT (DISPOSABLE) GRID DIMENSIONS. NXPD=NXPG-IOPT(2)+1 NYPD=NYPG-IOPT(4)+1 C NXPD AND NYPD ARE THE X AND Y POLE POSITIONS FOR THE C CUT (DISPOSABLE) GRID. CALL CUT(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 FD9,NXD,NYD,NXPD,NYPD) CALL MSHXMS(KFILDO,MESHLD,XMESHN,XMESHLD) C SUBROUTINE MSHXMS COMPUTES XMESHLD FROM MESHLD. CALL IJLLPS(1.,1.,XMESHLD,ORIENT,XLAT, 1 FLOAT(NXPD),FLOAT(NYPD),ALATD,ALOND) C ALATD AND ALOND ARE THE LL LAT/LON GRID POSITION. ALATD=NINT(ALATD*1000)/1000. ALOND=NINT(ALOND*1000)/1000. C ROUND LAT AND LON TO 3 DECIMAL PLACES TO AGREE WITH C LFM ARCHIVE. CALL PAWOTG(KFILDO,KFILOG,IP16,JDATE, 1 LD,LDPARS(12),ITAUM,NCEPNO,NSEQ,ISCALD, 2 NPROJ,ALATD,ALOND,ORIENT,MESHLD,XLAT,NXD,NYD, 3 FD9,DATA,IWORK,IPACK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLNCPV(1,J),PLNCPV(J),NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR WRITING DISPOSABLE GRIDS NOT COUNTED AS FATAL. C ENDIF C C SMOOTH THIS FIELD AS DESIRED. C IF(CAFSM(J+4).EQ.0)GO TO 430 C C THIN GRID TO 1/2 OR 1 BEDIENT. THE NX, NY, NXP, AND NYP C ARE ADJUSTED ACCORDINGLY. UNFORTUNATELY, THE USUAL GRID C BEING USED HAS A POLE POSITION THAT IS NON-INTEGER C ON A 1-BEDIENT GRID. THEREFORE, THE NXP AND NYP C RETURNED FROM SIZEGR ARE INCORRECT. SINCE THE C CUT GRID IS ONLY USED FOR SMOOTHING, WHICH DOES C NOT REQUIRE THE POLE POSITION, AND IS THEN PUT BACK C ON THE LAMP GRID, NXP AND NYP ARE SAVED IN NXPS AND C NYPS AND NXP AND NYP ARE RESTORED AFTER THE SECOND C CALL TO SIZEGR. C NSMX=NINT(CAFSM(J+4)) C IF(NSMX.LT.10)THEN MESNXB=MESHB*4 ELSE MESNXB=MESHB*2 ENDIF C C MESNXB IS THE 1/2-BEDIENT OR 1 BEDIENT MESH LENGTH. NXPS=NXP NYPS=NYP CALL SIZEGR(KFILDO,V51,NX,NY,NXP,NYP, 1 MESHW,MESNXB,1,ND2X3) C MESHW IS NOW THE SAME AS MESNXB. C C SMOOTH OVER 5 POINTS NSMX TIMES. THE RESULT IS IN V51( ); C FD9( , ) IS USED AS A WORK ARRAY. C DO 400 M=1,MOD(NSMX,10) CALL SMTH5(KFILDO,V51,FD9,NX,NY) 400 CONTINUE C C INTERPOLATE TO LAMP GRID OF MESH LENGTH MESHW. THE NX, NY, C NXP, AND NYP ARE ADJUSTED ACCORDINGLY. BIQUADRATIC C INTERPOLATION IS USED. C CALL SIZEGR(KFILDO,V51,NX,NY,NXP,NYP, 1 MESHW,MESHS,2,ND2X3) C MESHW IS NOW ITS ORIGINAL ENTRY VALUE. NXP=NXPS NYP=NYPS C SEE COMMENTS ABOVE FOR WHY NXP AND NYP ARE RESTORED TO C NXPS AND NYPS. C C FIELD HAS BEEN RETRIEVED AND SMOOTHED. ADD WEIGHTED FIELD C TO SUM. C 430 CWT=CAFSM(J) C DO 435 M=1,NX*NY V(M)=V(M)+V51(M)*CWT 435 CONTINUE 440 CONTINUE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C PACK THE SMOOTHED, AVERAGED, ADVECTIVE C C MODEL WINDS TO DISP GRID FILE C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C TDLPACK AND WRITE SMOOTHED, AVERAGED, ADVECTIVE MODEL C WINDS IN M/S TO DISPOSABLE FILE WHEN I4XXDG NE 0. C ALSO GRIDPRINT WHEN IP22 NE 0. C C IF(I4XXDG.NE.0.AND.(KFILOG.GT.0.OR.IP22.GT.0))THEN C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C CONVERT SMOOTHED, AVERAGED, ADVECTIVE C C NCEP M/S WINDS FROM GRID ORIENTED WINDS C C TO EARTH ORIENTED WINDS C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C CALL EOUWND(KFILDO,U10,U,V,NX,NY, 1 FLOAT(NXP),FLOAT(NYP)) CALL EOVWND(KFILDO,V10,U,V,NX,NY, 1 FLOAT(NXP),FLOAT(NYP)) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C PACK U WINDS FIRST C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ID IS WIND WITH DD = 5 FOR LAMP. ONLY LD(1) NEEDS C TO BE CHANGED. THIS IS NECESSARY TO DIFFERENTIATE C THE DIFFERENT SUMMATIONS. C LD(1)=IDIWND(1) LD(2)=777 LD(3)=LP LD(4)=080 CALL PRSID1(KFILDO,LD,LDPARS) C WORD 2 SET TO THE ID FOR U-WIND FOR COMPOSITE HEIGHTS. C THIS WILL ALLOW THEM TO BE DISTINGUISHED AND RELATED C TO THE WINDS. C NXG=NX NYG=NY NXPG=NXP NYPG=NYP MESHG=MESHW C NXG, ETC. ARE NECESSARY BECAUSE SIZEGR CHANGE THEM, AND C NX, ETC. MUST BE RETAINED. CALL TRNSFR(U10,FD9,NX*NY) CALL SIZEGR(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 MESHG,MESHLD,ITRPLQ,ND2X3) C THE SAME INTERPOLATION IS USED (IF NEEDED) AS FOR OTHER C USES IN U450. THE PROJECTION IS WRITTEN WITH REFERENCE C TO THE NCEP DATE/TIME. C IF(IP22.NE.0)THEN STATE='4401' TITLT(1:40)=' -H U WIND IN M/S( ) ' WRITE(TITLT(1:2),4401,IOSTAT=IOS,ERR=900)LP 4401 FORMAT(I2) STATE='4402' WRITE(TITLT(19:37),4402,IOSTAT=IOS,ERR=900)LD(1),LD(2) 4402 FORMAT(I9.9,1X,I9.9) TITLT(62:72)=' ' CALL PRTGR(IP22,FD9,NXG,NYG, 1 10./NRATIO,0.,1.,0.,IOPT,TITLT,IER) C CONTOUR AT 10 M/S INTERVALS AT 1/4 BEDIENT MESH. C IF(IER.NE.0)THEN C ERROR GRIDPRINTING NOT COUNTED AS FATAL. ISTOP=ISTOP+1 IF(IP22.NE.KFILDO)WRITE(KFILDO,152) ENDIF C ENDIF C XMISSP=0. C C THE GRID IN FD9( ) IS ALWAYS AT MESH LENGTH MESHLD AS A C RESULT OF SIZEGR, WHICH IS WHAT IS WANTED FOR THE C DISPOSABLE GRID. NOW CUT THE GRID TO THE DISPOSABLE AREA. C NXD=IOPT(3)-IOPT(2)+1 NYD=IOPT(5)-IOPT(4)+1 C NXD AND NYD ARE THE CUT (DISPOSABLE) GRID DIMENSIONS. NXPD=NXPG-IOPT(2)+1 NYPD=NYPG-IOPT(4)+1 C NXPD AND NYPD ARE THE X AND Y POLE POSITIONS FOR THE C CUT (DISPOSABLE) GRID. CALL CUT(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 FD9,NXD,NYD,NXPD,NYPD) CALL MSHXMS(KFILDO,MESHLD,XMESHN,XMESHLD) C SUBROUTINE MSHXMS COMPUTES XMESHLD FROM MESHLD. CALL IJLLPS(1.,1.,XMESHLD,ORIENT,XLAT, 1 FLOAT(NXPD),FLOAT(NYPD),ALATD,ALOND) C ALATD AND ALOND ARE THE LL LAT/LON GRID POSITION. ALATD=NINT(ALATD*1000)/1000. ALOND=NINT(ALOND*1000)/1000. C ROUND LAT AND LON TO 3 DECIMAL PLACES TO AGREE WITH C LFM ARCHIVE. STATE='4403' WRITE(PLIU(1:2),4403,IOSTAT=IOS,ERR=900)LP 4403 FORMAT(I2) CALL PAWOTG(KFILDO,KFILOG,IP16,NDATE, 1 LD,LDPARS(12),ITAUM,LAMPNO,NSEQ,ISCALD, 2 NPROJ,ALATD,ALOND,ORIENT,MESHLD,XLAT,NXD,NYD, 3 FD9,DATA,IWORK,IPACK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLIU,PLIU,NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR WRITING DISPOSABLE GRIDS NOT COUNTED AS FATAL. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C PACK V WINDS NEXT C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ID IS WIND WITH DD = 5 FOR LAMP. ONLY LD(1) NEEDS C TO BE CHANGED. THIS IS NECESSARY TO DIFFERENTIATE C THE DIFFERENT SUMMATIONS. C LD(1)=IDIWND(2) LD(2)=777 LD(3)=LP LD(4)=080 CALL PRSID1(KFILDO,LD,LDPARS) C WORD 2 SET TO THE ID FOR U-WIND FOR COMPOSITE HEIGHTS. C THIS WILL ALLOW THEM TO BE DISTINGUISHED AND RELATED C TO THE WINDS. C NXG=NX NYG=NY NXPG=NXP NYPG=NYP MESHG=MESHW C NXG, ETC. ARE NECESSARY BECAUSE SIZEGR CHANGE THEM, AND C NX, ETC. MUST BE RETAINED. CALL TRNSFR(V10,FD9,NX*NY) CALL SIZEGR(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 MESHG,MESHLD,ITRPLQ,ND2X3) C THE SAME INTERPOLATION IS USED (IF NEEDED) AS FOR OTHER C USES IN U450. THE PROJECTION IS WRITTEN WITH REFERENCE C TO THE NCEP DATE/TIME. C IF(IP22.NE.0)THEN STATE='4405' TITLT(1:40)=' -H V WIND IN M/S( ) ' WRITE(TITLT(1:2),4405,IOSTAT=IOS,ERR=900)LP 4405 FORMAT(I2) STATE='4406' WRITE(TITLT(19:37),4406,IOSTAT=IOS,ERR=900)LD(1),LD(2) 4406 FORMAT(I9.9,1X,I9.9) TITLT(62:72)=' ' CALL PRTGR(IP22,FD9,NXG,NYG, 1 10./NRATIO,0.,1.,0.,IOPT,TITLT,IER) C CONTOUR AT 10 M/S INTERVALS AT 1/4 BEDIENT MESH. C IF(IER.NE.0)THEN C ERROR GRIDPRINTING NOT COUNTED AS FATAL. ISTOP=ISTOP+1 IF(IP22.NE.KFILDO)WRITE(KFILDO,152) ENDIF C ENDIF C XMISSP=0. C C THE GRID IN FD9( ) IS ALWAYS AT MESH LENGTH MESHLD AS A C RESULT OF SIZEGR, WHICH IS WHAT IS WANTED FOR THE C DISPOSABLE GRID. NOW CUT THE GRID TO THE DISPOSABLE AREA. C NXD=IOPT(3)-IOPT(2)+1 NYD=IOPT(5)-IOPT(4)+1 C NXD AND NYD ARE THE CUT (DISPOSABLE) GRID DIMENSIONS. NXPD=NXPG-IOPT(2)+1 NYPD=NYPG-IOPT(4)+1 C NXPD AND NYPD ARE THE X AND Y POLE POSITIONS FOR THE C CUT (DISPOSABLE) GRID. CALL CUT(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 FD9,NXD,NYD,NXPD,NYPD) CALL MSHXMS(KFILDO,MESHLD,XMESHN,XMESHLD) C SUBROUTINE MSHXMS COMPUTES XMESHLD FROM MESHLD. CALL IJLLPS(1.,1.,XMESHLD,ORIENT,XLAT, 1 FLOAT(NXPD),FLOAT(NYPD),ALATD,ALOND) C ALATD AND ALOND ARE THE LL LAT/LON GRID POSITION. ALATD=NINT(ALATD*1000)/1000. ALOND=NINT(ALOND*1000)/1000. C ROUND LAT AND LON TO 3 DECIMAL PLACES TO AGREE WITH C LFM ARCHIVE. STATE='4407' WRITE(PLIV(1:2),4407,IOSTAT=IOS,ERR=900)LP 4407 FORMAT(I2) CALL PAWOTG(KFILDO,KFILOG,IP16,NDATE, 1 LD,LDPARS(12),ITAUM,LAMPNO,NSEQ,ISCALD, 2 NPROJ,ALATD,ALOND,ORIENT,MESHLD,XLAT,NXD,NYD, 3 FD9,DATA,IWORK,IPACK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLIV,PLIV,NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR WRITING DISPOSABLE GRIDS NOT COUNTED AS FATAL. C C PLEASE NOTE THAT U10 AND V10 ARE ONLY BEING CALCULATED AND C WRITTEN FOR GEMPAK PURPOSES, SO THAT WE CAN VIEW THE ACTUAL C EARTH ORIENTED ADVECTIVE WINDS IN M/S. THEY ARE NOT USED C HEREAFTER, SINCE THE ONLY PURPOSE IS FOR GEMPAK. THE WINDS C NEEDED FOR THE ADVECTION ARE GRID ORIENTED IN UNITS OF GRID C LENGTHS PER HALF HOUR, AND THEY WILL BE DETERMINED BELOW FROM C THE AVERAGED, SMOOTHED NCEP MODEL WINDS. C ENDIF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C CONVERT U AND V WINDS FROM M/S TO GLENGTHE/HALF HR C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DETERMINE TRUE MESH LENGTH GIVEN MESHS. TRUE MESH C LENGTH FOR USE IN DETERMINING GRID LENGTHS PER C HALF HOUR IS XMESHW C CALL MSHXMS(KFILDO,MESHS,XMESHS,XMESHW) C C CALCULATE FDMS( ) FACTOR ONCE PER RUN. C IF(IFIRST.EQ.1)THEN C NOTE THAT IFIRST HAS BEEN UPDATED FROM 0 ABOVE. IT C WILL NEVER HAVE A VALUE OTHER THAN O OR 1. D CALL TIMPR(KFILDO,KFILDO,'START PSMAPF ') IFIRST=1 C SETTING IFIRST = 1 HERE KEEPS ALLOCATION AND C COMPUTATION OF FDMS( ) OCCURRING MORE THAN ONCE PER RUN. CALL PSMAPF(KFILDO,(XMESHW*1000.),ORIENT,XLAT, 1 ALATL,ALONL,DATA,FDMS,NX,NY,IER) C DATA( ) IS USED IN PSMAPF FOR THE SIN OF THE C LATITUDE, BUT IS NOT NEEDED IN AWND15M. C IF(IER.NE.0) THEN WRITE(KFILDO,4408) 4408 FORMAT(' ****FATAL ERROR CALCULATING MAP SCALE', 1 ' FACTOR IN PSMAPF. STOP AT 4408 IN AWND15M.') STOP 4408 ENDIF C ENDIF C IDIM=NX*NY C DO 4409 I=1,IDIM C CONVERT GRID ORIENTED WINDS FROM M/S TO GRIDLENGTHS C PER HALF HOUR USING THE MAP SCALE FACTOR C FDMS( ) DETERMINED ABOVE CFACT=(XMESHW/(FDMS(I)*1.8)) U(I)=U(I)/CFACT V(I)=V(I)/CFACT 4409 CONTINUE C C FILTER THE WINDS IF DESIRED C CALL UVWND2(KFILDO,U,V,NX,NY,CAFSM(10), 1 MESHW,MESHB) C C CONVERT THE SMOOTHED U,V WINDS TO GRIDLENGTHS PER 1/8 HR. C THE RETURN FROM UVWND2 IS GRIDLENGTHS PER 1/2 HR. C ADJUST=4.0 DO 4410 I=1,IDIM U(I)=U(I)/ADJUST V(I)=V(I)/ADJUST 4410 CONTINUE C C WRITE U ADVECTIVE WINDS TO INTERNAL STORAGE AND TDL C DISPOSABLE GRIDPOINT FILES. THE PROJECTION IS WRITTEN C WITH REFERENCE TO THE LAMP DATE/TIME. IN KEEPING C WITH OTHER MODELS, SMOOTHING IS INDICATED, AND THE C COMBINATION OF WINDS IS INDICATED IN LD(2) BY 777. C FOR PACKING, SINCE CP TIME IS MORE IMPORTANT THAN C SPACE, ONE GROUP IS USED (GROUP SIZE = NX*NY-2). C LD(1)=IDWND(1) LD(2)=777 LD(3)=LP LD(4)=080 STATE=' 441' WRITE(PLU(1:2),441,IOSTAT=IOS,ERR=900)LP 441 FORMAT(I2) STATE=' 442' WRITE(PLU(24:32),442,IOSTAT=IOS,ERR=900)LD(1) 442 FORMAT(I9.9) CALL PRSID1(KFILDO,LD,LDPARS) C CALL PAWING(KFILDO,KFIL10,NDATE, 1 LD,LDPARS(12),ITAUM,LAMPNO,NSEQ,ISCALD, 2 NPROJ,ALATL,ALONL,ORIENT,MESHB,MESHW,XLAT,NX,NY, 3 U,DATA,IWORK,IPACK,ND5,NX*NY-2, 4 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK, 5 IS0,IS1,IS2,IS4,ND7, 6 IPLU,PLU,NCHAR, 7 XMISSP,XMISSS,LX,IOCTET, 8 L3264B,L3264W,IER) IF(IER.NE.0) GO TO 550 C C TDLPACK AND WRITE U-ADVECTIVE WIND WHEN I4XXDG NE 0. C ALSO GRIDPOINT WHEN IP22 NE 0. C IF(I4XXDG.NE.0.AND.(KFILOG.GT.0.OR.IP22.GT.0))THEN C NXG=NX NYG=NY NXPG=NXP NYPG=NYP MESHG=MESHW C NXG, ETC. ARE NECESSARY BECAUSE SIZEGR CHANGE THEM, AND C NX, ETC. MUST BE RETAINED. CALL TRNSFR(U,FD9,NX*NY) CALL SIZEGR(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 MESHG,MESHLD,ITRPLQ,ND2X3) C THE SAME INTERPOLATION IS USED (IF NEEDED) AS FOR OTHER C USES IN U450. THE PROJECTION IS WRITTEN WITH REFERENCE C TO THE LAMP DATE/TIME. C IF(IP22.NE.0)THEN TITLT(1:40)=' -H U-ADVECT WNDS IN UNITS/HALF HR*10' STATE=' 460' WRITE(TITLT(1:2),460,IOSTAT=IOS,ERR=900)LP 460 FORMAT(I2) STATE=' 461' WRITE(TITLT(62:72),461,IOSTAT=IOS,ERR=900)LD(1) 461 FORMAT(I11.9) CALL PRTGR(IP22,FD9,NXG,NYG, 1 1./NRATIO,0.,10.,0.,IOPT,TITLT,IER) C CONTOUR AT 1 UNIT INTERVALS AT 1/4 BEDIENT MESH. C AFTER MULTIPLYING BY 10. C IF(IER.NE.0)THEN C ERROR GRIDPRINTING NOT COUNTED AS FATAL. ISTOP=ISTOP+1 IF(IP22.NE.KFILDO)WRITE(KFILDO,152) ENDIF C ENDIF C C THE GRID IN FD9( ) IS ALWAYS AT MESH LENGTH MESHLD AS A C RESULT OF SIZEGR, WHICH IS WHAT IS WANTED FOR THE C DISPOSABLE GRID. NOW CUT THE GRID TO THE DISPOSABLE C AREA. C CALL CUT(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 FD9,NXD,NYD,NXPD,NYPD) CALL PAWOTG(KFILDO,KFILOG,IP16,NDATE, 1 LD,LDPARS(12),ITAUM,LAMPNO,NSEQ,ISCALD, 2 NPROJ,ALATD,ALOND,ORIENT,MESHLD,XLAT,NXD,NYD, 3 FD9,DATA,IWORK,IPACK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLU,PLU,NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR WRITING DISPOSABLE GRIDS NOT COUNTED AS FATAL. C ENDIF C C TDLPACK AND WRITE MAP SCALE FACTOR FDMS AND U-ADVECTIVE WIND C WHEN I4XXDG NE 0. ALSO GRIDPOINT WHEN IP22 NE 0. C IF(I4XXDG.NE.0.AND.(KFILOG.GT.0.OR.IP22.GT.0))THEN NXG=NX NYG=NY NXPG=NXP NYPG=NYP MESHG=MESHW C NXG, ETC. ARE NECESSARY BECAUSE SIZEGR CHANGE THEM, AND C NX, ETC. MUST BE RETAINED. C C CUT THE FDMS ARRAY TO BE ON THE DISPOSABLE GRID SIZE. C CALL TRNSFR(FDMS,FD9,NX*NY) C CALL SIZEGR(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 MESHG,MESHLD,ITRPLQ,ND2X3) CALL CUT(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 FD9,NXD,NYD,NXPD,NYPD) C MAKE UP MAP SCALE FACTOR ID C LD(1)=007110005 LD(2)=000 LD(3)=LP LD(4)=000 STATE='4428' WRITE(PLMF(1:2),4428,IOSTAT=IOS,ERR=900)LP 4428 FORMAT(I2) STATE='4429' WRITE(PLMF(24:32),4429,IOSTAT=IOS,ERR=900)LD(1) 4429 FORMAT(I9.9) CALL PRSID1(KFILDO,LD,LDPARS) C C PACK UP THE FDMS( ) FACTOR. C CALL PAWOTG(KFILDO,KFILOG,IP16,NDATE, 1 LD,LDPARS(12),ITAUM,LAMPNO,NSEQ,ISCALD, 2 NPROJ,ALATD,ALOND,ORIENT,MESHLD,XLAT,NXD,NYD, 3 FD9,DATA,IWORK,IPACK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLMF,PLMF,NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR WRITING DISPOSABLE GRIDS NOT COUNTED AS FATAL. C ENDIF C C WRITE V ADVECTIVE WINDS TO INTERNAL STORAGE AND TDL C DISPOSABLE GRIDPOINT FILES. THE PROJECTION IS WRITTEN C WITH REFERENCE TO THE LAMP DATE/TIME. IN KEEPING C WITH OTHER MODELS, SMOOTHING IS INDICATED, AND THE C COMBINATION OF WINDS IS INDICATED IN LD(2) BY 777. C FOR PACKING, SINCE CP TIME IS MORE IMPORTANT THAN C SPACE, ONE GROUP IS USED (GROUP SIZE = NX*NY-2). C LD(1)=IDWND(2) LD(2)=777 LD(3)=LP LD(4)=080 STATE=' 463' WRITE(PLV(1:2),463,IOSTAT=IOS,ERR=900)LP 463 FORMAT(I2) STATE=' 464' WRITE(PLV(24:32),464,IOSTAT=IOS,ERR=900)LD(1) 464 FORMAT(I9.9) CALL PRSID1(KFILDO,LD,LDPARS) CALL PAWING(KFILDO,KFIL10,NDATE, 1 LD,LDPARS(12),ITAUM,LAMPNO,NSEQ,ISCALD, 2 NPROJ,ALATL,ALONL,ORIENT,MESHB,MESHW,XLAT,NX,NY, 3 V,DATA,IWORK,IPACK,ND5,NX*NY-2, 4 LSTORE,ND9,LITEMS,CORE,ND10,NBLOCK, 5 IS0,IS1,IS2,IS4,ND7, 6 IPLV,PLV,NCHAR, 7 XMISSP,XMISSS,LX,IOCTET, 8 L3264B,L3264W,IER) IF(IER.NE.0) GO TO 550 C C TDLPACK AND WRITE V-ADVECTIVE WIND WHEN I4XXDG NE 0. C ALSO GRIDPOINT WHEN IP22 NE 0. C IF(I4XXDG.NE.0.AND.(KFILOG.GT.0.OR.IP22.GT.0))THEN C NXG=NX NYG=NY NXPG=NXP NYPG=NYP MESHG=MESHW C NXG, ETC. ARE NECESSARY BECAUSE SIZEGR CHANGE THEM, AND C NX, ETC. MUST BE RETAINED. CALL TRNSFR(V,FD9,NX*NY) CALL SIZEGR(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 MESHG,MESHLD,ITRPLQ,ND2X3) C THE SAME INTERPOLATION IS USED (IF NEEDED) AS FOR OTHER C USES IN U450. THE PROJECTION IS WRITTEN WITH REFERENCE C TO THE LAMP DATE/TIME. C IF(IP22.NE.0)THEN TITLT(1:40)=' -H V-ADVECT WNDS IN UNITS/HALF HR*10' STATE=' 470' WRITE(TITLT(1:2),470,IOSTAT=IOS,ERR=900)LP 470 FORMAT(I2) STATE=' 471' WRITE(TITLT(62:72),471,IOSTAT=IOS,ERR=900)LD(1) 471 FORMAT(I11.9) CALL PRTGR(IP22,FD9,NXG,NYG, 1 1./NRATIO,0.,10.,0.,IOPT,TITLT,IER) C CONTOUR AT 1 UNIT INTERVALS AT 1/4 BEDIENT MESH. C AFTER MULTIPLYING BY 10. C IF(IER.NE.0)THEN C ERROR GRIDPRINTING NOT COUNTED AS FATAL. ISTOP=ISTOP+1 IF(IP22.NE.KFILDO)WRITE(KFILDO,152) ENDIF C ENDIF C C THE GRID IN FD9( ) IS ALWAYS AT MESH LENGTH MESHLD AS A C RESULT OF SIZEGR, WHICH IS WHAT IS WANTED FOR THE C DISPOSABLE GRID. NOW CUT THE GRID TO THE DISPOSABLE C AREA. C CALL CUT(KFILDO,FD9,NXG,NYG,NXPG,NYPG, 1 FD9,NXD,NYD,NXPD,NYPD) CALL PAWOTG(KFILDO,KFILOG,IP16,NDATE, 1 LD,LDPARS(12),ITAUM,LAMPNO,NSEQ,ISCALD, 2 NPROJ,ALATD,ALOND,ORIENT,MESHLD,XLAT,NXD,NYD, 3 FD9,DATA,IWORK,IPACK,ND5,MINPK, 4 IS0,IS1,IS2,IS4,ND7, 5 IPLV,PLV,NCHAR, 6 XMISSP,XMISSS,LX,IOCTET, 7 JTOTBY,JTOTRC,L3264B,L3264W,IER) IF(IER.NE.0)ISTOP=ISTOP+1 C ERROR WRITING DISPOSABLE GRIDS NOT COUNTED AS FATAL. C ENDIF C 500 CONTINUE C GO TO 600 C 520 CONTINUE C 550 IF(IER.NE.0)THEN WRITE(KFILDO,551) 551 FORMAT(' ****FATAL ERROR IN AWND15M.') ENDIF C 600 CONTINUE C D CALL TIMPR(KFILDO,KFILDO,'END AWND15M ') C RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. 900 CALL IERX(KFILDO,KFILDO,IOS,'AWND15M',STATE) STOP 9999 END