SUBROUTINE LMSTR5(KFILDO,IP11,ID,IDPARS,NPRED,NPREDX, 1 NDATE,NRRDAT,INCCYL, 2 LSTORE,LITEMS,MSTORE,MITEMS,ND9, 3 NCEPNO,LAMPNO,MAXIBN,MAXIBL,MAXIBO,ISTOP,IER) C C MARCH 2001 GLAHN TDL MOS-2000 C JUNE 2001 GLAHN ADDED IFIRST C JULY 2001 GLAHN ADDED DD = 4 FOR RADAR DATA C AUGUST 2001 GLAHN LOOP DO 510 ADDED; /D PRINT C APRIL 2002 GLAHN CORRECTED IER COMMENT C JUNE 2002 GLAHN CORRECTED FOR KEEPING RADAR DATA C 2 HOURS 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 MODIFIED USE OF MAXIBN C AUGUST 2015 SAMPLATSKY CHECK NEAR LABEL 231 REGARDING C MAXIBL, UNRESOLVED ISSUE C NOVEMBER 2016 GHIRARDELLI MODIFIED CHECKS ON OBS OR RADAR C GRIDS TO CHECK FOR TAU=00 INSTEAD OF C DD=0 OR 4 SINCE NEW MRMS AND TL GRIDS C HAVE DD=05 AS INPUT INTO U150. BUT WE C DO NOT WANT TO TREAT THESE OBS GRIDS C LIKE LAMP *FORECAST* GRIDS C NOVEMBER 2016 GHIRARDELLI CHANGED MAXHR FOR RADAR TO BE 1 C SINCE MRMS DATA IS PROCESSED FROM 2 HRS C BUT GIVEN THE MOST RECENT HOUR AS THE C DATE OF THE DATA. C JUNE 2018 HUANG CHANGED MSTORE(12,N) TO MSTORE(1,N) C TO FIX check bounds ISSUE. C C C PURPOSE C TO INITIALIZE MSTORE AND PREPARE LSTORE FOR GCPAC FOR U150. C C LMSTR5 MAY NOT KEEP INTERMEDIATE FIELDS THAT COULD BE C REUSED IF DATE/TIMES WERE SEQUENTIAL (E.G., 500 MB C HEIGHT AT PROJECTION 5 INTERPOLATED FROM PROJECTIONS C 3 AND 6). HOWEVER, THIS IS SMALL POTATOES, AND IT IS C LIKELY RUNNING CONSECUTIVE HOURS WILL NOT BE ROUTINE C (ARCHIVAL WILL LIKELY BE BY HOUR, RATHER THAN ALL C ALL HOURS). C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (INPUT) C IP11 = INDICATES WHETHER (>0) OR NOT (=0) C THE VARIABLE IDS OF THE ARCHIVED FIELDS C ACTUALLY NEEDED, IN ORDER AS THEY APPEAR ON C THE THE FIRST DAY OF THE ARCHIVE FILES C WILL BE PRINTED. THIS IS THE CONTENTS OF C MSTORE( , ). C ID(J,N) = THE INTEGER PREDICTOR IDS (J=1,4) (N=1,ND4). C (INPUT) C IDPARS(J,N) = THE PARSED, INDIVIDUAL COMPONENTS OF THE C PREDICTOR IDS 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 NPRED = THE NUMBER OF VARIABLES IN ID( , ) AND C IDPARS( , ) READ IN FROM THE U150.CN FILE. C (INPUT) C NPREDX = THE TOTAL NUMVER OF VARIABLES IN ID( , ) C AND IDPARS( , ) INCLUDING THE AUGMENTED LIST. C (INPUT) C NDATE = THE DAY 1 DATE/TIME. (INPUT) C NRRDAT = THE NEXT DATE/TIME IN THE LIST. (INPUT) C INCCYL = INCREMENT IN HOURS BETWEEN DATE/TIMES THAT C ARE PUT INTO IDATE( ) BY SUBROUTINE DATPRO. C USED IN LMSTR1 TO ASSURE THAT DATA ARE SAVED FOR C CYCLES AT THIS FREQUENCY. C LSTORE(L,J) = THE ARRAY HOLDING INFORMATION ABOUT THE DATA C STORED (L=1,12) (J=1,LITEMS). (INPUT-OUTPUT) C L=1,4--THE 4 IDS 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 TDL GRIB, 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 PREDICTOR IN THE C SORTED 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 LSTORE(11,N) IS 7777 + THE NUMBER OF THE C FIRST PREDICTOR IN THE SORTED LIST FOR C WHICH 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 C VARIABLE. C LITEMS = THE NUMBER OF ITEMS IN LSTORE( , ). C MSTORE(L,J) = THE ARRAY HOLDING THE VARIABLES NEEDED AS C INPUT, AFTER DAY 1, AND ASSOCIATED INFORMATION C (L=1,7) (J=1,MITEMS). (OUTPUT) C L=1,4 --THE 4 IDS FOR THE DATA. C L=5 --INDICATES WHETHER OR NOT TO STORE THE C VARIABLE AND THE FIRST PREDICTOR TO USE C IT FOR. C L=6 --INITIALLY, THE EARLIEST DATE/TIME FOR C WHICH THIS VARIABLE IS NEEDED FOR THE C DATE BEING PROCESSED. UPON EXIT, THE C VALUE WILL HAVE BEEN SET TO THE CYCLE C TIME. THERE WILL BE AN ENTRY IN C MSTORE( , ) FOR EACH CYCLE FOR WHICH C THE VARIABLE IS NEEDED. MSTORE( , ) C IS NOT CHANGED AFTER EXIT. C L=7 --THE MAXIMUM TIME OFFSET RR (SEE C IDPARS(9, ) CORRESPONDING TO C MSTORE(6, ) C NOTE THAT MSTORE IN U201 AND LMSTR5 IS NOT C EXACTLY THAT IN U600 AND RDVECT. U201 DOES C NOT USE RDVECT. C MITEMS = THE NUMBER OF ITEMS IN MSTORE( , ). C (OUTPUT) C ND9 = MAXIMUM NUMBER OF FIELDS STORED IN LSTORE( , ) C AND MSTORE( , ). SECOND DIMENSION OF C LSTORE( , ) AND MSTORE( , ). (INPUT) C NCEPNO = EXPECTED NCEP INPUT MODEL NUMBER. (INPUT) C LAMPNO = LAMP OUTPUT MODEL NUMBER AND EXPECTED LAMP C INPUT MODEL NUMBER. (INPUT) C MAXIBN = MAXIMUM OF IBACKN OF INDIVIDUAL MODULE .CN C FILES. IBACKN IS THE NUMBER OF 6-HR CYCLES C TO GO BACK FROM THE CURRENT (MOST RECENT) C CYCLE. (INPUT) C MAXIBL = MAXIMUM OF IBACKL OF INDIVIDUAL MODULE .CN C FILES. (INPUT) C MAXIBO = MAXIMUM OF NUMBER OF HOURS TO SAVE HOURLY C DATA FOR, ASSUMED TO BE 1. (INPUT) C ISTOP = INCREMENTED BY IF DD IN IDPARS(4, ) IS NOT C EXPECTED. (INPUT/OUTPUT) C IER = STATUS RETURN. (OUTPUT) C 0 = GOOD RETURN. C MINDAT = MINIMUM DATE FOR WHICH THIS VARIABLE MAY BE C NEEDED. (INTERNAL) C JCYL(J) = WORK ARRAY. COMPUTE ALL THE CYCLE TIMES NEEDE C (J=1,NOCYL). (INTERNAL) C NOCYL = NUMBER OF VALUES IN JCYL( ). (INTERNAL) C ITEMEN = THE ENTRY VALUE OF MITEMS. (INTERNAL) C IFIRST = ALLOWS INITIALIZING MSTORE ON ONLY THE C FIRST ENTRY. (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C UPDAT C DIMENSION ID(4,NPREDX),IDPARS(15,NPREDX) DIMENSION LSTORE(12,ND9),MSTORE(7,ND9) DIMENSION JCYL(24) C DATA JCYL/24*0/ DATA IFIRST/0/ C IER=0 C IF(IFIRST.EQ.0)THEN IFIRST=1 ELSE GO TO 410 ENDIF C MITEMS=1 C D WRITE(KFILDO,100)((LSTORE(I,J),I=1,12),J=1,LITEMS) D100 FORMAT(/' LSTORE STARTING LMSTR5'/(' ',3I10,I11,3I8,I12,3I8,I12)) C C COMPUTE ALL THE POSSIBLE CYCLE TIMES IN JCYL( ), MAXIMUM OF 24. C ONLY WHEN INCCYL NE 24 WILL NOCYL BE GT 1. C JCYLST=MOD(NDATE,100) JCYL(1)=JCYLST NOCYL=1 C DO 103 J=2,24 JCYLX=MOD(JCYLST+(J-1)*INCCYL,24) C*** IF(JCYLX.EQ.JCYLST)GO TO 1030 IF(JCYLX.EQ.JCYLST)GO TO 104 NOCYL=NOCYL+1 JCYL(NOCYL)=JCYLX 103 CONTINUE C D1030 WRITE(KFILDO,1031)NOCYL,(JCYL(J),J=1,NOCYL) D1031 FORMAT(/' IN LMSTR5 AT 1030--NOCYL,(JCYL(J),J=1,NOCYL)',25I3) C C FOR EACH AUGMENTED ENTRY IN ID( , ) AND IDPARS( , ), MAKE ONE C OR MORE ENTRIES IN MSTORE( , ). MSTORE(6, )WILL HAVE AN C ENTRY FOR EACH CYCLE NEEDED. MSTORE(3, ) WILL HAVE EACH C PROJECTION NEEDED REPRESENTED. C 104 DO 400 N=NPRED+1,NPREDX C IF(IDPARS(4,N).EQ.0.OR.IDPARS(4,N).EQ.4.OR. 1 IDPARS(12,N).EQ.0)THEN C C THIS IS AN OBSERVATION - EITHER A RADAR RCM GRID (DD 4) C OR A TL OBS GRID (0075) OR AN MRMS GRID (0078). ALL C GRIDS HAVE A TAU (IDPARS(12,N)) EQUAL TO 0. C NSTART=MITEMS MAXHR=MAXIBO IF(IDPARS(12,N).EQ.0)MAXHR=1 C IF(IDPARS(4,N).EQ.4)MAXHR=2 THIS WAS NEEDED FOR RCM DATA C THIS HARDWIRES THE KEEPING OF RADAR FOR 2 HOURS, AND IS C IN AGREEMENT WITH AUGIDS. THIS WILL ASSURE 1 FULL HOUR C FOR SD ANALYSIS. MRMS DATA FROM CURRENT HOUR AND MOST C RECENT HOUR PREPROCESSED TO HAVE CURRENT HOUR ON DATA. C SO MAXHR NEEDS TO BE JUST 1. DO 120 INC=1,MAXHR+1,1 C DO 110 J=1,NOCYL MSTORE(1,MITEMS)=ID(1,N) MSTORE(2,MITEMS)=ID(2,N) MSTORE(3,MITEMS)=0 C THE PROJECTION FOR AN OBSERVATION = 0. MSTORE(4,MITEMS)=ID(4,N) MSTORE(5,MITEMS)=7777 MSTORE(6,MITEMS)=MOD(JCYL(J)-(INC-1)+24,24) C MSTORE(6, ) CONTAINS A CYCLE TIME NEEDED. MSTORE(7,MITEMS)=IDPARS(9,N) D WRITE(KFILDO,106)N,INC,J, D 1 (MSTORE(I,MITEMS),I=1,7) D106 FORMAT(' AT 106--N,INC,J, (MSTORE(I,MITEMS))', D 1 3I4,4X,4I10.9,3I6) MITEMS=MITEMS+1 C IF(MITEMS.LE.ND9)GO TO 110 WRITE(KFILDO,109)ND9,((MSTORE(I,L),I=1,7),L=1,ND9) 109 FORMAT(/' ****ND9 = ',I5,' ABOUT TO BE EXCEEDED IN', 1 ' LMSTR5'/' ENTRIES ALREADY MADE ARE:'/ 2 (' ',4I11,I6,I11,I6)) WRITE(KFILDO,1090) 1090 FORMAT(' STOP AT 1090') STOP 1090 C 110 CONTINUE C C ELIMINATE DUPLICATES. C L=NSTART M=L C 1105 IF(M.NE.L)THEN IF(MSTORE(1,L).EQ.MSTORE(1,M).AND. 1 MSTORE(2,L).EQ.MSTORE(2,M).AND. 2 MSTORE(3,L).EQ.MSTORE(3,M).AND. 3 MSTORE(4,L).EQ.MSTORE(4,M).AND. 4 MSTORE(6,L).EQ.MSTORE(6,M))THEN C DO 113 K=M,MITEMS-1 C DO 112 I=1,7 MSTORE(I,K)=MSTORE(I,K+1) 112 CONTINUE C 113 CONTINUE C MITEMS=MITEMS-1 IF(M.LE.MITEMS)GO TO 1105 C MUST LOOK AT ENTRY M AGAIN, OR THE TOP C VALUE MOVED UP WILL BE MISSED. ENDIF C ENDIF C M=M+1 IF(M.LE.MITEMS)GO TO 1105 L=L+1 M=L IF(L.LE.MITEMS)GO TO 1105 C 120 CONTINUE C ELSEIF(IDPARS(4,N).EQ.NCEPNO)THEN C C THIS IS AN NCEP FIELD. C DO 230 NPROJ=0,36,3 NSTART=MITEMS C DO 220 INC=1,(MAXIBN+1)*6 C DO 210 J=1,NOCYL MSTORE(1,MITEMS)=ID(1,N) MSTORE(2,MITEMS)=ID(2,N) MSTORE(3,MITEMS)=ID(3,N)-((ID(3,N)/1000)*1000) 1 +NPROJ C MSTORE(3, ) CONTAINS A PROJECTION MSTORE(4,MITEMS)=ID(4,N) MSTORE(5,MITEMS)=7777 MSTORE(6,MITEMS)= 1 MOD(JCYL(J)-(INC-1)+24*(MAXIBN+1),24) C MSTORE(6, ) CONTAINS A CYCLE TIME NEEDED, UNLESS C NCEP DATA ARE NOT AVAILABLE. IF(MOD(MSTORE(6,MITEMS),6).NE.0)GO TO 210 C THIS TEST ELIMINATES ALL BUT 6-H CYCLES. C MSTORE(6, ) CONTAINS A CYCLE TIME NEEDED. MSTORE(7,MITEMS)=IDPARS(9,N) D WRITE(KFILDO,126)N,INC,J,NPROJ, D 1 (MSTORE(I,MITEMS),I=1,7) D126 FORMAT(' AT 126--N,INC,J,NPROJ,(MSTORE(I,MITEMS))', D 1 4I4,4I10.9,3I6) MITEMS=MITEMS+1 C IF(MITEMS.LE.ND9)GO TO 210 WRITE(KFILDO,209)ND9,((MSTORE(I,L),I=1,7),L=1,ND9) 209 FORMAT(/' ****ND9 = ',I5,' ABOUT TO BE EXCEEDED ', 1 ' IN LMSTR5'/' ENTRIES ALREADY MADE', 2 ' ARE:'/(' ',4I11,I6,I11,I6)) WRITE(KFILDO,2090) 2090 FORMAT(' STOP AT 2090') STOP 2090 C 210 CONTINUE C C ELIMINATE DUPLICATES. C L=NSTART M=L C 2105 IF(M.NE.L)THEN IF(MSTORE(1,L).EQ.MSTORE(1,M).AND. 1 MSTORE(2,L).EQ.MSTORE(2,M).AND. 2 MSTORE(3,L).EQ.MSTORE(3,M).AND. 3 MSTORE(4,L).EQ.MSTORE(4,M).AND. 4 MSTORE(6,L).EQ.MSTORE(6,M))THEN C DO 213 K=M,MITEMS-1 C DO 212 I=1,7 MSTORE(I,K)=MSTORE(I,K+1) 212 CONTINUE C 213 CONTINUE C MITEMS=MITEMS-1 IF(M.LE.MITEMS)GO TO 2105 C MUST LOOK AT ENTRY M AGAIN, OR THE TOP C VALUE MOVED UP WILL BE MISSED. ENDIF C ENDIF C M=M+1 IF(M.LE.MITEMS)GO TO 2105 L=L+1 M=L IF(L.LE.MITEMS)GO TO 2105 C 220 CONTINUE C 230 CONTINUE C ELSEIF(IDPARS(4,N).EQ.LAMPNO)THEN C C THIS IS A LAMP FIELD. C DO 330 NPROJ=0,24,1 NSTART=MITEMS C c---------------------------------------------- c c for some reason maxibl=0 does not work with new rad/ltg c variables? forcing it to 1 works c c if (maxibl.eq.0) maxibl=1 c---------------------------------------------- DO 320 INC=1,MAXIBL,1 C DO 310 J=1,NOCYL MSTORE(1,MITEMS)=ID(1,N) MSTORE(2,MITEMS)=ID(2,N) MSTORE(3,MITEMS)=ID(3,N)-((ID(3,N)/1000)*1000) 1 +NPROJ C MSTORE(3, ) CONTAINS A PROJECTION MSTORE(4,MITEMS)=ID(4,N) MSTORE(5,MITEMS)=7777 MSTORE(6,MITEMS)=MOD(JCYL(J)-(INC-1)+24,24) C MSTORE(6, ) CONTAINS A CYCLE TIME NEEDED. MSTORE(7,MITEMS)=IDPARS(9,N) D WRITE(KFILDO,236)N,INC,J,NPROJ, D 1 (MSTORE(I,MITEMS),I=1,7) D236 FORMAT(' AT 123--N,INC,J,NPROJ,(MSTORE(I,MITEMS))', D 1 4I4,4I10.9,3I6) MITEMS=MITEMS+1 C IF(MITEMS.LE.ND9)GO TO 310 WRITE(KFILDO,309)ND9,((MSTORE(I,L),I=1,7),L=1,ND9) 309 FORMAT(/' ****ND9 = ',I5,' ABOUT TO BE EXCEEDED ', 1 'IN LMSTR5'/' ENTRIES ALREADY MADE ', 2 'ARE:'/(' ',4I11,I6,I11,I6)) WRITE(KFILDO,3090) 3090 FORMAT(' STOP AT 3090') STOP 3090 C 310 CONTINUE C C ELIMINATE DUPLICATES. C L=NSTART M=L C 3105 IF(M.NE.L)THEN IF(MSTORE(1,L).EQ.MSTORE(1,M).AND. 1 MSTORE(2,L).EQ.MSTORE(2,M).AND. 2 MSTORE(3,L).EQ.MSTORE(3,M).AND. 3 MSTORE(4,L).EQ.MSTORE(4,M).AND. 4 MSTORE(6,L).EQ.MSTORE(6,M))THEN C DO 313 K=M,MITEMS-1 C DO 312 I=1,7 MSTORE(I,K)=MSTORE(I,K+1) 312 CONTINUE C 313 CONTINUE C MITEMS=MITEMS-1 IF(M.LE.MITEMS)GO TO 3105 C MUST LOOK AT ENTRY M AGAIN, OR THE TOP C VALUE MOVED UP WILL BE MISSED. ENDIF C ENDIF C M=M+1 IF(M.LE.MITEMS)GO TO 3105 L=L+1 M=L IF(L.LE.MITEMS)GO TO 3105 C 320 CONTINUE C 330 CONTINUE C ELSE WRITE(KFILDO,335)IDPARS(4,N) 335 FORMAT(/' ****UNEXPECTED DD IN IDPARS(4, ) =',I3, 1 ' IN LMSTR5. PROCEEDING.') ISTOP=ISTOP+1 ENDIF C 400 CONTINUE C C ARRANGE TO DISCARD ALL DATA NOT NEEDED. C 410 DO 500 N=1,MITEMS C DO 490 L=1,LITEMS C IF(MSTORE(1,N).EQ.LSTORE(1,L).AND. 1 MSTORE(2,N).EQ.LSTORE(2,L).AND. 2 MSTORE(3,N).EQ.LSTORE(3,L).AND. 3 MSTORE(4,N).EQ.LSTORE(4,L))THEN C IF(MOD(MSTORE(4,N),100).EQ.0)THEN C C THIS IS AN OBSERVATION OR A RADAR (RCM OR C MRMS) OR TOTAL LIGHTNING GRID. ALL HAVE 00 AS C TAU IN THE 4TH WORD. C MAXHR=MAXIBO IF(MOD(MSTORE(1,N),100).EQ.0)MAXHR=1 C IF(MOD(MSTORE(1,N),100).EQ.4)MAXHR=2 NEEDED FOR RCM C THIS HARDWIRES THE KEEPING OF RADAR FOR 2 HOURS, AND IS C IN AGREEMENT WITH AUGIDS. THIS WILL ASSURE 1 FULL HOUR C FOR SD ANALYSIS. FOR RCM DATA MAXHR HAD TO BE 2. C FOR MRMS DATA, IT IS PREPROCESSED SO THAT THE DATA C FROM THE CURRENT HOUR AND THE PREVIOUS HOUR BOTH C HAVE DATES FOR THE CURRENT HOUR, SO MAXHR=1 CALL UPDAT(LSTORE(8,L),MAXHR,LSTORE(12,L)) C IF(LSTORE(12,L).LT.NRRDAT)THEN LSTORE(1,L)=0 C THIS ENTRY IN LSTORE( , ) CAN BE DISCARDED. ENDIF C ELSEIF(MOD(MSTORE(1,N),100).EQ.NCEPNO)THEN C C THIS IS AN NCEP FIELD. C CALL UPDAT(LSTORE(8,L),(MAXIBN+1)*6,LSTORE(12,L)) C MAXIBN REFERS TO 6-H INCREMENTS. C IF(LSTORE(12,L).LT.NRRDAT)THEN LSTORE(1,L)=0 C THIS ENTRY IN LSTORE( , ) CAN BE DISCARDED. ENDIF C ELSEIF(MOD(MSTORE(1,N),100).EQ.LAMPNO)THEN C C THIS IS A LAMP FIELD. C CALL UPDAT(LSTORE(8,L),MAXIBL,LSTORE(12,L)) C IF(LSTORE(12,L).LT.NRRDAT)THEN LSTORE(1,L)=0 C THIS ENTRY IN LSTORE( , ) CAN BE DISCARDED. ENDIF C ENDIF C ENDIF C 490 CONTINUE C 500 CONTINUE C MITEMS=MITEMS-1 C C THE LOOP BELOW IS FOR ITEMS IN LSTORE( , ) NOT C IN THE MSTORE( , ) LIST. C DO 510 J=1,LITEMS IF(LSTORE(12,J).LT.NRRDAT)LSTORE(1,J)=0 510 CONTINUE C D IF(IP11.NE.0)WRITE(IP11,521)((MSTORE(I,J),I=1,7),J=1,MITEMS) D521 FORMAT(/' MSTORE'/(' ',3I10,I11,3I8)) C NOTE THAT MSTORE IS PRINTED IN U150. C D WRITE(KFILDO,520)((LSTORE(I,J),I=1,12),J=1,LITEMS) D520 FORMAT(/' LSTORE ENDING LMSTR5'/(' ',3I10,I11,3I8,I12,3I8,I12)) C***D WRITE(KFILDO,522)((ID(I,J),I=1,4),J=1,NPREDX) C***D522 FORMAT(/' ID ENDING LMSTR5'/(' ',3I10,I11)) RETURN END