* PACKAGE  GTINTERP !" ³Ê»ÒÊÑ´¹
***********************************************************************
      PROGRAM GTINTRP
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
      COMMON     /GMWORK/ MWORK
      REAL       MWORK  ( IJKDIM )
*
      CHARACTER  HHEAD( NDC )*(NCC)
      REAL       GDATA( IJKDIM )
*
      CHARACTER  HFILE( 1 ) *(NFILN)
      DATA       HFILE   / '$GTTMPDIR/gtool.out' /
      DATA       IFILE / 50 /
      DATA       IFILP / 51 /
      DATA       JFILE / 60 /
*
      CHARACTER  X *(NCC)
      CHARACTER  Y *(NCC)
      CHARACTER  Z *(NCC)
      DATA       X,Y,Z  / 3*' ' /
      CHARACTER  OUT     *(NFILN)
      DATA       OUT    / '$GTTMPDIR/gtool.out' /
      LOGICAL    APND
      DATA       APND   / .FALSE. /
      LOGICAL    MISOUT
      DATA       MISOUT / .TRUE. /
      CHARACTER  ITEM   *(NCC)
      CHARACTER  UNIT   *(NCC)
      CHARACTER  TITLE  *(NCC*2)
      CHARACTER  DSET   *(NCC)
      CHARACTER  EDIT   *(NCC)
      CHARACTER  ETTL   *(NCC)
      DATA       ITEM, UNIT, TITLE, DSET, EDIT, ETTL / 6*' '/
      LOGICAL    GRESET
      DATA       GRESET / .FALSE. /
      LOGICAL    HELP
      DATA       HELP   / .FALSE. /
*
      EXTERNAL   INTERP
*     
      NAMELIST  /OPTION/ X, Y, Z, OUT, APND, MISOUT,
     &                   ITEM, UNIT, TITLE, DSET, EDIT, ETTL, GRESET,
     &                   HELP, HFILE
*
      CALL OPTARG ( 91, 'OPTION', 'HFILE', NOPT, NFILE )
      READ (91,OPTION,IOSTAT=IOS)
      CLOSE(91)
      IF ( IOS.NE.0 .OR. HELP ) THEN
         WRITE(6,OPTION)
         STOP
      ENDIF
*
      CALL GTOPEN
      CALL GTSIZE ( HHEAD, IJKDIM )
      CALL GMSIZE ( IJKDIM  )
*
      CALL GURNTF ( HFILE( 1 ), OUT  , '$GTTMPDIR/gtool.in' )
*
      CALL GFROPN ( IFILE , HFILE( 1 ) )
      CALL GFOOPN ( JFILE ,  OUT , APND )
*
      CALL GUNENV( OUT,'.',.FALSE. )
      IL=LENC(OUT)
      WRITE (6,*) 'output='//OUT(1:IL)
*
      CALL  SETCOR ( X, Y, Z )
      CALL  SETMIS ( MISOUT  )
*
 1100 CONTINUE
         CALL   GFREAD
     O        ( HHEAD , GDATA , IEOD  ,
     I          IFILE , 1               )
*
         IF ( MAX(IEOD,IEODP) .EQ.0 ) THEN
            CALL GMCAL1
     I         ( INTERP,
     M           HHEAD , GDATA ,
     I           EDIT  , ETTL  )
*
            IF ( ITEM .NE. ' ' ) THEN
               CALL GHCSET( HHEAD , 'ITEM', ITEM )
            ENDIF
            IF ( UNIT .NE. ' ' ) THEN
               CALL GHCSET( HHEAD , 'UNIT', UNIT )
            ENDIF
            IF ( TITLE .NE. ' ' ) THEN
               CALL GHCSTS( HHEAD , 'TITL', TITLE )
            ENDIF
            IF ( DSET .NE. ' ' ) THEN
               CALL GHCSET( HHEAD , 'DSET', DSET )
            ENDIF
            IF ( GRESET ) THEN
               CALL GHRSGP( HHEAD  )
            ENDIF
