$DEBUG
C     CHUONG TRINH HOI QUI TUNG BUOC
C...CHUONG TRINH DUOC KHOI TAO BOI SUB. INITIAL TAO FILE SO LIEU (FN)
C...TU CAC FILE SO LIEU BAN DAU
C...KET QUA IN RA TRONG HAI FILE DUOC DINH NGHIA BOI CAC BIEN
C...TEN FILE FIN (TUNG BUOC) VA FRESHQ2 (DANG BANG)
C
      PROGRAM HQTB
      INCLUDE 'HQTB.INC'       ! DUNG LUONG MAU VA SO BIEN CUC DAI
      REAL	X(NMAX,MMAX),X1(NMAX*MMAX)      ! MANG CHUA DU LIEU VAO
      INTEGER IDX(MMAX)				     ! MANG CHI SO
      CHARACTER*70 FN,FIN,FRESHQ2,FRESHQ3  ! TEN FILE SO LIEU, KQ1 VA KQ2
      Character*8 Ten(MMAX)                ! TEN BIEN
	CHARACTER*10 HSO(MMAX)			     ! HE SO HOI QUI
	CHARACTER*70 ST00,ST01
      Common Ten

      INTEGER		NSTEPS(MMAX,5), LS(MMAX,MMAX), KSTEP
      REAL		BS(MMAX,MMAX), ANSS(MMAX,11)
      COMMON	/OUT/ NSTEPS,ANSS,LS,BS, KSTEP
	REAL		XMEAN(MMAX),DX(MMAX)
	COMMON	/OUT1/ XMEAN,DX
	INTEGER		VUNG,YEUTO
      COMMON	/FNAME/ FN,FIN,FRESHQ2
	INTEGER		MONY,NTERM
	CHARACTER*70 TIEUDE
	COMMON	/MONXMONY/ MONY,NTERM,TIEUDE
	CHARACTER *2 ST1,ST2
	REAL		PRC
	COMMON /PRCCONST/ PRC

	NAMELIST /THEM/ VUNG, YEUTO, FRESHQ3
      OPEN (11,FILE='INPUT_HQTB1.TXT',STATUS='OLD')
      READ (11,THEM)
	CLOSE(11)
C***********************************************************
	DO 555 MONY = 1,12      ! LOOP OVER 12 MONTHS IN THE YEAR
	DO 555 NTERM = 1,3      ! LOOP OVER 3 TERMS OF FORECAST

C...MAKE INPUT DATA FILE

      PRINT*,' HQTB: MAKE INPUT DATA FILE FOR REGRESSION...'
      CALL INITIAL

 1234	CONTINUE

      KSTEP=0
      NSTEPS=-999

C...READ IN DATA FROM FN FILE

      OPEN(1,FILE=FN,Status='Old')

      PRINT*,' HQTB: READ IN DATA FROM FILE HQTB.DAT...'
      Read(1,*) Mbien
      Read(1,*) (Idx(i),i=1,Mbien)
      Read(1,*)
      Read(1,777) (Ten(i),i=1,Mbien)
 777  format(97A8)
      I=1
    5 READ(1,*,END=100)(X(I,J),J=1,Mbien)
      I=I+1
      IF(I-MMAX) 5,5,100
  100 N=I-1
      CLOSE(1)
C...STOP IF SAMPLE SIZE TOO SMALL
!      if(n.le.Mbien+2)goto 2110
C
C...MAKE NEW FILE NAME FOR OUTPUT
      LENFIN=INDEX(FIN,' ')-1
	LENFRE=INDEX(FRESHQ2,' ')-1
	WRITE(ST1,'(I2.2)') MONY
	WRITE(ST2,'(I2.2)') NTERM
	ST00 = FIN(1:LENFIN)//'_'//ST1//'_'//ST2//'.TXT'
	ST01 = FRESHQ2(1:LENFRE)//'_'//ST1//'_'//ST2//'.TXT'
C
C...OPEN FILE FOR RESULTS OUTPUT FIRST TIME
C
      Open(3,File=ST00,Status='UNKNOWN')  ! OUTPUT FILE 1

      L=0
      DO 160 J=1,Mbien
      DO 160 I=1,N
      L=L+1
      X1(L)=X(I,J)
  160 CONTINUE

C      prc=0.01                ! SHOULD BE CHANGED

      PRINT*,' HQTB: CALCULATE REGRESSION COEFFICIENTS...'
      CALL HQ(N,Mbien,1,PRC,X1,IDX)

C==========================================================
      DO J=1,MMAX
         IF (NSTEPS(J,4).EQ.-999) GOTO 2001
      ENDDO
 2001 NN=J-1
