C					                                  Aug. 2013
C
C       Count global median afc(UT) and ahc*UT) for maps TEC, fcF2 and hcF2 
C input maps for given UT 
      subroutine smedmap2(nnn,AYEAR,AMN,ADY,IMED)
C
C      output	fcYYMMUT.mut; hcYYMMUT.mut; tcYYMMUT.mut;
C
      DIMENSION im(12),da(7,71,0:72),av(0:72),iav(0:72)
     +,CC(7,0:72)  ! calculate med-map line-by-line for 71 latitudes
     +,IMED(71,0:72,0:23) ! results of median maps 
      character*2 ayr,amn,ady,aut,adyr,amnr,ayr_pre	   !C++
	character*1 fht
	character*66 infile  !Ljuba было 45
	CHARACTER*41 inf                  !Ljuba
      CHARACTER*25 ile                  !Ljuba

	CHARACTER*128 TXT
	character*4 AYEAR
c++	integer*2 iyr,mn,idy,iut,imn
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
c-			COMMON /BL1/CC,AV

c
c Add cycle on fm, hm, tm:
c
	if (nnn.eq.1) fht='t'
	if (nnn.eq.2) fht='f'
	if (nnn.eq.3) fht='h'
c
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
	AYR=AYEAR(3:4)
		read(ayr,*) yr
		read(amn,*) rmn
	mn=int(rmn)
C
 	iyr=int(yr)
	if(int(yr/4.)*4.eq.iyr) THEN 
	im(2)=29
	                          ELSE
	IM(2)=28
	ENDIF
	ndnr=im(mn)
C
		read(ady,*) rdy
	jdy=int(rdy)
	ldac=ndoy(iyr,mn,jdy)
	lda0=ldac-6
	lda1=ldac
	if (lda0.le.0) then						 !C++
	iyr_pre=iyr-1							 !C++
	imn_pre=12								 !C++
	idy_pre=31+lda0							 !C++
	call blet2(iyr_pre,AYR_pre)				 !C++
	endif									 !C++
C 
C
C       infile='d:\web\graf\dfc\yy\mm\ut\fcmmddut.jyr'	 !Tamara
C	infile(14:14)=fht								 !Tamara
C	infile(26:26)=fht								 !Tamara
C	infile(17:18)=ayr								 !Tamara
C	infile(36:37)=ayr								 !Tamara

      inf='/var/www/izmiran/ionosphere/weather/graf/'	 !Ljuba 41
      ile='dfc/yy/mm/ut/fcmmddut.jyr'	                 !Ljuba 66
	ile(2:2)=fht								     !Ljuba
	ile(14:14)=fht								     !Ljuba
	ile(5:6)=ayr								     !Ljuba
	ile(24:25)=ayr								     !Ljuba
      infile=inf//ile  	                             !Ljuba

C
C UT cycle
	DO 203 iut=0,23
	call blet2(iut,AUT)
C	infile(32:33)=AUT								 !Tamara

	infile(61:62)=AUT								 !Ljuba

C Day-to-day cycle
	DO 201 lda=lda0,lda1
	kk=lda-lda0+1
	if (lda.gt.0) then								 !C++
	call submmdd(lda,iyr,imn,idy)					 
C	infile(17:18)=ayr								 !C++
C	infile(36:37)=ayr								 !C++ Tamara
	infile(46:47)=ayr					! Ljuba              !C++ !! Added 02.01.15
	infile(65:66)=ayr					!Ljuba  		 !C++ !!Added 02.01.15
	else											 !C++ Tamara
	imn=imn_pre										 !C++
	idy=31+lda										 !C++
C	infile(17:18)=ayr_pre							 !C++ Tamara
C	infile(36:37)=ayr_pre							 !C++ Tamara
	infile(46:47)=ayr_pre			! Ljuba 			 !C++ !!Added 02.01.15
	infile(65:66)=ayr_pre			! Ljuba 			 !C++ !!Added 02.01.15
	endif											 !C++									 
C
	call blet2(imn,amnr)
	call blet2(idy,adyr)
C	infile(20:21)=amnr								 !Tamara
C	infile(28:29)=amnr								 !Tamara
C	infile(30:31)=adyr								 !Tamara

	infile(49:50)=amnr								 !Ljuba
	infile(57:58)=amnr								 !Ljuba
	infile(59:60)=adyr								 !Ljuba