*
            CALL  GFWRIT
     I                 ( HHEAD , GDATA ,
     I                   JFILE , 1     , 0       )
*
      GOTO 1100
         ENDIF
*
      STOP
      END
********************************************************************
      SUBROUTINE INTERP
     I         ( HDS   , DS     ,
     O           HDP   , DP    ,
     D           IMAX  , JMAX  , KMAX  )
*
      CHARACTER  HDS ( * )*(*)
      REAL       DS ( * )
      CHARACTER  HDP ( * )*(*)
      REAL       DP ( * )
*
      CHARACTER  HCORX1 *(*)
      CHARACTER  HCORY1 *(*)
      CHARACTER  HCORZ1 *(*)
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)
#else
#include         "gzsize.F"
#endif
      CHARACTER  HXP ( NDC )*(NCC)
      CHARACTER  HYP ( NDC )*(NCC)
      CHARACTER  HZP ( NDC )*(NCC)
      PARAMETER  ( IMAXD = 1024 )
      REAL       XS ( IMAXD ), XP( IMAXD )
      REAL       YS ( IMAXD ), YP( IMAXD )
      REAL       ZS ( IMAXD ), ZP( IMAXD )
      CHARACTER  HCORDX *(NCC)
      CHARACTER  HCORDY *(NCC)
      CHARACTER  HCORDZ *(NCC)
      REAL       XCYCL, YCYCL, ZCYCL
*
      IF ( MAX(IMAX,JMAX,KMAX) .GT. IMAXD ) THEN
         CALL MSGDMP( 'E','INTERP','WORK AREA TOO SMALL' )
      ENDIF
*
      CALL GUSMIS( HDS )
* 
      CALL GUQAXQ
     I            ( HDS   , 1     , 'LOC' ,
     O              XS    , XCYCL , IXDIM , IEOD  , 
     D              IMAXD                 )
      CALL GTSIZE ( HXP , IMAXD   )
      CALL GUQAXC
     I            ( HCORDX, 'LOC',
     O              HXP   , XP   , CYCLE , IMAXP , IEOD  )
*
      CALL GUQAXQ
     I            ( HDS   , 2     , 'LOC' ,
     O              YS    , YCYCL , IYDIM , IEOD  , 
     D              IMAXD                 )
      CALL GTSIZE ( HYP , IMAXD   )
      CALL GUQAXC
     I            ( HCORDY, 'LOC',
     O              HYP   , YP   , CYCLE , JMAXP , IEOD  )
*
      CALL GUQAXQ
     I            ( HDS   , 3     , 'LOC' ,
     O              ZS    , ZCYCL , IZDIM , IEOD  , 
     D              IMAXD                 )
      CALL GTSIZE ( HZP , IMAXD   )
      CALL GUQAXC
     I            ( HCORDZ, 'LOC',
     O              HZP   , ZP   , CYCLE , KMAXP , IEOD  )
*
      CALL INTR3
     I           ( DS  , XS   , YS   , ZS   ,
     I                   IMAX , JMAX , KMAX ,
     I                   XCYCL, YCYCL, ZCYCL,
     I                   XP   , YP   , ZP   ,
     I                   IMAXP, JMAXP, KMAXP,
     O             DP                          )
*
      CALL GHCSET( HDP, 'AITM1', HCORDX )
      CALL GHPSET( HDP, 'ASTR1', 1      )
      CALL GHPSET( HDP, 'AEND1', IMAXP  )
*
      CALL GHCSET( HDP, 'AITM2', HCORDY )
      CALL GHPSET( HDP, 'ASTR2', 1      )
      CALL GHPSET( HDP, 'AEND2', JMAXP  )
*
      CALL GHCSET( HDP, 'AITM3', HCORDZ )
      CALL GHPSET( HDP, 'ASTR3', 1      )
      CALL GHPSET( HDP, 'AEND3', KMAXP  )
*
      RETURN
