cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c ctall.for oct 1995 c for reading the CD disk containing Helios data c c $ for/align=rec=pack/warn=noalign ctall.for c c************************************************************* SUBROUTINE Clean0 (idirty) c cleans 'dirty' REAL*4 zeros. Call with REAL*4 argument! INTEGER*4 idirty IF (IAND(idirty,'0000FF80'x).EQ.0) idirty = 0 END SUBROUTINE Rclean (idirty, iclean) c cleans 'dirty' REAL*4 zeros. Call with REAL*4 arguments! INTEGER*4 idirty, iclean IF (IAND(idirty,'0000FF80'x).EQ.0) THEN iclean = 0 ELSE iclean = idirty END IF END SUBROUTINE I4_1 (in, out) ! quasilogarithmic compression as described in first blue book 141-147. ! works with both DEC and MS Fortran INTEGER i, i4, j, jk PARAMETER (jk=8*16) INTEGER*4 in(jk) INTEGER*1 out(jk) DO j = 1, jk i4 = in(j) IF (i4 .LT. 0) THEN ! .OR. i4 .GT. 65535 out(j) = -1 ELSE DO i = 15, 4, -1 IF (BTEST(i4,i)) THEN i4 = IBCLR(i4,i) GO TO 5 END IF END DO 5 IF (i .LT. 5) THEN out(j) = IOR(ISHFT(15-i,4),i4) - 256 ELSE IF (i .LT. 8) THEN out(j) = IOR(ISHFT(15-i,4),ISHFT(i4,4-i)) - 256 ELSE out(j) = IOR(ISHFT(15-i,4),ISHFT(i4,4-i)) END IF END IF END DO END SUBROUTINE Prtcnt INTEGER i, io, msec INTEGER iel, iaz, ien REAL b(3) REAL hel(6) INCLUDE 'STRUCT.INC' c******************************************************************** c gen c********************************************************************* READ (11, IOSTAT=io) gen DO WHILE (io .EQ. 0) IF (gen.mode .LT. 10) THEN READ (gen.msec,'(i8)') msec CALL Rclean (gen.heldissun, hel(1)) CALL Rclean (gen.hseangle, hel(2)) CALL Rclean (gen.helcarlng, hel(3)) CALL Rclean (gen.helcarlat, hel(4)) CALL Rclean (gen.helvrad, hel(5)) CALL Rclean (gen.helvnorm, hel(6)) CALL Clean0 (gen.bx) CALL Clean0 (gen.by) CALL Clean0 (gen.bz) b(1) = 10e-2 * gen.bx b(2) = 10e-2 * gen.by b(3) = 10e-2 * gen.bz cc structure /GEN_STRUCT/ c MODES write(15,101)gen.mSec,gen.seq,gen.Year, gen.DOY, & gen.Helios, & gen.Mode, gen.BitRate, gen.Format, gen.DisMod, & gen.Shift, gen.AzShift, gen.I1A_3,gen.I2A_B 101 format(1x,a9,1x,a2,11(1x,i4),1x/) c ORBIT write(15,102)gen.SpinRate, gen.Pitch, gen.Aspect, & gen.HelLngAsc, gen.HelDisSun, & gen.HelVrad, gen.HelVnorm, gen.HelCarLng, gen.HelCarLat , & gen.HelCarRot , gen.EarDisSun, gen.EarCarLng, & gen.EarCarLat, & gen.EarCarRot, gen.HSEangle 102 format(9(1x,f7.2),1x/,i6,3(1x,f7.2),1x,i6,1x,f7.2/) cPARAM write(15,103) gen.Vp_I1A,gen.Tp_I1A, gen.Np_I1A, & gen.AZp_I1A , gen.ELp_I1A , & gen.Valpha, gen.Talpha, gen.Nalpha , gen.ZeroRate_I1A, & gen.Vp_I1B, gen.Tp_I1B, gen.Np_I1B, gen.ZeroRate_I1B, & gen.ZeroVar_I1B 103 format(1x,f7.1,1x,e11.2,4(1x,f7.1),1x,e11.2/, & 3(1x,f7.1),1x,e11.2,(1x,3f7.1),1x/) c MAGN write(15,104)gen.Bx,gen.By,gen.Bz, & gen.BxSig,gen.BySig,gen.BzSig, gen.I1Aint, & gen.I1B 104 format(6(1x,f9.1),1x/,5(1x,f7.1),1x/,5(1x,f7.1),2x/) c****************************************************************** c ndm c****************************************************************** IF (gen.mode .EQ. 0) THEN ! normal data mode READ (11, IOSTAT=io) ndm WRITE (15, '(i3,i4,i3,f6.2,a5,3(a,i2))') & gen.year, gen.doy, msec/3600000, MOD(msec,3600000)/60e3, & ' NDM ', ' EL', ndm.maxel-2, ' AZ', ndm.maxaz-2, & ' EN', ndm.maxen-2 cNMAX c structure /NDM_STRUCT/ ! Used when GEN.Mode = 0 write(15,105) ndm.mSec, ndm.seq, (ndm.Init(j),j=1,8), & (ndm.Qw(j),j=1,5), ndm.MaxEl, & ndm.MaxAz, ndm.MaxEn, ndm.Mass, & (int(ndm.I1B(j)),j=1,32), & (int(ndm.I1Aint(j)),j=1,32), & ((int(ndm.I2AB(i,j)),i=1,8),j=1,16), & ((((INT(ndm.i1a_3(iel,iaz,ien)),iel=1,5),ien=i,i+2), & iaz=1,5),i=1,9,3) 105 format(a9,1x,a2,1x/,8(1x,i6),1x/,5(1x,i5),1x/,4(1x,i5),1x/, & 4(1x,8i5/),1x/,4(1x,8i5/),1x/,16(1x,8i5/),1x/, & 3(5(/3(1x,5i5))/)) c************************************************************************* c hdm2 c************************************************************************** ELSE IF (gen.format.EQ.2 .OR. gen.format.EQ.3) THEN ! high data mode READ (11, IOSTAT=io) hdm2 WRITE (15, '(i3,i4,i3,f6.2,a5,3(a,i2))') & gen.year, gen.doy, msec/3600000, MOD(msec,3600000)/60e3, & ' HDM2', ' EL', 2, ' AZ', 5, ' EN', 1 cc structure /HDM2_STRUCT/ ! Used when GEN.Mode=1, GEN.Format=2,3 c H2max write(15,106) hdm2.mSec, hdm2.seq, & ((hdm2.Init(i,j),i=1,8),j=1,4), & ((hdm2.Qw(i,j),i=1,5),j=1,4), & (hdm2.MaxEl(i),i=1,4), (hdm2.MaxAz(i),i=1,4), & (hdm2.MaxEn(i),i=1,4), (hdm2.Mass(i),i=1,4), & (int(hdm2.I1B(j)),j=1,32), & (int(hdm2.I1Aint(j)),j=1,32), & ((int(hdm2.I2AB(i,j)),i=1,8),j=1,32), & ((((INT(hdm2.i1a_3(iel,iaz,ien)),iel=1,6),ien=i,i+1), & iaz=1,7),i=1,32,2) 106 format(a9,1x,a2,1x/,4(1x,8i7/), 4(1x,5i7/), & 1x,4i5,1x,4i5,1x/, & 4i5,1x,4i5,1x/, & 4(1x,8i5/),1x/,4(1x,8i5/),1x/,32(1x,8i5/),1x/, & 16(7(/2(1x,6i5))/)) write(15,'(3(1x,i10))')(hdm2.mSecE(i),i=2,4) c********************************************************************** c hdm1 c********************************************************************* ELSE ! high data mode, full blocklength READ (11, IOSTAT=io) hdm1 WRITE (15, '(i3,i4,i3,f6.2,a5,3(a,i2))') & gen.year, gen.doy, msec/3600000, MOD(msec,3600000)/60e3, & ' HDM1', ' EL', 2, ' AZ', 5, ' EN', 1 c structure /HDM1_STRUCT/ ! Used when GEN.Mode=1, GEN.Format=1,5 c H1max write(15,107) hdm1.mSec, hdm1.seq, ! hdm1.mSecE, & ((hdm1.Init(i,j),i=1,8),j=1,4), & ((hdm1.Qw(i,j),i=1,5),j=1,4), & (hdm1.MaxEl(i),i=1,4), (hdm1.MaxAz(i),i=1,4), & (hdm1.MaxEn(i),i=1,4), (hdm1.Mass(i),i=1,4), & (int(hdm1.I1B(j)),j=1,32), & (int(hdm1.I1Aint(j)),j=1,32), & ((int(hdm1.I2AB(i,j)),i=1,8),j=1,32), & ((((INT(hdm1.i1a_3(iel,iaz,ien)),iel=1,7),ien=i,i+1), & iaz=1,7),i=1,32,2) 107 format(a9,1x,a2,1x/,4(1x,8i7/), 4(1x,5i7/), & 1x,4i5,1x,4i5,1x/, & 4i8,1x,4i8,1x/, & 4(1x,8i5/),1x/,4(1x,8i5/),1x/,32(1x,8i5/),1x/, & 16(7(/2(1x,7i5))/)) write(15,'(3(1x,i10))')(hdm1.mSecE(i),i=2,4) END IF END IF READ (11, IOSTAT=io) gen END DO END PROGRAM Counts BYTE byte INTEGER io INTEGER*2 snr, jj, doy, dd64, dd641, dd64n, y64, ielec LOGICAL exist CHARACTER*16 file PRINT *, 'Sonden-Nr.: [1]' READ *, snr IF (snr.NE.2) snr = 1 PRINT *, ' Erster Wert: Jahr, Tag des Jahres: [76 363]' READ *, jj, doy dd641 = (jj-64)*365 + (jj-61)/4 + doy PRINT *, 'Letzter Wert: Jahr, Tag des Jahres: [77 91]' READ *, jj, doy dd64n = (jj-64)*365 + (jj-61)/4 + doy DO dd64 = dd641, dd64n y64 = (dd64-(dd64/365+3)/4-1)/365 doy = dd64 - y64*365 - (y64+3)/4 jj = y64 + 64 WRITE (file,'(''MOD:H'',i1,''Y'',i2,''.D'',i3.3)') snr, jj, doy INQUIRE (FILE=file, EXIST=exist) IF (exist) THEN PRINT '(a,i2,2x,2i2,''/'',i3.3)', ' Helios', snr, 19, jj, doy OPEN (11, FILE=file, FORM='UNFORMATTED', STATUS='OLD', & ORGANIZATION='INDEXED', RECORDTYPE='VARIABLE', & ACCESS='KEYED', READONLY, IOSTAT=io) WRITE (file,'(''H'',i1,i2,''_'',i3.3,''.AAT'')') snr, jj, doy OPEN (15, FILE=file, FORM='FORMATTED', STATUS='NEW') CALL Prtcnt CLOSE (11) CLOSE (15) ELSE PRINT *, file, ' could not be opened.' END IF END DO END c@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ C OUTPUTS: C L_OUT integer*4 (defined in data statement) C Maximum record length (in 4 byte words) allowed for the C universal files. This number must be large enough to contain C the data structure HDM1 (the largest of the four structures). C CSEQ(2) character*1 (defined in character statement) C CSEQ(1) = 'A' is used to identify the parameter structure GEN C CSEQ(2) = 'B' is used to identify the raw data structures C COMMON BLOCKS: C common /ALL/ GEN C common /ALL0/ NDM C common /ALL1/ HDM1 C common /ALL2/ HDM2 C PROCEDURE: C Structure GEN is updated by: C CLR_GEN clears all entries C FILL_GEN fills the structure with data read from 1 dim. parameter tape C FILL_GEN_FAKE fills the structure with data read from Sorted Data tape C FILL_NDM only GEN.I2A_B and GEN.AzShift entries C FILL_HDM1 only GEN.AzShift entry C FILL_HDM2 only GEN.AzShift entry C C Structure NDM is updated by: C FILL_NDM C C Structure HDM1 is updated by: C FILL_HDM1 C C Structure HDM2 is updated by: C FILL_HDM2 C MODIFICATION HISTORY: C FEB/MAR-1992, Rainer Schwenn (MPAE)/Paul Hick (UCSD) structure /GEN_STRUCT/ character*8 mSec ! Milli seconds on day character*1 seq ! Sequence character 'A' byte Year ! Year-1900 e.g. 74 integer*2 DOY ! Day of year byte Helios ! S/C ID (1 or 2) byte Mode ! 0=NDM,1=HDM1;10=NDM,11=HDM; >10 = no raw data integer*2 BitRate ! Bitrate (bps) byte Format ! Format (0,..,6) byte DisMod ! Distribution mode (0,...,7) byte Shift ! 0=No shift, 1=Shift byte AzShift ! Azimuth shift (0=No shift,1=Shift) byte I1A_3 ! 1=I1A on; 2=I3 on; 0=both off byte I2A_B ! 0=I2A on; 1=I2B on real*4 SpinRate ! Average spin rate (1/s) real*4 Pitch ! Pitch angle (deg) real*4 Aspect ! Solar aspect angle (deg) real*4 HelLngAsc ! Heliographic longitude (from ascending node) real*4 HelDisSun ! Distance Helios - Sun (AU) real*4 HelVrad ! Radial velocity Helios (AU/day) real*4 HelVnorm ! Normal velocity Helios (AU/day) real*4 HelCarLng ! Carrington longitude Helios real*4 HelCarLat ! Heliographic latitude integer*2 HelCarRot ! Carrington rotation number Helios real*4 EarDisSun ! Distance Earth - Sun (AU) real*4 EarCarLng ! Carrington longitude Helios real*4 EarCarLat ! Heliographic latitude Earth integer*2 EarCarRot ! Carrington rotation number Helios real*4 HSEangle ! Helios-Sun-Earth angle real*4 Vp_I1A ! Proton velocity (km/s) real*4 Tp_I1A ! Proton temperature (K) real*4 Np_I1A ! Proton density (cm^-3) real*4 AZp_I1A ! Azimuth of flow angle (deg) real*4 ELp_I1A ! Elevation of flow angle (deg) real*4 Valpha ! Helium velocity (km/s) real*4 Talpha ! Helium temperature (K) real*4 Nalpha ! Helium density (cm^-3) real*4 ZeroRate_I1A ! Average zero count rate real*4 Vp_I1B ! Proton velocity (km/s) real*4 Tp_I1B ! Proton temperature (K) real*4 Np_I1B ! Proton density (cm^-3) real*4 ZeroRate_I1B ! Average zero count rate real*4 ZeroVar_I1B ! Variation of zero count rate real*4 Bx ! X-comp magnetic field (.01 Gamma) real*4 By ! Y-comp magnetic field (.01 Gamma) real*4 Bz ! Z-comp magnetic field (.01 Gamma) real*4 BxSig ! Sigma X-comp magnetic field (.01 Gamma) real*4 BySig ! Sigma Y-comp magnetic field (.01 Gamma) real*4 BzSig ! Sigma Z-comp magnetic field (.01 Gamma) real*4 I1Aint(5) ! Finger print for raw data (from ... real*4 I1B(5) ! .. 1 dim. parameter tape) end structure ! 198 bytes structure /NDM_STRUCT/ ! Used when GEN.Mode = 0 character*8 mSec ! Milli seconds on day character*1 seq ! Sequence character 'B' integer*4 Init(8) ! Initial data quality words integer*4 Qw(5) ! Instrument quality words byte MaxEl ! Elevation index of max byte MaxAz ! Azimuth index of max byte MaxEn ! Energy index of max byte Mass ! Index MASS channel ? real*4 I1B(32) real*4 I1Aint(32) integer*4 I2AB(8,16) ! Electron data (instrument I2) real*4 I1A_3(5,5,9) ! Proton data (instruments I1A and I3) end structure ! 1733 bytes structure /HDM1_STRUCT/ ! Used when GEN.Mode=1, GEN.Format=1,5 character*8 mSec ! Milli seconds on day (Time of EDF 1) character*1 seq ! Sequence character 'B' integer*4 mSecE(2:4) ! Times of EDF 2,3 and 4 integer*4 Init(8,4) ! Initial data quality words integer*4 Qw(5,4) ! Instrument quality words byte MaxEl(4) ! Elevation index of max byte MaxAz(4) ! Azimuth index of max byte MaxEn(4) ! Energy index of max byte Mass(4) ! MASS channel real*4 I1B(32) real*4 I1Aint(32) integer*4 I2AB(8,32) ! Electron data (instrument I2) real*4 I1A_3(7,7,32) end structure ! 7798 bytes structure /HDM2_STRUCT/ ! Used when GEN.Mode=1, GEN.Format=2,3 character*8 mSec ! Milli seconds on day (Time of EDF 1) character*1 seq ! Sequence character 'B' integer*4 mSecE(2:4) ! Times of EDF 2,3 and 4 integer*4 Init(8,4) ! Initial data quality words integer*4 Qw(5,4) ! Instrument quality words byte MaxEl(4) ! Elevation index of max byte MaxAz(4) ! Azimuth index of max byte MaxEn(4) ! Energy index of max byte Mass(4) ! MASS channel real*4 I1B(32) real*4 I1Aint(32) integer*4 I2AB(8,32) ! Electron data (instrument I2) real*4 I1A_3(6,7,32) end structure ! 7573 bytes record /GEN_STRUCT/ GEN record /NDM_STRUCT/ NDM record /HDM1_STRUCT/ HDM1 record /HDM2_STRUCT/ HDM2 common /ALL/ GEN common /ALL0/ NDM common /ALL1/ HDM1 common /ALL2/ HDM2