subroutine subsao1
C............................................................JUNE 2018
C include Sodankyla
C............................................................MAY 2018
C include Tucuman
C............................................................APR 2017
C include files .EDP
C!                                                           MAR 2013
C!    Include subroutines: dayyear, sublet2
C
C  TLG......................................................April 2010
C
c "CONVNO" EXTRACT foF2 & M3000F2 & hmF2 FROM DAILY-HOURLY FILE, NO
C 
	DIMENSION im(12)
	INTEGER*2 jyr,jmn,jdy,COUNTER,jjut
	+,jdy_pre,jmn_pre,ID1,ID2                            !C! new parameters
	CHARACTER*128 infile,outfile,TITLE1,TITLE2
c	+,datefile
     +,m_file,f_file,h_file
 	CHARACTER*4 YEAR,YEAR_pre
	CHARACTER*2 AYR,AMN,AMN_pre,ST,DY1,DY2,DDD,TT,AUT,
     *CYR,CMN,CDY,STS_IN(25),STS_OUT(25),STS_NAME ! Внимание, если добавлять станции в DATA STS, то здесь менять кол-во в STS_IN(25) и STS_OUT(11)
	*,dd1,dd2,DY22
	CHARACTER*1 fm						 
	CHARACTER*5 DAT(0:366,24),FOF2,BBB                     
	+,NUM_STS(25) ! Внимание, если добавлять станции в DATA STS, то здесь менять кол-во в NUM_STS(25)
	CHARACTER*3 DOY
	CHARACTER*5 FINP,XM3,HF2
       CHARACTER*128 m_data
	CHARACTER*30 STNAME
	COMMON /BL1/ST,YEAR,AYR,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22
  	+,STNAME
	DATA STS_IN/'RL','PS','VT','PQ','BP','CQ','HA','GU','ML','MA'
Crem	+,'WI','TR','IF','AL','PA','EI','GG','AU','LV','GA','NI','LM','NI'/         ! Our Directory name
C     +,'WP','TR','IF','AL','PA','EI','GG','AU','LV','GA','NI','LM','TU'
     +,'WP','TR','IF','AL','PA','EI','GG','AU','LV','GA','CJ','LM','TU'
     +,'BB','SO'/     ! Our Directory name				            !JUME 2018
      DATA STS_OUT/'ch','ps','vt','pq','bp','cq','ha','gu','ml','mo'
C	+,'wp','tr','if','al','pa','ei','gg','au','lv','ga','nc','lm','tu'
	+,'wp','tr','if','al','pa','ei','gg','au','lv','ga','cj','lm','tu'
     +,'bb','so'/														!JUME 2018
      DATA NUM_STS/'RL052','PSJ5J','VT139','PQ052','BP440','09429'
	+,'HA419','GU421','ML449','MA155','WI937','TR170','IF843','AL945'
C     +,'PA836','EI764','GU513','AU930','YA462','GA762','NI135','LM42J'
C     +,'PA836','EI764','GU513','AU930','LV12P','GA762','NI135','LM42J'
     +,'PA836','EI764','GU513','AU930','LV12P','GA762','CAJ2M','LM42J'
     +,'TUJ2O','BBJ3R','SO166'/  ! Source station code				!JUME 2018
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/

C	DAT(0:366,24)
  111	do n=0,366
	do k=1,24
	dat(n,k)='  00 '
	enddo
	enddo
C++
	do ist=1,25
	if (sts_out(ist).eq.st) exit
	enddo

	YEAR_pre=YEAR
	AMN_pre='01'		!temp +
C ==========================================================

C Next line: specify YEAR from current date:
       AYR=YEAR(3:4)
C Next line: specify MONTH from current date:
	read(ayr,*) ryr
	jyr=int(ryr)
	read(amn,*) rmn
	jmn=int(rmn)
	if(int(ryr/4.)*4.eq.jyr) THEN 
 	im(2)=29
	                          ELSE
	IM(2)=28
	ENDIF
C!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C!
C! Add check content of <datefile> for preceding month & day:
	 read(dy1,*) rdy1     !C! day in new month
	jdy=int(rdy1)		  !C! day in new month
	ndoy1=0				  !C! day in new month
	 read(dy2,*) rdy2     !C! day in new month