C
C...OPEN FILE FOR RESULTS OUTPUT SECOND TIME
C
!!!      OPEN(30,FILE=ST01,STATUS='UNKNOWN') ! OUTPUT FILE 2

      IF (NN.LE.0) THEN
	   PRINT*,' THERE ARE NO ANY RESULT ... FULL STOP !!!'
	   STOP
	ENDIF
C==========================================================
      PRINT*,' HQTB: WRITE OUT RESULTS...'
      WRITE(3,'(//A70)') TIEUDE
      WRITE(3,'(/10X,"              DU BAO THANG ",I2)') 
     &                              MONY
      WRITE(3,2) N,MBIEN
   2  FORMAT(10X,'Dung luong mau=',I5/
     &       10X,'       So bien=',I5)
      WRITE (3,5000)
 5000  FORMAT(/10X,'Ten bien',3x,'So TT bien',4X,'Trung binh',
     *4X,'Do lenh chuan')
      DO 105 I=1, 1 ! MBIEN
  105 WRITE(3,6000) Ten(i),I,XMEAN(I),DX(I)
 6000 FORMAT (10X,A,5x,I4,4X,F10.2,6X,F10.2)
C==========================================================
      K=NSTEPS(NN,4)
      WRITE(3,"(/' No ','  FISHER-F','  SAI SO S',' HSTQBOI R',
     &           '    HSO A0',30A10)") (TEN(LS(K,J)),J=1,K)!(TEN(J),J=2,MBIEN) 
      DO I=1,NN
         K=NSTEPS(I,4)
	   HSO='      ----'
	   DO J=1,K
	      WRITE(HSO(LS(I,J)),'(F10.4)') BS(I,J)
	   ENDDO
         WRITE(3,300) K,ANSS(I,7),ANSS(I,8),ANSS(I,6),ANSS(I,9),
     &                 (HSO(LS(I,J)),J=1,K)!(HSO(J),J=2,MBIEN)
      ENDDO
  300 FORMAT(1X,I3,4F10.4,30A10)
C...WRITE OUT FOR POST-PROCESSING
C...LATSEST STEP OF RESULTS IS REQUESTED
C
      IF (NN.GT.10) THEN    ! LAY TOI DA 10 BIEN TRONG PHUONG TRINH
	   PRC = PRC + 0.001
	   GOTO 1234
	ELSE IF (NN.LT.6) THEN ! LAY KHONG IT HON 6 BIEN
	   PRC = PRC - 0.001
	   GOTO 1234
	ENDIF

      OPEN (31, FILE=FRESHQ3, STATUS='UNKNOWN',ACCESS='APPEND')
!	WRITE (31,*)'----------------------------'
!	WRITE (31,'(" HS TQBOI:",F10.4)') ANSS(NN,6)
	WRITE (31,'(4I4," SAI_SO_S:",F10.4)') VUNG,YEUTO,MONY,NTERM,
	&                                      ANSS(NN,8)
	WRITE (31,'(4I4," HE_SO_A0:",F10.4)') VUNG,YEUTO,MONY,NTERM,
	&                                      ANSS(NN,9)
      DO I=2,MBIEN
	   WRITE (31,'(4I4,2A10)')VUNG,YEUTO,MONY,NTERM,TEN(I),HSO(I)
	ENDDO
  555	CONTINUE
C==========================================================
      STOP ' PROGRAM NORMAL TERMINAL....'
 2110 Continue   
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE HQ(N,M,NS,PCT,X,IDX)
      INCLUDE 'HQTB.INC'       ! DUNG LUONG MAU VA SO BIEN CUC DAI
      DIMENSION X(NMAX*MMAX/2),XBAR(MMAX),STD(MMAX),D(MMAX),
     &          B(MMAX),IDX(MMAX),L(MMAX),
     &          RX(MMAX*MMAX),R(MMAX*MMAX),NSTEP(5),ANS(11),T(MMAX)
      Character *8 Ten(MMAX)
      Common Ten
	REAL XMEAN(MMAX),DX(MMAX),PCT
	COMMON /OUT1/ XMEAN,DX

