pro fusionpos1d,xmin0,xmax0,idtms0,hdeb0,hfin0,idate0, $ valfreq0,valres0,nbrec0,chrec_cle0, $ nomfi,nposad,nbmaxad,itetadm,trpadm ;+ ; NAME: ; FUSIONPOS1D ; PURPOSE: ; fusionne des positions nouvelles avec un fichier positions existant ; et reecrit le fichier resultat ; CALLING SEQUENCE: ; FUSIONPOS1D,xmin0,xmax0,idtms0,hdeb0,hfin0,date0, $ ; valfreq0,valres0,valsto0, $ ; nomfi,nposad,nbmaxad,itetadm,trpadm ; ; INPUTS: ; xmin0,xmax0 : min et max des amplitudes FLOAT ; idtms0 : delta t entre 2 images en ms LONG ; hdeb0,hfin0 : heure debut et fin en ms LONG ; idate0 : date jr,m,an INTARR(3) ; valfreq0 : issus du descripteur frequence 164.0 MHZ STRING ; valres0 : EST-OUEST ou NORD-SUD STRING ; nbrec0 : nb de records par position INT ; chrec_cle0 : tableau de chaines decrivant le type de chacun des record ; d'une position strarr(12,nbrec) ; nomfi0 : nom du fichier de position a reeecrire STRING ; nposad : nb de positions INT ; nbmaxad : nb de points de la position la plus longue LONG ; itetadm(3,npos) : entete de chaque enrgt LONG(3) ; 1- num de la position ; 2- heure de debut de la position ; 3- nb points de la position ; trpadm(5,nbmaxpt,npos): tableau des positions FLOAT(5,*,*) ; 1- numero des images ; 2- canal ; 3- amplitude ; 4- flux ; 5- diametre ; (pour les positions comportant moins de nbmaxpt points, les 5 tableaux ; sont completes par des zeros) ; OUTPUTS: ; ; COMMON BLOCKS: ; NRH1_GLOBAL ; ; MODIFICATION HISTORY: (bonmartin@obspm.fr) ; adapte du logiciel XHELIO (20/11/98) ; ecrit par A.Bouteille (Juin 96) ; modif arguments : dec 1996 ; type de chaque record ; et appel a ecrpos (1D et 2D) ; CALLS: ; litentete,ch_date,ecrpos ; ;- common NRH1_GLOBAL,nomfich,fichinfo ; lecture du fichier ; LA VALEUR N du numero d'unite est choisi par le programme appelant ; lecture du descripteur n=4 litentete, n, nomfi, file nomfich(n)=nomfi fichinfo(n)=file nbrec=file.facbloc(1) ; nb de records par position nposlu=file.nbpix(1)/file.facbloc(1) ; nb de positions dans le fichier nbmaxptlu=file.nbpix(0) ; nb de points de la position la plus longue hdeb=file.heurdeb hfin=file.heurfin xmin=file.valmin xmax=file.valmax idtms=file.paspix(0) valfreq=motcle(n,'FREQ') valres=motcle(n,'LABEL') i2cdate,idate0,chdat0 chrec_cle=strarr(nbrec) for i=0,nbrec-1 do begin chbl='BLOC'+string(format='(i1)',i) chrec_cle(i)=motcle(4,chbl) endfor ; ; controle des parametres du fichier positions: ; if (idtms0 ne idtms) or $ (hdeb0 ne hdeb) or $ (hfin0 ne hfin) or $ (chdat0 ne file.date) or $ (valfreq0 ne valfreq) or $ (valres0 ne valres) or $ (chrec_cle(0) ne chrec_cle0(0)) or $ (chrec_cle(1) ne chrec_cle0(1)) or $ (chrec_cle(2) ne chrec_cle0(2)) or $ (chrec_cle(3) ne chrec_cle0(3)) or $ (chrec_cle(4) ne chrec_cle0(4)) then begin MES= WIDGET_MESSAGE('IMPOSSIBLE to add centroid position') return endif ; lecture des positions ; ;openr, n, nomfi itetlum=lonarr(3,nposlu) itt=lonarr(3) rec=fltarr(nbmaxptlu) trplum=fltarr(5,nbmaxptlu,nposlu) ;for ip=0,nposlu-1 do for i=0,4 do $ ; readu,n,itetlu(*,ip),trplu(i,*,ip) for ip=0,nposlu-1 do begin readu,n,itt,rec trplum(0,*,ip)=rec & itetlum(*,ip)=itt readu,n,itt,rec trplum(1,*,ip)=rec readu,n,itt,rec trplum(2,*,ip)=rec readu,n,itt,rec trplum(3,*,ip)=rec readu,n,itt,rec trplum(4,*,ip)=rec endfor ; initialisation du tableau de positions final ; on declare un tableau a la dimension max possible: ; nb de positions nposlu+nposad ; nb de points de la position la plus longue nbmaxptlu+nbmaxad itet=lonarr(3,nposlu+nposad) trp=fltarr(5,nbmaxptlu+nbmaxad,nposlu+nposad) nposnew=nposlu ; au depart trp contient le tableau du fichier lu itet(*,0:nposlu-1)=itetlum trp(*,0:nbmaxptlu-1,0:nposlu-1)=trplum ; ; boucle sur les positions a ajouter for ipad=0,nposad-1 do begin nptad=itetadm(2,ipad) itetad=itetadm(*,ipad) trpad=trpadm(*,0:nptad-1,ipad) rindad=fltarr(nptad) canalad=fltarr(nptad) rindad=trpad(0,0:nptad-1) canalad=trpad(1,0:nptad-1) ; boucle sur les positions lues ; on compare la position a ajouter a chaque position lue for iplu=0,nposlu-1 do begin nptlu=itetlum(2,iplu) itetlu=itetlum(*,iplu) trplu=trplum(*,0:nptlu-1,iplu) rindlu=fltarr(nptlu) canallu=fltarr(nptlu) rindlu=trplu(0,*) canallu=trplu(1,*) ; ; l'intervalle commun va de indmin a indmax indmin=max([rindlu(0),rindad(0)]) indmax=min([rindlu(nptlu-1),rindad(nptad-1)]) ; if indmin ge indmax then begin goto,suitelu endif diff=fltarr(indmax-indmin+1) diff=canallu(indmin-rindlu(0):indmax-rindlu(0)) $ - canalad(indmin-rindad(0):indmax-rindad(0)) tot=total(diff) ; position identique a celle lue dans le fichier if tot eq 0. then begin ; on complete la position lue si necessaire inddeb=min([rindlu(0),rindad(0)]) indfin=max([rindlu(nptlu-1),rindad(nptad-1)]) ; lue |------------------------| ; ad |---------------| ; dans ce cas la position nouvelle est plus limitee que la lue, on ne ; complete pas if (inddeb le rindad(0)) and (indfin ge rindad(nptad-1)) then $ goto, suitead ; if inddeb lt rindlu(0) then begin trpdeb=trpad & itetdeb=itetad i1deb=rindad(0) & i2deb=rindad(nptad-1) trpfin=trplu & itetfin=itetlu i1fin=rindlu(0) & i2fin=rindlu(nptlu-1) end else begin trpdeb=trplu & itetdeb=itetlu i1deb=rindlu(0) & i2deb=rindlu(nptlu-1) trpfin=trpad & itetfin=itetad i1fin=rindad(0) & i2fin=rindlu(nptad-1) endelse ; fusion de positions : on complete de i1deb a i2fin ; i1deb i2deb ; |------------------| ; |-------------------| ; i1fin i2fin ; trp(*,0:i2deb-i1deb+1,nposnew-1)=trpdeb trp(*,i1fin-i1deb+1:i2fin-ideb1+1,nposnew-1)=trpfin itet(*,nposnew-1)=itetdeb(*) ; heure de debut? itet(2,nposnew-1)=i2fin-i1deb+1 goto,suitead ; end else goto,new suitelu: endfor ; boucle sur positions lues new: ; nouvelle position nposnew=nposnew+1 trp(*,0:nptad-1,nposnew-1)=trpad(*,0:nptad-1) itet(*,nposnew-1)=itetad(*) itet(0,nposnew-1)=nposnew suitead: endfor ; boucle sur positions ajoutees ; extraction du tableau final a la taille ajustee: ; nb de points de la position la plus longue tb=itet(2,0:nposnew-1) nbmaxnew=max(itet(2,0:nposnew-1)) itet=itet(*,0:nposnew-1) trp=trp(*,0:nbmaxnew-1,0:nposnew-1) close,n ecrpos,xmin,xmax,idtms,hdeb,hfin,idate0, $ valfreq,valres,nbrec,chrec_cle, $ nomfi,nposnew,nbmaxnew,itet,trp return end