*"   PACKAGE  STTEMP       !"  seisouken
*"   
*"      Tue May 10 19:04:51 1994        Ishiwatari Masaki
***********************************************************************
      SUBROUTINE STRTAU
     O        ( TAUQ, TAUA,
     I          GDQ, GDPM ,
     I          TRPLEV )
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" $B3J;RE@?t!$GH?t(B
      INCLUDE   (ZCCOM)                      !" $BI8=`J*M}Dj?t(B
#else
#include        "zcdim.F"                    !" $B3J;RE@?t!$GH?t(B
#include        "zccom.F"                    !" $BI8=`J*M}Dj?t(B
#endif
*
*   [OUTPUT] 
      REAL       TAUQ   ( IDIM*JDIM, KMAX+1 ) !" $B8w3XE*8|$5!'?e(B
      REAL       TAUA   ( IDIM*JDIM, KMAX+1 ) !" $B8w3XE*8|$5!'6u5$(B
*
*   [INPUT] 
      REAL       GDPM   ( IDIM*JDIM, KMAX+1 ) !" $B5$05!JH>@0?t!K(B
      REAL       GDQ    ( IDIM*JDIM, KMAX )  !" $BHf<>(B  $B#q(B
      INTEGER    TRPLEV ( IDIM*JDIM )
*
      INTEGER    IJ,K
      REAL       ABSQL
*
*"         < 1. $B&S(B $B$N7W;;(B >
*
c$$$      write (6,*) 'at the beginning of strtau'
      do 1 k=1,kmax
c$$$        write (6,*) k,gdq(1,k),trplev(1)
 1    continue 
      ABSQL = 0.01
      CALL RESET ( TAUQ ( 1,KMAX+1 ), IDIM*JDIM )
      CALL RESET ( TAUA ( 1,KMAX+1 ), IDIM*JDIM )
      DO 1110 IJ = 1, IDIM*JDIM
         DO 1120  K = KMAX, TRPLEV( IJ ), -1
            TAUQ ( IJ,K ) = TAUQ ( IJ,K+1 )
     &                       + GDQ( IJ,TRPLEV( IJ ) ) * ABSQL
     &                         * ( GDPM( IJ,K )-GDPM( IJ,K+1 ) )/ GRAV
c$$$            write (6,*) 'in strtau:k,gdq,Delta p,g'
c$$$            write (6,*) k,GDQ( IJ,TRPLEV( IJ ) ),
c$$$     &           gdpm( ij,k )-GDPM( IJ,K+1 ),grav
 1120    CONTINUE
         DO 1130  K = TRPLEV( IJ )-1, 1, -1
            TAUQ ( IJ,K ) = TAUQ ( IJ,K+1 )
     &                       + GDQ( IJ,K ) * ABSQL
     &                         * ( GDPM( IJ,K )-GDPM( IJ,K+1 ) )/ GRAV
 1130    CONTINUE
 1110 CONTINUE
*
      RETURN
      END

