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 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 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,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'/ double precision OBS,R SIGOLD = SIG ! Only used in Say statement 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 OBS = OBSV(I) if (ID .eq. 2) OBS = 1.0d0*OBSV(I)*OBSV(I) ! OK 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 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 SIG = SIG+R*R end if end do !$omp end parallel 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 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