*=====================================================================
      ENTRY      SETCOR
     I         ( HCORX1, HCORY1, HCORZ1 )
      HCORDX = HCORX1 
      HCORDY = HCORY1 
      HCORDZ = HCORZ1 
      RETURN
      END
***********************************************************************
      SUBROUTINE INTR3
     I         ( DS  , XS   , YS   , ZS   ,
     I                 NXS  , NYS  , NZS  ,
     I                 XCYCL, YCYCL, ZCYCL,
     I                 XP   , YP   , ZP   ,
     I                 NXP  , NYP  , NZP  ,
     O           DP                          )
*
      REAL       DS  ( NXS, NYS, NZS )
      REAL       XS  ( NXS )
      REAL       YS  ( NYS )
      REAL       ZS  ( NZS )
      REAL       XP  ( NXP )
      REAL       YP  ( NYP )
      REAL       ZP  ( NZP )
      REAL       DP  ( NXP, NYP, NZP )
*
      LOGICAL    OMISOZ
      LOGICAL    OMISOU
      DATA       OMISOU / .TRUE. /
      PARAMETER  ( NDIM = 1025 )
      INTEGER    I0  ( NDIM ), I1  ( NDIM )
      INTEGER    J0  ( NDIM ), J1  ( NDIM )
      INTEGER    K0  ( NDIM ), K1  ( NDIM )
      REAL       DI  ( NDIM )
      REAL       DJ  ( NDIM )
      REAL       DK  ( NDIM )
*
      IF ( MAX( NXP, NYP, NZP ) .GT. NDIM ) THEN
         CALL MSGDMP( 'E','INTR3', ' TOO SMALL WORK AREA: NDIM' )
      ENDIF
*
      CALL       GLPGET( 'RMISS', VMISS )
*
      CALL       GETRNG
     I         ( XS    , NXS   , XCYCL  ,
     I           XP    , NXP   ,
     O           I0    , I1    , DI      )
*
      CALL       GETRNG
     I         ( YS    , NYS   , YCYCL  ,
     I           YP    , NYP   ,
     O           J0    , J1    , DJ      )
*
      CALL       GETRNG
     I         ( ZS    , NZS   , ZCYCL  ,
     I           ZP    , NZP   ,
     O           K0    , K1    , DK      )
*
      DO 4100 KP = 1, NZP
         DO 4100 JP = 1, NYP
            DO 4100 IP = 1, NXP
*
               DX  = DI(IP)
               DY  = DJ(JP)
               DZ  = DK(KP)
*
               DX1 = 1.-DX
               DY1 = 1.-DY
               DZ1 = 1.-DZ
*
               IF ( OMISOU ) THEN
                  IF (     (DX .GT. 1.).OR.(DY .GT. 1.)
     &                 .OR.(DZ .GT. 1.)                 ) THEN
                     DP(IP,JP,KP) = VMISS
                     GOTO 4100
                  ENDIF
               ENDIF
