subroutine init_names(iwrite) implicit none save include 'ephem.dek' c..initializes names and other stuff for the ephemeris database c..input: c..iwrite = integer determining if a message is written c..output: c..initialization of any ephemeris routines that need it, c..and filling of various common blocks c..declare the pass integer iwrite c..for initializing the jpl constants character names(500)*6 integer n double precision values(500),sss(3) c..for initializing the galsat constants integer ioin,ioout,iomsg,iopun common /ioblok/ ioin,ioout,iomsg,iopun c..for parsing the comet and asteroid data files logical ibhere character*80 namfil,symnam character*132 string,word integer ipos,getnam double precision value c..local variables character*9 pname(11), martian(2), jovian(4), saturian(8), 1 uranian(5) integer i,j,kk,ibeg,iend,iendsav c..various data statements data pname /'sun ','moon ', 1 'mercury ','venus ','earth ', 2 'mars ','jupiter ','saturn ', 3 'uranus ','neptune ','pluto '/ data martian /'phobos','deimos'/ data jovian /'io','europa','ganymede','calisto'/ data saturian /'mimas','enceladus','tethys','dione', 1 'rhea','titan','hyperion','iapetus'/ data uranian /'miranda','ariel','umbriel','titania', 1 'oberon'/ c..popular format statements 11 format(a) c..do all database initializations here c..jpl call const (names, values, sss, n) begjd = sss(1) endjd = sss(2) write(6,*) 'jpl initialized' c..martian satellites call blocdatas write(6,*) 'martian satellites initialized' c..jovian satellites namfil = 'ephem.e15' inquire(file=namfil, exist=ibhere) if (.not.ibhere) stop 'could not find file ephem.e15' open(unit=25,file=namfil, status='old') ioin = 25 ioout = 6 iomsg = 6 call cd2com write(6,*) 'jovian satellites initialized' c..saturn satellites namfil = 'redtass7.dat' inquire(file=namfil, exist=ibhere) if (.not.ibhere) stop 'could not find file redtass7.dat' call lecser(namfil,0) write(6,*) 'saturn satellites initialized' c..now initialize the names c..set the names of the planets nplanets = 11 ibeg = 1 iend = nplanets do i=ibeg,iend zname(i) = pname(i) enddo c..set the names of the martian satellites nmarsat = 2 iendsav = iend ibeg = iend + 1 iend = iend + nmarsat do i=ibeg,iend zname(i) = martian(i - iendsav) enddo c..set the names of the jovian satellites njupsat = 4 iendsav = iend ibeg = iend + 1 iend = iend + njupsat do i=ibeg,iend zname(i) = jovian(i - iendsav) enddo c..set the names of the saturian satellites nsatsat = 8 iendsav = iend ibeg = iend + 1 iend = iend + nsatsat do i=ibeg,iend zname(i) = saturian(i - iendsav) enddo c..set the names of the uranian satellites nurasat = 5 iendsav = iend ibeg = iend + 1 iend = iend + nurasat do i=ibeg,iend zname(i) = uranian(i - iendsav) enddo c j = 1 c if (j .eq. 1) goto 99 c..process the jpl datscom comet file c..open the file and read the first two header lines namfil = 'comet_elements.dat' inquire(file=namfil, exist=ibhere) if (.not.ibhere) stop 'could not find file comet_elements.dat' open(unit=14,file=namfil,status='old') read(14,11) string read(14,11) string c..parse off each line as we read it do j=1,ncomet_max read(14,11,err=100,end=200) string comet_name(j) = string(6:38) iend = iend + 1 if (iend .gt. iemax) stop 'iend>iemax for comets in init_names' zname(iend) = comet_name(j) ipos = 39 kk = getnam(string,word,ipos) comet_epoch(j) = value(word) kk = getnam(string,word,ipos) comet_q(j) = value(word) kk = getnam(string,word,ipos) comet_e(j) = value(word) kk = getnam(string,word,ipos) comet_i(j) = value(word) kk = getnam(string,word,ipos) comet_w(j) = value(word) kk = getnam(string,word,ipos) comet_node(j) = value(word) kk = getnam(string,word,ipos) comet_tp_year(j) = int(value(word(1:4))) comet_tp_month(j) = int(value(word(5:6))) comet_tp_day(j) = int(value(word(7:8))) comet_tp_hour(j) = value(word(9:14)) * 24.0d0 kk = getnam(string,word,ipos) comet_jpl(j) = word(1:kk) ncomet = j enddo c..an error reading 100 write(6,*) 'error reading comet elements' close(unit=14) stop 'error reading comet data' c..no error reading 200 close(unit=14) write(6,*) 'comets initialized' c..process the jpl datscom numbered asteroid data file c..open the file and read the first two header lines namfil = 'numasteroids_elements.dat' inquire(file=namfil, exist=ibhere) if (.not.ibhere) stop 'no file numasteroids_elements.dat' open(unit=14,file=namfil,status='old') read(14,11) string read(14,11) string c..parse off each line as we read it do j=1,nnaster_max read(14,11,err=300,end=400) string naster_name(j) = string(7:24) iend = iend + 1 if (iend .gt. iemax) stop 'iend>iemax for astroid in init_names' zname(iend) = naster_name(j) ipos = 25 kk = getnam(string,word,ipos) naster_epoch(j) = value(word) kk = getnam(string,word,ipos) naster_a(j) = value(word) kk = getnam(string,word,ipos) naster_e(j) = value(word) kk = getnam(string,word,ipos) naster_i(j) = value(word) kk = getnam(string,word,ipos) naster_w(j) = value(word) kk = getnam(string,word,ipos) naster_node(j) = value(word) kk = getnam(string,word,ipos) naster_m(j) = value(word) kk = getnam(string,word,ipos) naster_jpl(j) = word(1:kk) nnaster = j enddo c..if we got here then we either read naster_max elements c..currently naster_max is set to 15k and the whole file has about 46k objects goto 400 c..an error reading 300 write(6,*) 'error reading the numbered asteroid elements' close(unit=14) stop 'error reading numbered asteroid data' c..no error reading 400 close(unit=14) write(6,*) 'asteroids initialized' write(6,*) ' ' c 99 continue c..form various sums nsum1 = nplanets + nmarsat nsum2 = nsum1 + njupsat nsum3 = nsum2 + nsatsat nsum4 = nsum3 + nurasat nsum5 = nsum4 + ncomet nsum6 = nsum5 + nnaster c..write a message saying what we got if (iwrite .eq. 1) then write(6,401) 1 'there is ',1 ,' sun with a body number of ', 2 1, 3 'there is ',1 ,' moon with a body number of ', 4 2, 5 'there is ',9 ,' planets with body number between ', 6 3,' and ',nplanets, 7 'there is ',nmarsat,' martian moons with body number between ', 8 nplanets+1,' and ',nsum1, 9 'there is ',njupsat,' jovian moons with body number between ', & nsum1+1,' and ',nsum2, 1 'there is ',nsatsat,' saturn moons with body number between ', 2 nsum2+1,' and ',nsum3, 1 'there is ',nurasat,' uranus moons with body number between ', 2 nsum3+1,' and ',nsum4, 3 'there are ',ncomet,' comets with body numbers between', 4 nsum4+1,' and ',nsum5, 5 'there are ',nnaster,' asteroids with body numbers between', 6 nsum5+1,' and ',nsum6 401 format(1x,/, 1 1x,a,i6,a,i6,/, 2 1x,a,i6,a,i6,/, 3 1x,a,i6,a,i6,a,i6,/, 4 1x,a,i6,a,i6,a,i6,/, 5 1x,a,i6,a,i6,a,i6,/, 6 1x,a,i6,a,i6,a,i6,/, 6 1x,a,i6,a,i6,a,i6,/, 7 1x,a,i6,a,i6,a,i6,/, 8 1x,a,i6,a,i6,a,i6,/) write(6,*) 'first 30 body numbers and objects are:' write(6,402) (i,zname(i), i=1,35) 402 format(5(i4,'=',a10)) write(6,*) endif return end