program alshifor5 !** This program runs Atlantic SHIFOR guidance program. ! Modfied 10/08/2016 for WCOSS Cray. New ATCF libraries used, requires larger ishifo array ! Modifications: ! 06/11/2021 (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 al072022.com and al072022.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 !------------------------------------------------------------------------------- implicit none include 'dataformats.inc' common /shifor/ ishifor( 15, 3 ) integer :: ymdh real :: latcur, loncur, latm12, lonm12 real :: wndcur, wndm12 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 the final array do i = 1, 15 do j = 1, 3 ishifor ( i, j ) = 0 enddo enddo !** Get the command line parameter (i.e. input file name = strmid.com) 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 .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 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 .ne. 1 ) then print *,' ERROR - reading data = ', input_file, ' istat = ', istat stop endif latm12 = tauData%aRecord(1)%lat lonm12 = tauData%aRecord(1)%lon wndm12 = tauData%aRecord(1)%vmax write ( *, 1 ) strmid 1 format (' Atlantic SHIFOR5 forecast for ',a8,//) !** Compute 5-day SHIFOR forecasts call atshif5d(ymdh,latcur,loncur,latm12,lonm12,wndcur,wndm12,strmid) !** Open the output file, write out the data and close the file open ( 31, file='alshifor5.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 '***** ATLANTIC SHIFOR5 FORECASTS ARE FINISHED *****' !** Error messages 1010 print *,' ERROR - opening file = ', input_file, ' istat = ', istat stop end !************************************************************************ !************************************************************************ block data ! ! block data for the standardized coeficients to the 5-day ! Atlantic SHIFOR ! ! These are used by alshif5d and passed via a common block ! initialized in this subprogram. The common block is not passed ! to the main program. ! ! scoef are the standardized coeficients ! 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.0000000E+00, & 0.9632107E-01, 0.2161774E+00, 0.0000000E+00,-0.2598887E+00, & 0.6619257E+00,-0.6903946E-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.0000000E+00, & 0.0000000E+00,-0.3840485E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.2655196E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 1,j),j=1,36) / 0.6924230E+00, 0.2501092E+02, & 0.6001072E+02,-0.2517827E+01, 0.4779600E+01, 0.5636170E+02, & 0.2587011E+01, 0.1030277E+04, 0.1775327E+02, 0.4254318E+02, & 0.3506200E+02,-0.1217535E+02, 0.1154956E+03,-0.1672390E+02, & 0.6990111E+03, 0.1512090E+04,-0.2923416E+01, 0.1318952E+03, & 0.1450323E+04, 0.5226493E+02, 0.3901107E+04,-0.1370406E+03, & 0.2816506E+03, 0.3394556E+04, 0.1688047E+03, 0.9963890E+02, & -0.9566036E-01,-0.1150216E+03,-0.1612303E+02, 0.4871619E+02, & 0.2915584E+03, 0.1450799E+02, 0.3791872E+04, 0.1823332E+03, & 0.8294604E+02, 0.2005495E+01/ data (sdev( 1,j),j=1,36) / 0.3209314E+02, 0.8571875E+01, & 0.1731675E+02, 0.9659969E+01, 0.5086838E+01, 0.2480592E+02, & 0.8733048E+01, 0.1864341E+04, 0.8357047E+03, 0.2234280E+04, & 0.2879513E+03, 0.2154462E+03, 0.1749152E+04, 0.3003741E+03, & 0.4446778E+03, 0.6461969E+03, 0.2631858E+03, 0.1692676E+03, & 0.8461565E+03, 0.2281288E+03, 0.2127881E+04, 0.5451351E+03, & 0.3145661E+03, 0.1852198E+04, 0.5793061E+03, 0.1301999E+03, & 0.7732862E+02, 0.5875003E+03, 0.9362686E+02, 0.7837893E+02, & 0.3577816E+03, 0.6779141E+02, 0.3409085E+04, 0.6547117E+03, & 0.1612456E+03, 0.9235003E+01/ data (scoef( 2,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.1233280E+00, 0.2059798E+00, 0.0000000E+00,-0.2399135E+00, & 0.7064717E+00,-0.1008747E+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.1276496E+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.3583669E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.3909434E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 2,j),j=1,36) / 0.9079197E+00, 0.2451084E+02, & 0.5893240E+02,-0.3085352E+01, 0.4501705E+01, 0.5650076E+02, & 0.2622774E+01, 0.9678882E+03, 0.2445280E+02, 0.7167412E+02, & 0.3633494E+02,-0.1068501E+02, 0.1269655E+03,-0.1328003E+02, & 0.6709643E+03, 0.1464025E+04,-0.2066254E+02, 0.1185758E+03, & 0.1428452E+04, 0.5308390E+02, 0.3755662E+04,-0.1573582E+03, & 0.2618678E+03, 0.3339356E+04, 0.1592436E+03, 0.9354892E+02, & -0.6658569E+01,-0.1436312E+03,-0.1608299E+02, 0.4283905E+02, & 0.2740909E+03, 0.1404197E+02, 0.3795095E+04, 0.1763668E+03, & 0.7905362E+02, 0.3726980E+01/ data (sdev( 2,j),j=1,36) / 0.3110060E+02, 0.8378330E+01, & 0.1681333E+02, 0.9167630E+01, 0.4751629E+01, 0.2455349E+02, & 0.8496373E+01, 0.1768235E+04, 0.7934583E+03, 0.2132501E+04, & 0.2678891E+03, 0.1941161E+03, 0.1705528E+04, 0.2929895E+03, & 0.4255700E+03, 0.6396952E+03, 0.2369832E+03, 0.1480606E+03, & 0.8353543E+03, 0.2164446E+03, 0.2038278E+04, 0.5116897E+03, & 0.2930400E+03, 0.1768569E+04, 0.5501223E+03, 0.1166377E+03, & 0.6353190E+02, 0.5536301E+03, 0.8621957E+02, 0.6173920E+02, & 0.3307446E+03, 0.5880326E+02, 0.3329759E+04, 0.6239390E+03, & 0.1531375E+03, 0.1532608E+02/ data (scoef( 3,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.1334133E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.6672866E+00,-0.1210680E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.2524992E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & -0.5450201E+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.1718453E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.4152353E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 3,j),j=1,36) / 0.9616966E+00, 0.2404943E+02, & 0.5779779E+02,-0.3558863E+01, 0.4308050E+01, 0.5671110E+02, & 0.2737719E+01, 0.9210535E+03, 0.2779111E+02, 0.8878762E+02, & 0.3805056E+02,-0.1038823E+02, 0.1297228E+03,-0.1325298E+02, & 0.6464169E+03, 0.1417209E+04,-0.3392802E+02, 0.1093273E+03, & 0.1409962E+04, 0.5483954E+02, 0.3607683E+04,-0.1723524E+03, & 0.2469319E+03, 0.3293460E+04, 0.1577506E+03, 0.9111264E+02, & -0.1095332E+02,-0.1681860E+03,-0.1828591E+02, 0.3958164E+02, & 0.2626406E+03, 0.1389569E+02, 0.3815360E+04, 0.1803387E+03, & 0.7714023E+02, 0.4966674E+01/ data (sdev( 3,j),j=1,36) / 0.3033690E+02, 0.8249646E+01, & 0.1634490E+02, 0.8857997E+01, 0.4585509E+01, 0.2448144E+02, & 0.8346269E+01, 0.1721265E+04, 0.7590904E+03, 0.2051263E+04, & 0.2579913E+03, 0.1808050E+03, 0.1664844E+04, 0.2869225E+03, & 0.4123503E+03, 0.6362572E+03, 0.2202684E+03, 0.1374561E+03, & 0.8296448E+03, 0.2083708E+03, 0.1948476E+04, 0.4887198E+03, & 0.2799759E+03, 0.1721974E+04, 0.5274450E+03, 0.1109338E+03, & 0.5723892E+02, 0.5324178E+03, 0.8228619E+02, 0.5533614E+02, & 0.3181781E+03, 0.5351896E+02, 0.3303091E+04, 0.6109392E+03, & 0.1502984E+03, 0.2018737E+02/ data (scoef( 4,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.1179411E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.5688543E+00,-0.1263167E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.3047682E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & -0.6389252E+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.1818729E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.3632210E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 4,j),j=1,36) / 0.8890815E+00, 0.2363174E+02, & 0.5672563E+02,-0.3959007E+01, 0.4171206E+01, 0.5699431E+02, & 0.2956177E+01, 0.8737126E+03, 0.2832931E+02, 0.9426695E+02, & 0.3968130E+02,-0.1056524E+02, 0.1285152E+03,-0.1212280E+02, & 0.6245836E+03, 0.1374201E+04,-0.4443031E+02, 0.1024761E+03, & 0.1394454E+04, 0.5930000E+02, 0.3471278E+04,-0.1841963E+03, & 0.2358062E+03, 0.3260008E+04, 0.1639787E+03, 0.9053625E+02, & -0.1423454E+02,-0.1899361E+03,-0.2018777E+02, 0.3704388E+02, & 0.2550115E+03, 0.1441322E+02, 0.3847742E+04, 0.1924855E+03, & 0.7592820E+02, 0.5805893E+01/ data (sdev( 4,j),j=1,36) / 0.2954891E+02, 0.8132701E+01, & 0.1592306E+02, 0.8653384E+01, 0.4432809E+01, 0.2448550E+02, & 0.8197918E+01, 0.1667888E+04, 0.7266108E+03, 0.1972593E+04, & 0.2514733E+03, 0.1682396E+03, 0.1624908E+04, 0.2809930E+03, & 0.4014341E+03, 0.6329095E+03, 0.2091046E+03, 0.1281973E+03, & 0.8236214E+03, 0.2017373E+03, 0.1863299E+04, 0.4736634E+03, & 0.2677355E+03, 0.1698982E+04, 0.5058230E+03, 0.1072277E+03, & 0.5339523E+02, 0.5209970E+03, 0.8075079E+02, 0.5054678E+02, & 0.3098015E+03, 0.5224454E+02, 0.3286008E+04, 0.5994625E+03, & 0.1427729E+03, 0.2406040E+02/ data (scoef( 5,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.1066351E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.4361093E+00,-0.1229526E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.3588182E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & -0.7048543E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.7875312E-01, & 0.0000000E+00,-0.1810176E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.2748392E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 5,j),j=1,36) / 0.7411598E+00, 0.2323304E+02, & 0.5587768E+02,-0.4325152E+01, 0.4093352E+01, 0.5715955E+02, & 0.3132390E+01, 0.8297267E+03, 0.2728141E+02, 0.9450549E+02, & 0.4206970E+02,-0.1141570E+02, 0.1228300E+03,-0.1365545E+02, & 0.6040857E+03, 0.1336892E+04,-0.5336236E+02, 0.9788639E+02, & 0.1375858E+04, 0.6265878E+02, 0.3368683E+04,-0.1953185E+03, & 0.2288874E+03, 0.3232563E+04, 0.1698837E+03, 0.9092222E+02, & -0.1654315E+02,-0.2097693E+03,-0.2138794E+02, 0.3543734E+02, & 0.2507907E+03, 0.1472942E+02, 0.3870560E+04, 0.2028622E+03, & 0.7680764E+02, 0.6461952E+01/ data (sdev( 5,j),j=1,36) / 0.2879951E+02, 0.8020582E+01, & 0.1569833E+02, 0.8499159E+01, 0.4322857E+01, 0.2456659E+02, & 0.8186252E+01, 0.1617134E+04, 0.6940360E+03, 0.1907284E+04, & 0.2470698E+03, 0.1595705E+03, 0.1592168E+04, 0.2760713E+03, & 0.3922771E+03, 0.6302870E+03, 0.2006715E+03, 0.1216372E+03, & 0.8166120E+03, 0.1994494E+03, 0.1810311E+04, 0.4624083E+03, & 0.2593056E+03, 0.1694290E+04, 0.4982435E+03, 0.1037749E+03, & 0.5123920E+02, 0.5120408E+03, 0.8149457E+02, 0.4752918E+02, & 0.3031102E+03, 0.5243453E+02, 0.3284298E+04, 0.5991281E+03, & 0.1446465E+03, 0.2705362E+02/ data (scoef( 6,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.8026610E-01, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.3887290E+00,-0.1167581E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.3965225E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & -0.7556319E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.9791975E-01, & 0.0000000E+00,-0.1792372E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00,-0.2562578E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 6,j),j=1,36) / 0.5282349E+00, 0.2288561E+02, & 0.5509222E+02,-0.4616736E+01, 0.4066473E+01, 0.5720878E+02, & 0.3269119E+01, 0.7833530E+03, 0.2451029E+02, 0.8987844E+02, & 0.4654677E+02,-0.1255986E+02, 0.1154485E+03,-0.1190449E+02, & 0.5868539E+03, 0.1304664E+04,-0.5985332E+02, 0.9588982E+02, & 0.1357026E+04, 0.6501071E+02, 0.3277084E+04,-0.2018239E+03, & 0.2255694E+03, 0.3203238E+04, 0.1741666E+03, 0.9196463E+02, & -0.1768923E+02,-0.2261230E+03,-0.2270596E+02, 0.3445014E+02, & 0.2489540E+03, 0.1535398E+02, 0.3879045E+04, 0.2116815E+03, & 0.7734914E+02, 0.6904808E+01/ data (sdev( 6,j),j=1,36) / 0.2798798E+02, 0.7945013E+01, & 0.1555665E+02, 0.8406735E+01, 0.4233170E+01, 0.2462512E+02, & 0.8165998E+01, 0.1559906E+04, 0.6625800E+03, 0.1841586E+04, & 0.2441215E+03, 0.1501844E+03, 0.1544518E+04, 0.2655307E+03, & 0.3854558E+03, 0.6318023E+03, 0.1945790E+03, 0.1180420E+03, & 0.8090012E+03, 0.1964395E+03, 0.1767535E+04, 0.4526402E+03, & 0.2536928E+03, 0.1695497E+04, 0.4891541E+03, 0.1022458E+03, & 0.5073444E+02, 0.5048276E+03, 0.8129501E+02, 0.4514432E+02, & 0.2981933E+03, 0.5209768E+02, 0.3278063E+04, 0.5976022E+03, & 0.1443764E+03, 0.2930631E+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.1047530E+00,-0.8868639E-01, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.4587812E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & -0.8218156E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.1123108E+00, & 0.0000000E+00,-0.1655864E+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( 7,j),j=1,36) / 0.4207630E+00, 0.2255040E+02, & 0.5443819E+02,-0.4917055E+01, 0.4062362E+01, 0.5703888E+02, & 0.3388848E+01, 0.7403136E+03, 0.2312487E+02, 0.9094167E+02, & 0.4966651E+02,-0.1176302E+02, 0.1092751E+03,-0.4587674E+01, & 0.5698082E+03, 0.1275754E+04,-0.6694496E+02, 0.9490926E+02, & 0.1333167E+04, 0.6673709E+02, 0.3206201E+04,-0.2110588E+03, & 0.2246610E+03, 0.3166486E+04, 0.1796703E+03, 0.9265514E+02, & -0.1852151E+02,-0.2425760E+03,-0.2346312E+02, 0.3375825E+02, & 0.2468534E+03, 0.1563206E+02, 0.3860909E+04, 0.2147707E+03, & 0.7540719E+02, 0.7243947E+01/ data (sdev( 7,j),j=1,36) / 0.2721044E+02, 0.7830068E+01, & 0.1558119E+02, 0.8276644E+01, 0.4154732E+01, 0.2465152E+02, & 0.7996647E+01, 0.1486568E+04, 0.6332492E+03, 0.1784579E+04, & 0.2395884E+03, 0.1394451E+03, 0.1492160E+04, 0.2504226E+03, & 0.3766640E+03, 0.6321689E+03, 0.1879339E+03, 0.1158340E+03, & 0.7986561E+03, 0.1904583E+03, 0.1749101E+04, 0.4422272E+03, & 0.2496878E+03, 0.1696971E+04, 0.4733990E+03, 0.1008219E+03, & 0.4979871E+02, 0.4965642E+03, 0.7946046E+02, 0.4403391E+02, & 0.2927683E+03, 0.5060949E+02, 0.3274097E+04, 0.5828798E+03, & 0.1414711E+03, 0.3087317E+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.9537594E-01, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.4518728E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & -0.8478302E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.1335201E+00, & 0.0000000E+00,-0.1486502E+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( 8,j),j=1,36) / 0.4769039E+00, 0.2223271E+02, & 0.5392975E+02,-0.5245444E+01, 0.4073866E+01, 0.5679109E+02, & 0.3439451E+01, 0.6933816E+03, 0.2537599E+02, 0.9890241E+02, & 0.5022994E+02,-0.1020454E+02, 0.1035189E+03,-0.2918435E+01, & 0.5532652E+03, 0.1250069E+04,-0.7521220E+02, 0.9437025E+02, & 0.1308384E+04, 0.6672680E+02, 0.3154948E+04,-0.2238049E+03, & 0.2245567E+03, 0.3128242E+04, 0.1821682E+03, 0.9341725E+02, & -0.1931823E+02,-0.2613367E+03,-0.2460387E+02, 0.3332844E+02, & 0.2451973E+03, 0.1544944E+02, 0.3841154E+04, 0.2145339E+03, & 0.7453392E+02, 0.7796921E+01/ data (sdev( 8,j),j=1,36) / 0.2633330E+02, 0.7680913E+01, & 0.1570454E+02, 0.8119729E+01, 0.4091335E+01, 0.2482301E+02, & 0.7920240E+01, 0.1413855E+04, 0.6058992E+03, 0.1721314E+04, & 0.2337595E+03, 0.1330247E+03, 0.1450492E+04, 0.2424808E+03, & 0.3661280E+03, 0.6296606E+03, 0.1804536E+03, 0.1136799E+03, & 0.7890709E+03, 0.1860230E+03, 0.1750739E+04, 0.4317303E+03, & 0.2462065E+03, 0.1700974E+04, 0.4660102E+03, 0.1003206E+03, & 0.4966600E+02, 0.4872369E+03, 0.7847066E+02, 0.4366581E+02, & 0.2870837E+03, 0.5009062E+02, 0.3295655E+04, 0.5789249E+03, & 0.1388171E+03, 0.3218217E+02/ data (scoef( 9,j),j=1,36) / 0.0000000E+00, 0.3089123E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.1055703E+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.5977988E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.1598280E+00, & 0.1132629E+00,-0.2142111E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00, 0.0000000E+00,-0.2412702E+00, 0.0000000E+00, & 0.0000000E+00, 0.1000000E+01/ data (avg( 9,j),j=1,36) / 0.4476055E+00, 0.2192138E+02, & 0.5340811E+02,-0.5579272E+01, 0.4054054E+01, 0.5657278E+02, & 0.3548601E+01, 0.6483376E+03, 0.2617615E+02, 0.1013527E+03, & 0.5210487E+02,-0.9421763E+01, 0.9515031E+02,-0.3575154E+01, & 0.5370754E+03, 0.1224067E+04,-0.8324326E+02, 0.9253274E+02, & 0.1284906E+04, 0.6745268E+02, 0.3103078E+04,-0.2374746E+03, & 0.2228494E+03, 0.3088268E+04, 0.1870104E+03, 0.9521982E+02, & -0.2048142E+02,-0.2797499E+03,-0.2673219E+02, 0.3287624E+02, & 0.2417376E+03, 0.1522926E+02, 0.3831306E+04, 0.2196652E+03, & 0.7287435E+02, 0.8194879E+01/ data (sdev( 9,j),j=1,36) / 0.2546458E+02, 0.7520314E+01, & 0.1583576E+02, 0.8007618E+01, 0.4055698E+01, 0.2512221E+02, & 0.7765975E+01, 0.1336978E+04, 0.5802391E+03, 0.1659712E+04, & 0.2310691E+03, 0.1320454E+03, 0.1407886E+04, 0.2287508E+03, & 0.3549326E+03, 0.6250199E+03, 0.1747647E+03, 0.1116726E+03, & 0.7815645E+03, 0.1800884E+03, 0.1754649E+04, 0.4243386E+03, & 0.2447865E+03, 0.1705707E+04, 0.4525801E+03, 0.1010436E+03, & 0.5000002E+02, 0.4821107E+03, 0.7772745E+02, 0.4336179E+02, & 0.2819421E+03, 0.5012947E+02, 0.3344774E+04, 0.5673912E+03, & 0.1336848E+03, 0.3292386E+02/ data (scoef(10,j),j=1,36) / 0.0000000E+00, 0.0000000E+00, & 0.9469541E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, & 0.0000000E+00,-0.1078930E+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.1727341E+00, 0.0000000E+00,-0.6476331E+00, 0.0000000E+00, & 0.0000000E+00,-0.6957146E+00, 0.0000000E+00, 0.1605409E+00, & 0.1261314E+00,-0.1576631E+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.3980477E+00, 0.2159967E+02, & 0.5280331E+02,-0.5925649E+01, 0.4006236E+01, 0.5633189E+02, & 0.3727766E+01, 0.6011931E+03, 0.2631410E+02, 0.1027855E+03, & 0.5542253E+02,-0.9485357E+01, 0.8738937E+02,-0.7033623E+00, & 0.5208379E+03, 0.1195026E+04,-0.9081781E+02, 0.8989330E+02, & 0.1261422E+04, 0.7061524E+02, 0.3041471E+04,-0.2519473E+03, & 0.2191908E+03, 0.3042551E+04, 0.1953049E+03, 0.9791512E+02, & -0.2154251E+02,-0.2975466E+03,-0.2856389E+02, 0.3216120E+02, & 0.2370388E+03, 0.1545336E+02, 0.3819031E+04, 0.2332690E+03, & 0.7262690E+02, 0.8647505E+01/ data (sdev(10,j),j=1,36) / 0.2452266E+02, 0.7370310E+01, & 0.1591915E+02, 0.7926909E+01, 0.4014973E+01, 0.2541850E+02, & 0.7665672E+01, 0.1239007E+04, 0.5538984E+03, 0.1587020E+04, & 0.2307229E+03, 0.1327658E+03, 0.1352833E+04, 0.2263261E+03, & 0.3441646E+03, 0.6174752E+03, 0.1699011E+03, 0.1090849E+03, & 0.7755641E+03, 0.1731434E+03, 0.1751020E+04, 0.4186579E+03, & 0.2430095E+03, 0.1705991E+04, 0.4421535E+03, 0.1029045E+03, & 0.4997415E+02, 0.4806690E+03, 0.7786277E+02, 0.4229101E+02, & 0.2772892E+03, 0.4837127E+02, 0.3400294E+04, 0.5601602E+03, & 0.1343539E+03, 0.3347443E+02/ end !*********************************************************************** !*********************************************************************** !*********************************************************************** subroutine atshif5d(ymdh,alat,alon,alat12,alon12,vel,vel12,strmid) ! atshif5d ! This subroutine calculates tropical cyclone intensities through 120 ! hours based upon climatology and persistence using the years ! 1967-1999. The model 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. ! J. Knaff (04/05/2001) ! Modifications: ! 6/11/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 al072022.com as input, but will need ! some additional work to complete the goals of the f77 to f90 conversion. !------------------------------------------------------------------------------- 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 :: alat, alon, avglat, alat12, alon12, 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 (*,'('' ATLANTIC SHIFOR5'',/)') write (*,1001)strmid,ymdh 1001 format('INPUT PARAMETERS FOR TROPICAL CYCLONE ',A,' ON YMDH = ',I10.10,/) write (*,1002)alat,alon,vel,alat12,alon12,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.lt.15.0.OR.vel12.lt.15.0) then write (6,1) 1 format (/,' ATSHIF NOT RUN DUE TO AT LEAST ONE INPUT WIND LESS THAN & &15 KT') return endif ! create predictor pool (first order terms, squares, and ! co-variances terms) ! p1 = julian day - 253 ! 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(julday-253) p(2) = dble(alat) p(3) =dble(alon) avglat=(alat+alat12)/2.0 p(4) =dble((alon-alon12)* (-60.0)/ 12.0 * COS(rad*avglat)) p(5)=dble((alat-alat12)*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).lt.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) enddo ! write forecasts to standard output. 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