C file OCNHD.FOR
C ----------------------------------------------------------------------!-------
!  9 Mar 2012 - Changed formula for NTYP in terms of RAY and what is printed
! 15 Mar 2011 - Increased number of decimal points for printing frequency
C  1 May 2009 - replaced REAL*8 with DOUBLE PRECISION
C 13 Mar 2008 - Corrected length in common block /PCONST/
C 13 Mar 2008 - Corrected length in common block /MM/
C 12 Mar 2008 - Corrected length in block /GV/
C 26 Jul 2006 - correction
C 16 Mar 2006 - Added kzb to /RIN/
C 16 Mar 2006 - Changed kz2 to kz2a
C 14 Mar 2006 - Added kz2 to /RIN/
C 21 Feb 2006 - Added more printing of models
C 21 Feb 2006 - Fixed some errors
C 17 Feb 2006 - Correction
C  3 Feb 2006 - Added printing of gravity and density models to raysets
C  2 Feb 2006 - Added printing of gravity and density models
C  2 Feb 2006 - Added common decks GV and DS
C  2 Feb 2006 - Added common decks B13, B14, B15, and B16
C  5 June 2004.  Added printing of MODT, MODM, and MODP, and IDSV
C  5 June 2004.  Separated SUBROUTINE OCNHD into its own file.
C  2 June 2004.  Added printing of pressure and molecular weight to 
C                ENTRY HEADER1 in SUBROUTINE OCNHD
C 6 May 2003. Added 3 lines at line 58 in ENTRY HEADER1.
C ----------------------------------------------------------------------!-------
      SUBROUTINE OCNHD
C ----------------------------------------------------------------------!-------
C     PRINTS PAGE HEADINGS FOR RAY TRACING IN THE OCEAN 
C     IF W(72) IS NEGATIVE, ONLY ONE HEADER OUTPUT INCLUDED IN RAYSET
 
      implicit double precision (a-h,o-z)
 
      CHARACTER pcc*(*),pc*1,BLANKS*100,DIVIDR*132,banner(10)*80
      CHARACTER NUMSTG*80,STMP*80,typ*20,id*80,strg5*200
      LOGICAL NOPUNCH
      INTEGER STRIM
C
C     TWO ENTRY POINTS ARE PROVIDED. ONE FOR THE FIRST PAGE HEADER
C     OF THE COMPUTATIONAL PRINTOUT AND FOR THE RAYSET FILE. THE
C     SECOND ENTRY IS FOR ALL SUBSEQUENT PAGES OF THE COMPUTATIONAL
C     PRINTOUT.
C
C     COMMON DECK "LL" INSERTED HERE
      DOUBLE PRECISION MODL
      COMMON/LL/MODL(4),APH,APHPT,APHPR,APHPTH,APHPPH
      common/ident/id
C
C
C
C
C
C
C
C
C     COMMON DECK "PP" INSERTED HERE
      DOUBLE PRECISION MODP
      COMMON/PP/MODP(4),P,PPT,PPR,PPTH,PPPH
C
C     COMMON DECK "SS" INSERTED HERE
      DOUBLE PRECISION MODSURF
      COMMON/SS/ MODSURF(4)
      COMMON/SS/U,PUR,PURR,PURTH,PURPH
      COMMON/SS/PUTH,PUPH,PUTHTH,PUPHPH,PUTHPH,USELECT,UTIME

C     COMMON DECK "CONST" INSERTED HERE
      COMMON/PCONST/CREF,RGAS,GAMMA
     1 ,MO2,MN2,MO,MN,MH2O,MO3                        ! 9 Mar 2007 ! 13 Mar 2008
      DOUBLE PRECISION MO2,MN2,MO,MN,MH2O,MO3                      ! 13 Mar 2008
      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10
