!copyright (C) 2001  MSC-RPN COMM  %%%RPNPHY%%%
***S/P  LIN_SGO1_TL
#include "phy_macros_f.h"

      SUBROUTINE LIN_SGO1_TL ( F, SIZEF, U, V, T, U5, V5, T5, P, S,  1,1
     $                         RUG, RVG, TAU, KOUNT, TRNCH, N, M, NK, 
     $                         ITASK, SGOKIND)
*
#include "impnone.cdk"
      INTEGER ITASK, SIZEF, TRNCH, N, M, NK, KOUNT, SGOKIND
      REAL F(SIZEF)
      REAL U(M,NK),V(M,NK),T(M,NK),P(M),S(N,NK)
      REAL U5(M,NK),V5(M,NK),T5(M,NK)
      REAL RUG(N,NK),RVG(N,NK)
      REAL TAU
*
*Author
*          A. Zadra RPN (May 2002)
*
*Object
*          Tangent linear of LIN_SGO1
*
*IMPLICITES
*
#include "options.cdk"
#include "phybus.cdk"
#include "consphy.cdk"
*
*MODULES
*
*     ROUTINES D'EXTRACTION DE SERIES TEMPORELLES
*
c      EXTERNAL SERXST
c      EXTERNAL MVZNXST
*
*     ROUTINES DU "SGO DRAG"
*
      EXTERNAL LIN_SGOFLX1_TL
*
*
************************************************************************
*     AUTOMATIC ARRAYS
************************************************************************
*
      AUTOMATIC ( LAND     , REAL*8   , (N   ) )
      AUTOMATIC ( LAUNCH   , REAL*8   , (N   ) )
      AUTOMATIC ( SLOPE8   , REAL*8   , (N   ) )
      AUTOMATIC ( XCENT8   , REAL*8   , (N   ) )
      AUTOMATIC ( MTDIR8   , REAL*8   , (N   ) )
      AUTOMATIC ( TT       , REAL*8   , (N,NK) )
      AUTOMATIC ( TE       , REAL*8   , (N,NK) )
      AUTOMATIC ( UU       , REAL*8   , (N,NK) )
      AUTOMATIC ( VV       , REAL*8   , (N,NK) )
      AUTOMATIC ( TT5      , REAL*8   , (N,NK) )
      AUTOMATIC ( TE5      , REAL*8   , (N,NK) )
      AUTOMATIC ( UU5      , REAL*8   , (N,NK) )
      AUTOMATIC ( VV5      , REAL*8   , (N,NK) )
      AUTOMATIC ( PP       , REAL*8   , (N   ) )
      AUTOMATIC ( FCORIO   , REAL*8   , (N   ) )
      AUTOMATIC ( SS       , REAL*8   , (N,NK) )
      AUTOMATIC ( SE       , REAL*8   , (N,NK) )
      AUTOMATIC ( UTENDSGO , REAL*8   , (N,NK) )
      AUTOMATIC ( VTENDSGO , REAL*8   , (N,NK) )
*
************************************************************************
*
      INTEGER I,J,K,IS
      REAL*8 AA1,AA2
*
      LOGICAL GWDRG, BLOCKING, OROLIFT, LEEWAVE, APPLYTEND
*
*--------------------------------------------------------------------
*
      if (sgokind.eq.100) then
        gwdrg     = .true.
        blocking  = .true.
	orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 1.
        aa2 = 1.
      endif

      if (sgokind.eq.110) then
        gwdrg     = .true.
        blocking  = .true.
	orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 0.
        aa2 = 1.
      endif

      if (sgokind.eq.120) then
        gwdrg     = .true.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 1.
        aa2 = 0.
      endif

      if (sgokind.eq.130) then
        gwdrg     = .true.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 0.
        aa2 = 0.
      endif

      if (sgokind.eq.101) then
        gwdrg     = .true.
        blocking  = .true.
	orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 1.
        aa2 = 1.
      endif

      if (sgokind.eq.111) then
        gwdrg     = .true.
        blocking  = .true.
	orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 0.
        aa2 = 1.
      endif

      if (sgokind.eq.121) then
        gwdrg     = .true.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 1.
        aa2 = 0.
      endif

      if (sgokind.eq.131) then
        gwdrg     = .true.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 0.
        aa2 = 0.
      endif

      if (sgokind.eq.200) then
        gwdrg     = .false.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 1.
        aa2 = 1.
      endif

      if (sgokind.eq.210) then
        gwdrg     = .false.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 0.
        aa2 = 1.
      endif
 
      if (sgokind.eq.220) then
        gwdrg     = .false.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 1.
        aa2 = 0.
      endif

      if (sgokind.eq.230) then
        gwdrg     = .false.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 0.
        aa2 = 0.
      endif

      if (sgokind.eq.201) then
        gwdrg     = .false.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 1.
        aa2 = 1.
      endif

      if (sgokind.eq.211) then
        gwdrg     = .false.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 0.
        aa2 = 1.
      endif
 
      if (sgokind.eq.221) then
        gwdrg     = .false.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 1.
        aa2 = 0.
      endif

      if (sgokind.eq.231) then
        gwdrg     = .false.
        blocking  = .true.
        orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 0.
        aa2 = 0.
      endif

      if (sgokind.eq.300) then
        gwdrg     = .true.
        blocking  = .false.
        orolift   = .false.
        leewave   = .false.
        applytend = .false.
        aa1 = 0.
        aa2 = 0.
      endif

      if (sgokind.eq.301) then
        gwdrg     = .true.
        blocking  = .false.
        orolift   = .false.
        leewave   = .false.
        applytend = .true.
        aa1 = 0.
        aa2 = 0.
      endif

