      SUBROUTINE EXCHAN(NTSD,IDAT)

      PARAMETER (IM=111,JM=221,LM=38,LSM=19)
      PARAMETER (LDA=LM+9,LA=13)      
C
      PARAMETER (
     &  IMJM=IM*JM-JM/2,JMP1=JM+1,JAM=6+2*(JM-10),LB=2*IM+JM-3
     &, LM1=LM-1,LP1=LM+1,L3=LDA+LM+1,L4=LDA+2*LM+1,L7=L4+3
     &, LSCRCH=4*LM+1+LA+1)
      PARAMETER (IMT=2*IM-1)
      PARAMETER (KHL00=1,KHH00=IMJM)
C       
      P A R A M E T E R
     1 (IFM=53,JFM=45)
C      
      PARAMETER (KMAX = LM  ,      KMAX1=KMAX+1)
      PARAMETER (KMIN = LM-KMAX,   KTOP =KMIN+1)
      PARAMETER (IMAX =2*IM-1,     JMAX =JM)
      PARAMETER (IMAXI=IMAX-2,     JMAXI=JMAX-2)
      PARAMETER (IMAXD =IMAXI/2+1, JMAXD =JMAXI/2+1) 
      PARAMETER (KKMAX = KMAX)       
C-----------------------------------------------------------------------
                             C O M M O N /GRIDS/
     1 FMLAT(IFM,JFM),FMLON(IFM,JFM),ALAT(IFM,JFM),ALON(IFM,JFM)
     2,HLAT(IMJM),HLON(IMJM),VLAT(IMJM),VLON(IMJM)
     3,KH1FM(IFM,JFM),KH2FM(IFM,JFM),KV1FM(IFM,JFM),KV2FM(IFM,JFM)
     4,IFMHE(IMJM),JFMHE(IMJM)
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
                             C O M M O N /DYNAM/
     & DY,CPGFV,EN,ENT,R,PT,F4D,F4Q,EF4T
     &,DETA(LM),RDETA(LM),AETA(LM),F4Q2(LM),ETA(LP1),DFL(LP1)
C
     &,EM    (JAM),EMT   (JAM)
C
     &,DX    (IMJM),WPDAR (IMJM),CPGFU (IMJM),CURV  (IMJM),FCP   (IMJM)
     &,FDIV  (IMJM),FAD   (IMJM),F     (IMJM),DDMPU (IMJM),DDMPV (IMJM)
C-----------------------------------------------------------------------

C-----------------------------------------------------------------------
                             C O M M O N /VRBLS/
     & PD(IMJM),RES(IMJM),FIS(IMJM)
C
     &,U(IMJM,LM),V(IMJM,LM),T(IMJM,LM),Q(IMJM,LM)
C----------------------------------------------------------------------- 
C-----------------------------------------------------------------------
                             C O M M O N /MASKS/
     & HBM2  (IMJM),VBM2  (IMJM),VBM3  (IMJM),SM    (IMJM),SICE (IMJM)
C
     &,HTM   (IMJM,LM),VTM   (IMJM,LM)
