SUBROUTINE CHSIN90(TSTORM,CAPSTK)
!use consts
use global
implicit none  
    
      SAVE
      
      integer :: t1,t2,clock_rate,clock_max
      integer :: i,j,iloc
      real(DP) :: capstk,gcmax,gcij,dtc,dtmax,ifix,tcm,tca,tcend,ack,tt,tst0
      real(DP) :: tst,i1,i2,i21,j1,j2,j21,ic,tstorm
!-----IDIM=26
!-----JDIM=38
!-----IDIMR=20
!-----IDIMLO=121
     ! call system_clock(t1,clock_rate,clock_max)
      CALL FZERO90
     ! call system_clock(t2,clock_rate,clock_max)
      !write(*,*) "fzero time", real(t2 - t1)/real(clock_rate) 

      IND=0
   15 CONTINUE

!********** INPUT
      CALL INDAT290

      CALL INCHS90

      CAPSTK=CAPSTO

      IF(LFPRT.NE.0) CALL UTDAT290

!********** CALCULATION OF NECESSARY FIELDS
      CALL FIELD190

      CALL FIELD290

!********** TIMESTEPS
      CALL DTTST290

      CALL DTLOC90

      GCMAX=.0
      DO 180 I=IVOHSN,IVOHSX
      DO 180 J=JVOHSN,JVOHSX
      GCIJ=GVOHS(I,J)*CIN(I,J)
  180 GCMAX=dMAX1(GCMAX,GCIJ)
      DT=1./(1./DT+GCMAX)
      DTC=0.99*DT
  190 DTMAX=dMIN1(.99*DT,DTOKAY)

      ITR1=idint(TR1/DTMAX)+1
      ITR1M1=ITR1-1
      DT=TR1/ITR1
      IF(LFPRT.NE.0) WRITE(LUW_DST,200) TR1,DT,DTRMAX
  200 FORMAT(' *CHS* ',36(1H+),/,&
      ' TIMESCALE FOR LOCAL TRANSIENTS ',G10.4,/,&
      ' TIMESTEP FOR GLOBAL PROCESS    ',G10.4,/,&
      ' MAX TIMESTEP FOR LOCAL PROCESS ',G10.4,/,&
      ' *CHS* ',36(1H+),/)     
!-----DP OCT 1996
!-----CHECK THE VALUE ITR1
      IF (ITR1.GT.MAXTR1) THEN
        WRITE(LUW1,404) ITR1,MAXTR1
        RETURN
      END IF
  404 FORMAT(' ***ERROR***IN TYPE 60',/,&
     ' THE NUMBER OF GLOBAL TIMESTEP ITR1 (ITR1=',I4,') EXCEEDS THE',&
     /,' MAXIMUM NUMBER ALLOWED (MAXTR1=',I4,').',/,&
     ' IF YOU STILL WANT TO RUN YOUR CASE, INCREASE THE VALUE OF',/,&
     ' "MAXTR1" IN THE "TRNVDST.INC" INCLUDE FILE AND RECOMPILE.')
!-----END DP OCT 1996     
      IFLAGG=1
      TIMGLO=0.
      TIME=-1.0
      QWGMS=0.
      TAHT=0.
      TAT=0.
      QWDEM1=0.
      EPLUS=0.
      DEPLUS=0.
      ENEG=0.
      DENEG=0.
      ETOP=0.
      ESIDE=0.
      EBOT=0.
      TOUT=0.
      QDEM1=0.
      DO 212 ILOC=1,NLOC
      ESUMR(ILOC)=0.
      DO 210 I=1,ITR1
      ESUM(ILOC,I)=0.
  210 CONTINUE
  212 CONTINUE

!-----CAPSTO is calculated by INCHS
!
!========= REFERENCE TEMPERATURE GRADIENT FOR CONSISTENCE CRITERIA
      DTBREF=0.1
      DRBREF=RM(IMAX)-RM(IMAX-1)
      DZBREF=ZM(JMAX)-ZM(JMAX-1)
      DO 33 J=JTZ,JBZ
        IF(ZM(J).GT.ZDMIN*2) GOTO 34
 33   CONTINUE
 34   JREF=J
