SUBROUTINE PACK (Z,IDA,STAND,AMP,NGRID)
C
REAL*8 Z(NGRID), DMAX, DMIN
Crizvi INTEGER*2 IDA(NGRID)
INTEGER IDA(NGRID)
CMAX=32767.0
* ******* SCALING PART *******
Crizvi DMAX = -1.0E75
Crizvi DMIN = 1.0E75
DMAX = -1.0E38
DMIN = 1.0E38
DO 20 I=1,NGRID
DMAX = MAX(DMAX,Z(I))
DMIN = MIN(DMIN,Z(I))
20 CONTINUE
STAND=(DMAX+DMIN)*0.5
AMP =(DMAX-STAND)/CMAX
* ***** PACKING PART *******
IF(AMP.EQ.0.0) THEN
RAMP=1.0
ELSE
RAMP=1.0/AMP
END IF
C
DO 40 I=1,NGRID
WORK=(Z(I)-STAND)*RAMP
IF(WORK.GT.0.0) THEN
IDA(I)=INT(WORK+0.5)
ELSE
IDA(I)=INT(WORK-0.5)
END IF
40 CONTINUE
C
RETURN
END SUBROUTINE PACK
C*********************************************************************
SUBROUTINE CR4I2V(RDATA,BASE,AMP,IDATA,LM)
************************************************************************
* ( IN ) RDATA R*4(LM) : �����z��
* ( OUT) BASE R*4 : ��l
* ( OUT) AMP R*4 : �W��
* ( OUT) IDATA I*2(LM) : �����z��
* ( IN ) LM I*4 : �f�[�^��
*
************************************************************************
*
Crizvi REAL*4 RDATA(LM),RMAX,RMIN,DIST,DBASE,EXPV
REAL RDATA(LM),RMAX,RMIN,DIST,DBASE,EXPV
INTEGER*4 IDATA(*)
Crizvi REAL*4 DVAL/32760.E0/
REAL DVAL/32760.E0/
Crizvi INTEGER*2 HZERO/0/,HWORK
INTEGER HZERO/0/,HWORK
*
* GET BASE,AMP
*
RMAX=RDATA(1)
RMIN=RDATA(1)
DO 10 I=2,LM
IF (RDATA(I).GT.RMAX) RMAX=RDATA(I)
IF (RDATA(I).LT.RMIN) RMIN=RDATA(I)
10 CONTINUE
DIST=(RMAX-RMIN)/2
DBASE=(RMIN+RMAX)/2
BASE=DBASE
AMP=DIST/DVAL
*
* PACK
*
IF (DIST.EQ.0) THEN ! ALL SAME
DO 20 I=1,LM/2
IDATA(I)=0
20 CONTINUE
IF ((LM/2)*2.NE.LM) THEN ! LM ODD
Crizvi CALL MOVEC(IDATA(LM/2+1),1,HZERO,1,2)
IDATA(LM/2+1) = HZERO * 65536
END IF
ELSE ! NORMAL DATA
EXPV=DVAL/DIST
*cdir nodep
DO 30 I=2,LM,2
IWORK=NINT((RDATA(I)-DBASE)*EXPV) ! EVEN PART
IF (IWORK.GE.0) THEN
IDATA(I/2)=NINT((RDATA(I-1)-DBASE)*EXPV)*65536+IWORK
ELSE
IDATA(I/2)=(NINT((RDATA(I-1)-DBASE)*EXPV)+1)*65536+IWORK
END IF
30 CONTINUE
IF ((LM/2)*2.NE.LM) THEN ! LM ODD
HWORK=NINT((RDATA(LM)-DBASE)*EXPV)
Crizvi CALL MOVEC(IDATA(LM/2+1),1,HWORK,1,2)
IDATA(LM/2+1) = HWORK * 65536
END IF
END IF
*
RETURN
END SUBROUTINE CR4I2V
C*********************************************************************
C >>> �f�[�^���A���p�b�N����i�x�N�g���Łj <<<
C*********************************************************************
SUBROUTINE CI2R4V(RDATA,BASE,AMP,IDATA,LM)
************************************************************************
*
* ���l�\��ۗ��Q�o�C�g�����^�f�[�^�z����S�o�C�g�����ɕϊ�����B
* �i�r�R�W�O�O�x�N�g�������p�j
* 1995.11.06 ���쏮
* ����
* ( OUT) RDATA R*4(LM) : �����z��
* ( IN ) BASE R*4 : ��l
* ( IN ) AMP R*4 : �W��
* ( IN ) IDATA I*2(LM) : �����z��
* ( IN ) LM I*4 : �f�[�^��
*
* �K�v�ȃT�u���[�`�� ����
* ���ӁF�h�c�`�s�`�͌ꋫ�E�ɂ��邱�ƁB
*
************************************************************************
*
Crizvi REAL*4 RDATA(LM)
REAL RDATA(LM)
cshc-rizvi start
INTEGER*4 IDATA(*)
c INTEGER*2 IDATA(*)
cshc-rizvi end
INTEGER*2 HWORK
C INTEGER HWORK
*
DO 10 I=2,LM,2
IWRK=IDATA(I/2)/65536
IRMN=IDATA(I/2)-IWRK*65536
IF (IRMN.EQ.0) THEN ! LOWER-HALF=0
RDATA(I-1)=BASE+AMP*IWRK
RDATA(I) =BASE
ELSE IF (IRMN.GT.0) THEN
RDATA(I-1)=BASE+AMP*IWRK
IF (IRMN.LT.32768) THEN
RDATA(I)=BASE+AMP*IRMN
ELSE
RDATA(I)=BASE+AMP*(IRMN-65536)
END IF
ELSE
RDATA(I-1)=BASE+AMP*(IWRK-1)
IF (IRMN.LT.-32768) THEN
RDATA(I)=BASE+AMP*(IRMN+65536)
ELSE
RDATA(I)=BASE+AMP*IRMN
END IF
END IF
10 CONTINUE
IF ((LM/2)*2.NE.LM) THEN ! LM ODD
Crizvi CALL MOVEC(HWORK,1,IDATA(LM/2+1),1,2)
HWORK=IDATA(LM/2+1)/65536
RDATA(LM)=BASE+AMP*HWORK
END IF
*
RETURN
END SUBROUTINE CI2R4V
C*********************************************************************
C >>> �f�[�^���A���p�b�N����i�x�N�g���Łj <<<
C*********************************************************************
SUBROUTINE CI2R8V(RDATA,BASE,AMP,IDATA,LM)
************************************************************************
*
* ���l�\��ۗ��Q�o�C�g�����^�f�[�^�z����W�o�C�g�����ɕϊ�����B
* �i�r�R�W�O�O�x�N�g�������p�j
* 1995.11.07 ���쏮
* ����
* ( OUT) RDATA R*8(LM) : �����z��
* ( IN ) BASE R*4 : ��l
* ( IN ) AMP R*4 : �W��
* ( IN ) IDATA I*2(LM) : �����z��
* ( IN ) LM I*4 : �f�[�^��
*
* �K�v�ȃT�u���[�`�� ����
* ���ӁF�q�c�`�s�`�͂Q�ꋫ�E�A�h�c�`�s�`�͌ꋫ�E�ɂ��邱�ƁB
*
************************************************************************
*
REAL*8 RDATA(LM)
INTEGER*4 IDATA(*)
INTEGER*2 HWORK
c INTEGER HWORK
*
DO 10 I=2,LM,2
IWRK=IDATA(I/2)/65536
IRMN=IDATA(I/2)-IWRK*65536
IF (IRMN.EQ.0) THEN ! LOWER-HALF=0
RDATA(I-1)=BASE+AMP*IWRK
RDATA(I) =BASE
ELSE IF (IRMN.GT.0) THEN
RDATA(I-1)=BASE+AMP*IWRK
IF (IRMN.LT.32768) THEN
RDATA(I)=BASE+AMP*IRMN
ELSE
RDATA(I)=BASE+AMP*(IRMN-65536)
END IF
ELSE
RDATA(I-1)=BASE+AMP*(IWRK-1)
IF (IRMN.LT.-32768) THEN
RDATA(I)=BASE+AMP*(IRMN+65536)
ELSE
RDATA(I)=BASE+AMP*IRMN
END IF
END IF
10 CONTINUE
IF ((LM/2)*2.NE.LM) THEN ! LM ODD
Crizvi CALL MOVEC(HWORK,1,IDATA(LM/2+1),1,2)
HWORK=IDATA(LM/2+1)/65536
RDATA(LM)=BASE+AMP*HWORK
END IF
*
RETURN
END SUBROUTINE CI2R8V
*
C*********************************************************************
SUBROUTINE MOVERD(DATIN,DATOUT,N)
DIMENSION DATIN(N)
REAL*8 DATOUT(N)
C
DO 100 I=1,N
DATOUT(I)=DATIN(I)
100 CONTINUE
C
RETURN
END SUBROUTINE MOVERD
C*********************************************************************
SUBROUTINE GETTYP(NFL,IOTYP)
CHARACTER*4 GVSD
REWIND NFL
C
READ(NFL,'(2A4)',ERR=10) GVSD, GVSD
10 REWIND NFL
IF( GVSD.EQ.'GVD1' ) THEN
IOTYP=1
RETURN
ENDIF
C
READ(NFL,ERR=20) GVSD
20 REWIND NFL
IF( GVSD.EQ.'GVS1' ) THEN
IOTYP=3
RETURN
ENDIF
C
IOTYP=-1
C
RETURN
END SUBROUTINE GETTYP