C-----------------------------------------------------------------------
C      COMMON/ETADOT/DEDT(IMJM,LM),DEDT2(IMJM,LM) 
      DIMENSION IDAT(3)
      COMMON/ETATM/ ETADO(IMJM,LM),ETAZ(IMJM,LP1),
     *             ETAKH(IMJM,LM1),ETAKHS(IMJM),
     *             ETAPR(IMJM),ETACPR(IMJM)      
      
      DIMENSION WORK(IMJM)
      
      COMMON/ETATRN/
     * QQL(IMJM,KKMAX),QQH(IMJM,KKMAX),      
     * PS(IMJM,2), QQ(IMJM,KKMAX,2),    
     * UU(IMJM,KKMAX,2), VV(IMJM,KKMAX,2),
     * WW(IMJM,KKMAX,2), RO(IMJM,KKMAX,2),     
     * TT(IMJM,KKMAX,2), ZZ(IMJM,KKMAX+1,2),
     * ALFA(IMJM,KKMAX,2),
     * DIFQ(IMJM,KKMAX),
     * AKH(IMJM,KKMAX,2),AKHS(IMJM,2),
     * TOPG(IMJM)
     *,PREC(IMJM,2),ACPR(IMJM,2) 
      
      COMMON/TMCTRL/ISTEP,IBSTEP,DTT,
     *  NSTEP,NSWRI,NSFON,
     *  QMIN,VD,CW,IFDAY,QFLX0,
     *  NSSOUR,QCON0,NSOUR,
     *  IREC,IREC1,IREC2,IREC3,IRECF,
     *  AREAX0,AREAY0,NXAREA,NYAREA,
     *  LOGU,DATE2
      CHARACTER*6 DATE2
      LOGICAL LOGU       
      
      COMMON/TIMECP/t1,t2,t3,t4, tt1, tt2      
      REAL*8 t1,t2,t3,t4, tt1, tt2
      REAL*8 t5
      SAVE t5            
C-----------------------------------------------------------------------
CX      WRITE(66,*)'EXCHAN START NTSD=',NTSD
      NTSPH=30
      
      IF(NTSD.EQ.1)RETURN
      
CX      CALL DIPREC(66,NTSD)
      
CX      WRITE(0,*)'EXCHAN: CALL TAPES(0)'
CX      CALL TAPES(0)
      
      IF(NTSD .EQ.5)THEN
      
      WRITE(66,*)'START OF EXCHAN FOR NTSD=5'
      
      CALL PASSAB(PD,IMJM,PS(1,1))
      CALL PASSAB(T,IMJM*LM,TT(1,1,1))
      CALL PASSAB(U,IMJM*LM,UU(1,1,1))
      CALL PASSAB(V,IMJM*LM,VV(1,1,1))
      CALL CORW(ETADO,IMJM,LM)      
      CALL PASSAB(ETADO,IMJM*LM,WW(1,1,1))
      CALL PASSAB(ETAZ,IMJM*(LM+1),ZZ(1,1,1))
      CALL PASSAB(ETAKH,IMJM*LM,AKH(1,1,1))               
      CALL PASSAB(ETAKHS,IMJM,AKHS(1,1))
      CALL PASSAB(ETAPR,IMJM,PREC(1,1))
      CALL PASSAB(ETACPR,IMJM,ACPR(1,1))
      ISTEP=0
      t5=0.      
      ENDIF
      
      IF(MOD(NTSD,NTSPH).EQ.0)THEN 
      
      WRITE(0,*)'START OF EXCHAN FOR NTSD=',NTSD      
                      
      CALL PASSAB(PD,IMJM,PS(1,2))
      CALL PASSAB(T,IMJM*LM,TT(1,1,2))
      CALL PASSAB(U,IMJM*LM,UU(1,1,2))
      CALL PASSAB(V,IMJM*LM,VV(1,1,2))
      CALL CORW(ETADO,IMJM,LM)     
      CALL PASSAB(ETADO,IMJM*LM,WW(1,1,2)) 
      CALL PASSAB(ETAZ,IMJM*(LM+1),ZZ(1,1,2))
      CALL PASSAB(ETAKH,IMJM*LM,AKH(1,1,2))               
      CALL PASSAB(ETAKHS,IMJM,AKHS(1,2))
      CALL PASSAB(ETAPR,IMJM,PREC(1,2))
      CALL PASSAB(ETACPR,IMJM,ACPR(1,2)) 
              
      ISTEP=ISTEP+1
C
      ICL=1           !  Warnig: for debug            
      CALL TM2(ISTEP,NTSD,IDAT,ICL)
      t5=t5+t4-t3
C
C      IF(ISTEP.EQ.2*NSTEP)THEN               ! for 2 day 
      IF(ISTEP.EQ.NSTEP)THEN                ! for 1 day       
      write(66,102) t5
      STOP           
102   format('CPU TIME for calculation: ',f10.4,' sec')      
      ENDIF
C      
      ENDIF
      
      RETURN
      END