C+
C NAME:
C	Mk_Base
C PURPOSE:
C	Set the base density map from the 1 AU density using the density falloff from
C	the source surface.  Write out a lot of other information about the ecliptic 
C 	and polar tomographic densities and velocities as well. (B. Jackson, 03/28/01) 
C       
C CATEGORY:
C	Data processing
C CALLING SEQUENCE:
C	call Mk_Base(VMAP,DMAP,nLng,nLat,nT,VREF,DEN1AU,FALLOFF,VEL1AU,BADV,BADD,DBASE)
C            
C INPUTS:
C
C	VMAP(nLng,nLat,nT)  real	Velocity map
C	DMAP(nLng,nLat,nT)  real	Density map
C	nLng		    integer	Number of longitude points in VMAP
C	nLat		    integer	Number of latitude points in VMAP
C	VREF		    real	Velocity map reference height
C	DEN1AU		    real	Average density at 1 AU
C	FALLOFF		    real	Density Falloff with distance from Sun
C	VEL1AU		    real	Average velocity at 1 AU
C	BADV		    real	Value of vmap where there is no projection
C	BADD		    real	Value of dmap where there is no projection
C	DBASE(nLng,nLat,nT) real	Base density map
C       
C OUTPUTS:
C
C	DBASE(nLng,nLat,nT) real	Base density map
C
C FUNCTIONS/SUBROUTINES:
C	
C PROCEDURE:
C
C MODIFICATION HISTORY:
C	NOV, 1995 B. Jackson (STEL,UCSD)
C	MAR, 2000 B. Jackson (CASS/UCSD)
C	Mar, 2001 B. Jackson (CASS/UCSD)
C
 	subroutine Mk_Base(VMAP,DMAP,nLng,nLat,nT,nTmin,nTmax,VREF,DEN1AU,FALLOFF,VEL1AU,
     &			    BADV,BADD,DBASE)
        real*4          VMAP(nLng,nLat,nT),	! Velocity map
     &			DMAP(nLng,nLat,nT),	! Density map
     &	                DBASE(nLng,nLat,nT)	! Base density map
C
	R1AU   = 1.0				! 1 AU distance in AU
C	CONREF = DEN1AU*(VEL1AU**2)		! Momentum flux constant at ecliptic at 1 AU
	nLats = nLat/8 			! Ending S polar latitude
	nLatn = nLat - nLats + 1 	! Beginning N polar latitude
	DAVP    = 0.0
	ANCONP  = 0.0
	VAVP    = 0.0
	ANVAVP  = 0.0
	do n=1,nT 			! Polar latitudes - determine deconvolved D and V at source surface
	  if(n.ge.nTmin.and.n.le.nTmax) then
	    do i=1,nLng
		do j=1,nLats 				! South polar latitudes
		    if(DMAP(i,j,n).ne.BADD) then
			DAVP   = DMAP(i,j,n) + DAVP
			ANCONP = ANCONP + 1.0
			if(VMAP(i,j,n).ne.BADV) then
			    VAVP = VMAP(i,j,n) + VAVP
			    ANVAVP = ANVAVP + 1.0
			end if
		    end if	
	 	end do
		do j=nLatn,nLat 			!  North polar latitudes
		    if(DMAP(i,j,n).ne.BADD) then
			DAVP   = DMAP(i,j,n) + DAVP
			ANCONP = ANCONP + 1.0
			if(VMAP(i,j,n).ne.BADV) then
			    VAVP = VMAP(i,j,n) + VAVP
			    ANVAVP = ANVAVP + 1.0
			end if
		    end if	
	 	end do
	    end do
	  end if
	end do
	nLatst  = nLat/2			! Beginning ecliptic latitude
	nLaten  = nLatst+2			! Ending ecliptic Latitude
	ANCON  = 0.0
	DAV    = 0.0
	VAV    = 0.0
	ANVAV  = 0.0
	DB     = 0.0
	do n=1,nT 				 ! Ecliptic latitudes - determine D and V at source surface
	  if(n.ge.nTmin.and.n.le.nTmax) then
	    do i=1,nLng
		do j=nLatst,nLaten
		    if(DMAP(i,j,n).ne.BADD) then
			DAV   = DMAP(i,j,n) + DAV
			ANCON = ANCON + 1.0
			if(VMAP(i,j,n).ne.BADV) then
			    VAV = VMAP(i,j,n) + VAV
			    ANVAV = ANVAV + 1.0
			end if
		    end if		
	 	end do
	    end do
	  end if
	end do
	if(ANCONP.ne.0) DAVP = DAVP/ANCONP 	! Polar averages
	if(ANVAVP.ne.0) VAVP = VAVP/ANVAVP
	if(ANCON.ne.0) DAV = DAV/ANCON		! Ecliptic averages
	if(ANVAV.ne.0) VAV = VAV/ANVAV
C	DB 	= DEN1AU/3.					! Set 1 AU base density
	DB 	= DEN1AU*2./3.					! Set 1 AU base density
	write (*,'(/,A,F7.4,A,F10.1,F7.1)')
     &  'Polar tomographic D and V average at the',VREF,' AU height    =',DAVP-DB*((R1AU/VREF)**FALLOFF),VAVP
	write (*,'(A,F7.4,A,F10.1,F7.1)')
     &  'Ecliptic tomographic D and V average at the',VREF,' AU height =',DAV-DB*((R1AU/VREF)**FALLOFF),VAV
	write (*,'(A,2F7.3)')
     &  'Total ecliptic and polar D average at 1 AU height this rotation =',
     &	DAV*((VREF/R1AU)**FALLOFF), DAVP*((VREF/R1AU)**FALLOFF)
	write (*,'(A,F9.1,F9.3,F7.3)')
     &  '1 AU ecliptic tomographic average V and D and base D =', VAV, DAV*((VREF/R1AU)**FALLOFF)-DB, DB
C Set the new base density
C	DEN1AU 	= 3.*DAV*((VREF/R1AU)**FALLOFF)			! Reset the total 1 AU density
	DBSS	= DB*((R1AU/VREF)**FALLOFF)			! Base density at the source surface
			
	do n=1,nT
	    do i=1,nLng
		do j=1,nLat
			DBASE(i,j,n) = DBSS
		end do
	    end do
	end do
        return
	end