C+ C NAME: C FixModeltdn C PURPOSE: C To determine the change needed for the various lines of sight (LOS) C [g = m/ ==> dm = dg] C The velocity and density (Thomson scattering) analyses are handled the same but differently C than g-levels according to the mode input. C CATEGORY: C Data processing C CALLING SEQUENCE: C call FixModeltdn(ID,NL,OBSV,MODV,PW,NBS,SIG,FIX,SSIG,RAT) C INPUTS: C ID integer 1: Fix V model C 2: Fix G model (Only this mode does anything different. For ipshtd this mode is not used. C 3: Fix Thomson scattering model 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 FUNCTIONS/SUBROUTINES: C PROCEDURE: C MODIFICATION HISTORY: C NOV, 1995 B. Jackson (STEL,UCSD) C- subroutine FixModeltdn(ID,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','D'/ SIGOLD = SIG ! Only used in Say statement SIG = 0 . RAT = 0. ! Only useful for ID=1 (G level) NLL = 0 . PWD = 2.0 do I=1,NL OBS = OBSV(I) if (ID .eq. 2) OBS = OBSV(I)*OBSV(I) ! OK for g-value linearization 7/14/00 B. Jackson R = OBS/MODV(I) FIXR(I) = 1.0 if(NBS(I).ne.0) then FIXR(I) = R ! In 6/10/00 B. Jackson C FIXR(I) = R**PW ! Out 6/10/00 B. Jackson C if(ID.eq.3) FIXR(I) = R**PWD ! Original for Helios data, removed 3/26/01 if (FIXR(I).gt.10.0) FIXR(I) = 10.0 if (FIXR(I).lt.0.1) FIXR(I) = 0.1 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 C print *, ' I, SIG, R, RAT, SSIG(I)', I, SIG, R, RAT, SSIG(I) SIG = SIG + R*R end if end do 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 C print *, 'SIG, NLL, NL', SIG, NLL, NL SIG = sqrt(SIG/NLL) do I=1,NL if(NBS(I).ne.0) SSIG(I) = SSIG(I)/SIG end 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 .ge. 2) write (cStr(itrim(cStr)+1:),'(A,F7.3)') '#Summed model to observed density ratio ',RAT call Say('FixModeltdn','I','Info',cStr) return end