program epshifor5 !** This program runs east pacific SHIFOR guidance program ! Modfied 10/08/2016 for WCOSS Cray. New ATCF libraries used, requires larger ! ishifor array. ! Modifications: ! 6/14/21 (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 and cp012018.com as ! input, but will need some additional work to complete the goals of the f77 ! to f90 conversion. ! 02/02/2023 (J. Dostalek) removed jday subroutine from end of file. ! Will link to libgeneralutils in Makefile instead !------------------------------------------------------------------------------- include 'dataformats.inc' common/shifor/ishifor(15, 3) integer :: ymdh real :: latcur, loncur, latm12, lonm12 character(len=4) :: techname character(len=8) :: strmid character(len=10) :: aymdh character(len=50) :: input_file integer :: ishifor integer :: i, j integer :: ios integer :: istat type(AID_DATA) comRcd, tauData !** Zero final array do i = 1, 15 do j = 1, 3 ishifor(i, j) = 0 end do end do !** Get the command line parameter and the storms directory path call getarg(1, input_file) strmid = input_file(1: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 == 0) then print *, ' ERROR - reading file = ', input_file, ' istat = ', istat stop end if !** Read in the current data call getSingleTAU(comRcd, 0, tauData, istat) if (istat /= 1) then print *, ' ERROR - reading data = ', input_file, ' istat = ', istat stop end if aymdh = tauData%aRecord(1)%DTG read (tauData%aRecord(1)%DTG, '(i10)') ymdh latcur = tauData%aRecord(1)%lat loncur = tauData%aRecord(1)%lon wndcur = tauData%aRecord(1)%vmax !** Read in the minus 12-hour old data call getSingleTAU(comRcd, -12, tauData, istat) if (istat /= 1) then print *, ' ERROR - reading data = ', input_file, ' istat = ', istat stop end if latm12 = tauData%aRecord(1)%lat lonm12 = tauData%aRecord(1)%lon wndm12 = tauData%aRecord(1)%vmax write (*, 1) strmid 1 format(' East Pacific SHIFOR5 forecast for ', a8,/) !** Compute the east Pacific SHIFOR forecasts call epshif5d(ymdh, latcur, loncur, latm12, lonm12, wndcur, wndm12, strmid) !** Open the output file, write the forecasts to the file and close the file open (31, file='epshifor5.dat', status='unknown') !** Write the forecasts to a temporary adeck for merging with the !** actual adeck techname = 'SHF5' call newWriteAidRcd(31, strmid, aymdh, techname, ishifor) close (31) stop ' ***** EAST PACIFIC SHIFOR5 FORECASTS ARE FINISHED *****' !** Error messages 1010 print *, ' ERROR - opening file = ', input_file, ' istat = ', istat stop end !************************************************************************ !************************************************************************ block data ! This subprogram contains the standardized coefficients, means and ! standard deviations of the predictors used in the eastern Pacific ! version of the Statistical Hurricane Intensity Forecast. These ! data are used in subroutine epshif5d and are passed via a common ! block. ! ! scoef are the standardized coefficients ! avg are the averages ! sdev are the standard deviations common /coef/ scoef(10,36), avg(10,36), sdev(10,36) data (scoef( 1,j),j=1,36) / 0.0000000E+00,-0.1823524E+00, & -0.6025346E-01, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.7614017E+00, 0.0000000E+00,-0.9648295E-01, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2989867E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2441196E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 1,j),j=1,36) / 0.3409045E+02, 0.1647778E+02, & 0.1194100E+03,-0.7575877E+01, 0.2703427E+01, 0.6359764E+02, & 0.8415730E+00, 0.1709157E+04, 0.5391900E+03, 0.3987097E+04, & -0.2346845E+03, 0.8988298E+02, 0.1862021E+04, 0.3237899E+02, & 0.2843427E+03, 0.1978615E+04,-0.1227261E+03, 0.4757833E+02, & 0.9302553E+03,-0.9259438E+00, 0.1446544E+05,-0.9215050E+03, & 0.3176249E+03, 0.6665289E+04, 0.5694735E+02, 0.8057443E+02, & -0.1971690E+02,-0.4274374E+03,-0.7634565E+01, 0.1694525E+02, & 0.1703698E+03, 0.4083034E+01, 0.3833088E+04, 0.7290146E+02, & 0.1182917E+03,-0.6213483E-01/ data (sdev( 1,j),j=1,36) / 0.2338930E+02, 0.3581487E+01, & 0.1437713E+02, 0.4814886E+01, 0.3104484E+01, 0.2800452E+03, & 0.1084420E+02, 0.2377903E+04, 0.3472305E+03, 0.2704805E+04, & 0.2426896E+03, 0.1372968E+03, 0.1545159E+04, 0.4306967E+03, & 0.1266151E+03, 0.5390896E+03, 0.8227717E+02, 0.6035736E+02, & 0.5446276E+03, 0.1866596E+03, 0.3603070E+04, 0.6238622E+03, & 0.3774387E+03, 0.3333336E+04, 0.1306984E+04, 0.7470361E+02, & 0.2940368E+02, 0.4714602E+03, 0.9879948E+02, 0.2882326E+02, & 0.3413755E+03, 0.4834698E+02, 0.3712495E+04, 0.2072621E+04, & 0.2253573E+03, 0.1101109E+02/ data (scoef( 2,j),j=1,36) / 0.0000000E+00,-0.2201037E+00, & -0.1125746E+01, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.7669960E+00, 0.0000000E+00,-0.1205761E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.3805355E+00, 0.9819010E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00,-0.3280108E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 2,j),j=1,36) / 0.3388374E+02, 0.1621464E+02, & 0.1190225E+03,-0.7737213E+01, 0.2666646E+01, 0.6608255E+02, & 0.1375492E+01, 0.1694369E+04, 0.5275113E+03, 0.3950797E+04, & -0.2393237E+03, 0.8834578E+02, 0.1907476E+04, 0.5036208E+02, & 0.2745901E+03, 0.1940280E+04,-0.1240043E+03, 0.4571776E+02, & 0.9503964E+03, 0.8596223E+01, 0.1436974E+05,-0.9367046E+03, & 0.3124024E+03, 0.6867745E+04, 0.1217556E+03, 0.8150956E+02, & -0.2046919E+02,-0.4495492E+03,-0.1176072E+02, 0.1598613E+02, & 0.1734764E+03, 0.5824803E+01, 0.4036648E+04, 0.9347293E+02, & 0.1184358E+03,-0.3540846E+00/ data (sdev( 2,j),j=1,36) / 0.2337367E+02, 0.3417155E+01, & 0.1426190E+02, 0.4652715E+01, 0.2979298E+01, 0.2928763E+03, & 0.1079621E+02, 0.2404624E+04, 0.3395607E+03, 0.2700929E+04, & 0.2367192E+03, 0.1330576E+03, 0.1568953E+04, 0.4286487E+03, & 0.1185794E+03, 0.5170034E+03, 0.7846817E+02, 0.5543961E+02, & 0.5550459E+03, 0.1833025E+03, 0.3568410E+04, 0.6010082E+03, & 0.3588002E+03, 0.3373653E+04, 0.1297714E+04, 0.7369955E+02, & 0.2833205E+02, 0.4820746E+03, 0.9938897E+02, 0.2604367E+02, & 0.3510014E+03, 0.4619587E+02, 0.3774183E+04, 0.2161811E+04, & 0.2182329E+03, 0.1938118E+02/ data (scoef( 3,j),j=1,36) / 0.0000000E+00,-0.2303735E+00, & -0.1473419E+01, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.7107538E+00, 0.0000000E+00,-0.1389359E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.4188341E+00, 0.1300377E+01, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.6600728E-01, & 0.0000000E+00, 0.0000000E+00,-0.3934926E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 3,j),j=1,36) / 0.3368899E+02, 0.1595987E+02, & 0.1186078E+03,-0.7856443E+01, 0.2622831E+01, 0.6849837E+02, & 0.2040401E+01, 0.1680311E+04, 0.5164424E+03, 0.3916439E+04, & -0.2425100E+03, 0.8671753E+02, 0.1946771E+04, 0.7170458E+02, & 0.2654435E+03, 0.1902633E+04,-0.1242365E+03, 0.4395626E+02, & 0.9662881E+03, 0.2062413E+02, 0.1426791E+05,-0.9467457E+03, & 0.3062754E+03, 0.7042070E+04, 0.2034481E+03, 0.8239523E+02, & -0.2073621E+02,-0.4684744E+03,-0.1724166E+02, 0.1511958E+02, & 0.1754523E+03, 0.7855410E+01, 0.4233243E+04, 0.1224204E+03, & 0.1156651E+03,-0.9270607E+00/ data (sdev( 3,j),j=1,36) / 0.2335459E+02, 0.3275283E+01, & 0.1414661E+02, 0.4546905E+01, 0.2870793E+01, 0.3072913E+03, & 0.1056016E+02, 0.2435531E+04, 0.3325807E+03, 0.2700756E+04, & 0.2341398E+03, 0.1308612E+03, 0.1594228E+04, 0.4169710E+03, & 0.1119010E+03, 0.4971324E+03, 0.7578139E+02, 0.5153394E+02, & 0.5683723E+03, 0.1760623E+03, 0.3533794E+04, 0.5863201E+03, & 0.3425258E+03, 0.3432086E+04, 0.1268322E+04, 0.7296887E+02, & 0.2785581E+02, 0.4960866E+03, 0.9846447E+02, 0.2392651E+02, & 0.3619989E+03, 0.4294414E+02, 0.3852650E+04, 0.2257165E+04, & 0.2120755E+03, 0.2645941E+02/ data (scoef( 4,j),j=1,36) / 0.0000000E+00,-0.6944878E+00, & -0.1674557E+01, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.6274028E+00, 0.0000000E+00,-0.1514233E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.5581393E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.4049150E+00, 0.1250209E+01, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.7471567E-01, & 0.0000000E+00, 0.0000000E+00,-0.4392256E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 4,j),j=1,36) / 0.3350910E+02, 0.1571008E+02, & 0.1181326E+03,-0.7945663E+01, 0.2557487E+01, 0.7075982E+02, & 0.2670429E+01, 0.1667663E+04, 0.5056566E+03, 0.3882390E+04, & -0.2444269E+03, 0.8436892E+02, 0.1976468E+04, 0.9222919E+02, & 0.2567841E+03, 0.1864842E+04,-0.1238269E+03, 0.4194849E+02, & 0.9755518E+03, 0.3153982E+02, 0.1415158E+05,-0.9529552E+03, & 0.2972958E+03, 0.7171507E+04, 0.2793818E+03, 0.8310629E+02, & -0.2060539E+02,-0.4832446E+03,-0.2235800E+02, 0.1434458E+02, & 0.1753482E+03, 0.9751166E+01, 0.4404444E+04, 0.1549809E+03, & 0.1150295E+03,-0.1737848E+01/ data (sdev( 4,j),j=1,36) / 0.2334276E+02, 0.3158935E+01, & 0.1401045E+02, 0.4469423E+01, 0.2793746E+01, 0.3236109E+03, & 0.1038819E+02, 0.2472404E+04, 0.3255645E+03, 0.2702188E+04, & 0.2325489E+03, 0.1293590E+03, 0.1617585E+04, 0.4053358E+03, & 0.1064771E+03, 0.4795868E+03, 0.7352919E+02, 0.4875947E+02, & 0.5826815E+03, 0.1700602E+03, 0.3490472E+04, 0.5741495E+03, & 0.3301058E+03, 0.3499914E+04, 0.1247264E+04, 0.7179615E+02, & 0.2745527E+02, 0.5120160E+03, 0.9851597E+02, 0.2227744E+02, & 0.3742758E+03, 0.4073142E+02, 0.3942398E+04, 0.2366353E+04, & 0.2132211E+03, 0.3194976E+02/ data (scoef( 5,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.6812104E+00, 0.0000000E+00,-0.1495004E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2898585E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.5135095E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2273493E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.8122859E-01, & 0.0000000E+00, 0.0000000E+00,-0.3064732E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 5,j),j=1,36) / 0.3327280E+02, 0.1547144E+02, & 0.1176365E+03,-0.8025509E+01, 0.2476860E+01, 0.7294497E+02, & 0.3328004E+01, 0.1649972E+04, 0.4945912E+03, 0.3841616E+04, & -0.2455439E+03, 0.8077078E+02, 0.1994411E+04, 0.1132713E+03, & 0.2486167E+03, 0.1828098E+04,-0.1232210E+03, 0.3979703E+02, & 0.9797526E+03, 0.4265947E+02, 0.1403067E+05,-0.9581615E+03, & 0.2865943E+03, 0.7265209E+04, 0.3586360E+03, 0.8392738E+02, & -0.2025503E+02,-0.4949773E+03,-0.2786637E+02, 0.1355154E+02, & 0.1738348E+03, 0.1159021E+02, 0.4546875E+04, 0.1918206E+03, & 0.1140813E+03,-0.2786772E+01/ data (sdev( 5,j),j=1,36) / 0.2330202E+02, 0.3041842E+01, & 0.1386926E+02, 0.4418356E+01, 0.2723592E+01, 0.3420756E+03, & 0.1015003E+02, 0.2512109E+04, 0.3184644E+03, 0.2702379E+04, & 0.2311652E+03, 0.1254157E+03, 0.1632792E+04, 0.3962381E+03, & 0.1006864E+03, 0.4603183E+03, 0.7158336E+02, 0.4644048E+02, & 0.5971776E+03, 0.1630912E+03, 0.3445141E+04, 0.5664914E+03, & 0.3198441E+03, 0.3571135E+04, 0.1213577E+04, 0.7166328E+02, & 0.2698355E+02, 0.5301886E+03, 0.9685469E+02, 0.2155422E+02, & 0.3892121E+03, 0.3890517E+02, 0.4031562E+04, 0.2486870E+04, & 0.2124573E+03, 0.3609719E+02/ data (scoef( 6,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.6261557E+00, 0.0000000E+00,-0.1497080E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2719499E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.5162974E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2741849E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.7807224E-01, & 0.0000000E+00, 0.0000000E+00,-0.2952774E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 6,j),j=1,36) / 0.3309105E+02, 0.1524456E+02, & 0.1170965E+03,-0.8085144E+01, 0.2390498E+01, 0.7491747E+02, & 0.3891728E+01, 0.1636725E+04, 0.4848110E+03, 0.3805275E+04, & -0.2458836E+03, 0.7685264E+02, 0.2000089E+04, 0.1311931E+03, & 0.2410369E+03, 0.1792407E+04,-0.1222881E+03, 0.3766839E+02, & 0.9766734E+03, 0.5174439E+02, 0.1390026E+05,-0.9611770E+03, & 0.2751466E+03, 0.7302574E+04, 0.4254768E+03, 0.8465199E+02, & -0.1974076E+02,-0.5023709E+03,-0.3289441E+02, 0.1277484E+02, & 0.1704612E+03, 0.1295930E+02, 0.4633386E+04, 0.2234049E+03, & 0.1132493E+03,-0.3925989E+01/ data (sdev( 6,j),j=1,36) / 0.2327682E+02, 0.2939717E+01, & 0.1373689E+02, 0.4391593E+01, 0.2657386E+01, 0.3626381E+03, & 0.9905671E+01, 0.2560954E+04, 0.3121063E+03, 0.2704248E+04, & 0.2283015E+03, 0.1202093E+03, 0.1636206E+04, 0.3908052E+03, & 0.9559690E+02, 0.4429090E+03, 0.7007668E+02, 0.4442154E+02, & 0.6100070E+03, 0.1564196E+03, 0.3400547E+04, 0.5635516E+03, & 0.3103789E+03, 0.3626780E+04, 0.1178258E+04, 0.7209558E+02, & 0.2665871E+02, 0.5498324E+03, 0.9543129E+02, 0.2097211E+02, & 0.4054575E+03, 0.3702311E+02, 0.4106859E+04, 0.2619981E+04, & 0.2103640E+03, 0.3879220E+02/ data (scoef( 7,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.5853452E+00, 0.0000000E+00,-0.1406750E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2364586E+00, 0.0000000E+00,-0.8097417E-01, & 0.0000000E+00,-0.4477453E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.3301889E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.8612577E-01,-0.2660320E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 7,j),j=1,36) / 0.3287039E+02, 0.1503177E+02, & 0.1165874E+03,-0.8148692E+01, 0.2312446E+01, 0.7469045E+02, & 0.4279135E+01, 0.1621358E+04, 0.4750126E+03, 0.3765667E+04, & -0.2458547E+03, 0.7305763E+02, 0.1991023E+04, 0.1410150E+03, & 0.2340843E+03, 0.1759192E+04,-0.1215257E+03, 0.3584299E+02, & 0.9667653E+03, 0.5768961E+02, 0.1377877E+05,-0.9648518E+03, & 0.2649892E+03, 0.7298661E+04, 0.4706489E+03, 0.8548945E+02, & -0.1926236E+02,-0.5090874E+03,-0.3672544E+02, 0.1212880E+02, & 0.1640531E+03, 0.1378406E+02, 0.4672013E+04, 0.2449278E+03, & 0.1147646E+03,-0.4972365E+01/ data (sdev( 7,j),j=1,36) / 0.2325965E+02, 0.2851655E+01, & 0.1364507E+02, 0.4369481E+01, 0.2604390E+01, 0.3572350E+03, & 0.9822130E+01, 0.2620210E+04, 0.3063521E+03, 0.2710421E+04, & 0.2250002E+03, 0.1148629E+03, 0.1627826E+04, 0.3834453E+03, & 0.9109157E+02, 0.4275875E+03, 0.6883896E+02, 0.4284667E+02, & 0.6080621E+03, 0.1531289E+03, 0.3367195E+04, 0.5614836E+03, & 0.3026992E+03, 0.3670575E+04, 0.1166571E+04, 0.7268656E+02, & 0.2630556E+02, 0.5491028E+03, 0.9548569E+02, 0.2073056E+02, & 0.3987535E+03, 0.3619340E+02, 0.4166875E+04, 0.2772995E+04, & 0.2160317E+03, 0.4040804E+02/ data (scoef( 8,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00,-0.1366803E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2516920E+00, 0.0000000E+00,-0.9944827E-01, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2916846E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00,-0.3086647E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 8,j),j=1,36) / 0.3267741E+02, 0.1483578E+02, & 0.1161084E+03,-0.8193725E+01, 0.2257631E+01, 0.7162686E+02, & 0.4580464E+01, 0.1611289E+04, 0.4663680E+03, 0.3730107E+04, & -0.2449940E+03, 0.7036105E+02, 0.1976781E+04, 0.1472987E+03, & 0.2277729E+03, 0.1728568E+04,-0.1205942E+03, 0.3454231E+02, & 0.9528255E+03, 0.6192274E+02, 0.1366508E+05,-0.9661400E+03, & 0.2576956E+03, 0.7274969E+04, 0.5052988E+03, 0.8597862E+02, & -0.1888309E+02,-0.5160939E+03,-0.3935513E+02, 0.1167900E+02, & 0.1558802E+03, 0.1408596E+02, 0.4682938E+04, 0.2563573E+03, & 0.1164193E+03,-0.5997314E+01/ data (sdev( 8,j),j=1,36) / 0.2331542E+02, 0.2770294E+01, & 0.1356292E+02, 0.4341210E+01, 0.2565874E+01, 0.3118126E+03, & 0.9770463E+01, 0.2700221E+04, 0.3019180E+03, 0.2728907E+04, & 0.2217190E+03, 0.1108056E+03, 0.1614140E+04, 0.3789682E+03, & 0.8680218E+02, 0.4127718E+03, 0.6735981E+02, 0.4158892E+02, & 0.5858888E+03, 0.1504650E+03, 0.3336576E+04, 0.5575274E+03, & 0.2972206E+03, 0.3702202E+04, 0.1157438E+04, 0.7301750E+02, & 0.2609112E+02, 0.5195650E+03, 0.9562437E+02, 0.2091177E+02, & 0.3571355E+03, 0.3537364E+02, 0.4208102E+04, 0.2944192E+04, & 0.2209439E+03, 0.4131228E+02/ data (scoef( 9,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00,-0.1245924E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.2065900E+00, 0.0000000E+00,-0.1119146E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.3103650E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00,-0.3156649E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 9,j),j=1,36) / 0.3256700E+02, 0.1464551E+02, & 0.1155945E+03,-0.8221828E+01, 0.2212730E+01, 0.6724372E+02, & 0.4851480E+01, 0.1610180E+04, 0.4590651E+03, 0.3702369E+04, & -0.2446719E+03, 0.6839015E+02, 0.1959760E+04, 0.1568171E+03, & 0.2217126E+03, 0.1698372E+04,-0.1193639E+03, 0.3350007E+02, & 0.9351116E+03, 0.6553180E+02, 0.1354381E+05,-0.9647840E+03, & 0.2514245E+03, 0.7223625E+04, 0.5354881E+03, 0.8602952E+02, & -0.1838713E+02,-0.5213773E+03,-0.4177164E+02, 0.1129564E+02, & 0.1469301E+03, 0.1391820E+02, 0.4667659E+04, 0.2648191E+03, & 0.1178677E+03,-0.7068398E+01/ data (sdev( 9,j),j=1,36) / 0.2344619E+02, 0.2687708E+01, & 0.1348207E+02, 0.4293741E+01, 0.2530070E+01, 0.2366000E+03, & 0.9713761E+01, 0.2796710E+04, 0.2982126E+03, 0.2756915E+04, & 0.2191171E+03, 0.1077691E+03, 0.1599424E+04, 0.3733430E+03, & 0.8225807E+02, 0.3977646E+03, 0.6485299E+02, 0.4052077E+02, & 0.5554506E+03, 0.1482124E+03, 0.3306920E+04, 0.5491180E+03, & 0.2916813E+03, 0.3740634E+04, 0.1145511E+04, 0.7211736E+02, & 0.2558451E+02, 0.4751219E+03, 0.9594357E+02, 0.2122226E+02, & 0.2924824E+03, 0.3480763E+02, 0.4253586E+04, 0.3133444E+04, & 0.2277168E+03, 0.4168740E+02/ data (scoef(10,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.6412943E+00, & 0.0000000E+00, 0.0000000E+00,-0.1008322E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.1808974E+00, 0.0000000E+00,-0.9930872E-01, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg(10,j),j=1,36) / 0.3244245E+02, 0.1446961E+02, & 0.1151464E+03,-0.8219359E+01, 0.2156941E+01, 0.6130843E+02, & 0.5112215E+01, 0.1608799E+04, 0.4521713E+03, 0.3675283E+04, & -0.2431198E+03, 0.6584370E+02, 0.1934150E+04, 0.1645114E+03, & 0.2161679E+03, 0.1671032E+04,-0.1178861E+03, 0.3231959E+02, & 0.9146586E+03, 0.6895284E+02, 0.1344060E+05,-0.9605197E+03, & 0.2440476E+03, 0.7157191E+04, 0.5657189E+03, 0.8555419E+02, & -0.1777317E+02,-0.5241910E+03,-0.4391199E+02, 0.1068508E+02, & 0.1363673E+03, 0.1368596E+02, 0.4633374E+04, 0.3485460E+03, & 0.1163851E+03,-0.8081436E+01/ data (sdev(10,j),j=1,36) / 0.2358951E+02, 0.2607800E+01, & 0.1348963E+02, 0.4242887E+01, 0.2456545E+01, 0.2957923E+02, & 0.9501540E+01, 0.2905742E+04, 0.2946989E+03, 0.2792864E+04, & 0.2139260E+03, 0.1052045E+03, 0.1575003E+04, 0.3630870E+03, & 0.7811045E+02, 0.3847938E+03, 0.6279043E+02, 0.3821323E+02, & 0.5127150E+03, 0.1431177E+03, 0.3302588E+04, 0.5408215E+03, & 0.2809234E+03, 0.3784311E+04, 0.1114523E+04, 0.7099328E+02, & 0.2340798E+02, 0.4078613E+03, 0.9483244E+02, 0.1876076E+02, & 0.1704033E+03, 0.3395292E+02, 0.4303698E+04, 0.8312715E+03, & 0.2208521E+03, 0.4166153E+02/ end !********************************************************************* !********************************************************************* !********************************************************************* subroutine epshif5d(ymdh, elat, elon, elat12, elon12, vel, vel12, strmid) ! ! epshif5d ! This subroutine calculates tropical cyclone in the eastern Pacific ! intensities through 120 hours based upon climatology and persistence ! using tropical cyclone data during the years 1975-1999 for development. ! Tropical cyclones used in this developmental dataset had initial ! positions south of 35N and east of 160W and were 50km from any ! coastline. The linear regression model (one for each forecast time) ! was created using the total change in intensity for each period ! (12-hr,....120-hr) from intial conditions as the predictand and ! 35 predictors including and derived from julian day, latitude, ! longitude, zonal speed, meridional speed, current intensity the ! past 12-hour intensity trend. ! ! In the formulation of the model linear terms are first put into the ! model using a forward stepping approach for the 12-hour forecast. ! The linear predictors chosen in this forward stepping process ! are then forced into the model and exposed to the 2nd order terms, ! which at this point are allowed to come into the model in a ! stepwise fashion. A backward step is then performed to remove ! predictors that are no longer significant. Then a final stepwise ! stepping proceedure is performed possibly adding a removing predictors ! Following the 12-hour forecast the predictors chosen for the previous ! forecast period are then given preference in the selection process. ! Again, the predictors chosen in this forward stepping process ! are then forced into the model and exposed to the 2nd order terms, ! which at this point are allowed to come into the model in a ! stepwise fashion. A backward pass through the data is then performed ! to remove predictors that are no longer significant. Followed by ! a final step that is stepwise. Probabilities were set at .000000001%. ! J. Knaff (04/12/2001) ! Modifications: ! 6/14/21 (J. Dostalek) Started this Fortran 90 version !------------------------------------------------------------------------------- implicit none integer :: ishifor real :: scoef, avg, sdev common/shifor/ishifor(15, 3) common/coef/scoef(10, 36), avg(10, 36), sdev(10, 36) ! dimension coeficients. integer, parameter :: nc = 36 real, dimension(36) :: p real, dimension(36) :: forecast(10) integer, parameter :: double = selected_real_kind(13) real(kind=double), dimension(10) :: dv ! dimension input. integer :: ymdh, daynum integer, dimension(10) :: iwnd character(len=6) :: strmid character(len=8) :: aymdh real :: elat, elon, avglat, elat12, elon12, vel, vel12 real :: rad integer :: iyear, imonth, iday, julday, ivel integer :: i, j rad = 3.14159/180.0 ! intialize to zero do i = 1, 10 dv(i) = 0.0 iwnd(i) = 0 end do ! ! write input parameters out to printer write (*, '('' EASTERN PACIFIC SHIFOR5'',/)') write (*, 1001) strmid, ymdh 1001 format('INPUT PARAMETERS FOR TROPICAL CYCLONE ', A, ' ON YMDH = ', & I10.10,/) write (*, 1002) elat, elon, vel, elat12, elon12, vel12 1002 format(' LA0 = ', F5.1, ' N LO0 = ', F6.1, ' W WND0 = ', F4.0, & ' KT', /, ' LAM12 = ', F5.1, ' N LOM12 = ', F6.1, ' W WNDM12 = ', F4.0, & ' KT',/) ! check for system intensity requirements. if (vel < 15.0 .or. vel12 < 15.0) then write (6, 1) 1 format(/, ' EPSHIF NOT RUN DUE TO AT LEAST ONE INPUT WIND LESS THAN 15 KT') return end if ! create predictor pool (first order terms, squares, and ! co-variances terms) ! p1 = absolute value of (julian day - 238) ! p2 = lat ! p3 = lon ! p4 = u ! zonal speed of the storm over the last 12 hours ! p5 = v ! meridional speed of the storm over the last 12 hours ! p6 = vmax ! p7 = delta vmax ! calculate julian day iyear = ymdh/1000000 imonth = (ymdh - iyear*1000000)/10000 iday = (ymdh - iyear*1000000 - imonth*10000)/100 call jday(imonth, iday, iyear, julday) ! assign predictor values from the input data p(1) = dble(abs(julday - 238)) p(2) = dble(elat) p(3) = dble(elon) avglat = (elat + elat12)/2.0 p(4) = dble((elon - elon12)*(-60.0)/12.0*cos(rad*avglat)) p(5) = dble((elat - elat12)*60./12.) p(6) = dble(vel) p(7) = dble(vel - vel12) p(8) = p(1)**2 !p1*p1 p(9) = p(1)*p(2) !p1*p2 p(10) = p(1)*p(3) !p1*p3 p(11) = p(1)*p(4) !etc.... p(12) = p(1)*p(5) p(13) = p(1)*p(6) p(14) = p(1)*p(7) p(15) = p(2)**2 p(16) = p(2)*p(3) p(17) = p(2)*p(4) p(18) = P(2)*p(5) p(19) = p(2)*p(6) p(20) = p(2)*p(7) p(21) = p(3)**2 p(22) = p(3)*p(4) p(23) = p(3)*p(5) p(24) = p(3)*p(6) p(25) = p(3)*p(7) p(26) = p(4)**2 p(27) = p(4)*p(5) p(28) = p(4)*p(6) p(29) = p(4)*p(7) p(30) = p(5)**2 p(31) = p(5)*p(6) p(32) = p(5)*p(7) p(33) = p(6)**2 p(34) = p(6)*p(7) p(35) = p(7)**2 p(36) = vel ! calculate the predicted incremental change in velocity ! ! do i = 1, 10 dv(i) = 0.0 ! intitialize array to zero. do j = 1, 35 dv(i) = dv(i) + dble(scoef(i, j)*((p(j) - avg(i, j))/sdev(i, j))) end do dv(i) = dv(i)*dble(sdev(i, 36)) + dble(avg(i, 36)) end do ! ! construct forecast intensities forecast(1) = p(36) + dv(1) do i = 1, 10 forecast(i) = p(36) + sngl(dv(i)) end do do i = 1, 10 if (forecast(i) < 0.0) forecast(i) = 0.0 iwnd(i) = nint(forecast(i)) end do ! fill ishifor array for the atcf ishifor(1, 3) = nint(vel) do i = 1, 10 ishifor(i + 1, 3) = iwnd(i) end do ivel = nint(vel) write (*, '('' FORECAST INTENSITY (KT)'')') write (*, 2) ivel, (iwnd(i), i=1, 10) 2 format(/, ' 00 HR = ', I5, /, ' 12 HR = ', I5, /, ' 24 HR = ', I5, /, & ' 36 HR = ', I5, /, ' 48 HR = ', I5, /, ' 60 HR = ', i5, /, ' 72 HR = ', & I5, /, ' 84 HR = ', I5, /, ' 96 HR = ', I5, /, '108 HR = ', I5, /, & '120 HR = ', I5,/) return end subroutine epshif5d