      SUBROUTINE TM1(NTSD,IDAT,DT)
C     ---------------------------------------
C                     14/07/99 
C                     02/05/2000 
C                     03/07/2000      
C                     05/01/2001
C     ---------------------------------------
      PARAMETER (IM=111,JM=221,LM=38,LSM=19)      
      PARAMETER (IMJM = IM*JM - JM/2)
      PARAMETER (LP1=LM+1)
      PARAMETER (JAM=6+2*(JM-10))      
      PARAMETER (IMAX=2*IM-1  , JMAX=JM)
      PARAMETER (KKMAX=LM)
      PARAMETER (KMAX=KKMAX)
      PARAMETER (KMIN = LM-KKMAX)
      PARAMETER (KTOP = KMIN + 1)
      PARAMETER (LENIWA=1000)
      REAL PHI0,LAM0
      LOGICAL LOGU

      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)     
            
      PARAMETER (NPOINT=25)      
C
      COMMON/ETAGRD/
     *      XB,DEX,YB,DEY,
     *      COSETA(JM),XETA(IMAX),YETA(JM),
     *      ITMP(NPOINT), JTMP(NPOINT), KTMP(NPOINT)
C     
      COMMON/ETABND/IBND1,IBND2,JBND1,JBND2 
      COMMON/ETAREA/CAREA(IMJM)
      COMMON/CITERB/EPS,MAXIT          
      COMMON/CFINTY/FINTY(30) 
      COMMON/CBFIRE/ICLF1,QFLX1,ARFKM2,FLON1,FLAT1,
     *                     FLON2,FLAT2,FLON3,FLAT3 
C         From TUPI Version
C         ICLF1 = 1 with one fire only
C         ICLF1 = 2 with distribution fires + one fire
C         ICLF1 = 3 with distribution fires only
C                            
C23456789 123456789 123456789 123456789 123456789 123456789 123456789 12
C     DIAGNOSIS ARRAYS
C
      CHARACTER*80 NAMEC
      DIMENSION IDAT(3)           
      DIMENSION IWA(LENIWA)
C-----------------------------------------------------------------------
C      DATA FINTY/0.,0.,0. ,0., 0., 0.,0.,0.,0.,0.,
C     *           0.,0.,0. ,0., 0., 0.,0.,0.,0.,0.,
C     *           0.,0.,0.5,2.0,0.5,0.,0.,0.,0.,0./      
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 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 O M M O N /MAPOT/
     & LSL,IXM,IYM
     &,ISHDE(49)
     &,R,PT,TSPH
     &,WBD,SBD,TLM0D,TPH0D,DLMD,DPHD,CMLD,DP30,X1P,Y1P
     &,DISLP,Z0SLP,SPL(LSM),ALSL(LSM)
     &,DETA(LM),AETA(LM),ETA(LP1),TSHDE(49)
     &,ERLAM0,CPHI0,SPHI0
     &,KUNIT,LUNIT,MUNIT,IUNIT,NUNIT
C-----------------------------------------------------------------------
                             C O M M O N /LOOPS/
     & KHLA  (JAM),KHHA  (JAM),KVLA  (JAM),KVHA  (JAM)
C
     &,KHL2  (JM),KHH2  (JM),KVL2  (JM),KVH2  (JM)
C
     &,LMH   (IMJM),LMV   (IMJM)     
C------------------------------------------------------------------------ 
CDB      COMMON/ICOUNT/NUMSTE,NUMPOI,NUMLEV 
C --------------------------------
C      DIMENSION BUFI(IMJM,2)     ! Buffer for the fires area
C --------------------------------    

      CHARACTER*4 RUN
      CHARACTER*80 S80, NRUN 
      CHARACTER*7 DATE
      CHARACTER*40 RUNAME     

      COMMON/CBT1T2/HINTG(IMJM), HINN(IMJM,KMAX), 
     *              HZM(IMJM,KMAX+1),BUFI(IMJM,2),
     *              QFLUX(IMJM,2) ,EFIREA(IMJM,4),
     *              QSOUR(10),ISOUR(10),JSOUR(10),
     *              XSOUR(10),YSOUR(10),
     *              QFIL(IMJM,KKMAX,2),
     *              IDATCP(3)
