PROGRAM NCEPDATA C C** THIS PROGRAM READ TROPICAL CYCLONE DATA TO A NCEP FILE C C modified by: C. Sisko 03-NOV-2006 C mod notes - "fix radii bug and offset problem in 64 KT radii include 'dataformats.inc' c dimension itau(5) c real latcur, loncur, nm2km, kt2ms INTEGER dircur cc INTEGER dircur,spdcur,wndcur INTEGER cenprs,outprs INTEGER MINZERO cc INTEGER cenprs,outprs,outrad,rmaxwd cc INTEGER RD34NE,RD34SE,RD34SW,RD34NW,RD50NE,RD50SE,RD50SW,RD50NW C CHARACTER*1 SDEPTH,EW,NS character*2 status CHARACTER*8 STRMID, output CHARACTER*10 aymdh CHARACTER*10 STNAME CHARACTER*11 FCINFO,ADECK,INPUT character*75 input_file, output_file character*150 record CHARACTER*200 aline c type ( AID_DATA ) comRcd, ofcRcd, tauData, ofcData c data itau / 12, 24, 36, 48, 72 / data nm2km / 1.8533 / data kt2ms / 1.9425 / data MINZERO / 0.0001 / C C** INITIALIZE THE NCEP RECORD C RECORD = ' ' RECORD(1:3) = 'NHC' RECORD(8:8) = 'L' RECORD(31:32) = '00' RECORD(37:37) = 'N' RECORD(43:43) = 'W' RECORD(123:123) = 'N' RECORD(129:129) = 'W' C WRITE (*,'('' NHC TROPICAL CYCLONE DATA FOR NCEP'',//)') c c** Get the first command line parameter c call getarg ( 1, input_file ) c strmid = input_file(1:8) c c** Get the second command line parameter c call getarg ( 2, output_file ) c iend = len_trim( output_file ) output = output_file( iend - 7:iend ) print *, ' output parameter = ', output c c** Open the input and ncepdata files c open ( 21, file=input_file, status='old', iostat=ios, err=1010 ) open ( 31, file='ncepdata.dat', status='unknown' ) c C** Read the input file, find and write the CARQ CARDS TO THE output c** file AND rewind THE FILE C 10 read ( 21, '(a)', end=20 ) aline if ( index( aline, 'CARQ' ) .gt. 0 ) then lnend = lastch ( aline ) write ( *, '(a)' ) aline( 1:lnend ) write ( 31, '(a)' ) aline( 1:lnend ) endif goto 10 C 20 close ( 31 ) rewind ( 21 ) c c** Read in the last official forecast c call getARecord ( 21, "OFCL", ofcRcd, iofcl_stat ) c rewind ( 21 ) c c** Read in the compute data c call getARecord ( 21, "CARQ", comRcd, istat ) if ( istat .eq. 0 ) goto 1020 c close ( 21 ) c c** Read in the current data c call getSingleTAU (comRcd, 0, tauData, istat ) if ( istat .ne. 1 ) goto 1030 C C** Read in current data and change to metric units, if necessary C status = tauData%aRecord(1)%ty c c if ( status .eq. 'DB' .and. output .eq. 'tcvitals' ) c & stop ' NCEP models are NOT run on disturbances' c if ( status .eq. 'WV' .and. output .eq. 'tcvitals' ) c & stop ' NCEP models are NOT run on tropical waves' c aymdh = tauData%aRecord(1)%DTG latcur = tauData%aRecord(1)%lat loncur = tauData%aRecord(1)%lon wndcur = tauData%aRecord(1)%vmax/kt2ms dircur = tauData%aRecord(1)%dir NS = trim( tauData%aRecord(1)%NS ) EW = trim( tauData%aRecord(1)%EW ) if ( dircur .eq. 0 ) dircur = 360 spdcur = tauData%aRecord(1)%speed/kt2ms cenprs = tauData%aRecord(1)%mslp outprs = tauData%aRecord(1)%radp outrad = tauData%aRecord(1)%rrp*nm2km rmaxwd = tauData%aRecord(1)%mrd*nm2km stname = tauData%aRecord(1)%stormname sdepth = tauData%aRecord(1)%depth c if (tauData%aRecord(1)%windcode .eq. 'AAA' ) then rd34ne = tauData%aRecord(1)%radii(1)*nm2km rd34se = tauData%aRecord(1)%radii(1)*nm2km rd34sw = tauData%aRecord(1)%radii(1)*nm2km rd34nw = tauData%aRecord(1)%radii(1)*nm2km elseif (tauData%aRecord(1)%windcode .eq. 'NEQ' ) then rd34ne = tauData%aRecord(1)%radii(1)*nm2km rd34se = tauData%aRecord(1)%radii(2)*nm2km rd34sw = tauData%aRecord(1)%radii(3)*nm2km rd34nw = tauData%aRecord(1)%radii(4)*nm2km endif c if (tauData%aRecord(2)%windcode .eq. 'AAA' ) then rd50ne = tauData%aRecord(2)%radii(1)*nm2km rd50se = tauData%aRecord(2)%radii(1)*nm2km rd50sw = tauData%aRecord(2)%radii(1)*nm2km rd50nw = tauData%aRecord(2)%radii(1)*nm2km elseif (tauData%aRecord(2)%windcode .eq. 'NEQ' ) then rd50ne = tauData%aRecord(2)%radii(1)*nm2km rd50se = tauData%aRecord(2)%radii(2)*nm2km rd50sw = tauData%aRecord(2)%radii(3)*nm2km rd50nw = tauData%aRecord(2)%radii(4)*nm2km endif c if (tauData%aRecord(3)%windcode .eq. 'AAA' ) then rd64ne = tauData%aRecord(3)%radii(1)*nm2km rd64se = tauData%aRecord(3)%radii(1)*nm2km rd64sw = tauData%aRecord(3)%radii(1)*nm2km rd64nw = tauData%aRecord(3)%radii(1)*nm2km elseif (tauData%aRecord(3)%windcode .eq. 'NEQ' ) then rd64ne = tauData%aRecord(3)%radii(1)*nm2km rd64se = tauData%aRecord(3)%radii(2)*nm2km rd64sw = tauData%aRecord(3)%radii(3)*nm2km rd64nw = tauData%aRecord(3)%radii(4)*nm2km endif c C** PREPARE THE NMC RECORD C RECORD(6:7) = STRMID(3:4) READ( STRMID(3:4), '(I2.2)' ) istrmid C stop if it is a training system IF ( istrmid .GE. 80 .AND. istrmid .LE. 89 ) THEN PRINT *, " " PRINT *, "TERMINATING PROGRAM EARLY..." PRINT *, "INPUT SYSTEM WAS IDENTIFIED AS TRAINING SYSTEM" PRINT *, "STRMID --> ", istrmid STOP ENDIF IF (STRMID(1:2).EQ.'al') RECORD(8:8) = 'L' IF (STRMID(1:2).EQ.'ep') RECORD(8:8) = 'E' IF (STRMID(1:2).EQ.'cp') RECORD(8:8) = 'C' IF (STRMID(1:2).EQ.'wp') RECORD(8:8) = 'W' IF (STRMID(1:2).EQ.'sl') RECORD(8:8) = 'Q' stname = adjustl( stname ) RECORD(10:18) = STNAME(1:9) cc RECORD(10:18) = STNAME(2:10) IF (RECORD(10:18).EQ.' ') RECORD(10:18) = 'NAMELESS' C RECORD(20:27) = aymdh(1: 8) RECORD(29:30) = aymdh(9:10) C RECORD(37:37) = NS RECORD(43:43) = EW RECORD(123:123) = NS RECORD(129:129) = EW C WRITE (RECORD(34:36),'(I3.3)') nint(latcur*10.0) WRITE (RECORD(39:42),'(I4.4)') nint(loncur*10.0) WRITE (RECORD(44:51),'(2(1X,I3.3))') dircur, NINT(spdcur*10.0) C C** IF THERE ARE NO VALUES (I.E., NEGATIVE), DON'T WRITE C C C 5 6 7 8 9 C 234567890123456789012345678901234567890123 RECORD(52:93) = ' -999 -999 -999 -9 -99 -999 -999 -999 -999' C IF (cenprs.GE.0) WRITE (RECORD(53:56),'(I4.4)') CENPRS IF (outprs.GE.0) WRITE (RECORD(58:61),'(I4.4)') OUTPRS IF (outrad.GE.MINZERO) WRITE(RECORD(63:66),'(I4.4)') NINT(outrad) IF (wndcur.GE.MINZERO) WRITE(RECORD(68:69),'(I2.2)') NINT(wndcur) IF (rmaxwd.GE.MINZERO) WRITE(RECORD(71:73),'(I3.3)') NINT(rmaxwd) IF (rd34ne.GT.MINZERO) WRITE(RECORD(75:78),'(I4.4)') NINT(rd34ne) IF (rd34se.GT.MINZERO) WRITE(RECORD(80:83),'(I4.4)') NINT(rd34se) IF (rd34sw.GT.MINZERO) WRITE(RECORD(85:88),'(I4.4)') NINT(rd34sw) IF (rd34nw.GT.MINZERO) WRITE(RECORD(90:93),'(I4.4)') NINT(rd34nw) C RECORD(95:95) = SDEPTH C C 0 1 1 C 9 0 1 C 67890123456789012345 RECORD(96:115) = ' -999 -999 -999 -999' C IF (rd50ne.GT.MINZERO) WRITE(RECORD( 97:100),'(I4.4)')NINT(rd50ne) IF (rd50se.GT.MINZERO) WRITE(RECORD(102:105),'(I4.4)')NINT(rd50se) IF (rd50sw.GT.MINZERO) WRITE(RECORD(107:110),'(I4.4)')NINT(rd50sw) IF (rd50nw.GT.MINZERO) WRITE(RECORD(112:115),'(I4.4)')NINT(rd50nw) c record(130:130) = ' ' C 1 1 1 C 3 4 5 C 123456789012345678901 RECORD(131:150) = '-999 -999 -999 -999' C IF (rd64ne.GT.MINZERO) WRITE(RECORD(131:135),'(I4.4)')NINT(rd64ne) IF (rd64se.GT.MINZERO) WRITE(RECORD(136:140),'(I4.4)')NINT(rd64se) IF (rd64sw.GT.MINZERO) WRITE(RECORD(141:145),'(I4.4)')NINT(rd64sw) IF (rd64nw.GT.MINZERO) WRITE(RECORD(146:150),'(I4.4)')NINT(rd64nw) c c** Format the previous official forecast to locate the GFDL grids c RECORD(116:129) = ' -9 -99N -999W' c if (iofcl_stat .ne. 0 ) then c do 30 i = 1, 5 c call getSingleTAU ( ofcRcd, itau(i), ofcData, istat ) if ( istat .ne. 1 ) goto 30 c record(116:118) = ofcData%atcfRcd(1)%tau record(120:123) = ofcData%atcfRcd(1)%latns record(125:129) = ofcData%atcfRcd(1)%lonew c 30 continue endif C C** OPEN THE TCVITALS.DAT FILE, WRITE THE RECORD TO THE STANDARD OUTPUT AND C** THE PROPER FILE AND CLOSE THE FILE C OPEN ( 32, FILE='tcvitals.dat', STATUS='UNKNOWN' ) C WRITE ( *, '(/,A,/)' ) RECORD WRITE ( 32, '( A )' ) RECORD C CLOSE ( 32 ) C STOP '***** NCEPDATA IS FINISHED *****' C C** ERROR MESSAGES C 1010 PRINT *,' ERROR - opening file = ', input_file, ' istat = ', istat STOP C 1020 PRINT *,' ERROR - reading file = ', input_file, ' istat = ', istat STOP C 1030 PRINT *,' ERROR - reading data = ', input_file, ' istat = ', istat STOP C END c************************************************************************* FUNCTION LASTCH (STRING) C C** RETURNS THE POSITION OF THE LAST NON-BLANK CHARACTER OF A C** STRING C CHARACTER*(*) STRING C LAST = LEN(STRING) C DO 10 I = LAST,1,-1 IF (STRING(I:LAST).NE.' ') GO TO 20 10 CONTINUE C LASTCH = 0 RETURN C 20 LASTCH = I RETURN C END