C+ C NAME: C ExternalRead_c.f Must use to accomodate variable nT values C PURPOSE: C Read the externally-provided volumetric elements provided by an external 3D-MHD program . C These volumetric elements are read from files provided that are interpolated with the cadence C and in the heliographic coordinate system needed by the UCSD tomography program. C These files needed for the UCSD program are expected to be provided at the 3D-MHD program's run location C by ExternalConvert C CATEGORY: C I/O C CALLING SEQUENCE: C call ExternalRead_c(cWild3DMHD,MHDs,nLng,nLat,nMap,nT,nTmax,LLfstt,LLEndd,JDCar,nCar,XCEA,NCOFF,iYr,XCintDG, C RRS,RADMS,RAD1,dRR,RADS,FALLOFFN,FALLOFFT,FALLOFFBR,FALLOFFBT,FALLOFFBN,DDD1,TTT1,VVV3,BBB3,iNUM) C C INPUTS: C cWild3DMHD character*80 input file name C MHDs integer Which 3D MHD program provides the input? 1 - ENLIL, 2 - MSFLUKSS, 3 - HAF3DMHD C nLng integer Number of Longitude bins C nLat integer Number of Latitude bins C nMap integer Number of Map heights C nT integer number of times C nTmax integer Maximum number of times possible C LLfstt integer Beginning increment of daily averages C LLEndd integer Ending number of 6-hour averages C JDCar(nCar) real*8 Julian date at the beginning of each Carrington Rotation C nCar integer Carrington rotation maximum number C XCEA real Location of the Earth at in carrington rotation value c NCOFF integer Carrington notation number offset C iYr integer Beginning year of the tomography sequence C XCintDG(nTmax) real*8 Day of Year C RRS real Beginning Height of the IPS modeling C RADMS real Beginning Height of the Magnetic Field pick-up C RAD1 real Beginning Height of the 3D-MHD modeling C dRR real Outward step height of the modeling C FALLOFFN real Fall off in density C FALLOFFT real Fall off in temperature C FALLOFFBR real Fall off in Br C FALLOFFBT real Fall off in Bt C FALLOFFBN real Fall off in Bn C C OUTPUTS: C RADS(nMap+1) real Heights input from the model (The first height is RADMS). C DDD1(nLng,nLat,NMap+1,nT) real Input 1 component density C TTT1(nLng,nLat,NMap+1,nT) real Input 1 component temperature C VVV3(nLng,nLat,NMap+1,nT,3) real Input 3 component velocity (r,t,n) C BBB3(nLng,nLat,NMap+1,nT,3) real Input 3 component magnetic field (r,t,n) C iNUM integer # of files read C C MODIFICATION HISTORY: C November-2015, Bernard Jacks Must use to accomodate variable nT valueson (UCSD) C- subroutine ExternalRead_c(cWild3DMHD,MHDs,nLng,nLat,nMap,nT,nTmax,LLfstt,LLEndd,JDCar,nCar,XCEA,NCOFF,iYr,XCintDG, & RRS,dRR,FALLOFFN,FALLOFFT,FALLOFFBR,FALLOFFBT,FALLOFFBN,DDD1,TTT1,VVV3,BBB3,iNUM) real XCEA(nT), & DDD1(nLng,nLat,nMap,nT), & TTT1(nLng,nLat,nMap,nT), & VVV3(nLng,nLat,nMap,nT,3), & BBB3(nLng,nLat,nMap,nT,3), & RADS(nMap), & VVV31(nLng,nLat,nMap,nT), !scratch files & VVV32(nLng,nLat,nMap,nT), & VVV33(nLng,nLat,nMap,nT), & BBB31(nLng,nLat,nMap,nT), & BBB32(nLng,nLat,nMap,nT), & BBB33(nLng,nLat,nMap,nT) real*8 JDCar(nCar), & JD, JEpoch, MJDRefB, MJDRef real*8 XCintDG(nT) character cdate*8 character cfile*80 character ccfile*80 character cWild*80 character cheader*132 character cWild3DMHD*80 character cFmtF4*9 /'(55F10.4)'/ character cMon*3 include 'dirspec.h' bad = badr4() badD = -999.9999 badV = -999.9999 badB = -999.9999 badT = -999.9999 print *, ' ' if(MHDS.eq.1) then write(*,'(A,4I4)') 'Into external read for ENLIL inputs',nLng,nLat,nMap,nT cfile = cWild3DMHD INN = 12 + 7 ! ./mhd_files/ = 12, ENLIL_ = 7 (begins at next character) end if if(MHDS.eq.2) then write(*,'(A,4I4)') 'Into external read for MSFLUKSS inputs' cfile = cWild3DMHD INN = 12 + 11 ! ./mhd_files/ = 12, MS-FLUKSS_ = 11 (begins at next character) end if if(MHDS.eq.3) print *, 'Into external read for HAF3DMHD inputs' Ifirst = 0 NNtot = 0 NNtotE = 0 iNUM = 0 Doy = sngl(XCintDG(1)) ! At what DOY do the ENLIL data files begin? (BVJ 12/28/2018) call Julian(10,iYr,Doy,MJDrefB,JEpoch) ! Where do the ENLIL data files begin in MJD? (BVJ 12/28/2018) do II=1,nT NNtotE = 0 if(II.ge.LLfstt.and.II.le.LLEndd) then ! Maybe needed someday. XC = XCEA(II) + float(NCOFF) ! position of Earth in Carrington coordinates. C write(*,'(F11.5,F8.3)' ) XC, XCintDG(II) C Modifications BVJ MJDref = XCintDG(II) - XCintDG(1) + MJDrefB Doy = sngl(XCintDG(1)) iDoy = nint(Doy) iH = nint((Doy - iDoy)*24.0) call Julian(11,iYrr,Doy,MJDref,JEpoch) ! What dates do the ENLIL data files have in year and day of year? iDoy = nint(Doy) C End Modifications C Doy = sngl(XCintDG(II)) ! Need to remove (BVJ 12/28/2018) C iDoy = Doy ! Need to remove (BVJ 12/28/2018) C print *, iYrr, DoY, iDoY ! This is the time of Earth at the Carrington rotation value at Earth call DATE_DOY(1,iYrr,cMon,iMon,iDay,iDoy) C print *, iYrr, iMon, iDay, INN ! This is the year, month, and day at the beginning of the output sequence ! The first data begins at the next UT interval specified if(iYrr.lt.2000) iY = iYrr - 1900 if(iYrr.ge.2000) iY = iYrr - 2000 mo = iMon iD = iDay iH = nint((Doy - iDoy)*24.0) write(cfile(INN:INN+18),'(F10.5,A,4I2.2)') XC,'_',iY,mo,iD,iH C write (*,'(A,A50)') 'cfile after additions =', cFile open (13, file=cFile,status='old',recl=1000,access='sequential',form='formatted',iostat=iRead3DMHD) C print*,'to here after file open attempt' C print *, ' ' if(iRead3DMHD.eq.0) write(*,'(A,I3,A,A40)') 'II =',II,' The file opened was ',cfile if(iRead3DMHD.ne.0) then close(13) write(*,'(A,I3,A,A40)') 'II =',II,' The file not found was ',cfile go to 1999 end if read (13,'(A)',iostat=iRead3DMHD) cheader ! read header - someday use parameters? if(iread3DMHD.ne.0) then close(13) print *, 'Something is wrong. The header lines could not be read.' go to 1999 end if Ifirst = Ifirst + 1 if(Ifirst.eq.1) write(*,'(A,I4)') 'Solar distances read; nmap = ',nMap read (13,'(55F10.6)',iostat=iRead3DMHD) (RADS(N),N=1,nMAP) ! read solar distances if(iread3DMHD.ne.0) then close(13) print *, 'Something is wrong. The solar distances could not be read.' go to 1999 end if if(Ifirst.eq.1) write(*,'(31F10.6)') (RADS(N),N=1,nMAP) NBDDD1 = 0 NBTTT1 = 0 NBVVV1 = 0 NBVVV2 = 0 NBVVV3 = 0 NBBBB1 = 0 NBBBB2 = 0 NBBBB3 = 0 do IP=1,8 do N=1,nMAP FALLN = RADS(N)**FALLOFFN FALLT = RADS(N)**FALLOFFT FALLBR = RADS(N)**FALLOFFBR FALLBT = RADS(N)**FALLOFFBT FALLBN = RADS(N)**FALLOFFBN C if(IP.eq.1.and.II.eq.20) C & write(*,'(3I4,5F6.3,4F6.2)') II,IP,N,FALLOFFN,FALLOFFT,FALLOFFBR,FALLOFFBT,FALLOFFBN,FALLN,FALLBR,FALLBT,FALLBN do J=1,nLat C print*, 'before all parameter read', IP,J,N, II if(IP.eq.1) read (13,cFmtF4,iostat=iRead3DMHD) (DDD1 (I,J,N,II),I=1,nLng) ! read density if(IP.eq.2) read (13,cFmtF4,iostat=iRead3DMHD) (VVV31(I,J,N,II),I=1,nLng) ! read Vr C if(IP.eq.2.and.J.eq.5.and.N.eq. 1.and.II.eq.22) write (*,cFmtF4) (VVV31(I,J,N,II), I=1,nLng) C if(IP.eq.2.and.J.eq.5.and.N.eq.NMAP.and.II.eq.22) write (*,cFmtF4) (VVV31(I,J,N,II), I=1,nLng) if(IP.eq.3) read (13,cFmtF4,iostat=iRead3DMHD) (VVV32(I,J,N,II),I=1,nLng) ! read Vt if(IP.eq.4) read (13,cFmtF4,iostat=iRead3DMHD) (VVV33(I,J,N,II),I=1,nLng) ! read Vn if(IP.eq.5) read (13,cFmtF4,iostat=iRead3DMHD) (BBB31(I,J,N,II),I=1,nLng) ! read Br if(IP.eq.6) read (13,cFmtF4,iostat=iRead3DMHD) (BBB32(I,J,N,II),I=1,nLng) ! read Bt if(IP.eq.7) read (13,cFmtF4,iostat=iRead3DMHD) (BBB33(I,J,N,II),I=1,nLng) ! read Bn if(IP.eq.8) read (13,cFmtF4,iostat=iRead3DMHD) (TTT1 (I,J,N,II),I=1,nLng) ! read temperature C print*, 'after all parameter read', IP,J,N, II do III=1, nlng if(IP.eq.1) then if(DDD1(III,J,N,II).gt.BadD) then DDD1(III,J,N,II) = DDD1(III,J,N,II)/FALLN C if(III.eq.20.and.J.eq.6.and.II.eq.24) write(*,'(A,4I4,F10.1,2F10.5)'), C & 'III, J, N, II, DDD1',III,J,N,II,DDD1(III,J,N,II),FALLN,RADS(N) else DDD1(III,J,N,II) = Bad NBDDD1 = NBDDD1 + 1 end if end if if(IP.eq.2) then if(VVV31(III,J,N,II).le.BadV) then VVV31(III,J,N,II) = Bad NBVVV1 = NBVVV1 + 1 end if end if if(IP.eq.3) then if(VVV32(III,J,N,II).le.BadV) then VVV32(III,J,N,II) = Bad NBVVV2 = NBVVV2 + 1 end if end if if(IP.eq.4) then if(VVV33(III,J,N,II).le.BadV) then VVV33(III,J,N,II) = Bad NBVVV3 = NBVVV3 + 1 end if end if if(IP.eq.5) then if(BBB31(III,J,N,II).gt.BadB) then BBB31(III,J,N,II) = BBB31(III,J,N,II)/FALLBR else BBB31(III,J,N,II) = Bad NBBBB1 = NBBBB1 + 1 end if end if if(IP.eq.6) then C print*, 'First 6 parameter read', IP,J,N, II, III, nLng, nLat, nMapm1, NF, IINC, FALLBT if(BBB32(III,J,N,II).gt.BadB) then BBB32(III,J,N,II) = BBB32(III,J,N,II)/FALLBT else BBB32(III,J,N,II) = Bad NBBBB2 = NBBBB2 + 1 C print*, 'Second 7 parameter read', IP,J,N, II, III, nLng, nLat, nMapm1, NF, IINC, FALLBT end if end if If(IP.eq.7) then if(BBB33(III,J,N,II).gt.BadB) then BBB33(III,J,N,II) = BBB33(III,J,N,II)/FALLBN else BBB33(III,J,N,II) = Bad NBBBB3 = NBBBB3 + 1 end if end if if(IP.eq.8) then if(TTT1(III,J,N,II).gt.BadT) then TTT1(III,J,N,II) = 1000.0*TTT1(III,J,N,II)/FALLT else TTT1(III,J,N,II) = Bad NBTTT1 = NBTTT1 + 1 end if end if end do end do end do end do iNUM = iNUM + 1 close(13) NNtot = NBDDD1+NBVVV1+NBVVV2+NBVVV3+NBBBB1+NBBBB2+NBBBB3+NBTTT1 C if(NNtot .eq. NNtotE) write(*,'(A,I7)') 'NNtot = ',NNtot if(NNtot .ne. 0) then if(NBDDD1.ne.0) write(*,'(A,I3,A,I6,A)') 'II =',II,' There were',NBDDD1,' bad points in this density read' if(NBVVV1.ne.0) write(*,'(A,I3,A,I6,A)') 'II =',II,' There were',NBVVV1,' bad points in this radial velocity read' if(NBVVV2.ne.0) write(*,'(A,I3,A,I6,A)') 'II =',II,' There were',NBVVV2,' bad points in this tangential velocity read' if(NBVVV3.ne.0) write(*,'(A,I3,A,I6,A)') 'II =',II,' There were',NBVVV3,' bad points in this normal velocity read' if(NBBBB1.ne.0) write(*,'(A,I3,A,I6,A)') 'II =',II,' There were',NBBBB1,' bad points in this radial field read' if(NBBBB2.ne.0) write(*,'(A,I3,A,I6,A)') 'II =',II,' There were',NBBBB2,' bad points in this tangential field read' if(NBBBB3.ne.0) write(*,'(A,I3,A,I6,A)') 'II =',II,' There were',NBBBB3,' bad points in this normal field read' if(NBTTT1.ne.0) write(*,'(A,I3,A,I6,A)') 'II =',II,' There were',NBTTT1,' bad points in this temperature read' print *, ' ' end if C NNtotE = NNtot 1999 continue do N=1,nMAP do J=1,nLat do I=1,nLng VVV3(I,J,N,II,1) = VVV31(I,J,N,II) VVV3(I,J,N,II,2) = VVV32(I,J,N,II) VVV3(I,J,N,II,3) = VVV33(I,J,N,II) BBB3(I,J,N,II,1) = BBB31(I,J,N,II) BBB3(I,J,N,II,2) = BBB32(I,J,N,II) BBB3(I,J,N,II,3) = BBB33(I,J,N,II) end do end do end do end if ! Maybe remove someday end do print *, ' ' if(MHDS.eq.1) then if(iNUM.eq.0) write(*,'(A)') 'The external read for ENLIL input files was not successful.' if(iNUM.gt.0) write(*,'(A,I3,A,I3,A)') 'The external read for ENLIL files was successful.', & iNUM,' of',nT, ' files were read.' end if if(MHDS.eq.2) then if(iNUM.eq.0) write(*,'(A)') 'The external read for MSFLUKSS input files was not successful.' if(iNUM.gt.0) write(*,'(A,I3,A,I3,A)') 'The external read for MSFLUKSS files was successful.', & iNUM,' of',nT, ' files were read.' end if if(MHDS.eq.3) then if(iNUM.eq.0) write(*,'(A)') 'The external read for HAF3DMHD input files was not successful.' if(iNUM.gt.0) write(*,'(A,I3,A,I3,A)') 'The external read for HAF3DMHD files was successful.', & iNUM,' of',nT, ' files were read.' end if return end