C+ C NAME: C ExternalWrite.f C PURPOSE: C Write the externally-provided volumetric elements provided by the UCSD 3D-MHD program in order to read them as a test. C These volumetric elements are usually 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 To operate through the end of the year, the program assumes that the starting hour of the tomography C is at 3 UT. The cadence is specified by nT and the values of XCEA. (BVJ 12/27/2018). C CATEGORY: C I/O C CALLING SEQUENCE: C call ExternalWrite(MHDs,nLng,nLat,nMap,nT,nTmax,LLFst,LLEnd,JDcar,nCAR,XCEA,NCOFF,iYr,XCintDG, C RRS,dRR,FALLOFFN,FALLOFFT,FALLOFFBR,FALLOFFBT,FALLOFFBN,DDD1,TTT1,VVV3,BBB3) C C INPUTS: 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 tomography program increments C nTmax integer Total number of tomography program increments C LLfst integer Beginning number of output file (>1) C LLEnd integer End number of output file 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 rotation offset C XCintDG(nTmax) real*8 Day of year C iYr integer The year of the beginning output file C RRS real Beginning Height of the IPS 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 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 C MODIFICATION HISTORY: C October-2015, Bernard Jackson (UCSD) C- subroutine ExternalWrite(MHDs,nLng,nLat,nMap,nT,nTmax,LLfst,LLEnd,JDCar,nCar,XCEA,NCOFF,iYr,XCintDG, & RRS,dRR,FALLOFFN,FALLOFFT,FALLOFFBR,FALLOFFBT,FALLOFFBN,DDD1,TTT1,VVV3,BBB3) real XCEA(nTmax), & DDD1(nLng,nLat,NMap,nTmax), & TTT1(nLng,nLat,NMap,nTmax), & VVV3(nLng,nLat,NMap,nTmax,3), & BBB3(nLng,nLat,NMap,nTmax,3), & VVV31(nLng,nLat,NMap,nTmax), !scratch files & VVV32(nLng,nLat,NMap,nTmax), & VVV33(nLng,nLat,NMap,nTmax), & BBB31(nLng,nLat,NMap,nTmax), & BBB32(nLng,nLat,NMap,nTmax), & BBB33(nLng,nLat,NMap,nTmax) real RADS(nMap) ! Scratch File real*8 JDCar(nCar), & MJDRefB,JEpoch,MJDRef real*8 XCintDG(nTmax) character cfileE*25 character cfileM*29 character cfileH*27 character cfile*29 character cWild3DMHD*80 character cFmtF4*9 /'(55F10.4)'/ character cMon*3 bad = badr4() badD = -9999.999 badV = -9999.999 badB = -9999.999 badT = -9999.999 C print *, ' ' print *, 'Into ExternalWrite', LLfst,LLEnd RAD = RRS - dRR do NN=1,nMap RAD = RAD + dRR RADS(NN) = RAD end do C write(*,'(4I3,3F10.4)') 25,5,10,25,BBB3(25,5,10,25,1),BBB3(25,5,10,25,2),BBB3(25,5,10,25,3) iNM = 0 Doy = sngl(abs(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 if(II .ge. LLfst .and. II .le. LLEnd) then if(abs(XCintDG(II)) .gt. -0.5d0) then MJDref = abs(XCintDG(II)) - abs(XCintDG(1)) + MJDrefB XC = XCEA(II) + float(NCOFF) ! position of Earth in Carrington coordinates Doy = sngl(abs(XCintDG(II))) iDoy = Doy iH = nint((Doy - iDoy)*24.0) C print*, 'XC = ',XC,'MJDref = ', MJDRef, 'Doy = ', Doy, 'Hour = ', iH call Julian(11,iYr,Doy,MJDref,JEpoch) ! Where do the ENLIL data files begin in year and day of year? iDoy = nint(Doy) C print *, iYr, DoY, iDoY ! This is the time of Earth at the Carrington rotation value at Earth call DATE_DOY(1,iYr,cMon,iMon,iDay,iDoy) c print *, iYr, iMon, iDay ! 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(iYr.lt.2000) iY = iYr - 1900 if(iYr.ge.2000) iY = iYr - 2000 mo = iMon iD = iDay C iH = nint((Doy - iDoy)*24.0) C write(*,'(F10.5,4I2.2)') XC,iY,mo,iD,iH if(MHDS.eq.1) then cfileE = 'ENLIL_ ' write(cfileE(7:25),'(F10.5,A,4I2.2)') XC,'_',iY,mo,iD,iH C print *, ' ' print *, 'Into external write for ENLIL files, cfileE = ', cfileE end if if(MHDS.eq.2) then cfileM = 'MS-FLUKSS_ ' C print *, cfileM write(*,'(F10.5,A,4I2.2)') XC,'_',iY,mo,iD,iH write(cfileM(11:29),'(F10.5,A,4I2.2)') XC,'_',iY,mo,iD,iH print *, 'Into external write for MS-FLUKSS files, cfileM = ', cfileM end if if(MHDS.eq.3) then cfileH = 'H3D-MHD_ ' write(cfileH(9:27),'(F10.5,A,3I2.2)') XC,iY,mo,iD,iH print *, 'Into external write for H3D-MHD files, cfileH = ', cfileH end if close(13) if(MHDS.eq.1) open (13, file=cFileE,status='new',recl=550,access='sequential',form='formatted',iostat=iWrt3DMHD) if(MHDS.eq.2) open (13, file=cFileM,status='new',recl=550,access='sequential',form='formatted',iostat=iWrt3DMHD) if(MHDS.eq.3) open (13, file=cFileH,status='new',recl=550,access='sequential',form='formatted',iostat=iWrt3DMHD) if(XCintDG(II).lt.0.0d0) iWrt3DMHD = 99 if(iWrt3DMHD.ne.0) then close(13) if(MHDS.eq.1) write(*,'(A,I3,A,1X,A)') 'File',II,' could not be opened in the specified directory', cfileE if(MHDS.eq.2) write(*,'(A,I3,A,1X,A)') 'File',II,' could not be opened in the specified directory', cfileM if(MHDS.eq.3) write(*,'(A,I3,A,1X,A)') 'File',II,' could not be opened in the specified directory', cfileH if(iWrt3DMHD.eq.99) then print *, 'There was no valid file input in translate' else if(iWrt3DMHD.ne.0.and.iWrt3DMHD.ne.99) print *, 'Probably there was an existing file in the write directory' stop ! assume you made some write mistake. end if end if iNM = iNM + 1 if(MHDS.eq.1) write (13,'(A,3I5,2F10.7,F12.5,I5,3I3.2)',iostat=iwrt3DMHD) ! write ENLIL header & cfileE, nLng, nLat, nMAP, RRS, dRR, XC, iy, mo, id, ih if(MHDS.eq.2) write (13,'(A,3I5,2F10.7,F12.5,I5,3I3.2)',iostat=iwrt3DMHD) ! write MS-FLUKSS header & cfileM, nLng, nLat, nMAP, RRS, dRR, XC, iy, mo, id, ih if(MHDS.eq.3) write (13,'(A,3I5,2F10.7,F12.5,I5,3I3.2)',iostat=iwrt3DMHD) ! write H3D-MHD header & cfileH, nLng, nLat, nMAP, RRS, dRR, XC, iy, mo, id, ih C print *, 'year, month, day, hour', iY+2000,mo,id,ih do IP=1,8 RAD = RRS - dRR do NN=1, nMap RAD = RAD + dRR C FALLN = RAD**FALLOFFN C FALLT = (RAD**FALLOFFT)/1000.0 C FALLBR = RAD**FALLOFFBR C FALLBT = RAD**FALLOFFBT C FALLBN = RAD**FALLOFFBN FALLN = 1.0 FALLT = 1.0 FALLBR = 1.0 FALLBT = 1.0 FALLBN = 1.0 if(IP.eq.1.and.NN.eq.1) then C write(*,'(I2,F10.6,35(F5.2,F8.4))') C & IP, RAD, FALLOFFN, FALLN, FALLOFFBR, FALLBR, FALLOFFBT, FALLBT, FALLOFFBN, FALLBN, FALLOFFT, FALLT if(NN.eq.1) write (13,'(55F10.5)') (RADS(NNN), NNN=1,NMAP) ! write heights to file end if do J=1,nLat do III=1, nlng if(IP.eq.1) then DDD1(III,J,NN,II) = DDD1(III,J,NN,II)*FALLN if(DDD1(III,J,NN,II).ge.-badD .or. DDD1(III,J,NN,II) .eq. bad) then C write(*,'(A,F15.4,4I4)') 'Density greater than 9999. !',DDD1(III,J,NN,II), III,J,NN,II DDD1(III,J,NN,II) = badD end if end if if(IP.eq.2) then VVV3(III,J,NN,II,1) = VVV3(III,J,NN,II,1) if(VVV3(III,J,NN,II,1).gt.-badV .or. VVV3(III,J,NN,II,1) .eq. bad) then C write(*,'(A,E12.4,4I4)') 'Vr greater than 9999. !',VVV3(III,J,NN,II,1), III,J,NN,II VVV3(III,J,NN,II,1) = badV end if end if if(IP.eq.3) then VVV3(III,J,NN,II,2) = VVV3(III,J,NN,II,2) if(VVV3(III,J,NN,II,2).ge.-badV .or. VVV3(III,J,NN,II,2) .eq. bad) then C write(*,'(A,F15.4,4I4)') 'Vt greater than 9999. !',VVV3(III,J,NN,II,2), III,J,NN,II VVV3(III,J,NN,II,2) = badV end if if(VVV3(III,J,NN,II,2).le.badV) then C write(*,'(A,F15.4,4I4)') 'Vt less than -9999. !',VVV3(III,J,NN,II,2), III,J,NN,II VVV3(III,J,NN,II,2) = badV end if end if if(IP.eq.4) then VVV3(III,J,NN,II,3) = VVV3(III,J,NN,II,3) if(VVV3(III,J,NN,II,3).ge.-badV .or. VVV3(III,J,NN,II,3) .eq. bad) then C write(*,'(A,F15.4,4I4)') 'Vn greater than 9999. !',VVV3(III,J,NN,II,3), III,J,NN,II VVV3(III,J,NN,II,3) = badV end if if(VVV3(III,J,NN,II,3).le.badV) then C write(*,'(A,F15.4,4I4)') 'Vn less than -9999. !',VVV3(III,J,NN,II,3), III,J,NN,II VVV3(III,J,NN,II,3) = badV end if end if if(IP.eq.5) then BBB3(III,J,NN,II,1) = BBB3(III,J,NN,II,1)*FALLBR if(BBB3(III,J,NN,II,1).ge.-badB .or. BBB3(III,J,NN,II,1) .eq. bad) then C write(*,'(A,F15.4,4I4)') 'Br greater than 9999. !',BBB3(III,J,NN,II,1), III,J,NN,II BBB3(III,J,NN,II,1) = badB end if if(BBB3(III,J,NN,II,1).le.badB) then C write(*,'(A,F15.4,4I4)') 'Br less than -9999. !',BBB3(III,J,NN,II,1), III,J,NN,II BBB3(III,J,NN,II,1) = badB end if end if if(IP.eq.6) then BBB3(III,J,NN,II,2) = BBB3(III,J,NN,II,2)*FALLBT if(BBB3(III,J,NN,II,2).ge.-badB .or. BBB3(III,J,NN,II,2) .eq. bad) then C write(*,'(A,F15.4,4I4)') 'Bt greater than 9999. !',BBB3(III,J,NN,II,2), III,J,NN,II BBB3(III,J,NN,II,2) = badB end if if(BBB3(III,J,NN,II,2).le.badB) then C write(*,'(A,F15.4,4I4)') 'Bt less than -9999. !',BBB3(III,J,NN,II,2), III,J,NN,II BBB3(III,J,NN,II,2) = badB end if end if if(IP.eq.7) then BBB3(III,J,NN,II,3) = BBB3(III,J,NN,II,3)*FALLBN if(BBB3(III,J,NN,II,3).ge.-badB .or. BBB3(III,J,NN,II,3) .eq. bad) then C write(*,'(A,F15.4,4I4)') 'Bn greater than 9999. !',BBB3(III,J,NN,II,3), III,J,NN,II BBB3(III,J,NN,II,3) = badB end if if(BBB3(III,J,NN,II,3).le.badB) then C write(*,'(A,F15.4,4I4)') 'Bn less than -9999. !',BBB3(III,J,NN,II,3), III,J,NN,II BBB3(III,J,NN,II,3) = badB end if end if if(IP.eq.8) then TTT1(III,J,NN,II) = TTT1(III,J,NN,II)*FALLT if(TTT1(III,J,NN,II).ge.-badT .or. TTT1(III,J,NN,II) .eq. bad) then C write(*,'(A,F15.4,4I4)') 'Temperature greater than 9999. !',TTT1(III,J,NN,II), III,J,NN,II TTT1(III,J,NN,II) = badT end if end if end do C if(IP.eq.1) write (13,'(A12)') 'Density ' C if(IP.eq.1.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(A12)') 'Density ' C if(IP.eq.1.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,cFmtF4) (DDD1(I,J,NN,II), I=1,nLng) if(IP.eq.1) write (13,cFmtF4) (DDD1(I,J,NN,II), I=1,nLng) ! write density C if(IP.eq.2) write (13,'(A12)') 'VR ' C if(IP.eq.2.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(A12)') 'VR NN=1 ' C if(IP.eq.2.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,cFmtF4) (VVV3(I,J,NN,II,1), I=1,nLng) C if(IP.eq.2.and.J.eq.5.and.NN.eq.NMAP.and.II.eq.22) write (*,'(A12)') 'VR NN=nMAP ' C if(IP.eq.2.and.J.eq.5.and.NN.eq.NMAP.and.II.eq.22) write (*,cFmtF4) (VVV3(I,J,NN,II,1), I=1,nLng) if(IP.eq.2) write (13,cFmtF4) (VVV3(I,J,NN,II,1),I=1,nLng) ! write Vr C if(IP.eq.3) write (13,'(A12)') 'VT ' C if(IP.eq.3.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(A12)') 'VT ' C if(IP.eq.3.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,cFmtF4) (VVV3(I,J,NN,II,2), I=1,nLng) if(IP.eq.3) write (13,cFmtF4) (VVV3(I,J,NN,II,2),I=1,nLng) ! write Vt C if(IP.eq.4) write (13,'(A12)') 'VN ' C if(IP.eq.4.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(A12)') 'VN ' C if(IP.eq.4.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,cFmtF4) (VVV3(I,J,NN,II,3), I=1,nLng) if(IP.eq.4) write (13,cFmtF4) (VVV3(I,J,NN,II,3),I=1,nLng) ! write Vn C if(IP.eq.5) write (13,'(A12)') 'BR ' C if(IP.eq.5.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(A12)') 'BR ' C if(IP.eq.5.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,cFmtF4) (BBB3(I,J,NN,II,1), I=1,nLng) if(IP.eq.5) write (13,cFmtF4) (BBB3(I,J,NN,II,1),I=1,nLng) ! write Br C if(IP.eq.6) write (13,'(A12)') 'BT ' C if(IP.eq.6.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(A12)') 'BT ' C if(IP.eq.6.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,cFmtF4) (BBB3(I,J,NN,II,2), I=1,nLng) if(IP.eq.6) write (13,cFmtF4) (BBB3(I,J,NN,II,2),I=1,nLng) ! write Bt C if(IP.eq.7) write (13,'(A12)') 'BN ' C if(IP.eq.7.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(A12)') 'BN ' C if(IP.eq.7.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,cFmtF4) (BBB3(I,J,NN,II,3), I=1,nLng) if(IP.eq.7) write (13,cFmtF4) (BBB3(I,J,NN,II,3),I=1,nLng) ! write Bn C if(IP.eq.8) write (13,'(A12)') 'Temperature ' C if(IP.eq.8.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(A12)') 'Temperature ' C if(IP.eq.8.and.J.eq.5.and.NN.eq.1.and.II.eq.22) write (*,'(55E10.2)') (TTT1(I,J,NN,II), I=1,nLng) if(IP.eq.8) write (13,cFmtF4) (TTT1(I,J,NN,II), I=1,nLng) ! write temperature end do end do end do end if end if close(13) C end if end do if(MHDS.eq.1) write(*,'(A,I3,A)') 'The external write of ENLIL files was successful.',iNM,' files were written' if(MHDS.eq.2) write(*,'(A,I3,A)') 'The external write of MSFLUKSS files was successful.',iNM,' files were written' if(MHDS.eq.3) write(*,'(A,I3,A)') 'The external write of H3DMHD files was successful.',iNM,' files were written' print *, ' ' return end