C
C
      COMMON/WW/DUM(10),MAXW,W(1000)
      DOUBLE PRECISION MAXSTP,MAXERR,INTYP,LLAT,LLON
      EQUIVALENCE (EARTHR,W(1)),(RAY,W(2)),(XMTRH,W(3)),(TLAT,W(4)),
     1 (TLON,W(5)),(OW,W(6)),(FBEG,W(7)),(FEND,W(8)),(FSTEP,W(9)),
     2 (AZ1,W(10)),(AZBEG,W(11)),(AZEND,W(12)),(AZSTEP,W(13)),
     3 (BETA,W(14)),(ELBEG,W(15)),(ELEND,W(16)),(ELSTEP,W(17)),
     8   (RUNSUP,W(18)),(RCVRH,W(20)),
     4 (ONLY,W(21)),(HOP,W(22)),(MAXSTP,W(23)),(PLAT,W(24)),(PLON,W(25))
     5,(HMAX,W(26)),(RAYFNC,W(29)),(EXTINC,W(33)),
     6 (HMIN,W(27)),(RGMAX,W(28)),
     8 (INTYP,W(41)),(MAXERR,W(42)),(ERATIO,W(43)),
     6 (STEP1,W(44)),(STPMAX,W(45)),(STPMIN,W(46)),(FACTR,W(47)),
     7 (SKIP,W(71)),(RAYSET,W(72)),(PRTSRP,W(74)),(HITLET,W(75))
     9 ,(BINRAY,W(76)),(PAGLN,W(77)),(PLT,W(81)),(PFACTR,W(82)),
     1 (LLAT,W(83)),(LLON,W(84)),(RLAT,W(85)),(RLON,W(86))
     2,(TIC,W(87)),(HB,W(88)),(HT,W(89)),(TICV,W(96))

C     COMMON DECK "GG" INSERTED HERE
      DOUBLE PRECISION MODG
      COMMON/GG/MODG(4)
      COMMON/GG/G,PGR,PGRR,PGRTH,PGRPH
      COMMON/GG/PGTH,PGPH,PGTHTH,PGPHPH,PGTHPH,GSELECT,GTIME

C     COMMON DECK "RR" INSERTED HERE
      DOUBLE PRECISION MODREC
      COMMON/RR/ MODREC(4)
      COMMON/RR/F,PFR,PFRR,PFRTH,PFRPH
      COMMON/RR/PFTH,PFPH,PFTHTH,PFPHPH,PFTHPH,FSELECT,FTIME

C     COMMON DECK "B9" INSERTED HERE
      INTEGER GMX,GNTBL,GITBL,GFRMTBL,IDSG(20)
      COMMON/B9/GMX,GNTBL(10),GITBL(10),GFRMTBL(10),GGP(113)
      EQUIVALENCE (GGP,IDSG),(ANG,GGP(11))

C     COMMON DECK "B2" INSERTED HERE
      INTEGER DUMX,DUNTBL,DUITBL,DUFRMTB,IDSDU(20)
      COMMON/B2/DUMX,DUNTBL(10),DUITBL(10),DUFRMTB(10),DUGP(10)
      EQUIVALENCE (DUGP,IDSDU)

C     COMMON DECK "B4" INSERTED HERE
      INTEGER DCMX,DCNTBL,DCITBL,DCFRMTB,IDSDC(20)
      COMMON/B4/DCMX,DCNTBL(10),DCITBL(10),DCFRMTB(10),DCGP(10)
      EQUIVALENCE (DCGP,IDSDC)

C     COMMON DECK "B6" INSERTED HERE
      INTEGER DTMX,DTNTBL,DTITBL,DTFRMTB,IDSDT(20)
      COMMON/B6/DTMX,DTNTBL(10),DTITBL(10),DTFRMTB(10),DTGP(10)
      EQUIVALENCE (DTGP,IDSDT)

C     COMMON DECK "B1" INSERTED HERE
      INTEGER UMX,UNTBL,UITBL,UFRMTBL,IDSU(20)
      COMMON/B1/UMX,UNTBL(10),UITBL(10),UFRMTBL(10),UGP(10)
      EQUIVALENCE (UGP,IDSU)

C     COMMON DECK "B3" INSERTED HERE
      INTEGER CMX,CNTBL,CITBL,CFRMTBL,IDSC(20)
      COMMON/B3/CMX,CNTBL(10),CITBL(10),CFRMTBL(10),CGP(512)
      EQUIVALENCE (CGP,IDSC),(ANC,CGP(11))

