SUBROUTINE RVELPLTH  
C  
C CHANGE RECORD  
C **  SUBROUTINE RVELPLTH WRITES HORIZONTAL EULERIAN RESIDUAL, VECTOR  
C **  POTENTIAL AND MEAN MASS TRANSPORT VELOCITY VECTOR FILES  
C  
C *** PMC  THIS ROUTINE USES HMP, THE STATIC IC DEPTH.  SHOULDN'T IT USE HP?

      USE GLOBAL  
      DIMENSION DBS(10)  
      CHARACTER*80 TITLE1,TITLE2,TITLE3  
      IF(JSRVPH.NE.1) GOTO 300  
C  
C **  WRITE HEADINGS  
C  
      TITLE1='HORIZ EULERIAN MEAN TRANSPORT VELOCITY'  
      TITLE2='HORIZ VECTOR POTENTIAL TRANSPORT VELOCITY'  
      TITLE3='HORIZ MEAN MASS TRANSPORT VELOCITY'  
      IF(ISRVPH.EQ.1) LINES=LA-1  
      IF(ISRVPH.EQ.2) LINES=NRC  
      IF(ISRVPH.EQ.3) LINES=NBC  
      LEVELS=2  
      DBS(1)=0.  
      DBS(2)=99.  
      OPEN(11,FILE='RVELVCH.OUT',STATUS='UNKNOWN')  
      OPEN(12,FILE='PVELVCH.OUT',STATUS='UNKNOWN')  
      OPEN(13,FILE='MVELVCH.OUT',STATUS='UNKNOWN')  
      CLOSE(11,STATUS='DELETE')  
      CLOSE(12,STATUS='DELETE')  
      CLOSE(13,STATUS='DELETE')  
      OPEN(11,FILE='RVELVCH.OUT',STATUS='UNKNOWN')  
      OPEN(12,FILE='PVELVCH.OUT',STATUS='UNKNOWN')  
      OPEN(13,FILE='MVELVCH.OUT',STATUS='UNKNOWN')  
      WRITE (11,99) TITLE1  
      WRITE (11,101)LINES,LEVELS  
      WRITE (11,250)(DBS(L),L=1,LEVELS)  
      WRITE (12,99) TITLE2  
      WRITE (12,101)LINES,LEVELS  
      WRITE (12,250)(DBS(L),L=1,LEVELS)  
      WRITE (13,99) TITLE3  
      WRITE (13,101)LINES,LEVELS  
      WRITE (13,250)(DBS(L),L=1,LEVELS)  
      CLOSE(11)  
      CLOSE(12)  
      CLOSE(13)  
      JSRVPH=0  
  300 CONTINUE  
      IF(ISDYNSTP.EQ.0)THEN  
        TIME=DT*FLOAT(N)+TCON*TBEGIN  
        TIME=TIME/TCON  
      ELSE  
        TIME=TIMESEC/TCON  
      ENDIF  
      OPEN(11,FILE='RVELVCH.OUT',POSITION='APPEND',STATUS='UNKNOWN')  
      OPEN(12,FILE='PVELVCH.OUT',POSITION='APPEND',STATUS='UNKNOWN')  
      OPEN(13,FILE='MVELVCH.OUT',POSITION='APPEND',STATUS='UNKNOWN')  
      WRITE (11,100)N,TIME  
      WRITE (12,100)N,TIME  
      WRITE (13,100)N,TIME  
      IF(ISRVPH.EQ.1)THEN  
        DO L=2,LA  
          LN=LNC(L)  
          UTMP=50.*STCUV(L)*(UHLPF(L+1,KC)+UHLPF(L,KC))/HMP(L)  
          VTMP=50.*STCUV(L)*(VHLPF(LN,KC)+VHLPF(L,KC))/HMP(L)  
          RVELEKC=CUE(L)*UTMP+CVE(L)*VTMP  
          RVELNKC=CUN(L)*UTMP+CVN(L)*VTMP  
          UTMP=50.*STCUV(L)*(UHLPF(L+1,1)+UHLPF(L,1))/HMP(L)  
          VTMP=50.*STCUV(L)*(VHLPF(LN,1)+VHLPF(L,1))/HMP(L)  
          RVELEKB=CUE(L)*UTMP+CVE(L)*VTMP  
          RVELNKB=CUN(L)*UTMP+CVN(L)*VTMP  
          WRITE(11,200)IL(L),JL(L),DLON(L),DLAT(L),RVELEKC,RVELNKC,  
     &        RVELEKB,RVELNKB  
          UTMP=50.*STCUV(L)*(UVPT(L+1,KC)+UVPT(L,KC))/HMP(L)  
          VTMP=50.*STCUV(L)*(VVPT(LN,KC)+VVPT(L,KC))/HMP(L)  
          PVELEKC=CUE(L)*UTMP+CVE(L)*VTMP  
          PVELNKC=CUN(L)*UTMP+CVN(L)*VTMP  
          UTMP=50.*STCUV(L)*(UVPT(L+1,1)+UVPT(L,1))/HMP(L)  
          VTMP=50.*STCUV(L)*(VVPT(LN,1)+VVPT(L,1))/HMP(L)  
          PVELEKB=CUE(L)*UTMP+CVE(L)*VTMP  
          PVELNKB=CUN(L)*UTMP+CVN(L)*VTMP  
          WRITE(12,200)IL(L),JL(L),DLON(L),DLAT(L),PVELEKC,PVELNKC,  
     &        PVELEKB,PVELNKB  
          PVELEKC=PVELEKC+RVELEKC  
          PVELNKC=PVELNKC+RVELNKC  
          PVELEKB=PVELEKB+RVELEKB  
          PVELNKB=PVELNKB+RVELNKB  
          WRITE(13,200)IL(L),JL(L),DLON(L),DLAT(L),PVELEKC,PVELNKC,  
     &        PVELEKB,PVELNKB  
        ENDDO  
      ENDIF  
      CLOSE(11)  
      CLOSE(12)  
      CLOSE(13)  
   99 FORMAT(A80)  
  100 FORMAT(I10,F12.4)  
  101 FORMAT(2I10)  
  200 FORMAT(2I5,1X,6E14.6)  
  250 FORMAT(12E12.4)  
      RETURN  
      END