C-----------------------------------------------------------------------------
      SUBROUTINE NPCURR   
C-----------------------------------------------------------------------------
! 31 Mar 2010 - Added entry point IPWINDg(modug)
! 31 Mar 2010 - Added entry point PWINDg(wind)
C-----------------------------------------------------------------------------
C     DO-NOTHING CURRENT PERTURBATION MODEL   

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

C     COMMON DECK "UU" INSERTED HERE     
      implicit double precision (a-h,o-z)
      DOUBLE PRECISION MODU
      common/ww/ dum(10), maxw,w(1000)
      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------------------------------------------------------------------------------

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

C------------------------------------------------------------------------------
! 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

! A structure for a vector plus first and second derivatives:     ! 31 Mar 2010

      TYPE :: vector_and_gradients_1_2
         TYPE  (value_and_gradients_1_2) :: size,r,th,ph
      END TYPE vector_and_gradients_1_2

      TYPE (vector_and_gradients_1_2) wind

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

C     DELTA WIND        125-149          
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)                                  
      INTEGER DXMX    ,DXNTBL(10),DXITBL(10),DXFRMTB(10)        
      DATA DXMX/1/           
      DATA DXNTBL/1,11,8*0/  
      DATA DXITBL/1,9*0/     
      DATA DXFRMTB/1,9*0/    
C                            
C------------------------------------------------------------------------------

      ENTRY SETPWN           
      DUMX=DXMX              
      CALL IMOVE(DUNTBL,DXNTBL,10)  
      CALL IMOVE(DUITBL,DXITBL,10)  
      CALL IMOVE(DUFRMTB,DXFRMTB,10)
      RETURN                        
C                                   
C-----------------------------------------------------------------------------
C     This subroutine is called once for each new W array.

      ENTRY IPWINDR                 
      IF(W(125) .NE. 0.) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(125) should be 0 if you are using model NPCURR.'
      ENDIF

      MODU(3)=8HNPCURR      
      MODU(4)= w(127)
      RETURN                
C                           
C-----------------------------------------------------------------------------
C     This subroutine is called once for each new W array.

      ENTRY IPWINDg(modug)                  
      IF(W(125) .NE. 0.) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(125) should be 0 if you are using model NPCURR.'
      ENDIF

      MODU(3)=8HNPCURR      
      MODU(4)= w(127)
      modug%pert_name = 'NPCURR'
      modug%pert_id = W(127)
      RETURN                
C                           
C-----------------------------------------------------------------------------

      ENTRY PWINDR          
      RETURN                
C-----------------------------------------------------------------------------

      ENTRY PWINDg(wind)          
      RETURN                
C-----------------------------------------------------------------------------
      END SUBROUTINE NPCURR                     
C-----------------------------------------------------------------------------