C     COMMON DECK "B5" INSERTED HERE
      INTEGER TMX,TNTBL,TITBL,TFRMTBL,IDST(20)
      COMMON/B5/TMX,TNTBL(10),TITBL(10),TFRMTBL(10),TGP(262)
      EQUIVALENCE (TGP,IDST),(ANT,TGP(11))

C     COMMON DECK "B7" INSERTED HERE
      INTEGER MMX,MNTBL,MITBL,MFRMTBL,IDSM(20)
      DOUBLE PRECISION MGP
      COMMON/B7/MMX,MNTBL(10),MITBL(10),MFRMTBL(10),MGP(10)
      EQUIVALENCE (MGP,IDSM)

C     COMMON DECK "HDR" INSERTED HERE
      CHARACTER INITID*80,DAT*10,TOD*10
      COMMON/HDR/SEC,stsec                               !Rev 7/13/90
      COMMON/HDRC/INITID,DAT,TOD

C     COMMON DECK "RINPLEX" INSERTED HERE
      DOUBLE PRECISION KAY2,KAY2I
     & , kz2a,kz2ai,kzb,kzbi               ! 16 Mar 2006
      COMPLEX*16 PNP,POLAR,LPOLAR
      LOGICAL SPACE
      CHARACTER DISPM*6,modrin*64
      COMMON/RINPL/DISPM
      COMMON /RIN/ MODRIN,RAYNAME(2,3),TYPE(3),SPACE
      COMMON/RIN/OMEGMIN,OMEGMAX,KAY2,KAY2I
     & , kz2a,kz2ai,kzb,kzbi       ! 16 Mar 2006
      COMMON/RIN/PNP(10),POLAR,LPOLAR,SGN

C     COMMON DECK "CC" INSERTED HERE
      DOUBLE PRECISION MODC
      COMMON/CC/MODC(4),CS,PCST,PCSR,PCSTH,PCSPH
C     COMMON DECK "MM" INSERTED HERE
      DOUBLE PRECISION M,MODM
      COMMON/MM/MODM(4),M,PMT,PMR,PMTH,PMPH
     1 ,XO2,XN2,XO,XN,XH2O,XO3                        ! 5 Mar 2007 ! 13 Mar 2008

C     COMMON DECK "FLAG" INSERTED HERE
      LOGICAL NEWWR,NEWWP,NEWTRC,PENET
      COMMON /FLG/ NTYP,NEWWR,NEWWP,NEWTRC,PENET,LINES,IHOP,HPUNCH
      COMMON/FLGP/NSET

C     COMMON DECK "TT" INSERTED HERE
      DOUBLE PRECISION MODT
      COMMON/TT/MODT(4), T,PTT,PTR,PTTH,PTPH

C     COMMON DECK "UU" INSERTED HERE
      DOUBLE PRECISION MODU
      COMMON/UU/MODU(4)
     1  ,V  ,PVT  ,PVR  ,PVTH  ,PVPH
     2  ,VR ,PVRT ,PVRR ,PVRTH ,PVRPH
     3  ,VTH,PVTHT,PVTHR,PVTHTH,PVTHPH
     4  ,VPH,PVPHT,PVPHR,PVPHTH,PVPHPH
C
C     COMMON DECK "GV" INSERTED HERE                               !  2 Feb 2006   
      DOUBLE PRECISION MODGV                                       !  2 Feb 2006
      COMMON/GV/MODGV(4), GV,PGVT,PGVR,PGVTH,PGVPH,STUFF(15)       ! 12 Mar 2008

C     COMMON DECK "DS" INSERTED HERE                               !  2 Feb 2006   
      DOUBLE PRECISION MODDS                                       !  2 Feb 2006
      COMMON/DS/MODDS(4), DS,PDST,PDSR,PDSTH,PDSPH                 !  2 Feb 2006

C     COMMON DECK "B10" INSERTED HERE
      INTEGER DGMX,DGNTBL,DGITBL,DGFRMTB,IDSDG(20)
      COMMON/B10/DGMX,DGNTBL(10),DGITBL(10),DGFRMTB(10),DGGP(10)
      EQUIVALENCE (DGGP,IDSDG)