c--	jdy=int(rdy2)		  !C! day in new month
	ndoy1=ndoy(jyr,jmn,jdy)
	jdy_pre=0			   !C! prec. day 
	jmn_pre=0			   !C! month for prec. day
	ndoy0=ndoy1-1		   !C! prec. day of year
c//	call dayyear(jyr,jmn_pre,jdy_pre,ndoy0) !C! produce mon & day for preceding day
	jmn_pre=jmn  ! TEMP
	jdy_pre=jdy ! TEMP
	call blet2(jmn_pre,AMN_pre)    !C! produce CHARACTER AMN_pre     
	call blet2(jdy_pre,dy1)    !C! produce CHARACTER <dy1>
C End of Check for preceding day	     
C! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      WRITE(*,*)YEAR,AMN,dy2,YEAR_pre,AMN_pre,dy1   ! this line is moved here C!

C Next line: get YEAR,AMN,dy2,YEAR_pre,AMN_pre,dy1 from file "date"

c       datefile='/var/www/izmiran/ionosphere/weather/graf/date' ! Ljuba
   50	FORMAT(A4,1x,A2,1x,A2,1x,A4,1x,A2,1x,A2,A10)			   ! Ljuba
C=============================================================== 

C НАчало цикла стирания последних 3-х строк у файлов GM111m.br, IR11m.br  YK11m.br NO10m.br
C ==============================================================
c     
CREM 
      do i=ist,ist
      STS_NAME=STS_OUT(i)
      write(*,*) ' STS_NAME= ', STS_NAME, STS_OUT(i), i
c
  333 FORMAT(a128)
      count=0
c      m_file='/var/www/izmiran/ionosphere/weather/graf/2010/NO10m.br' !Ljuba
      m_file='d:/web/graf/2012/au10m.br' 								!Tamara
c      m_file(42:45)=YEAR        										 !Ljuba
c      m_file(47:48)=STS_NAME  										 !Ljuba
c      m_file(49:50)=AYR  												 !Ljuba
      m_file(13:16)=YEAR        										 !Tamara
      m_file(18:19)=STS_NAME  										 !Tamara
      m_file(20:21)=AYR  												 !Tamara
      OPEN(33,FILE=m_file)
   55 READ(33, 333, END=44) m_data 
	CYR=m_data(1:2)
	CMN=m_data(3:4)
	CDY=m_data(5:6)
	if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then  
	goto 44
	                  else
         count=count+1
      GOTO 55
      CONTINUE
                  	endif
   44 m_strings = count
      REWIND (33)
      count=0
      do while (count.lt.m_strings)
         READ(33, 333, END=444) m_data 
         count=count+1
      enddo
  444 print*,'YES!'
      ENDFILE 33
      close(UNIT=33)
CCC
      count=0
c      f_file='/var/www/izmiran/ionosphere/weather/graf/2010/NO10f.br'	  !Ljuba
c      f_file(42:45)=YEAR  											  !Ljuba
c      f_file(47:48)=STS_NAME 											  !Ljuba
c      f_file(49:50)=AYR  												  !Ljuba
      f_file='d:/web/graf/2012/au10f.br'	  !Tamara
      f_file(13:16)=YEAR  											  !Tamara
      f_file(18:19)=STS_NAME 											  !Tamara
      f_file(20:21)=AYR  												  !Tamara

      OPEN(88,FILE=f_file)
  255 READ(88, 333, END=244) m_data 
	CYR=m_data(1:2)
	CMN=m_data(3:4)
	CDY=m_data(5:6)
	if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then	
	goto 244
	                  else
         count=count+1
      GOTO 255
      CONTINUE
                  	endif
  244 f_strings = count
      REWIND (88)
      count=0
      do while (count.lt.f_strings)
         READ(88, 333, END=248) m_data 
         count=count+1
      enddo
  248 print*,'YES!'
      ENDFILE 88
      close(UNIT=88)
C TLG ADD!
CCC
      count=0
