SUBROUTINE TRNSPRT C C DESCRIBED IN CERN 73-16, SLAC 91, NAL 91 C BY BROWN, ROTHACKER, CAREY, AND ISELIN C C MAIN STEERING ROUTINE C C List of Common Blocks C INCLUDE 'TRNSPRT_PARAM.CIN' INCLUDE 'BROAD.CIN' INCLUDE 'CONSTS.CIN' INCLUDE 'DATA0A.CIN' INCLUDE 'DATA0B.CIN' INCLUDE 'DATA1A.CIN' INCLUDE 'DATA1C.CIN' INCLUDE 'DATA2A.CIN' INCLUDE 'DATA2D.CIN' INCLUDE 'ELM0A.CIN' INCLUDE 'ELM8A.CIN' INCLUDE 'ELM10B.CIN' INCLUDE 'FLUSHC.CIN' INCLUDE 'IOFLAG.CIN' INCLUDE 'IOUNIT.CIN' INCLUDE 'PRINTL.CIN' INCLUDE 'RDPRNT.CIN' INCLUDE 'STEPT1.CIN' C C List of local variables C INTEGER NV3M, NSAVE DATA NV3M /NPVAR/ C C Declare the Named Block Data as External so it loads properly C EXTERNAL TRNSBLK, TRINBLK C C --------------------------------------------------- C Executable C----------------------------------------------------- C WRITE (NOUT,1901) 1901 FORMAT (' CHANGEDATE(TRMAIN FORTRAN 19991129 16:31:18)') NPSTEP = 0 BROAD = .TRUE. RADIAN = 180.0/PI NV3 = NV3M CALL RDINIT(NIN,NOUT) 100 CALL FITTIN IF (FLUSHL .OR. ENDFIL) GO TO 300 IF (NUSE .NE. 0) THEN CALL REVISE IF (FLUSHL) GO TO 300 CALL REPAIR IF (FLUSHL) GO TO 300 ENDIF CALL RDVCIN CALL FINGER CALL FITCHK CALL REFCHK IF (FLUSHL) GO TO 300 C IF (ALIGN) THEN CALL MCOUNT IF (FLUSHL) GO TO 300 CALL SPREAD CALL MIDENT IF (FLUSHL) GO TO 300 CALL FINGER ENDIF C C NARROW BAND FITTING C NSAVE = NV1 NV3 = 0 IF (LSTEP) THEN CALL FNDSTP IF (.NOT. BROAD) GO TO 110 IF (BROAD) GO TO 210 ENDIF IF (.NOT. SLV) GO TO 100 IF (NV1 * NC .NE. 0) THEN NPASS = 1 IF (ALIGN)THEN CALL HARDEN IF (FLUSHL) GO TO 300 ENDIF NV3 = NSAVE CALL EXPLOR IF (FLUSHL) GO TO 300 NV3 = 0 IF (BEF) THEN CALL OUTFIT IF (FLUSHL) GO TO 300 ENDIF NV3 = NSAVE CALL SOLVE IF (FLUSHL) GO TO 300 NV3 = 0 ENDIF IF (PRNT) THEN NPASS = 2 IF (ALIGN) THEN CALL HARDEN IF (FLUSHL) GO TO 300 ENDIF CALL PARADE CALL OUTFIT IF (FLUSHL) GO TO 300 IF (MADL .OR. TRANSPORTL .OR. LATDEFL .OR. STRUCTL 1 .OR. ACADL .OR. FILEL) CALL LATOUT ENDIF GO TO 100 C C STEPPING OF A PARAMETER, WITH SEPARATE FITTING FOR EACH VALUE C 110 IF (.NOT. SLV) GO TO 100 DO 150 NSTEPP = 1, NSTEPS NV1 = NSAVE CALL STEPIT IF (NV1 * NC .NE. 0) THEN NPASS = 1 IF (ALIGN)THEN CALL HARDEN IF (FLUSHL) GO TO 300 ENDIF NV3 = NSAVE CALL EXPLOR IF (FLUSHL) GO TO 300 CALL SOLVE IF (FLUSHL) GO TO 100 NV3 = 0 ENDIF IF (PRNT) THEN NPASS = 2 IF (ALIGN)THEN CALL HARDEN IF (FLUSHL) GO TO 300 ENDIF CALL OUTFIT ENDIF 150 CONTINUE GO TO 100 C C BROAD BAND FITTING C 210 IF (NV1 * NC .NE. 0) THEN NPASS = 1 IF (ALIGN) THEN CALL HARDEN IF (FLUSHL) GO TO 300 ENDIF LSTEPN = LSTEP CALL FZERO DO 220 NSTEPP = 1, NSTEPS CALL STEPIT CALL RECKON 220 CONTINUE LSTEPN = .FALSE. IF (BEF) THEN CALL OUTFIT IF (FLUSHL) GO TO 100 ENDIF NV3 = NSAVE CALL EXPLOR IF (FLUSHL) GO TO 300 CALL SOLVE IF (FLUSHL) GO TO 300 NV3 = 0 ENDIF IF (PRNT) THEN NPASS = 2 LSTEPN = LSTEP CALL FZERO DO 240 NSTEPP = 1, NSTEPS CALL STEPIT CALL RECKON 240 CONTINUE LSTEPN = .FALSE. IF (ALIGN) THEN CALL HARDEN IF (FLUSHL) GO TO 300 ENDIF CALL PARADE CALL OUTFIT ENDIF GO TO 100 C 300 CONTINUE RETURN END BLOCK DATA TRNSBLK C C BLOCKDATA FOR TRANSPORT C C List of Commons C INCLUDE 'TRNSPRT_PARAM.CIN' INCLUDE 'CONSTS.CIN' INCLUDE 'ELM8B.CIN' INCLUDE 'ELM8H.CIN' INCLUDE 'ELM39D.CIN' INCLUDE 'HORNS.CIN' INCLUDE 'INDX.CIN' INCLUDE 'IOUNIT.CIN' INCLUDE 'LIMITS.CIN' C C Local variables C C Equivalence these local variables to RDCHAR variables C C------------------------------------------------------------ DATA INDX2 /0,1,3,6,10,15/ DATA INDX3 /0,1,4,10,20,35/ DATA NIN, NOUT, NPUNCH, NDATA, NPLOT /5, 6, 4, 7, 8/ DATA CT, CT0, CT1, VM /36*0.0,36*0.0,9*0.0,6*0.0/ DATA PI /3.14159265358979323/, CLIGHT /2.997924580E8/, 1 EMASS /.5110041E-3/ DATA ALM04 /0., 1., 0., 0., 1 0., 0., 0., 0., 2 0., 0., 0., 0., 3 0., 0., 0., 0., 4 0., 0., 0., 0., 5 0., 0., 0., 0./ DATA ALM05 /0., 1., 0., 0., 1 0., 0., 0., 0., 2 0., 0., 0., 0., 3 0., 0., 0., 0., 4 0., 0., 0., 0./ DATA ALM01 /0., 1., 0., 0./ DATA ALM02 /-1.04720,1., 1.04720,1./ DATA ALM03 /0., 1., 0., 0./ DATA ALM012 /-.99999, 1., .99999, 1., 1 -.99999, 1., .99999, 1., 2 -.99999, 1., .99999, 1., 3 -.99999, 1., .99999, 1., 4 -.99999, 1., .99999, 1., 5 -.99999, 1., .99999, 1., 6 -.99999, 1., .99999, 1., 7 -.99999, 1., .99999, 1., 8 -.99999, 1., .99999, 1., 9 -.99999, 1., .99999, 1., A -.99999, 1., .99999, 1., B -.99999, 1., .99999, 1., C -.99999, 1., .99999, 1., D -.99999, 1., .99999, 1., E -.99999, 1., .99999, 1./ DATA ALM018 /0., 1., 0., 0., 1 0., 0., 0., 0., 2 0., 0., 0., 0., 3 0., 0., 0., 0./ DATA ALM019 /0., 1., 0., 0., 1 0., 0., 0., 0., 2 0., 0., 0., 0./ DATA ALM020 /-6.28318,1., 6.28318,1./ DATA ALM025 /0., 1., 0., 0., 1 0., 0., 0., 0., 2 0., 0., 0., 0., 3 0., 0., 0., 0./ DATA ALM028 /0., 1., 0., 0., 1 0., 0., 0., 0., 2 0., 0., 0., 0., 3 0., 0., 0., 0., 4 0., 0., 0., 0., 5 0., 0., 0., 0., 6 0., 0., 0., 0., 7 0., 0., 0., 0., 8 0., 0., 0., 0., 9 0., 0., 0., 0., A 0., 0., 0., 0., B 0., 0., 0., 0., C 0., 0., 0., 0./ DATA ALM034 /0., 1., 0., 0., 1 0., 0., 0., 0., 2 0., 0., 0., 0., 3 0., 0., 0., 0., 4 0., 0., 0., 0./ DATA ALM035 /0., 1., 0., 0., 1 0., 0., 0., 0., 2 0., 0., 0., 0., 3 0., 0., 0., 0./ C----------------------------------------------------------------------- DATA MXHORN /12/ DATA NELLIM /ISTLIM/, IDLIM /IDALIM/ END BLOCKDATA BDNEWOUT C INCLUDE 'TRNSPRT_PARAM.CIN' INCLUDE 'LOUTAR.CIN' INCLUDE 'DBEAMR.CIN' INCLUDE 'DSPECR.CIN' INCLUDE 'OUTNEWC.CIN' C 1 ' ','LINE 1 ITEMS 1- 4 L,THETA,K1,K2'/ C 2 ' ','LINE 2 ITEMS 5- 8 K3,TILT,ALPHAX,BETAX,'/ C 3 ' ','LINE 3 ITEMS 9-12 MUX,ETAX,ETAX'',ALPHAY'/ C 4 ' ','LINE 4 ITEMS 13-16 BETAY,MUY,ETAY,ETAY'''/ C 5 ' ','LINE 5 ITEMS 17-20 4*NOT USED'/ C 6 ' ','LINE 6 ITEMS 21-24 SUML,X,Y,Z(FLOOR)'/ C 7 ' ','LINE 7 ITEMS 25-30 YAW,PITCH,ROLL',3*NOT DEFINED.') DATA OUTDESC /'LENGTH','BEND','K1','K2','K3','TILT', ! 6 1 'ALPHA X','BETA X','MU X','ETA X','ETA X''', ! 5 11 2 'ALPHA Y','BETA Y','MU Y','ETA Y','ETA Y''', ! 5 16 3 'X(C)','X''(C)','Y(C)','Y''(C)', ! 4 20 4 'DIST.','X FLOOR','Y FLOOR','Z FLOOR','YAW','PITCH','ROLL', ! 7 27 5 'SIG11','SIG12','SIG13','SIG14','SIG15','SIG16', !6 33 6 'SIG22','SIG23','SIG24','SIG25','SIG26', !5 38 7 'SIG33','SIG34','SIG35','SIG36', !4 42 8 'SIG44','SIG45','SIG46', !3 45 9 'SIG55','SIG56','SIG66',!3 48 1 12*' '/ C DATA DSPEC_VAL /33*-1.0E+10/ DATA DBEAM_VAL /18*-1.0E+10/ DATA DETA_VAL / 6*-1.0E+10/ C END BLOCKDATA BDSTATUS INCLUDE 'CHARLINE.CIN' INCLUDE 'DTF.CIN' INCLUDE 'DTFRI.CIN' INCLUDE 'PRINTC.CIN' INCLUDE 'PRINTL.CIN' C DATA CDATE, CTIME, MACHINE, TIN, UFILEIN, UFILEOUT, HOMEDIR, 1 CURRENT, TRANFILE /' ',' ',' ',' ',' ',' ',' ',' ',' '/ DATA LMC, LTN, LCD, NIH /0,0,0,0/ DATA ACADL, FILEL, LATDEFL, MADL, STRUCTL, TRANSPORTL 1 /.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE.,.FALSE./ DATA ACADFILE, FILENAME, LATDEFFILE, MADFILE, STRUCTFILE, 1 TRANSPORTFILE /' ',' ',' ',' ',' ',' '/ DATA LACADF, LLATDEFF, LMADF, LSTRUCTF, LTRANSPORTF 1 /0,0,0,0,0/ DATA SLINE, AS, BS /' ',' ',' '/ END