C
C                   IDATCP(3)= IM, ID, IY
C     
      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
     
      PARAMETER (NFIL = 10)
      COMMON/DIRICT/DIRTAB(NFIL),IDIR(NFIL) 
      CHARACTER*80   DIRTAB

      COMMON/RECRDS/IREC4                 ! nvp   
          
      CHARACTER*6 DATE2
      CHARACTER*6 DATE3
               
      COMMON/TIMECP/t1,t2,t3,t4, tt1, tt2
      REAL*8 t1,t2,t3,t4, tt1, tt2
C-----------------------------------------------------------------------     
      DATA G /9.81/
      DATA CON/-999.0/
C     ---------------------
C            START
C     ---------------------      
      call clock(t1)
       
      WRITE(66,*)'START TM1 NTSD=',NTSD,'  t1=',t1
      
      RADDEG=3.14159265/180.
      DEG=180./3.14159265
                

      CALL RDDIRS(54)
      CLOSE(54)

      I1=IDIR(1)
      OPEN(54,FILE=DIRTAB(1)(1:I1)//'runpar.x4',         
     *   STATUS='UNKNOWN')

      OPEN(55,FILE=DIRTAB(1)(1:I1)//'runame',
     *   STATUS='UNKNOWN') 
                             
      READ(55,'(A40)')RUNAME 
      WRITE(66,*)'TM1: ',RUNAME 
      REWIND(55)
      CALL READST(55,NRUN,LNRUN)           
      WRITE(66,*)'/////////////////'
      WRITE(66,*)' x4.    Version  ',RUNAME
      WRITE(66,*)'/////////////////' 
   
      CALL READST(54,RUN,LENRUN)
      CALL READI(54,NSTEP)
C
C     Warning: Some problem will be for a last day of month
C                     IENDAY = 32
C
      
      IENDAY=IDAT(2)+NSTEP/30
      IENDAT=(IENDAY*10000+IDAT(1)*100+IDAT(3)-2000)
      I2Y=IDAT(3)-(IDAT(3)/100)*100       
      IENDA2=(           I2Y*10000+IDAT(1)*100+IENDAY)
C     IENDA2=((IDAT(3)-2000)*10000+IDAT(1)*100+IENDAY)   
      WRITE(66,*)'   ///// IDAT  =',IDAT 
      WRITE(66,*)'   ///// NSTEP =',NSTEP     !  30     
      WRITE(66,*)'   ///// IENDAY=',IENDAY    !  17      
      WRITE(66,*)'   ///// IENDAT=',IENDAT    !  171001  171099  last day
      WRITE(66,*)'   ///// IENDA2=',IENDA2    !  011017  991017  last day
           
      CALL READI(54,NSWRI)
      CALL READI(54,NSFON) 
      
      CALL READR(54,QMIN)
      CALL READR(54,EPS)
      CALL READI(54,MAXIT)
      CALL READR(54,VD)
      CALL READR(54,CW)
      CALL READL(54,LOGU)
      
      CALL TR3DATE(IDAT,DATE,DATE2)
      DATE3=DATE2(5:6)//DATE2(3:4)//DATE2(1:2)

      WRITE(66,*)'       INITIAL CONDITION'
      WRITE(66,*)'       ',DATE                 
      WRITE(66,*)'       ',DATE2
      WRITE(66,*)'       ',DATE3
      WRITE(66,*)'       '
      
