C------------------------------------------------------------------------------
C     npgrav.for
C------------------------------------------------------------------------------
! 30 Apr 2010 - Correction
C 25 Mar 2010 - Added ENTRY IPGRAVa (without argument)
C 23 Mar 2010 - Changed subroutine name to npgrav
C 23 Mar 2010 - Added ENTRY PGRAV (with argument)
C 23 Mar 2010 - Added ENTRY PGRAVa (without argument)
C     19 Jul 2006 - - Separated ipgrav (no argument) and ipgravg (w. argument)
C     26 Jan 2006 - 
C     25 Jan 2006 - version for gravity waves
C     GENERIC GRAVITY PERTURBATION MODEL
C------------------------------------------------------------------------------
      SUBROUTINE NPGRAV                                           ! 23 Mar 2010
C------------------------------------------------------------------------------

      implicit double precision (a-h,o-z)

C For gravity, the following variables represent first derivatives of the
C the three components (r, theta, and phi), NOT SECOND DERIVATIVES.
C Example: pthtm is the partial derivative of g_sub_th with respect to time.

      TYPE :: gravity_and_derivs_1
         REAL(KIND=8) :: gs,gsr,gsth,gsph
         REAL(KIND=8) :: ptm,pr,pth,pph
         REAL(KIND=8) :: prtm,prr,prth,prph
         REAL(KIND=8) :: pthtm,pthr,pthth,pthph
         REAL(KIND=8) :: pphtm,pphr,pphth,pphph
      END TYPE 
      TYPE (gravity_and_derivs_1) :: gravity
C------------------------------------------------------------------------------
      ENTRY PGRAV(gravity)                                        ! 23 Mar 2010
      ENTRY PGRAVg(gravity)                                       ! 23 Mar 2010
      RETURN

      ENTRY PGRAVa
      RETURN
C------------------------------------------------------------------------------
      END SUBROUTINE NPGRAV
C------------------------------------------------------------------------------

C------------------------------------------------------------------------------
      SUBROUTINE SETPGRAV
C------------------------------------------------------------------------------
C
C     This subroutine is called once.
C
      implicit double precision (a-h,o-z)

C     COMMON DECK "B14" INSERTED HERE
      INTEGER DTMX,DTNTBL,DTITBL,DTFRMTB,IDSDT(10)
      COMMON/B14/DTMX,DTNTBL(10),DTITBL(10),DTFRMTB(10),DTGP(10)
      EQUIVALENCE (DTGP,IDSDT)
C
      INTEGER DWMX ,DWNTBL(10),DWITBL(10),DWFRMTB(10)
C
      DATA DWMX/1/
      DATA DWNTBL/1,11,8*0/
      DATA DWITBL/1,9*0/
      DATA DWFRMTB/1,9*0/
C
      DTMX=DWMX
      CALL IMOVE(DTNTBL,DWNTBL,10)
      CALL IMOVE(DTITBL,DWITBL,10)
      CALL IMOVE(DTFRMTB,DWFRMTB,10)
C
      RETURN
C
C------------------------------------------------------------------------------
      END SUBROUTINE SETPGRAV
C------------------------------------------------------------------------------

C------------------------------------------------------------------------------
      SUBROUTINE IPGRAV  ! 19 Jul 2006
C------------------------------------------------------------------------------
C     This subroutine is called once for each new W array.

      implicit double precision (a-h,o-z)

      TYPE :: model
         CHARACTER :: model_name
         REAL(KIND=8) :: data_id
         CHARACTER :: pert_name
         REAL(KIND=8) :: pert_id
      END TYPE model
      TYPE (model) :: modgg

C     COMMON DECK "GV" INSERTED HERE
      DOUBLE PRECISION modgv
      COMMON/GV/MODGV(4)
     1  ,GV  ,PGVTM  ,PGVR  ,PGVTH  ,PGVPH
     2  ,GVR ,PGVRTM ,PGVRR ,PGVRTH ,PGVRPH
     3  ,GVTH,PGVTHTM,PGVTHR,PGVTHTH,PGVTHPH
     4  ,GVPH,PGVPHTM,PGVPHR,PGVPHTH,PGVPHPH

C     COMMON DECK "WW" INSERTED HERE
      PARAMETER (NWARSZ=1000)
      COMMON/WW/dum(10), MAXW,W(NWARSZ)
C
C     DELTA GRAVITY    625-249
      EQUIVALENCE (W(626),DGVFORM)
C
      ENTRY IPGRAVa                                               ! 25 Mar 2010

      IF(W(625) .NE. 0.0) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(625) should be 0 if you are using NPGRAV'
      ENDIF
C
      MODGV(3) = 'NPGRAV'
      MODGV(4) = W(627)
      RETURN

C------------------------------------------------------------------------------
      ENTRY IPGRAVg(modgg)
C     This subroutine is called once for each new W array.

      IF(W(625) .NE. 0.0) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(625) should be 0 if you are using NPGRAV'
      ENDIF
C
      modgg%pert_name = 'NPGRAV'
      modgg%pert_id = W(627)

!      MODGV(3) = modgg%pert_name                                 ! 30 Apr 2010
!      MODGV(4) = modgg%pert_id                                   ! 30 Apr 2010
      MODGV(3) = 'NPGRAV'                                         ! 30 Apr 2010
      MODGV(4) = W(627)                                           ! 30 Apr 2010

      RETURN

C------------------------------------------------------------------------------
      END SUBROUTINE IPGRAV
C------------------------------------------------------------------------------