C
   18	continue
C
C++  Rename file extension tc* or ta* / tb* for prediction files
  700 format(A128)
C	INFILE(27:27)='c'								 !Tamara
	INFILE(56:56)='c'								 !Ljuba

C++ Check availability of INFILE
C
      OPEN(11,FILE=INFILE)
       read(11,700,END=701,ERR=701) txt
	backspace(11)
	goto 704
C
c//	            if (txt.eq.'') then  ! no tc* data
  701	close(unit=11)
C	INFILE(27:27)='a'								 !Tamara
	INFILE(56:56)='a'								 !Ljuba

		OPEN(11,FILE=INFILE) 
	read(11,700,END=702,ERR=702) txt
	backspace(11)
	goto 704
C
c//	   if (txt.eq.'') then	  ! no ta* data 
  702 	close(unit=12)
C	INFILE(27:27)='b'								 !Tamara
	INFILE(56:56)='b'								 !Ljuba

		OPEN(11,FILE=INFILE) 
	read(11,700,END=703,ERR=703) txt
	backspace(11)
	goto 704
C
c//	if (txt.eq.'') then	  ! no tb* data 
  703	close(unit=11)
	write(*,*) 'No file: ',infile
C	pause ' '  !!!!!!!!!!!! Ljuba !!!!!!!!!!!!
	stop
C
 704 	 continue
C
C
	do lat=1,71
  107 format(73(1X,F4.0))	! 
	READ (11,107,END=99,ERR=2) (da(kk,lat,k),k=0,72) !map lines
	enddo				   ! end lati
   99	close(unit=11)
 
  201  CONTINUE				  ! end day-to-day cycle

	do 301 lat=1,71
	do k=0,72
	av(k)=0.
	enddo
C combile all days for selected lati:
	do idy=1,7
      	do lon=0,72
	    cc(idy,lon)=da(idy,lat,lon)
	    enddo
	enddo
	call smedian2(7,CC,AV)
C
	  	do lon=0,72
	iav(lon)=nint(av(lon))
	IMED(lat,lon,iut)=iav(lon) ! results of median map
	    enddo
c	   write(*,109) (iav(k),k=0,72)

  301	continue                 ! end lat cycle of median map

  203 continue   ! end ut cycle
 
  108 format(3A2,24(1X,I4))	! 
  109 format(73(1X,I4))	! 
      
C
       GOTO 1234
    2 CONTINUE
       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ',infile
C	pause ' '   !!!!!!!!!!! Ljuba
	goto 34
 1234	continue  !
c//      write(*,*) infile,outfile
c//      pause ' ' 
   34 RETURN
       END

C=========================================================================
c VERIFICATION OF MEDIAN ================
      subroutine smedian2(ndnr,CC,SME)
C Input file: CC(ndnr,0:72) for ndnr days, longitudes -180:5:180
C Number days for median : ndnr=7
C Output array: SME(0:72) for longitudes -180:5:180
	DIMENSION CC(7,0:72),SME(0:72),X1(7),X2(7)
c-		COMMON /BL1/CC,SME
C "MEDIAN:"
       DO 1030 M=0,72
      MM=0
      DO N=1,ndnr
      X1(N)=CC(N,M)
      ENDDO 
  880 XX=0.
CREM MAX X1(N)
  890 DO N=1,ndnr
  900 IF (XX.lt.X1(N)) THEN 
      XX=X1(N)
	ENDIF
      ENDDO      !N
  920 IF (XX.eq.0) GOTO 980
C
  930 DO 960 N=1,ndnr
      IF (X1(N).lt.XX) GOTO 960
      MM=MM+1 
      X2(MM)=XX 
	X1(N)=0.
  960 CONTINUE      ! N
  970 IF (MM.lt.NDNR) GOTO 880
  980 XMM=FLOAT(MM)
      XD1=XMM/2.
      ND1=INT(XD1)
	CD1=FLOAT(ND1) 
      ND2=ND1+1 
      IF (CD1.LT.XD1) THEN 
	XMD=X2(ND2)
	else
	XMD=(X2(ND1)+X2(ND2))/2.
	ENDIF
C
 1020 SME(M)=XMD
 1030 CONTINUE
c
 1050 RETURN
      END
C=============================================================================