PROGRAM LTGGRIDS C C MARCH 2017 SAMPLATSKY MDL MOS-2000 C APRIL 2017 SAMPLATSKY MODIFIED IDS TO FINAL APPROVED C IDS. C DECEMBER 2017 SAMPLATSKY MODIFIED HANDLING OF READING THE C INGEST DATA TO ALLOW AN ERROR IN C FILE READING TO STILL ALLOW AN C OUTPUT FILE TO BE CREATED, WHICH C WILL CONTAIN GRIDS FILLED WITH 0. C ALSO MADE A COUPLE PRINT MESSAGES C MORE ACCURATE. C APRIL 2018 HUANG REDIFINED PLAIN TO BE 32 CHARACTER TO C BE CONSISTENT WITH OTHER SUBROUTINES. C ALSO INITIALIZED PLAIN AS 32 BLANK C CHARACTERS. C SEPTEMBER 2020 SAMPLATSKY INITIALIZE IOSTAT=0 TO SATISFY C CHECK ALL COMPILER OPTION. ALSO C AS A QUICK FIX, ADJUSTED THE C ALLOCATION OF LGRID TO MAXVAR C INSTEAD OF NUMVAR. A BETTER FIX C WILL BE DONE FOR LAMP 3.0 C DECEMBER 2022 SAMPLATSKY ADJUSTED LOGIC TO PROCESS 15 MIN C LTG GRIDS FOR CORRESPONDING TO C HH:30 AND HH:00 RADAR DATA. C APRIL 2024 SAMPLATSKY MODIFIED THE WRITE 125 STATEMENT C TO NOT USE A VARIABLE FORMAT, C TO PREVENT A COMPILE WARNING. C C PURPOSE C READ ASCII FILE CONTAINING LIGHTNING FLASH DATA, THEN C PLACE THE DATA ON A GRID (SPECIFIED IN CONTROL FILE), C AND FINALLY OUTPUT A TDLPACK GRID FILE CONTAINING ALL C DESIRED GRIDDING LTG DATA. C C C VARIABLES C CONVERTX = CHARACTER VARIABLE HOLDING THE KEYWORD USED TO OPEN C OUTPUT FILE WITH THE CORRECT ENDIAN. C (CHARACTER*20) (INTERNAL). C C C VARIABLES C NUMVAR = NUMBER OF INPUT AND OUTPUT MRMS VARIABLES. C (PARAMETER) C IPACK(N) = ARRAY CONTAINING PACKED DATA IN TDLPACK GRID C INPUT FILE (N=1,ND1). (INTERNAL) C NID = MAXIMUM NUMBER OF VARIABLE IDS TO BE PROCESSED. C DIMENSION OF ID_OLD( , ), ID_NEW( , ), JTYPE( ). C ID_OLD(J,K) = VARIABLE IDS ON INPUT FILE (J=1,4; K=1,NID). C (INPUT) C ID_NEW(J,K) = VARIABLE IDS ON OUTPUT FILES (J=1,4; K=1,NID). C (INPUT) C NBYTES = NUMBER OF BYTES IN RECORD TO FOLLOW. C IS0( ) = MOS-2000 GRIB SECTION 0 (8 BYTES) C 1 - "TDLP" C 2 - RECORD LENGTH IN BYTES C IS1( ) = MOS-2000 GRIB SECTION 1 C 9-12 TDL 4-WORD ID C IS2( ) = MOS-2000 GRIB SECTION 2 C 2 - MAP PROJECTION C 3 - NX NUMBER OF GRID POINTS IN X DIRECTION C 4 - NY NUMBER OF GRID POINTS IN Y DIRECTION C 5 - LATITUDE OF LOWER LEFT CORNER, DEGREE*10000 C 6 - LONGITUDE OF LOWER LEFT CORNER, DEGREE*10000 C 7 - GRID ORIENTATION, DEGREE*10000 C 8 - GRID LENGTH, MILLIMETERS C 9 - LATITUDE AT WHICH MESH APPLIES, C DEGREES*10000; ALSO TANGENCY LATITUDE C IS4( ) = MOS-2000 GRIB SECTION 4 C L3264B = WORD LENGTH OF MACHINE YOU ARE RUNNING ON C 32 OR 64. C L3264W = 64/L3264B C ND7 = DIMENSION OF IS0( ), IS2( ), AND IS4( )(=60). C ND1 = DIMENSION OF IPACK( ) AND DATA( ) - THE C PACKED AND UNPACKED DATA, RESPECTIVELY. C ND1 = DIMENSION OF CCALL( ), THE "STATION CALL C LETTERS". C KREC = COUNTER FOR ALL PACKED DATA RECORDS READ FROM C INPUT FILE. (INTERNAL) C ISTRT = FIRST UNPACKED "DATA" RECORD TO PRINT OUT. C (INPUT) C IFIN = LAST UNPACKED "DATA" RECORD TO PRINT OUT. C (INPUT) C JTYPE(N) = THE TYPE OF OUTPUT FOR THE CERTAIN ID (N=1,NID). C = 1 VECTOR FILE, = 2 GRID FILE, = 3 BOTH C C COMMON BLOCKS: NONE C C C SUBPROGRAMS CALLED: C UNDAT, WRVTGD C C23456789112345678921234567893123456789412345678951234567896123456789712 C PARAMETER (ND1=3000000,ND7=60,L3264B=32,L3264W=64/L3264B) PARAMETER (MAXVAR=6) C INTEGER, ALLOCATABLE, DIMENSION (:,:,:) :: LGRID C DIMENSION IS0(ND7),IS1(ND7),IS2(ND7),IS4(ND7),DATA(ND1) DIMENSION IPLAIN(L3264W,4),ID(4,MAXVAR),JD(4),NBYTES(2) C CHARACTER*1 STA1(8),XTMP CHARACTER*32 PLAIN CHARACTER*8 CCALL(ND1),STA8(1) CHARACTER*60 INFILE,OUTFILE,DATFILE CHARACTER*255 JUNK C EQUIVALENCE (IPLAIN,PLAIN) EQUIVALENCE (STA8,STA1) CINTEL CHARACTER(LEN=20) :: CONVERTX C CONVERTX='BIG_ENDIAN' CINTEL DATA KFILDI/5/,KFILDO/6/,KFILVT/99/ DATA PLAIN/' '/ C NBYWD = L3264B/8 IOSTAT = 0 C CALL TIMPR(KFILDO,KFILDO,'START LMP_LTGGRIDS ') C C READ CONTROL FILE INFO C READ(KFILDI,100) JUNK 100 FORMAT(A255) READ(KFILDI,105) IPBOX,NPROJ,NX,NY,MESH,XMESHL,XLATLL,XLONLL, 1 XLAT,ORIENT,NUMVAR 105 FORMAT(5(I10/),5(F10.0/),I10) C C ERROR CHECKS FROM GRID/VARIABLE PARAMETERS C IF (NUMVAR.GT.MAXVAR) THEN WRITE(KFILDO,110) MAXVAR,NUMVAR 110 FORMAT(/,' **** ID LIST IN CONTROL FILE IS TOO LONG. ', 1 ' INCREASE MAXVAR FROM ',I4,' TO ',I4,' ... ', 2 ' STOP 110') CALL W3TAGE('LMP_LTGGRIDS') STOP 110 END IF C IF (NX*NY.GT.ND1) THEN WRITE(KFILDO,111) NX,NY,ND1,NX*NY 111 FORMAT(/,' **** READ IN NX,NY OF ',2I6,' ... INCREATE ND1', 1 ' FROM ',I10,' TO AT LEAST ',I10,'. STOP 111') CALL W3TAGE('LMP_LTGGRIDS') STOP 111 END IF C C READ IN ID LIST TO PROCESS C DO N=1,NUMVAR READ(KFILDI,115) ID(1,N),ID(2,N) 115 FORMAT(2I10) END DO C C READ INPUT/OUTPUT FILES C READ(KFILDI,120) KFILDT,DATFILE READ(KFILDI,120) IJUNK,JUNK READ(KFILDI,120) KFILIN,INFILE READ(KFILDI,120) IJUNK,JUNK READ(KFILDI,120) KFILOUT,OUTFILE 120 FORMAT(I3,4X,A60) C C PRINT CONTROL FILE INFO TO KFILDO C C 4/26/24: PS REMOVED PRINTING OF ID LIST FROM PRINT C STATEMENT BELOW - CAUSED COMPILER WARNING C C WRITE(KFILDO,125) NPROJ,NX,NY,MESH,XMESHL,XLATLL,XLONLL,XLAT, C 1 ORIENT,NUMVAR,((ID(K,N),K=1,2),N=1,NUMVAR), C 2 KFILDT,DATFILE,KFILIN,INFILE,KFILOUT,OUTFILE WRITE(KFILDO,125) NPROJ,NX,NY,MESH,XMESHL,XLATLL,XLONLL,XLAT, 1 ORIENT,NUMVAR, 2 KFILDT,DATFILE,KFILIN,INFILE,KFILOUT,OUTFILE 125 FORMAT(/,' MAP PROJECTION OF GRID: ',I10, 2 /,' NX OF GRID: ',I10, 3 /,' NY OF GRID: ',I10, 4 /,' NOMINAL MESH OF GRID (KM): ',I10, 5 /,' ACTUAL MESH OF GRID (M): ',F10.3, 6 /,' LOWER LEFT LATITUDE: ',F10.3, 7 /,' LOWER LEFT LONGITUDE: ',F10.3, 8 /,' XLAT: ',F10.3, 9 /,' ORIENT: ',F10.3,/, X /,' NUMBER OF VARIABLES TO PROCESS: ',I10, C 1 /,<NUMVAR>(I10,I10/),/, C 1 /,10(I10,I10/),/, 2 /,' UNIT AND NAME OF DATE FILE: ',I2,2X,A60, 3 /,' UNIT AND NAME OF INPUT FILE: ',I2,2X,A60, 4 /,' UNIT AND NAME OF OUTPUT FILE: ',I2,2X,A60) C C OPEN DATE FILE WITH CONVERT= SPECIFIER C OPEN(UNIT=KFILDT,FORM='FORMATTED',STATUS='OLD', 1 IOSTAT=IOS,ERR=150) 150 IF (IOSTAT.NE.0) THEN WRITE(KFILDO,155)KFILDT,IOS 155 FORMAT(/,' ****TROUBLE OPENING FILE ON UNIT NO.',I3, 1 '. IOSTAT =',I5,' STOP 150') CALL W3TAGE('LMP_LTGGRIDS') STOP 150 ENDIF C C READ AND PRINT THE DATE TO BE PROCESSED C CALL GET_NCEPDATE(KFILDT,IYR,IMO,IDA,IHR,KDATE,IER) C IF(IER.NE.0)THEN WRITE(KFILDO,160) 160 FORMAT(/' ****ERROR: CAN NOT READ NCEP DATE FILE - ', 1 'FATAL ERROR IN LTGGRIDS. STOP 160.') CALL W3TAGE('LMP_LTGGRIDS') STOP 160 ENDIF C C KDATE REPRESENTS THE "CURRENT" HOUR. ALSO NEEDED IS THE C PREVIOUS HOUR, WHICH WILL BE IN KDATEM1. FOR USE IN C DATA INGEST BELOW, ALSO DEFINE VARIABLES TO REPRESENT THE C COMPONENTS OF KDATEM1. C CALL UPDAT(KDATE,-1,KDATEM1) IYRM1=MOD(KDATEM1/1000000,100) IMOM1=MOD(KDATEM1/10000,100) IDAM1=MOD(KDATEM1/100,100) IHRM1=MOD(KDATEM1,100) C WRITE(KFILDO,170) KDATE,KDATEM1 170 FORMAT(/,' CURRENT HOUR DATE: ',I10, 1 /,' PREVIOUS HOUR DATE: ',I10) C C OPEN ASCII INPUT FILE. C OPEN(UNIT=KFILIN,FORM='FORMATTED', 1 STATUS='OLD',IOSTAT=IOS,ERR=200) C 200 IF (IOSTAT.NE.0) THEN WRITE(KFILDO,210) KFILIN,IOS 210 FORMAT(/,' **** TROUBLE OPENING INPUT FILE UNIT NO.',I3, 1 '. IOSTAT=',I5,' STOP 200') CALL W3TAGE('LMP_LTGGRIDS') STOP 200 END IF C C OPEN TDLPACK OUTPUT FILE. C OPEN(UNIT=KFILOUT,FORM='UNFORMATTED', 1 STATUS='NEW',CONVERT=CONVERTX,IOSTAT=IOS,ERR=250) C 250 IF (IOSTAT.NE.0) THEN WRITE(KFILDO,260) KFILOUT,IOS 260 FORMAT(/,' **** TROUBLE OPENING OUTPUT FILE UNIT NO.',I3, 1 '. IOSTAT=',I5,' STOP 250') CALL W3TAGE('LMP_LTGGRIDS') STOP 250 END IF C C ALLOCATE LGRID, BASED ON CONTROL FILE INFO READ IN, THEN C INITIALIZE LGRID TO 0. C SEPT 2020 - CRUDE FIX TO SATISFY CHECK-ALL: ALLOCATE BY C MAXVAR INSTEAD OF NUMVAR. THIS IS A PROBLEM BECAUSE FOR C AK, NUMVAR=3 WHICH IS LESS THAN MAXVAR, WHILE LOGIC BELOW C WILL SPECIFICALLY WORK ON LGRID(MAXVAR, , ). THIS FIX IS C SAFE SINCE LGRID(MAXVAR, , ) IS NOT USED FOR ALASKA, AND C FOR CONUS, NUMVAR=MAXVAR. C ALLOCATE(LGRID(MAXVAR,NX,NY),STAT=IOS) C ALLOCATE(LGRID(NUMVAR,NX,NY),STAT=IOS) DO N=1,NUMVAR DO J=1,NY DO I=1,NX LGRID(N,I,J)=0 END DO END DO END DO C C READ IN LTG FLASH DATA FROM INPUT ASCII FILE. C NTOTREC=0 ! TOTAL # RECORDS IN FILE NUSEREC=0 ! TOTAL # RECORDS TO USE FROM FILE NUM60M=0 ! TOTAL # OF FLASHES IN 60M PERIOD NUM30M=0 ! TOTAL # OF FLASHES IN 30M PERIOD NUM15M1=0 ! TOTAL # OF FLASHES IN 20-35 FROM PREV HR NUM15M2=0 ! TOTAL # OF FLASHES IN 35-50 FROM PREV HR NUM15M3=0 ! TOTAL # OF FLASHES IN 50-05 FROM PREV-CURR HR NUM15M4=0 ! TOTAL # OF FLASHES IN 05-20 FROM CURR HR C C PATCH 12/11/17 - CHANGED ERR= SPECIFIER BELOW TO ALLOW C OUTPUT OF GRIDS INITIALIZED TO 0. C 300 READ(KFILIN,305,END=400,ERR=400) IRMO,IRDA,IRYR,IRHR,IRMIN,ISEC, 1 RLAT,RLON,RSIG,IRSTYPE 305 FORMAT(5(I2,1X),I2,F8.3,F9.3,F8.1,3X,I3) NTOTREC=NTOTREC+1 C C CHECK THE TIME READ IN AGAINST THE NECESSARY TIME WINDOW. C THIS WINDOW IS DEFINED AS THE CURRENT AND PREVIOUS HOUR AS C DEFINED PREVIOUSLY BY IHR AND IHRM1. NOTE THAT IF THE READ C IN HOUR IS GREATER THAN THE CURRENT HOUR. C IF ((IRHR.EQ.IHRM1.AND.IRMIN.GE.15).OR. 1 (IRHR.EQ.IHR.AND.IRMIN.LE.20)) THEN C C THIS FLASH IS WITHIN THE TIME WINDOW. NOW DETERMINE THE C GRID COORDINATE OF THIS FLASH. C RLON=-RLON IF(NPROJ.EQ.5) CALL PSLLIJ(KFILDO,RLAT,RLON,XMESHL,ORIENT, 1 XLAT,XLATLL,XLONLL,GRIDX,GRIDY) IF(NPROJ.EQ.3) CALL LMLLIJ(KFILDO,RLAT,RLON,XMESHL,ORIENT, 1 XLAT,XLATLL,XLONLL,GRIDX,GRIDY) C C BASED ON READ IN IPBOX PARAMETER, "POSITION" THE STRIKE C WITHIN THE GRID BOX. C IF (IPBOX.EQ.1) THEN ! LOWER LEFT CORNER JCOR=GRIDY ICOR=GRIDX ELSE ! CENTER JCOR=NINT(GRIDY) ICOR=NINT(GRIDX) END IF C C MAKE SURE COORDINATE IS WITHIN THE BOUNDS OF THE GRID. C IF ((ICOR.GE.1.AND.ICOR.LE.NX).AND. 1 (JCOR.GE.1.AND.JCOR.LE.NY)) THEN NUSEREC=NUSEREC+1 C C UPDATE CORRESPONDING FLASH COUNT GRIDS BASED ON WHEN C THE FLASH OCCURRED. C C 60 MIN FLASH COUNT C IF ((IRHR.EQ.IHRM1.AND.IRMIN.GE.15).OR. 1 (IRHR.EQ.IHR.AND.IRMIN.LT.15)) THEN NUM60M=NUM60M+1 LGRID(1,ICOR,JCOR)=LGRID(1,ICOR,JCOR)+1 END IF C C (MOST RECENT) 30 MIN FLASH COUNT C IF ((IRHR.EQ.IHRM1.AND.IRMIN.GE.45).OR. 1 (IRHR.EQ.IHR.AND.IRMIN.LT.15)) THEN NUM30M=NUM30M+1 LGRID(2,ICOR,JCOR)=LGRID(2,ICOR,JCOR)+1 END IF C C 15 MIN FLASH COUNT, FOR MRMS QC PREV HR HH:30 C IF ((IRHR.EQ.IHRM1.AND.IRMIN.GE.20).AND. 1 (IRHR.EQ.IHRM1.AND.IRMIN.LT.35)) THEN NUM15M1=NUM15M1+1 LGRID(3,ICOR,JCOR)=LGRID(3,ICOR,JCOR)+1 END IF C C 15 MIN FLASH COUNT, FOR MRMS QC PREV HR HH:45 C IF ((IRHR.EQ.IHRM1.AND.IRMIN.GE.35).AND. 1 (IRHR.EQ.IHRM1.AND.IRMIN.LT.50)) THEN NUM15M2=NUM15M2+1 LGRID(4,ICOR,JCOR)=LGRID(4,ICOR,JCOR)+1 END IF C C 15 MIN FLASH COUNT, FOR MRMS QC CURR HR HH:00 C IF ((IRHR.EQ.IHRM1.AND.IRMIN.GE.50).OR. 1 (IRHR.EQ.IHR.AND.IRMIN.LT.05)) THEN NUM15M3=NUM15M3+1 LGRID(5,ICOR,JCOR)=LGRID(5,ICOR,JCOR)+1 END IF C C 15 MIN FLASH COUNT, FOR MRMS QC CURR HR HH:15 C IF ((IRHR.EQ.IHR.AND.IRMIN.GE.05).AND. 1 (IRHR.EQ.IHR.AND.IRMIN.LT.20)) THEN NUM15M4=NUM15M4+1 LGRID(6,ICOR,JCOR)=LGRID(6,ICOR,JCOR)+1 END IF C END IF ! MAKING SURE FLASH FALLS WITHIN GRID C END IF ! MAKING SURE FLASH IS WITHIN TIME WINDOW C C READ ANOTHER RECORD. ADVANCING BEYOND HERE WILL HAPPEN WHEN C THE EOF IS READ. C GOTO 300 ! READS NEXT RECORD FROM INGEST FILE C C EOF REACHED ON INPUT FILE. PRINT OUT SOME INFORMATION ON C WHAT WAS READ IN. NOTE THERE IS NO WAY TO DISTINGUISH C BETWEEN A PROBLEM WITH THE LIGHTNING DATA FEED, OR NO C LIGHTNING OCCURRING. WHILE A MESSAGE WILL GET PRINTED WHEN C THIS SCENARIO OCCURS, NO ERROR WILL BE RETURNED, AND WHAT C GETS OUTPUT ARE GRIDS CONTAINING VALUES OF 0. C 400 IF (NTOTREC.EQ.0) THEN WRITE(KFILDO,405) 405 FORMAT(/,' **** THIS IS NOT NECESSARILY AN ERROR, BUT A FILE', 1 ' WAS CREATED CONTAINING NO LIGHTNING FLASHES. THE', 2 ' OUTPUT WILL BE GRIDS FILLED WITH 0.') END IF C IF (NTOTREC.GT.0.AND.NUSEREC.EQ.0) THEN WRITE(KFILDO,415) NTOTREC 415 FORMAT(/,' **** A TOTAL OF ',I8,' FLASHES WERE READ, BUT 0', 1 ' FELL WITHIN THE NECESSARY TIME AND SPACE WINDOW.', 2 ' THIS IS NOT AN ERROR, AND THE OUTPUT WILL BE', 3 ' GRIDS FILLED WITH 0.') END IF C IF (NUSEREC.GT.0) THEN WRITE(KFILDO,425) NTOTREC,NUSEREC,NUM60M,NUM30M,NUM15M1, 1 NUM15M2,NUM15M3,NUM15M4 425 FORMAT(/,' ALL LIGHTNING FLASHES HAVE BEEN GRIDDED.', 1 /,' TOTAL # FLASHES READ: ',I10, 2 /,' TOTAL # FLASHES IN TIME/SPACE WINDOW: ',I10, 3 /,' 60 MIN FLASH COUNT: ',I10, 4 /,' 30 MIN FLASH COUNT: ',I10, 5 /,' 15 MIN FLASH COUNT (PREV FOR HH:30): ',I10, 6 /,' 15 MIN FLASH COUNT (PREV FOR HH:45): ',I10, 7 /,' 15 MIN FLASH COUNT (CURR FOR HH:00): ',I10, 8 /,' 15 MIN FLASH COUNT (CURR FOR HH:15): ',I10) END IF C C WRITE DATA TO OUTPUT. C DO N=1,NUMVAR C C SET DATE. THIS CODE STILL FOLLOWS AN OLD PARADIGM WHERE C THE DATE WRITTEN TO OUTPUT IS BASED ON THE BEGINNING OF C THE VALID PERIOD. C IF (N.LT.NUMVAR) THEN NDATE=KDATEM1 ELSE NDATE=KDATE END IF C C BUILD OUTPUT ID. C JD(1)=ID(1,N) JD(2)=ID(2,N) JD(3)=0 JD(4)=0 C C POPULATE DATA WITH THE CORRECT GRID. C MM=0 DO J=1,NY DO I=1,NX MM=MM+1 DATA(MM)=LGRID(N,I,J) END DO END DO C C SETTING PARAMETERS OF OUTPUT GRID DOMAIN C NSTA=NX*NY ITYPE=2 ISCALD=0 ISCALE=0 C C CALL ROUTINE TO PACK AND WRITE EACH VARIABLE IN C TDLPACK GRID FORMAT. C CALL WRVTGD(KFILDO,KFILVT,KFILOUT,JD,NDATE,CCALL,DATA, 1 NSTA,XLATLL,XLONLL,ORIENT,MESH,XLAT,NX,NY,ND7, 2 ISCALD,ISCALE,ITYPE,L3264B,L3264W,ISTOP, 3 IPLAIN,PLAIN,IERV,IERG,NPROJ) C END DO ! DO N=1,NUMVAR C C A SUCCESSFUL COMPLETION C CALL TIMPR(KFILDO,KFILDO,'END LTGGRIDS ') STOP C C ERRORS IN READING INGEST DATA C 900 WRITE(KFILDO,910) KFILIN 910 FORMAT(/,' **** ERRORS WERE ENCOUNTERED TRYING TO READ KFILIN.', 1 ' STOP 300') CALL W3TAGE('LMP_LTGGRIDS') STOP 300 C END