c
c ++++BEGIN ERC-CLIM intensity change model MODULE++++
c
c Jim Kossin, NOAA/CWC, 14 AUG 2015
c
c v. 19.0.1. GC - added statements to avoid out-of bound arrays
c           while itereting on k
c
c
      subroutine erc_clim_driver(luout,ivships,mft)
      dimension ivships(0:mft),iverc(0:mft)
      character *4 cvships(0:mft)

c write module header
      write(luout,800)
 800  format(/,'**',1x,'DSHIPS INTENSITY FORECAST ADJUSTED RELATIVE TO',
     +' ONSET OF ERC WEAKENING PHASE **')

c write time header
      write(luout,810) (i*6,i=0,4),(i*6,i=6,mft,2)
 810  format('      TIME (HR)   ',1x,i3,20(3x,i3))

c
c Onset of ERC weakening 24h ago or more ( = DSHIPS)
c
      do k=0,mft
         write(cvships(k),900) ivships(k)
      enddo

c if below 15kt, set all subsequent to dissipating (DIS)
      k=0
      do while (k.le.mft .and. ivships(k).ge.15)
         k=k+1
         if ( k .gt. mft ) exit
      enddo
      if(k.le.mft)then
         do m=k,mft
            write(cvships(m),700)
         enddo
      endif

c write to SHIPS output
      write(luout,816) (cvships(i),i=0,4),(cvships(i),i=6,mft,2)
 816  format('>24HR AGO (DSHIPS)',a4,20(2x,a4))

c
c Onset of ERC weakening 18h ago
c
      iverc(0)=ivships(0)
      iverc(1)=ivships(0)-1
      idif=ivships(1)-(ivships(0)-1)
      do k=2,mft
         iverc(k)=ivships(k)-idif
      enddo
      do k=0,mft
         write(cvships(k),900) iverc(k)
      enddo

c if below 15kt, set to dissipating (DIS)
      k=0
      do while (iverc(k).ge.15 .and. k.le.mft)
         k=k+1
         if ( k .gt. mft ) exit
      enddo
      if(k.le.mft)then
         do m=k,mft
            write(cvships(m),700)
         enddo
      endif

c write to SHIPS output
      write(luout,818) (cvships(i),i=0,4),(cvships(i),i=6,mft,2)
 818  format(' 18HR AGO',9x,a4,20(2x,a4))

c
c Onset of ERC weakening 12h ago
c
      iverc(0)=ivships(0)
      iverc(1)=ivships(0)-3
      iverc(2)=ivships(0)-4
      idif=ivships(2)-(ivships(0)-4)
      do k=3,mft
         iverc(k)=ivships(k)-idif
      enddo
      do k=0,mft
         write(cvships(k),900) iverc(k)
      enddo

c if below 15kt, set to dissipating (DIS)
      k=0
      do while (iverc(k).ge.15 .and. k.le.mft)
         k=k+1
         if ( k .gt. mft ) exit
      enddo
      if(k.le.mft)then
         do m=k,mft
            write(cvships(m),700)
         enddo
      endif

c write to SHIPS output
      write(luout,820) (cvships(i),i=0,4),(cvships(i),i=6,mft,2)
 820  format(' 12HR AGO',9x,a4,20(2x,a4))

c
c Onset of ERC weakening 6h ago
c
      iverc(0)=ivships(0)
      iverc(1)=ivships(0)-6
      iverc(2)=ivships(0)-9
      iverc(3)=ivships(0)-10
      idif=ivships(3)-(ivships(0)-10)
      do k=4,mft
         iverc(k)=ivships(k)-idif
      enddo
      do k=0,mft
         write(cvships(k),900) iverc(k)
      enddo

c if below 15kt, set to dissipating (DIS)
      k=0
      do while (iverc(k).ge.15 .and. k.le.mft)
         k=k+1
         if ( k .gt. mft ) exit
      enddo
      if(k.le.mft)then
         do m=k,mft
            write(cvships(m),700)
         enddo
      endif

