/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/reductionflight.f
ViewVC logotype

Annotation of /DarthVader/TrackerLevel2/src/F77/reductionflight.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (download) (vendor branch)
Fri May 19 13:15:56 2006 UTC (18 years, 6 months ago) by mocchiut
Branch: DarthVader
CVS Tags: v0r01, start
Changes since 1.1: +0 -0 lines
Imported sources

1 mocchiut 1.1 *************************************************************************
2     *
3     * Program reductionflight.f
4     *
5     * - reads readraw.f output files: LEVEL0 ntuple, and ped, sig and bad histograms
6     * - decodes raw data (DATATRACKER) using DSP ped, sig and bad values
7     * - looks for clusters information using ped, sig and bad values from
8     * DSP histograms
9     * - fills LEVEL1 ntuple
10     *
11     *************************************************************************
12    
13     subroutine reductionflight()
14    
15     include 'commontracker.f'
16     include 'level0.f'
17     include 'level1.f'
18     include 'common_reduction.f'
19     include 'calib.f'
20    
21    
22     * -------------------------------------------------------
23     * STRIP MASK
24     * -------------------------------------------------------
25    
26     call stripmask
27     call init_level1
28    
29     C---------------------------------------------------
30     C variables in blocks GENERAL and CPU are anyway filled
31     C in order to mantain sincronization among
32     C events at different levels
33     C---------------------------------------------------
34     good1=good0
35     c$$$ do iv=1,12
36     c$$$ crc1(iv)=crc(iv)
37     c$$$ enddo
38     ccc print*,'totdatalength(reduction)=',TOTDATAlength
39     ccc print*,''
40     c--------------------------------------------------
41     c read the variable DATATRACKER from LEVEL0
42     c and fill the variable ADC (inverting view 11)
43     c--------------------------------------------------
44     call filladc(iflag)
45     if(iflag.ne.0)then
46     good1=0
47     print*,'event ',eventn(1),' >>>>> decode ERROR'
48     goto 200
49     endif
50    
51     c--------------------------------------------------
52     c computes common noise for each VA1
53     c (excluding strips affected by signal,
54     c tagged with the flag CLSTR)
55     c--------------------------------------------------
56     do iv=1,nviews
57     do ik=1,nva1_view
58     cn(iv,ik)=0 !initializes cn variable
59     if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik)
60     enddo
61     enddo
62    
63    
64     c---------------------------------------------
65     c loops on views, VA1 and strips,
66     c and computes strips signals using
67     c badstrip, pedestals, and
68     c sigma informations from histograms
69     c---------------------------------------------
70     flag_shower = .false.
71     ind=1 !clsignal array index
72     do iv=1,nviews !loop on views
73     do is=1,nstrips_view !loop on strips (1)
74     if(mod(iv,2).eq.1) then
75     C=== > Y view
76     value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
77     $ -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
78     $ *mask(iv,nvk(is),nst(is))
79     clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
80     $ *mask(iv,nvk(is),nst(is))
81     clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
82     $ *mask(iv,nvk(is),nst(is))
83     ccc print*,"value(",is,")(reduction)= ",value(is)
84     else
85     C=== > X view
86     value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
87     $ -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
88     $ *mask(iv,nvk(is),nst(is))
89     clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
90     $ *mask(iv,nvk(is),nst(is))
91     clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
92     $ *mask(iv,nvk(is),nst(is))
93     endif
94     enddo !end loop on strips (1)
95     call search_cluster(iv)
96     if(flag_shower.eqv..true.)then
97     call init_level1
98     good1=0
99     goto 200 !jump to next event
100     endif
101     enddo ! end loop on views
102     do iv=1,nviews
103     do ik=1,nva1_view
104     cnev(iv,ik)=cn(iv,ik) !assigns computed CN to ntuple variables
105     ccc print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)
106     enddo
107     enddo
108     c$$$ nevent_good = nevent_good + 1
109    
110     C---------------------------------------------
111     C come here if GOOD1=0
112     C or the event has too many clusters
113     C---------------------------------------------
114    
115     200 continue
116     ccc print*,'nclstr1(reduction)=',nclstr1
117     c------------------------------------------------------------------------
118     c
119     c closes files and exits
120     c
121     c------------------------------------------------------------------------
122    
123     RETURN
124     END
125    
126     ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
127     *
128     *
129     *
130     *
131     *
132     *
133     *
134     *
135     *
136     ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
137    
138    
139     subroutine init_level1
140    
141     include 'commontracker.f'
142     include 'level1.f'
143     include 'level0.f'
144    
145     good1=0
146     nclstr1=0
147     totCLlength=0
148     do ic=1,nclstrmax
149     view(ic)=0
150     ladder(ic)=0
151     indstart(ic)=0
152     indmax(ic)=0
153     maxs(ic)=0
154     mult(ic)=0
155     dedx(ic)=0
156     enddo
157     do id=1,maxlength !???
158     clsignal(id)=0.
159     enddo
160     do iv=1,nviews
161     c crc1(iv)=0
162     do ik=1,nva1_view
163     cnev(iv,ik)=0
164     enddo
165     enddo
166    
167     return
168     end
169     *---***---***---***---***---***---***---***---***
170     *
171     *
172     *
173     *
174     *
175     *---***---***---***---***---***---***---***---***
176    
177     subroutine search_cluster(iv)
178    
179     include 'commontracker.f'
180     include 'common_reduction.f'
181     include 'level0.f'
182     include 'level1.f'
183     include 'calib.f'
184    
185    
186    
187     c local variables
188     integer rmax,lmax !estremi del cluster
189     integer rstop,lstop !per decidere quali strip includere nel cluster
190     ! oltre il seed
191     integer first,last,diff !per includere le strip giuste... !???
192    
193     integer multtemp !temporary multiplicity variable
194    
195     integer CLlength !lunghezza in strip del cluster
196    
197     external nst
198    
199     c------------------------------------------------------------------------
200     c looks for clusters on each view
201     C : CERCO STRIP SOPRA CLSEEDCUT, POI SCORRO A DX FINCHE'
202     c NON TROVO
203     C STRIP PIU' BASSA (in segnale/rumore)
204     C => L'ULTIMA DELLA SERIE CRESCENTE
205     C (LA PIU' ALTA) E' IL
206     C CLUSTER SEED. POI SCORRO A SX E DX INCLUDENDO TUTTE
207     C LE STRIP (FINO A 17 AL
208     C MAX) CHE SUPERANO CLINCLCUT.
209     C QUANDO CERCO IL CLUSTER SEED SUCCESSIVO SALTO LA STRIP
210     C ADIACENTE A DESTRA
211     C DELL'ULTIMO CLUSTER SEED (CHE SARA' NECESSARIAMENTE
212     C PIU' BASSA) E PRENDO
213     C COME SEED UNA STRIP SOLO SE IL SUO SEGNALE E'
214     C MAGGIORE DI QUELLO DELLA STRIP
215     C PRECEDENTE (PRATICAMENTE PER EVITARE CHE L'ULTIMA
216     C STRIP DI UN GRUPPO DI STRIP
217     C TUTTE SOPRA IL CLSEEDCUT VENGA AUTOMATICAMENTE PRESA
218     C COME SEED... DEVE ESSERE
219     C PRESA SOLO SE IL CLUSTER E' DOUBLE PEAKED...)
220     c------------------------------------------------------------------------
221     c 6 ottobre 2003
222     c Elena: CLSEEDCUT = 7 (old value 10)
223     c Elena: CLINCLCUT = 4 (old value 5)
224    
225     iseed=-999 !cluster seed index initialization
226    
227     do jl=1,nladders_view !1..3 !loops on ladders
228     first=1+nstrips_ladder*(jl-1) !1,1025,2049
229     last=nstrips_ladder*jl !1024,2048,3072
230     c X views have 1018 strips instead of 1024
231     if(mod(iv,2).eq.0) then
232     first=first+3
233     last=last-3
234     endif
235     do is=first,last !loop on strips in each ladder
236     if(is.le.iseed+1) goto 220
237     c-----------------------------------------
238     c after a cluster seed as been found,
239     c look for next one skipping one strip on the right
240     c (i.e. look for double peak cluster)
241     c-----------------------------------------
242     if(is.ne.first) then
243     if(value(is).le.value(is-1)) goto 220
244     endif
245     c-----------------------------------------
246     c skips cluster seed
247     c finding if strips values are descreasing (a strip
248     c can be a cluster seed only if previous strip value
249     c is lower)
250     c-----------------------------------------
251     if(value(is).gt.clseedcut(is)) then
252     ccc print*,"value(",is,")=",value(is),
253     ccc $ " .gt.clseedcut(",is,")=",clseedcut(is)
254     c-----------------------------------------
255     c possible SEED...
256     c-----------------------------------------
257     itemp=is
258     if(itemp.eq.last) goto 230 !estremo...
259     do while(value(itemp)
260     $ /sigma(iv,nvk(itemp),nst(itemp))
261     $ .le.value(itemp+1)
262     $ /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???
263     itemp=itemp+1
264     if(itemp.eq.last) goto 230 !stops if reaches last strip
265     enddo ! of the ladder
266     230 continue
267     c-----------------------------------------
268     c fownd SEED!!!
269     c-----------------------------------------
270     iseed=itemp
271     c----------------------------------------------------------
272     c after finding a cluster seed, checks also adjacent strips,
273     C and marks the ones exceeding clinclcut
274     c----------------------------------------------------------
275     ir=iseed !indici destro
276     il=iseed ! e sinistro
277    
278     rmax=ir !estremo destro del cluster
279     lmax=il ! e sinistro
280    
281     rstop=0 !initialize flags used to exit from
282     lstop=0 ! inclusion loop
283    
284     do while(lstop.eq.0.or.rstop.eq.0) !shifts left and right from
285     ir=ir+1 !position index for strips on right side of
286     ! cluster seed
287     il=il-1 !and for left side
288     c------------------------------------------------------------------------
289     c checks for last or first strip of the ladder
290     c------------------------------------------------------------------------
291     if(ir.gt.last) then !when index goes beyond last strip
292     rstop=1 ! of the ladder, change rstop flag in order
293     ! to "help" exiting from loop
294     endif
295    
296     if(il.lt.first) then !idem when index goes beyond
297     lstop=1 ! first strip of the ladder
298     endif
299    
300     c------------------------------------------------------------------------
301     c check for clusters including more than nclstrp strips
302     c------------------------------------------------------------------------
303     if((rmax-lmax+1).ge.nclstrp) then
304     goto 210 !exits inclusion loop:
305     ! lmax and rmax maintain last value
306     ! NB .ge.!???
307     endif
308     c------------------------------------------------------------------------
309     c marks strips exceeding inclusion cut
310     c------------------------------------------------------------------------
311     if(rstop.eq.0) then !if last strip of the ladder or last
312     ! over-cut strip has not been reached
313     if(value(ir).gt.clinclcut(ir)) then !puts in rmax the
314     rmax=ir ! last right over-cut strip
315     else
316     rstop=1 !otherwise cluster ends on right and rstop
317     endif ! flag=1 signals it
318     endif
319     if(lstop.eq.0) then
320     if(value(il).gt.clinclcut(il)) then
321     lmax=il
322     else
323     lstop=1
324     endif
325     endif
326    
327     enddo !ends strip inclusion loop
328     210 continue !jumps here if more than nclstrp have been included
329    
330     multtemp=rmax-lmax+1 !stores multiplicity in temp
331     ! variable. NB rmax and lmax can change later in
332     ! order to include enough strips to calculate eta3
333     ! and eta4. so mult is not always equal to cllength
334     c------------------------------------------------------------------------
335     c NB per essere sicuro di poter calcolare eta3 e eta4 devo includere
336     c sempre e comunque le 2 strip adiacenti al cluster seed e quella
337     c adiacente ulteriore dalla parte della piu' alta fra queste due
338     c (vedi oltre...)!???
339     c------------------------------------------------------------------------
340    
341     c nel caso di estremi del ladder...!???
342    
343     c ho meno di 4 strip nel cluster --> se sono sui bordi o quasi del ladder
344     c costruisco il cluster ad hoc e poi esco, se non sono sui bordi o quasi
345     c vado oltre (aggiungero' quindi strip a sx e dx in modo da poter calcolare
346     c eta3e4)
347     if((rmax-lmax+1).lt.4) then
348    
349     if(iseed.eq.first) then !estremi...
350     rmax=iseed+2 !NB in questo modo puo' anche capitare di
351     lmax=iseed ! includere strip sotto taglio di inclusione
352     goto 250 ! che non serviranno per eta3e4!???
353     endif
354    
355     if(iseed.eq.last) then !estremi...
356     rmax=iseed
357     lmax=iseed-2 !NB 2 e non 3, perche' altrimenti sarei in
358     goto 250 ! ((rmax-lmax+1).lt.4).eq.false. !???
359     endif !NMB questo e' l'unico caso di cllength=3!???
360    
361     if(iseed.eq.first+1) then !quasi estremi...
362     rmax=iseed+2
363     lmax=iseed-1
364     goto 250
365     endif
366     if(iseed.eq.last-1) then
367     rmax=iseed+1
368     lmax=iseed-2
369     goto 250
370     endif
371     c se ho 4 o piu' strip --> se sono sui bordi esco, se sono sui quasi bordi
372     c includo la strip del bordo
373     else
374    
375     if(iseed.eq.first) goto 250 !estremi... non includo altro
376     if(iseed.eq.last) goto 250
377     if(iseed.eq.first+1) then !quasi estremi... mi assicuro di
378     lmax=first ! avere le strip adiacenti al seed
379     if((rmax-lmax+1).gt.nclstrp) rmax=rmax-1 !NB effetto
380     goto 250 ! coperta: se la lunghezza del cluster era gia'
381     endif ! al limite (nclstrp), per poter aggiungere questa
382     ! strip a sinistra devo toglierne una a destra...!???
383     if(iseed.eq.last-1) then
384     rmax=last
385     if((rmax-lmax+1).gt.nclstrp) lmax=lmax+1
386     goto 250
387     endif
388     endif
389     c------------------------------------------------------------------------
390     c be sure to include in the cluster the cluster seed with its 2 adjacent
391     c strips, and the one adjacent to the greatest between this two strip, as the
392     c fourth one. if the strips have the same value (!) the fourth one is chosen
393     c as the one having the greatest value between the second neighbors
394     c------------------------------------------------------------------------
395     if(value(iseed+1).eq.value(iseed-1)) then
396     if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'
397     diff=(iseed+2)-rmax
398     if(diff.gt.0) then
399     rmax=rmax+diff
400     if((rmax-lmax+1).gt.nclstrp) then
401     lmax=rmax-nclstrp+1
402     endif
403     endif
404     diff=(iseed-1)-lmax
405     if(diff.lt.0) then
406     lmax=lmax+diff
407     if((rmax-lmax+1).gt.nclstrp) then
408     rmax=lmax+nclstrp-1
409     endif
410     endif
411     else
412     diff=(iseed-2)-lmax
413     if(diff.lt.0) then
414     lmax=lmax+diff
415     if((rmax-lmax+1).gt.nclstrp) then
416     rmax=lmax+nclstrp-1
417     endif
418     endif
419     diff=(iseed+1)-rmax
420     if(diff.gt.0) then
421     rmax=rmax+diff
422     if((rmax-lmax+1).gt.nclstrp) then
423     lmax=rmax-nclstrp+1
424     endif
425     endif
426    
427     endif
428     elseif(value(iseed+1).gt.value(iseed-1)) then
429     c !??? sposto il limite del cluster a destra per includere sempre le strip
430     c necessarie al calcolo di eta-i
431     c se il cluster diventa troppo lungo lo accorcio a sinistra per avere non piu'
432     c di nclstrp (in questo caso sono sicuro di aver gia' incluso le strip
433     c necessarie al calcolo di eta-i a sinistra, quindi se voglio posso uscire)
434     diff=(iseed+2)-rmax
435     if(diff.gt.0) then
436     rmax=rmax+diff
437     if((rmax-lmax+1).gt.nclstrp) then
438     lmax=rmax-nclstrp+1
439     c goto 250
440     endif
441     endif
442     diff=(iseed-1)-lmax
443     if(diff.lt.0) then
444     lmax=lmax+diff
445     if((rmax-lmax+1).gt.nclstrp) then
446     rmax=lmax+nclstrp-1
447     c goto 250 !inutile!???
448     endif
449     endif
450     else
451     diff=(iseed-2)-lmax
452     if(diff.lt.0) then
453     lmax=lmax+diff
454     if((rmax-lmax+1).gt.nclstrp) then
455     rmax=lmax+nclstrp-1
456     c goto 250
457     endif
458     endif
459     diff=(iseed+1)-rmax
460     if(diff.gt.0) then
461     rmax=rmax+diff
462     if((rmax-lmax+1).gt.nclstrp) then
463     lmax=rmax-nclstrp+1
464     c goto 250 !inutile!???
465     endif
466     endif
467     endif
468     250 continue
469    
470     c--------------------------------------------------------
471     c fills ntuple variables
472     c--------------------------------------------------------
473     nclstr1=nclstr1+1 !cluster number
474     ccc print*,nclstr1,multtemp
475     if(nclstr1.gt.nclstrmax) then !too many clusters for the event:
476     good1=0 ! event
477     nclstr1=0
478     totCLlength=0
479     flag_shower = .true.
480     print*,'Event ',eventn(1),
481     $ ': more than ',nclstrmax,' clusters'
482     goto 2000
483     endif
484     view(nclstr1)=iv !vista del cluster
485     ladder(nclstr1)=nld(iseed,iv) !ladder a cui appartiene il cluster seed
486     maxs(nclstr1)=iseed !strip del cluster seed
487     mult(nclstr1)=multtemp !molteplicita'
488    
489     indstart(nclstr1)=ind !posizione dell'inizio del cluster nell'
490     ! array clsignal
491     indmax(nclstr1)=indstart(nclstr1)+(iseed-lmax) !posizione del
492     ! cluster seed nell'array clsignal
493    
494     CLlength=rmax-lmax+1 !numero di strip del cluster
495     totCLlength=totCLlength+CLlength
496     dedx(nclstr1)=0
497     do j=lmax,rmax !stores sequentially cluter strip values in
498     clsignal(ind)=value(j) ! clsignal array
499     ind=ind+1
500     c if(value(j).gt.0)
501     if(value(j).gt.clinclcut(j))
502     $ dedx(nclstr1)=dedx(nclstr1)+value(j) !cluster charge
503     enddo
504     c--------------------------------------------------------
505     c
506     c--------------------------------------------------------
507     endif !end possible seed conditio
508     220 continue !jumps here to skip strips left of last seed
509    
510     enddo ! end loop on strips
511     enddo !end loop on ladders
512     2000 continue
513     return
514     end
515    
516    
517     *---***---***---***---***---***---***---***---***
518     *
519     *
520     *
521     *
522     *
523     *---***---***---***---***---***---***---***---***
524    
525    
526     subroutine stripmask
527    
528     * this routine set va1 and single-strip masks,
529     * on the basis of the VA1 mask saved in the DB
530     *
531     * mask(nviews,nva1_view,nstrips_va1) !strip mask
532     * mask_vk(nviews,nva1_view) !VA1 mask
533     *
534     include 'commontracker.f'
535     include 'level1.f'
536     include 'calib.f'
537    
538     c$$$ character*20 data_file
539     c$$$
540     c$$$ character*3 aid
541     c$$$ character*6 adate
542     c$$$ integer id
543     c$$$ integer date
544     c$$$
545     c$$$* ----------------------
546     c$$$* retrieve date and id
547     c$$$ aid=data_file(8:10)
548     c$$$ adate=data_file(2:6)
549     c$$$ READ (aid, '(I3)'), id
550     c$$$ READ (adate, '(I6)'), date
551     c$$$* ----------------------
552    
553     * init mask
554     do iv=1,nviews
555     do ivk=1,nva1_view
556     do is=1,nstrips_va1
557     mask(iv,ivk,is) = mask_vk(iv,ivk)
558     enddo
559     enddo
560     enddo
561    
562     c$$$* ---------------------
563     c$$$* VIEW 2 - VK 23-24
564     c$$$* couple of vk damaged during integration
565     c$$$ if(date.ge.50208)then
566     c$$$cc print*,'MASK: view 2 - vk 23/24'
567     c$$$ mask_vk(2,23)=0
568     c$$$ mask_vk(2,24)=0
569     c$$$ do is=1,nstrips_va1
570     c$$$ mask(2,23,is)=0
571     c$$$ mask(2,24,is)=0
572     c$$$ enddo
573     c$$$ endif
574     c$$$
575     c$$$* ---------------------
576     c$$$* VIEW 7 - VK 11-12
577     c$$$ if(date.ge.50209)then
578     c$$$ if(.not.(date.eq.50209.and.id.le.6)) then
579     c$$$cc print*,'MASK: view 7 - vk 11/12'
580     c$$$ mask_vk(7,11)=0
581     c$$$ mask_vk(7,12)=0
582     c$$$ do is=1,nstrips_va1
583     c$$$ mask(7,11,is)=0
584     c$$$ mask(7,12,is)=0
585     c$$$ enddo
586     c$$$ endif
587     c$$$ endif
588     c$$$
589     c$$$* ---------------------
590     c$$$* VIEW 7 - VK 21-22
591     c$$$ if(date.ge.50316)then
592     c$$$cc print*,'MASK: view 7 - vk 21/22'
593     c$$$ mask_vk(7,21)=0
594     c$$$ mask_vk(7,22)=0
595     c$$$ do is=1,nstrips_va1
596     c$$$ mask(7,21,is)=0
597     c$$$ mask(7,22,is)=0
598     c$$$ enddo
599     c$$$ endif
600     c$$$
601     c$$$* ---------------------
602     c$$$* VIEW 12 - VK 1-2-3-4
603     c$$$ if((date.eq.50317).and.(id.le.3))then
604     c$$$cc print*,'MASK: view 12 - vk 1/2/3/4'
605     c$$$ mask_vk(12,1)=0
606     c$$$ mask_vk(12,2)=0
607     c$$$ mask_vk(12,3)=0
608     c$$$ mask_vk(12,4)=0
609     c$$$ do is=1,nstrips_va1
610     c$$$ mask(12,1,is)=0
611     c$$$ mask(12,2,is)=0
612     c$$$ mask(12,3,is)=0
613     c$$$ mask(12,4,is)=0
614     c$$$ enddo
615     c$$$ endif
616     c$$$
617     c$$$* ---------------------
618     c$$$* VIEW 7 - VK 5-6
619     c$$$ if(date.ge.50320)then
620     c$$$ if(.not.(date.eq.50320.and.id.le.3)) then
621     c$$$cc print*,'MASK: view 7 - vk 5/6'
622     c$$$ mask_vk(7,5)=0
623     c$$$ mask_vk(7,6)=0
624     c$$$ do is=1,nstrips_va1
625     c$$$ mask(7,5,is)=0
626     c$$$ mask(7,6,is)=0
627     c$$$ enddo
628     c$$$ endif
629     c$$$ endif
630     c$$$
631     c$$$* ---------------------
632     c$$$* VIEW 7 - VK 13-14
633     c$$$ if(date.ge.50320)then
634     c$$$ if(.not.(date.eq.50320.and.id.le.5)) then
635     c$$$cc print*,'MASK: view 7 - vk 13/14'
636     c$$$ mask_vk(7,13)=0
637     c$$$ mask_vk(7,14)=0
638     c$$$ do is=1,nstrips_va1
639     c$$$ mask(7,13,is)=0
640     c$$$ mask(7,14,is)=0
641     c$$$ enddo
642     c$$$ endif
643     c$$$ endif
644     c$$$
645     c$$$*** SAMARA
646     c$$$*** SAMARA
647     c$$$*** SAMARA
648     c$$$* it needs further checks...
649     c$$$
650     c$$$* ---------------------
651     c$$$* VIEW 7 - VK 9-10
652     c$$$* VIEW 12 - VK 1-2-3-4
653     c$$$ if((date.eq.50516).and.(id.le.8))then
654     c$$$cc print*,'MASK: view 7 - vk 9/10'
655     c$$$cc print*,'MASK: view 12 - vk 1/2/3/4'
656     c$$$ mask_vk(7,9)=0
657     c$$$ mask_vk(7,10)=0
658     c$$$ mask_vk(12,1)=0
659     c$$$ mask_vk(12,2)=0
660     c$$$ mask_vk(12,3)=0
661     c$$$ mask_vk(12,4)=0
662     c$$$ do is=1,nstrips_va1
663     c$$$ mask(7,9,is)=0
664     c$$$ mask(7,10,is)=0
665     c$$$ mask(12,1,is)=0
666     c$$$ mask(12,2,is)=0
667     c$$$ mask(12,3,is)=0
668     c$$$ mask(12,4,is)=0
669     c$$$ enddo
670     c$$$ endif
671     c$$$
672     c$$$* ---------------------
673     c$$$* VIEW 7 - VK 9-10
674     c$$$ if(date.ge.50516)then
675     c$$$ if(.not.(date.eq.50516.and.id.le.8)) then
676     c$$$cc print*,'MASK: view 7 - vk 9/10'
677     c$$$ mask_vk(7,9)=0
678     c$$$ mask_vk(7,10)=0
679     c$$$ do is=1,nstrips_va1
680     c$$$ mask(7,9,is)=0
681     c$$$ mask(7,10,is)=0
682     c$$$ enddo
683     c$$$ endif
684     c$$$ endif
685     c$$$
686     c$$$* ---------------------
687     c$$$* VIEW 12 - VK 7-8
688     c$$$ if(date.ge.50523)then
689     c$$$ if(.not.(date.eq.50523.and.id.le.3)) then
690     c$$$cc print*,'MASK: view 12 - vk 7/8'
691     c$$$ mask_vk(12,7)=0
692     c$$$ mask_vk(12,8)=0
693     c$$$ do is=1,nstrips_va1
694     c$$$ mask(12,7,is)=0
695     c$$$ mask(12,8,is)=0
696     c$$$ enddo
697     c$$$ endif
698     c$$$ endif
699    
700     return
701     end
702    

  ViewVC Help
Powered by ViewVC 1.1.23