PROGRAM UKMET ! !** THIS PROGRAM CONVERTS TROPICAL CYCLONE TRACK FORECASTS FROM !** UKMET GTS BULLETINS TO A-DECK FORMATTED LINES ! ! Version 2.1.1 ! ! Modfied May 2016 by M. Bozeman and M. DeMaria for new UKMet ! bulletin format ! Modfied Jun 2016 by M. DeMaria (v2.0.1) to modify include ! statment for longer range ATCF utilies ! ! Modified Dec 2016 by M. DeMaria (v2.1.1) for Cray. ! Use updated dataformats.inc (no longer need 168 version) ! Use $DCOMROOT for path to input data. ! ! Modified Mar 2020 by SPA Office to pick up ukmet file from dcom on dell. ! Use $DCOMbase (to allow for easy testing of data from ! $DCOMROOT/prod vs $DCOMROOT/para vs $DCOMROOT/test) ! ! Modifications: ! 1/10/2023 (J. Dostalek) Started this Fortran 90 version ! 1/31/23 (J. Dostalek) This Fortran 90 version was created somewhat ! quickly to include in the February 2023 delivery to NHC. It gives the same ! results as the FORTRAN 77 version using ep122021.com as input, but will need ! some additional work to complete the goals of the f77 to f90 conversion. !------------------------------------------------------------------------------ implicit none ! include 'dataformats168.inc' include 'dataformats.inc' ! ! Set number of forecast times (including t=0) integer, parameter :: nft = 15 integer, parameter :: bignumber = 100000 ! REAL FLAT(nft), FLON(nft),VMAXKT(nft) CHARACTER CLAT(nft), CLON(nft) ! ! Note: First dimension of iukmet must match that in dataio.f integer, dimension(nft,3) :: iukmet ! character(len=2) :: hour character(len=4) :: techname character(len=8) :: strmid, uc_strmid, ustrmid character(len=10) :: aymdh, fymdh, bymdh character(len=50) :: input_file,dcompath character(len=70) :: flname character(len=80) :: uline integer :: i,k,l,m,n integer :: ios integer :: istat integer :: ivmaxtemp integer :: local, loccp, locep ! type ( AID_DATA ) comRcd, tauData ! !** ZERO THE FORECAST LATITUDES, LONGITUDES, AND MAX WINDS ! DO I = 1,nft FLAT(I) = 0.0 FLON(I) = 0.0 CLAT(I) = ' ' CLON(I) = ' ' vmaxkt(i) = 0.0 enddo ! do i = 1,nft do k = 1,3 iukmet(i,k) = 0 enddo enddo !** Get the command line parameter ! call getarg ( 1, input_file ) ! strmid = input_file(1:8) uc_strmid = strmid call upcase ( uc_strmid, 8 ) ! !** Open the input file ! open ( 21, file=input_file, status='old', iostat=ios, err=1010 ) ! !** Read in the compute data and close the file ! call getARecord (21, "CARQ", comRcd, istat ) close ( 21 ) if ( istat .eq. 0 ) then print *,' ERROR - reading file = ', input_file, ' istat = ', istat stop endif ! ! !** Read in the current data ! call getSingleTAU ( comRcd, 0, tauData, istat ) if ( istat .ne. 1 ) then print *,' ERROR - reading data = ', input_file, ' istat = ', istat stop endif ! aymdh = tauData%aRecord(1)%DTG hour = aymdh(9:10) ! !** Determine the FORECAST TIME AND CREATE THE UKMET FILE NAME ! IF ( HOUR .EQ. '00' ) CALL dtgmod ( aymdh, -12, FYMDH, istat ) IF ( HOUR .EQ. '06' ) CALL dtgmod ( aymdh, -6, FYMDH, istat ) IF ( HOUR .EQ. '12' ) CALL dtgmod ( aymdh, -12, FYMDH, istat ) IF ( HOUR .EQ. '18' ) CALL dtgmod ( aymdh, -6, FYMDH, istat ) WRITE ( *, '( 5X,A10 )' ) FYMDH ! !** Set the correct path for the ukmet bulletin on the WCOSS Dell !** DCOMbase /gpfs/dell1/nco/ops/dcom/prod !!! FLNAME = '/dcom/us007003/'//fymdh(1:8)// !!! & '/wtxtbul/ukmet_tropical_storms' ! Use for IBM ! FLNAME = '/dcomdev/us007003/'//fymdh(1:8)// ! & '/wtxtbul/ukmet_tropical_storms_dev' ! Use for dev IBM ! FLNAME = 'ukmet_tropical_storms_dev' ! Use local version call getenv("DCOMbase", dcompath ) FLNAME = trim( dcompath )//'/'//fymdh(1:8)//& &'/wtxtbul/ukmet_tropical_storms' WRITE (*,'(A)') FLNAME ! !** Open the UKMET message file ! OPEN ( 22, FILE=FLNAME, STATUS='OLD', IOSTAT=IOS, ERR=1040 ) ! !** READ UKMET FILE ! do l = 1,bignumber READ ( 22, '(A)', END=200, IOSTAT=IOS, ERR=1050 ) ULINE WRITE ( *, '( '' read 1 '', A )' ) ULINE ! !** SEARCH FOR THE STORM ID ! IF ( INDEX( ULINE, 'ATCF' ) .EQ. 0 ) cycle ! LOCAL = INDEX( ULINE, 'AL' ) LOCEP = INDEX( ULINE, 'EP' ) LOCCP = INDEX( ULINE, 'CP' ) ! IF ( LOCAL .NE. 0 ) THEN ustrmid = ULINE( LOCAL:LOCAL + 7 ) ELSEIF ( LOCEP .NE. 0 ) THEN ustrmid = ULINE( LOCEP:LOCEP + 7 ) ELSEIF ( LOCCP .NE. 0 ) THEN ustrmid = ULINE( LOCCP:LOCCP + 7 ) ELSE cycle ENDIF ! WRITE ( *,'( 3(5X,A8) )' ) STRMID, uc_strmid, ustrmid IF ( uc_strmid .NE. ustrmid ) cycle ! do m = 1,bignumber READ ( 22, '(A)', END=100, IOSTAT=IOS, ERR=1050 ) ULINE WRITE ( *, '( '' read 2 '',A )' ) ULINE ! !** SEARCH FOR THE CORRECT DTG ! IF (ULINE(9:11).EQ.'UTC') exit enddo ! BYMDH = ULINE(19:22)//ULINE(16:17)//ULINE(13:14)//ULINE(5:6) WRITE ( *, '( 2(5X,A10) )' ) FYMDH, BYMDH IF ( FYMDH .NE. BYMDH ) cycle ! N = 1 READ ( ULINE(30:41), '(F4.1,1A,1X,F5.1,1A)', ERR=100 ) & FLAT(N), CLAT(N), FLON(N), CLON(N) print *, "-->", ULINE(30:41) iukmet( 1, 1 ) = int( flat(1)*10.0 + 0.5 ) iukmet( 1, 2 ) = int( flon(1)*10.0 + 0.5 ) if ( CLAT(N) .EQ. 'S' ) iukmet( 1, 2 ) = -1 * iukmet( 1, 1 ) if ( CLON(N) .EQ. 'E' ) iukmet( 1, 2 ) = -1 * iukmet( 1, 2 ) ! READ ( ULINE(62:64), '(I3)',ERR=100 ) ivmaxtemp vmaxkt(n) = float(ivmaxtemp) iukmet( 1, 3 ) = int( vmaxkt(1) ) print*, "FOUND WIND ", ULINE(62:64) ! N = 2 do while(n < nft+1) READ ( 22, '(A)', END=100, IOSTAT=IOS, ERR=1050 ) ULINE WRITE ( *,'( '' read 3** '',A )' ) ULINE(30:41) ! !** READ THE POSITION FORECASTS ! READ ( ULINE(30:41), '(F4.1,1A,1X,F5.1,1A)', ERR=100 ) & FLAT(N), CLAT(N), FLON(N), CLON(N) iukmet( n, 1 ) = int( flat(n)*10.0 + 0.5 ) iukmet( n, 2 ) = int( flon(n)*10.0 + 0.5 ) if ( CLAT(N) .EQ. 'S' ) iukmet( n, 1 ) = -1 * iukmet( n, 1 ) if ( CLON(N) .EQ. 'E' ) iukmet( n, 2 ) = -1 * iukmet( n, 2 ) ! READ ( ULINE(62:64), '(I3)',ERR=100 ) ivmaxtemp vmaxkt(n) = float(ivmaxtemp) iukmet( n, 3 ) = int( vmaxkt(n) ) print *, "INTENSITY", ULINE(62:64) N = N + 1 enddo ! exit enddo 100 CLOSE ( 22 ) ! WRITE (*,'('' t(hr), FCST LAT/LON/VMX ''i3,2F10.2,1a,1x,f5.0)') & ((i-1)*12,FLAT(I),FLON(I),CLON(I),vmaxkt(i), I =1,nft) ! !** OPEN, WRITE TO AND CLOSE THE OUTPUT FILE ! OPEN ( 31, FILE='ukmet.dat', STATUS='UNKNOWN' ) ! techname = 'EGRR' call newWriteAidRcd ( 31, strmid, fymdh, techname, iukmet ) ! CLOSE (31) ! STOP ' UKMET IS FINISHED AND AN UKMET FORECAST WAS FOUND!' ! 200 CLOSE (22) ! STOP ' UKMET IS FINISHED AND NO UKMET FORECAST WAS FOUND?' ! !** FILE ERROR MESSAGES ! 1010 PRINT *,' ERROR - opening file = ', input_file, ' ios = ', ios STOP ! 1040 PRINT *,' ERROR - opening UKMET FILE = ', flname, ' ios = ', ios STOP ! 1050 PRINT *,' ERROR - reading UKMET FILE = ', flname, ' ios = ', ios STOP ! END