C------------------------------------------------------------------------------ C A S R B A N D - Program to convert ASRot type output into C a marked BAND sequence for use by gle C------------------------------------------------------------------------------ C C Reads an excerpt from an .ASR file and converts encountered frequencies C into connected sticks C C 1/ the .ASR file is to be cut down to contain only the lines in the band C C 2/ blank lines or lines producing input errors will be ignored C C 3/ the first line of the data set should contain six numbers: C C FLEVEL - position in units of Y-axis (usually 0 to 1) of the band C line C SHIFT - difference between top and bottom band lines for C backfolded bands (suggested value = 0.01) C FLEN - marker length in Y-axis units (suggested value = 0.01, C change the sign to change direction relative to the C band line) C FMULT - multiplier for the length of selected markers C (suggested value = 1. or 2.) C NMULT - the divisor for which markers should be made longer C (suggested value 5 or 10) C NQN - number of quantum number (1-6) to be subject to C the marker multiplier C C 4/ Three types of special lines are allowed defining actions depending C on the character placed in the 21st column (underneath the E in the C intensity column) C C209177.321357 2.50E-04 115, 1,115 114, 0,114 b.R 1, 1113.756378 399.472 C209177.321357 T C209177.321357 * C209177.321357 D 10. 5. C C The 'T' line defines the frequency of the turning point for the band C C The '*' line defines an extension of the band line to the specified C frequency C C The 'D' line defines three dashes terminating the band line with C the two values following the 'D' defining empty run length, and C dash length, respectively. If 'D' is used with '*' then it is best C to give the same frequency for both. C C C C ver. 10.IV.2007 ----- Zbigniew KISIEL ----- C __________________________________________________ C | Institute of Physics, Polish Academy of Sciences | C | Al.Lotnikow 32/46, Warszawa, POLAND | C | kisiel@ifpan.edu.pl | C | http://info.ifpan.edu.pl/~kisiel/prospe.htm | C_________________________/-------------------------------------------------- C C Modification history: C c 26.10.02: stop points c 20.11.03: enhanced marker multiplier options c 10.04.07: up to standard of CATBAND C_____________________________________________________________________________ c C implicit real*8 (a-h,o-z) character filnam*25,line*80 c iturn=0 c c WRITE(*,5500) 5500 FORMAT(1X//' ',76(1H_)/' |',T79,'|'/ * ' | ASRBAND - Conversion of .ASR output into marked BAND ', * 'sequence for use',T79,'|'/ * ' | in gle drawings',T79,'|'/ * ' |',76(1H_),'|'/' version 10.IV.2007',T64,'Zbigniew KISIEL'/) c c 1 write(*,'(1x//'' Name of data file: '',$)') read(*,'(a)',err=1)filnam open(2,file=filnam,status='old',err=1) do 7 n=1,len(filnam) if(filnam(n:n).eq.'.'.or.filnam(n:n).eq.' ')then ncars=n-1 goto 8 endif 7 continue ncars=len(filnam) 8 open(3,file=filnam(1:ncars)//'.dat',status='unknown') c C parameters line C read(2,*)flevel,shift,flen,fmult,nmult,nqn write(*,10)fmult,nmult,nqn 10 format(1x/10x,'Fmult = ',f5.2/ * 10x,'nmult = ',i5/ * 10x,' nqn = ',i5/) c C ASROT line C C209177.321357 2.50E-04 115, 1,115 114, 0,114 b.R 1, 1113.756378 399.472 C nread=0 2 read(2,'(a)',err=2,end=3)line c read(line(1:14),'(f14.0)',err=2)freq if(freq.eq.0.0d0)goto 2 c if(line(21:21).ne.'*'.and. * line(21:21).ne.'D'.and.line(21:21).ne.'d'.and. * line(21:21).ne.'T'.and.line(21:21).ne.'t')then write(3,'(4a)')'! transition: ',line(25:37),' <--',line(38:50) write(3,'(''!'')') endif c if(line(21:21).eq.'*')then write(3,'(a/''!'')')'! elongation of the band line' write(3,4)freq,' ',flevel write(3,'(''!'')') goto 2 endif c if(line(21:21).eq.'T'.or.line(21:21).eq.'t')then write(3,'(a/''!'')')'! BAND TURNING POINT' write(3,4)freq,' ',flevel flevel=flevel-shift write(3,4)freq,' ',flevel write(3,'(''!'')') iturn=1 goto 2 endif c if(line(21:21).eq.'D'.or.line(21:21).eq.'d')then read(line(22:),*,err=2,end=2)fblank,fdash write(3,'(a/''!'')')'! three dashes terminating the band line' freq=freq+fblank write(3,4)freq,' * ' write(3,4)freq,' ',flevel write(3,4)freq+fdash,' ',flevel write(3,'(1x)') freq=freq+fblank+fdash write(3,4)freq,' * ' write(3,4)freq,' ',flevel write(3,4)freq+fdash,' ',flevel write(3,'(1x)') freq=freq+fblank+fdash write(3,4)freq,' * ' write(3,4)freq,' ',flevel write(3,4)freq+fdash,' ',flevel write(3,'(''!'')') goto 2 endif c c...select quantum number to use for longer markers every multiple of NMULT c c columns 27:29 for J' c columns 31:33 for k-1' c columns 35:37 for k+1' c columns 40:42 for J'' c columns 44:46 for k-1'' c columns 48:50 for k+1'' c if(nqn.le.3)then ncola=(nqn-1)*4+27 ncolb=ncola+2 endif if(nqn.ge.4)then ncola=(nqn-4)*4+40 ncolb=ncola+2 endif rmult=1. read(line(ncola:ncolb),'(i3)')m if((m/nmult)*nmult.eq.m)then rmult=fmult endif c if(iturn.eq.0)then fmark=flevel+rmult*flen else fmark=flevel-rmult*flen endif write(3,4)freq,' ',flevel write(3,4)freq,' ',fmark write(3,4)freq,' ',flevel 4 format(5x,f14.4,a,f7.4) write(3,'(''!'')') c goto 2 c 3 close(2) close(3) write(*,'(1x/'' Output written to: '',a//)') * filnam(1:ncars)//'.dat' c stop end C C------------------------------------------------------------------------------ C------------------------------------------------------------------------------