C     COMMON DECK "B8" INSERTED HERE
      INTEGER RMX,RNTBL,RITBL,RFRMTBL,IDSR(20)
      COMMON/B8/RMX,RNTBL(10),RITBL(10),RFRMTBL(10),RGP(10)
      EQUIVALENCE (RGP,IDSR)

C     COMMON DECK "CB11" INSERTED HERE
      INTEGER SMX,SNTBL,SITBL,SFRMTBL,IDSS(20)
      COMMON/B11/SMX,SNTBL(10),SITBL(10),SFRMTBL(10),SGP(11)
      EQUIVALENCE (SGP,IDSS),(ANS,SGP(11))

C     COMMON DECK "CB12" INSERTED HERE
      INTEGER DSMX,DSNTBL,DSITBL,DSFRMTB,IDSDS(20)
      COMMON/B12/DSMX,DSNTBL(10),DSITBL(10),DSFRMTB(10),DSGP(11)
      EQUIVALENCE (DSGP,IDSDS),(ANDS,DSGP(11))

C     COMMON DECK "CB13" INSERTED HERE                           ! 2 Feb 2006
      INTEGER AMX,ANTBL,AITBL,AFRMTBL,IDSA(20)                   ! 2 Feb 2006
      COMMON/B13/AMX,ANTBL(10),AITBL(10),AFRMTBL(10),AGP(11)     ! 2 Feb 2006
      EQUIVALENCE (AGP,IDSA),(ANA,AGP(11))                       ! 2 Feb 2006

C     COMMON DECK "CB14" INSERTED HERE                           ! 2 Feb 2006
      INTEGER DAMX,DANTBL,DAITBL,DAFRMTB,IDSDA(20)               ! 2 Feb 2006
      COMMON/B14/DAMX,DANTBL(10),DAITBL(10),DAFRMTB(10),DAGP(11) ! 2 Feb 2006
      EQUIVALENCE (DAGP,IDSDA),(ANDA,DAGP(11))                   ! 2 Feb 2006

C     COMMON DECK "CB15" INSERTED HERE                           ! 2 Feb 2006
      INTEGER DMX,DNTBL,DITBL,DFRMTBL,IDSD(20)                   ! 2 Feb 2006
      COMMON/B15/DMX,DNTBL(10),DITBL(10),DFRMTBL(10),DGP(11)     ! 2 Feb 2006
      EQUIVALENCE (DGP,IDSD),(AND,DGP(11))                       ! 2 Feb 2006

C     COMMON DECK "CB16" INSERTED HERE                           ! 2 Feb 2006
      INTEGER DDMX,DDNTBL,DDITBL,DDFRMTB,IDSDD(20)               ! 2 Feb 2006
      COMMON/B16/DDMX,DDNTBL(10),DDITBL(10),DDFRMTB(10),DDGP(11) ! 2 Feb 2006
      EQUIVALENCE (DDGP,IDSDD),(ANDD,DDGP(11))                   ! 2 Feb 2006

C     COMMON DECK "CB17" INSERTED HERE
      INTEGER VMX,VNTBL,VITBL,VFRMTBL,IDSV(20)
      COMMON/B17/VMX,VNTBL(10),VITBL(10),VFRMTBL(10),VGP(53)
      EQUIVALENCE (VGP,IDSV),(ANV,VGP(11))

C     COMMON DECK "CB18" INSERTED HERE
      INTEGER DVMX,DVNTBL,DVITBL,DVFRMTB,IDSDV(20)
      COMMON/B18/DVMX,DVNTBL(10),DVITBL(10),DVFRMTB(10),DVGP(11)
      EQUIVALENCE (DVGP,IDSDV),(ANDV,DVGP(11))

C     COMMON DECK "CB19" INSERTED HERE
      INTEGER PRMX,PRNTBL,PRITBL,PRFRMTB,IDSPR(20)
      COMMON/B19/PRMX,PRNTBL(10),PRITBL(10),PRFRMTB(10),PRGP(11)
      EQUIVALENCE (PRGP,IDSPR),(ANP,PRGP(11))