c      f_file='/var/www/izmiran/ionosphere/weather/graf/2010/NO10h.br'   !Ljuba
c      h_file(42:45)=YEAR 												   !Ljuba
c      h_file(47:48)=STS_NAME  										   !Ljuba
c      h_file(49:50)=AYR  												   !Ljuba
      h_file='d:/web/graf/2012/no10h.br'								  !Tamara
      h_file(13:16)=YEAR  											  !Tamara
      h_file(18:19)=STS_NAME 											  !Tamara
      h_file(20:21)=AYR  												  !Tamara

      OPEN(55,FILE=h_file)
  355 READ(55, 333, END=344) m_data 
	CYR=m_data(1:2)
	CMN=m_data(3:4)
	CDY=m_data(5:6)
	if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then  
	goto 344
	                  else
         count=count+1
      GOTO 355
      CONTINUE
                  	endif
  344 h_strings = count
      REWIND (55)
      count=0
      do while (count.lt.h_strings)
         READ(55, 333, END=348) m_data 
         count=count+1
      enddo
  348 print*,'YES!'
      ENDFILE 55
      close(UNIT=55)
      enddo
C=============================================================== 
C Конец цикла стирания последних 3-х строк у файлов GM11m.br, IR11m.br  YK11m.br NO11m.br jj11m.br
C ==============================================================
c
C=============================================================== 
C Начало цикла обработки файлов GM11m.br, IR11m.br  YK11m.br NO10m.br jj11m.br
C ==============================================================
c
c      DO COUNTER=1,6  ! Внимание, меняем кол-во станций!!!!
      DO COUNTER=ist,ist! Внимание, меняем кол-во станций!!!!
c      WRITE(*,*)' COUNTER=', COUNTER
c
c
c
c
C        Double letters cycle + letters 'f', 'm', 'h':
      fm='f'
	iflag=0
C ==========================================================

C Next line : specify DAY1 and DAY2 from current dates:
C	       WRITE(*,*)' ENTER START-DY1,END-DY2:'
C	       READ(*,*) DY1,DY2
C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	read(dy1,*) rdy1
	read(dy2,*) rdy2
 	idy1=int(rdy1)
	idy2=int(rdy2)
	idd=idy1
C
      STS_NAME=STS_OUT(COUNTER)
c      print*,'STS_OUT(COUNTER)=', STS_OUT(COUNTER)

c+	 Next lines = specify path and name of Output file:
c=
c      outfile='/var/www/izmiran/ionosphere/weather/graf/2012/NO12f.br' !Ljuba
c      outfile(42:45)=YEAR  											 !Ljuba
c      outfile(47:48)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Ljuba
c      outfile(49:50)=AYR  												 !Ljuba
      outfile='d:/web/graf/2012/au12f.br'                             !Tamara
      outfile(13:16)=YEAR  											 !Tamara
      outfile(18:19)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Tamara
      outfile(20:21)=AYR  											 !Tamara
C ==========================================================
101	  continue
c	  outfile(51:51)=fm                                              !Ljuba
	outfile(22:22)=fm												!Tamara
C ==========================================================

	OPEN(12,FILE=OUTFILE,ACCESS='APPEND')

C ==========================================================
   1	do 77 j=idy1,idy2               ! cycle day-by-day
	jdy=j
	jj=j-idy1+1
	call blet2(jdy,DDD)
C
C Calculate day-of-year:
   17	FORMAT(1X,A3)
	lday=ndoy(jyr,jmn,jdy) ! function to define day-of-year
	call blet3(lday,DOY)
	write(*,17) doy

1111	DO 1110 jut=1,24             ! Daily cycle
	title1=' '
	ut=float(jut-1)
	jjut=jut-1
	call blet2(jjut,AUT)

C  
c
      STS_NAME=STS_IN(COUNTER)
c      print*,'STS_IN(COUNTER)=', STS_IN(COUNTER)

c      infile='/var/www/izmiran/ionosphere/weather/graf/NO/'  !Ljuba
c      infile(42:43)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Ljuba
c      infile(45:46)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Ljuba
c      infile(47:49)=NUM_STS(COUNTER) 						   !Ljuba
c      infile(50:)='_2011035040000.SAO' 					   !Ljuba
      infile='d:/web/graf/AU/'                               !Tamara
      infile(13:14)=STS_NAME !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Tamara
      infile(16:20)=NUM_STS(COUNTER) 						   !Tamara NEW!!!!!!!
      infile(21:)='_2013035040000.SAO' 					   !Tamara
	if ((ist.ge.5).and.(ist.lt.10)) infile(34:34)='1'        !NEW!!!!!
