--- DarthVader/TrackerLevel2/src/F77/analysissubroutines.f 2006/10/25 16:18:41 1.8 +++ DarthVader/TrackerLevel2/src/F77/analysissubroutines.f 2006/10/27 16:08:19 1.9 @@ -12,19 +12,17 @@ subroutine track_finding(iflag) include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' include 'common_mech.f' include 'common_xyzPAM.f' include 'common_mini_2.f' include 'calib.f' - include 'level1.f' +c include 'level1.f' include 'level2.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' -c logical DEBUG -c common/dbg/DEBUG - *------------------------------------------------------------------------------- * STEP 1 *------------------------------------------------------------------------------- @@ -47,22 +45,9 @@ c iflag=0 call cl_to_couples(iflag) if(iflag.eq.1)then !bad event - goto 880 !fill ntp and go to next event + goto 880 !go to next event endif -*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -* selezione di tracce pulite per diagnostica -*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -c$$$ if(DEBUG)then -c$$$ do ip=1,nplanes -c$$$ if(ncp_plane(ip).ne.1)good2=.false. -c$$$ enddo -c$$$c if(good2.eq.0)goto 100!next event -c$$$c if(good2.eq.0)goto 880!fill ntp and go to next event -c$$$ endif - - - *----------------------------------------------------- *----------------------------------------------------- * HOUGH TRASFORM @@ -94,7 +79,7 @@ c iflag=0 call cp_to_doubtrip(iflag) if(iflag.eq.1)then !bad event - goto 880 !fill ntp and go to next event + goto 880 !go to next event endif @@ -123,18 +108,61 @@ * $ ,ptcloud_xz,tr_cloud,cpcloud_xz *------------------------------------------------------------------------------- *------------------------------------------------------------------------------- +* count number of hit planes + planehit=0 + do np=1,nplanes + if(ncp_plane(np).ne.0)then + planehit=planehit+1 + endif + enddo + if(planehit.lt.3) goto 880 ! exit + + nptxz_min=x_min_start + nplxz_min=x_min_start + + nptyz_min=y_min_start + nplyz_min=y_min_start -c iflag=0 + cutdistyz=cutystart + cutdistxz=cutxstart + + 878 continue call doub_to_YZcloud(iflag) if(iflag.eq.1)then !bad event goto 880 !fill ntp and go to next event - endif -c iflag=0 + endif + if(nclouds_yz.eq.0.and.cutdistyz.lt.maxcuty)then + if(cutdistyz.lt.maxcuty/2)then + cutdistyz=cutdistyz+cutystep + else + cutdistyz=cutdistyz+(3*cutystep) + endif + goto 878 + endif + + if(planehit.eq.3) goto 881 + + 879 continue call trip_to_XZcloud(iflag) if(iflag.eq.1)then !bad event goto 880 !fill ntp and go to next event endif - + + if(nclouds_xz.eq.0.and.cutdistxz.lt.maxcutx)then + cutdistxz=cutdistxz+cutxstep + goto 879 + endif + + + 881 continue +* if there is at least three planes on the Y view decreases cuts on X view + if(nclouds_xz.eq.0.and.nclouds_yz.gt.0.and. + $ nplxz_min.ne.y_min_start)then + nptxz_min=x_min_step + nplxz_min=x_min_start-x_min_step + goto 879 + endif + 880 return end @@ -144,19 +172,16 @@ subroutine track_fitting(iflag) include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' include 'common_mech.f' include 'common_xyzPAM.f' include 'common_mini_2.f' include 'calib.f' - include 'level1.f' include 'level2.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' -c logical DEBUG -c common/dbg/DEBUG - logical FIMAGE ! *------------------------------------------------------------------------------- @@ -198,13 +223,33 @@ ibest=0 !best track among candidates iimage=0 !track image * ------------- select the best track ------------- +c$$$ rchi2best=1000000000. +c$$$ do i=1,ntracks +c$$$ if(RCHI2_STORE(i).lt.rchi2best.and. +c$$$ $ RCHI2_STORE(i).gt.0)then +c$$$ ibest=i +c$$$ rchi2best=RCHI2_STORE(i) +c$$$ endif +c$$$ enddo +c$$$ if(ibest.eq.0)goto 880 !>> no good candidates + rchi2best=1000000000. + ndofbest=0 !(1) do i=1,ntracks - if(RCHI2_STORE(i).lt.rchi2best.and. - $ RCHI2_STORE(i).gt.0)then + if(RCHI2_STORE(i).lt.rchi2best.and. + $ RCHI2_STORE(i).gt.0)then + ndof=0 !(1) + do ii=1,nplanes !(1) + ndof=ndof !(1) + $ +int(xgood_store(ii,i)) !(1) + $ +int(ygood_store(ii,i)) !(1) + enddo !(1) + if(ndof.ge.ndofbest)then !(1) ibest=i rchi2best=RCHI2_STORE(i) - endif + ndofbest=ndof !(1) + endif !(1) + endif enddo if(ibest.eq.0)goto 880 !>> no good candidates *------------------------------------------------------------------------------- @@ -242,6 +287,7 @@ IDCAND = icand !fitted track-candidate ifail=0 !error flag in chi2 computation jstep=0 !# minimization steps + iprint=0 if(DEBUG)iprint=1 call mini2(jstep,ifail,iprint) @@ -608,8 +654,9 @@ c***************************************************** include 'commontracker.f' - include 'calib.f' include 'level1.f' + include 'calib.f' +c include 'level1.f' include 'common_align.f' include 'common_mech.f' include 'common_xyzPAM.f' @@ -1285,6 +1332,7 @@ * it returns the plane number * include 'commontracker.f' + include 'level1.f' c include 'common_analysis.f' include 'common_momanhough.f' @@ -1322,6 +1370,7 @@ * it returns the id number ON THE PLANE * include 'commontracker.f' + include 'level1.f' c include 'common_analysis.f' include 'common_momanhough.f' @@ -1350,6 +1399,7 @@ * positive if sensor =2 * include 'commontracker.f' + include 'level1.f' c include 'calib.f' c include 'level1.f' c include 'common_analysis.f' @@ -1661,13 +1711,11 @@ subroutine cl_to_couples(iflag) include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' include 'calib.f' - include 'level1.f' - -c logical DEBUG -c common/dbg/DEBUG +c include 'level1.f' * output flag * -------------- @@ -1692,26 +1740,41 @@ ncls(ip)=0 enddo do icl=1,nclstrmax_level2 - cl_single(icl)=1 - cl_good(icl)=0 + cl_single(icl) = 1 + cl_good(icl) = 0 + enddo + do iv=1,nviews + ncl_view(iv) = 0 + mask_view(iv) = 0 !all included enddo +* count number of cluster per view + do icl=1,nclstr1 + ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1 + enddo +* mask views with too many clusters + do iv=1,nviews + if( ncl_view(iv).gt. nclustermax)then + mask_view(iv) = 1 + print*,' * WARNING * cl_to_couple: n.clusters > ' + $ ,nclustermax,' on view ', iv,' --> masked!' + endif + enddo + + * start association ncouples=0 do icx=1,nclstr1 !loop on cluster (X) if(mod(VIEW(icx),2).eq.1)goto 10 * ---------------------------------------------------- -* cut on charge (X VIEW) +* jump masked views (X VIEW) * ---------------------------------------------------- - if(dedx(icx).lt.dedx_x_min)then - cl_single(icx)=0 - goto 10 - endif + if( mask_view(VIEW(icx)).ne.0 ) goto 10 * ---------------------------------------------------- -* cut on multiplicity (X VIEW) +* cut on charge (X VIEW) * ---------------------------------------------------- - if(mult(icx).ge.mult_x_max)then + if(dedx(icx).lt.dedx_x_min)then cl_single(icx)=0 goto 10 endif @@ -1754,16 +1817,14 @@ if(mod(VIEW(icy),2).eq.0)goto 20 * ---------------------------------------------------- -* cut on charge (Y VIEW) +* jump masked views (Y VIEW) * ---------------------------------------------------- - if(dedx(icy).lt.dedx_y_min)then - cl_single(icy)=0 - goto 20 - endif + if( mask_view(VIEW(icy)).ne.0 ) goto 20 + * ---------------------------------------------------- -* cut on multiplicity (X VIEW) +* cut on charge (Y VIEW) * ---------------------------------------------------- - if(mult(icy).ge.mult_y_max)then + if(dedx(icy).lt.dedx_y_min)then cl_single(icy)=0 goto 20 endif @@ -1809,9 +1870,6 @@ * charge correlation * (modified to be applied only below saturation... obviously) -* ------------------------------------------------------------- -* >>> eliminata (TEMPORANEAMENTE) la correlazione di carica <<< -* ------------------------------------------------------------- if( .not.(dedx(icy).gt.chsaty.and.dedx(icx).gt.chsatx) $ .and. $ .not.(dedx(icy).lt.chmipy.and.dedx(icx).lt.chmipx) @@ -1855,7 +1913,7 @@ $ '** warning ** number of identified '// $ 'couples on plane ',nplx, $ 'exceeds vector dimention ' - $ ,'( ',ncouplemax,' )' + $ ,'( ',ncouplemax,' ) NB - THIS SHOULD NOT HAPPEN' c good2=.false. c goto 880 !fill ntp and go to next event iflag=1 @@ -1923,13 +1981,12 @@ subroutine cl_to_couples_nocharge(iflag) include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' include 'calib.f' - include 'level1.f' +c include 'level1.f' -c logical DEBUG -c common/dbg/DEBUG * output flag * -------------- @@ -2148,15 +2205,14 @@ c***************************************************** include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' include 'common_xyzPAM.f' include 'common_mini_2.f' include 'calib.f' - include 'level1.f' +c include 'level1.f' -c logical DEBUG -c common/dbg/DEBUG * output flag * -------------- @@ -2374,11 +2430,10 @@ subroutine doub_to_YZcloud(iflag) include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' -c logical DEBUG -c common/dbg/DEBUG * output flag * -------------- @@ -2410,6 +2465,8 @@ distance=0 nclouds_yz=0 !number of clouds npt_tot=0 + nloop=0 + 90 continue do idb1=1,ndblt !loop (1) on DOUBLETS if(db_used(idb1).eq.1)goto 2228 !db already included in a cloud @@ -2513,7 +2570,7 @@ nplused=nplused+ hit_plane(ip) enddo c print*,'>>>> ',ncpused,npt,nplused - if(ncpused.lt.ncpyz_min)goto 2228 !next doublet +c if(ncpused.lt.ncpyz_min)goto 2228 !next doublet if(npt.lt.nptyz_min)goto 2228 !next doublet if(nplused.lt.nplyz_min)goto 2228 !next doublet @@ -2564,6 +2621,12 @@ enddo !end loop (1) on DOUBLETS + if(nloop.lt.nstepy)then + cutdistyz = cutdistyz+cutystep + nloop = nloop+1 + goto 90 + endif + if(DEBUG)then print*,'---------------------- ' print*,'Y-Z total clouds ',nclouds_yz @@ -2590,11 +2653,10 @@ subroutine trip_to_XZcloud(iflag) include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' -c logical DEBUG -c common/dbg/DEBUG * output flag * -------------- @@ -2625,6 +2687,8 @@ distance=0 nclouds_xz=0 !number of clouds npt_tot=0 !total number of selected triplets + nloop=0 + 91 continue do itr1=1,ntrpt !loop (1) on TRIPLETS if(tr_used(itr1).eq.1)goto 22288 !already included in a cloud c print*,'--------------' @@ -2726,7 +2790,7 @@ do ip=1,nplanes nplused=nplused+ hit_plane(ip) enddo - if(ncpused.lt.ncpxz_min)goto 22288 !next triplet +c if(ncpused.lt.ncpxz_min)goto 22288 !next triplet if(npt.lt.nptxz_min)goto 22288 !next triplet if(nplused.lt.nplxz_min)goto 22288 !next doublet @@ -2774,7 +2838,13 @@ * ~~~~~~~~~~~~~~~~~ 22288 continue enddo !end loop (1) on DOUBLETS - + + if(nloop.lt.nstepx)then + cutdistxz=cutdistxz+cutxstep + nloop=nloop+1 + goto 91 + endif + if(DEBUG)then print*,'---------------------- ' print*,'X-Z total clouds ',nclouds_xz @@ -2801,14 +2871,13 @@ c***************************************************** include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' include 'common_xyzPAM.f' include 'common_mini_2.f' include 'common_mech.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' -c logical DEBUG -c common/dbg/DEBUG * output flag * -------------- @@ -2824,7 +2893,7 @@ * ----------------------------------------------------------- * list of matching couples in the combination * between a XZ and YZ cloud - integer cp_match(nplanes,ncouplemax) + integer cp_match(nplanes,2*ncouplemax) integer ncp_match(nplanes) * ----------------------------------------------------------- integer hit_plane(nplanes) @@ -2924,13 +2993,13 @@ c$$$ print*,'~~~~~~~~~~~~~~~~~~~~~~~~~' * -------> INITIAL GUESS <------- - AL_INI(1)=dreal(alfaxz1_av(ixz)) - AL_INI(2)=dreal(alfayz1_av(iyz)) - AL_INI(4)=datan(dreal(alfayz2_av(iyz)) + AL_INI(1) = dreal(alfaxz1_av(ixz)) + AL_INI(2) = dreal(alfayz1_av(iyz)) + AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz)) $ /dreal(alfaxz2_av(ixz))) - tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4)) - AL_INI(3)=tath/sqrt(1+tath**2) - AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0. + tath = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4)) + AL_INI(3) = tath/sqrt(1+tath**2) + AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0. c print*,'*******',AL_INI(5) if(AL_INI(5).gt.defmax)goto 888 !next cloud @@ -3139,16 +3208,15 @@ c****************************************************** include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' include 'common_xyzPAM.f' include 'common_mini_2.f' include 'common_mech.f' - include 'momanhough_init.f' - include 'level1.f' +c include 'momanhough_init.f' +c include 'level1.f' include 'calib.f' -c logical DEBUG -c common/dbg/DEBUG * flag to chose PFA character*10 PFA @@ -3469,14 +3537,13 @@ subroutine clean_XYclouds(ibest,iflag) include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' - include 'momanhough_init.f' +c include 'momanhough_init.f' include 'level2.f' !(1) c include 'calib.f' c include 'level1.f' -c logical DEBUG -c common/dbg/DEBUG do ip=1,nplanes !loop on planes @@ -3652,47 +3719,21 @@ subroutine init_level2 -c***************************************************** -c 07/10/2005 modified by elena vannuccini --> (1) -c***************************************************** - include 'commontracker.f' + include 'level1.f' include 'common_momanhough.f' include 'level2.f' - include 'level1.f' +c include 'level1.f' do i=1,nviews good2(i)=good1(i) enddo -c good2 = 0!.false. -c$$$ nev2 = nev1 - -c$$$# ifndef TEST2003 -c$$$c***************************************************** -c$$$cccccc 11/9/2005 modified by david fedele -c$$$c pkt_type = pkt_type1 -c$$$c pkt_num = pkt_num1 -c$$$c obt = obt1 -c$$$c which_calib = which_calib1 -c$$$ swcode = 302 -c$$$ -c$$$ which_calib = which_calib1 -c$$$ pkt_type = pkt_type1 -c$$$ pkt_num = pkt_num1 -c$$$ obt = obt1 -c$$$ cpu_crc = cpu_crc1 -c$$$ do iv=1,12 -c$$$ crc(iv)=crc1(iv) -c$$$ enddo -c$$$# endif -c***************************************************** NTRK = 0 - do it=1,NTRKMAX!NTRACKSMAX + do it=1,NTRKMAX IMAGE(IT)=0 CHI2_nt(IT) = -100000. -c BdL(IT) = 0. do ip=1,nplanes XM_nt(IP,IT) = 0 YM_nt(IP,IT) = 0 @@ -3701,12 +3742,8 @@ RESY_nt(IP,IT) = 0 XGOOD_nt(IP,IT) = 0 YGOOD_nt(IP,IT) = 0 -c***************************************************** -cccccc 11/9/2005 modified by david fedele DEDX_X(IP,IT) = 0 DEDX_Y(IP,IT) = 0 -c****************************************************** -cccccc 17/8/2006 modified by elena CLTRX(IP,IT) = 0 CLTRY(IP,IT) = 0 enddo @@ -3717,25 +3754,18 @@ enddo enddo enddo - - -c***************************************************** -cccccc 11/9/2005 modified by david fedele nclsx=0 nclsy=0 do ip=1,NSINGMAX planex(ip)=0 -c xs(ip)=0 xs(1,ip)=0 xs(2,ip)=0 sgnlxs(ip)=0 planey(ip)=0 -c ys(ip)=0 ys(1,ip)=0 ys(2,ip)=0 sgnlys(ip)=0 enddo -c******************************************************* end @@ -3750,6 +3780,90 @@ ************************************************************ + subroutine init_hough + + include 'commontracker.f' + include 'level1.f' + include 'common_momanhough.f' + include 'common_hough.f' + include 'level2.f' + + ntrpt_nt=0 + ndblt_nt=0 + NCLOUDS_XZ_nt=0 + NCLOUDS_YZ_nt=0 + do idb=1,ndblt_max_nt + db_cloud_nt(idb)=0 + alfayz1_nt(idb)=0 + alfayz2_nt(idb)=0 + enddo + do itr=1,ntrpl_max_nt + tr_cloud_nt(itr)=0 + alfaxz1_nt(itr)=0 + alfaxz2_nt(itr)=0 + alfaxz3_nt(itr)=0 + enddo + do idb=1,ncloyz_max + ptcloud_yz_nt(idb)=0 + alfayz1_av_nt(idb)=0 + alfayz2_av_nt(idb)=0 + enddo + do itr=1,ncloxz_max + ptcloud_xz_nt(itr)=0 + alfaxz1_av_nt(itr)=0 + alfaxz2_av_nt(itr)=0 + alfaxz3_av_nt(itr)=0 + enddo + + ntrpt=0 + ndblt=0 + NCLOUDS_XZ=0 + NCLOUDS_YZ=0 + do idb=1,ndblt_max + db_cloud(idb)=0 + cpyz1(idb)=0 + cpyz2(idb)=0 + alfayz1(idb)=0 + alfayz2(idb)=0 + enddo + do itr=1,ntrpl_max + tr_cloud(itr)=0 + cpxz1(itr)=0 + cpxz2(itr)=0 + cpxz3(itr)=0 + alfaxz1(itr)=0 + alfaxz2(itr)=0 + alfaxz3(itr)=0 + enddo + do idb=1,ncloyz_max + ptcloud_yz(idb)=0 + alfayz1_av(idb)=0 + alfayz2_av(idb)=0 + do idbb=1,ncouplemaxtot + cpcloud_yz(idb,idbb)=0 + enddo + enddo + do itr=1,ncloxz_max + ptcloud_xz(itr)=0 + alfaxz1_av(itr)=0 + alfaxz2_av(itr)=0 + alfaxz3_av(itr)=0 + do itrr=1,ncouplemaxtot + cpcloud_xz(itr,itrr)=0 + enddo + enddo + end +************************************************************ +* +* +* +* +* +* +* +************************************************************ + + subroutine fill_level2_tracks(ntr) * ------------------------------------------------------- @@ -3760,36 +3874,35 @@ include 'commontracker.f' +c include 'level1.f' include 'level1.f' + include 'common_momanhough.f' include 'level2.f' include 'common_mini_2.f' - include 'common_momanhough.f' - real sinth,phi,pig !(4) + real sinth,phi,pig pig=acos(-1.) -c good2=1!.true. chi2_nt(ntr) = sngl(chi2) nstep_nt(ntr) = nstep - phi = al(4) !(4) - sinth = al(3) !(4) - if(sinth.lt.0)then !(4) - sinth = -sinth !(4) - phi = phi + pig !(4) - endif !(4) - npig = aint(phi/(2*pig)) !(4) - phi = phi - npig*2*pig !(4) - if(phi.lt.0) !(4) - $ phi = phi + 2*pig !(4) - al(4) = phi !(4) - al(3) = sinth !(4) -***************************************************** + phi = al(4) + sinth = al(3) + if(sinth.lt.0)then + sinth = -sinth + phi = phi + pig + endif + npig = aint(phi/(2*pig)) + phi = phi - npig*2*pig + if(phi.lt.0) + $ phi = phi + 2*pig + al(4) = phi + al(3) = sinth + do i=1,5 al_nt(i,ntr) = sngl(al(i)) do j=1,5 coval(i,j,ntr) = sngl(cov(i,j)) enddo -c print*,al_nt(i,ntr) enddo do ip=1,nplanes ! loop on planes @@ -3805,7 +3918,6 @@ zv_nt(ip,ntr) = sngl(zv(ip)) axv_nt(ip,ntr) = sngl(axv(ip)) ayv_nt(ip,ntr) = sngl(ayv(ip)) -c dedxp(ip,ntr) = sngl(dedxtrk(ip)) !(1) dedx_x(ip,ntr) = sngl(dedxtrk_x(ip)) !(2) dedx_y(ip,ntr) = sngl(dedxtrk_y(ip)) !(2) @@ -3822,22 +3934,11 @@ endif enddo -c call CalcBdL(100,xxxx,IFAIL) -c if(ifps(xxxx).eq.1)BdL(ntr) = xxxx -c$$$ print*,'xgood(ip,ntr) ',(xgood_nt(ip,ntr),ip=1,6) -c$$$ print*,'ygood(ip,ntr) ',(ygood_nt(ip,ntr),ip=1,6) -c$$$ print*,'dedx_x(ip,ntr) ',(dedx_x(ip,ntr),ip=1,6) -c$$$ print*,'dedx_y(ip,ntr) ',(dedx_y(ip,ntr),ip=1,6) end subroutine fill_level2_siglets -c***************************************************** -c 07/10/2005 created by elena vannuccini -c 31/01/2006 modified by elena vannuccini -* to convert adc to mip --> (2) -c***************************************************** * ------------------------------------------------------- * This routine fills the elements of the variables @@ -3846,10 +3947,11 @@ * ------------------------------------------------------- include 'commontracker.f' - include 'level1.f' - include 'level2.f' +c include 'level1.f' include 'calib.f' + include 'level1.f' include 'common_momanhough.f' + include 'level2.f' include 'common_xyzPAM.f' * count #cluster per plane not associated to any track @@ -3857,6 +3959,10 @@ nclsx = 0 nclsy = 0 + do iv = 1,nviews + if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv) + enddo + do icl=1,nclstr1 if(cl_used(icl).eq.0)then !cluster not included in any track ip=nplanes-npl(VIEW(icl))+1 @@ -3900,8 +4006,81 @@ enddo end +*************************************************** +* * +* * +* * +* * +* * +* * +************************************************** + subroutine fill_hough +* ------------------------------------------------------- +* This routine fills the variables related to the hough +* transform, for the debig n-tuple +* ------------------------------------------------------- + include 'commontracker.f' + include 'level1.f' + include 'common_momanhough.f' + include 'common_hough.f' + include 'level2.f' - + if(.false. + $ .or.ntrpt.gt.ntrpt_max_nt + $ .or.ndblt.gt.ndblt_max_nt + $ .or.NCLOUDS_XZ.gt.ncloxz_max + $ .or.NCLOUDS_yZ.gt.ncloyz_max + $ )then + ntrpt_nt=0 + ndblt_nt=0 + NCLOUDS_XZ_nt=0 + NCLOUDS_YZ_nt=0 + else + ndblt_nt=ndblt + ntrpt_nt=ntrpt + if(ndblt.ne.0)then + do id=1,ndblt + alfayz1_nt(id)=alfayz1(id) !Y0 + alfayz2_nt(id)=alfayz2(id) !tg theta-yz + enddo + endif + if(ndblt.ne.0)then + do it=1,ntrpt + alfaxz1_nt(it)=alfaxz1(it) !X0 + alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz + alfaxz3_nt(it)=alfaxz3(it) !1/r + enddo + endif + nclouds_yz_nt=nclouds_yz + nclouds_xz_nt=nclouds_xz + if(nclouds_yz.ne.0)then + nnn=0 + do iyz=1,nclouds_yz + ptcloud_yz_nt(iyz)=ptcloud_yz(iyz) + alfayz1_av_nt(iyz)=alfayz1_av(iyz) + alfayz2_av_nt(iyz)=alfayz2_av(iyz) + nnn=nnn+ptcloud_yz(iyz) + enddo + do ipt=1,nnn + db_cloud_nt(ipt)=db_cloud(ipt) + enddo + endif + if(nclouds_xz.ne.0)then + nnn=0 + do ixz=1,nclouds_xz + ptcloud_xz_nt(ixz)=ptcloud_xz(ixz) + alfaxz1_av_nt(ixz)=alfaxz1_av(ixz) + alfaxz2_av_nt(ixz)=alfaxz2_av(ixz) + alfaxz3_av_nt(ixz)=alfaxz3_av(ixz) + nnn=nnn+ptcloud_xz(ixz) + enddo + do ipt=1,nnn + tr_cloud_nt(ipt)=tr_cloud(ipt) + enddo + endif + endif + end +