!!      Write(3,500) Ten(1)
!! 500  Format(//10X,'  HOI QUI GIUA ',A,' VA CAC YEU TO')
!!      Write(3,501) (Ten(i),i=2,M)
!! 501  Format(5X,50A)
!!      WRITE(3,2) N,M
!!   1  FORMAT(20X,'Hoi quy tung buoc')
!!   2  FORMAT(20X,'Dung luong mau',I5/10X,'So bien',7X,I5)
      IO=1
      CALL CORRE(N,M,IO,X,XBAR,STD,RX,R,B,D,T)
!!      WRITE (3,5)
!!   5  FORMAT(/10X,'Ten bien',3x,'So TT bien',4X,'Trung binh',
!!     *4X,'Do lenh chuan')
      DO 105 I=1,M
	   XMEAN(I)=XBAR(I)
	   DX(I)=STD(I)
  105 CONTINUE
!!  105 WRITE(3,6) Ten(i),I,XBAR(I),STD(I)
!!   6  FORMAT (10X,A,5x,I4,4X,F10.2,6X,F10.2)
      IF(NS)135,135,140
  135 CONTINUE
!!  135 WRITE(3,9)
!!   9  FORMAT(/20X,'So chon NS khong xac dinh. CHAM DUT cong viec')
      GoTO 200
  140 CONTINUE
!!  140 CALL MSTR(RX,R,M,0,1)
      NSEL=1
      GOTO 150
  145 CALL MSTR(R,RX,M,1,0)
  150 CONTINUE
C      WRITE(3,10)NSEL
C   10 FORMAT(//10X,'Lan chon thu',I10)
      N35=0
      DO 155 K=1,M
      IF (IDX(K))152,153,153
  152 CONTINUE
!!  152 WRITE(3,11)K,NSEL
!!   11 FORMAT(20X,'Chi so bien thu',I5,2X,'Am o lan chon thu',I5)
      GOTO 185
  153 IF(IDX(K)-3)155,154,152
  154 N35=N35+1
  155 CONTINUE
      IF (N35-1)156,157,156
  156 CONTINUE
C      WRITE(3,12)NSEL
C   12 FORMAT(20X,'Lan chon thu',I4,2X,'So bien phu thuoc khac 1')
      GOTO 185
  157 CALL STEP(M,N,RX,XBAR,IDX,PCT,NSTEP,ANS,L,B,STD,TT,D,IER)

c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  160 CONTINUE
!!  160 WRITE(3,*)'                    Bang phan du '
!!      WRITE(3,*)'      Mau  Gia tri Y  Uoc luong cua Y  Phan du'
      MM=NSTEP(1)
      DO 180 I=1,N
      DO 181 J=1,M
      JJ=N*(j-1)+I
  181 D(J)=X(JJ)
      YEST=ANS(9)
      K=NSTEP(4)
      DO 170 J=1,K
      KK=L(J)
  170 YEST=YEST+B(J)*D(KK)
      RESI=D(MM)-YEST
  180	CONTINUE
!! 180  WRITE(3,15)I,D(MM),YEST,RESI
!!  15  FORMAT(1X,I8,F11.3,F17.3,F9.3)
c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  185 IF(NSEL-NS)190,200,200
  190 NSEL=NSEL+1
      GOTO 145
  200 CONTINUE
      return
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE CORRE(N,M,I0,X,XBAR,STD,RX,R,B,D,T)
      INCLUDE 'HQTB.INC'       ! DUNG LUONG MAU VA SO BIEN CUC DAI
!      DIMENSION X(1),XBAR(1),STD(1),RX(1),R(1),B(1),D(1),T(1)
      DIMENSION X(NMAX*MMAX),XBAR(MMAX),STD(MMAX),RX(MMAX*MMAX),
     &          R(MMAX*MMAX),B(MMAX),D(MMAX),T(MMAX)
C      WRITE(*,*)'  BAT DAU CORRE'
      DO 100 J=1,M
      B(J)=0.
  100 T(J)=0.
      K=(M*M+M)/2
      DO 102 I=1,K
  102 R(I)=0.
      FN=N
      L=0
      IF(I0)105,127,105
  105 DO 108 J=1,M
      DO 107 I=1,N
      L=L+1
  107 T(J)=T(J)+X(L)
      XBAR(J)=T(J)
  108 T(J)=T(J)/FN
      DO 115 I=1,N
      JK=0
      L=I-N
      DO 110 J=1,M
      L=L+N
      D(J)=X(L)-T(J)
  110 B(J)=B(J)+D(J)
      DO 115 J=1,M
      DO 115 K=1,J
      JK=JK+1
  115 R(JK)=R(JK)+D(J)*D(K)
      GOTO 205
  127 IF(N-M)130,130,135
  130 KK=N
      GOTO 137
  135 KK=M
  137 DO 140 I=1,KK
      CALL DATA(M,D)
      DO 140 J=1,M
      T(J)=T(J)+D(J)
      L=L+1
  140 RX(L)=D(J)
      FRR=KK
      DO 150 J=1,M
      XBAR(J)=T(J)
  150 T(J)=T(J)/FRR
      L=0
      DO 180I=1,KK
      JK=0
      DO 170 J=1,M
      L=L+1
  170 D(J)=RX(L)-T(J)
      DO 180 J=1,M
      B(J)=B(J)+D(J)
      DO 180 K=1,J
      JK=JK+1
  180 R(JK)=R(JK)+D(J)*D(K)
      IF(N-KK) 205,205,185
  185 KK=N-KK
      DO 200 I=1,KK
      JK=0
      CALL DATA(M,D)
      DO 190 J=1,M
      XBAR(J)=XBAR(J)+D(J)
      D(J)=D(J)-T(J)
  190 B(J)=B(J)+D(J)
      DO 200 J=1,M
      DO 200 K=1,M
      JK=JK+1
  200 R(JK)=R(JK)+D(J)*D(K)
  205 JK=0
      DO 210 J=1,M
      XBAR(J)=XBAR(J)/FN
      DO 210 K=1,J
      JK=JK+1
  210 R(JK)=R(JK)-B(J)*B(K)/FN
      JK=0
      DO 220 J=1,M
      JK=JK+J
  220 STD(J)=SQRT(ABS(R(JK)))
      DO 230 J=1,M
      DO 230 K=J,M
      JK=J+(K*K-K)/2
      L=M*(J-1)+K
      RX(L)=R(JK)
      L=M*(K-1)+J
      RX(L)=R(JK)
      IF(STD(J)-STD(K)) 225,222,225
  222 R(JK)=1.
      GOTO 230
  225 STD2=STD(J)*STD(K)
      R(JK)=R(JK)/STD2
C 225 R(JK)=R(JK)/(STD(J)*STD(K))
C     WRITE(3,500) R(JK)
C500  FORMAT(5X,F10.4)
  230 CONTINUE
C     WRITE(*,*)' Dung luong mau=',fn
      FN=SQRT(FN-1.)
      DO 240 J=1,M
  240 STD(J)=STD(J)/FN
      L=-M
      DO 250 I=1,M
      L=L+M+1
  250 B(I)=RX(L)
C      WRITE(*,*)'  KET THUC CORRE'
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE DATA(M,D)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE LOC(I,J,IR,N,M,MS)
      IX=I
      JX=J
      IF (MS-1)10,20,30
   10 IRX=N*(JX-1)+IX
      GOTO 36
   20 IF(IX-JX)22,24,24
   22 IRX=IX+(JX*JX-JX)/2
      GOTO 36
   24 IRX=JX+(IX*IX-IX)/2
      GOTO 36
   30 IRX=0
      IF(IX-JX)36,32,36
   32 IRX=IX
   36 IR=IRX
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE MSTR(A,R,N,MSA,MSR)
      DIMENSION A(1),R(1)
C      WRITE(*,*) ' Bat dau MSTR'
      DO 20 I=1,N
      DO 20 J=1,N
      IF(MSR)5,10,5
    5 IF(I-J)10,10,20
   10 CALL LOC(I,J,IR,N,N,MSR)
      IF (IR)20,20,15
   15 R(IR)=0
      CALL LOC(I,J,IA,N,N,MSA)
      IF(IA)20,20,18
   18 R(IR)=A(IA)
   20 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE STEP(M,N,D,XBAR,IDX,PCT,NSTEP,ANS,L,B,S,T,LL,IER)
      INCLUDE 'HQTB.INC'       ! DUNG LUONG MAU VA SO BIEN CUC DAI
      DIMENSION D(MMAX*MMAX),XBAR(MMAX),IDX(MMAX),NSTEP(5),ANS(11),
     &          L(MMAX),B(MMAX),S(MMAX),
     &          T(MMAX)
      REAL LL(MMAX)
C      DIMENSION D(1),XBAR(1),IDX(1),NSTEP(1),ANS(1),L(1),B(1),S(1)
C     *,T(1),LL(1)
C      WRITE(*,*) ' Bat dau STPRG'
      IER=0
      ONM=N-1
      NFO=0
      NSTEP(3)=0
      ANS(3)=0
      ANS(4)=0
      NSTOP=0
      DO 30 I=1,M
      LL(I)=1
      IF(IDX(I))30,30,10
   10 IF(IDX(I)-2)15,20,25
   15 NFO=NFO+1
      IDX(NFO)=I
      GOTO 30
   20 NSTEP(3)=NSTEP(3)+1
      LL(I)=-1
      GOTO 30
   25 MY=I
      NSTEP(1)=MY
      LY=M*(MY-1)
      LYP=LY+MY
      ANS(5)=D(LYP)
   30 CONTINUE
      NSTEP(2)=NFO
      MX=M-NSTEP(3)-1
      DO 140 NL=1,MX
      RD=0
      IF(NL-NFO) 35,35,55
   35 DO 50 I=1,NFO
      K=IDX(I)
      IF(LL(K))50,50,40
   40 LYP=LY+K
      IP=M*(K-1)+K
      RE=D(LYP)**2/D(IP)
      IF(RD-RE) 45,50,50
   45 RD=RE
      NEW=K
   50 CONTINUE
      GOTO 75
   55 DO 70 I=1,M
      IF(I-MY) 60,70,60
   60 IF(LL(I))70,70,62
   62 LYP=LY+I
      IP=M*(I-1)+I
      RE=D(LYP)**2/D(IP)
      IF(RD-RE) 64,70,70
   64 RD=RE
      NEW=I
   70 CONTINUE
   75 IF(RD) 77,77,76
   76 IF(ANS(5)-(ANS(3)+RD))77,77,78
   77 IER=1
      GOTO 150
   78 RE=RD/ANS(5)
      IF(RE-PCT) 150,80,80
   80 LL(NEW)=0
      L(NL)=NEW
      ANS(1)=RD
      ANS(2)=RE
      ANS(3)=ANS(3)+RD
      ANS(4)=ANS(4)+RE
      NSTEP(4)=NL
      NSTEP(5)=NEW
   85 ANS(6)=SQRT(ANS(4))
      RD=NL
      RE=ONM-RD
      RE=(ANS(5)-ANS(3))/RE
      ANS(7)=(ANS(3)/RD)/RE
   90 CONTINUE
      IF (RE.GE.0) THEN
         ANS(8)=SQRT(RE)
	ELSE
	   ANS(8)=-999
	ENDIF
C   90 ANS(8)=SQRT(RE)
      IP=M*(NEW-1)+NEW
      RD=D(IP)
      LYP=NEW-M
      DO 100 J=1,M
      LYP=LYP+M
      IF(LL(J))100,94,97
   94 IF(J-NEW) 96,98,96
   96 IJ=M*(J-1)+J
      D(IJ)=D(IJ)+D(LYP)*D(LYP)/RD
   97 D(LYP)=D(LYP)/RD
      GOTO 100
  98  D(IP)=1/RD
  100 CONTINUE
      LYP=LY+NEW
      B(NL)=D(LYP)
      IF(NL-1)112,112,105
  105 ID=NL-1
      DO 110 J=1,ID
      IJ=NL-J
      KK=L(IJ)
      LYP=LY+KK
      B(IJ)=D(LYP)
      DO 110 K=1,J
      IK=NL-K+1
      MK=L(IK)
      LYP=M*(MK-1)+KK
  110 B(IJ)=B(IJ)-D(LYP)*B(IK)
  112 ANS(9)=XBAR(MY)
      DO 115 I=1,NL
      KK=L(I)
      ANS(9)=ANS(9)-B(I)*XBAR(KK)
      IJ=M*(KK-1)+KK
  114 S(I)=ANS(8)*SQRT(D(IJ))
  115 T(I)=B(I)/S(I)
      IP=M*(NEW-1)
      DO 130 I=1,M
      IJ=I-M
      IK=NEW-M
      IP=IP+1
      IF(LL(I)) 130,130,120
  120 DO 126J=1,M
      IJ=IJ+M
      IK=IK+M
      IF(LL(J)) 126,122,122
  122 IF(J-NEW)124,126,124
  124 D(IJ)=D(IJ)-D(IP)*D(IK)
  126 CONTINUE
      D(IP)=D(IP)/(-RD)
  130 CONTINUE
      RD=N-NSTEP(4)
      RD=ONM/RD
  132 ANS(10)=SQRT(1-(1-ANS(6)**2)*RD)
  134 IF(RD.GE.0) GOTO 905
      ANS(11)=999.
      GOTO 906
  905 ANS(11)=ANS(8)*SQRT(RD)
  906 CONTINUE
      CALL INHQ(NSTEP,ANS,L,B,S,T,NSTOP)
      IF (NSTEP(4).GE.10) NSTOP = 1       ! LAY TOI DA 10 BUOC

      IF (NSTOP) 140,140,150
  140 CONTINUE
  150 RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE INHQ(NSTEP,ANS,L,B,S,TT,NSTOP)
      INCLUDE 'HQTB.INC'       ! DUNG LUONG MAU VA SO BIEN CUC DAI
!      DIMENSION NSTEP(5),ANS(11),L(1),B(1),S(1),TT(1)
      DIMENSION NSTEP(5),ANS(11),L(MMAX),B(MMAX),S(MMAX),TT(MMAX)
      Character *8 Ten(MMAX)
      Common Ten

      INTEGER NSTEPS(MMAX,5), LS(MMAX,MMAX),KSTEP
      REAL BS(MMAX,MMAX), ANSS(MMAX,11)
      COMMON /OUT/ NSTEPS,ANSS,LS,BS,KSTEP

      KSTEP=KSTEP+1
      DO I=1,5
         NSTEPS(KSTEP,I)=NSTEP(I)
      ENDDO
      DO I=1,11
         ANSS(KSTEP,I)=ANS(I)
      ENDDO
      DO I=1,MMAX
         LS(KSTEP,I)=L(I)
         BS(KSTEP,I)=B(I)
      ENDDO

!!      WRITE (3,1)NSTEP(4)
!!   1  FORMAT(5X,'Buoc thu ',I5)
!!      WRITE(3,4)ANS(6)
!!   4  FORMAT(/5X,'He so T.quan boi',F10.5)
!!      WRITE(3,5)ANS(7)
   5  FORMAT(5X,'Gia tri F de phan tich phuong sai',F10.3)
C      WRITE(3,6)ANS(8),ANS(11)
C   6  FORMAT(5X,'Sai so chuan: ',F10.3,5X,'(Chinh theo bac '
C     *,'TD)',F10.3)
!!      WRITE(3,6)ANS(8)
!!   6  FORMAT(5X,'Sai so chuan: ',F10.3)
!!      WRITE(3,7)
C   7  FORMAT(5X,'Bien thu',5X,'He so hoi quy',5X,'Sai so chuan cua HSHQ
!!   7  FORMAT(5X,'Bien thu',2x,'Ten Bien',5X,'He so hoi quy')
C     *',5X,'Gia tri tinh toan T')
      K=NSTEP(4)
C      DO 20 I=1,K
C   20 WRITE(3,8)L(I),B(I),S(I)
C   20 WRITE(3,8)L(I),B(I)
C    ,TT(I)
!!      DO 20 I=1,K
!!   20 WRITE(3,8)I,Ten(L(I)),B(I)
!!    8 FORMAT(5X,I6,4x,A8,6X,F10.3,10X,F15.3,10X,F10.3)
!!      WRITE(3,9)ANS(9)
!!    9 FORMAT(5X,'He so tu do',F10.3/)
C    8 FORMAT(5X,I7,6X,F10.3,10X,F15.3,10X,F10.3)
C      WRITE(3,9)ANS(9)
C    9 FORMAT(5X,'He so tu do',F10.3/)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE INITIAL
C
C...CHUONG TRINH NAY DOC CAC NAMELIST TU FILE INPUT_HQTB
C...DE XAC DINH CAC FILE SO LIEU BAN DAU:
C
C   NFILE: SO FILE CO THE CO CHUA SO LIEU BAN DAU
C   NYEAR: SO NAM CO THE CO SO LIEU
C   NMO:   SO THANG (SO COT TRONG TUNG FILE SL), KE CA TONG/TB NAM
C   NFIN2: BIEN CHUA SO FILE THUC CO
C   MONY:  THANG DUOC DUNG LAM BIEN PHU THUOC CUA BIEN DU BAO
C   MONX:  THANG DUOC DUNG LAM BIEN DOC LAP CUA NHAN TO DU BAO
C   IDX:   MANG CHI SO CHI THI LOAI BIEN:
C          = 3 - BIEN PHU THUOC
C          = 2 - BIEN DOC LAP BI LOAI
C          = 1 - BIEN DOC LAP BAT BUOC DUA VAO PHUONG TRINH
C          = 0 - BIEN DOC LAP CHUONG TRINH TU DONG LUA CHON
C   FIN1:  TEN FILE CHUA SO LIEU BIEN PHU THUOC
C   FIN2:  TEN CUA NFIN2 FILE CHUA SO LIEU BIEN DOC LAP
C   FOUT:  TEN FILE KET XUAT CHO CHUONG TRINH HQTB
C   FRESHQ1: TEN FILE KET QUA HOI QUI (DANG TUNG BUOC)
C   FRESHQ2  TEN FILE KET QUA HOI QUI (DANG BANG)
C   TENBIEN: TEN BIEN THAM GIA HOI QUI, KE CA BIEN PHU THUOC
C
C...CAU TRUC CAC FILE SO LIEU CO DANG NHU SAU:
C   DONG 1: TIEU DE MO TA FILE DU LIEU
C   DONG 2: CHUA 3 SO NGUYEN (NYEAR, YEAR_STAT, YEAR_STOP)
C           CHI SO NAM CO SO LIEU, NAM BAT DAU, NAM KET THUC
C   DONG 3: TIEU DE CHI CAC THANG
C   DONG 4 TRO DI, MOI DONG GOM:
C                  COT 1: CHI THU TU NAM
C                  COT 2-COT THU (NMO) (=12 HOAC 13) SO LIEU
C                       CAC THANG 1-12 HOAC THEM SO LIEU NAM
C   CO THE CO DONG CUOI CUNG GHI THONG TIN THEM NHUNG KHONG DUOC DOC
C
C   DATA INPUT:  NFIN2+1 FILE
C   DATA OUTPUT: 1 FILE
C
      INCLUDE 'HQTB.INC'       ! DUNG LUONG MAU VA SO BIEN CUC DAI
      PARAMETER (NFILE=NFILEMAX,NYEAR=150,NMO=12)
	INTEGER NFIN2,MONY,NTERM,IDX(MMAX),NOW, NMON, IDXENSO
      CHARACTER *70 FIN1,FIN2(NFILE),FOUT,FRESHQ1,FRESHQ2
	CHARACTER*70 FN,FHQ1,FHQ2,TIEUDE
	CHARACTER TENBIEN(MMAX)*6, VARN(NFILE+1)*4
	REAL PRC
	COMMON /PRCCONST/ PRC
      NAMELIST /NFINP2/ NFIN2
     1         /FINP/ FIN1,FIN2
     2         /FOUTP/ FOUT
	3         /MONTH/ NOW, NMON ! NOW=1: THIS YEAR, =0 PREVIOUS YEAR
	4         /VARNAME/ VARN				  !TENBIEN
	5         /FRESULT/ FRESHQ1,FRESHQ2
	6         /PRCONST/ PRC
	7         /ENSOCO/  IDXENSO

      REAL X(1:NYEAR,0:NMO,1:NFILE),Y(1:NYEAR,0:NMO),XX(NYEAR,0:MMAX)

	INTEGER YMN,YMX,NMX, YMNENSO,YMXENSO, IDK(NMO)
      COMMON /FNAME/ FN,FHQ1,FHQ2
	COMMON /MONXMONY/ MONY,NTERM,TIEUDE
	PARAMETER (YMNENSO=1868, YMXENSO=2000)
	INTEGER  ENSO(YMNENSO:YMXENSO)
	DATA ENSO /1,-1, 0,-1,-1,-1,-1,-1, 0, 1, 0, 0, 1, 0, 0, 
	1           0, 0, 0,-1, 0, 1,-1, 0, 0,-1,-1, 0, 0, 1, 0, 
     2           0, 1, 0, 0, 1,-1, 1, 1,-1, 0,-1,-1,-1, 1, 0, 
     3           1, 0, 0,-1, 0, 1, 0, 0, 0,-1, 0,-1, 1, 0, 0, 
     4           0, 1, 1, 0, 0, 0, 0, 0, 0, 0,-1, 0, 1, 0,-1, 
     5           0,-1, 0, 0, 0, 0,-1, 0, 1, 0, 0,-1,-1,-1, 1, 
     6           0, 0, 0, 0, 0, 1,-1, 1, 0,-1, 0, 1,-1,-1, 1, 
     7          -1, 0,-1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 
     8          -1, 0, 0, 1, 0, 0, 0, 0, 0, 1,-1, 0, 0/	         !132 YEARS

      MONX=0
      OPEN (1,FILE='INPUT_HQ2002.TXT',STATUS='OLD')
	READ (1,PRCONST)
	READ (1,ENSOCO)     ! READ IDXENSO: = 0 - NONE ENSO
      READ (1,NFINP2)		!			    = 1 - EL NINO
	READ (1,FINP)		!               =-1	- LA NINA
      READ (1,FOUTP)		!				=-999 - ALL
      READ (1,FRESULT)
      READ (1,MONTH)
	READ (1,VARNAME)

	CLOSE(1) 

      FN=FOUT
	FHQ1=FRESHQ1
	FHQ2=FRESHQ2

	CALL MAKEIDK (MONY, NTERM, IDK, IY)

      YMN=-99999
	YMX= 99999
	NMX=0
	X=-999.
	Y=-999.
	IDX=0           ! SET IDX = 0 AS DEFAULT VALUES
	IDX(1)=3        ! DEPENDENT VARIABLE, MUST BE EQUAL TO 3
      TENBIEN=''
	TENBIEN(1)='  '//VARN(1)
	J=1
	DO K=2,NFIN2+1
         DO I=1,NMON
	      J=J+1
	      WRITE(TENBIEN(J),'(I2.2)') I
	      TENBIEN(J)=VARN(K)//TENBIEN(J)
	   ENDDO
	ENDDO
      DO K=1,NFIN2
         OPEN (1,FILE=FIN2(K),STATUS='OLD')
         READ (1,*) 
         READ (1,*) N,NYM,NYX
         READ (1,*)
         DO I=1,N
	      READ (1,*) (X(I,J,K),J=0,NMO)   ! CHI DOC 12 THANG
         ENDDO
	   IF (YMN.LT.NYM) YMN=NYM
	   IF (YMX.GT.NYX) YMX=NYX
         IF (NMX.LT.N)   NMX=N
	   CLOSE(1)
	ENDDO

      OPEN (1,FILE=FIN1,STATUS='OLD')
      READ (1,'(A70)') TIEUDE
      READ (1,*) N,NYM,NYX
      READ (1,*)
      DO I=1,N
         READ (1,*) (Y(I,J),J=0,NMO)   ! DOC 12 THANG
      ENDDO
      IF (YMN.LT.NYM) YMN=NYM
      IF (YMX.GT.NYX) YMX=NYX
      IF (NMX.LT.N)   NMX=N
      CLOSE(1)

      MVAR=NMON*NFIN2
      IF (NOW.EQ.1) THEN     ! SU DUNG SO LIEU DU BAO DE DU BAO (CUNG NAM)
	PRINT*,'YMN,YMX=',YMN,YMX
	DO I=YMN,YMX
         DO II=1,NMX
	      IF (NINT(Y(II,0)).EQ.I) THEN
		     XX(I-YMN+1,0)=Y(II,MONY)      ! VAR Y
	      ENDIF
	      DO K=1,NFIN2
	         IF (NINT(X(II,0,K)).EQ.I) THEN 
	             DO J=1,NMON
	                JJ=(K-1)*NMON+J
		            XX(I-YMN+1,JJ)=X(II,J,K)
	             ENDDO
	         ENDIF 
	      ENDDO
	   ENDDO
	ENDDO

	ELSE IF (NOW.EQ.0) THEN     ! SU DUNG SO LIEU NA TRUOC DE DU BAO

	YMX=YMX-IY                   ! REDUCE IY YEAR
	DO I=YMN,YMX
         DO II=1,NMX
	      IF (NINT(Y(II,0)).EQ.I+IY) THEN
		     XX(I-YMN+1,0)=Y(II,MONY)     ! VAR Y
!	      ENDIF	!!
	      DO K=1,NFIN2
!	         IF (NINT(X(II,0,K)).EQ.I) THEN 
	             DO J=1,NMON
	                JJ=(K-1)*NMON+J
		 	        XX(I-YMN+1,JJ)=X(II-IY+IDK(J),J,K)
	             ENDDO
!	         ENDIF 
	      ENDDO
	      ENDIF !!
	   ENDDO
	ENDDO

	ENDIF

      OPEN (3,FILE=FOUT,STATUS='UNKNOWN')
	WRITE(3,'(I4)') MVAR+1
	WRITE(3,'(97I8)') (IDX(I),I=1,MVAR+1)
	WRITE(3,*)
	WRITE(3,'(97A8)') (TENBIEN(I),I=1,MVAR+1)
	PRINT*,'MVAR=',MVAR
	IF (IDXENSO.EQ.-999) THEN  ! ALL CASES
	   DO I=1,YMX-YMN+1
	      WRITE(3,'(97F8.2)') (XX(I,K),K=0,MVAR)
	   ENDDO
	ELSE IF (IDXENSO.EQ.-1) THEN  ! LA NINA
	   DO I=1,YMX-YMN+1
	      IF (ENSO(YMN+I-1).EQ.-1) THEN
	         WRITE(3,'(97F8.2)') (XX(I,K),K=0,MVAR)
	      ENDIF
	   ENDDO
	ELSE IF (IDXENSO.EQ.1) THEN  ! EL NINO
	   DO I=1,YMX-YMN+1
	      IF (ENSO(YMN+I-1).EQ.1) THEN
	         WRITE(3,'(97F8.2)') (XX(I,K),K=0,MVAR)
	      ENDIF
	   ENDDO
	ELSE IF (IDXENSO.EQ.0) THEN  ! NONE ENSO
	   DO I=1,YMX-YMN+1
	      IF (ENSO(YMN+I-1).EQ.0) THEN
	         WRITE(3,'(97F8.2,I6)') (XX(I,K),K=0,MVAR) !, YMN+I-1
	      ENDIF
	   ENDDO
	ENDIF
      CLOSE(3)
	RETURN
      END

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      SUBROUTINE MAKEIDK (MON, NTERM, IDK, IY)
C...TAO MANG CHI SO IDK(1..12)
C...INPUT: MON: THANG DUOC TINH
C          NTERM: HAN DU BAO
C...OUTPUT: IDX(12) ===>
C                      IDK(I) = 0 : LAY TU NAM DAU TIEN DEN NAM THU (N-IY)
C                             = 1 :     -- 	 THU 1       ---      ---
C                             = 2 :     --         2
C           IY : SO NAM TRU RA KE TU NAM THU NHAT TRONG CHUOI Y

	INTEGER IDK(12)
	INTEGER NTERM, MON, IY, I

	I=MON-NTERM-1

	IF (I.NE.0) THEN
	   IY=2
	ELSE
	   IY=1
      ENDIF

	IF (I.GT.0) THEN
	   K=I
	ELSE
	   K=12+I
	ENDIF
	PRINT*,'MON=',MON,' TERM=',NTERM,' START=',K
	DO J=1,12
	   IF (J.LE.K) THEN
	      IDK(J)=IY-1
	   ELSE 
	      IDK(J)=IY-2
	   ENDIF
	ENDDO

!	PRINT '("     ",12I5)',(J,J=1,12)
!	PRINT '(14I5)', IY,IDK
!	PAUSE
	RETURN
	END