c-	if (ist.eq.3) infile(31:34)='0600'        !NEW!!!!! Sodankyla
c-	if (ist.eq.4) infile(31:34)='0400'        !NEW!!!!!	  SJJ
C=/MA/	if (ist.eq.10) infile(31:34)='0100'        !NEW!!!!! Moscow /MO/
	if (ist.eq.18) infile(31:34)='0005'        !NEW!!!!! Austin
	if (ist.eq.25) infile(31:34)='0600'        !NEW!!!!! Sodankyla June 2018
	if (ist.le.4) infile(36:38)='EDP'        !NEW!!!!! Chilton,
C//	if ((ist.gt.1).and.(ist.le.4)) infile(36:38)='EDP'        !NEW!!!!! Port_Stanley
Crem	if ((ist.eq.11).or.(ist.eq.12)) infile(36:38)='EDP'    !NEW!!!!!WI-Wallaps, Tromso
	if (ist.eq.12) infile(36:38)='EDP'   !Tromso
Crem	if ((ist.ge.13).and.(ist.ne.18).and.(ist.ne.23).and.(ist.ne.24))  ! AU~.SAO
	if ((ist.ge.13).and.(ist.ne.23).and.(ist.ne.24)) ! AU~.sao
     *infile(36:38)='EDP'        !Alpena,P-Arguello,Eielsen,Guam,Yakutsk
      if (ist.eq.20) infile(31:34)='0010'        !NEW!!!!! Gakona

c      infile(45:)='NO369_2011035040000.SAO'                 !Ljuba???????
c	infile(51:54)=YEAR								  !Ljuba
c	infile(55:57)=DOY								  !Ljuba
c	infile(58:59)=AUT                                 !Ljuba
	infile(22:25)=YEAR								  !Tamara
	infile(26:28)=DOY								  !Tamara
	infile(29:30)=AUT                                 !Tamara

c      WRITE(*,*)' INFILE:',infile ! ПОТОМ УБРАТЬ КОММЕНТ!!!
C ==========================================================

    	OPEN(11,FILE=INFILE,err=3)
	read (11,*,err=3,end=10) title1
	goto 9
   10	continue
	 TT=title1(1:2)
	if (TT.eq.' ') then
	goto 3
	endif
   9	continue
C Change input for SAO format ===============
	nn=15
	if (ist.gt.10) nn=5
	if (ist.eq.10) nn=4
C	if (ist.eq.2) nn=4 !PS .sao
C-	if (ist.eq.18) nn=4 !AU.sao
	if (ist.eq.23) nn=4 !TU.sao
	if (ist.eq.24) nn=4 !BB.sao
C
C Case .EDP:
 1106	format(2X,A5,3X,A5)
 1107	format(2X,F8.4,4X,F7.4)
1108 	format(2X,A5,7X,A5)

C-	if ((ist.eq.2).or.(ist.eq.23).or.(ist.eq.18).or.(ist.eq.24)) !PS,TU or BB
	if ((ist.eq.23).or.(ist.eq.24))
     + goto 777	!TU or BB
Crem	if ((ist.eq.18).or.(ist.eq.23).or.(ist.eq.24)) goto 777	!AU-sao, TU or BB
	if ((ist.gt.4).and.(ist.le.11)) goto 777
C//	if (((ist.gt.1).and.(ist.le.4)).and.(ist.le.11)) goto 777
C?	if ((ist.le.3).or.(ist.eq.4).or.(ist.ge.11).and.(ist.ne.18)) then  !>>>>>>>>>>>>>>>>>>>>>>>>
	if ((ist.le.4).or.(ist.ge.11))then
