C note C-code also calls: llx2pq(&lt_pnt1,&lg_pnt1,&i,&j);
C note get rid of program main in runslhg.f...
C UND      
      SUBROUTINE INITAL (MMHALT,IIMXB,JJMXB,ZZB,MBHR,MMIN,MBDY,MBNT,
     1                   MYR,YYLT,YYLG,FFLE5,FFLE9,FFLE91,FFLE99,
     2                   FFLE40,CDFFILE,CDFLEN,PFILE,PFILELEN,WFILE,
     3                   WFILELEN,TBEGIN1,SFILE,SFILELEN,RFILE,RFILELEN)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C THIS SUBROUTINE CALLS ALL THE FORTRAN SUBROUTINES WHICH ARE NEEDED TO
C INITIALIZE THE FORTRAN VARIABLES BEFORE WE ENTER INTO THE COMPUTE LOOP.
C
C ORIGINALLY THIS WAS DONE IN PROGRAM MAIN AND CMPUTE.
C THE CODE IS THE SAME EXCEPT CUT AND PASTED HERE.
C
C THIS ALSO RETURNS TO C THE VARIOUS INITIAL VARIABLES NEEDED SO THAT
C IT CAN PROPERLY CONTROL THE EXECUTION OF THE PROGRAM.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      include 'parm.for'

      REAL ZZB(M_,N_),YYLT(M_,N_),YYLG(M_,N_)
      CHARACTER*257 FFLE5,FFLE9,FFLE91,FFLE99,FFLE40
      COMMON /IDENT/  AIDENT(40),DACLOK(7)
      COMMON /CESAV/  IPN(120),IPL(120),KHSPT
      COMMON /PRHSY/  IPRHR,JUMPR,IPRT
      COMMON /KEYS/ KEY1
C STIME interferes with C code, so switched to STIME2
      COMMON /STIME2/  ISTM,JHR,ITMADV,NHRAD,IBGNT,ITEND
      COMMON /FFTH/   ITIME,MHALT
      COMMON /DUMB3/  IMXB,JMXB,IMXB1,JMXB1,IMXB2,JMXB2
      COMMON /FLES/ FLE5,FLE9,FLE8,FLE91,FLE99,FLE10,FLE20,FLE30,FLE1
      CHARACTER*256 FLE5,FLE9,FLE8,FLE91,FLE99,FLE10,FLE20,FLE30,FLE1
      CHARACTER*256 FLE40
      common /landfl/ lftime
      CHARACTER*80   lftime
      CHARACTER*3 CMNT,TMNT(12)
C UND     
      INTEGER :: WFILELEN, PFILELEN, CDFLEN, TBEGIN1
      INTEGER :: SFILELEN, RFILELEN
      BYTE      :: WFILE(100),PFILE(100),CDFFILE(100),SFILE(100)
      BYTE      :: RFILE(100)

      INTEGER NDYMNT(12)
      DATA NDYMNT/31,28,31,30,31,30,31,31,30,31,30,31/
      DATA TMNT/'JAN','FEB','MAR','APR','MAY','JUN',
     1            'JUL','AUG','SEP','OCT','NOV','DEC'/

C UND 
      TBEGIN = TBEGIN1
      write(NCFILE,'(100a)') (cdffile(i),i=1,cdflen)
      write(WNFILE,'(100a)') (wfile(i),i=1,wfilelen)
      write(PRFILE,'(100a)') (pfile(i),i=1,pfilelen)
      write(STFILE,'(100a)') (sfile(i),i=1,sfilelen)      
      write(WVFILE,'(100a)') (rfile(i),i=1,rfilelen)            
      

C CODE FOR PROGRAM MAIN STARTS.
C
CC      write (*,*) '   This program is compiled with the maximum'
CC      write (*,*) '   dimensions ',m_,n_
c
CC      WRITE(*,*)'   SLOSH STORM INPUT FILE'
C      READ (*,'(A)') FLE5
      FLE5 = FFLE5
CC      WRITE(*,*)'   BASIN FILE *DTA'
C      READ (*,'(A)') FLE9
      FLE9 = FFLE9
      KEY1=1
