C+ C NAME: C interpolate_enlil_nn.f C PURPOSE: C To interpolate IHG maps from ENLIL to the UCSD HG rotating coordinate system at one given time. C UCSD assumes that 0 is when the Earth is at the right end of a three rotation volume - like 4 to 7 in Carrington Variable C IHG assumes the start in longitude is goes from 0 to 360. Thus, if you know where the Earth is in IHG then at the time Earth C is at 4, this is the location of the Earth in IHG. C Earthlng is the location of the Earth in IHG at the given time. IHG values are incremented from 0 to 360 degrees in this volume, C or thus from -Earthlng to 360 -Earthlng. These are given in values of Edeg. We are given input IHG values from 0 to 360. C We also know the Carrington variable of the Earth at this time. This is given as XMAP with EARTH as the external function. The values C of XMAP range from one end of the Carrington variable values (XCTEST0 to XCTEST2), and start at XMAP - XCTEST0, and go in C increments of the difference between the Earth value of XMAP (XMAPE), in increments of 20 IHG degrees in the UCSD volume, C or slightly larger values than 20 degrees, given as the multiplier of 20 degrees and the daily rotation period in IHG divided C by the daily rotation period in the UCSD corotating system that is called DXMAP positive from XCTEST0. C The grid of locations where UCSD data are needed are well known and these go from XCTEST0 to XCTEST2 in 20 degree longitude spacings C or at 20/360 or increments of 0.05555555555556. C Let's also make a grid of XMAP locations where the data are at each time. These are at -Earthlng that corresponds to XMAPE +Earthlng C in terms of increments of DXMAP. C C CATEGORY: C Data processing C CALLING SEQUENCE: C call interpolate_enlil_n(iLng,iLat,iMap,NNT,nTmax,nLng,nLat,nMap,iYr,Doy8,nCar,JDCar,EarthLng,XCEA,XCtest0,XCtest2, C & DD1,TT1,VV3,BB3,DDD1,TTT1,VVV3,BBB3) C INPUTS: C iLng integer # ENLIL Longitude points C iLat integer # ENLIL Latitude points C iMap integer # ENLIL solar distances. For ENLIL, nMap - 1 C NNT integer specific time index of nTmax value C nTmax integer Maximum number of times allowed C nLng integer # UCSD tomography Longitude points C nLat integer # UCSD tomography Latitude points C nMap integer # UCSD tomography solar distances C nCar parameter C JDCar(nCar) C EarthLng real Earth IHG heliographic longitude at the time of the volume C XCEA(I) real Earth Carrington variable value at the time of the volume C XCtest0 real Begining of the UCSD three Carrington rotation volume C XCtest2 real Ending of the UCSD three Carrington rotation volume C DD1(iLng,iLat,iMap+1,nTmax) real ENLIL 4-dimensional densities C TT1(iLng,iLat,iMap+1,nTmax) real ENLIL 4-dimensional temperatures C VV3(iLng,iLat,iMap+1,nTmax,3) real ENLIL 5-dimensional velocities C BB3(iLng,iLat,iMap+1,nTmax,3) real ENLIL 5-dimensional magnetic fields C OUTPUTS: C DDD1(nLng,nLat,nMap,nTmax) real Tomography 4-dimensional densities C TTT1(nLng,nLat,nMap,nTmax) real Tomography 4-dimensional temperatures C VVV3(nLng,nLat,nMap,nTmaxG,3) real Tomography 5-dimensional velocities C BBB3(nLng,nLat,nMap,nTmaxG,3) real Tomography 5-dimensional magnetic fields C FUNCTIONS/SUBROUTINES: C PROCEDURE: C Bad values (indicated by BadR4()) are processed C MODIFICATION HISTORY: C MAY, 1999 B. Jackson (STEL,UCSD), Modified 2008/03/03 BVJ C- subroutine interpolate_enlil_nn(iPrint,iLng,iLat,iMap,NNT,nTmax,nLng,nLat,nMap,iYr,Doy8,nCar,JDCar,EarthLng,XCtest0,XCtest2, & DD1,TT1,VV3,BB3,DDD1,TTT1,VVV3,BBB3) real DD1 (iLng,iLat,iMap+1,nTmax), ! ENLIL 4-dimensional densities & TT1 (iLng,iLat,iMap+1,nTmax), ! ENLIL 4-dimensional temperatures & VV3 (iLng,iLat,iMap+1,nTmax,3), ! ENLIL 5-dimensional velocities & BB3 (iLng,iLat,iMap+1,nTmax,3), ! ENLIL 5-dimensional magnetic fields & DDD1(nLng,nLat,nMap, nTmax), ! Tomography 4-dimensional densities & TTT1(nLng,nLat,nMap, nTmax), ! Tomography 4-dimensional temperatures & VVV3(nLng,nLat,nMap, nTmax,3), ! Tomography 5-dimensional velocities & BBB3(nLng,nLat,nMap, nTmax,3) ! Tomography 5-dimensional magnetic fields real*8 JDCar(nCar), & Doy8 real XMAP(nTmax+2), ! Scratch location of the tomography Carrington variable & VALX(nTmax+2), ! Scratch data value at the tomography Carrington variable location & ALONG(iLng*3+10) ! Scratch values of the input file longitude locations external SCALONG external EARTH common ALONGG C C Average the other non-Bad longitude values. C if(iPrint.eq.1) then print *, ' ' print *, 'Into interpolate_enlil_nn.f', NNT end if C DXDAY = 1.0/24.47 ! Siderial solar rotation in one day Edeg = 360.0/float(iLng-1) ! Number of IHG degrees per interval of input volume iLng3 = 3*iLng + 10 ! Ample # of inertial longitude steps from the input volume AMD = XCtest2 - XCtest0 ! Number of UCSD Carrington varaible values (usually 3.0) Tint = AMD/float(nLng-1) ! Interval of UCSD corotating volume Doy = sngl(Doy8) if(iPrint.eq.1) write(*,'(A,3F12.6)') ' AMD, Tint, DXDAY ', AMD, Tint, DXDAY if(iPrint.eq.1) write(*,'(A,I5,2F12.6)') 'iLng3, Edeg, EarthLng', iLng3, Edeg, EarthLng ALON = EARTH(iYr,Doy-0.5) ! Longitude of the UCSD HG value at Earth at this time minus 0.5 day ALONGG = ALON XMAPM = XMAP_SC_POS(SCALONG,iYr,Doy-0.5,nCar,JDCar) ! Carrington variable value at Earth minus 0.5 day from this time ALON = EARTH(iYr,Doy+0.5) ALONGG = ALON XMAPP = XMAP_SC_POS(SCALONG,iYr,Doy+0.5,nCar,JDCar) ! Carrington variable value at Earth plus 0.5 day from this time DXF = DXDAY/(XMAPP - XMAPM) ! Carrington variable difference in one day at this time DXMAP = DXF*Edeg/360.0 ! Translate increment of Carrington variable for input IHG coordinate C ALON = EARTH(iYr,Doy) ! Longitude of the UCSD HG value at Earth at this time ALONGG = ALON XMAPE = XMAP_SC_POS(SCALONG,iYr,Doy,nCar,JDCar) ! Carrington variable UCSD HG value of Earth at this time C if(iPrint.ge.1) write(*,'(A,F9.3,4F10.6)') 'ALON,XMAPE,XMAPP,DXF,DXMAP',ALON, XMAPE, XMAPP, DXF, DXMAP DEGDX = 360.0/Edeg ! Carrington variable increment in degrees of IHG input volumes DXMEA = (Earthlng/DEGDX) ! Carr. interval and fraction that Earth is in IHG from first value of data XMAP0 = XMAPE - DXMEA*DXMAP ! Map Location of zero value of data if(iPrint.eq.1) write(*,'(A,F12.5,3F11.4)') '1 Earthlng, DEGDX, DXMEA, XMAP0',Earthlng, DEGDX, DXMEA, XMAP0 if(XMAP0.gt.XCTEST0) XMAP0 = XMAP0 - 1.0*DXF ! Make sure the UCSD HG XMAP0 is lower than XCTEST0 if(XMAP0.gt.XCTEST0) XMAP0 = XMAP0 - 1.0*DXF if(iPrint.eq.1) write(*,'(A,F12.5,3F11.4)') '2 Earthlng, DEGDX, DXMEA, XMAP0',Earthlng, DEGDX, DXMEA, XMAP0 XMAP00 = XMAP0 do I=1,iLng if(XMAP00.le.XCTEST0) then XMAPMIN = XMAP00 IMIN = I end if XMAP00 = XMAP00 + DXMAP end do if(iPrint.eq.1) write(*,'(A,I5,F11.4)') 'IMIN, XMAPMIN',IMIN, XMAPMIN iLngm = iLng -2 do IJ=1,iLng3 ! XMAP(IJ) are the locations (from EarthLng in IHG) of the input volume IALONG = IMIN + (IJ-1) ALONG(IJ) = IALONG ! Goes from 1 - 17 -- lower value of interval. Must be filled. XMAP(IJ) = XMAPMIN + float(IJ-1)*DXMAP ! Goes from just below 4 - 7 and integrates with ALONG. Must be filled. if(IALONG.gt.iLngm) IMIN = -IJ + 1 end do if(iPrint.eq.1) then do IJ=1,iLng3 write(*,'(A,I5,2F12.4)') 'IJ, ALONG(IJ), XMAP(IJ)', IJ, ALONG(IJ), XMAP(IJ) end do end if nMapm = nMap-iMap TLOC = -Tint + XCtest0 do I=1,nLng TLOC = TLOC + Tint do IJ=1,iLng3-1 ELOCB = XMAP(IJ) TLOCM = TLOC-ELOCB if(XMAP(IJ).lt.TLOC.and.XMAP(IJ+1).gt.TLOC) then ! A sucessful match. II = nint(ALONG(IJ)) if(iPrint.eq.1) write(*,'(A,3I3,4F7.4)') 'af I,IJ,II.XMAP(IJ),TLOC,ELOCB,TLOCM', I,IJ,II,XMAP(IJ),TLOC,ELOCB,TLOCM do J=1,nLat do N=1,iMap DDD1(I,J,N,NNT) = (TLOC - ELOCB)*(DD1(II+1,J,N,NNT) - DD1(II,J,N,NNT))/Tint + DD1(II,J,N,NNT) TTT1(I,J,N,NNT) = (TLOC - ELOCB)*(TT1(II+1,J,N,NNT) - TT1(II,J,N,NNT))/Tint + TT1(II,J,N,NNT) VVV3(I,J,N,NNT,1) = (TLOC - ELOCB)*(VV3(II+1,J,N,NNT,1) - VV3(II,J,N,NNT,1))/Tint + VV3(II,J,N,NNT,1) VVV3(I,J,N,NNT,2) = (TLOC - ELOCB)*(VV3(II+1,J,N,NNT,2) - VV3(II,J,N,NNT,2))/Tint + VV3(II,J,N,NNT,2) VVV3(I,J,N,NNT,3) = (TLOC - ELOCB)*(VV3(II+1,J,N,NNT,3) - VV3(II,J,N,NNT,3))/Tint + VV3(II,J,N,NNT,3) BBB3(I,J,N,NNT,1) = (TLOC - ELOCB)*(BB3(II+1,J,N,NNT,1) - BB3(II,J,N,NNT,1))/Tint + BB3(II,J,N,NNT,1) BBB3(I,J,N,NNT,2) = (TLOC - ELOCB)*(BB3(II+1,J,N,NNT,2) - BB3(II,J,N,NNT,2))/Tint + BB3(II,J,N,NNT,2) BBB3(I,J,N,NNT,3) = (TLOC - ELOCB)*(BB3(II+1,J,N,NNT,3) - BB3(II,J,N,NNT,3))/Tint + BB3(II,J,N,NNT,3) C if(iPrint.eq.1.and.J.eq.1.and.N.eq.1.and.NNT.eq.21) print *, ' ' if(NNT.eq.1.or.NNT.eq.30.or.NNT.eq.47) then if(iPrint.eq.1.and.J.eq.6.and.N.eq.10) then write(*,'(A,10I4,3F10.4)'),'Density',NNT,I,J,N,II+1,II,ilng,iLat,iMap+1,nTmax, & DDD1(I,J,N,NNT),DD1(II,J,N,NNT),DD1(II+1,J,N,NNT) end if end if C & VVV3(I,J,N,NNT,1), VV3(II,J,N,NNT,1), VV3(II+1,J,N,NNT,1) end do end do end if end do do J=1,nLat do N=1,nMapm DDD1(I,J,N+iMap,NNT) = DDD1(I,J,iMap,NNT) TTT1(I,J,N+iMap,NNT) = TTT1(I,J,iMap,NNT) VVV3(I,J,N+iMap,NNT,1) = VVV3(I,J,iMap,NNT,1) VVV3(I,J,N+iMap,NNT,2) = VVV3(I,J,iMap,NNT,2) VVV3(I,J,N+iMap,NNT,3) = VVV3(I,J,iMap,NNT,3) BBB3(I,J,N+iMap,NNT,1) = BBB3(I,J,iMap,NNT,1) BBB3(I,J,N+iMap,NNT,2) = BBB3(I,J,iMap,NNT,2) BBB3(I,J,N+iMap,NNT,3) = BBB3(I,J,iMap,NNT,3) end do end do end do if(iPrint.eq.1) print *, 'End of interpolate_enlil_nn' C if(NNT.eq.21) stop return end