*
               SP = 0.
               SD = 0.
               IF ( DS(I0(IP),J0(JP),K0(KP)) .NE. VMISS ) THEN
                  SP = SP + DS(I0(IP),J0(JP),K0(KP))* DX1*DY1*DZ1
                  SD = SD + DX1*DY1*DZ1
               ENDIF
               IF ( DS(I1(IP),J0(JP),K0(KP)) .NE. VMISS ) THEN
                  SP = SP + DS(I1(IP),J0(JP),K0(KP))* DX *DY1*DZ1
                  SD = SD + DX *DY1*DZ1
               ENDIF
               IF ( DS(I0(IP),J1(JP),K0(KP)) .NE. VMISS ) THEN
                  SP = SP + DS(I0(IP),J1(JP),K0(KP))* DX1*DY *DZ1
                  SD = SD + DX1*DY *DZ1
               ENDIF
               IF ( DS(I1(IP),J1(JP),K0(KP)) .NE. VMISS ) THEN
                  SP = SP + DS(I1(IP),J1(JP),K0(KP))* DX *DY *DZ1
                  SD = SD + DX *DY *DZ1
               ENDIF
               IF ( DS(I0(IP),J0(JP),K1(KP)) .NE. VMISS ) THEN
                  SP = SP + DS(I0(IP),J0(JP),K1(KP))* DX1*DY1*DZ
                  SD = SD + DX1*DY1*DZ
               ENDIF
               IF ( DS(I1(IP),J0(JP),K1(KP)) .NE. VMISS ) THEN
                  SP = SP + DS(I1(IP),J0(JP),K1(KP))* DX *DY1*DZ
                  SD = SD + DX *DY1*DZ
               ENDIF
               IF ( DS(I0(IP),J1(JP),K1(KP)) .NE. VMISS ) THEN
                  SP = SP + DS(I0(IP),J1(JP),K1(KP))* DX1*DY *DZ
                  SD = SD + DX1*DY *DZ
               ENDIF
               IF ( DS(I1(IP),J1(JP),K1(KP)) .NE. VMISS ) THEN
                  SP = SP + DS(I1(IP),J1(JP),K1(KP))* DX *DY *DZ
                  SD = SD + DX *DY *DZ
               ENDIF
               IF ( SD .GT. 0. ) THEN
                  DP(IP,JP,KP) = SP/SD
               ELSE
                  DP(IP,JP,KP) = VMISS
               ENDIF
*
 4100 CONTINUE 
*
      RETURN
*===============================================================
      ENTRY      SETMIS
     I         ( OMISOZ )
      OMISOU = OMISOZ
      RETURN
      END
****************************************************************
      SUBROUTINE GETRNG
     I         ( XS    , NXS   , XCYCL  ,
     I           XP    , NXP   ,
     O           I0    , I1    , DX      )
*
      REAL       XS  ( NXS )
      REAL       XCYCL
      REAL       XP  ( NXP )
      INTEGER    I0  ( NXP )
      INTEGER    I1  ( NXP )
      REAL       DX  ( NXP )
*
      IF ( XCYCL .NE. 0. ) THEN
         NCY = 1
      ELSE
         NCY = 0
      ENDIF
*
      IF ( NXS .EQ. 1 ) THEN
         DO 100 IP = 1, NXP
            I0(IP) = 1
            I1(IP) = 1
            DX(IP) = 0.
  100    CONTINUE 
*
         RETURN
      ENDIF

      DO 1100 IP = 1, NXP
         I0 ( IP ) = 0
         DO 1110 IX = 1, NXS
            DO 1110 ICY = -NCY, NCY
*
               IF      ( IX .NE. NXS ) THEN
                  IXP = IX + 1
                  DA  = XS(IXP) - XS(IX)
                  DD  = ( XP(IP) - ( XS(IX) + ICY*XCYCL ) ) / DA
               ELSE IF ( XCYCL .NE. 0. ) THEN
                  IXP = 1
                  DA  = XS(1)+XCYCL - XS(IX)
                  DD  = ( XP(IP) - ( XS(IX) + ICY*XCYCL ) ) / DA
               ELSE
                  GOTO 1110
               ENDIF
*
               IF ( DD .GE. 0. .AND. DD .LE. 1. ) THEN
                  I0(IP) = IX
                  I1(IP) = IXP
                  DX(IP) = DD
               ELSE IF ( (IX .EQ. 1) .AND. (ICY .EQ. -NCY )
     &                               .AND. (DD  .LT. 0.   ) ) THEN
                  I0(IP) = 1
                  I1(IP) = 1
                  DX(IP) = 2.
               ELSE IF ( (IX .EQ. NXS-1) .AND. (ICY .EQ. NCY )
     &                                   .AND. (DD  .GT. 1.  ) ) THEN
                  I0(IP) = NXS
                  I1(IP) = NXS
                  DX(IP) = 2.
               ENDIF
 1110    CONTINUE 
         IF ( I0(IP) .EQ. 0 ) WRITE (6,*) 'ERROR I0', IP
*
 1100 CONTINUE 
*
      RETURN
      END