C        ARCHIVE SURGE ENVELOP TO A FILE
CC      WRITE(*,'(A)')' FINAL MAX SURGE WILL BE SAVED IN THE FORM READY '
cc      WRITE(*,'(A)')' TO USE SLOSH FOR GRAPHICAL DISPLAY (IN FT).'
CC      WRITE(*,'(A)')'   SPECIFY THE FILE NAME = '
C      READ (*,'(A)') FLE91
      FLE91 = FFLE91
C
c      CALL STRMPR
C
C      FLE40 = 'FT40'
      FLE40 = FFLE40

CCCCC Arthur: Removed "FT40" option 8/2/2004
CCCC      CALL EXTRPT (FLE40)
CCCCC
CC      WRITE (*,*)' READ IN LAT/LONG OF THE GRIDS'
C      READ (*,'(A)') FLE99
      FLE99 = FFLE99
      CALL INITLZ

C CODE Located at top of CMPUTE... Initialize here, do rest in time step.
C
C    SELECTION OF SNAPSH FROM 'C' OPTION.
C     OPEN (77,FILE='SN001',FORM='UNFORMATTED')
c
c   include 'cmpgr1.for'
C
c Arthur: This part goes into intrface.f (but we don't need conditional.
C     IF (MHALT.EQ.0) GOTO 1111
c
      JUMPR=1
C      INCSM=20                  Arthur: Moved into loop...
C      IF (EBSN1.EQ.'+') INCSM=1       : local variable needs to be in timestep
c
c
        CALL SETCMP
        CALL INTLHT
        CALL RDLTLG
C
      IF (KHSPT.EQ.0) THEN
C      OPEN (10,FILE='$$fle10',FORM='UNFORMATTED')
C      OPEN (20,FILE='$$fle20',FORM='UNFORMATTED')
C      OPEN (30,FILE='$$fle30',FORM='UNFORMATTED')
C      WRITE(10) AIDENT
C      WRITE(20) AIDENT
C      WRITE(30) AIDENT
      ELSE
      OPEN (13,FILE='$$fle13',FORM='UNFORMATTED')
      OPEN (14,FILE='$$fle14',FORM='UNFORMATTED')
      OPEN (15,FILE='$$fle15',FORM='UNFORMATTED')
      WRITE(13) AIDENT
      WRITE(14) AIDENT
      WRITE(15) AIDENT
      ENDIF
C
C     End of compute and initall... return stuff to C.
C     CODE TO RETURN VALUES TO C CODE
C
      MMHALT = MHALT
C start of time parse in fortran
      READ(LFTIME,2020) MHR,MMIN,MDAY,CMNT,MYR
 2020 FORMAT(2X,2I2.2,1X,I2.2,1X,A3,1X,I4)
      IF(MOD(MYR,4).EQ.0) NDYMNT(2)=29
      IF(MOD(MYR,100).EQ.0) NDYMNT(2)=28
      IF(MOD(MYR,400).EQ.0) NDYMNT(2)=29
      DO MBNT=1,12
        IF(CMNT.EQ.TMNT(MBNT)) GOTO 2021
      END DO
 2021 NTMLNG=JHR-IBGNT
      MBHR=MHR-NTMLNG
      MBDY=MDAY+MBHR/24
      MBHR=MOD(MBHR,24)
      IF (MBHR.LT.0) THEN
        MBDY=MBDY-1
        MBHR=24+MBHR
      ENDIF
      IF (MBDY.LT.1) THEN
        MBNT=MBNT-1
        IF(MBNT.LT.1) THEN
          MYR=MYR-1
          MBNT=MBNT+12
        ENDIF
        MBDY=NDYMNT(MBNT)+MBDY
      ENDIF
C Arthur Added... 5/26/2005
      IF (MBDY.GT.NDYMNT(MBNT)) THEN
        MBDY=MBDY-NDYMNT(MBNT)
        MBNT=MBNT+1
        IF(MBNT.GT.12) THEN
          MYR=MYR+1
          MBNT=MBNT-12
        ENDIF
      ENDIF
C end of time parse in fortran

      IIMXB = IMXB
      JJMXB = JMXB
C The actual computation grid is jmxb-1 imxb-1
      DO J=1,JMXB
         DO I=1,IMXB
            ZZB(I,J)=ZB(I,J)
         END DO
      END DO
      DO J=1,JMXB
         DO I=1,IMXB
            YYLT(I,J)=YLT(I,J)
            YYLG(I,J)=YLG(I,J)
         END DO
      END DO
      RETURN
      END

      SUBROUTINE WIND (IU,IV,IP,DELSNM,N0,WSPEED,WDIRCT)
C     This procedure is to calculate SLOSH's wind field on a lat/lon
C     grid.  Results are returned in MPH.
C     This procedure is taken from Jye Chen's wind2.for (first 3pages).
C     Inputed by Arthur Taylor 6/9/1997
C     IU (O) MPH WIND IN U DIRECTION AT LOCATION I,J (MAX:200X200)
C     IV (O) MPH WIND IN V DIRECTION AT LOCATION I,J
C     IP (O)     PRESSURE AT LOCATION I,J
C     DELSNM (I) DELTA IN NAUTICAL MILES ON GRID (USUAL:5)
C     N0 (I) NUMBER OF GRID ELEMENTS IN 2D ARRAY (MAX:199)(USUAL:95)
C     WSPEED (I) THE STORM'S SPEED (MPH)
C     WDIRCT (I) THE STORM'S DIRECTION (0 FOR NORTH)
C     STORM CENTER IS AT CENTER OF GRID.
C     May not actually need to call force1

C     /FRST/ USED HERE TO GET ACCESS TO VELOCITY
C   ASSUMPTION: X1, X12 ARE ALREADY INITIALIZED
C     COMMON /FRST/ X1(50),X12(50)
      COMMON /STRMSB/ C1,C2,C21,C22,AX,AY,PTENCY,RTENCY
      COMMON /DUMMY4/ S(800),C(800),P(800),DELP(800)
C CANT FIND COMMON /LK0/
C     COMMON /LK0/ LAKO
C   FOLLOWING COMMONS ARE FOR INSTANTANEOUS CALLS TO FORCE1
      COMMON /WTEMP/  YDELP,ZDELP,PNN,YC24,ZC24
      COMMON /DUMY44/ SW(800),CW(800),W1218(2),WMAX(2)
      COMMON /ZLATO/  ZLATO

      COMMON /STRMPS/ X(100),Y(100),PT(100),R(100),DIR(100),SP(100)
C STIME interferes with C code, so switched to STIME2
      COMMON /STIME2/  ISTM,JHR,ITMADV,NHRAD,IBGNT,ITEND

      COMMON /BSN/    PHI,ALTO,ALNO,PHI1,ALT1,ALN1,ALT1C

      REAL X12(50)
      REAL IU(200,200),IV(200,200),IP(200,200)
      REAL DELSNM
C     CHARACTER*1 LAKO
      DATA RHOWG/29.89/,PI/3.14159265358979/
C  RAD/1.74552925E-2/
      DATA NCATG/2/

C     IF (LAKO.EQ.'Y'.OR.LAKO.EQ.'y') NCATG=1

      VMAX=WMAX(NCATG)
      CALL FORCE1(YDELP,YC24,VMAX,ZLATO,NCATG,0)
C     Get Storm Speed, Direction as variables: c21, DIRin MPH, 0 for N
      X12(7)=WSPEED
C     DIR=90.-DIRin
C     DIR=C22
      DIRECT=90.-WDIRCT
      X12(20)=COS(DIRECT*PI/180.0)
      X12(21)=SIN(DIRECT*PI/180.0)
      X12(9)=X12(7)*X12(20)
      X12(10)=X12(7)*X12(21)
      X12(23)=X12(7)*COS(DIRECT*PI/180.0+7.*PI/6.-.5*PI)
      X12(24)=X12(7)*SIN(DIRECT*PI/180.0+7.*PI/6.-.5*PI)
      X12(4)=YC24
      X12(15)=X12(4)*X12(4)
      X1218=2.*VMAX
C     SET THE INTERVAL SPACING IN NAUTICAL MILES
C     DELSNM=5.  PASSED BY CALLING PROCEDURE
      DELS=DELSNM*1.1508
C     SET THE DIMMENSION, AND THE CENTER OF THE STORM.
C     N0=95 PASSED BY CALLING PROCEDURE
      N00=(N0-1)/2

      DO 240 J=1,N0
        XP=(J-N00-1)*DELS
        DO 230 I=1,N0
          YP=(N00+1-I)*DELS
          RSQ=XP*XP+YP*YP
          RS=SQRT(RSQ)

          R1=RS+1.
          K=R1
          R2=K
C     GET THE DECIMAL PART OF RS.
          DR=R1-R2
          K=MIN0(K,790)
          CK1=C(K)+DR*(C(K+1)-C(K))
          SK1=S(K)+DR*(S(K+1)-S(K))
          CCN=X12(15)+RSQ
          CC=1./CCN
          X28=X1218
          A=RS*X12(9) -X28*(YP*CK1+XP*SK1)
          B=RS*X12(10)+X28*(XP*CK1-YP*SK1)
          IF (NCATG.EQ.1) THEN
            RHOL=ABS(XP*X12(20)+YP*X12(21))
            CCC=CCN*RHOL/(X12(15)+RHOL*RHOL)
            A=A+CCC*X12(23)
            B=B+CCC*X12(24)
          ENDIF
          A=A*X12(4)*CC
          B=B*X12(4)*CC
C CONVERT FROM MPH TO M/S
C         IU(I,J)=(A*.44704)*10.+.5
C         IV(I,J)=(B*.44704)*10.+.5

C LEAVE IN MPH
          IU(I,J)=A
          IV(I,J)=B

          PK1=DELP(K)+DR*(DELP(K+1)-DELP(K))
          IP(I,J)=120.-PK1*RHOWG*10.+.5
 230    CONTINUE
 240  CONTINUE
C RETURN VALUES TO C FOR PLOTTING.
      RETURN
      END

      SUBROUTINE WAV
      COMMON /WTEMP/  YDELP,ZDELP,PNN,YC24,ZC24
      REAL YDELP,ZDELP,PNN,YC24,ZC24
      COMMON /DUMY44/ SW(800),CW(800),W1218(2),WMAX(2)
      REAL SW,CW,W1218,WMAX
      COMMON /STRMPS/ X(100),Y(100),P(100),R(100),DIR(100),SP(100)
      REAL X,Y,P,R,DIR,SP
C STIME interferes with C code, so switched to STIME2
      COMMON /STIME2/  ISTM,JHR,ITMADV,NHRAD,IBGNT,ITEND
      INTEGER ISTM,JHR,ITMADV,NHRAD,IBGNT,ITEND
      REAL VM,RM,DP,VF,HN,TS
C UNITS: YC24 IS IN STATUTE MILES
C UNITS: YDELP IS IN MILBARS
C UNITS: VF, WMAX ARE IN MPH
CC      WRITE (*,*) 'Rmax: ',YC24, ' statute miles'
CC      WRITE (*,*) 'dP: ',YDELP, ' mb'
CC      WRITE (*,*) 'Vf: ',SP(ITMADV -1), ' mph'
CC      WRITE (*,*) 'VMax: ',WMAX(2) + 0.5*SP(ITMADV -1), ' mph'
      VM = WMAX(2) + 0.5*SP(ITMADV -1)
C     WRITE (*,*) 'Rmax: ',(YC24 / 1.15), ' nautical miles'
C     WRITE (*,*) 'dP: ',(YDELP * 0.029565), ' in'
C     WRITE (*,*) 'Vf: ',(SP(ITMADV -1) / 1.15), ' knots'
C     WRITE (*,*) 'Vmax: ',(VM / 1.15), ' knots'
      RM = YC24 / 1.15
      DP = YDELP *0.029565
      VF = SP(ITMADV -1) / 1.15
      VM = VM / 1.15
      HN = 16.5 * EXP((RM * DP)/100)
      HN=HN*(1+(0.208*VF)/(SQRT(VM)))
CC      WRITE (*,*)
CC      WRITE (*,*) 'H. = ', HN, ' ft'
      TS = 8.6 * EXP((RM * DP)/200)
      TS=TS*(1+(0.104*VF)/SQRT(VM))
CC      WRITE (*,*) 'Ts = ', TS, ' sec'
CC      WRITE (*,*)
      RETURN
      END
C UND
      SUBROUTINE TMSTEP(IITIME,MMHALT,HHB,DDELT,XXLT,XXLG,YYDELP,YYC24,
     1WSPEED,WDIRCT,FLAG,SMOOTH,FPASS,TBEGIN1,PSTEP1,ETIME1,WFILE,
     2WFILELEN,PFILE,PFILELEN,CDFFILE,cdflen,SFILE,SFILELEN,RFILE,
     3RFILELEN)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C THIS SUBROUTINE CALLS ALL THE FORTRAN SUBROUTINES WHICH ARE NEEDED TO
C DO ONE TIME STEP.
C
C ORIGINALLY THIS WAS DONE IN CMPUTE BETWEEN 100 AND 999.
C THE CODE IS THE SAME EXCEPT CUT AND PASTED HERE.
C
C THIS ALSO RETURNS TO C THE VARIOUS VARIABLES NEEDED SO THAT
C IT CAN UPDATE THE GRAPHICS.
C
C RA Dominguez 5/15/12 Added TBEGIN,WSTEP,ETIME,WFILE,PFILE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      include 'parm.for'
      REAL HHB(M_,N_)
c REAL   HHHB(M_,N_)
      INTEGER*2 FLAG,SMOOTH,FPASS
C UND      
      INTEGER :: TBEGIN1 ,PSTEP1
      INTEGER :: WFILELEN,PFILELEN,cdflen,SFILELEN
      INTEGER :: RFILELEN
      REAL*8 :: ETIME1 
      INTEGER     :: PCNT      
      BYTE      :: WFILE(100),PFILE(100),CDFFILE(100),SFILE(100)
      BYTE      :: RFILE(100)      
      COMMON /GPRT2/  EBSN1,EBSN2
      CHARACTER*1  EBSN1,EBSN2
      COMMON /FFTH/   ITIME, MHALT
      COMMON /FLWCPT/ NSQRS,NSQRW,NSQRWC,NPSS,NCUT
      COMMON /OPTS/   NOFLD,NOF1D
      CHARACTER*1     NOFLD,NOF1D
      COMMON /PRHSY/  IPRHR,JUMPR,IPRT
      COMMON /PRTSV/  IPRTSV,IPRTAD
C STIME interferes with C code, so switched to STIME2
      COMMON /STIME2/  ISTM,JHR,ITMADV,NHRAD,IBGNT,ITEND
      COMMON /DELTH/  NDLTHR,NDLTH2,DLTHR,DLTH2
      COMMON /CESAV/  IPN(120),IPL(120),KHSPT
      COMMON /GPRT1/  DOLLAR,EBSN
      CHARACTER*1 EBSN
      CHARACTER*2 DOLLAR
      COMMON /EGTH/   DELS,DELT,G,COR
      COMMON /WTEMP/  YDELP,ZDELP,PNN,YC24,ZC24
      COMMON /STRMSB/ C1,C2,C21,C22,AX,AY,PTENCY,RTENCY
      COMMON /POLAR/  DEGREE,RMOUTH,AZMTH,DELA
      COMMON /DUMB3/  IMXB,JMXB,IMXB1,JMXB1,IMXB2,JMXB2
      INTEGER I, J, K
      REAL    RI, RJ, RK

C UND
      TBEGIN = TBEGIN1
      PSTEP = PSTEP1
      ETIME = INT(ETIME1)
      write(NCFILE,'(100a)') (cdffile(i),i=1,cdflen)
      write(WNFILE,'(100a)') (wfile(i),i=1,wfilelen)
      write(PRFILE,'(100a)') (pfile(i),i=1,pfilelen)
      write(STFILE,'(100a)') (sfile(i),i=1,sfilelen)
      write(WVFILE,'(100a)') (rfile(i),i=1,rfilelen)
C UND - Load Structured NetCDF Met Forcing      
      K = ichar(WNFILE(1:1))
      if ((K.NE.0).AND.(K.NE.32)) then
        CALL NETWIND
      endif
      K = ichar(PRFILE(1:1))
      if ((K.NE.0).AND.(K.NE.32)) then
        CALL NETPRESSURE
      endif
      K = ichar(STFILE(1:1))
      if ((K.NE.0).AND.(K.NE.32)) then
        CALL NETSTRESS
      endif      
      K = ichar(WVFILE(1:1))
      if ((K.NE.0).AND.(K.NE.32)) then
        CALL NETWAVES
      endif


C CODE TO IMPLEMENT ONE TIME STEP..
  100 INCSM=20
      IF (EBSN1.EQ.'+') INCSM=1
      CALL TTIMER
      xtime=itime
c
c  continuity
c
      CALL CONTTY
c
C       NO CORNER SMOOTHING for PNB BASIN
c

      IF (EBSN1.EQ.'&'.or.EBSN1.EQ.'+') GOTO 113
      IF (ITIME.GT.5.AND.INCSM.NE.1)  CALL SMPT2G
 113  CONTINUE
c
c
c
      CALL BDRYHT
      IF (NPSS.NE.0) CALL CHANNL
      IF (NSQRWC.NE.0.and.nof1d.ne.'+') CALL FLW1DM
      CALL HMXSV
C Create C-COPY OF HB TO HHB.. DO THIS RIGHT AFTER HMXSV
C HMXSV is where the envelope calculations are done, so
C we want them as close together as possible.
      IF(FPASS.EQ.1) THEN
        DO J=1,JMXB
          DO I=1,IMXB
C This is so that HHB is never greater than HMX
            IF (HMX(I,J).LT.HB(I,J)) THEN
              HHB(I,J)=HMX(I,J)
            ELSE
              HHB(I,J)=HB(I,J)
            ENDIF
          END DO
        END DO
      ENDIF
C
      IPRHR=3
      IF (ITIME.NE.IPRTSV) GO TO 180
      IF(ITIME.EQ.NHRAD) IPRHR=1
      IF(ITIME.EQ.NHRAD-NDLTHR/2) IPRHR=2
      IPRTSV=IPRTSV+IPRTAD
      IF (KHSPT.EQ.0) THEN
       CALL HISTRY
       ELSE
       IF (IPRHR.NE.3) CALL HSTRY2
       ENDIF
c
c
c    include 'cmpgr3.for'
c
  180 CONTINUE
C
C       IF (KEY1.EQ.0) GOTO 1112
C
c      IF(ITIME+1.EQ.NHRAD.or.EBSN1.EQ.'+') THEN
      IF(mod(ITIME+1,INCSM).EQ.0.or.EBSN1.EQ.'+') THEN
       IF (DOLLAR.EQ.'$') THEN
      CALL FLTER2
      ELSE
      CALL FILTER
      ENDIF
      ENDIF
c
c  momentum equation
c
      CALL MOMNTM
C
      CALL STMVAL
c
C GRAPHICS
C
c    include 'cmpgr2.for'
C
C END OF COMPUTE FOR ONE TIME STEP

C UND - SAVE Current Timestep to NETCDF      
      RI = mod((ETIME-DELT),PSTEP*60)      
      RJ = mod(ETIME,PSTEP*60)
      RK = mod((ETIME+DELT),PSTEP*60)
      if (((RI.GT.RJ).and.(RJ.lt.RK)).OR.(ETIME.eq.0)) then
       PCNT = (ETIME+RJ)/PSTEP/60+1
        J = ichar(NCFILE(1:1))
        IF ((J.NE.0).AND.(J.NE.32)) THEN
          CALL NetCDFWrite(PCNT)
          write(*,*) "Saved", ITIME, "of", MHALT
        ENDIF
      endif
C UND - Clear Global Variables
      do I=1,IMXB
        do J=1,JMXB
          GPXX(I,J)=0.d0
          GPYY(I,J)=0.d0
          GFXX(I,J)=0.d0
          GFYY(I,J)=0.d0
          GWXX(I,J)=0.d0
          GWYY(I,J)=0.d0
          GFPY(I,J)=0.d0
          GFPX(I,J)=0.d0      
          GFWY(I,J)=0.d0
          GFWX(I,J)=0.d0            
        enddo
      enddo


C ARTHUR: PROCEDURE FOR CS.
C NOTE: ITMADV HAS BEEN ADVANCED FOR NEXT HOUR IN CALL TO STMVAL
      IF (FLAG.EQ.1) THEN
        CALL WAV
      ENDIF

C END CODE FOR ONE TIME STEP

C CODE TO RETURN TO C-CODE THE REST OF THE VALUES IT NEEDS.
      IITIME = ITIME
      MMHALT = MHALT
      DDELT = DELT
      YYDELP = YDELP
      YYC24 = YC24
      XA=(C1+AX)/5280.
      YA=(C2+AY)/5280.
      CALL XY2LLX(XA,YA,XXLT,XXLG)
      WSPEED=C21
C Direction is 0 for north. (I think this is meteorological direction)
C WDIRCT is returned in degrees.
      WDIRCT=(AZMTH-(C22)*180./3.14159265358979)
      RETURN
      END


      SUBROUTINE CLNUP (HHB, iENV)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C THIS SUBROUTINE CALLS THE FORTRAN SUBROUTINES NEEDED TO SAVE THE
C MAX ENVELOP, AND TO CLEAN UP EXECUTION OF THE CODE.
C
C ORIGINALLY THIS WAS DONE AT THE END OF CMPUTE (AFTER 999) AND AT THE
C END OF PROGRAM MAIN.
C THE CODE IS THE SAME EXCEPT CUT AND PASTED HERE.
C
C THIS ALSO RETURNS TO C THE VARIOUS VARIABLES NEEDED SO THAT
C IT CAN DISPLAY THE MAX ENVELOP.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      include "parm.for"
      REAL HHB(M_,N_)
      COMMON /FFTH/   ITIME, MHALT
      COMMON /KEYS/ KEY1
      COMMON /FLES/ FLE5,FLE9,FLE8,FLE91,FLE99,FLE10,FLE20,FLE30,FLE1
      CHARACTER*256 FLE5,FLE9,FLE8,FLE91,FLE99,FLE10,FLE20,FLE30,FLE1
      COMMON /DUMB3/  IMXB,JMXB,IMXB1,JMXB1,IMXB2,JMXB2

C FINISHING UP THE CMPUTE CODE
CC      write (*,*)'   finished at time step=',itime
CC      write (*,*)'   mhalt=' ,mhalt
c      CALL FILTRP
      CALL FHMXSV
      if (ienv.eq.1) CALL ARCHIV

C
C      GOTO 1112
C 1111 call rdhmx
C 1112 CONTINUE
c
c   include 'cmpgr4.for'
C
C    FINISHING UP WHAT WAS LEFT IN MAIN PROGRAM
      IF (KEY1.EQ.0) GOTO 1000
C
CC       WRITE(*,*)'   FINISHED SAVING SURGE ENVELOP (FT*10) TO DISK.'
CC       WRITE(*,'(A)') '  FILE NAME = '
CC       WRITE(*,'(A)')  FLE91
CC       WRITE(*,*)'   TIME-HISTRIES data ARE SAVED ON'
CC       WRITE(*,'(A)') FLE10
CC       WRITE(*,'(A)') FLE20
CC       WRITE(*,'(A)')  FLE30
CC       WRITE(*,*) ' RESPECTIVELY FOR SURGE, WIND SPEED, AND WIND DIR.'
CC       WRITE(*,*) '  IN FEET, MPH, METEOR. DIRECTION (DEG.)'
C
 1000 CONTINUE
c
c       CALL PLOTS1
C
C      CALL GETDAT(MYR,MMON,MDAY)
C      CALL GETTIM(MHR,MMIN,MSEC,MI100)
C
C      WRITE(*,100) MMON,MDAY,MYR,MHR,MMIN,MSEC,MI100
C 100  FORMAT(1H0,'         CALCULATIONS ENDED AT DAY - TIME ',
C    1   2(I2.2,':'),I4.4,'--',2(I2.2,':'),I2.2,'.',I2.2//)

C CODE TO RETURN VALUES TO C-CODE.
      DO J=1,JMXB
         DO I=1,IMXB
            HHB(I,J)=HMX(I,J)
         END DO
      END DO
      RETURN
      END

      SUBROUTINE LLX2PQ(XLTL,YLNL,INP,INQ)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      COMMON /BSN/    PHI,ALTO,ALNO,PHI1,ALT1,ALN1,ALT1C
      REAL PHI,ALTO,ALNO,PHI1,ALT1,ALN1,ALT1C
      COMMON /POLAR/  DEGREE,RMOUTH,AZMTH,DELA
      REAL DEGREE,RMOUTH,AZMTH,DELA
      COMMON /ELLIP/  AAXIS,BAXIS,ABQAB
      REAL AAXIS,BAXIS,ABQAB
      COMMON /INDX/   IRB,IRE,NDB,NDE
      INTEGER IRB,IRE,NDB,NDE
      COMMON /ORIGN/  XMOUTH,YMOUTH
      REAL XMOUTH,YMOUTH

C PASSED PASSED PARAMETERS
      REAL XLTL,YLNL
      INTEGER INP,INQ

C LOCAL VARIABLES
      COMPLEX *8 ZETA,ZXY,Z2,PQ
      REAL SLTO,CLTO,ERAD,FTPNM,ERAD2,CO2
      REAL ALTII,ALNII,DLAT,DLAT2,DLON,DLON2
      REAL S2,S,RLNGTH,AN,AD,ANG,XINXY,YINXY
      REAL PINPQ,QINPQ
      DATA ERAD/3437.87/,FTPNM/6080.21/

C THIS IS THE DECLARATION OF AN IMPLICIT FUNCTION ZETA.
      ZETA(ZXY)=CSQRT(ZXY*ZXY-4.*ABQAB)

C        SET LAT/LONG AND SLANT IN RADIANS; COMPLEMENT LAT BY 90 DEG
      YLNL=-YLNL
      SLTO=SIN(ALT1C)
      CLTO=COS(ALT1C)
      ERAD2=2.*ERAD
      CO2=2.*CLTO

C  TRANSFORM LAT-LONG INTO X-Y
      ALTII=1.74532925E-2*(90.-XLTL)
      ALNII=1.74532925E-2*YLNL
      DLAT=ALT1C-ALTII
      DLAT2=.5*DLAT
      DLON=ALN1-ALNII
      DLON2=.5*DLON
      S2=SIN(DLON2)**2
      S=SIN(DLAT2)**2+SLTO*SIN(ALTII)*S2
      RLNGTH=ERAD2*SQRT(S/(1.-S))
      AN=SIN( ALTII)*SIN(DLON)
      AD=SIN(DLAT)+CO2*SIN(ALTII)*S2
      IF (AN**2+AD**2.LT.1.E-10) THEN
        ANG=3.14159265358979-PHI1
      ELSE
        ANG=3.14159265358979+ATAN2(-AN,-AD)-PHI1
      ENDIF
      XINXY=(RLNGTH*SIN(ANG))*FTPNM/5280.+XMOUTH
      YINXY=(RLNGTH*COS(ANG))*FTPNM/5280.+YMOUTH

C  TRANSFORM X-Y TO P-Q
      ZXY=CMPLX(XINXY,YINXY)/RMOUTH
      IF (ABQAB.NE.0.) THEN
        Z2 =ZETA(ZXY)
        IF (ABQAB.GT.0.) THEN
          IF (XINXY.LT.0.D00) Z2=-Z2
        ENDIF
        ZXY=.5*(ZXY+Z2)
      ENDIF
      PQ=CLOG(ZXY)
      PINPQ=REAL(PQ)/DELA+IRB+1.
      QINPQ=MOD(AIMAG(PQ)+NDB*DELA,2*3.14159265358979)/DELA+1.
      INP=PINPQ
      INQ=QINPQ
      RETURN
      END

      SUBROUTINE XY2LLX(XA,YA,XLT,XLG)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      COMMON /BSN/    PHI,ALTO,ALNO,PHI1,ALT1,ALN1,ALT1C
      REAL PHI,ALTO,ALNO,PHI1,ALT1,ALN1,ALT1C
      COMMON /ORIGN/  XMOUTH,YMOUTH
      REAL XMOUTH,YMOUTH

C PASSED PARAMETERS
      REAL XA,YA,XLT,XLG

C LOCAL VARIABLES
      REAL CLTO,SLTO,XCORD,YCORD,RLL,ENU,PSI,SPSI,CPSI,CNU
      REAL DLAT,DLONG

      CLTO=COS(ALT1C)
      SLTO=SIN(ALT1C)
      XCORD=(XA-XMOUTH)*5280./6080.21
      YCORD=(YA-YMOUTH)*5280./6080.21
      RLL=SQRT(XCORD**2+YCORD**2)
      IF (RLL.LT.1.E-5) THEN
        ENU=PHI1
      ELSE
        ENU=ATAN2(XCORD,YCORD)+PHI1
      ENDIF
      PSI=2.*ATAN(.5*RLL/3437.87)
      SPSI=SIN(PSI)
      CPSI=COS(PSI)
      CNU=COS(ENU)
      DLAT=ACOS(CLTO*CPSI+SPSI*SLTO*CNU)
      DLONG=ALN1-ATAN2(SPSI*SIN(ENU),CPSI*SLTO-SPSI*CNU*CLTO)
      XLT=90.-DLAT/1.74532925E-2
      XLG=DLONG/1.74532925E-2
      return
      end
