hdiff output

r22287/coorio.src 2017-01-21 10:33:35.718250000 +0000 r22286/coorio.src 2017-01-21 10:33:36.418250000 +0000
 47: ##INCLUDE '~/charmm_fcm/stream.fcm' 47: ##INCLUDE '~/charmm_fcm/stream.fcm'
 48: ##INCLUDE '~/charmm_fcm/parallel.fcm'  ! mh050712 48: ##INCLUDE '~/charmm_fcm/parallel.fcm'  ! mh050712
 49: C 49: C
 50:       INTEGER NATOM,IOMODE,IFILE,IOFFS,NINPUT,IMODE,NSEG 50:       INTEGER NATOM,IOMODE,IFILE,IOFFS,NINPUT,IMODE,NSEG
 51:       INTEGER IUNIT,IFREEA,IRESM,LENAP,IRES,NRES,IRESC,I 51:       INTEGER IUNIT,IFREEA,IRESM,LENAP,IRES,NRES,IRESC,I
 52:       CHARACTER*(*) TITLEB(*) 52:       CHARACTER*(*) TITLEB(*)
 53:       INTEGER NTITLB,ICNTRL(*),MODECW,MODEL,MODFL 53:       INTEGER NTITLB,ICNTRL(*),MODECW,MODEL,MODFL
 54: C 54: C
 55:       LOGICAL ERROR 55:       LOGICAL ERROR
 56:       INTEGER OLDUSD 56:       INTEGER OLDUSD
 57: C jmc allow longer lines to be read in from input coordinate files 57:       CHARACTER*80 ILINE
 58: C jmc      CHARACTER*80 ILINE 
 59:       CHARACTER*120 ILINE 
 60:       LOGICAL OFFICIAL 58:       LOGICAL OFFICIAL
 61: C 59: C
 62: C++LNI add for reading dynamics RESTART FILE 60: C++LNI add for reading dynamics RESTART FILE
 63:       INTEGER IX1,IX2,IY1,IY2,IZ1,IZ2,IDM,JDUM,LDYNA 61:       INTEGER IX1,IX2,IY1,IY2,IZ1,IZ2,IDM,JDUM,LDYNA
 64:       REAL*8 DUM 62:       REAL*8 DUM
 65: C 63: C
 66: C--LNI add for reading dynamics RESTART FILE 64: C--LNI add for reading dynamics RESTART FILE
 67:       OLDUSD=LSTUSD 65:       OLDUSD=LSTUSD
 68:       WX=ALLSTK(IREAL4(NATOM+1)) 66:       WX=ALLSTK(IREAL4(NATOM+1))
 69:       WY=ALLSTK(IREAL4(NATOM+1)) 67:       WY=ALLSTK(IREAL4(NATOM+1))
298:               Y(I)=ANUM296:               Y(I)=ANUM
299:               Z(I)=ANUM297:               Z(I)=ANUM
300:             ENDIF298:             ENDIF
301:           ENDDO299:           ENDDO
302:         ENDIF300:         ENDIF
303: C301: C
304:         IF (NINPUT.NE.-2) THEN302:         IF (NINPUT.NE.-2) THEN
305:           CALL CREAD(IUNIT,TITLEB,NTITLB,ICNTRL,X,Y,Z,WMAIN,NATOM,303:           CALL CREAD(IUNIT,TITLEB,NTITLB,ICNTRL,X,Y,Z,WMAIN,NATOM,
306:      &      NINPUT,ISLCT,STACK(WX),STACK(WY),STACK(WZ),STACK(WW),IOFFS,304:      &      NINPUT,ISLCT,STACK(WX),STACK(WY),STACK(WZ),STACK(WW),IOFFS,
307:      &      RES,NRES,TYPE,IBASE,IFILE,STACK(IFREEA),305:      &      RES,NRES,TYPE,IBASE,IFILE,STACK(IFREEA),
308: C jmc     &      SEGID,RESID,NICTOT,NSEG,LRSID,LFREE,ILINE,80,MODEL,OFFICIAL)306:      &      SEGID,RESID,NICTOT,NSEG,LRSID,LFREE,ILINE,80,MODEL,OFFICIAL)
309:      &      SEGID,RESID,NICTOT,NSEG,LRSID,LFREE,ILINE,120,MODEL,OFFICIAL) 
310:         ELSE307:         ELSE
311:           CALL CREADU(IUNIT,X,Y,Z,WMAIN,NATOM,ISLCT,308:           CALL CREADU(IUNIT,X,Y,Z,WMAIN,NATOM,ISLCT,
312:      &      RES,NRES,TYPE,IBASE,SEGID,RESID,NICTOT,NSEG,309:      &      RES,NRES,TYPE,IBASE,SEGID,RESID,NICTOT,NSEG,
313:      &      LRSID,LFREE,IOFFS)310:      &      LRSID,LFREE,IOFFS)
314:         ENDIF311:         ENDIF
315:         IF (LCHECK) THEN312:         IF (LCHECK) THEN
316:           DO I=1,NATOM313:           DO I=1,NATOM
317:             IF(.NOT.INITIA(I,X,Y,Z)) THEN314:             IF(.NOT.INITIA(I,X,Y,Z)) THEN
318:               CALL WRNDIE(1,'<COORIO>',315:               CALL WRNDIE(1,'<COORIO>',
319:      &          'The coordinates for some atoms were not read')316:      &          'The coordinates for some atoms were not read')


r22287/coorio.src.save 2017-01-21 10:33:36.082250000 +0000 r22286/coorio.src.save 2017-01-21 10:33:36.698250000 +0000
  1: CHARMM Element source/io/coorio.src 1.1  1: svn: E195012: Unable to find repository location for 'svn+ssh://svn.ch.private.cam.ac.uk/groups/wales/trunk/CHARMM35/source/io/coorio.src.save' in revision 22286
  2:       SUBROUTINE COORIO(IOMODE,IUNIT,COMLYN,COMLEN, 
  3:      &  TITLEB,NTITLB,ICNTRL,NATOM,X,Y,Z,WMAIN, 
  4:      &  ISLCT,TYPE,RESID,RES,NRES,IBASE,SEGID,NICTOT,NSEG,LCHECK) 
  5: C----------------------------------------------------------------------- 
  6: C     THIS ROUTINE PARSES THE COMMAND LINKE FOR OPTIONS AND ATOM 
  7: C     SPECIFICATION IN READING AND WRITING COORDINATES. 
  8: C 
  9: C     SOME OF THE CALLING SEQUENCE; 
 10: C       IOMODE - INTEGER - NEGATIVE READ, ZERO WRITE, POSITIVE PRINT 
 11: C       IUNIT - INTEGER - FORTRAN UNIT NUMBER FOR IO 
 12: C       ISLCT - I*2     - LIST OF SELECTED ATOMS RETURNED 
 13: C       LMUST - LOGICAL - IF TRUE, WILL CHECK FOR ALL ATOMS PLACED 
 14: C 
 15: C     Overhauled by Bernard R. Brooks   1983 
 16: C 
 17:  
 18:       use cheq,only:qcg    !##CHEQ 
 19:  
 20: ##INCLUDE '~/charmm_fcm/impnon.fcm' 
 21: ##INCLUDE '~/charmm_fcm/exfunc.fcm' 
 22: ##INCLUDE '~/charmm_fcm/number.fcm' 
 23: C 
 24:       REAL*8 X(*),Y(*),Z(*),WMAIN(*) 
 25:       INTEGER ISLCT(*),IBASE(*) 
 26:       CHARACTER*(*) TYPE(*),RESID(*),RES(*),SEGID(*) 
 27:       INTEGER NICTOT(*) 
 28:       INTEGER WX,WY,WZ,WW 
 29:       LOGICAL LCHECK,LINIT,LRSID,LAPPE,LFREE 
 30:       INTEGER COMLEN 
 31:       CHARACTER*(*) COMLYN 
 32: ##IF CHEQ 
 33: ##INCLUDE '~/charmm_fcm/dimens.fcm' 
 34:       INTEGER   ICGOLD,IVCG,ICGTMP 
 35:       LOGICAL   QCHEQRDPRM 
 36: ##ENDIF 
 37: C PJ 06/2005 
 38: ##IF PIPF 
 39: ##INCLUDE '~/charmm_fcm/pipf.fcm' 
 40:       INTEGER   IUIND,IUINDO,IVUIND, N3UIND 
 41: ##ENDIF 
 42: C 
 43: C++LNI add for reading dynamics RESTART FILE 
 44: ##INCLUDE '~/charmm_fcm/heap.fcm' 
 45: C--LNI add for reading dynamics RESTART FILE 
 46: ##INCLUDE '~/charmm_fcm/stack.fcm' 
 47: ##INCLUDE '~/charmm_fcm/stream.fcm' 
 48: ##INCLUDE '~/charmm_fcm/parallel.fcm'  ! mh050712 
 49: C 
 50:       INTEGER NATOM,IOMODE,IFILE,IOFFS,NINPUT,IMODE,NSEG 
 51:       INTEGER IUNIT,IFREEA,IRESM,LENAP,IRES,NRES,IRESC,I 
 52:       CHARACTER*(*) TITLEB(*) 
 53:       INTEGER NTITLB,ICNTRL(*),MODECW,MODEL,MODFL 
 54: C 
 55:       LOGICAL ERROR 
 56:       INTEGER OLDUSD 
 57:       CHARACTER*80 ILINE 
 58:       LOGICAL OFFICIAL 
 59: C 
 60: C++LNI add for reading dynamics RESTART FILE 
 61:       INTEGER IX1,IX2,IY1,IY2,IZ1,IZ2,IDM,JDUM,LDYNA 
 62:       REAL*8 DUM 
 63: C 
 64: C--LNI add for reading dynamics RESTART FILE 
 65:       OLDUSD=LSTUSD 
 66:       WX=ALLSTK(IREAL4(NATOM+1)) 
 67:       WY=ALLSTK(IREAL4(NATOM+1)) 
 68:       WZ=ALLSTK(IREAL4(NATOM+1)) 
 69:       WW=ALLSTK(IREAL4(NATOM+1)) 
 70:       OFFICIAL = .FALSE. 
 71:  
 72:       IF (IOMODE.LT.0) THEN 
 73: C 
 74:         IFILE=GTRMI(COMLYN,COMLEN,'IFIL',1) 
 75:         IOFFS=GTRMI(COMLYN,COMLEN,'OFFS',0) 
 76:         NINPUT=0 
 77:         IF (INDXA(COMLYN,COMLEN,'FILE').GT.0) THEN 
 78:           NINPUT=0 
 79:         ELSE IF (INDXA(COMLYN,COMLEN,'CARD').GT.0) THEN 
 80:           NINPUT=1 
 81:         ELSE IF (INDXA(COMLYN,COMLEN,'IGNO').GT.0) THEN 
 82:           NINPUT=3 
 83:         ELSE IF (INDXA(COMLYN,COMLEN,'PDB').GT.0) THEN 
 84:           NINPUT=-1 
 85:           OFFICIAL = INDXA(COMLYN,COMLEN,'OFFI').GT.0 
 86:           IF(OFFICIAL)THEN 
 87:           WRITE(OUTU,*) ' Read official pdb format.  '// 
 88:      &    'Note that the segid (chain id) must be '// 
 89:      &    'limited to one character.' 
 90:           ELSE 
 91:           WRITE(OUTU,*) ' read CHARMM-pdb format' 
 92:           ENDIF 
 93: C LNI Check if PDB NMR MODEL is to be read 
 94:           MODEL=GTRMI(COMLYN,COMLEN,'MODE',0)   
 95:         ELSE IF (INDXA(COMLYN,COMLEN,'UNIV').GT.0) THEN 
 96:           NINPUT=-2 
 97: C**clbiii add for reading lattice coordinates 
 98:         ELSE IF (INDXA(COMLYN,COMLEN,'LATT').GT.0) THEN 
 99:           NINPUT=-4 