C     COMMON DECK "CB20" INSERTED HERE
      INTEGER DPMX,DPNTBL,DPITBL,DPFRMTB,IDSDP(20)
      COMMON/B20/DPMX,DPNTBL(10),DPITBL(10),DPFRMTB(10),DPGP(11)
      EQUIVALENCE (DPGP,IDSDP),(ANDP,DPGP(11))
C
      PARAMETER (nbnrls=10,nblns=10)
C
      DATA BLANKS/' '/
      DATA BANNER/
     1  '<<<<<   H A R P O   >>>>>'
     2 ,'HAMILTONIAN ACOUSTIC RAY-TRACING PROGRAM FOR THE OCEAN'
     3 ,' '
     4 ,'BY'
     5 ,'R. M. JONES,  J. P. RILEY  AND  T. M. GEORGES'
     6 ,'WAVE PROPAGATION LABORATORY'
     7 ,'NATIONAL OCEANIC AND ATMOSPHERIC ADMINISTRATION'
     8 ,'BOULDER, COLORADO 80303'
     9 ,' '
     1 ,'PC VERSION 7/1/90 BY T. M. GEORGES, R. M. JONES AND R. S. LAWRE
     2NCE'/     
      DATA NOPUNCH/.FALSE./
      DATA IBLK/1H /
C
C ----------------------------------------------------------------------!-------
      ENTRY HEADER1
C ----------------------------------------------------------------------!-------
C
C     COMPUTE EFFECTIVE LINES COUNT BASED ON FIXED PAGE SIZE
      CALL NEWPAG(NPAG,INT(PAGLN),PC)
      CALL SFILL(DIVIDR,LEN(DIVIDR),'_')
      DIVIDR(1:1)=' '
!  9 Mar 2012      NTYP=2
!  9 Mar 2012      IF(RAY.NE.0.D0) NTYP=2.D0+DSIGN(1.D0,RAY)
      NTYP=3.D0+RAY                                                !  9 Mar 2012