c write to SHIPS output
      write(luout,912) (cvships(i),i=0,4),(cvships(i),i=6,mft,2)
 912  format('  6HR AGO',9x,a4,20(2x,a4))

c
c Onset of ERC weakening now
c
      iverc(0)=ivships(0)
      iverc(1)=ivships(0)-9
      iverc(2)=ivships(0)-15
      iverc(3)=ivships(0)-18
      iverc(4)=ivships(0)-19
      idif=ivships(4)-(ivships(0)-19)
      do k=5,mft
         iverc(k)=ivships(k)-idif
      enddo
      do k=0,mft
         write(cvships(k),900) iverc(k)
      enddo

c if below 15kt, set to dissipating (DIS)
      k=0
      do while (iverc(k).ge.15 .and. k.le.mft)
         k=k+1
         if ( k .gt. mft ) exit
      enddo
      if(k.le.mft)then
         do m=k,mft
            write(cvships(m),700)
         enddo
      endif

c write to SHIPS output if threshold satisfied
      ithresh=83
      if (iverc(0).ge.ithresh) then
         write(luout,913) (cvships(i),i=0,4),(cvships(i),i=6,mft,2)
      else
         write(luout,713)
      endif
 713  format('      NOW',30x,'CURRENT INTENSITY < 83 KT')
 913  format('      NOW',9x,a4,20(2x,a4))

c
c Onset of ERC weakening in 6h
c
      iverc(0)=ivships(0)
      iverc(1)=ivships(1)
      iverc(2)=ivships(1)-9
      iverc(3)=ivships(1)-15
      iverc(4)=ivships(1)-18
      iverc(5)=ivships(1)-19
      idif=ivships(5)-(ivships(1)-19)
      do k=6,mft
         iverc(k)=ivships(k)-idif
      enddo
      do k=0,mft
         write(cvships(k),900) iverc(k)
      enddo

c if below 15kt, set to dissipating (DIS)
      k=0
      do while (iverc(k).ge.15 .and. k.le.mft)
         k=k+1
         if ( k .gt. mft ) exit
      enddo
      if(k.le.mft)then
         do m=k,mft
            write(cvships(m),700)
         enddo
      endif

c write to SHIPS output if threshold satisfied
      ithresh=83
      if (iverc(1).ge.ithresh) then
         write(luout,914) (cvships(i),i=0,4),(cvships(i),i=6,mft,2)
      else
         write(luout,714)
      endif
 714  format('  IN  6HR',30x,'INTENSITY IN  6HR < 83 KT')
 914  format('  IN  6HR',9x,a4,20(2x,a4))

c
c Onset of ERC weakening in 12h
c
      iverc(0)=ivships(0)
      iverc(1)=ivships(1)
      iverc(2)=ivships(2)
      iverc(3)=ivships(2)-9
      iverc(4)=ivships(2)-15
      iverc(5)=ivships(2)-18
      iverc(6)=ivships(2)-19
      idif=ivships(6)-(ivships(2)-19)
      do k=7,mft
         iverc(k)=ivships(k)-idif
      enddo
      do k=0,mft
         write(cvships(k),900) iverc(k)
      enddo

c if below 15kt, set to dissipating (DIS)
      k=0
      do while (iverc(k).ge.15 .and. k.le.mft)
         k=k+1
         if ( k .gt. mft ) exit
      enddo
      if(k.le.mft)then
         do m=k,mft
            write(cvships(m),700)
         enddo
      endif

c write to SHIPS output if threshold satisfied
      ithresh=83
      if (iverc(2).ge.ithresh) then
         write(luout,915) (cvships(i),i=0,4),(cvships(i),i=6,mft,2)
      else
         write(luout,715)
      endif
 715  format('  IN 12HR',30x,'INTENSITY IN 12HR < 83 KT')
 915  format('  IN 12HR',9x,a4,20(2x,a4))

 900  format(i4)
 700  format(' DIS')

      return
      end