C//	if (((ist.gt.1).and.(ist.le.4)).or.(ist.ge.11))then
C+
Crem	if ((ist.eq.11).or.(ist.eq.12)) THEN       !WI, TR .edp select hmax
      if (ist.eq.12) THEN       ! TR .edp select hmax
	read (11,*,err=3,end=2) title2  ! extra line
	read (11,*,err=3,end=2) title2  ! extra line
	fmax=0.
	fpre=0.
 1333	read (11,1107,err=3,end=334) rhf2,rfinp
      if (rhf2.lt.150) goto 1333
      if ((rfinp.ge.fmax).and.(fpre.lt.rfinp)) then
	rhmax=rhf2
	fmax=rfinp
	fpre=rfinp
	backspace(11)
	read (11,1108,err=3,end=2) hf2,finp
	goto 1333
	else
	goto 334
	endif
  334	continue
       if (rhmax.lt.170.) then
	hf2='  00 '
	finp='  00 '
	endif
C       GOTO 440                    
      	goto 1306
      ENDIF
C+
	read (11,1106,err=3,end=2) hf2,finp
	if (hf2.eq.'-99.0') then 
	hf2='  00 '
	else
	BBB=hf2
	hf2(1:1)=' '
	hf2(2:4)=BBB(1:3)
	hf2(5:5)=' '
	endif
	if (finp.eq.'-99.0') then 
	finp='  00 '
	else
      if ((ist.eq.25).and.(finp(1:3).eq.'  0')) then 
 	finp(5:5)='0'
	 endif

	BBB=finp
	finp(1:1)=' '
	finp(2:3)=BBB(2:3)
	finp(4:4)=BBB(5:5)
	finp(5:5)=' '
	endif
		if (fm.eq.'f') then
	if (finp.eq.' 990 ') finp='  00 '
	 fof2=finp
	endif
	if (fm.eq.'m') fof2=' 000 '
	if (fm.eq.'h') fof2=hf2             
	goto 440
	endif



777	do k=1,nn
	read (11,*,err=3,end=2) title2  ! extra lines
	if (title2(3:6).eq.YEAR) exit
	enddo
C
	if ((ist.lt.5).or.(ist.gt.10)) then
C//	if ((ist.eq.2).or.(ist.eq.3).or.(ist.eq.4).or.(ist.gt.10)) then
      finp='  00 '
	xm3='  00 '
	read (11,106,err=3,end=2) finp,xm3
	if (xm3.eq.'9.000') xm3=' 000 '
	read (11,*,err=3,end=2) title2  ! extra lines TLG
	read (11,306,err=3,end=2) hf2
	if (finp.eq.'99.00') finp='  00 '
	if (hf2.eq.'999.0 ') hf2='  00 '
	if (xm3.eq.'999.0 ') xm3='  00 '
	continue
	               else
	 finp='  00 '
 	read (11,105) finp			! China stations
	xm3='  00 '
	hf2='  00 '
	foF2='  00 '
		if (fm.eq.'f') then
	call replet(fm,finp,bbb)							    
	 fof2=bbb
	endif
	if (finp.eq.' 990 ') finp='  00 '
	if (fm.eq.'m') then
	if (xm3.eq.' 999 ') xm3='  00 '
	fof2=xm3
	endif
	if (fm.eq.'h') then
	if (hf2.eq.' 999 ') hf2='  00 '
	fof2=hf2 
	endif            
	goto 440
	endif

  106 FORMAT(2X,A5,12X,A5)
  104 FORMAT(A5)
  105 FORMAT(1X,A5)
  306 FORMAT(9X,A5)
C
C Add control of letters in input data:                  
1306	if (fm.eq.'f') then
	call replet(fm,finp,bbb)							    
	finp=bbb		
	endif								   
	if (fm.eq.'m') then
	call replet(fm,xm3,bbb)							   
      xm3=bbb		
	endif
		if (fm.eq.'h') then
	call replet(fm,hf2,bbb)							    
      hf2=bbb			
	endif								    
C

crem	 foF2='  00 '
	 foF2=finp
	if (finp(1:2).eq.'99') then 
	finp='  00 '
      xm3='  00 '
	endif
	if (hf2(1:3).eq.'999') then
	hf2=' 000 '
	endif
	if (fm.eq.'f') fof2=finp
	if (fm.eq.'m') fof2=xm3
	if (fm.eq.'h') fof2=hf2
