*"表題 緯度微分 GTOOL3(GPAYDF)
*
*"履歴 91/01/17 沼口  敦
*
*
*********************************************************************
*"         << 緯度微分 >>
*"      [acosφ]^-1 d/dφ(cosφ )
*********************************************************************
      SUBROUTINE GPAYDF
     I         ( HHEAD , GDATA ,
     I           HEDIT , HETTL ,
     O           HHEADO, GDATAO  )
*
      CHARACTER  HHEAD  ( * )*(*)        !" ヘッダー(入力)
      REAL       GDATA  ( * )            !" データ(入力)
      CHARACTER  HEDIT       *(*)        !" 編集略記号
      CHARACTER  HETTL       *(*)        !" 編集タイトル
      CHARACTER  HHEADO ( * )*(*)        !" ヘッダー(出力)
      REAL       GDATAO ( * )            !" データ(出力)
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HAXIS         *(NCC)
      CHARACTER  HETTLD        *(NCC)
      CHARACTER  HAITM1        *(NCC)
*
      PARAMETER  ( IDIM=3, JDIM=2, KDIM=1 )
#ifdef SYS_IBMS
      INCLUDE    (GPAINC)                !" /GPAWRK/
#else
#include         "gpainc.F"              !" /GPAWRK/
#endif
*"    COMMON /GPAWK?/ WDATA , ZDATA , ZWORK ,
*"                    PNM   , DPNM  , TRIGS , IFAX  ,
*"                    NMO   , GW    , COSLAT,
*"                    QPNM  , QDPNM , QGW   , QSINLA
*"    REAL ER / 6370.E3 /
*
*"         < 1. 大きさの取得 >
*
      CALL GUSMIS ( HHEAD )
*
      CALL GUQSIZ
     I         ( HHEAD ,
     O           IXSTR , IXEND , IXDIM ,
     O           IYSTR , IYEND , IYDIM ,
     O           IZSTR , IZEND , IZDIM  )
*
      CALL GUSZCK ( HHEADO, IXDIM*IYDIM*IZDIM )
*
*"         < 1.1 第１次元か第２次元か？ >
*
      CALL GHCGET( HHEAD, 'AITM1', HAITM1 )
      IF ( INDEX( HAITM1, 'LA' ) .GT. 0 ) THEN
         IF ( IZDIM .NE. 1 ) THEN
            CALL MSGDMP( 'W', 'GPAYDF', 'INVALID DIMENSION' )
         ENDIF
         IZDIM = IYDIM
         IYDIM = IXDIM
         IXDIM = 1
      ENDIF
*
*"         < 2. 球関数の準備 >
*
      CALL GPASPS
     I         ( IXDIM , IYDIM , IZDIM , ER    ,
     O           PNM   , DPNM  , TRIGS , IFAX  ,
     O           NMO   , GW    , COSLAT,
     O           LMAX  , MMAX  , NMAX  , MINT  , NMDIM , JMXHF
     W           QPNM  , QDPNM , QGW   , QSINLA               )
*
*"         < 3. スペクトル >
*
      DO 3100 K = 1, IZDIM
         DO 3110 J = 1, IYDIM
            DO 3120 I = 1, IXDIM
               IJK = I + (J-1)*IXDIM + (K-1)*IXDIM*IYDIM
               GDATAO( IJK ) = GDATA( IJK ) * COSLAT( J )
 3120       CONTINUE
 3110    CONTINUE
 3100 CONTINUE
*
      CALL SPG2W
     M         ( WDATA ,
     I           GDATAO,
     C           PNM   , NMO   , TRIGS , IFAX  , GW    ,
     F           '    ', 'POS' ,
     D           IXDIM , IYDIM , IZDIM , IXDIM , IYDIM ,
     D           LMAX  , MMAX  , NMAX  , MINT  , NMDIM , JMXHF
     W           ZDATA , ZWORK                                 )
*
*"         < 4. 微分して格子点値に戻す >
*
      CALL SPW2G
     M         ( GDATAO,
     I           WDATA ,
     C           DPNM  , NMO   , TRIGS , IFAX  ,
     F           'YGRA', 'POS' ,
     D           IXDIM , IYDIM , IZDIM , IXDIM , IYDIM ,
     D           LMAX  , MMAX  , NMAX  , MINT  , NMDIM , JMXHF
     W           ZDATA , ZWORK                                 )
*
*
*"         < 5. ａcosφ^2 で割る >
*
      DO 5100 K = 1, IZDIM
         DO 5110 J = 1, IYDIM
            DO 5120 I = 1, IXDIM
               IJK = I + (J-1)*IXDIM + (K-1)*IXDIM*IYDIM
               GDATAO( IJK ) = GDATAO( IJK ) / ER / ( COSLAT( J )**2 )
 5120       CONTINUE
 5110    CONTINUE
 5100 CONTINUE
*
*"         < 6. ヘッダー変更 >
*
      CALL GHCOPY ( HHEAD, HHEADO )
*
      IF      ( HEDIT .EQ. ' ' ) THEN
         CALL GHCGET( HHEAD, 'AITM2', HAXIS )
         NH = LENC( HAXIS )
         HETTLD = HAXIS(1:NH)//'-diff'
         CALL GHEADD ( HHEADO, 'YDF' , HETTLD )
*
      ELSE IF ( HEDIT .NE. 'NUL' ) THEN
         CALL GHEADD ( HHEADO, HEDIT, HETTL  )
      ENDIF
*
      RETURN
      END
*********************************************************************
*"         << 緯度微分 >>
*"      [acosφ]^-1 d/dφ(cosφ )
*********************************************************************
      SUBROUTINE GMAYDF
     M         ( HHEAD , GDATA ,
     I           HEDIT , HETTL  )
*
      CHARACTER  HHEAD  ( * )*(*)        !" ヘッダー(入力)
      REAL       GDATA  ( * )            !" データ(入力)
      CHARACTER  HEDIT       *(*)        !" 編集略記号
      CHARACTER  HETTL       *(*)        !" 編集タイトル
*
      COMMON     /GMWORK/ GDATAW
      REAL       GDATAW ( 1 )            !" データ(ワーク)
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HHEADW ( NDC )*(NCC)    !" ヘッダー(ワーク)
*
      CALL       GMCSIZ ( HHEADW )
      CALL       GPAYDF
     I         ( HHEAD , GDATA ,
     I           HEDIT , HETTL ,
     O           HHEADW, GDATAW  )
*
      CALL       GPFSET
     I         ( HHEADW, GDATAW,
     I           ' '   , ' '   ,
     O           HHEAD , GDATA   )
*
      RETURN
      END