C      IF(IDAT(3).LT.2000)THEN
C      IDATE=(IDAT(2)*10000+IDAT(1)*100+IDAT(3)-1900)
C      ELSE
C      IDATE=(IDAT(2)*10000+IDAT(1)*100+IDAT(3)-2000)      
C      ENDIF
      
      IDATE=(IDAT(2)*10000+IDAT(1)*100+I2Y)
      WRITE(66,*)'IDATE=',IDATE      
      CALL CALEND(IDATE*100,JUDAY1)     
             
      WRITE(66,*)'QMIN  =',QMIN
      WRITE(66,*)'EPS   =',EPS
      WRITE(66,*)'MAXIT =',MAXIT
            
      IF(RUN.EQ.'COLD')THEN
      IFDAY=IDAT(2)-19
      ELSE
      IFDAY=IDATCP(2)-19      
      ENDIF

      CALL READR(54,QFLX0)
      CALL READI(54,NSSOUR)
      WRITE(66,*)'NSSOUR=',NSSOUR
      DO K=1,NSSOUR
      READ(54,*)XSOUR(K),YSOUR(K)
      WRITE(66,*)'SURFACE SOURCE ',QFLX0,XSOUR(K),YSOUR(K)
      
      
      ENDDO      
      
      CALL READR(54,QCON0)
      CALL READI(54,NSOUR)             ! CONCENTRATION IN COLUM
      
      WRITE(66,*)'RUN=',RUN
      WRITE(66,*)'NSTEP=',NSTEP      
      WRITE(66,*)'NSWRI=',NSWRI          
      WRITE(66,*)'NSFON=',NSFON 
      WRITE(66,*)'QFLX0=',QFLX0,' INPUT: kg CO2/ha/day'
      QFLX0=QFLX0/10000./86400.
      WRITE(66,*)'QFLX0=',QFLX0,'        kg CO2/m**2/s'           
      WRITE(66,*)'QCON0=',QCON0
      WRITE(66,*)'NSOUR=',NSOUR            
      DO K=1,NSOUR                     ! CONCENTRATION IN COLUM
      READ(54,*)ISOUR(K),JSOUR(K)      ! CONCENTRATION IN COLUM
      ENDDO                            ! CONCENTRATION IN COLUM
      CALL READR(54,AREAX0)
      CALL READR(54,AREAY0)
      CALL READI(54,NXAREA)
      CALL READI(54,NYAREA)      
C      
C     CHECK POINT FOR READ
C
      IF(RUN.EQ.'WARM')THEN
      CALL I2CH(IDATE,NAMEC(1:6))  
C   From 6-digits number to 6-character string

