C+
C NAME:
C	FixModeltdn
C PURPOSE:
C	To determine the change needed for the various lines of sight (LOS)
C	[g = m/<m> ==> dm = <m> dg]
C CATEGORY:
C	Data processing
C CALLING SEQUENCE:
C	call FixModeltdn(ID,Nit,NL,OBSV,MODV,PW,NBS,SIG,FIX,SSIG,RAT)
C INPUTS:
C	ID		integer		1: Fix V model
C					2: Fix G model
C					3: Fix D model
C	Nit		integer 	iteration number
C	NL		integer		# data points
C	OBSV(NL)	real		Observed values
C	MODV(NL)	real		Model values
C	SIG		real		previous convergence criteria
C	PW		real    	Power of G
C	NBS(NL)		integer 	Bad source
C OUTPUTS:
C	SIG		real		new convergence criteria
C	FIX(NL)		real		Ratio of observed to model values	????
C	SSIG(NL)	real		deviation from mean			????
C	RAT		real		Ratio by which to multiply DEN1AU (G only)
C CALLS:
C PROCEDURE:
C MODIFICATION HISTORY:
C	NOV, 1995 B. Jackson (STEL,UCSD)
C-
	subroutine FixModeltdn(ID,Nit,NL,OBSV,MODV,PW,NBS,SIG,FIXR,SSIG,RAT)
	real		OBSV(NL),	! Observed G-levels
     &			MODV(NL),	! Modeled G-levels
     &			FIXR(NL),	! Ratio of observed to modeled G-values
     &			SSIG(NL)	! G-source deviation from mean

	integer		NBS(NL)		! Bad source value
	character	cStr*100,
     &			cID(3)		/'V','G','B'/

C	double precision OBS,R

	SIGOLD = SIG			! Only used in Say statement
	NitM   = 20
	NNBSU  = 0
	NNBSL  = 0
	NNBST  = 0
	SIG = 0
	RAT = 0				! Only useful for ID=1 (G level)
	NLL = 0
!$omp parallel do private(I,OBS,R) reduction(+:SIG,RAT,NLL)
	do I=1,NL
	    if(NBS(I).ne.0) then
	        OBS = OBSV(I)
	        if (ID .eq. 2) OBS = OBSV(I)*OBSV(I) ! OK 7/14/00 B. Jackson
	        R = OBS/MODV(I)
 		FIXR(I) = 1.0

		if(Nit.gt.NitM.and.I.eq.72458) print *, ' Value', I, R, OBS, MODV(I)
		if(ID.eq.3) NNBST = NNBST + 1
		if (R.gt.10.0) then
		  R = 10.0
		  if(ID.eq.3) NNBSU = NNBSU + 1
		  if(I.eq.72458) print *, ' Upper limit', I, NNBSU, OBS, MODV(I)
		  if(ID.eq.3.and.Nit.gt.NitM) then
		    NBS(I) = 0
		    go to 1111
		  end if	  
		end if
		if (R.lt.0.1) then
		  if(ID.ne.3) R = 0.1
		  if(R.lt.0.01.and.ID.eq.3) R = 0.01
		  if(ID.eq.3) NNBSL = NNBSL + 1
C		  if(I.eq.72458) print *, ' Lower limit', I, NNBSL, OBS, MODV(I)
		  if(ID.eq.3.and.Nit.gt.NitM) then
		    NBS(I) = 0
		    go to 1111
		  end if
		end if
		FIXR(I) = R		! In 6/10/00 B. Jackson
C	    	FIXR(I) = R**PW		! Out 6/10/00 B. Jackson
		NLL = NLL + 1
C		RAT = RAT+SQRT(1/R)	! Out 7/9/00 B. Jackson
		RAT = RAT + (1./R)	! In 7/9/00 B. Jackson
		R = R-1
		SSIG(I) = R
		SIG = SIG+R*R
	    end if
 1111	    continue
	end do
!$omp end parallel do

	if (ID .eq. 3 .and. NNBST .ne. 0 .and. Nit .le. NitM) 
     &    write (*,'(2(I8,A))') NNBSU, ' LOS above an upper limit this iteration and are set zero',NNBST-NNBSU,' remain' 
	if (ID .eq. 3 .and. NNBST .ne. 0 .and. Nit .le. NitM) 
     &    write (*,'(2(I8,A))') NNBSL, ' LOS below a  lower limit this iteration and are set zero',NNBST-NNBSL-NNBSU,' remain'
	if (ID .eq. 3 .and. NNBST .ne. 0 .and. Nit .gt. NitM) 
     &    write (*,'(2(I8,A))') NNBSU, ' LOS above an upper limit this iteration and are set zero',NNBST-NNBSU,' remain' 
	if (ID .eq. 3 .and. NNBST .ne. 0 .and. Nit .gt. NitM) 
     &    write (*,'(2(I8,A))') NNBSL, ' LOS below a  lower limit this iteration and are set zero',NNBST-NNBSL-NNBSU,' remain'


	if(ID.eq.1) RAT = RAT/NLL
	if(ID.eq.2) RAT = (RAT/NLL)**(1./PW)	! In 7/14/00 B. Jackson
	if(ID.eq.3) RAT =  RAT/NLL
C	if(ID.eq.2) RAT = (RAT/NLL)**2.0	! Out 7/14/00 B. Jackson
	SIG = sqrt(SIG/NLL)

!$omp parallel do private(I)
	do I=1,NL
	    if(NBS(I).ne.0) SSIG(I) = SSIG(I)/SIG
	end do
!$omp end parallel do

	write (cStr,'(A,F6.3,A,F7.3,A)') cID(ID)//' convergence = ',SIG,
     &		', from last =',abs(1-SIG/SIGOLD)*100,'%'

	if (ID .eq. 1) write (cStr(itrim(cStr)+1:),'(A,F7.3)') '#Summed model to observed velocity ratio ',RAT
	if (ID .eq. 2) write (cStr(itrim(cStr)+1:),'(A,F7.3)') '#Summed model to observed density ratio ',RAT
	if (ID .eq. 3) write (cStr(itrim(cStr)+1:),'(A,F7.3)') '#Summed model to observed density ratio ',RAT

	call Say('FixModeltdn','I','Info',cStr)

	return
	end