C------------------------------------------------------------------------------
C     NPPRES.for
C------------------------------------------------------------------------------
! 30 Apr 2010 - Slight change in setting model labeling
! 31 Mar 2010 - Alternate way to define a structure for a value plus gradients
C 29 Mar 2010 - Added ENTRY PPRES
C 29 Mar 2010 - Changed subroutine name to NPPRES
C  4 May 2009 - replaced REAL*8 with DOUBLE PRECISION
C     25 Jan 2006 - Added modp(3) and modp(4) to ENTRY ippresg()
C     25 Jan 2006 - Deleted some extra stuff.
C     25 Jan 2006 - Changed name to NPPRES.FOR
C     24 Jan 2006 - different entry points for acoustics and gravity
C     23 January 2006, version for gravity waves
C------------------------------------------------------------------------------
      SUBROUTINE NPPRES                                           ! 29 Mar 2010
C------------------------------------------------------------------------------
C     DO-NOTHING PRESSURE PERTURBATION MODEL
      implicit double precision (a-h,o-z)

      TYPE :: values_and_derivs_1_2
         REAL(KIND=8) :: value
         REAL(KIND=8) :: ptm,pr,pth,pph
         REAL(KIND=8) :: ptmtm,prtm,pthtm,pphtm
         REAL(KIND=8) :: ptmr,prr,pthr,pphr
         REAL(KIND=8) :: ptmth,prth,pthth,pphth
         REAL(KIND=8) :: ptmph,prph,pthph,pphph
      END TYPE 
      TYPE (values_and_derivs_1_2) :: pressure

C------------------------------------------------------------------------------
! An alternate way to define a structure for a value plus first and second 
!     derivatives:                                                ! 31 Mar 2010

      TYPE :: gradient
         DOUBLE PRECISION :: tm,r,th,ph
      END TYPE gradient

      TYPE :: gradient2
         TYPE (gradient) :: tm,r,th,ph
      END TYPE gradient2

      TYPE :: value_and_gradients_1_2
         DOUBLE PRECISION :: value
         TYPE (gradient) :: p
         TYPE (gradient2) :: pp
      END TYPE value_and_gradients_1_2

      TYPE (value_and_gradients_1_2) pressure2

!      pressure2%value = 1
!      pressure2%p%r = 2
!      pressure2%pp%r%th = 23
!      pressure2%pp%r%ph = 24
!      pressure2%pp%ph%th = 43
!      pressure2%pp%ph%ph = 44

!      PRINT*, 'pressure2 = ', pressure2                                 ! testing types

C------------------------------------------------------------------------------

      ENTRY PPRES                                                 ! 29 Mar 2010

      RETURN

      ENTRY PPRESg(pressure)                                      ! 24 Jan 2006
      RETURN
C------------------------------------------------------------------------------
      END SUBROUTINE NPPRES                                       ! 29 Mar 2010
C------------------------------------------------------------------------------
      SUBROUTINE SETPPRES
C------------------------------------------------------------------------------
C     This subroutine is called once.
C     DO-NOTHING PRESSURE PERTURBATION MODEL
      implicit double precision (a-h,o-z)

C     COMMON DECK "CB20" INSERTED HERE
      INTEGER DPMX,DPNTBL,DPITBL,DPFRMTB,IDSDP(10)
      COMMON/B20/DPMX,DPNTBL(10),DPITBL(10),DPFRMTB(10),DPGP(11)
      EQUIVALENCE (DPGP,IDSDP),(ANDP,DPGP(11))
      INTEGER DPFMX,DPFNTBL(10),DPFITBL(10),DPFFRMTB(10)
      DATA DPFMX/1/
      DATA DPFNTBL/1,11,8*0/
      DATA DPFITBL/1,9*0/
      DATA DPFFRMTB/1,9*0/
                           
      DPMX=DPFMX             
      CALL IMOVE(DPNTBL,DPFNTBL,10)  
      CALL IMOVE(DPITBL,DPFITBL,10)  
      CALL IMOVE(DPFRMTB,DPFFRMTB,10)
      RETURN
C------------------------------------------------------------------------------
      END SUBROUTINE SETPPRES
C------------------------------------------------------------------------------
      SUBROUTINE IPPRES ! 24 January 2006
C------------------------------------------------------------------------------
C     DO-NOTHING PRESSURE PERTURBATION MODEL
C     This subroutine is called once for each new W array.
      implicit double precision (a-h,o-z)

      PARAMETER (NWARSZ=1000)
C     COMMON DECK "WW" INSERTED HERE
      COMMON/WW/dum(10),MAXW,W(NWARSZ)

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

C     DELTA PRESSURE        575-599
      EQUIVALENCE (W(575),DPMODEL),(W(576),DPFORM),(W(577),DPID)
C
C     COMMON DECK "PP" INSERTED HERE
      DOUBLE PRECISION MODP
      COMMON/PP/MODP(4),P,PPT,PPR,PPTH,PPPH

      DATA RECOGDP/0.d0/
                           
      IF(idint(RECOGDP) .NE. idint(DPMODEL))
     1    CALL RERROR('NPPRES ','WRONG MODEL',RECOGDP)

      MODP(3)='NPPRES' ! 25 January 2006
      MODP(4)= DPID ! 24 January 2006

      RETURN

      ENTRY IPPRESg(modpg) ! 24 January 2006

      IF(idint(RECOGDP) .NE. idint(DPMODEL))
     1    CALL RERROR('NPPRES ','WRONG MODEL',RECOGDP)

      modpg%pert_name = 'NPPRES' ! 25 January 2006
      modpg%pert_id = DPID

!      MODP(3) = modpg%pert_name                     ! 2 Feb 2006 ! 30 Apr 2010
!      MODP(4) = modpg%pert_id                       ! 2 Feb 2006 ! 30 Apr 2010
      MODP(3)='NPPRES' ! 25 January 2006                          ! 30 Apr 2010
      MODP(4)= DPID ! 24 January 2006                             ! 30 Apr 2010

      RETURN
C------------------------------------------------------------------------------
      END SUBROUTINE IPPRES
C------------------------------------------------------------------------------