C
1600  FORMAT(2(2(A8,F7.1,1X),2X))
C%      CALL PUTKST(3,'1'
C%     1  //DAT//TOD//BLANKS(:100)//'PAGE'//NUMSTG(NPAG,1,'(I5)'))
      call pcodes (pc,typ)
      call putkst(3,typ//pc)
      strg5=blanks(:3)//dat//tod//blanks(:100)//'PAGE'
     1 //numstg(npag,1,'(i4)')
      call putkst(3,strg5)
      CALL PUTKST(3,DIVIDR)
      CALL PUTKBK(3,1)
      DO 15 I=1,NBNRLS
15    CALL PUTKCT(3,BANNER(I))
      CALL PUTKBK(3,1)
      CALL PUTKST(3,DIVIDR)
      CALL PUTKBK(3,NBLNS)
C
C%      CALL PUTKST(3,BLANKS(:57)//'RUN SET NUMBER'
C%     1  //NUMSTG(NSET,1,'(a5)'))
      strg5=blanks(:57)//'RUN SET NUMBER'//numstg(nset,1,'(i5)')
      call putkst (3,strg5)
      CALL PUTKBK(3,1)
C*      WRITE(STMP,'(10A8)') ID
      WRITE(STMP,'(A80)') ID
      CALL PUTKST(3,BLANKS(:57)//'OCEAN MODEL ID: '//STMP(:3))
      CALL PUTKBK(3,1)
      CALL PUTKST(3,
     1 BLANKS(:25)//'OCEAN MODEL DESCRIPTION:  '//STMP(7:))
      CALL PUTKBK(3,1)
C
      IF(NTYP.GT.0.AND.NTYP.LE.3) THEN                             !  9 Mar 2012
      WRITE(STMP,'(2A8)') (RAYNAME(I,NTYP),I=1,2)
      ELSE                                                         !  9 Mar 2012
      WRITE(STMP,'(A8,I3,5X)') '    Root',INT(RAY)                 !  9 Mar 2012
      ENDIF                                                        !  9 Mar 2012
      CALL PUTKST(3,STMP)
      CALL PUTKBK(3,1)
      CALL PUTKST(3,DIVIDR)
      CALL PUTKBK(3,1)
      CALL PUTKST(3,
     1  BLANKS(:8)//'MODEL                 SUBROUTINE    DATA SET'
     1  //'       DESCRIPTION')
      CALL PUTKST(3,
     1  BLANKS(:8)//'TYPE                     NAME         ID')
      CALL PUTKBK(3,1)
      CALL PUTKST(3,DIVIDR)
      CALL PUTKBK(3,1)
      CALL PUTKST(3,' DISPERSION RELATION           '//DISPM
     1  //BLANKS(:16)//MODRIN )
C*     1  //BLANKS(:16)//NUMSTG(MODRIN,8,'(8A8)'))
      CALL PUTDES(3,'BACKGROUND CURRENT VELOCITY',MODU,IDSU)
      CALL PUTDES(3,'CURRENT VELOCITY PERTURBATION',MODU(3),IDSDU)
      CALL PUTDES(3,'BACKGROUND SOUND SPEED',MODC,IDSC)
      CALL PUTDES(3,'SOUND SPEED PERTURBATION',MODC(3),IDSDC)
C ADDed temp stuff 5/6/03 wbm
      CALL PUTDES(3,'TEMPERATURE',MODT,IDST) ! 6 May 2003
      CALL PUTDES(3,'TEMPERATURE PERTURBATION',MODT(3),IDSDT)       ! 6 May 2003
      CALL PUTDES(3,'BACKGROUND GRAVITY',MODGV,IDSA)       ! 2 Feb 2006         
      CALL PUTDES(3,'GRAVITY PERTURBATION',MODGV(3),IDSDA) ! 2 Feb 2006 
      CALL PUTDES(3,'BACKGROUND DENSITY',MODDS,IDSD)       ! 2 Feb 2006         
      CALL PUTDES(3,'DENSITY PERTURBATION',MODDS(3),IDSDD) ! 2 Feb 2006 
      CALL PUTDES(3,'MOLECULAR WEIGHT',MODM,IDSM)                   ! 2 Jun 2004
      CALL PUTDES(3,'BACKGROUND BOTTOM',MODG,IDSG)
      CALL PUTDES(3,'BOTTOM PERTURBATION',MODG(3),IDSDG)
      CALL PUTDES(3,'ABSORPTION',MODL,IDSV)
      CALL PUTDES(3,'ABSORPTION PERTURBATION',MODL(3),IDSDV)
C
C
      CALL PUTDES(3,'BACKGROUND PRESSURE',MODP,IDSPR)               ! 2 Jun 2004
      CALL PUTDES(3,'PRESSURE PERTURBATION',MODP(3),IDSDP)          ! 2 Jun 2004
      CALL PUTDES(3,'RECEIVER SURFACE',MODREC,IDSR)
      CALL PUTDES(3,'OCEAN SURFACE',MODSURF,IDSS)
      CALL PUTDES(3,'OCEAN SURFACE PERTURBATION',MODSURF(3),IDSDS)
      CALL PUTKST(3,DIVIDR)
C
c      print * , ' nopunch = ', nopunch
c      print * , ' rayset = ', rayset
C      NOPUNCH=NOPUNCH.AND.RAYSET.LT.0.0
      NOPUNCH=NOPUNCH.or.RAYSET.Le.0.0 ! 26 Jul 2006
      IF(NOPUNCH) RETURN
c      NOPUNCH=RAYSET.LT.0.0
      NOPUNCH=RAYSET.Le.0.0 ! 26 Jul 2006
C
C*    WRITE(9,1200) ID,DAT,TOD
      WRITE(9,1201) ID,DAT,TOD
1201  FORMAT(A80,2(A10,2X))
      WRITE(9,1600) MODU,MODC,MODT,MODM(1),MODM(2)                 ! 21 Feb 2006
     1 ,MODREC(1),MODREC(2),MODP,MODL                              ! 21 Feb 2006
     2 ,MODGV,MODDS,MODG,MODSURF                                   ! 21 Feb 2006
      IF(IDSU(1) .NE. IBLK) WRITE(9,1205) IDSU
      IF(IDSDU(1) .NE. IBLK) WRITE(9,1205) IDSDU
      IF(IDSC(1) .NE. IBLK) WRITE(9,1205) IDSC
      IF(IDSDC(1) .NE. IBLK) WRITE(9,1205) IDSDC
      IF(IDST(1) .NE. IBLK) WRITE(9,1205) IDST
      IF(IDSDT(1) .NE. IBLK) WRITE(9,1205) IDSDT
      IF(IDSA(1) .NE. IBLK) WRITE(9,1205) IDSA                      ! 3 Feb 2006 
      IF(IDSDA(1) .NE. IBLK) WRITE(9,1205) IDSDA                    ! 3 Feb 2006 
      IF(IDSD(1) .NE. IBLK) WRITE(9,1205) IDSD                      ! 3 Feb 2006 
      IF(IDSDD(1) .NE. IBLK) WRITE(9,1205) IDSDD                   ! 17 Feb 2006 
      IF(IDSM(1) .NE. IBLK) WRITE(9,1205) IDSM
      IF(IDSR(1) .NE. IBLK) WRITE(9,1205) IDSR                     ! 21 Feb 2006
      IF(IDSG(1) .NE. IBLK) WRITE(9,1205) IDSG
      IF(IDSDG(1) .NE. IBLK) WRITE(9,1205) IDSDG                   ! 21 Feb 2006
      IF(IDSV(1) .NE. IBLK) WRITE(9,1205) IDSV                      ! 5 Jun 2004
      IF(IDSDV(1) .NE. IBLK) WRITE(9,1205) IDSDV                   ! 21 Feb 2006
      IF(IDSPR(1) .NE. IBLK) WRITE(9,1205) IDSPR                    ! 2 Jun 2004
      IF(IDSDP(1) .NE. IBLK) WRITE(9,1205) IDSDP                    ! 2 Jun 2004
      IF(IDSS(1) .NE. IBLK) WRITE(9,1205) IDSS                      ! 2 Jun 2004
      IF(IDSDS(1) .NE. IBLK) WRITE(9,1205) IDSDS                    ! 2 Jun 2004
C
1000  format (A1/A80,21X,2A10,' PAGE',I4)
1200  FORMAT(10A8,2(A10,2x))
1205  format (20A4)
C
      RETURN
C ----------------------------------------------------------------------!-------
      ENTRY HEADER2
C ----------------------------------------------------------------------!-------
C     COMPUTE EFFECTIVE LINES COUNT BASED ON FIXED PAGE SIZE
      CALL NEWPAG(NPAG,INT(PAGLN),PC)
      LINES=LINES+5
C
      WRITE(3,1000) PC,ID,DAT,TOD,NPAG
      WRITE(3,2400) SNGL(AZ1*DEGS),SNGL(TLAT*DEGS),SNGL(OW/PIT2),
     1         SNGL(BETA*DEGS)
     1        ,SNGL(TLON*DEGS),MAXERR
 2400 FORMAT (
     1  /' AZIMUTH ANGLE OF TRANSMISSION   =',F12.6,' DEG'
     2  ,'   TRANSMITTER  LATITUDE  =',F12.6,' DEG'
     3  ,'    FREQUENCY =',F20.8,' HZ'                             ! 15 Mar 2011
     4  /' ELEVATION ANGLE OF TRANSMISSION =',F12.6,' DEG'
     5  ,'   TRANSMITTER  LONGITUDE =',F12.6,' DEG'
     6  ,'    SINGLE STEP ERROR =',1PG13.6/)
C
      RETURN
C ----------------------------------------------------------------------!-------
      ENTRY PUTDVR(NUNIT)
C ----------------------------------------------------------------------!-------
      CALL PUTKST(NUNIT,DIVIDR)
      RETURN
C
C
C ----------------------------------------------------------------------!-------
      ENTRY PUTHDR(NUNIT,PCC,NP)
C ----------------------------------------------------------------------!-------
C%      CALL PUTKST(NUNIT,
C%     1  PCC//DAT//TOD//BLANKS(:100)//'PAGE'//NUMSTG(NP,1,'(I5)'))
      strg5=pcc//blanks(:2)//dat//tod//blanks(:100)//'PAGE'
     1 //numstg(np,1,'(i4)')
      call putkst(nunit,strg5)
      RETURN
C ----------------------------------------------------------------------!-------
      END SUBROUTINE OCNHD
C ----------------------------------------------------------------------!-------
