program tcliper c This program is a driver for the tclip subroutine, c which makes a traectory CLIPER forecast c c Input files: tcliper.com - contains CARQ lines for the forecast c c Output file: tcliper.dat - TCLIPER forecast in ATCF format c tcliper.log - TCLIPER log file c c Written by M. DeMaria, Oct 2016 for WCOSS Cray so tclip c forecast is a stand alone application rather than part of c the SHIPS processing. c Modified Jan 2023 (KM) to remove goto statements; create error handling subroutine c c The program uses the following subroutines and related data files: c c tcliper_model.f (main tcliper subroutine) c xint.f (from libgeneralutils) c writeaidlocal2.f (from libshipsutils) c gdland_table.f90 gfland_table.f (from liblandutils) c dataio.f dtgutils.f dataformats.inc dataioparams.inc (from libguidanceio) c gdland_table.dat, gfland_table.dat, oban_WH.dat, clim_rsst.dat c include 'dataformats.inc' c character *1 latNS,lonEW,latNSm12,lonEWm12 character *2 bb character *4 mname character *8 strmid character *10 aymdh c c Arrays for tclip call and writing output. parameter (ndt=40) dimension tcplat(0:ndt), tcplon(0:ndt), tcpvmx(0:ndt) dimension itcplat(0:ndt),itcplon(0:ndt),itcpvmx(0:ndt) dimension itcptime(0:ndt) character *4 tcpstype(0:ndt) c type ( AID_DATA ) comRcd, tauData c data lucom,ludat,lulog /10,11,12/ data dtr /0.017453/ data mname /'TCLP'/ c c **** Specify tcliper parameters ipf = 1 iftypet = 2 iftypei = 2 dthr = 6.0 idthr = nint(dthr) ioper = 1 c c Calculate forecast arays idelt = 6 do k=0,ndt itcptime(k) = idthr*(k) tcplat(k) = 0.0 tcplon(k) = 0.0 tcpvmx(k) = 0.0 itcplat(k) = 0 itcplon(k) = 0 itcpvmx(k) = 0 enddo c c **** Open the com input file and log output files open(file='tcliper.log',unit=lulog,form='formatted', + status='replace') c write(lulog,499) 499 format('Begin TCLIPER forecast') c open(file='tcliper.com',unit=lucom,form='formatted', + status='old',err=900) c c **** Read t=0 hr info from CARQ line c call getARecord (lucom,"CARQ", comRcd, istat) if (istat .eq. 0) then call tclip_err_handling(2,lulog,istat) endif c call getSingleTAU ( comRcd, 0, tauData, istat ) if (istat .ne. 1) then call tclip_err_handling(2,lulog,istat) endif c 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 quantities speedtc = float(ispeed) dirtc = dtr*float(90-ihead) cx00 = speedtc*cos(dirtc) cy00 = speedtc*sin(dirtc) c vmx00 = float(ivmx00) vmxm12 = float(ivmxm12) c 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 c **** Write initialization info to log file write(lulog,500) iyear4,imon,iday,itime 500 format('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 write(lulog,508) ihead,ispeed,cx00,cy00 508 format(5x,'Storm motion towards ',i3,' at ',i3,' kt', + ' cx,cy=',f5.1,1x,f5.1) c if (bb .ne. 'AL' .and. bb .ne. 'EP' + .and. bb .ne. 'CP') then call tclip_err_handling(3,lulog,0) endif c **** Run tcliper if (latNS .eq. 'S') rlat00 = -rlat00 if (latNSm12 .eq. 'S') rlatm12 = -rlatm12 if (lonEW .eq. 'W') rlon00 = 360.0 - rlon00 if (lonEWm12 .eq. 'W') rlonm12 = 360.0 - rlonm12 c call tclip(rlon00,rlat00,rlonm12,rlatm12,cx00,cy00,ipf, + vmx00,vmxm12,iyear4,imon,iday,itime,dthr,ndt,ioper, + iftypet,iftypei,tcplon,tcplat,tcpvmx,ierr) c if (ierr .ne. 0) then call tclip_err_handling(4,lulog,ierr) endif c write(lulog,510) ierr 510 format(/,'TCLIPER Forecast, ierr=',i2) do k=0,ndt write(lulog,512) itcptime(k),tcplat(k),tcplon(k),tcpvmx(k) enddo 512 format(i3,1x,f6.1,1x,f6.1,1x,f6.0) c c ATCF format output open(file='tcliper.dat',unit=ludat,form='formatted', + status='replace') c do k=0,ndt itcplat(k) = nint(10.0*tcplat(k)) itcplon(k) = nint(10.0*tcplon(k)) itcpvmx(k) = nint(tcpvmx(k)) tcpstype(k) = ' ' enddo c minc = 2 call writeaidlocal2(ludat,strmid,aymdh,mname, + itcplat,itcplon,itcpvmx, + tcpstype,itcptime,ndt,minc) c write(lulog,599) 599 format(/,'TCLIPER completed normally') c stop c c **** Error processing 900 call tclip_err_handling(1,lulog,0) stop c end