C 

C
C ========================================
   11	continue
  440 CLOSE (unit=11)
  107	 dat(jj,jut)=fof2
	
1110	continue           ! End of daily cycle

  77  continue         ! end cycle day-to-day

c
      read(dy1,*) rdy1     !C! day in new month
	jdy=int(rdy1)		  !C! day in new month
c
	DO J=1,JJ
	jdy=jdy+j-1
	call blet2(jdy,ddd)
	if (fm.eq.'m') then
		write(12,181) ayr,amn,DDD,(dat(j,k),k=1,24)
c- 	write(*,181) ayr,amn,ddd,(dat(j,k),k=1,24)
	endif
	if (fm.eq.'f') then
	write(12,181) ayr,amn,ddd,(dat(j,k),k=1,24)
c-	write(*,181) ayr,amn,ddd,(dat(j,k),k=1,24)
	endif
	if (fm.eq.'h') then
	write(12,181) ayr,amn,ddd,(dat(j,k),k=1,24)
c-	write(*,181) ayr,amn,ddd,(dat(j,k),k=1,24)
	endif
  180	format(3A2,2X,24(A5))
  181	format(3A2,1X,24(A5))
	ENDDO
C
c	pause ' '
	goto 2
    3	continue
	if (fm.eq.'f') then
	dat(jj,jut)='  00 '
	else
      dat(jj,jut)=' 000 '
	endif
	close(unit=11)
	goto 1110
   2      CLOSE (unit=12)
	if (fm.eq.'f') then
	fm='m'
	goto 101
	endif

	if (fm.eq.'m') then
	fm='h'
	goto 101
	endif

       ENDDO
crem	 write(*,112) st
crem 112	format(1X,A2,' st=00 for stop')      
c	pause ' '
crem	goto 111
crem      STOP

  
	RETURN
	END
c
c
c
c
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C  NEW SUBROUTINE to check letters in input data and remove <.>:					 
	subroutine replet(fm,aaa,bbb)
C .......................................................Feb 2014
      CHARACTER*5 aaa,bbb
	CHARACTER*1 IN(0:11),x1,x2,x3,x4,x5,fm						 
	DATA IN/'0','1','2','3','4','5','6','7','8','9',' ','.'/	
	bbb=' 000 '
      x1=aaa(1:1)
	x2=aaa(2:2)
	x3=aaa(3:3)
	x4=aaa(4:4)
	x5=aaa(5:5)
	ic1=-1
	ic2=-1
	ic3=-1
	ic4=-1
	ic5=-1
	do i=0,11
	if (x1.eq.in(i)) ic1=i
	if (x2.eq.in(i)) ic2=i
	if (x3.eq.in(i)) ic3=i
	if (x4.eq.in(i)) ic4=i
	if (x5.eq.in(i)) ic5=i
	enddo
	if ((ic1.eq.-1).or.(ic2.eq.-1).or.(ic3.eq.-1).or.(ic4.eq.-1).
     *or.(ic5.eq.-1)) then	  
c     	if (ic3.eq.11) then
	if (fm.eq.'f') then
	 bbb='  00 '
	else
	bbb=' 000 '
	endif
	                else
crem	bbb=aaa
      if (fm.eq.'h') then
	bbb(2:2)=x1
	bbb(3:3)=x2
	bbb(4:4)=x3
	goto 12
	endif
      if (fm.eq.'m') then
	bbb(2:2)=x1
	bbb(3:3)=x3
	bbb(4:4)=x4
	goto 12
	endif
C foF2
      if (ic4.eq.11) then
      bbb(2:2)=x2
      bbb(3:3)=x3
      bbb(4:4)=x5
      	               else
	if(ic3.eq.11) then
      bbb(2:2)=x1
	bbb(3:3)=x2
      bbb(4:4)=x4
	endif
	              endif
	endif
  12   	if ((ic1.eq.10).and.(ic2.eq.10).and.(ic3.eq.10).and.(ic4.eq.10).
     *and.(ic5.eq.10)) then
	bbb=' 000 '
	endif
	return
	end
C -----------------------------------------------------------