C+ C NAME: C MkVModeltd C PURPOSE: C Make model line of sight velocities from a velocity map at a given height. C The LOS. values are assumed to vary with the densities from a model C relative to a mean which includes densities determined from that model. C Note - this is somewhat unlike the LOS. weights determined for densities. C CATEGORY: C Data processing C CALLING SEQUENCE: C call MkVModeltd(XCbe,XCtbeg,XCtend,XEV,XCtpr,XLON,XLAT,RP, C WTS1,DFAC,VFAC,PW,NL,NLOS,NLOSP1,VMAP,VLIM,DMAP, C nLng,nLat,nT,RRS,VM,VWTij) C INPUTS: C XCbe(2,nT) real Beginning and ending Carrington variables C XCtbeg real Beginning time interval C XCtend real Ending time interval C XEV(NL) real Source elongations C XCtpr(NL) real*8 Projected time value on surface C XLON(NLOSP1,NL) real Projected Carr. rot. value of point on L.O.S. C XLAT(NLOSP1,NL) real Heliographic lat. (in deg.) point on L.O.S. C RP (NLOSP1,NL) real Distance above Sun of point on L.O.S. C WTS1(NLOS ,NL) real Weights of each point along the L.O.S. C DFAC(NLOSP1,NL) real Density factors for each L.O.S. point C VFAC(NLOSP1,NL) real Velocity factors for each L.O.S. point C PW real Density power C NL integer Number of G-level data points C NLOS integer Number of L.O.S. distance segments C NLOSP1 integer Number of L.O.S. distance segments + 1 C VMAP(nLng,nLat,nT) real Velocity map C VLIM real Linit on velocity (maximum) C DMAP(nLng,nLat,nT) real Density map C nT integer Number of time intervals C nLng integer Number of longitude points in DMAP C nLat integer Number of latitude points in DMAP C dRR real distance between reference maps C RRS real Height of reference maps C OUTPUTS: C VM(NL) real Model Velocities for a given source C VWTij(NLOS ,NL) real L.O.S. weights C FUNCTIONS/SUBROUTINES: C Get3DTval C PROCEDURE: C MODIFICATION HISTORY: C NOV, 1995 B. Jackson (STEL,UCSD), MAR, 1999 B. Jackson (UCSD) to C include VFAC C- subroutine MkVModeltd(XCbe,XCtbeg,XCtend,XEV,XCtpr,XLON,XLAT,RP, & WTS1,DFAC,VFAC,PW,NL,NLOS,NLOSP1,VMAP,VLIM, & DMAP,nLng,nLat,nT,RRS,VM,VWTij) logical bVbnd real XEV(NL), ! Source elongations & XCbe(2,nT), ! Beginning and ending Carr. variables & XLON(NLOSP1,NL), ! Projected Carr. rot. value of point on L.O.S. & XLAT(NLOSP1,NL), ! Heliographic lat. (in deg.) point on L.O.S. & RP (NLOSP1,NL), ! Distance above Sun of point on L.O.S. & WTS1(NLOS ,NL), ! Weights of each point along the L.O.S. & DFAC(NLOSP1,NL), ! Density factors for each L.O.S. point & VFAC(NLOSP1,NL), ! Velocity factors for each L.O.S. point & VMAP(nLng,nLat,nT), ! Velocity map & DMAP(nLng,nLat,nT), ! Density map & VM(NL), ! Model velocities for a given source & VWTij(NLOS,NL) ! L.O.S. weights real*8 XCtpr(NLOSP1,NL) ! Projected time value on surface real*8 XCtbeg,XCtend ! Fixed 6/11/04 BVJ BAD = BadR4() NDENj = 0 do I=1,NL do J=1,NLOS call Get3DTval(XCbe,XCtbeg,XCtend,nLng,nLat,nT,DMAP,1, & XLON(J,I),XLAT(J,I),XCtpr(J,I),DENj) if (DENj .eq. BAD) stop ' Bad density in MAKE_VMODEL' DENj = DENj*DFAC(J,I)*((RRS/RP(J,I))**2) C if(DENj.lt.0.) print *, 'Bad density', J,I,XLON(J,I),XLAT(J,I),XCtpr(J,I),DENj,DFAC(J,I),RRS,RP(J,I),WTS1(J,I),PW if(DENj.lt.0.) NDENj = NDENj + 1 if(DENj.lt.0.) DENj = 0.001 VWTij(J,I) = (DENj**(2.0*PW))*WTS1(J,I) ! Original C VWTij(J,I) = (DENj**PW)*WTS1(J,I)*cosd(XLAT(J,I)) ! Tried 02/02/01 end do end do if(NDENj.ne.0) print *, NDENj, ' L.O.S. density values in MkVmodeltd are below zero' do I=1,NL VPERP = 0 VWT = 0 VWTi = 0 sinE = sind(abs(XEV(I))) do J=1,NLOS VSN = sinE/RP(J,I) call Get3DTval(XCbe,XCtbeg,XCtend,nLng,nLat,nT,VMAP,1, & XLON(J,I),XLAT(J,I),XCtpr(J,I),VELO) if (VELO .eq. BAD) stop 'Bad velocity in MAKE_VMODEL' VELO = VELO*VFAC(J,I) ! Added B. Jackson 3/99 C VPERP = VPERP + VWTij(J,I)*VSN*VELO ! Original C VWT = VWT + VWTij(J,I) C VWTi = VWTi + VWTij(J,I) C VWTij(J,I) = VWTij(J,I)*VSN ! Added B. Jackson 01/30/01 C VWT = VWT + VWTij(J,I) C VPERP = VPERP + VWTij(J,I)*VELO C VWTi = VWTi + VWTij(J,I) C VWTij(J,I) = VWTij(J,I)*VSN ! Old run long ago. C VPERP = VPERP + VWTij(J,I)*VSN*VELO ! 01/31/01A C VWT = VWT + VWTij(J,I)*VSN C VWTi = VWTi + VWTij(J,I)*VSN C VWTij(J,I) = VWTij(J,I)*VSN C VPERP = VPERP + VWTij(J,I)*VSN*VELO ! 01/31/01B Seemed ~best so far C VWT = VWT + VWTij(J,I) C VWTi = VWTi + VWTij(J,I)*VSN*VELO C VWTij(J,I) = VWTij(J,I)*VSN*VELO C VPERP = VPERP + VWTij(J,I)*VSN*VELO ! 02/01/01A C VWT = VWT + VWTij(J,I) C VWTi = VWTi + VWTij(J,I)/VSN C VWTij(J,I) = VWTij(J,I)/VSN C VPERP = VPERP + VWTij(J,I)*VSN*VELO ! 02/01/01B (Original) C VWT = VWT + VWTij(J,I) C VWTi = VWTi + VWTij(J,I) C VWTij(J,I) = VWTij(J,I) C VPERP = VPERP + SQRT(VWTij(J,I))*VSN*VELO ! 02/01/01C C VWT = VWT + SQRT(VWTij(J,I)) C VWTi = VWTi + SQRT(VWTij(J,I))*VSN*VELO C VWTij(J,I) = SQRT(VWTij(J,I))*VSN*VELO C VPERP = VPERP + VWTij(J,I)*VSN*VELO ! 01/31/01B Seemed ~best so far C VWT = VWT + VWTij(J,I) C VWTi = VWTi + VWTij(J,I)*VSN*VELO C VWTij(J,I) = VWTij(J,I)*VSN*VELO C VPERP = VPERP + (VWTij(J,I)**2)*VSN*VELO ! 02/02/01A C VWT = VWT + (VWTij(J,I)**2) C VWTi = VWTi + (VWTij(J,I)**2)*VSN*VELO C VWTij(J,I) = (VWTij(J,I)**2)*VSN*VELO VW = VWTij(J,I)*VSN*VELO ! 01/31/01B rewritten VPERP = VPERP + VW VWT = VWT + VWTij(J,I) VWTi = VWTi + VW VWTij(J,I) = VW end do VM(I) = VPERP/VWT do J=1,NLOS C VWTij(J,I) = VWTij(J,I)/VWT ! Added B. Jackson 01/30/01 VWTij(J,I) = VWTij(J,I)/VWTi ! Original end do end do return end