* PACKAGE GTSQR   !" Ê¿Êýº¬                                A.Numaguti
*"                                    bug fix : 96/10/14 M.Ishiwatari
*"                                    bug fix : 99/10/12 S.Takehiro
*********************************************************************
      PROGRAM GTSQR
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
      COMMON     /GMWORK/ MWORK
      REAL       MWORK  ( IJKDIM )
*
      CHARACTER  HHEAD1( NDC )*(NCC)
      REAL       GDATA1( IJKDIM )
      CHARACTER  HFILE( 1 ) *(NFILN)
      DATA       HFILE  / '$GTTMPDIR/gtool.out' /
      INTEGER    IFILE
      DATA       IFILE  / 50 /
      DATA       JFILE  / 60 /
*
      REAL       OFS , FACT
      DATA       OFS , FACT   / 0.0, 1.0 /
      CHARACTER  OUT    *(NFILN)
      DATA       OUT    / '$GTTMPDIR/gtool.out' /
      LOGICAL    APND
      DATA       APND   / .FALSE. /
      CHARACTER  ITEM   *(NCC)
      CHARACTER  UNIT   *(NCC)
      CHARACTER  TITLE  *(NCC*2)
      CHARACTER  DSET   *(NCC)
      CHARACTER  EDIT   *(NCC)
      CHARACTER  ETTL   *(NCC)
      DATA       ITEM, UNIT, TITLE, DSET /4*' '/
*
      DATA       EDIT, ETTL /'SQR','<gtsqr>'/
*
      LOGICAL    GRESET
      DATA       GRESET / .TRUE. /
      LOGICAL    HELP
      DATA       HELP   / .FALSE. /
*
      NAMELIST  /OPTION/ OFS , FACT, OUT, APND,
     &                   ITEM, UNIT, TITLE, DSET, EDIT, ETTL, GRESET,
     &                   HELP, HFILE
*
      EXTERNAL SUBSQR
*
      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
*
      OFS1  = OFS
      FACT1 = FACT
*
      CALL GTOPEN
      CALL GTSIZE ( HHEAD1, 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)
*
 1100 CONTINUE
*
         CALL   GFREAD
     O        ( HHEAD1, GDATA1, IEOD1 ,
     I          IFILE , 1               )
*
         IEOD2 = 0
*
         IF ( MAX( IEOD1,IEOD2 ) .EQ. 0 ) THEN
*

           IF ( OFS1 .NE. 0.0 ) THEN
              CALL GMFINC
     I        ( HHEAD1, GDATA1, OFS1 ,
     I          '  '  , '  '           )
           ENDIF
           IF ( FACT1 .NE. 1.0 ) THEN
              CALL GMFFCT
     I        ( HHEAD1, GDATA1, FACT1   ,
     I          '  '  , '  '           )
           ENDIF
*
           CALL GMCAL1
     I        ( SUBSQR,
     I          HHEAD1, GDATA1,
     I          EDIT  , ETTL             )
*
           IF ( ITEM .NE. ' ' ) THEN
              CALL GHCSET( HHEAD1, 'ITEM', ITEM )
           ENDIF
           IF ( UNIT .NE. ' ' ) THEN
              CALL GHCSET( HHEAD1, 'UNIT', UNIT )
           ENDIF
           IF ( TITLE .NE. ' ' ) THEN
              CALL GHCSTS( HHEAD1, 'TITL', TITLE )
           ENDIF
           IF ( DSET .NE. ' ' ) THEN
              CALL GHCSET( HHEAD1, 'DSET', DSET )
           ENDIF
*
           IF ( GRESET ) THEN
              CALL GHRSGP( HHEAD1 )
           ENDIF
*
           CALL  GFWRIT
     I         ( HHEAD1, GDATA1,
     I           JFILE , 1     , 0       )
*
      GOTO 1100
         ENDIF
*
      STOP
      END
********************************************************************
      SUBROUTINE SUBSQR
     I         ( HHEAD , GDATA ,
     O           HHEADS, GDATAS,
     D           IXDIM , IYDIM , IZDIM )
*
      CHARACTER  HHEAD  ( * ) *(*)
      CHARACTER  HHEADS ( * ) *(*)
      REAL       GDATA  ( * )
      REAL       GDATAS ( * )
      REAL       VMISS
*
      CALL GLPGET( 'RMISS', VMISS )
      DO 1100 I = 1, IXDIM*IYDIM*IZDIM
         IF ( GDATA( I ).NE.VMISS .AND. GDATA( I ).GE. 0. ) THEN
            GDATAS( I ) = SQRT( GDATA( I ) )
         ELSE 
            GDATAS( I ) =VMISS
         ENDIF
 1100 CONTINUE
*
      RETURN
      END