*
*--------------------------------------------------------------------
*     TRAJECTORY
*
      DO K=1,NK
*VDIR NODEP
         DO J=1,N
            TT5(J,K) = T5(J,K)
            UU5(J,K) = U5(J,K)
            VV5(J,K) = V5(J,K)
         ENDDO
      ENDDO
*
         DO J=1,N
            PP(J)     = P(J)
            FCORIO(J) = F(FCOR+J-1)
         ENDDO
*
      DO J=1,N
         LAND(J) = - ABS( NINT( f(MG+J-1) ) )
      ENDDO
*
      DO K=1,NK
         DO J=1,N
            SS(J,K) = S(J,K)
         ENDDO
      ENDDO
*
      DO K=1,NK-1
*VDIR NODEP
         DO J=1,N
            SE(J,K) = 0.5*( S(J,K) + S(J,K+1) )
         ENDDO
      ENDDO
*
*VDIR NODEP
         DO J=1,N
            SE(J,NK) = 0.5*( S(J,NK) + 1. )
         ENDDO
*
      DO  K=1,NK-1
*VDIR NODEP
         DO J=1,N
            TE5(J,K)  = 0.5*( TT5(J,K)  + TT5(J,K+1)  )
         ENDDO
      ENDDO
*
*VDIR NODEP
         DO J=1,N
            TE5(J,NK)  = 2.0*TT5(J,NK)  - TT5(J,NK-1)
         ENDDO
*
      DO I=1,N
         LAUNCH(I) = F(LHTG+I-1)
         SLOPE8(I) = F(SLOPE+I-1)
         XCENT8(I) = F(XCENT+I-1)
         MTDIR8(I) = F(MTDIR+I-1)
      ENDDO
*
*------------------------------------------------------------------
*     TANGENT LINEAR
*
      DO K=1,NK
*VDIR NODEP
         DO J=1,N
            TT(J,K)  = T(J,K)
            UU(J,K)  = U(J,K)
            VV(J,K)  = V(J,K)
            UTENDSGO(J,K) = 0.
            VTENDSGO(J,K) = 0.
         ENDDO
      ENDDO
*
      DO  K=1,NK-1
*VDIR NODEP
         DO J=1,N
            TE(J,K)  = 0.5*( TT(J,K)  + TT(J,K+1)  )
         ENDDO
      ENDDO
*
*VDIR NODEP
         DO J=1,N
            TE(J,NK)  = 2.0*TT(J,NK)  - TT(J,NK-1)
         ENDDO
*
       CALL LIN_SGOFLX1_TL (UU, VV, UTENDSGO, VTENDSGO,
     $                   TE, TT, SS, SE,
     $                   UU5, VV5, TE5, TT5,
     $                   NK, NK, N, 1, N,
     $                   GRAV, RGASD, CAPPA, TAU, TAUFAC,
     $                   LAND, LAUNCH, SLOPE8, XCENT8, MTDIR8,
     $                   PP, FCORIO,
     $                   GWDRG, BLOCKING, OROLIFT, LEEWAVE,
     $                   AA1,AA2,APPLYTEND) 
*
*
      DO K=1,NK
*VDIR NODEP
         DO J=1,N
            RUG(J,K) = UTENDSGO(J,K)
            RVG(J,K) = VTENDSGO(J,K)
            U(J,K)   = UU(J,K)
            V(J,K)   = VV(J,K)
         ENDDO
      ENDDO
*
c      CALL SERXST( RUG,    'GU',     TRNCH, N, 0.0, 1.0,   -1)
c      CALL SERXST( RVG,         'GV',TRNCH, N, 0.0, 1.0,   -1)
c      CALL MVZNXST(RUG,RVG,'GU','GV',TRNCH, N, 1.0, -1 ,ITASK)
*
      RETURN
      END