C+ C NAME: C smei_skyd_fill C PURPOSE: C Each pixel contributes to several nodes. These 'votes' are added C here to the pool of votes for all nodes. C CATEGORY: C smei/camera/for/sky C CALLING SEQUENCE: subroutine smei_skyd_fill(iSilent,level,icam,mode,ra_pix,dec_pix,ipos,response,nflag) C INPUTS: C iSilent integer higher value suppresses more messages C level integer determines resolution of pool of nodes C (1 <= level <= SKYD__LEVEL=3 C icam integer camera 1,2, or 3 C mode integer mode 0,1 or 2 C ra_pix (*) double precision RA for center and four corners of a pixel C dec_pix(*) double precision dec for center and four corners of a pixel C (passed to smei_skyd_pixel) C ipos integer linear array position of pixel in frame C response real CCD response for pixel C nflag integer bitwise flags C CALLS: C Say, smei_skyd_pixel, smei_skyd_size C INCLUDE: include 'filparts.h' include 'smei_skyd_dim.h' C PROCEDURE: C The pool of nodes is maintaind in the node_* arrays. C C All nodes in the first couple of frames are all put in pool 2 C (with one vote for each node). These are the nodes that may be encountered C again in frames at the end of the orbit. C C For subsequent frames, if the node is present already in pool 1 or 2 then C a vote is added to that node. New nodes are put in pool 1. C C Nodes from pool 1 are removed if they move far enough outside the FOV. C After the last frame has been processed (and the skymap is complete), C both pools are cleared. C C The node_sort array contains the indices needed to sort the node_* arrays C containing nodes up to and including contributions from the previous frame, C i.e. NOT YET the contribution from the frame currently being processed. C At the start node_sort(*) = n_nodes(SKYD__NODE_NTOP). C As pixels from the new frame are added the node_* arrays and C n_nodes(SKYD__NODE_NTOP) are updated; node_sort will be synchronized with C n_nodes(SKYD__NODE_NTOP) by skyd_sort prior to starting the next frame. C C The implicit assumption is made that within a frame all triangles will have C different node names, i.e. NO NODE IS DUPLICATED WITHIN A FRAME. C MODIFICATION HISTORY: C JAN-2006, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C- integer iSilent integer level integer icam integer mode double precision ra_pix (*) double precision dec_pix(*) integer ipos real response integer nflag !======================== ! Args for smei_skyd_flush integer iType logical bKeepGlitch double precision qq(*) real drfov_max real img(*) real xmg(*) integer badpix(*) real lowres(SKYD__NXLO,SKYD__NYLO,SKYD__LO_NMAP) !======================== ! Args for smei_skyd_sort !======================== integer n_frame_votes save n_frame_votes !======================== ! node_list is passed to smei_skyd_pixel to get a list of the nodes to which the ! current pixel contributes. integer node_list(SKYD__NODES_PER_PIXEL) !======================== ! n_nodes and n_old_nodes retain information about the status of the ! the vote pools integer n_nodes (SKYD__NODE_N) /SKYD__NODE_N*0/ save n_nodes integer n_old_nodes(SKYD__NODE_N) save n_old_nodes !======================== integer node_sort (SKYD__NODES) save node_sort integer node_name (SKYD__NODES) ! Node ID save node_name integer node_cnt (SKYD__NODES) ! Counter for votes in node save node_cnt integer node_alive(SKYD__NODES) ! Done with node ? save node_alive double precision node_ra (SKYD__NODES) ! Node right ascension save node_ra double precision node_dec (SKYD__NODES) ! Node declination save node_dec real node_value(SKYD__VOTES) save node_value integer*1 node_flag (SKYD__VOTES) save node_flag integer node_pos (SKYD__VOTES) save node_pos !===================== double precision x_eq double precision y_eq double precision x_pl double precision y_pl double precision d_eq double precision d_pl double precision px double precision py double precision rx double precision ry double precision rz double precision tx double precision ty double precision dr double precision phi double precision r8bad double precision dcosd double precision dsind double precision datan2d character cInt2Str*14 integer Str2Str integer Flt2Str integer smei_skyd_pixel integer smei_skyd_combine double precision BadR8 character cStr*(FIL__LENGTH) logical node_not_found logical b_node_alive integer count include 'smei_skyd_fnc.h' ! Collect list of bins to which the pixel contributes. count = smei_skyd_pixel(level,ra_pix,dec_pix,SKYD__NODES_PER_PIXEL,node_list) n_frame_votes = n_frame_votes+count x_eq = origin(level, 0) y_eq = origin(level,SKYD__NYEQ) x_pl = origin(level,SKYD__NXPL) y_pl = origin(level,SKYD__NYPL) d_eq = level*SKYD__D_EQ d_pl = level*SKYD__D_PL i_eq = level*SKYD__NXEQ i_pl = level*SKYD__NXPL i = level*level n_eq = i*SKYD__N_EQ n_pl = i*SKYD__N_PL do i=1,count ! Loop over all nodes in node_list node_newid = node_list(i) ! Node ID of new node if (node_newid .le. SKYD__NO_NODE) stop 'smei_skyd_fill, dang' ! Check whether node_newid is already in the pool. ! All nodes are accessed using the node_sort array, which sorts the ! nodes collected from all previous frames into ascending order). node_not_found = n_nodes(SKYD__NODE_NSORT) .eq. 0 if (.not. node_not_found) then ! No nodes yet? Then bail: node not found ! Lowest and highest node ID ! 1..n_nodes(SKYD__NODE_NEMPTY) were empty at the start of the frame, but ! will be filled by new nodes in the current frame. node_low = n_nodes(SKYD__NODE_NEMPTY)+1 node_high = n_nodes(SKYD__NODE_NSORT ) inode = node_sort(node_low) ! Check node with lowest ID node_id = node_name(inode) node_not_found = node_newid .lt. node_id if (.not. node_not_found) then ! Is new ID is lower than lowest ID? ! Then bail: node not found node_not_found = node_newid .ne. node_id if (node_not_found) then ! Is new ID same as lowest ID? Then bail: node found ! Only one node? Then bail: node not found node_not_found = node_high .eq. node_low ! At least two nodes if (.not. node_not_found) then ! Check node with highest ID inode = node_sort(node_high) node_id = node_name(inode) node_not_found = node_newid .gt. node_id ! Is new ID is higher than highest ID? ! Then bail: node not found if (.not. node_not_found) then node_not_found = node_newid .ne. node_id ! Is new ID same as highest ID? ! Then bail: node found if (node_not_found) then ! Neither node_low nor node_high are right node ! node_high must be at least two higher than node_low or node_mid ! will be equal to node_low do while (node_not_found .and. node_high-node_low .ge. 2) node_mid = (node_low+node_high)/2 inode = node_sort(node_mid) node_id = node_name(inode) node_not_found = node_newid .ne. node_id ! Is new ID same as mid ID? Then bail: node found if (node_not_found) then ! node_mid is not the right node. Adjust node_high or ! node_low such that node_low and node_high bracket ! the node (if it exists), but neither node_low nor ! node_high is the right node. if (node_id .gt. node_newid) then node_high = node_mid else node_low = node_mid end if end if end do end if end if end if end if end if end if ! If node_not_found=.FALSE. then node_newid is present at (inode). ! If node_not_found=.TRUE. then find a location for the new node. if (node_not_found) then ! New node inode = n_nodes(SKYD__NODE_IEMPTY) ! Empty slot available? if (inode .lt. n_nodes(SKYD__NODE_NEMPTY)) then inode = inode+1 n_nodes(SKYD__NODE_IEMPTY) = inode ! Update number of empty slots filled again inode = node_sort(inode) ! Empty slot node_id = node_name(inode) ! Make sure it really is empty if (node_id .ne. SKYD__NO_NODE) stop 'node not empty, node_name' else ! No empty slots available inode = n_nodes(SKYD__NODE_NTOP)+1 ! Add to end of pool if (inode .gt. SKYD__NODES) ! Still room in node arrays? & call Say('skyd_fill','E','SKYD__NODES='//cInt2Str(SKYD__NODES),'is too small') ! Votes for each node are collected in 1-dim arrays (e.g. node_value and ! node_flag). Logically the arrays are treated as 2-dim arrays with ! the 1st dimension the max number of votes per node [n_nodes(SKYD__NODE_MAPVOTES)], and ! the 2nd dimension the max number of nodes [n_nodes(SKYD__NODE_MAPNODES)]. ! The size of these two dimensions is adjusted dynamically to accomodate large ! changes in number of nodes and number of votes per node. if (n_nodes(SKYD__NODE_MAPNODES) .eq. 0) then ! Logical dimensions not defined yet. Start out with reasonable values ! The integer divide keeps the product of the dimensions is kept below SKYD__VOTES n_nodes(SKYD__NODE_MAPVOTES) = SKYD__VOTES_PER_NODE_INIT n_nodes(SKYD__NODE_MAPNODES) = SKYD__VOTES/SKYD__VOTES_PER_NODE_INIT if (iSilent .le. 0) then ix = n_nodes(SKYD__NODE_MAPVOTES)*n_nodes(SKYD__NODE_MAPNODES) ip = 0 ip = ip+Str2Str('map' ,cStr(ip+1:))+1 ip = ip+Int2Str(n_nodes(SKYD__NODE_MAPVOTES),cStr(ip+1:)) ip = ip+Str2Str('x' ,cStr(ip+1:)) ip = ip+Int2Str(n_nodes(SKYD__NODE_MAPNODES),cStr(ip+1:)) ip = ip+Str2Str('=' ,cStr(ip+1:)) ip = ip+Int2Str(ix ,cStr(ip+1:)) ip = ip+Str2Str('/' ,cStr(ip+1:)) ip = ip+Int2Str(SKYD__VOTES ,cStr(ip+1:)) ip = ip+Str2Str('=' ,cStr(ip+1:)) ip = ip+Flt2Str(100.0*ix/SKYD__VOTES,-2,cStr(ip+1:)) ip = ip+Str2Str('%' ,cStr(ip+1:)) call Say('skyd_fill','I','pool',cStr) end if end if ! Still room in vote arrays? if (inode .gt. n_nodes(SKYD__NODE_MAPNODES)) then ! Not enough nodes in arrays with dynamic size control. ! Increase the number of available nodes (2nd logical dimension) by ! decreasing the max number of votes per node (1st logical dimension). call smei_skyd_size(iSilent,1,n_nodes,node_cnt,node_value,node_flag) end if n_nodes(SKYD__NODE_NTOP) = inode ! Update highest occupied index end if ! Update total number of nodes ! Note that always n_nodes(SKYD__NODE_NSLOT) <= n_nodes(SKYD__NODE_NTOP) ! since the right hand value includes remaining empty slots. n_nodes(SKYD__NODE_NSLOT) = n_nodes(SKYD__NODE_NSLOT)+1 node_name(inode) = node_newid ! Store node ID node_cnt (inode) = 0 ! Clear counter for votes ip = node_newid if (ip .le. n_eq) then ! Node from equatorial map ix = 1+mod(ip-1,i_eq) ! Column index jy = 1+(ip-1)/i_eq ! Row index rx = ix-x_eq ! # bins to RA=0 ry = jy-y_eq ! # bins to dec=0 node_ra (inode) = rx/d_eq ! Right ascension node_dec(inode) = ry/d_eq ! Declination else ! Node from polar map ip = ip-n_eq ! Take out offset (# elem in eq map) kp = 1+(ip-1)/n_pl ! 1 for North; 2 for South ip = 1+mod(ip-1,n_pl) ! Linear array index ix = 1+mod(ip-1,i_pl) ! Column index jy = 1+(ip-1)/i_pl ! Row index rx = ix-x_pl ! # bins to pole ry = jy-y_pl ! # bins to pole node_ra (inode) = dmod(datan2d(ry,rx)+360d0,360d0) ! Right ascension node_dec(inode) = (3-2*kp)*(90.0d0-dsqrt(rx*rx+ry*ry)/d_pl) ! Declination end if end if if (node_name(inode) .ne. node_newid) stop 'node_name problem' ! Nodes are still 'alive' as long as votes are being added. node_alive(inode) = 1 ivote = node_cnt(inode)+1 ! Next vote for inode if (ivote .gt. n_nodes(SKYD__NODE_MAPVOTES)) then ! Not enough votes in arrays with dynamic size control. ! Increase the number of available votes per node (1st logical dimension) ! by decreasing the number of nodes (2nd logical dimension). call smei_skyd_size(iSilent,0,n_nodes,node_cnt,node_value,node_flag) end if node_cnt(inode) = ivote ! Update counter for votes for inode ivote = (inode-1)*n_nodes(SKYD__NODE_MAPVOTES)+ivote node_value(ivote) = response ! CCD readout node_flag (ivote) = nflag ! Bitwise flags node_pos (ivote) = ipos ! Linear array index in frame ! Update total number of votes in pool n_nodes(SKYD__NODE_NVOTE) = n_nodes(SKYD__NODE_NVOTE)+1 end do return C+ C NAME: C smei_skyd_sort C PURPOSE: C Sorts the node ID of all nodes C CALLING SEQUENCE: entry smei_skyd_sort(iSilent) C INPUTS: C iSilent controls informational messages C OUTPUTS: C PROCEDURE: C The sorted array are described by a couple of arrays C that are saved internally C C node_sort index array to sort nodes C n_nodes(SKYD__NODE_NEMPTY) C number of empty slots in pool C (these are located at the bottom of the node_sort array) C n_nodes(SKYD__NODE_IEMPTY) C counter used when filling up empty slots in smei_skyd_fill C (initialized to zero here) C C n_nodes(*) is set zero at the start of a new orbit, forcing the C initialization of n_nodes(SKYD__NODE_NSORT), n_nodes(SKYD__NODE_NEMPTY) and C n_nodes(SKYD__NODE_IEMPTY) to zero. C MODIFICATION HISTORY: C FEB-2006, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C- ntop = n_nodes(SKYD__NODE_NTOP) ! Highest occupied node index if (ntop .eq. 0) then ! No nodes in pool n = 0 else call IndexI4(1,ntop,1,ntop,node_name,node_sort) ! The sorting operation puts available empty slots between 1 and ntop ! at the bottom of the sorted array. Count number of empty slots. n = 0 node_id = SKYD__NO_NODE ! Redundant do while (n .lt. ntop .and. node_id .eq. SKYD__NO_NODE) n = n+1 node_id = node_name(node_sort(n)) end do if (node_id .eq. SKYD__NO_NODE) stop 'bottom problem' n = n-1 ! Number of empty slots ! Empty slots are marked as 'alive' to avoid accessing them in smei_skyd_flush. do i=1,n node_alive(node_sort(i)) = 1 ! Empty slots: 'alive' end do ! Occopied slots are marked as 'not alive'. If a vote is added in ! smei_skyd_fill by the next frame they will be marked as 'alive' again. ! Only nodes marked as 'not alive' are candidates for removal in ! smei_skyd_flush. do i=n+1,ntop node_alive(node_sort(i)) = 0 ! Filled slots: 'not alive' end do end if if (iSilent .le. 0) call Say('skyd_sort','I',cInt2Str(n),'empty pool slots') ! The nodes are sorted before calling smei_skyd_fill, where new nodes are added from ! the next frame. n_nodes(SKYD__NODE_NEMPTY) = n ! Number of empty slots n_nodes(SKYD__NODE_IEMPTY) = 0 n_nodes(SKYD__NODE_NSORT ) = ntop ! Number of sorted slots return C+ C NAME: C smei_skyd_flush C PURPOSE: C Removes node that have moved outside the field of view from the C pool of nodes after depositing in on the equatorial and/or polar skymaps C CALLING SEQUENCE: entry smei_skyd_flush(iType,bKeepGlitch,iSilent,level,icam,mode,qq,drfov_max,img,xmg,badpix,lowres) C INPUTS: C iType integer C bKeepGlitch logical C level integer C mode integer C qq(*) double precision C drfov_max real C OUTPUTS: C xmg C img C badpix C lowres C PROCEDURE: C n_nodes integer n_nodes(SKYD__NODE_NTOP) C highest occupied index in pool arrays C updated to a lower value when empty slots C at the end of the pool are removed. C n_nodes(SKYD__NODE_NSLOT) C total number of nodes in pool C updated when nodes are removed C n_nodes(SKYD__NODE_NVOTE) C total number of votes in pool C update when nodes are removed C smei_skyd_flush is called in smei_skyd_sky prior to adding in the pixels C of the a new frame into the pool, i.e. the quaternion from the new C header is used to decided whether a node is inside/outside the fov. C MODIFICATION HISTORY: C FEB-2006, Paul Hick (UCSD/CASS; pphick@ucsd.edu) C- ntop = n_nodes(SKYD__NODE_NTOP) ! Current highest occupied node n_nodes(SKYD__NODE_NTOPMAX) = max(n_nodes(SKYD__NODE_NTOPMAX),ntop) if (ntop .ne. 0) then call ArrI4GetMinMax(ntop,node_cnt,i,n) else n = 0 end if n_nodes(SKYD__NODE_NVOTEMAX) = max(n_nodes(SKYD__NODE_NVOTEMAX),n) n_nodes(SKYD__NODE_NMAPMAX ) = max(n_nodes(SKYD__NODE_NMAPMAX ),n*ntop) if (ntop .gt. 0) then call ArrI4Copy(SKYD__NODE_N,n_nodes,n_old_nodes) ! Sorting node_alive puts nodes that marked 'not alive' (node_alive=0) ! at the bottom of the sorted array. Only these nodes are candidates ! for removal. call IndexI4(1,ntop,1,ntop,node_alive,node_sort) r4bad = BadR4() r8bad = BadR8() ! The while loop starts at the bottom of the array and continues until a ! a node marked 'alive' (node_alive=1) is encountered. ! If drfov_max is set to r4bad then all nodes are removed (this is used ! to clean up after the last frame for the skymap). n = 1 ! Bottom of pool inode = node_sort(n) ! Sorted index at bottom of pool do while (n .le. ntop .and. (node_alive(inode) .eq. 0 .or. drfov_max .eq. r4bad)) ! node_name=SKYD__NO_NODE only happens if drfov_max=r4bad ! (i.e. the final cleanup of all nodes). node_id = node_name(inode) if (node_id .ne. SKYD__NO_NODE) then px = node_ra (inode) ! Pick up RA and dec py = node_dec(inode) ! If drfov_max=r4bad then b_node_alive=.FALSE., and the node is always removed b_node_alive = drfov_max .ne. r4bad if (b_node_alive) then rx = dcosd(py)*dcosd(px) ! Unit vector in equatorial frame ry = dcosd(py)*dsind(px) rz = dsind(py) call quaternion_rotate_xyz(qq,rx,ry,rz) ! Equatorial --> camera frame ! Camera frame --> CCD coordinates call smei_axis_cam(1,icam,mode,dr,phi,rx,ry,rz,tx,ty) ! Node must be more than drfov_max pixels ! dr = r8bad occurs after a data gap b_node_alive = dr .ne. r8bad .and. dr .le. drfov_max ! away from optical axis in radial direction end if if (.not. b_node_alive) then ! Remove node nvote = node_cnt(inode) ! Number of votes in pool if (nvote .eq. 0) then ! Safety belt: cannot happen print *, n,ntop,inode,node_id,node_cnt(inode),px,py stop 'skyd_flush: node with no votes' end if !print *, 'using',node_id,'with',nvote,' votes' i = (inode-1)*n_nodes(SKYD__NODE_MAPVOTES)+1 ngood = smei_skyd_combine(iType,bKeepGlitch,iSilent,nvote,node_value(i), ! & node_flag(i),xgood,xbad,badpix) & node_flag(i),node_pos(i),xgood,xbad,badpix) if (ngood .gt. 0.0) call smei_skyd_node2sky(level,node_id,nvote,ngood,xgood,img,xmg) i = nint(origin(1, 0)+px*SKYD__D_LO)! Pixel center j = nint(origin(1,SKYD__NYLO)+py*SKYD__D_LO) j = min(j,SKYD__NYLO) ! Only used if py exactly +90d0 if (i .lt. 1 .or. i .gt. SKYD__NXLO .or. j .lt. 1 .or. j .gt. SKYD__NYLO) then write (*,*) ' RA=',px,' Dec=',py ! Better not happen! stop 'skyd_flush: bad low res bin, darn' end if lowres(i,j,SKYD__LO_CNT ) = lowres(i,j,SKYD__LO_CNT )+1.0 lowres(i,j,SKYD__LO_FRAC) = lowres(i,j,SKYD__LO_FRAC)+(nvote-ngood)/float(nvote) ! Dropped nodes as frac of total lowres(i,j,SKYD__LO_CUT ) = lowres(i,j,SKYD__LO_CUT )+xbad ! Dropped adus as fraction of total ! Decrease counters for nodes and votes n_nodes(SKYD__NODE_NSLOT) = n_nodes(SKYD__NODE_NSLOT)-1 n_nodes(SKYD__NODE_NVOTE) = n_nodes(SKYD__NODE_NVOTE)-nvote node_name(inode) = SKYD__NO_NODE ! Necesssary node_cnt (inode) = 0 ! Redundant node_ra (inode) = r8bad ! Redundant node_dec (inode) = r8bad ! Redundant end if end if n = n+1 if (n .le. ntop) inode = node_sort(n) end do ! Update highest occupied index by removing empty slots at top of pool do while (ntop .gt. 0 .and. node_name(ntop) .eq. SKYD__NO_NODE) ntop = ntop-1 end do if (iSilent .le. 0) then i = 0 i = i+Int2Str(n_old_nodes(SKYD__NODE_NSLOT)-n_nodes(SKYD__NODE_NSLOT), cStr(i+1:)) i = i+Str2Str('/' , cStr(i+1:)) i = i+Int2Str(n_old_nodes(SKYD__NODE_NSLOT) , cStr(i+1:))+1 i = i+Str2Str('nodes,' , cStr(i+1:))+1 i = i+Int2Str(n_old_nodes(SKYD__NODE_NVOTE)-n_nodes(SKYD__NODE_NVOTE), cStr(i+1:)) i = i+Str2Str('/' , cStr(i+1:)) i = i+Int2Str(n_old_nodes(SKYD__NODE_NVOTE) , cStr(i+1:))+1 i = i+Str2Str('votes,' , cStr(i+1:))+1 i = i+Int2Str(n_nodes(SKYD__NODE_NTOP)-ntop , cStr(i+1:)) i = i+Str2Str('@end' , cStr(i+1:)) call Say('skyd_flush','I','pool',cStr) end if n_nodes(SKYD__NODE_NTOP) = ntop end if return entry smei_skyd_save() call ArrI4Copy(SKYD__NODE_N,n_nodes,n_old_nodes) n_frame_votes = 0 return entry smei_skyd_print() i = 0 i = i+Int2Str(n_frame_votes , cStr(i+1:))+1 i = i+Str2Str('votes (' , cStr(i+1:)) i = i+Int2Str(n_nodes(SKYD__NODE_IEMPTY)-n_old_nodes(SKYD__NODE_IEMPTY), cStr(i+1:))+1 i = i+Str2Str('in empty slots)' , cStr(i+1:)) call Say('skyd','I','',cStr) i = 0 i = i+Int2Str(n_old_nodes(SKYD__NODE_NSLOT), cStr(i+1:)) i = i+Str2Str('/' , cStr(i+1:)) i = i+Int2Str(n_old_nodes(SKYD__NODE_NTOP), cStr(i+1:)) i = i+Str2Str('+' , cStr(i+1:)) i = i+Int2Str(n_nodes(SKYD__NODE_NSLOT)-n_old_nodes(SKYD__NODE_NSLOT), cStr(i+1:)) i = i+Str2Str('=' , cStr(i+1:)) i = i+Int2Str(n_nodes(SKYD__NODE_NSLOT), cStr(i+1:)) i = i+Str2Str('/' , cStr(i+1:)) i = i+Int2Str(n_nodes(SKYD__NODE_NTOP), cStr(i+1:)) i = i+Str2Str(',' , cStr(i+1:)) i = i+Int2Str(n_old_nodes(SKYD__NODE_NVOTE), cStr(i+1:)) i = i+Str2Str('+' , cStr(i+1:)) i = i+Int2Str(n_nodes(SKYD__NODE_NVOTE)-n_old_nodes(SKYD__NODE_NVOTE), cStr(i+1:)) i = i+Str2Str('=' , cStr(i+1:)) i = i+Int2Str(n_nodes(SKYD__NODE_NVOTE), cStr(i+1:)) call Say('skyd','I','',cStr) return entry smei_skyd_print_nodes(icam,mode) n = n_nodes(SKYD__NODE_NTOPMAX) i = 0 i = i+Str2Str('n=' , cStr(i+1:)) i = i+Int2Str(n , cStr(i+1:)) i = i+Str2Str('=' , cStr(i+1:)) i = i+Flt2Str(100.0*n/SKYD__NODES,-2 , cStr(i+1:)) i = i+Str2Str('%;' , cStr(i+1:))+1 n = n_nodes(SKYD__NODE_NVOTEMAX) i = i+Int2Str(n , cStr(i+1:))+1 i = i+Str2Str('v/n;' , cStr(i+1:))+1 n = n_nodes(SKYD__NODE_NMAPMAX) i = i+Str2Str('v=' , cStr(i+1:)) i = i+Int2Str(n , cStr(i+1:)) i = i+Str2Str('=' , cStr(i+1:)) i = i+Flt2Str(100.0*n/SKYD__VOTES,-2 , cStr(i+1:)) i = i+Str2Str('%' , cStr(i+1:)) n_nodes(SKYD__NODE_MAPVOTES) = 0 n_nodes(SKYD__NODE_MAPNODES) = 0 n_nodes(SKYD__NODE_NTOPMAX ) = 0 n_nodes(SKYD__NODE_NVOTEMAX) = 0 n_nodes(SKYD__NODE_NMAPMAX ) = 0 call Say('nodes','I','used',cStr) print *, '????', n_nodes return end