C PROGRAM phsp C C PROGRAM TO CONVERT A MAP IN TEN EYCK'S FFT FORMAT TO hassp readable one C THE INPUT MAP *MUST* CORRESPOND TO THE FOLLOWING CONSTRAINTS : C C () INPUT MAP MAY BE TERMINATED WITH A NEGATIVE SECTION NO. C ############################################## C () # MAP MUST BE SECTIONED IN Z. # C ############################################## C C program asks for: name of input teneyck map (usually *.tey) C name of output FFT map C C NO. OF GRID POINTS IN ONE SECTION(i.e.(NACROSS)*(NDOWN)) C SHOULD NOT EXCEED MAPDIM.(currently 160000) C C NO. OF GRID POINTS ACROSS (DOWN) SHOULD NOT EXCEED MAPREC ( currently 400 ) C C WARNING!!! PROGRAM DESIGNED TO READ .TEY FORMAT FROM PROTEIN3.1, C IF YOU ARE DOING CONVENTIONAL FOURIER C TRANSFORMATION AND THEN "CONV E H" REMEMBER THAT IT WOULD BE X-DOWN C AND Y-ACROSS! SO Y DIRECTION WILL BE THE FASTEST ONE. C USER HAVE TO TAKE CARE OF THAT AND KNOW DEFINITLY WHAT (X OR Y) IS THE C FASTEST, PLEASE DO 'COPY (DIRE Z)' AND UNDERSTAND WHAT DIRECTION IS ACROSS C THE BEST WAY TO DO THAT -- 'LIST E' AFTER 'COPY' AND SEE THE LOG FILE. C C ##### PHSP DOES NOT KNOW HOW YOUR MAP IS DESIGNED ####### C IT EXPECTS ONLY Z-SECTIONING,SO PROGRAM HAVE TO ASK SHOULD IT EXCHANGE C X AND Y DIRECTIONS, BECAUSE HASSP EXPECTS XYZ-MAP C IF YOU WANT TO DO THAT ANSWER 1 C C NEXT QUESTION IS ABOUT SHARPENING PEAKS. IF YOU DO NOT WANT TO DO THAT C JUST ANSWER 0, OTHERWISE YOUR ANSWER (>1) WILL CAUSE 'SHARPENING' C IN CORRESPONDING DEGREE. ANSWERING 1 HAS NO SENSE. DO NOT ENTER C 1.5 OR 2.1. C YOU ALSO MAY ENTER SCALING VALUE. 1 - JUST REMAIN THE MAP AS IT IS. C C YOU CAN NOT REWRITE ALL THE ENTERING SECTIONS, JUST RESTRICT THE NUMBER OF C OUTPUT SECTIONS WITH DESIRABLE NUMBER. NUMERATION BEGINS FROM 1!!!! C C IF YOU WANT TO USE UNIX VERSION OF HASSP ANSWER 1 TO CORRESPNDING C QUESTION C C------------------------------------------------------------------------------ PARAMETER (MAPDIM=160000, MAPREC = 400) C CHARACTER*40 MAPIN,MAPOUT C CHARACTER*4 VERS COMMON/MAP/ AMAP(MAPDIM),RMAP(MAPREC) COMMON /IO/LC,LT,LMAP,LTEYCK COMMON /OUTP/ SCALE,NXM,NYM,NZM,ASC,NORN,IXSM,IYSM,IZSM,ISHARP * ,iver C--- DEFINE LOGICAL UNITS LC=5 LT=6 LTEYCK=10 LMAP=13 C------------------------- C WRITE (LT,25) READ (LC,90) MAPIN OPEN (UNIT=LTEYCK,FILE=MAPIN,STATUS='OLD',FORM='UNFORMATTED', . READONLY,err=10011) WRITE (LT,30) READ (LC,90) MAPOUT 25 FORMAT (T2,'Enter file name for input(Ten Eyck) map',T54,'> ',$) 30 FORMAT (T2,'Enter file name for the output map',T54,'> ',$) write(lt,2970) read(lc,'(i1)')norn !replace XY write (lt,2980) read(lc,'(i1)')isharp if(isharp.le.1) isharp=1 write (lt,2990) read(lc,*)scale if(scale.le.0.) scale=1. write (lt,2995) read(lc,*)ISEC if(ISEC.le.0.OR.isec.eq.1) isec=1000000 iver=0 write (lt,3000) read(lc,'(i1)') iVER c if(VERS.eq.'unix')iver=1 c if( (VERS.ne.'unix'.and.VERS.ne.'vms ') c * .or.(VERS.ne.'UNIX'.and.VERS.ne.'VMS ' ) ) stop ' WRONG VERS c * OF OS -- CHECK INPUT' if(iver.ne.1)iver=0 2970 format(' DO YOU WANT TO SWITCH X AND Y IN Z-SECTIONS?'/ * ' (HASSP EXPECTS XYZ MAP) -- 1 YES',T54,'> ',$) 2980 format(' ENTER DEGREE OF SHARPENING (2,3,..) '/ * ' 1 OR LESS - NOT TO SHARP',T54,'> ',$) 2990 format(' ENTER SCALE FACTOR',T54,'> ',$) 2995 format(' HOW MANY SECTIONS TO REWRITE?',T54,'> ',$) 3000 format(' IF YOU ARE GOING TO USE UNIX HASSP? -'/ * ' ANSWER 1 OTHERWISE ANSWER 0',T54,'> ',$) II=0 !number of current section C C READ TITLE OF TEN EYCK MAP READ(LTEYCK)JUNK C C READ TEN EYCK'S SUBHEADER FIRST TIME AND REMEMBER C C C READ SECTION HEADER C READ (LTEYCK)NSEC,NFASTI,NFASTF,NSLOWI,NSLOWF c...debug c type *,' sech',NSEC,NFASTI,NFASTF,NSLOWI,NSLOWF C C CHECK FOR END-OF-MAP C nerror=0 call secend(nsec,ii,nerror) if(nerror.ne.0) goto 998 c c now we know something about map c nfasti - nfastf fast direction boundaries nslowi ...f slow direction c c nfast must be x c we should and are able to determine the record length in output file c if(norn.eq.1) then nxm=nslowf-nslowi+1 nym=nfastf-nfasti+1 else nym=nslowf-nslowi+1 nxm=nfastf-nfasti+1 endif irecl=nxm c !output map contents x-records y-blocks z-sections c...debug c type *,' nxm,nym',nxm,nym if(iver.ne.1) then OPEN(UNIT=LMAP,FILE = MAPOUT,FORM='UNFORMATTED', * STATUS='NEW') else open(unit=LMAP,file=mapout,access='direct',recl=irecl, * status='new') endif IA=NXM ID=NYM icoun=1 C MAIN CYCLE C READ TEN EYCK MAP ONE SECTION AT A TIME, C ... AND WRITE IT RECORD BY RECORD. C nerror=0 DO 130 II = 1,ISEC CALL READTEYCK ( IA,ID,II,NERROR ) IF (NERROR.LT.0)GO TO 998 do 120 jj=1,id if (norn.eq.1) then do 210 kk=1,ia 210 rmap(kk)=AMAP((kk-1)*id+jj) else DO 110 KK = 1,IA 110 RMAP(KK) = AMAP(kk+(jj-1)*ia) endif call wrmap(ia,icoun) 120 CONTINUE c c now read second and others TEN EYK'S subheaders c C C READ SECTION HEADER C READ (LTEYCK)NSEC1,NFASTI1,NFASTF1,NSLOWI1,NSLOWF1 c...debug c type *,' sech',NSEC1,NFASTI1,NFASTF1,NSLOWI1,NSLOWF1 C C CHECK FOR END-OF-MAP C nerror=0 call secend(nsec1,ii,nerror) if(nerror.ne.0) goto 999 C C check consistency C if((nfastf1-nfastf+nslowi1-nslowi+ * nfasti1-nfasti+nslowf1-nslowf).ne.0) then type *,' inconsistent headers' go to 998 endif NFAST = NFASTF1 - NFASTI1 + 1 NSLOW = NSLOWF1 - NSLOWI1 + 1 if(norn.eq.1) then nnn=nfast nfast=nslow nslow=nnn endif IF ( (NFAST-IA)*(NSLOW.NE.ID).ne.0 ) THEN WRITE (LT,400)IA,ID,NFAST,NSLOW 400 FORMAT(/5X,' INFORMATION ON HEADER AT SEC ',I10, . ' DOES NOT TALLY',/5X . ,'WITH FIRST HEADER ON TEN EYCK MAP.'//5X,' ACCORDING TO . FIRST HEADER, YOU HAVE ',I4,' GRID POINTS ACROSS AND',I4,'GRID . POINTS DOWN',/5X,'BUT NOW, YOU HAVE ',I4,' GRID . POINTS ACROSS AND ',I4,'GRID POINTS DOWN.') GO TO 998 END IF if(nsec1.ne.ii) then write(6,401)ii,nsec1 401 format(/5X,' INCONSISTENT SECTION NUMBER ' . /' MUST BE ',I10,' IN TEY MAP',I10) GOTO 998 endif C 130 CONTINUE go to 999 C___________________________________________________________________________ 90 format (A) C------------------------------------------------------------------------------ 998 STOP ' FAIL TO COMPLETE' 999 CONTINUE C--- ECHO INFORMATION TO LINE PRINTER WRITE(LT,1089)II,IA,ID 1089 FORMAT(//27X,'MAP WRITTEN AS ',I10,1X,' XYZ SECTIONS', .//35X,'WITH',I3,' GRID POINTS ACROSS', .//35X,'AND ',I3,' GRID POINTS DOWN' ) STOP ' NORMAL END' 10011 stop ' failed to open input file' END C------------------------------------------------------------------------------- SUBROUTINE READTEYCK ( IA,ID,II,NERROR ) PARAMETER (MAPDIM = 160000,MAPREC=400) COMMON/MAP/ AMAP(MAPDIM),RMAP(MAPREC) COMMON /IO/LC,LT,LMAP,LTEYCK COMMON /OUTP/ SCALE,NXM,NYM,NZM,ASC,NORN,IXSM,IYSM,IZSM,ISHARP * ,iver C NERROR = 0 C NOW READ SECTION NPNTS = IA*ID READ(LTEYCK)(AMAP(I),I=1,NPNTS) c...debug c type *,' ty section ',(AMAP(I),I=1,NPNTS) C RETURN END subroutine wrmap(ia,k) PARAMETER (MAPDIM=160000, MAPREC = 400) C COMMON/MAP/ AMAP(MAPDIM),RMAP(MAPREC) COMMON /IO/LC,LT,LMAP,LTEYCK COMMON /OUTP/ SCALE,NXM,NYM,NZM,ASC,NORN,IXSM,IYSM,IZSM,ISHARP * ,iver ssc=scale do 100 i=1,ia fsign=1. if(mod(isharp,2).eq.0) fsign=rmap(i)/abs(rmap(i)) rmap(i)=fsign*scale*rmap(i)**isharp c if(iver.eq.1) call bytswp(rmap,ia,maprec) 100 continue if(iver.eq.1) then WRITE(LMAP,rec=k)(RMAP(I),I=1,IA) k=k+1 else WRITE(LMAP)(RMAP(I),I=1,IA) endif c...debug c type *,' mapo ' cddddee c type *,(RMAP(I),I=1,IA) return end c########################### subroutine bytswp (rec,dim,id) implicit none integer*4 dim,kkk,i,id byte rec(2,2*id), one kkk=2*dim do 100 i=1,kkk one = rec (1,i) rec(1,i) = rec(2,i) 100 rec(2,i) = one return end c############################ subroutine secend(nsec,ii,nerror) nerror=0 IF (NSEC.LT.0) THEN WRITE (6,300)II 300 FORMAT(/5X, 'END OF TEN EYCK MAP REACHED AFTER',I4,' SECTIONS') NERROR = -2 END IF end