C
C     PRINT TO PROTOCOL
C
      WRITE(0,*)'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>'
      WRITE(0,*)'Date ',IDAT
      WRITE(0,*)'Chkp in =',DATE3
      WRITE(0,*)'Chkp out=',NAMEC(1:6)
      WRITE(0,*)'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'    

      WRITE(66,*)'CONTINUE WITH READ FROM'

      I1=IDIR(2)                   
      OPEN(57,FILE=
     * DIRTAB(2)(1:I1)//'FIRST.CHKP',STATUS='OLD')

      WRITE(66,*)
     *DIRTAB(2)(1:I1)//'FIRST.CHKP' 

      ENDIF
C
C    '/pesqout/sdg04/igor/eta/40km/of/o/'//NAMEC(1:6)//'_chkp.3
C      
C     CHECK POINT FOR WRITE 
C 

      CALL I2CH(IENDA2,NAMEC(1:6))
            
      WRITE(66,*)'CHECK POINT FOR WRITE ',NAMEC(1:6)

      I1=IDIR(2)  
      OPEN(58,FILE=
     * DIRTAB(2)(1:I1)//'SECOND.CHKP',STATUS='UNKNOWN')  

      WRITE(66,*)'CHECK POINT FOR WRITE:'
      WRITE(66,*)
     * DIRTAB(2)(1:I1)//'SECOND.CHKP' 
          
C
C                     FIRE AREAS FILE
C
C          |------------------------------------|
C          |                                    |
C          |                                    |
C          |          FIRE AREAS FILE           |
C          |                                    |
C          |                                    |
C          |------------------------------------|
C

      I1=IDIR(3)      
      OPEN(4,FILE=DIRTAB(3)(1:I1)//'fire_areas_eta2.dat',  
     * FORM='UNFORMATTED',ACCESS='DIRECT',RECL=IMJM,
     * STATUS='OLD')   

      WRITE(66,*)'FIRE AREA FROM:'
      WRITE(66,*)      
     *DIRTAB(3)(1:I1)//'fire_areas_eta2.dat'
                      
      CALL NULLI(BUFI,2*IMJM)
C
      IRECF=1
C       
      WRITE(66,*)'FIRE AREA OF ',DATE,' IREC=',IRECF,' /#'
C
C       
      IBSTEP=0
      ISTEP=0
                       
      IF(RUN.EQ.'COLD')THEN     
      WRITE(66,*)'       START TRNETA COLD RUN'
  
      DO K=1,KMAX
      DO J=1,IMJM
      QQ(J,K,1)=0.
      ENDDO
      ENDDO
      IBSTEP=0      

      
      IREC=0
      IREC1=0
      IREC2=0
      IREC3=0
      
      WRITE(66,*)'IBSTEP=',IBSTEP
      WRITE(66,*)'IREC  =',IREC
      WRITE(66,*)'IREC1 =',IREC1
      WRITE(66,*)'IREC2 =',IREC2
      WRITE(66,*)'IREC3 =',IREC3
            
      
      ELSE
      WRITE(66,*)'       START TRNETA WARM RUN'
      CALL CHKPT(57,'R',IDATCP,IBSTEP,IREC,IREC1,IREC2,
     * QQ,IMJM,KMAX)
           
      IDATE=(IDATCP(2)*10000+IDATCP(1)*100+IDATCP(3)-1900)
      CALL CALEND(IDATE*100,JUDAY2)    
              
      ENDIF
      
      WRITE(66,*)'IREC=',IREC,' IREC1=',IREC1,' IREC2=',IREC2
C
C        INTERNAL POINTS
C
C         +/- 4 points 
C 
         IMAR=4
         JMAR=4
         
         IBND1=IMAR+1              !   5
         IBND2=IMAX-IMAR           ! 217  mistake
         JBND1=JMAR+1              !   5
         JBND2=JM-JMAR             ! 217  mistake
C
C        GET MASK FOR INTERNAL POINT
C
         CALL GETMSK(HINTG,IMJM,IM,IBND1,IBND2,JBND1,JBND2)                            
C            

         WRITE(66,*)'IM=',IM
         WRITE(66,*)'JM=',JM
         WRITE(66,*)'DT=',DT
         WRITE(66,*)'IDAT=',IDAT
         WRITE(66,*)'PT=',PT
         WRITE(66,*)'KMIN,KTOP,KMAX=',KMIN,KTOP,KMAX,' #/'
C 
      DTT=30.*DT 
      WRITE(66,*)'TRANSPORT MODEL TIME STEP=',DTT,' sec'
      
      CALL ETAGSI
C     =====================================
C                  HISTORY FILES
C     ===================================== 

      I1=IDIR(5) 
      OPEN(60,FILE=
     * DIRTAB(5)(1:I1)//'P.'//DATE3//'_'//NRUN(1:LNRUN)//'_history.grd',      
     * FORM='UNFORMATTED',ACCESS='DIRECT',RECL=51*51*4,
     * STATUS='UNKNOWN')
     
      WRITE(66,*)'       HISTORY FILE:'
      WRITE(66,*)
     *DIRTAB(5)(1:I1)//'P.'//DATE3//'_'//NRUN(1:LNRUN)//'_history.grd'        
                                                             
       IREC4=0                               
                                              
      CALL EGRIDS(DPHD,DLMD)        !     (PHI0,LAM0)               

      CALL SETMPL(IMAR,JMAR)      
C
C     HEIGHT MASK = 1.
C      
      DO J=1,IMJM
      DO K=1,KMAX+1
      HZM(J,K)=1.
      ENDDO
      ENDDO
C
C     SET INNER POINTS MASK
C
      DO J=1,IMJM
      DO K=1,KMAX
      HINN(J,K)=HTM(J,K+KMIN)*HINTG(J)
      ENDDO
      ENDDO
C
C     SET 3D INTEREPOLATION PARAMETERS
C
      CALL SETID3(XB,DEX,YB,DEY,IM,JM,CON)  
C
C     SET VERTICAL MASK FOR 3D-INTERPOLATION
C      
      CALL VEGRID(AETA(KTOP),0.1)
      
      DO J=1,IMJM
      QFLUX(J,1)=0.
      QFLUX(J,2)=0.
      ENDDO      
             
      CALL CELLAR(CMEAN,CMIN,CMAX)
      WRITE(66,*)'CELL AREA'
      WRITE(66,*)'CMEAN=',CMEAN,' m**2'
      WRITE(66,*)'CMIN =',CMIN,' m**2'      
      WRITE(66,*)'CMAX =',CMAX,' m**2' 
      
      CALL AMWEIG(RO(1,1,1),HTM(1,KTOP),PS(1,1),RES,
     * IMJM,KMAX,DETA(KTOP),CAREA,1.)

      WRITE(66,*)'   FIRE SOURCE LOCATION'
      DO K=1,NSOUR
      CALL GCOORD(ISOUR(K),JSOUR(K),GLON,GLAT)      
      WRITE(66,*)'I,J FONTE=',ISOUR(K),JSOUR(K),
     *' Lon=',GLON,' Lat=',GLAT
      ENDDO
C     ----------------------------------------- 
C            INPUT FIRE AREA FOR 4 TIMES
C     -----------------------------------------
      CLOSE(54)
C     -----------------------------------------
C     AREAS ANALISADOS 
C     ----------------------------------------- 
      IWA(1)=0            
C ------------------
C     VEGETATION  
C ------------------
      CALL VEGETY      ! Warning: Temporary is out.

      WRITE(66,*)' ************** End of TM1 ****************'
      CALL TAPES(66)
      WRITE(66,*)' ************** End of TM1 ****************'
       
      WRITE(66,*)'KMAX=',KMAX
      CALL EXTRAC(HTM,IMJM*KMAX,AMEAN,AMIN,AMAX,0.,NULL)
      WRITE(66,*)'HTM=',AMEAN,AMIN,AMAX,' 0=',NULL
      CALL EXTRAC(HTM,IMJM*KMAX,AMEAN,AMIN,AMAX,1.,NULL)
      WRITE(66,*)'HTM=',AMEAN,AMIN,AMAX,' 1=',NULL 
C     --------------------------------------------
C                      One fire
C     --------------------------------------------
      CLOSE(54)
      I1=IDIR(1)               
      OPEN(54,FILE=DIRTAB(1)(1:I1)//'one_fire',         
     *   STATUS='OLD')
                 
      CALL NULLI(EFIREA,4*IMJM)
      CALL TRANXY(-1.,56.,20.,40.,-1.,9.,57.,45.,FLON1,FLAT1)
      ARFKM2=0.0009     ! 9 ha = 0.0009 km**2           
      CALL ONEFIR(EFIREA,ARFKM2,FLON1,FLAT1)
C      QFLX0=0.0228/(3.*2880.)          !  kg/m**2*s 
C      QFLX0=100.0*0.0228/(3.*2880.)    !  kg/m**2*s 
      QFLX1=0.0228                      ! see one_fire
      QFLX1=10.*QFLX1/2880. 
C --------- Original Source ------------ 25/03/2002
      QFLX1=22.8/(3.*2880.)     
C -------------------------------------- 25/03/2002       
      WRITE(66,*)'  Program one fire parameters'
      WRITE(66,*)'Location: FLON,FLAT=',FLON1,FLAT1
      WRITE(66,*)'Fire area          =',ARFKM2,' km**2'                            
      WRITE(66,*)'Fire intensity     =',QFLX1 ,' kg/m**2*s'      
      
      READ(54,*)HEX,XGRA,XMIN,XSEC,HEY,YGRA,YMIN,YSEC
Cx      HEX=-1.
Cx      XGRA=56.
Cx      XMIN=20.
Cx      XSEC=40.
Cx      HEY=-1.
Cx      YGRA=9.
Cx      YMIN=57.
Cx      YSEC=45.      !   Coordinates of one fire
      CALL TRANXY(HEX,XGRA,XMIN,XSEC,HEY,YGRA,YMIN,YSEC,FLON2,FLAT2)      
      READ(54,*)ARFKM2
Cx      ARFKM2=0.0009
      READ(54,*)QFLXA
Cx      QFLX0=0.0228
      QFLXA=QFLXA/(3.*2880.)     !  kg/m**2*s            
      QFLX1=QFLXA
C     25/03/2002 /////////////////////////////!  kg/m**2*s       

      READ(54,*)(FINTY(I),I=1,30)
      IF(RUN.EQ.'WARM')THEN
      DO I=1,30
      FINTY(I)=0.
      ENDDO
      ENDIF
      READ(54,*)ICLF1
      WRITE(66,*)'  '                
      WRITE(66,*)'  Table one fire parameters'
      WRITE(66,*)'Location: FLON,FLAT=',FLON2,FLAT2
      WRITE(66,*)'Fire area          =',ARFKM2,' km**2'                            
      WRITE(66,*)'Fire intensity     =',QFLXA ,' kg/m**2*s'
      WRITE(66,*)'Time intensity'       
      WRITE(66,100)(I1,FINTY(I1),I1=1,30)
C      WRITE(66,*)FINTY
      WRITE(66,*)'Source Type (ICLF1)=',ICLF1,', see next table'
      WRITE(66,*)'         Source Type Table'
      WRITE(66,*)'ICLF1 = 0 with one fire only'
      WRITE(66,*)'ICLF1 = 1 with distribution fires + one fire'
      WRITE(66,*)'ICLF1 = 2 with distribution fires only'                                                     
      call clock(t2)
      write(66,101) t2-t1
      
      call clock(t1)      
100   FORMAT(5(I2,'-',F3.1,1X))
101   format('CPU TIME for initiallization: ',f10.4,' sec')

C      STOP

      RETURN
      
      END
C& TR3DATE
      SUBROUTINE TR3DATE(IDAT,DATE,DATE2)
      DIMENSION IDAT(3)
      CHARACTER*6 DATE2
      CHARACTER*7 DATE
      CHARACTER*3 MON1(12)
      CHARACTER*2 MON2(12), DAY(31), YEAR(25)
      DATA MON1/'JAN','FEB','MAR','APR','MAI','JUN',
     *          'JUL','AUG','SEP','OCT','NOV','DEC'/
      DATA MON2/'01','02','03','04','05','06',
     *          '07','08','09','10','11','12'/
      DATA DAY/'01','02','03','04','05','06',
     *         '07','08','09','10','11','12',
     *         '13','14','15','16','17','18', 
     *         '19','20','21','22','23','24',
     *         '25','26','27','28','29','30',
     *         '31'/
      DATA YEAR/'80','81','82','83','84',
     *          '85','86','87','88','89',
     *          '90','91','92','93','94',
     *          '95','96','97','98','99',
     *          '00','01','02','03','04'/          
      
      ID=IDAT(2)                                   !  2 
      IM=IDAT(1)                                   !  1  
      IY=IDAT(3)-1979                              !  2000-1979=21 
      IF(IY.LT.1.OR.IY.GT.25)THEN
      WRITE(66,*)'ERROR IN INITIAL DATE:'
      WRITE(66,*)'IDAT=',IDAT
      WRITE(66,*)'Year.GE.1980.and.Year.LE.2004'      
      STOP
      ENDIF
              
      DATE=DAY(ID)//MON1(IM)//YEAR(IY)              !   7 bytes  
      DATE2=DAY(ID)//MON2(IM)//YEAR(IY)             !   6 bytes
      RETURN
      END      
C& RDDIRS
      SUBROUTINE RDDIRS(NU)
C
C     READ DIRECTORIES
C
      PARAMETER (NFIL = 10)
      COMMON/DIRICT/DIRTAB(NFIL),IDIR(NFIL) 
      CHARACTER*80 DIRTAB,S80

      WRITE(66,*)'     TABLE OF DIRECTORIES' 
      WRITE(66,*)
     *'123456789 123456789 123456789 123456789 123456789 1'
          
      DO I=1,5
      READ(NU,'(A80)')S80      
      I1=INDEX(S80,' ')-1
      IDIR(I)=I1
      DIRTAB(I)(1:I1)=S80(1:I1)
      WRITE(66,*)DIRTAB(I)(1:I1)
      ENDDO
      
      RETURN
      END        
