program tab
c
c ver3.1.2
c
c This program provides a tropical cyclone track forecast
c based on a trajectory calculation from a vertically averaged
c and horizontally smoothed horizontal wind field, usually
c from a global model forecast.
c
c This is the driver program that calls teh Trajectory and Beta (TAB)
c subroutine tab.f. TAB is similar to the Beta and Advection (BAM) model,
c except that the horizontal average is from a simple area average
c rather than from a truncated spherical harmonic transform.
c
c Input files:
c tab.com - contains CARQ lines for the forecast
c (Used for date/time info, initial position and motion vector)
c
c Afffyy_Zmmdd_PACK.DAT - Files containing packed ASCII formatted GFS fields.
c fff= forecast hour, yy=2 digit year,
c Z=X for 00 or 06 UTC initial time
c =Y for 12 or 18 UTC initial GFS times
c mm = month (01, 02, etc)
c dd = day of month if Z=X or day of month + 50 if Z=Y
c
c Output files:
c tab.dat - TAB track forecast in ATCF format
c tab.tst - TAB track forecast in old ATCF format for testing
c tab.log - TAB log file
c
c Note that the track forecast can still be made if GFS fields are from
c the previous 6 hour cycle compared to the date in the CARQ information.
c In real time, the 6 hr old GFS will normally be used since TAB is an early model.
c
c Modfified Oct 2016 (MD):
c Rename from gtm.f to tab.f
c Separate the TAB model and utility subroutines
c Storm information is from .com format instead of stormcard.dat format.
c Runs extended from 5 to 7 days
c Modified Jun 2018 (SS):
c Added capability to look at previous 12 hr cycle in getgfsl subroutine
c Modified Feb 2023 (KM):
c NCO compliance; error-handling subroutine
c
include 'dataformats.inc'
c
parameter (mxx=361,mxy=181,mxp=15,mxt=50)
dimension flon(0:mxt),flat(0:mxt),iftime(0:mxt)
dimension iflont(0:mxt),iflatt(0:mxt)
dimension ifvmaxt(0:mxt),iftimet(0:mxt)
dimension ugrid(mxx,mxy,mxp,0:mxt),vgrid(mxx,mxy,mxp,0:mxt)
dimension tgrid(mxx,mxy,mxp,0:mxt),zgrid(mxx,mxy,mxp,0:mxt)
dimension rgrid(mxx,mxy,mxp,0:mxt)
c
dimension glon(mxx),glat(mxy),gp(mxp),gt(0:mxt)
c
character *1 latNS,lonEW,latNSm12,lonEWm12
character *2 bb
character *4 aidname,aidnamed,aidnamem,aidnames
character *7 fnlog,fntst,fndat
character *6 atcfid
character *8 strmid
character *10 aymdh
character *10 sname
character *14 fncom
c
c Variables for writing forecast in ATCF format
dimension ialat(0:mxt),ialon(0:mxt),iavmax(0:mxt),iatime(0:mxt)
character *4 stype(0:mxt)
c
type ( AID_DATA ) comRcD, tauData
c
c I/O variables
data fncom /'tab.com'/
data fnlog,fntst,fndat/'tab.log','tab.tst','tab.dat'/
data lucom /10/
data lulog,lutst,ludat /20,21,22/
c
c **** Model variables
c
c Specific the aid names for the Deep, Medium, Shallow models
aidnamed='TABD'
aidnamem='TABM'
aidnames='TABS'
c
c aidnamed='TD09'
c aidnamem='TM09'
c aidnames='TS09'
c
c Specify the time step (hr) for saving TAB output (idthr),
c number of time steps for saving output (ndt), and initialize error flag
idthr = 6
ndt = 28
ierr = 99
c
c **** Open needed files
c
c Open the log file
open(file=fnlog,unit=lulog,form='formatted',
+ status='replace')
c
c Open the forecast output files
open(file=fntst,unit=lutst,form='formatted',
+ status='replace')
open(file=fndat,unit=ludat,form='formatted',
+ status='replace')
c
c Open the com input file with the initialization information
open(file=fncom,unit=lucom,form='formatted',
+ status='old',err=920)
c
c **** Read t=0 hr info from CARQ line
c
call getARecord (lucom,"CARQ", comRcd, istat)
if (istat .eq. 0) then
call tab_err_handling(2,lulog,istat)
endif
c
call getSingleTAU ( comRcd, 0, tauData, istat )
if (istat .ne. 1) then
call tab_err_handling(2,lulog,istat)
endif
aymdh = tauData%aRecord(1)%DTG
bb = tauData%aRecord(1)%basin
nn = tauData%aRecord(1)%cyNum
ivmx00 = tauData%aRecord(1)%vmax
rlat00 = tauData%aRecord(1)%lat
rlon00 = tauData%aRecord(1)%lon
latNS = tauData%aRecord(1)%NS
lonEW = tauData%aRecord(1)%EW
ihead = tauData%aRecord(1)%dir
ispeed = tauData%aRecord(1)%speed
c
c **** Read t=-12 hr info from CARQ line
c
call getSingleTAU ( comRcd, -12, tauData, istat )
ivmxm12 = tauData%aRecord(1)%vmax
rlatm12 = tauData%aRecord(1)%lat
rlonm12 = tauData%aRecord(1)%lon
latNSm12 = tauData%aRecord(1)%NS
lonEWm12 = tauData%aRecord(1)%EW
c
c **** Derived input variables
read(aymdh,300) iyear4,imon,iday,itime
300 format(i4,3(i2))
c
write(strmid,302) bb,nn,aymdh(1:4)
302 format(a2,i2.2,a4)
c
atcfid(1:4) = strmid(1:4)
atcfid(5:6) = strmid(7:8)
c
c **** Write initialization info to log file
write(lulog,500) iyear4,imon,iday,itime
500 format('Start TAB model run',/,
+ 'Initialization date/time: ',i4,1x,i2.2,i2.2,
+ 1x,i2.2,' UTC')
c
write(lulog,502) bb,nn,aymdh(1:10)
502 format(/,'CARQ input: ',/,a2,i2.2,' t=00 date/time: ',a10)
c
write(lulog,504) ivmx00,rlat00,latNS,rlon00,lonEW
504 format(5x,'t= 0 vmax, lat, lon: ',i3,1x,f5.1,1x,a1,1x,
+ f6.1,1x,a1)
c
write(lulog,506) ivmxm12,rlatm12,latNSm12,rlonm12,lonEWm12
506 format(5x,'t=-12 vmax, lat, lon: ',i3,1x,f5.1,1x,a1,1x,
+ f6.1,1x,a1)
c
if (latNS .eq. 'S') rlat00 = -1.0*rlat00
if (latNSm12 .eq. 'S') rlatm12 = -1.0*rlatm12
c
if (lonEW .eq. 'W') rlon00 = 360.0 - rlon00
if (lonEWm12 .eq. 'W') rlonm12 = 360.0 - rlonm12
c
iftype = 2
if (atcfid(1:2) .eq. 'AL') iftype=2
c
c Initialize forecast lat/lon to zero and calculate forecast times
do k=0,ndt
flon(k) = 0.0
flat(k) = 0.0
iftime(k) = k*idthr
enddo
c
c Calculate times for old ATCF format output (tab.tst) and
c intialize forecast to zero
ndtt = 10
do k=0,ndtt
iftimet(k) = k*12
iflatt(k) = 0
iflont(k) = 0
ifvmaxt(k) = 0
enddo
c
write(lulog,507) "before getgfsl"
507 format(a15)
c **** Get global model fields
call getgfsl(iyear4,imon,iday,itime,idthr,ndt,
+ mxx,mxy,mxp,mxt,nxx,nxy,nxp,nxt,
+ glon,glat,gp,gt,ugrid,vgrid,tgrid,zgrid,rgrid)
c
write(lulog,507) "after getgfsl"
c **** Deep TAB
pbot = 850.0
ptop = 200.0
call tab_model(rlon00,rlat00,rlonm12,rlatm12,iftype,
+ mxx,mxy,mxp,mxt,nxx,nxy,nxp,nxt,
+ glon,glat,gp,gt,ugrid,vgrid,pbot,ptop,
+ flon,flat,lulog,ierr)
c
c Write Deep TAB forecast in old ATCF format
call new2old( flon , flat ,iftime ,mxt,ndt,
+ iflont,iflatt,iftimet,mxt,ndtt)
c
aidname=aidnamed
iaidnum=99
write(lutst,400) iaidnum,aidname,iyr2,imon,iday,itime,
+ (iflatt(kk),iflont(kk),kk=1,ndtt),
+ (ifvmaxt(kk),kk=1,ndtt),atcfid
400 format(i2.2,a4,4(i2.2),20(i4),10(i3),1x,a6)
c
c Write Deep TAB forecast in ATCF format
itrack = 1
minc=1
do k=0,mxt
stype(k) = ' '
iavmax(k) = 0
enddo
c
strmid(1:4) = atcfid(1:4)
write(strmid(5:8),700) iyr
700 format(i4)
c
do k=0,nxt
ialat(k) = nint(10.0*flat(k))
ialon(k) = nint(10.0*flon(k))
iatime(k) = iftime(k)
enddo
c
call writeaidlocal3(ludat,strmid,aymdh,aidname,itrack,
+ ialat,ialon,iavmax,stype,iatime,nxt,
+ minc)
c
c Write Deep TAB forecast to log file
write(lulog,200) aidname
200 format(/,a4,' forecast')
do k=0,ndt
ttime = float(idthr*k)
write(lulog,210) ttime,flat(k),flon(k)-360.0
210 format('t=',f6.1,' lat=',f7.2,' lon=',f7.2)
enddo
c
c **** Medium TAB
pbot = 850.0
ptop = 400.0
call tab_model(rlon00,rlat00,rlonm12,rlatm12,iftype,
+ mxx,mxy,mxp,mxt,nxx,nxy,nxp,nxt,
+ glon,glat,gp,gt,ugrid,vgrid,pbot,ptop,
+ flon,flat,lulog,ierr)
c
c Write Medium TAB forecast in old ATCF format
call new2old( flon , flat ,iftime ,mxt,ndt,
+ iflont,iflatt,iftimet,mxt,ndtt)
c
aidname=aidnamem
iaidnum=99
write(lutst,400) iaidnum,aidname,iyr2,imon,iday,itime,
+ (iflatt(kk),iflont(kk),kk=1,ndtt),
+ (ifvmaxt(kk),kk=1,ndtt),atcfid
c
c Write Medium TAB forecast in ATCF format
do k=0,nxt
ialat(k) = nint(10.0*flat(k))
ialon(k) = nint(10.0*flon(k))
iatime(k) = iftime(k)
enddo
c
call writeaidlocal3(ludat,strmid,aymdh,aidname,itrack,
+ ialat,ialon,iavmax,stype,iatime,nxt,
+ minc)
c
c Write Medium TAB to log file
write(lulog,200) aidname
do k=0,ndt
ttime = float(idthr*k)
write(lulog,210) ttime,flat(k),flon(k)-360.0
enddo
c
c **** Shallow TAB
pbot = 850.0
ptop = 700.0
call tab_model(rlon00,rlat00,rlonm12,rlatm12,iftype,
+ mxx,mxy,mxp,mxt,nxx,nxy,nxp,nxt,
+ glon,glat,gp,gt,ugrid,vgrid,pbot,ptop,
+ flon,flat,lulog,ierr)
c
c Write Shallow TAB forecast in old ATCF format
call new2old( flon , flat ,iftime ,mxt,ndt,
+ iflont,iflatt,iftimet,mxt,ndtt)
c
aidname=aidnames
iaidnum=99
write(lutst,400) iaidnum,aidname,iyr2,imon,iday,itime,
+ (iflatt(kk),iflont(kk),kk=1,ndtt),
+ (ifvmaxt(kk),kk=1,ndtt),atcfid
c
c Write Shallow TAB forecast in ATCF format
do k=0,nxt
ialat(k) = nint(10.0*flat(k))
ialon(k) = nint(10.0*flon(k))
iatime(k) = iftime(k)
enddo
c
call writeaidlocal3(ludat,strmid,aymdh,aidname,itrack,
+ ialat,ialon,iavmax,stype,iatime,nxt,
+ minc)
c
c Write Shallow TAB forecast to log file
write(lulog,200) aidname
do k=0,ndt
ttime = float(idthr*k)
write(lulog,210) ttime,flat(k),flon(k)-360.0
enddo
c
stop
c
c **** Error processing
920 call tab_err_handling(1,lulog,0)
stop
c
end
subroutine new2old( flon, flat ,iftime ,mxt ,ndt,
+ iflont,iflatt,iftimet,mxtt,ndtt)
c This routine converts the flat,flon forecast to the form needed
c for the old ATCF format.
c
dimension flon(0:mxt),flat(0:mxt)
dimension iflont(0:mxtt),iflatt(0:mxtt)
dimension iftime(0:mxt),iftimet(0:mxtt)
c
do kk=0,ndtt
c Search for matching forecast time
do k=0,ndt
if (iftimet(kk) .eq. iftime(k)) then
iflatt(kk) = nint(10.0*flat(k))
iflont(kk) = nint(10.0*(360.0-flon(k)))
if (iflont(kk) .eq. -3600 .or.
+ iflont(kk) .eq. 3600 ) iflont(kk) = 0
exit !inner loop
endif
enddo
enddo
c
return
end