!
      IF(IND.EQ.0) GO TO 220

      WRITE(LUW1,215) IND
  215 FORMAT('***ERROR*** PROGRAM STOPPED BECAUSE OF ',I2, &
      ' ERROR(S) IN INPUT TO SUBROUTINE STORE')
      RETURN
  220 CONTINUE

!******* PREHEATING OF THE SURROUNDING GROUND
!
      IF(IPRE.EQ.0) GOTO 310
      TCM=0.5*(TCMAX+TCMIN)
      TCA=TCMAX-TCM
      TCEND=FLOAT(IPRE)*31536000.
!     TCPH=-7884000.
      ACK=2*PI/31536000.
      TT=0.
      TST0=TCM+TCA*SIN(ACK*(TT+TCPH))

      DO 299 I=IVOHSN,IVOHSX
      DO 299 J=JVOHSN,JVOHSX
      IF(INVOL(I,J).EQ.0) GO TO 299
      T(I,J)=TST0
      TOLD(I,J)=TST0
  299 CONTINUE

  300 CONTINUE
      DTC=dMIN1(DTC,TCEND-TT)
      TST=TCM+TCA*SIN(ACK*(TT+TCPH))
      DO 48 I=2,IRR
      T(I,JTZ)=TST
   48 T(I,JBZ)=TST
      DO 49 J=JTZ,JBZ
   49 T(IRR,J)=TST

      TAIR=TAIRM+ATAIR*SIN(ACK*(TT+TAPH))
      DO 501 I=1,IMAX
  501 T(I,1)=TAIR

      I1=2
      I2=IMAX
      I21=IMAX1
      J1=2
      J2=JTZ-1
      J21=JTZ
      IC=1
   50 CONTINUE
      DO 60 I=I1,I2
      DO 60 J=J1,J21
      FZ(I,J)=GFZ(I,J)*(T(I,J-1)-T(I,J))
   60 CONTINUE
      DO 70 J=J1,J2
      DO 70 I=I1,I21
      FR(I,J)=GFR(I,J)*(T(I-1,J)-T(I,J))
   70 CONTINUE
      IF(IC.GE.2) GO TO 55
      J1=JBZ1
      J2=JMAX
      J21=JMAX1
      IC=2
      GO TO 50
   55 IF(IC.EQ.3) GO TO 75
      I1=IRR1
      J1=JTZ
      J2=JBZ
      J21=JBZ1
      IC=3
      GO TO 50
   75 CONTINUE

      I1=2
      I2=IMAX
      J1=2
      J2=JTZ-1
      IC=1
   80 CONTINUE
      DO 110 J=J1,J2
      DO 110 I=I1,I2
  110 T(I,J)=T(I,J)+CIN(I,J)*(FZ(I,J)-FZ(I,J+1)+FR(I,J)- &
      FR(I+1,J))*DTC
      IF(IC.GE.2) GO TO 85
      J1=JBZ1
      J2=JMAX
      IC=2
      GO TO 80
   85 IF(IC.EQ.3) GO TO 90
      I1=IRR1
      J1=JTZ
      J2=JBZ
      IC=3
      GO TO 80
   90 CONTINUE
!
!========== CHECK ON ADIABATIC BOUNDARY CONDICTIONS CONSISTENCE
!
      IF(ABS(T(IMAX-1,JREF)-T(IMAX,JREF))/DRBREF.GT.DTBREF.OR. &
        ABS(T(2,JMAX-1)-T(2,JMAX))/DZBREF.GT.DTBREF) THEN

        WRITE(LUW1,111)
  111   FORMAT(//,1X,'** Warning : ',&
            /,15X,'THE STORAGE BOUNDARIES !!!',&
            /,15X,'THE GOVERNING PARAMETER FOR THE MESH GENERATION',&
            /,15X,'MUST BE INCREASED (SY = SIMULATION YEARS).')
        RETURN
      ENDIF
!
      TT=TT+DTC
      IF(TT.LT.TCEND) GO TO 300

      DO 148 I=2,IRR
      T(I,JTZ)=TCMIN
  148 T(I,JBZ)=TCMIN
      DO 149 J=JTZ,JBZ
  149 T(IRR,J)=TCMIN
      DO 95 I=2,IMAX
      DO 95 J=2,JMAX
   95 TOLD(I,J)=T(I,J)

  310 CONTINUE
      CALL TMSTO90

      TSTORM=TMSTOR


RETURN
END subroutine chsin90