100: CEND OF**clbiii add for reading lattice coordinates 
101: C++LNI add for reading dynamics RESTART FILE 
102:         ELSE IF (INDXA(COMLYN,COMLEN,'DYNR').GT.0) THEN 
103:           NINPUT=-5 
104: C--LNI add for reading dynamics RESTART FILE 
105:         ENDIF 
106: C++ 
107: C LN ADD /APR 90: HANDLE BINARY INPUT W/O REWINDING THE FILE ALL THE TIME 
108:         IF(NINPUT .EQ. 0) THEN 
109:           IF (reallow) THEN   !## NOREWIND 
110:           IF(INDXA(COMLYN,COMLEN,'CONT').GT.0) NINPUT=-3 
111:           ELSE                !## NOREWIND 
112:             NINPUT=-3         !## NOREWIND 
113:           ENDIF               !## NOREWIND 
114:         ENDIF 
115: C-- 
116:         LRSID=(INDXA(COMLYN,COMLEN,'RESI').GT.0) 
117:         LINIT=(INDXA(COMLYN,COMLEN,'INIT').GT.0).OR. 
118:      &        (INDXA(COMLYN,COMLEN,'REST').GT.0) 
119:         LAPPE=(INDXA(COMLYN,COMLEN,'APPE').GT.0) 
120:         LFREE=(INDXA(COMLYN,COMLEN,'FREE').GT.0) 
121: C 
122:         IMODE=0 
123:         CALL SELRPN(COMLYN,COMLEN,ISLCT,NATOM,1,IMODE, 
124:      &    .FALSE.,1,' ',0,RESID,RES,IBASE,SEGID,NICTOT,NSEG, 
125:      &    .TRUE.,X,Y,Z,.TRUE.,1,WMAIN) 
126:         IF(IMODE.NE.0)  THEN 
127: C         Begin Procedure CRAP-OUT 
128:           CALL WRNDIE(0,'<COORIO>','Atom selection parsing error') 
129:           LSTUSD=OLDUSD 
130:           RETURN 
131: C         End Procedure CRAP-OUT 
132:         ENDIF 
133: C 
134:         IF(IUNIT.LT.0 .AND. NINPUT.NE.0) IUNIT=ISTRM 
135:         IF(PRNLEV.GE.2) WRITE(OUTU,430) IUNIT 
136:   430   FORMAT(10X,'SPATIAL COORDINATES BEING READ FROM UNIT',I3) 
137:         IF(IUNIT.LT.0) THEN 
138:           CALL WRNDIE(0,'<COORIO>','INVALID UNIT NUMBER') 
139:           LSTUSD=OLDUSD 
140:           RETURN 
141:         ENDIF 
142: C 
143: C**clbiii add for reading lattice coordinates 
144:         IF( NINPUT .EQ. -4 ) THEN 
145:           if ( iomode .lt. 0 ) CALL RLATT(IUNIT,ISLCT) 
146: c          if ( iomode .eq. 0 ) CALL WLATT0 
147: c          if ( iomode .gt. 0 ) CALL PLATT0 
148:           LSTUSD = OLDUSD 
149:           return 
150:         ENDIF 
151: CEND of**clbiii add for reading lattice coordinates 
152: C++LNI add for reading dynamics RESTART FILE 
153:         IF(NINPUT .EQ. -5)THEN 
154: C Just try to keep track of what we actually need from the file 
155: C LDYNA may need to be set properly to interpret old files? 
156: C RESTART file contents depend on the integrator used. 
157: C 
158: C LDYNA=1 means we behave as if this was being read into the 
159: C leap frog integrator. 
160: C The idea is that CURR returns coordinates at CURRENT step 
161: C                  DELT returns coordinate displacement FROM CURRENT 
162: C                  VEL  returns current VELOCITIES 
163: C Note that the restart file written after a crash may be different! 
164: C 
165:           LDYNA=1 
166:           IF(INDXA(COMLYN,COMLEN,'VERL').GT.0) LDYNA=-1 
167:           IF(INDXA(COMLYN,COMLEN,'LEAP').GT.0) LDYNA=1 
168:           IX1=ALLHP(IREAL8(NATOM),'coorio.src','COORIO','IX1') 
169:           IY1=ALLHP(IREAL8(NATOM),'coorio.src','COORIO','IY1') 
170:           IZ1=ALLHP(IREAL8(NATOM),'coorio.src','COORIO','IZ1') 
171:           IX2=ALLHP(IREAL8(NATOM),'coorio.src','COORIO','IX2') 
172:           IY2=ALLHP(IREAL8(NATOM),'coorio.src','COORIO','IY2') 
173:           IZ2=ALLHP(IREAL8(NATOM),'coorio.src','COORIO','IZ2') 
174:           IDM=ALLSTK(IREAL8(NATOM)) 
175: ##IF CHEQ 
176:           ICGTMP  = ALLSTK(IREAL8(NATOM)) 
177:           ICGOLD  = ALLSTK(IREAL8(NATOM)) 
178:           IVCG    = ALLSTK(IREAL8(NATOM)) 
179: ##ENDIF 
180: C PJ 06/2005 
181: ##IF PIPF 
182:           IF (QPIPF .AND. QPFDYN) THEN 
183:              N3UIND = 3 * NATOM 
184:           ELSE 
185:              N3UIND = 3 
186:           ENDIF 
187:           IUIND  = ALLSTK(IREAL8(N3UIND)) 
188:           IUINDO = ALLSTK(IREAL8(N3UIND)) 
189:           IVUIND = ALLSTK(IREAL8(N3UIND)) 
190: ##ENDIF 
191:           IF(INDXA(COMLYN,COMLEN,'DELT').GT.0)THEN 
192:              CALL READYN(IUNIT,NATOM, 
193:      &            HEAP(IX1),HEAP(IY1),HEAP(IZ1), 
194:      &            X,Y,Z,HEAP(IX2),HEAP(IY2),HEAP(IZ2), 
195:      &            STACK(ICGTMP),STACK(ICGOLD),STACK(IVCG),QCG, !##CHEQ 
196:      &        STACK(IUIND),STACK(IUINDO),STACK(IVUIND),QPFDYN, !##PIPF 
197:      &            NPFBATHS,PFNHSBATH,PFNHSOBATH,               !##PIPF 
198:      $            .FALSE.,HEAP(IX2),HEAP(IY2),HEAP(IZ2),       !##DYNVV2 
199:      $            JDUM,JDUM, 
200:      &            JDUM,JDUM,JDUM,JDUM,DUM,DUM,JDUM,LDYNA 
201: ##IF LDM 
202:      &            ,.FALSE.                          !##LMC 
203:      &            ,.FALSE.,JDUM,STACK(IDM),STACK(IDM),STACK(IDM),JDUM 
204: ##ENDIF 
205:      &            ,STACK(IDM),STACK(IDM)            !##FOURD 
206:      -    ,.FALSE.,.FALSE.,.FALSE.,0,0,ZERO,ZERO,ZERO  !##SCCDFTB 
207:      &            ) 
208:           ELSEIF(INDXA(COMLYN,COMLEN,'CURR').GT.0)THEN 
209:              CALL READYN(IUNIT,NATOM,X,Y,Z, 
210:      &            HEAP(IX1),HEAP(IY1),HEAP(IZ1), 
211:      &            HEAP(IX2),HEAP(IY2),HEAP(IZ2), 
212:      &            STACK(ICGTMP),STACK(ICGOLD),STACK(IVCG),QCG, !##CHEQ 
213:      &        STACK(IUIND),STACK(IUINDO),STACK(IVUIND),QPFDYN, !##PIPF 
214:      &            NPFBATHS,PFNHSBATH,PFNHSOBATH,               !##PIPF 
215:      $            .FALSE.,HEAP(IX2),HEAP(IY2),HEAP(IZ2),       !##DYNVV2 
216:      $            JDUM,JDUM, 
217:      &            JDUM,JDUM,JDUM,JDUM,DUM,DUM,JDUM,LDYNA 
218: ##IF LDM 
219:      &            ,.FALSE.                          !##LMC 
220:      &            ,.FALSE.,JDUM,STACK(IDM),STACK(IDM),STACK(IDM),JDUM 
221: ##ENDIF 
222:      &            ,STACK(IDM),STACK(IDM)            !##FOURD 
223:      -    ,.FALSE.,.FALSE.,.FALSE.,0,0,ZERO,ZERO,ZERO  !##SCCDFTB 
224:      &            ) 
225:           ELSEIF(INDXA(COMLYN,COMLEN,'VEL').GT.0)THEN 
226:              CALL READYN(IUNIT,NATOM, 
227:      &            HEAP(IX1),HEAP(IY1),HEAP(IZ1), 
228:      &            HEAP(IX2),HEAP(IY2),HEAP(IZ2),X,Y,Z, 
229:      &            STACK(ICGTMP),STACK(ICGOLD),STACK(IVCG),QCG, !##CHEQ 
230:      &        STACK(IUIND),STACK(IUINDO),STACK(IVUIND),QPFDYN, !##PIPF 
231:      &            NPFBATHS,PFNHSBATH,PFNHSOBATH,               !##PIPF 
232:      $            .FALSE.,HEAP(IX2),HEAP(IY2),HEAP(IZ2),       !##DYNVV2 
233:      $            JDUM,JDUM, 
234:      &            JDUM,JDUM,JDUM,JDUM,DUM,DUM,JDUM,LDYNA 
235: ##IF LDM 
236:      &            ,.FALSE.                          !##LMC 
237:      &            ,.FALSE.,JDUM,STACK(IDM),STACK(IDM),STACK(IDM),JDUM 
238: ##ENDIF 
239:      &            ,STACK(IDM),STACK(IDM)            !##FOURD 
240:      -    ,.FALSE.,.FALSE.,.FALSE.,0,0,ZERO,ZERO,ZERO  !##SCCDFTB 
241:      &            ) 
242:           ELSE 
243:             CALL WRNDIE(0,'<COORIO>','Unknown READ COOR DYNR option') 
244:           ENDIF 
245:           LSTUSD = OLDUSD 
246:           RETURN 
247:         ENDIF 
248: C--LNI add for reading dynamics RESTART FILE 
249: C 
250:         IFREEA=ALLSTK(INTEG4(NATOM)) 
251: ##IF ENSEMBLE 
252:         IF(IUNIT.NE.ISTRM) THEN 
253: ##ELSE 
254:         IF(IOLEV.GT.0 .AND. IUNIT.NE.ISTRM) THEN 
255: ##ENDIF 
256:           IF (reallow) THEN      !## NOREWIND 
257:           IF(IFILE.EQ.1 .AND. NINPUT.NE.-3) REWIND IUNIT 
258:           ENDIF                  !## NOREWIND 
259:         ENDIF 
260: C 
261:         IRESM=0 
262:         LENAP=0 
263:         IF (LAPPE) THEN 
264:           DO IRES=1,NRES 
265:             IRESC=0 
266:             DO I=IBASE(IRES)+1,IBASE(IRES+1) 
267:               IF(INITIA(I,X,Y,Z)) IRESC=1 
268:             ENDDO 
269:             IF(IRESC.EQ.1) IRESM=IRES 
270:           ENDDO 
271:         ENDIF 
272:         IF(IRESM.GT.0) LENAP=IBASE(IRESM+1) 
273:         IF(IRESM.EQ.NRES) THEN 
274:           CALL WRNDIE(0,'<COORIO>','Cannot append to full set') 
275:           LSTUSD=OLDUSD 
276:           RETURN 
277:         ENDIF 
278: C 
279:         IOFFS=IOFFS+IRESM 
280:         IF(IOFFS.NE.0) THEN 
281:           IF (LRSID) THEN 
282:             CALL WRNDIE(0,'<COORIO>', 
283:      &        'APPEnd and OFFSet options not allowed with RESI option') 
284:             IOFFS=0 
285:           ELSE 
286:             IF(PRNLEV.GE.2) WRITE(OUTU,129) IOFFS 
287:  129        FORMAT(' A RESIDUE OFFSET OF',I4,' WILL BE USED.') 
288:           ENDIF 
289:         ENDIF 
290: C 
291:         CALL FILLI4(ISLCT,LENAP,0) 
292:         IF(LINIT) THEN 
293:           DO I=1,NATOM 
294:             IF(ISLCT(I).EQ.1) THEN 
295:               X(I)=ANUM 
296:               Y(I)=ANUM 
297:               Z(I)=ANUM 
298:             ENDIF 
299:           ENDDO 
300:         ENDIF 
301: C 
302:         IF (NINPUT.NE.-2) THEN 
303:           CALL CREAD(IUNIT,TITLEB,NTITLB,ICNTRL,X,Y,Z,WMAIN,NATOM, 
304:      &      NINPUT,ISLCT,STACK(WX),STACK(WY),STACK(WZ),STACK(WW),IOFFS, 
305:      &      RES,NRES,TYPE,IBASE,IFILE,STACK(IFREEA), 
306:      &      SEGID,RESID,NICTOT,NSEG,LRSID,LFREE,ILINE,80,MODEL,OFFICIAL) 
307:         ELSE 
308:           CALL CREADU(IUNIT,X,Y,Z,WMAIN,NATOM,ISLCT, 
309:      &      RES,NRES,TYPE,IBASE,SEGID,RESID,NICTOT,NSEG, 
310:      &      LRSID,LFREE,IOFFS) 
311:         ENDIF 
312:         IF (LCHECK) THEN 
313:           DO I=1,NATOM 
314:             IF(.NOT.INITIA(I,X,Y,Z)) THEN 
315:               CALL WRNDIE(1,'<COORIO>', 
316:      &          'The coordinates for some atoms were not read') 
317:               GOTO 30 
318:             ENDIF 
319:           ENDDO 
320:         ENDIF 
321: 30      CONTINUE 
322: C 
323: C       Write out coordinates. 
324:       ELSE 
325:         IF(IUNIT.LT.0 .AND. IOMODE.GT.0) IUNIT=OUTU 
326:         IF(IUNIT.LT.0) THEN 
327:           CALL WRNDIE(0,'<COORIO>','INVALID UNIT NUMBER') 
328:           LSTUSD=OLDUSD 
329:           RETURN 
330:         ENDIF 
331:         MODECW=1 
332:         IF(INDXA(COMLYN,COMLEN,'FILE').NE.0) MODECW=1 
333:         IF(INDXA(COMLYN,COMLEN,'CARD').NE.0) MODECW=2 
334:         IF(INDXA(COMLYN,COMLEN,'PDB').NE.0) THEN 
335:            MODECW=4 
336:            OFFICIAL = INDXA(COMLYN,COMLEN,'OFFI').GT.0 
337:            IF(OFFICIAL)THEN 
338:               WRITE(OUTU,*) ' Write official pdb format.  '// 
339:      &         'Note that the segid (chain id) will be '// 
340:      &         'truncated to only one character.' 
341:            ELSE 
342:               WRITE(OUTU,*) ' Write CHARMM-pdb format' 
343:            ENDIF 
344:         ENDIF 
345:         IF(INDXA(COMLYN,COMLEN,'DUMB').NE.0) MODECW=5 
346:         IF(IOMODE.GT.0) MODECW=3 
347:         IOFFS=GTRMI(COMLYN,COMLEN,'OFFS',0) 
348:         IMODE=0 
349: C LNI Check if NMR model is to be written to PDB file 
350:         IF(MODECW.EQ.4)THEN 
351:            MODEL=GTRMI(COMLYN,COMLEN,'MODE',0) 
352:            MODFL=0 
353: C MODFL= 0 don't force header or END line writing 
354: C        1 force header, 2 force END, 3 force both header and END 
355:            IF(INDXA(COMLYN,COMLEN,'FIRS').NE.0) MODFL=1 
356:            IF(INDXA(COMLYN,COMLEN,'LAST').NE.0) MODFL=MODFL+2 
357:         ENDIF  
358:         CALL SELRPN(COMLYN,COMLEN,ISLCT,NATOM,1,IMODE, 
359:      &    .FALSE.,1,' ',0,RESID,RES,IBASE,SEGID,NICTOT,NSEG, 
360:      &    .TRUE.,X,Y,Z,.TRUE.,1,WMAIN) 
361:         IF(IMODE.NE.0)  THEN 
362: C         Begin Procedure CRAP-OUT 
363:           CALL WRNDIE(0,'<COORIO>','Atom selection parsing error') 
364:           LSTUSD=OLDUSD 
365:           RETURN 
366: C         End Procedure CRAP-OUT 
367:         ENDIF 
368:         CALL CWRITE(IUNIT,TITLEB,NTITLB,ICNTRL,X,Y,Z,WMAIN, 
369:      &    RES,TYPE,IBASE,NRES,NATOM,ISLCT,STACK(WW),MODECW,MODEL, 
370:      &    MODFL,OFFICIAL) 
371:         IF(MODECW.LT.3) CALL VCLOSE(IUNIT,'KEEP',ERROR) 
372:       ENDIF 
373: C 
374:       LSTUSD=OLDUSD 
375:       RETURN 
376:       END 
377:  
378:       SUBROUTINE CWRITE(IUNIT,TITLE,NTITL,ICNTRL,X,Y,Z,WMAIN, 
379:      &  RES,TYPE,IBASE,NRES,NATOM,ISLCT,WW,MODE,MODEL,MODFL, 
380:      &  OFFICIAL) 
381: C----------------------------------------------------------------------- 
382: C     THIS ROUTINE WRITES COORDINATE MODULES OR CARD FILES. 
383: C 
384: C     MODE = 1 FOR BINARY MODULES 
385: C     MODE = 2 FOR CARD FILES 
386: C     MODE = 3 FOR PRINT OUT 
387: C     MODE = 4 FOR PDB FORMAT  AB/LN JAN-85 
388: C              option to write nmr-style file with multiple models added 
389: C              MODEL=0 Standard PDBfile. MODEL=1 write header and first model 
390: C              MODEL>1 write one model. MODEL=N (N<0) write MODEN |N| and END line 
391: C                  FIRST|LAST keyword forces writing of header|END. Oct-03 (c31a1). L.Nilsson 
392: C     MODE = 5 FOR DUMB CARD OUTPUT 
393: C 
394: C     Overhauled by Bernard R. Brooks   1983 
395: C 
396: ##INCLUDE '~/charmm_fcm/impnon.fcm' 
397: ##INCLUDE '~/charmm_fcm/dimens.fcm' 
398: ##INCLUDE '~/charmm_fcm/exfunc.fcm' 
399: ##INCLUDE '~/charmm_fcm/fourd.fcm' 
400: ##INCLUDE '~/charmm_fcm/stream.fcm' 
401: ##INCLUDE '~/charmm_fcm/image.fcm' 
402: ##INCLUDE '~/charmm_fcm/parallel.fcm'  ! mh050712 
403: ##INCLUDE '~/charmm_fcm/repdstr.fcm'   ! mh050712 
404:       INTEGER IUNIT,NTITL 
405:       integer*4 ntitl4 
406:       CHARACTER*(*) TITLE(*) 
407:       INTEGER ICNTRL(20) 
408:       integer*4 icntrl4(20) 
409:       REAL*8 X(*),Y(*),Z(*),WMAIN(*) 
410:       CHARACTER*(*) RES(*),TYPE(*) 
411:       INTEGER IBASE(*),ISLCT(*) 
412:       INTEGER NRES,NATOM,MODE,MODEL,MODFL 
413:       REAL    WW(*) 
414:       LOGICAL OFFICIAL 
415: C 
416:       CHARACTER*4 HDR 
417:       CHARACTER*8 SID,RID,REN,AC,ARID,ATYPE 
418:       character*60 fm2                          ! yw 
419:       INTEGER NSLCT,IRES,IPT,I,L 
420:       integer*4 nslct4 
421:       LOGICAL QCRYS 
422:       DATA HDR/'COOR'/ 
423: C 
424: ##IF FOURD (4dsetw) 
425: C     If a four-D minimization is requested then their coordinates 
426: C     are placed into WMAIN here to print in .crd file. 
427: C 
428:       IF (DIM4) THEN 
429:        DO I=1,NATOM 
430:          WMAIN(I)=FDIM(I) 
431:        ENDDO 
432:       ENDIF 
433: ##ENDIF (4dsetw) 
434: C 
435:       QCRYS=(XTLTYP.NE.'    ') 
436: C 
437: ##IFN ENSEMBLE 
438: ##IF REPDSTR 
439:       IF(.NOT.QREPDSTR) THEN 
440:          IF(IOLEV.LT.0) RETURN 
441:       ENDIF 
442: ##ELSE 
443:       IF(IOLEV.LT.0) RETURN 
444: ##ENDIF 
445: ##ENDIF 
446: C 
447:       NSLCT=0 
448:       DO I=1,NATOM 
449:         IF(ISLCT(I).EQ.1) NSLCT=NSLCT+1 
450:       ENDDO 
451:       IF(NSLCT.EQ.0) THEN 
452:         CALL WRNDIE(2,'<COORIO>', 
453:      &    'ZERO ATOMS SPECIFIED TO WRITE. NO FILE CREATED') 
454:         RETURN 
455:       ENDIF 
456:       IF(NSLCT.LT.NATOM .AND. PRNLEV.GE.3) WRITE(OUTU,127) 
457:  127  FORMAT(' NOTE: A SELECTED SUBSET OF ATOMS WILL BE USED'/) 
458: C 
459:       IF (MODE.EQ.1) THEN 
460: C       Begin Procedure WRITE-BINARY-FILE 
461:         IF(NSLCT.LT.NATOM .AND. PRNLEV.GE.2) WRITE(OUTU,135) NSLCT, 
462:      &    NATOM 
463:  135    FORMAT(/' **** INFO ***** IN CWRITE. BINARY MODULE WRITTEN ', 
464:      &    'WITH ONLY A PARTIAL SET OF ATOMS.'/,' NSLCT=',I5,' NATOM=' 
465:      &      ,I5) 
466:         DO I=1,20 
467:           ICNTRL(I)=0 
468:         ENDDO 
469:         ICNTRL(1)=1 
470:         IF(QCRYS) ICNTRL(11)=1 
471: ##IF I4BINARY 
472:         do i=1,20 
473:            icntrl4(i)=icntrl(i) 
474:         enddo 
475:         WRITE(IUNIT) HDR,ICNTRL4 
476:         CALL WRTITL(TITLE,NTITL,IUNIT,-1) 
477:         nslct4=nslct 
478:         WRITE(IUNIT) NSLCT4 
479: ##ELSE 
480:         WRITE(IUNIT) HDR,ICNTRL 
481:         CALL WRTITL(TITLE,NTITL,IUNIT,-1) 
482:         WRITE(IUNIT) NSLCT 
483: ##ENDIF 
484: C 
485:         IF(QCRYS) WRITE(IUNIT) XTLABC 
486: C 
487: C       FILL W ARRAYS BASED ON SELECTED ATOMS ONLY 
488: C 
489:         IPT=0 
490:         DO I=1,NATOM 
491:           IF(ISLCT(I).EQ.1) THEN 
492:             IPT=IPT+1 
493:             WW(IPT)=X(I) 
494:           ENDIF 
495:         ENDDO 
496:         WRITE(IUNIT) (WW(I),I=1,NSLCT) 
497: C 
498:         IPT=0 
499:         DO I=1,NATOM 
500:           IF(ISLCT(I).EQ.1) THEN 
501:             IPT=IPT+1 
502:             WW(IPT)=Y(I) 
503:           ENDIF 
504:         ENDDO 
505:         WRITE(IUNIT) (WW(I),I=1,NSLCT) 
506: C 
507:         IPT=0 
508:         DO I=1,NATOM 
509:           IF(ISLCT(I).EQ.1) THEN 
510:             IPT=IPT+1 
511:             WW(IPT)=Z(I) 
512:           ENDIF 
513:         ENDDO 
514:         WRITE(IUNIT) (WW(I),I=1,NSLCT) 
515: C 
516:         IPT=0 
517:         DO I=1,NATOM 
518:           IF(ISLCT(I).EQ.1) THEN 
519:             IPT=IPT+1 
520:             WW(IPT)=WMAIN(I) 
521:           ENDIF 
522:         ENDDO 
523:         WRITE(IUNIT) (WW(I),I=1,NSLCT) 
524: C 
525: C       End Procedure WRITE-BINARY-FILE 
526:       ELSE IF (MODE.EQ.2 .OR. MODE.EQ.3) THEN 
527:         IF(MODE.EQ.3) THEN 
528: C print to the output 
529:           WRITE(IUNIT,'(/10X,A)') 'COORDINATE FILE MODULE' 
530:           CALL WRTITL(TITLE,NTITL,IUNIT,1) 
531:         ELSEIF (MODE.EQ.2) THEN 
532: C write to the file 
533:           CALL WRTITL(TITLE,NTITL,IUNIT,0) 
534:         ENDIF 
535: C       Begin Procedure WRITE-CARD-FILE 
536: cyw++ 
537:         qextfmt=qxform() 
538:         if(qextfmt) then 
539:            write(iunit,'(i10,2x,a)') nslct,'EXT' 
540:            fm2='(2I10,2X,A8,2X,A8,3F20.10,2X,A8,2X,A8,F20.10)' 
541:         else 
542:            write(iunit,'(i5)') nslct 
543:            fm2='(2I5,1X,A4,1X,A4,3F10.5,1X,A4,1X,A4,F10.5)' 
544:         endif 
545:         DO IRES=1,NRES 
546:           DO I=IBASE(IRES)+1,IBASE(IRES+1) 
547:             IF(ISLCT(I).EQ.1) THEN 
548:               CALL ATOMID(I,SID,RID,REN,AC) 
549:               WRITE(IUNIT,fm2) 
550:      &        I,IRES,RES(IRES),TYPE(I),X(I),Y(I),Z(I),SID,RID,WMAIN(I) 
551:             ENDIF 
552:           ENDDO 
553:         ENDDO 
554: C       End Procedure WRITE-CARD-FILE 
555:       ELSE IF (MODE.EQ.4) THEN 
556: C 
557: C write PDB title 
558: C 
559:         IF(MODEL.EQ.0 .OR. MODEL .EQ.1   
560:      &     .OR. MODFL.EQ.1 .OR. MODFL.EQ.3)THEN 
561:            CALL WRTITL(TITLE,NTITL,0,2) 
562:            WRITE(IUNIT,'(A,A)') ('REMARK ',TITLE(I)(2:),I=1,NTITL) 
563:         ENDIF 
564: C       Begin Procedure WRITE-PDB-FILE 
565: C 
566: C use Brookhaven PDB format 
567: C 
568: CTOM   1223  O   GLY   153     -11.704  -9.200    .489  1.00  0.80 
569: C     ccccc ''''Iyyy O,,,,L   ........>>>>>>>>////////ppppppiiiiii iii 
570: C                         ^ insertion character 
571: C                    ^ chain identifier 
572: C           ^ additional character for some atom names (mostly h's) 
573: C 
574: C adjust resid's so that they are as close as possible to the original 
575: C PDB format 
576: C 
577:         IF(MODEL .NE. 0) WRITE(IUNIT,'(A,I9)') 'MODEL',IABS(MODEL) 
578:         DO IRES=1,NRES 
579:           DO I=IBASE(IRES)+1,IBASE(IRES+1) 
580:             IF(ISLCT(I).EQ.1) THEN 
581:               CALL ATOMID(I,SID,RID,REN,AC) 
582: C              L=4 
583: C              CALL TRIME(RID,L) 
584: C              ARID='    ' 
585: C              IF (L.EQ.4.OR.RID(L:L).GE.'A') THEN 
586: C                ARID(4-L+1:4)=RID(1:L) 
587: C              ELSE 
588: C                ARID(4-L:3)=RID(1:L) 
589: C              ENDIF 
590: C Allow 5 character RESID (4 char resSeq + 1 char insertion code) 
591:               L=5 
592:               CALL TRIME(RID,L) 
593:               ARID='    ' 
594:               IF (L.EQ.5.OR.RID(L:L).GE.'A') THEN 
595:                 ARID(5-L+1:5)=RID(1:L) 
596:               ELSE 
597:                 ARID(5-L:4)=RID(1:L) 
598:               ENDIF 
599: C shift atom names when they exceed 3 characters 
600:               IF (TYPE(I)(4:4).EQ.' ') THEN 
601:                 ATYPE=' '//TYPE(I)(1:3) 
602:               ELSE 
603:                 ATYPE=TYPE(I) 
604:               ENDIF 
605: C the SEGID is written to the last four characters of the line 
606: Cbrb..07-FEB-99 Change default occupancy from zero to one 
607: C Format correction. L. Nilsson, November 07 
608: C Previous format:  (A,I5,1X,A4,1X,A3,1X,A1,1X,A3,4X,3F8.3,6X,F6.2,6X,A4) 
609:               IF(OFFICIAL)THEN 
610:               WRITE(IUNIT, 
611:      &         '(A6,I5,1X,A4,1X,A3,1X,A1,A5,3X,3F8.3,2F6.2,6X,A4)') 
612:      &    'ATOM  ',I,ATYPE,REN,SID,ARID,X(I),Y(I),Z(I),1.0,WMAIN(I),SID 
613:               ELSE 
614:               WRITE(IUNIT, 
615:      &         '(A6,I5,1X,A4,1X,A4,1X,   A5,3X,3F8.3,2F6.2,6X,A4)') 
616:      &         'ATOM  ',I,ATYPE,REN,ARID,X(I),Y(I),Z(I),1.0,WMAIN(I) 
617:      &           ,SID 
618:               ENDIF 
619:             ENDIF 
620:           ENDDO 
621:         ENDDO 
622:         WRITE(IUNIT,'(A3,I8,6X,A4,2X,A4)') 'TER',NATOM+1,REN,ARID 
623: C write END statement for PDB file 
624:         IF(MODEL .NE. 0) WRITE(IUNIT,'(A)') 'ENDMDL' 
625:         IF(MODEL.EQ.0 .or. MODEL .LE. 0 .OR. MODFL.GE.2)  
626:      &    WRITE(IUNIT,'(A)') 'END' 
627: C       End Procedure WRITE-PDB-FILE 
628:       ELSE IF (MODE.EQ.5) THEN 
629: C       DUMB CARD OUTPUT 
630:         DO I=1,NATOM 
631:           IF(ISLCT(I).NE.0) THEN 
632:             WRITE(IUNIT,27) X(I),Y(I),Z(I) 
633:   27        FORMAT(4F12.6) 
634:           ENDIF 
635:         ENDDO 
636:       ELSE 
637:         CALL DIE 
638:       ENDIF 
639: C 
640:       RETURN 
641:       END 
642:  
643:       SUBROUTINE CREAD(IUNIT,TITLE,NTITL,ICNTRL,X,Y,Z,WMAIN,NATOM, 
644:      &  NINPUT,ISLCT,WX,WY,WZ,WW,IOFFS,RES,NRES,TYPE,IBASE, 
645:      &  IFILE,FREEAT,SEGID,RESID,NICTOT,NSEG,LRSID,LFREE,LYN,MXLEN, 
646:      &  MODEL,OFFICIAL) 
647: C----------------------------------------------------------------------- 
648: C     COORDINATE READING ROUTINES CARD READING SECTION MODIFIED TO 
649: C     MAP COORDINATES BY THE SEQUENCE NUMBER, RESIDUE TYPE, AND ATOM 
650: C     TYPE IN THE INPUT FILE, AND TO CHECK FOR SEQUENCE CONSISTENCY: 
651: C 
652: C             SEQUENCE ERRORS ARE FATAL 
653: C             MISSING COORDINATES RESULT IN WARNINGS 
654: C             MULTIPLE COORIDNATES RESULT IN WARNINGS 
655: C             UNFOUND ATOMS ARE IGNORED 
656: C            Residues out of range result in warnings 
657: C 
658: C 
659: C     MODIFIED TO INCLUDE THE DUMB CARD READING OPTION 
660: C 
661: C 
662: C     FREEAT IS USED TO STORE THE FREEAT ARRAY THAT IS READ FROM A 
663: C     DYNAMICS TRAJECTORY FILE. IT IS A WORK ARRAY ONLY. 
664: C 
665: C     A SIMPLE PDB FORMAT READ OPTION (NINPUT=-1) ADDED AB/LN JAN-85 
666: C 
667: C     Modified to allow continued reading of selected coordinate 
668: C     sets from a trajectory w/o getting the file rewound all the time. 
669: C     This case is signalled by NINPUT=-3. April 1987 /LN 
670: C 
671:  
672: C     Overhauled by Bernard R. Brooks   1983 
673: C 
674: ##INCLUDE '~/charmm_fcm/impnon.fcm' 
675: ##INCLUDE '~/charmm_fcm/dimens.fcm' 
676: ##INCLUDE '~/charmm_fcm/exfunc.fcm' 
677: ##INCLUDE '~/charmm_fcm/fourd.fcm' 
678: ##INCLUDE '~/charmm_fcm/number.fcm' 
679: ##INCLUDE '~/charmm_fcm/stack.fcm' 
680: ##INCLUDE '~/charmm_fcm/stream.fcm' 
681: ##INCLUDE '~/charmm_fcm/image.fcm' 
682: ##INCLUDE '~/charmm_fcm/parallel.fcm'  ! mh050712 
683: ##INCLUDE '~/charmm_fcm/repdstr.fcm'   ! mh050712 
684:       INTEGER IUNIT,NTITL 
685:       CHARACTER*(*) TITLE(*) 
686:       INTEGER ICNTRL(20) 
687: ##IF I4BINARY 
688:       INTEGER*4 ICNTRL4(20) 
689:       integer oldusd,itmpint4,index 
690: ##ENDIF 
691:       REAL*8 X(*),Y(*),Z(*),WMAIN(*) 
692:       INTEGER NATOM,NINPUT,IFILE 
693:       REAL   WX(*),WY(*),WZ(*),WW(*) 
694:       INTEGER IBASE(*),ISLCT(*) 
695:       INTEGER IOFFS,NRES,NSEG 
696:       CHARACTER*(*) RESID(*),SEGID(*),RES(*),TYPE(*) 
697:       CHARACTER*8   SID,RID,RESIN,ATOMIN 
698:       INTEGER FREEAT(*),NICTOT(*) 
699:       LOGICAL LRSID,LFREE 
700:       CHARACTER*(*) LYN 
701:       INTEGER MXLEN,MODEL 
702:       LOGICAL OFFICIAL 
703:  
704: C 
705:       CHARACTER*4 HDR 
706:       CHARACTER*140 PDBLIN 
707:       character*40  fmt40,fmt50 
708:       character*10  fmt10 
709:       logical lextfmt 
710:       integer ilen 
711:  
712:       INTEGER ERRCNT,NFREAT 
713:       REAL*8  XIN,YIN,ZIN,WIN 
714:       CHARACTER*20 CXIN,CYIN,CZIN,CWIN 
715:       LOGICAL EOF, QATOM 
716:       LOGICAL DYN, QBIN, QCONT, QCRYS 
717:       INTEGER SLEN, IJ 
718:       INTEGER NSLCT,IATOM,NMULT,ISRES,NRNG,NSEQM,NDESL,ISEQ,IRES,ISEG 
719:       integer*4 iatom4 
720:       INTEGER ISTP,IPOINT,NMISS,IPT,I,II 
721:       INTEGER TRANSF,MDL 
722: C 
723: ##IF ENSEMBLE 
724:       INTEGER MXFILE,FLEN 
725:       PARAMETER (MXFILE=128) 
726:       CHARACTER*(MXFILE)JUNKNM 
727:       LOGICAL QOPEN,QFORM,QWRITE,QENS 
728: ##ENDIF 
729: C 
730:       INTEGER RIFILE, NFILE 
731:       SAVE    RIFILE, NFILE, QCRYS 
732: C 
733:       EOF=.FALSE. 
734:       NSLCT=0 
735:       DO I=1,NATOM 
736:         IF(ISLCT(I).EQ.1) NSLCT=NSLCT+1 
737:       ENDDO 
738:       IF(NSLCT.EQ.0) THEN 
739:         CALL WRNDIE(1,'<COORIO>','ZERO ATOMS SPECIFIED IN SELECTION') 
740:         RETURN 
741:       ENDIF 
742:       IF(NSLCT.LT.NATOM .AND. PRNLEV.GE.2) WRITE(OUTU,127) 
743:  127  FORMAT(' INFO: A subset of total atoms will be read.'/) 
744:       ERRCNT=0 
745: C++ 
746: C LN ADD /APR 90: FLAG BINARY AND BINARY W/O REWIND 
747: C 
748:       QBIN=.FALSE. 
749:       QCONT=.FALSE. 
750:       IF(NINPUT .EQ. 0) QBIN=.TRUE. 
751:       IF(NINPUT .EQ. -3) THEN 
752:         QBIN=.TRUE. 
753:         QCONT=.TRUE. 
754:       ENDIF 
755: C 
756: ##IF ENSEMBLE 
757: C     check whether it is serial or parallel read  
758: C     for serial, root will read one file and broadcast to all 
759: C     for parallel, each node reads its own file 
760:       CALL ENSINQ('UNIT',JUNKNM,MXFILE,FLEN,QOPEN, 
761:      1    QFORM,QWRITE,QENS,IUNIT) 
762:       IF(IOLEV.GT.0) THEN 
763:         IF (QENS) THEN 
764:             WRITE(OUTU,*) ' CREAD>  READING SEPARATE COORDINATES' 
765:         ELSE 
766:             WRITE(OUTU,*) ' CREAD>  READING SINGLE COORDINATE SET' 
767:         ENDIF 
768:       ENDIF 
769:       IF(QENS.OR.(IOLEV.GT.0)) THEN 
770: ##ELSE 
771: ##IF REPDSTR 
772:       IF((QREPDSTR.AND.MYNOD.EQ.0).OR.(IOLEV.GT.0)) THEN 
773: ##ELSE 
774:       IF(IOLEV.GT.0) THEN 
775: ##ENDIF 
776: ##ENDIF 
777: C 
778:         IF( QBIN ) THEN 
779: C 
780: C     READ COORDINATES FROM A COORDINATE FILE MODULE 
781: C     OR THE 'IFILE' COORDINATE SET FROM A DYNAMICS 'CORD' FILE 
782: C 
783:           IF (IFILE.LT.0) THEN 
784:             IATOM=NATOM 
785:             IF(QCRYS) READ(IUNIT) XTLABC 
786:             READ(IUNIT) (WX(I),I=1,IATOM) 
787:             READ(IUNIT) (WY(I),I=1,IATOM) 
788:             READ(IUNIT) (WZ(I),I=1,IATOM) 
789:             DO I=1,IATOM 
790:               WW(I)=0.0 
791:             ENDDO 
792:             GOTO 138 
793:           ENDIF 
794:           IF( .NOT. QCONT) THEN 
795: C 
796:             CALL TRYORO(IUNIT,'UNFORMATTED') 
797: ##IF I4BINARY 
798:             READ(IUNIT) HDR,ICNTRL4 
799:             do i=1,20 
800:                icntrl(i)=icntrl4(i) 
801:             enddo 
802: ##ELSE 
803:             READ(IUNIT) HDR,ICNTRL 
804: ##ENDIF 
805:             IF (HDR.EQ.'COOR') THEN 
806:               DYN=.FALSE. 
807:             ELSE IF (HDR.EQ.'CORD') THEN 
808:               DYN=.TRUE. 
809:             ELSE IF (HDR.EQ.'VELD') THEN 
810:               DYN=.TRUE. 
811:             ELSE 
812:               DYN=.FALSE. 
813:               CALL WRNDIE(-1,'<CREAD>','HEADERS DONT MATCH') 
814:             ENDIF 
815:             CALL RDTITL(TITLE,NTITL,IUNIT,-1) 
816:             CALL WRTITL(TITLE,NTITL,OUTU,1) 
817: ##IF I4BINARY 
818:             READ(IUNIT) IATOM4 
819:             iatom=iatom4 
820: ##ELSE 
821:             READ(IUNIT) IATOM 
822: ##ENDIF 
823:             NFREAT=IATOM-ICNTRL(9) 
824:             QCRYS=(ICNTRL(11).EQ.1) 
825:             IF(IATOM.NE.NSLCT) THEN 
826:               IF(WRNLEV.GE.2) WRITE(OUTU,135) IATOM,NSLCT 
827:  135  FORMAT(/' ** WARNING ** Number of atoms in binary', 
828:      &        ' file does not match the number of selected atoms.'/, 
829:      &        ' IATOM=',I5,' NSLCT=',I5) 
830:               CALL DIEWRN(0) 
831:             ENDIF 
832:             IF(IATOM.GT.NATOM) IATOM=NATOM 
833:             IF(NFREAT.GT.NATOM) NFREAT=NATOM 
834:           ENDIF 
835:           IF (.NOT. DYN) THEN 
836:             IF(QCRYS) READ(IUNIT) XTLABC 
837:             READ(IUNIT) (WX(I),I=1,IATOM) 
838:             READ(IUNIT) (WY(I),I=1,IATOM) 
839:             READ(IUNIT) (WZ(I),I=1,IATOM) 
840:             READ(IUNIT,ERR=137,END=137) (WW(I),I=1,IATOM) 
841:             GOTO 136 
842:  137        CONTINUE 
843:             DO I=1,IATOM 
844:               WW(I)=0.0 
845:             ENDDO 
846:  136        CONTINUE 
847:           ELSE 
848:             IF (QCONT) THEN 
849: C 
850: C This option does not work when there are fixed atoms 
851: C 
852:               IF(NFREAT .NE. IATOM) THEN 
853:                 CALL WRNDIE(0,'<CREAD>', 
854:      &            'Cannot CONTinue reading trajectory w/ fixed atoms') 
855:                 GOTO 900 
856:               ENDIF 
857:               IF (IFILE .LT. 1) IFILE = 1 
858:               NFILE=NFILE+IFILE 
859:               IF(NFILE .GT. RIFILE) THEN 
860:                 IF(WRNLEV.GE.2) WRITE(OUTU,1000) RIFILE,IFILE 
861:                 CALL DIEWRN(1) 
862:                 NFILE=NFILE-IFILE 
863:                 IFILE=RIFILE-NFILE 
864:                 NFILE=RIFILE 
865:               ENDIF 
866:               IF(PRNLEV.GE.2) WRITE (OUTU,200) NFILE 
867: C 
868: C ln MOD TO GET THIS TO WORK ON MACHINES W/O RECORD CONCEPT: 
869: C 
870:               DO I=2,IFILE 
871:                 IF(QCRYS) READ(IUNIT) 
872:                 READ(IUNIT) 
873:                 READ(IUNIT) 
874:                 READ(IUNIT) 
875:               ENDDO 
876:               IF(QCRYS) READ(IUNIT) XTLABC 
877:               READ(IUNIT) (WX(I),I=1,IATOM) 
878:               READ(IUNIT) (WY(I),I=1,IATOM) 
879:               READ(IUNIT) (WZ(I),I=1,IATOM) 
880:               DO I=1,IATOM 
881:                 WW(I)=0.0 
882:               ENDDO 
883:             ELSE 
884:               RIFILE=ICNTRL(1) 
885:               IF(RIFILE.LT.IFILE) THEN 
886:                 IF(WRNLEV.GE.2) WRITE(OUTU,1000) RIFILE,IFILE 
887:  1000 FORMAT(/' ** WARNING ** IFILE is too big,  File has ',i9, 
888:      2       '  IFILE = ',I9/' IFILE will be set to last set on file.') 
889:                 CALL DIEWRN(1) 
890:                 IFILE=RIFILE 
891:               ENDIF 
892:               IF(IFILE.LT.1) IFILE=1 
893:               NFILE=IFILE 
894:               IF(PRNLEV.GE.2) WRITE(OUTU,200) IFILE 
895:   200         FORMAT(' Reading from coordinate trajectory, IFILE = ',I9) 
896:               IF (NFREAT.EQ.IATOM) THEN 
897:                 DO I=2,IFILE 
898:                   IF(QCRYS) READ(IUNIT) 
899:                   READ(IUNIT) 
900:                   READ(IUNIT) 
901:                   READ(IUNIT) 
902:                 ENDDO 
903:                 IF(QCRYS) READ(IUNIT) XTLABC 
904:                 READ(IUNIT) (WX(I),I=1,IATOM) 
905:                 READ(IUNIT) (WY(I),I=1,IATOM) 
906:                 READ(IUNIT) (WZ(I),I=1,IATOM) 
907:                 DO I=1,IATOM 
908:                   WW(I)=0.0 
909:                 ENDDO 
910:               ELSE 
911: ##IF I4BINARY 
912:                  oldusd=lstusd 
913:                  itmpint4=allstk(nfreat) 
914:                  call readint4(iunit,stack(itmpint4),nfreat) 
915:                  index=1 
916:                  call extractint4(freeat,stack(itmpint4),index,nfreat) 
917:                  lstusd=oldusd 
918: ##ELSE 
919:                 READ(IUNIT) (FREEAT(I),I=1,NFREAT) 
920: ##ENDIF 
921:                 IF(QCRYS) READ(IUNIT) XTLABC 
922:                 READ(IUNIT) (WX(I),I=1,IATOM) 
923:                 READ(IUNIT) (WY(I),I=1,IATOM) 
924:                 READ(IUNIT) (WZ(I),I=1,IATOM) 
925:                 DO I=1,IATOM 
926:                   WW(I)=1.0 
927:                 ENDDO 
928:                 IF (IFILE.GT.1) THEN 
929:                   DO I=1,NFREAT 
930:                     IF(FREEAT(I).GT.NATOM) FREEAT(I)=NATOM+1 
931:                   ENDDO 
932:                   DO I=3,IFILE 
933:                     IF(QCRYS) READ(IUNIT) 
934:                     READ(IUNIT) 
935:                     READ(IUNIT) 
936:                     READ(IUNIT) 
937:                   ENDDO 
938:                   IF(QCRYS) READ(IUNIT) XTLABC 
939:                   READ(IUNIT) (WX(FREEAT(I)),I=1,NFREAT) 
940:                   READ(IUNIT) (WY(FREEAT(I)),I=1,NFREAT) 
941:                   READ(IUNIT) (WZ(FREEAT(I)),I=1,NFREAT) 
942:                 ENDIF 
943:               ENDIF 
944:             ENDIF 
945:           ENDIF 
946:  138      CONTINUE 
947:           IPT=0 
948:           NMULT=0 
949:           DO I=1,NATOM 
950:             IF(ISLCT(I).EQ.1 .AND. IPT.LT.IATOM) THEN 
951:               IPT=IPT+1 
952:               IF (INITIA(I,X,Y,Z)) NMULT=NMULT+1 
953:               X(I)=WX(IPT) 
954:               Y(I)=WY(IPT) 
955:               Z(I)=WZ(IPT) 
956:               WMAIN(I)=WW(IPT) 
957: ##IF FOURD (4dread) 
958:               IF (DIM4) THEN 
959:                 FDIM(I)=WW(IPT) 
960:                 WMAIN(I)=0.0 
961:               ENDIF 
962: ##ENDIF (4dread) 
963:             ENDIF 
964:           ENDDO 
965:           IF (NMULT.GT.0 .AND. WRNLEV.GE.2) WRITE(OUTU,55) NMULT 
966:           GOTO 900 
967:         ENDIF 
968: C 
969:         CALL TRYORO(IUNIT,'FORMATTED') 
970:         IF(NINPUT.GT.1) GOTO 90 
971: C 
972: C READ COORDINATES FROM CARDS 
973: C 
974: C CHARMM FORMAT OR PDB FORMAT 
975: C NINPUT=-1 MEANS PDB FORMAT. 
976: C 
977:         IF (NINPUT.EQ.-1) THEN 
978: C 
979: C read PDB title 
980: C 
981:           NTITL=0 
982: 99963     CONTINUE 
983:           READ(IUNIT,'(A)',END=61,ERR=61) PDBLIN 
984: Cln...05-Jan-95, convert the string to upper case 
985:           SLEN=LEN(PDBLIN) 
986:           CALL CNVTUC(PDBLIN,SLEN) 
987: Cln...(1) 
988:           IF (PDBLIN(1:6).EQ.'REMARK') THEN 
989:             NTITL=NTITL+1 
990:             TITLE(NTITL)=PDBLIN(8:80) 
991:             GOTO 99963 
992:           ENDIF 
993:           CALL WRTITL(TITLE,NTITL,OUTU,+1) 
994: C LNI look for NMR MODEL  
995:           IF(MODEL.GT.0)THEN 
996: 700          CONTINUE 
997:              IF(PDBLIN(1:5).EQ. 'MODEL') THEN 
998:                 READ(PDBLIN(6:14),'(I9)') MDL 
999:                 IF(MDL.EQ.MODEL)THEN 
1000:                    IF(PRNLEV.GE.2) WRITE(OUTU,'(/A,I8/)')  
1001:      &                'Found model #',MODEL 
1002:                    GOTO 702 
1003:                 ELSE      
1004:                    READ(IUNIT,'(A)',END=61,ERR=61) PDBLIN 
1005:                    SLEN=LEN(PDBLIN) 
1006:                    CALL CNVTUC(PDBLIN,SLEN) 
1007:                    GOTO 700 
1008:                 ENDIF 
1009:              ELSE 
1010:                READ(IUNIT,'(A)',END=61,ERR=61) PDBLIN 
1011:                SLEN=LEN(PDBLIN) 
1012:                CALL CNVTUC(PDBLIN,SLEN) 
1013:                GOTO 700 
1014:              ENDIF      
1015:           ENDIF 
1016: 702       CONTINUE 
1017:         ELSE 
1018:           QRDQTT = .FALSE.                                  !##REPDSTR 
1019:           IF(QREPDSTR)QRDQTT = .TRUE.                       !##REPDSTR 
1020:           CALL RDTITL(TITLE,NTITL,IUNIT,0) 
1021:           QRDQTT = .FALSE.                                  !##REPDSTR 
1022:         ENDIF 
1023: C 
1024:         lextfmt=.false. 
1025:         IF (NINPUT .LT. 0) THEN 
1026:           IATOM=0 
1027:         ELSE 
1028: cyw++ 28-Jan-2003 use PDBLIN to process a line 
1029: cyw       READ(IUNIT,30) IATOM 
1030:           read(iunit,'(a)') pdblin 
1031:           slen=len(pdblin) 
1032:           call cnvtuc(pdblin,slen) 
1033:           iatom=nexti(pdblin,slen) 
1034:           lextfmt=indxa(pdblin,slen,'EXT').gt.0 
1035:           if (iatom.ge.100000) lextfmt=.true. 
1036: cyw-- 
1037:         ENDIF 
1038:         IF(IATOM.EQ.0) THEN 
1039:           IATOM=99999999 
1040:           IF (NINPUT.NE.-1 .AND. WRNLEV.GE.2) WRITE(OUTU,32) 
1041:         ENDIF 
1042:  32     FORMAT(' ** No atom count specified in card file.', 
1043:      $       ' Will read atoms until EOF is reached. **') 
1044:  
1045:         if (lextfmt) then 
1046:            fmt40='(2I10,2(2X,A8),3A20,2X,A8,2X,A8,A20)' 
1047:            fmt10='(F20.10)' 
1048:            ilen=8 
1049:         else 
1050:            fmt40='(2I5,2(1X,A4),3A10,1X,A4,1X,A4,A10)' 
1051:            fmt10='(F10.5)' 
1052:            ilen=4 
1053:         endif 
1054:  
1055:         ISRES=IOFFS+1 
1056: C 
1057:         NRNG=0 
1058:         NSEQM=0 
1059:         NMULT=0 
1060:         NDESL=0 
1061:         DO 60  I=1,IATOM 
1062: C 
1063:           IF (LFREE) THEN 
1064: C 
1065: C FREE FIELD INPUT 
1066: C 
1067:             CALL RDCMND(LYN,MXLEN,SLEN,IUNIT,EOF,.FALSE.,.FALSE.,' ') 
1068:             ISEQ=0 
1069:             IRES=0 
1070:             RESIN='    ' 
1071:             ATOMIN='    ' 
1072:             XIN=0.0 
1073:             YIN=0.0 
1074:             ZIN=0.0 
1075:             SID='    ' 
1076:             RID='    ' 
1077:             WIN=0.0 
1078:             CALL TRIME(LYN,SLEN) 
1079:             IF(SLEN.GT.0) ISEQ=NEXTI(LYN,SLEN) 
1080:             CALL TRIME(LYN,SLEN) 
1081:             IF(SLEN.GT.0) IRES=NEXTI(LYN,SLEN) 
1082:             CALL TRIME(LYN,SLEN) 
1083:             IF(SLEN.GT.0) RESIN=NEXTA8(LYN,SLEN) 
1084:             CALL TRIME(LYN,SLEN) 
1085:             IF(SLEN.GT.0) ATOMIN=NEXTA8(LYN,SLEN) 
1086:             CALL TRIME(LYN,SLEN) 
1087:             IF(SLEN.GT.0) XIN=NEXTF(LYN,SLEN) 
1088:             CALL TRIME(LYN,SLEN) 
1089:             IF(SLEN.GT.0) YIN=NEXTF(LYN,SLEN) 
1090:             CALL TRIME(LYN,SLEN) 
1091:             IF(SLEN.GT.0) ZIN=NEXTF(LYN,SLEN) 
1092:             CALL TRIME(LYN,SLEN) 
1093:             IF(SLEN.GT.0) SID=NEXTA8(LYN,SLEN) 
1094:             CALL TRIME(LYN,SLEN) 
1095:             IF(SLEN.GT.0) RID=NEXTA8(LYN,SLEN) 
1096:             CALL TRIME(LYN,SLEN) 
1097:             IF(SLEN.GT.0) WIN=NEXTF(LYN,SLEN) 
1098:             CALL TRIME(LYN,SLEN) 
1099:             IF(SLEN.GT.0) CALL XTRANE(LYN,SLEN,'CREAD') 
1100:           ELSE 
1101: C 
1102: C FIXED FIELD INPUT 
1103: C 
1104:             IF (NINPUT .LT. 0) THEN 
1105: C 
1106: C PDB format 
1107: C 
1108:               QATOM=.FALSE. 
1109:               IF (PDBLIN(1:3).EQ.'END') THEN 
1110:                 GOTO 61 
1111:               ELSE IF (PDBLIN(1:4).EQ.'ATOM') THEN 
1112:                 QATOM=.TRUE. 
1113:               ELSE IF (PDBLIN(1:4).EQ.'HETA') THEN 
1114:                 QATOM=.TRUE. 
1115:               ELSE 
1116: C 
1117: C keep reading until reaching ATOM or END 
1118: C 
1119: 99962           CONTINUE 
1120:                 READ(IUNIT,'(A)',END=61,ERR=61) PDBLIN 
1121: Cln...05-Jan-95, convert the string to upper case 
1122:                 SLEN=LEN(PDBLIN) 
1123:                 CALL CNVTUC(PDBLIN,SLEN) 
1124: Cln...(2) 
1125:                 QATOM=(PDBLIN(1:4).EQ.'ATOM'.OR.PDBLIN(1:4).EQ.'HETA') 
1126:                 IF (PDBLIN(1:3).EQ.'END') GOTO 61 
1127:                 IF (.NOT.QATOM) GOTO 99962 
1128:               ENDIF 
1129:               IF (QATOM) THEN 
1130: C 
1131: C               process ATOM line 
1132:                IF (OFFICIAL) THEN 
1133: c Read with the official PDB format : 
1134: c ATOM      2  CA  GLN A  12      50.249   6.624   3.918  1.00151.29 
1135: C Format correction, and allow insertion code. L.Nilsson, November 07 
1136: C Previous format:   
1137: C               (6X,I5,1X,A4,1X,A3,1X,A1,1X,A3,4X,3F8.3,6X,F6.2,6X,A4) 
1138: C 
1139:                READ(PDBLIN, 
1140:      &         '(6X,I5,1X,A4,1X,A3,1X,A1,A5,3X,3F8.3,6X,F6.2,6X,A4)') 
1141:      &           ISEQ,ATOMIN,RESIN,SID,RID,XIN,YIN,ZIN,WIN 
1142:                ELSE 
1143: c The CHARMM PDB format is: 
1144: c ATOM     69  HA  THR     5      10.000   0.000   0.000  1.00  0.00      A 
1145: C 
1146:                 READ(PDBLIN, 
1147:      &          '(6X,I5,1X,A4,1X,A4,1X,A5,3X,3F8.3,6X,F6.2,6X,A4)') 
1148:      &               ISEQ,ATOMIN,RESIN,RID,XIN,YIN,ZIN,WIN,SID 
1149:  
1150:                 ENDIF 
1151: C 
1152: C make ATOMIN left-justified 
1153: C 
1154:                 IJ=8 
1155:                 CALL TRIMA(ATOMIN,IJ) 
1156: C 
1157: C make RESIN left-justified 
1158: C 
1159:                 IJ=8 
1160:                 CALL TRIMA(RESIN,IJ) 
1161: C 
1162: C make RID left-justified 
1163: C 
1164:                 IF(.NOT.LRSID) THEN 
1165:                   IRES=-99999999 
1166:                   READ(RID(1:4),'(I4)',ERR=37) IRES 
1167:   37              CONTINUE 
1168:                 ENDIF 
1169:                 IJ=5 
1170:                 CALL TRIMA(RID,IJ) 
1171: C 
1172: C read next PDB line 
1173: C 
1174:                 READ(IUNIT,'(A)',ERR=61,END=61) PDBLIN 
1175: Cln...05-Jan-95, convert the string to upper case 
1176:                 SLEN=LEN(PDBLIN) 
1177:                 CALL CNVTUC(PDBLIN,SLEN) 
1178: Cln...(3) 
1179:               ENDIF 
1180:             ELSE 
1181: Cln...05-Jan-95, convert the string to upper case 
1182:               READ(IUNIT,'(A)',ERR=61,END=61) PDBLIN 
1183:               SLEN=LEN(PDBLIN) 
1184:               CALL CNVTUC(PDBLIN,SLEN) 
1185:               READ(PDBLIN,fmt40) ISEQ,IRES,RESIN,ATOMIN, 
1186:      &                           CXIN,CYIN,CZIN,SID,RID,CWIN 
1187:             ENDIF 
1188:           ENDIF 
1189: C 
1190: CCC       IF(LRSID.OR.NINPUT.EQ.-1) THEN 
1191: CCC - brb -- reinstate LRES option for PDB (change was not in io.doc) 
1192:           IF(LRSID) THEN 
1193: C           GET ATOM FROM RESID AND SEGID FIELDS 
1194:             ISEG=1 
1195: 99961       IF (SEGID(ISEG).NE.SID) THEN 
1196:               ISEG=ISEG+1 
1197:               IF(ISEG.GT.NSEG) GOTO 888 
1198:               GOTO 99961 
1199:             ENDIF 
1200:             IRES=NICTOT(ISEG)+1 
1201:             ISTP=NICTOT(ISEG+1) 
1202:             IF(IRES.GT.ISTP) GOTO 888 
1203: 99960       IF (RESID(IRES).NE.RID) THEN 
1204:               IRES=IRES+1 
1205:               IF(IRES.GT.ISTP) GOTO 888 
1206:               GOTO 99960 
1207:             ENDIF 
1208:             GOTO 889 
1209:  888        IRES=-99999999 
1210:           ENDIF 
1211: C 
1212:           IRES=IRES+ISRES-1 
1213:  889      CONTINUE 
1214: C 
1215: C     CHECK THE INPUT TO SEE THAT: 
1216: C 
1217: C             THE SEQUENCE MATCHES THE PSF 
1218: C             THE ATOM TYPE IS LOCATED PROPERLY 
1219: C             NO COORDINATES ARE MULTIPLY DEFINED 
1220: C             THAT THE COORDINATES ARE WITHIN THE DESIRED INTERVAL 
1221: C 
1222:           IF (IRES.LT.1.OR.IRES.GT.NRES) THEN 
1223:             NRNG=NRNG+1 
1224:             IF (NRNG.LT.5) THEN 
1225:               IF (LRSID.OR.NINPUT.EQ.-1) THEN 
1226:                 IF(WRNLEV.GE.2) WRITE(OUTU,82) SID(1:ilen), 
1227:      $                RID(1:ilen),RESIN(1:ilen),ATOMIN(1:ilen) 
1228:   82               FORMAT(/' ** WARNING ** For atom in coordinate file,' 
1229:      &                    ,' could not find residue in PSF,', 
1230:      &                    ' and is thus ignored:',/ 
1231:      &                    /'  SEGID=',A,' RESID=',A,' RESNAME= ',A, 
1232:      &                    ' TYPE= ',A) 
1233:               ELSE 
1234:                 IF(WRNLEV.GE.2) WRITE(OUTU,83) IRES, 
1235:      $                RESIN(1:ilen),ATOMIN(1:ilen) 
1236:   83               FORMAT(/' ** WARNING ** For atom in coordinate file,' 
1237:      &                    ,' the residue number is out of range,', 
1238:      &                    ' and is thus ignored:',/ 
1239:      &                    /'  IRES=',I5,' RESNAME= ',A,' TYPE= ',A) 
1240:               ENDIF 
1241:               CALL DIEWRN(1) 
1242:             ENDIF 
1243:           ELSE 
1244:             IF(RES(IRES).NE.RESIN) THEN 
1245:               NSEQM=NSEQM+1 
1246:               IF(NSEQM.LE.5) THEN 
1247:                 IF(WRNLEV.GE.2) WRITE(OUTU,85) IRES, 
1248:      $                RES(IRES)(1:ilen),RESIN(1:ilen) 
1249:   85               FORMAT(/' ** WARNING ** For atom in coordinate file,' 
1250:      &                    ,' the residue type does not match', 
1251:      &                    ' that (RESN) in the PSF:', 
1252:      &                    I5,' PSF= ',A,' INPUT= ',A) 
1253:               ENDIF 
1254:             ENDIF 
1255:             IPOINT=MATOM(IRES,ATOMIN,TYPE,IBASE,IRES,IRES,.FALSE.) 
1256:             IF (IPOINT.LT.0) THEN 
1257:               ERRCNT=ERRCNT+1 
1258:               IF (ERRCNT.LT.20) THEN 
1259:                 IF(WRNLEV.GE.2) WRITE(OUTU,45) ISEQ,IRES, 
1260:      $                RESID(IRES)(1:ilen),RESIN(1:ilen),ATOMIN(1:ilen) 
1261:   45     FORMAT(/' ** WARNING ** For atom in coordinate file, the', 
1262:      &   ' corresponding residue in the PSF lacks that atom:',/ 
1263:      &   ' INDEX=',I5,' IRES=',I5,' RESID=',A,' RES=',A,' ATOM=',A) 
1264:               ENDIF 
1265:             ELSE IF (IPOINT.LT.1.OR.IPOINT.GT.NATOM) THEN 
1266:               NRNG=NRNG+1 
1267:               IF(NRNG.LE.5 .AND. WRNLEV.GE.2) WRITE(OUTU,50) 
1268:      &          ISEQ,IRES,RESIN(1:ilen),ATOMIN(1:ilen),IPOINT 
1269:   50  FORMAT(/' ** WARNING ** For atom in coordinate file, the', 
1270:      &       ' corresponding atom is out of range, and thus ignored:',/ 
1271:      & '  ISEQ=',I6,' IRES=',I6,' RESIN=',A,' ATOMIN=',A,' INDEX=',I6) 
1272:             ELSE IF (ISLCT(IPOINT).EQ.1) THEN 
1273:               IF (INITIA(IPOINT,X,Y,Z)) NMULT=NMULT+1 
1274:               IF (LFREE .OR. NINPUT.LT.0) THEN 
1275:                 X(IPOINT)=XIN 
1276:                 Y(IPOINT)=YIN 
1277:                 Z(IPOINT)=ZIN 
1278:                 WMAIN(IPOINT)=WIN 
1279: ##IF FOURD (4dread) 
1280:                 IF (DIM4) THEN 
1281:                   FDIM(IPOINT)=WIN 
1282:                   WMAIN(IPOINT)=0.0 
1283:                 ENDIF 
1284: ##ENDIF (4dread) 
1285:               ELSE 
1286:                 READ(CXIN,fmt10,ERR=58) X(IPOINT) 
1287:                 READ(CYIN,fmt10,ERR=58) Y(IPOINT) 
1288:                 READ(CZIN,fmt10,ERR=58) Z(IPOINT) 
1289:                 READ(CWIN,fmt10,ERR=58) WMAIN(IPOINT) 
1290:                 GOTO 59 
1291:    58           CONTINUE 
1292:                   CALL WRNDIE(1,'<CREAD>', 
1293:      &              'Bad characters in coordinate field: Initialized') 
1294:                   X(IPOINT)=ANUM 
1295:                   Y(IPOINT)=ANUM 
1296:                   Z(IPOINT)=ANUM 
1297:                   WMAIN(IPOINT)=ZERO 
1298:    59           CONTINUE 
1299: ##IF FOURD (4dread) 
1300:                 IF (DIM4) THEN 
1301:                   FDIM(IPOINT)=WMAIN(IPOINT) 
1302:                   WMAIN(IPOINT)=0.0 
1303:                 ENDIF 
1304: ##ENDIF (4dread) 
1305:               ENDIF 
1306:             ELSE 
1307:               NDESL=NDESL+1 
1308:             ENDIF 
1309:           ENDIF 
1310:    60   CONTINUE 
1311: C 
1312:         GOTO 63 
1313:   61    I=I-1 
1314:         IF(IATOM.NE.99999999 .AND. WRNLEV.GE.2) 
1315:      $       WRITE(OUTU,62) I,IATOM 
1316:   62   FORMAT(' ** WARNING ** Error or EOF on input file.', 
1317:      $       I10,' coordinates read.',I10,' expected.') 
1318:   63    CONTINUE 
1319: C 
1320: C     CHECK TO SEE THAT ALL THE DESIRED COORDINATES WERE FOUND 
1321: C 
1322:         IRES=1 
1323:         NMISS=0 
1324:         DO I=1,NATOM 
1325:           IF (I.GT.IBASE(IRES+1)) IRES=IRES+1 
1326:           IF(ISLCT(I).EQ.1) THEN 
1327:             IF (INITIA(I,X,Y,Z)) GOTO 70 
1328:             NMISS=NMISS+1 
1329:             IF (NMISS.GT.10) GOTO 70 
1330:             IF(WRNLEV.GE.2) WRITE(OUTU,65) I,IRES, 
1331:      $           RES(IRES)(1:ilen),TYPE(I)(1:ilen) 
1332:    65       FORMAT( 
1333:      &        ' ** WARNING ** After reading, there are no coordinates', 
1334:      &         ' for selected atom:',2I6,2(1X,A)) 
1335:    70       CONTINUE 
1336:           ENDIF 
1337:         ENDDO 
1338:         IF(NMISS.GT.0 .AND. WRNLEV.GE.2) WRITE(OUTU,74) NMISS 
1339:    74 FORMAT(/' ** A total of',I6,' selected atoms have no coordinates') 
1340:       IF (ERRCNT.GT.5 .AND. WRNLEV.GE.2) WRITE(OUTU,75) ERRCNT 
1341:    75 FORMAT(/' ** A total of',I5,' warnings were encountered during', 
1342:      &        ' coordinate reading **') 
1343:       IF (NMULT.GT.0 .AND. WRNLEV.GE.2) WRITE(OUTU,55) NMULT 
1344:    55 FORMAT(/' ** WARNING ** Coordinates were overwritten for',i6, 
1345:      &        ' atoms.') 
1346:       IF(NDESL.GT.0 .AND. WRNLEV.GE.2) WRITE(OUTU,77) NDESL 
1347:   77  FORMAT(/' ** MESSAGE **',I6,' atoms in coordinate file were', 
1348:      &        ' ignored because of the specified atom selection.') 
1349:       IF (NRNG.GT.0 .AND. WRNLEV.GE.2) WRITE(OUTU,78) NRNG 
1350:   78  FORMAT(/' ** MESSAGE **',I6,' atoms in coordinate file', 
1351:      &  ' were outside the specified sequence range.') 
1352:         IF(NMISS+ERRCNT+NMULT.GT.0) CALL DIEWRN(2) 
1353:         IF (NSEQM.GT.0 .AND. WRNLEV.GE.2) THEN 
1354:           WRITE(OUTU,79) NSEQM 
1355:   79  FORMAT(/' ** WARNING **',I6,' atoms in coordinates file had a', 
1356:      &        ' sequence mismatch.') 
1357:           CALL DIEWRN(0) 
1358:         ENDIF 
1359:         GOTO 900 
1360: C 
1361: C 
1362:   90    CONTINUE 
1363: C 
1364: C       READ CARDS IGNORING ATOM NAMES AND SEQUENCE INFO 
1365: C 
1366:         IF(LFREE) CALL WRNDIE(0,'<CREAD> ', 
1367:      &           'Cannot use both FREE and IGNOre options') 
1368: C 
1369:         CALL RDTITL(TITLE,NTITL,IUNIT,0) 
1370: cyw++ 28-Jan-2003 use PDBLIN to process a line 
1371: cyw       READ(IUNIT,'(I5)') IATOM 
1372:           read(iunit,'(a)') pdblin 
1373:           slen=len(pdblin) 
1374:           call cnvtuc(pdblin,slen) 
1375:           iatom=nexti(pdblin,slen) 
1376:           lextfmt=indxa(pdblin,slen,'EXT').gt.0 
1377:           if (iatom.ge.100000) lextfmt=.true. 
1378:           if (lextfmt) then 
1379:              fmt50='(40X,3F20.10,20X,F20.10)' 
1380:           else 
1381:              fmt50='(20X,3F10.5,10X,F10.5)' 
1382:           endif 
1383: cyw-- 
1384:         IF(IATOM.EQ.0) THEN 
1385:           IATOM=99999999 
1386:           IF(WRNLEV.GE.2) WRITE(OUTU,32) 
1387:         ENDIF 
1388:         IPT=0 
1389:         DO 180 I=1,NATOM 
1390:           IF(ISLCT(I).EQ.1 .AND. IPT.LT.IATOM) THEN 
1391:             IPT=IPT+1 
1392:             READ(IUNIT,fmt50,ERR=184,END=184) 
1393:      &               X(I),Y(I),Z(I),WMAIN(I) 
1394:           ENDIF 
1395:   180   CONTINUE 
1396:         GOTO 900 
1397: C 
1398:   184   IPT=IPT-1 
1399:         IF(IATOM.NE.99999999) WRITE(OUTU,62) IPT,IATOM 
1400: C 
1401: C 
1402:  900    CONTINUE 
1403: C       Done reading coordinates. 
1404:       ENDIF 
1405: C 
1406: ##IF PARALLEL 
1407:       CALL PSND8(X, NATOM) 
1408:       CALL PSND8(Y, NATOM) 
1409:       CALL PSND8(Z, NATOM) 
1410:       CALL PSND8(WMAIN, NATOM) 
1411:       CALL PSND4(QCRYS,1) 
1412:       CALL PSND8(XTLABC,6) 
1413: ##ENDIF 
1414: ##IF ENSEMBLE 
1415:       IF (.NOT.QENS) THEN 
1416:         CALL PSND8(X, NATOM) 
1417:         CALL PSND8(Y, NATOM) 
1418:         CALL PSND8(Z, NATOM) 
1419:         CALL PSND8(WMAIN, NATOM) 
1420:         CALL PSND4(QCRYS,1) 
1421:         CALL PSND8(XTLABC,6) 
1422:       ENDIF 
1423: ##ENDIF 
1424: ##IFN NOIMAGES 
1425:       IF(QCRYS .AND. XDIM.GT.0) THEN 
1426:          CALL COPYR8(XUCELL,XUCOLD,6) 
1427:          CALL XTLLAT(XUCELL,XTLABC) 
1428:          CALL XTLMSR(XUCELL) 
1429: C     Recompute the images from the crystal transformations. 
1430:          TRANSF =  ALLSTK(IREAL8(12*XNSYMM)) 
1431:          CALL IMFILL(STACK(TRANSF),.FALSE.) 
1432:          CALL FRESTK(IREAL8(12*XNSYMM)) 
1433:       ENDIF 
1434: ##ENDIF 
1435: C 
1436:       RETURN 
1437:       END 


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0