1 subroutine read_general_data(*)
4 include "DIMENSIONS.ZSCOPT"
5 include "DIMENSIONS.FREE"
6 include "COMMON.TORSION"
7 include "COMMON.INTERACT"
8 include "COMMON.IOUNITS"
11 include "COMMON.PROTFILES"
12 include "COMMON.CHAIN"
13 include "COMMON.NAMES"
14 include "COMMON.FFIELD"
15 include "COMMON.ENEPS"
16 include "COMMON.WEIGHTS"
18 include "COMMON.CONTROL"
19 include "COMMON.ENERGIES"
20 include "COMMON.SPLITELE"
21 include "COMMON.SBRIDGE"
22 character*800 controlcard
23 integer i,j,k,ii,n_ene_found
24 integer ind,itype1,itype2,itypf,itypsc,itypp
31 call card_concat(controlcard,.true.)
32 call readi(controlcard,"N_ENE",n_ene,max_ene)
33 if (n_ene.gt.max_ene) then
34 write (iout,*) "Error: parameter out of range: N_ENE",n_ene,
38 call readi(controlcard,"NPARMSET",nparmset,1)
39 separate_parset = index(controlcard,"SEPARATE_PARSET").gt.0
40 call readi(controlcard,"IPARMPRINT",iparmprint,1)
41 write (iout,*) "PARMPRINT",iparmprint
42 if (nparmset.gt.max_parm) then
43 write (iout,*) "Error: parameter out of range: NPARMSET",
47 call readi(controlcard,"MAXIT",maxit,5000)
48 call reada(controlcard,"FIMIN",fimin,1.0d-3)
49 call readi(controlcard,"ENSEMBLES",ensembles,0)
50 hamil_rep=index(controlcard,"HAMIL_REP").gt.0
51 write (iout,*) "Number of energy parameter sets",nparmset
52 call multreadi(controlcard,"ISAMPL",isampl,nparmset,1)
53 write (iout,*) "MaxSlice",MaxSlice
54 call readi(controlcard,"NSLICE",nslice,1)
56 if (nslice.gt.MaxSlice) then
57 write (iout,*) "Error: parameter out of range: NSLICE",nslice,
61 write (iout,*) "Frequency of storing conformations",
62 & (isampl(i),i=1,nparmset)
63 write (iout,*) "Maxit",maxit," Fimin",fimin
64 call readi(controlcard,"NQ",nQ,1)
66 write (iout,*) "Error: parameter out of range: NQ",nq,
71 if (index(controlcard,"CLASSIFY").gt.0) indpdb=1
72 call reada(controlcard,"DELTA",delta,1.0d-2)
73 call readi(controlcard,"EINICHECK",einicheck,2)
74 call reada(controlcard,"DELTRMS",deltrms,5.0d-2)
75 call reada(controlcard,"DELTRGY",deltrgy,5.0d-2)
76 call readi(controlcard,"RESCALE",rescale_mode,1)
77 check_conf=index(controlcard,"NO_CHECK_CONF").eq.0
78 call reada(controlcard,'DISTCHAINMAX',distchainmax,50.0d0)
79 call reada(controlcard,'BOXX',boxxsize,100.0d0)
80 call reada(controlcard,'BOXY',boxysize,100.0d0)
81 call reada(controlcard,'BOXZ',boxzsize,100.0d0)
82 c Cutoff range for interactions
83 call reada(controlcard,"R_CUT",r_cut,15.0d0)
84 call reada(controlcard,"LAMBDA",rlamb,0.3d0)
85 call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
86 call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
87 if (lipthick.gt.0.0d0) then
88 bordliptop=(boxzsize+lipthick)/2.0
89 bordlipbot=bordliptop-lipthick
91 if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0))
92 & write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE"
93 buflipbot=bordlipbot+lipbufthick
94 bufliptop=bordliptop-lipbufthick
95 if ((lipbufthick*2.0d0).gt.lipthick)
96 &write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF"
98 write(iout,*) "bordliptop=",bordliptop
99 write(iout,*) "bordlipbot=",bordlipbot
100 write(iout,*) "bufliptop=",bufliptop
101 write(iout,*) "buflipbot=",buflipbot
102 call readi(controlcard,'SYM',symetr,1)
103 write (iout,*) "DISTCHAINMAX",distchainmax
104 write (iout,*) "delta",delta
105 write (iout,*) "einicheck",einicheck
106 write (iout,*) "rescale_mode",rescale_mode
108 bxfile=index(controlcard,"BXFILE").gt.0
109 cxfile=index(controlcard,"CXFILE").gt.0
110 if (nslice .eq. 1 .and. .not.bxfile .and. .not.cxfile)
112 histfile=index(controlcard,"HISTFILE").gt.0
113 histout=index(controlcard,"HISTOUT").gt.0
114 entfile=index(controlcard,"ENTFILE").gt.0
115 zscfile=index(controlcard,"ZSCFILE").gt.0
116 with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0
117 write (iout,*) "with_dihed_constr ",with_dihed_constr
118 with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0
119 write (iout,*) "with_theta_constr ",with_theta_constr
120 call readi(controlcard,'CONSTR_DIST',constr_dist,0)
121 write (iout,*) "with_dihed_constr ",with_dihed_constr,
122 & " CONSTR_DIST",constr_dist
123 call readi(controlcard,'CONSTR_HOMOL',constr_homology,0)
124 write (iout,*) "with_homology_constr ",with_dihed_constr,
125 & " CONSTR_HOMOLOGY",constr_homology
126 refstr = index(controlcard,'REFSTR').gt.0
127 pdbref = index(controlcard,'PDBREF').gt.0
128 dyn_ss=(index(controlcard,'DYN_SS').gt.0)
129 call readi(controlcard,'NSAXS',nsaxs,0)
130 call readi(controlcard,'SAXS_MODE',saxs_mode,0)
131 call reada(controlcard,'SCAL_RAD',scal_rad,1.0d0)
132 call reada(controlcard,'SAXS_CUTOFF',saxs_cutoff,1.0d0)
133 write (iout,*) "Number of SAXS restraints",NSAXS," SAXS_MODE",
134 & SAXS_MODE," SCAL_RAD",scal_rad,"SAXS_CUTOFF",saxs_cutoff
135 C /06/28/2013 Adasko: dyn_ss is keyword allowing to break and create bond
136 C disulfide bond. Note that in conterary to dynamics this in
137 C CONTROLCARD. The bond are read in molread_zs.F
141 c------------------------------------------------------------------------------
142 subroutine read_efree(*)
144 C Read molecular data
148 include 'DIMENSIONS.ZSCOPT'
149 include 'DIMENSIONS.COMPAR'
150 include 'DIMENSIONS.FREE'
151 include 'COMMON.IOUNITS'
152 include 'COMMON.TIME1'
153 include 'COMMON.SBRIDGE'
154 include 'COMMON.CONTROL'
155 include 'COMMON.CHAIN'
156 include 'COMMON.HEADER'
158 include 'COMMON.FREE'
159 character*320 controlcard,ucase
160 integer iparm,ib,i,j,npars
172 call card_concat(controlcard,.true.)
173 call readi(controlcard,'NT',nT_h(iparm),1)
174 write (iout,*) "iparm",iparm," nt",nT_h(iparm)
176 if (nT_h(iparm).gt.MaxT_h) then
177 write (iout,*) "Error: parameter out of range: NT",nT_h(iparm),
181 replica(iparm)=index(controlcard,"REPLICA").gt.0
182 umbrella(iparm)=index(controlcard,"UMBRELLA").gt.0
183 read_iset(iparm)=index(controlcard,"READ_ISET").gt.0
184 write (iout,*) "nQ",nQ," nT",nT_h(iparm)," replica ",
185 & replica(iparm)," umbrella ",umbrella(iparm),
186 & " read_iset",read_iset(iparm)
189 call card_concat(controlcard,.true.)
190 call readi(controlcard,'NR',nR(ib,iparm),1)
191 if (umbrella(iparm)) then
194 nRR(ib,iparm)=nR(ib,iparm)
196 if (nR(ib,iparm).gt.MaxR) then
197 write (iout,*) "Error: parameter out of range: NR",
201 call reada(controlcard,'TEMP',beta_h(ib,iparm),298.0d0)
202 beta_h(ib,iparm)=1.0d0/(beta_h(ib,iparm)*1.987D-3)
203 call multreada(controlcard,'FI',f(1,ib,iparm),nR(ib,iparm),
206 call card_concat(controlcard,.true.)
207 call multreada(controlcard,'KH',KH(1,i,ib,iparm),nQ,
209 call multreada(controlcard,'Q0',Q0(1,i,ib,iparm),nQ,
214 write (iout,*) "ib",ib," beta_h",
215 & 1.0d0/(0.001987*beta_h(ib,iparm))
216 write (iout,*) "nR",nR(ib,iparm)
217 write (iout,*) "fi",(f(i,ib,iparm),i=1,nR(ib,iparm))
219 write (iout,*) "i",i," Kh",(Kh(j,i,ib,iparm),j=1,nQ),
220 & "q0",(q0(j,i,ib,iparm),j=1,nQ)
225 write (iout,*) "HOMOL_NSET",homol_nset
233 nR(ib,iparm)=nR(ib,1)
234 if (umbrella(iparm)) then
237 nRR(ib,iparm)=nR(ib,1)
239 beta_h(ib,iparm)=beta_h(ib,1)
241 f(i,ib,iparm)=f(i,ib,1)
243 KH(j,i,ib,iparm)=KH(j,i,ib,1)
244 Q0(j,i,ib,iparm)=Q0(j,i,ib,1)
247 replica(iparm)=replica(1)
248 umbrella(iparm)=umbrella(1)
249 read_iset(iparm)=read_iset(1)
257 c-----------------------------------------------------------------------------
258 subroutine read_protein_data(*)
261 include "DIMENSIONS.ZSCOPT"
262 include "DIMENSIONS.FREE"
265 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
268 include "COMMON.CHAIN"
269 include "COMMON.IOUNITS"
270 include "COMMON.PROT"
271 include "COMMON.PROTFILES"
272 include "COMMON.NAMES"
273 include "COMMON.FREE"
274 include "COMMON.OBCINKA"
276 character*16000 controlcard
277 integer i,ii,ib,iR,iparm,ilen,iroof,nthr,npars
287 C Read names of files with conformation data.
288 if (replica(iparm)) then
294 do ii=1,nRR(ib,iparm)
295 write (iout,*) "Parameter set",iparm," temperature",ib,
298 call card_concat(controlcard,.true.)
299 write (iout,*) controlcard(:ilen(controlcard))
300 call readi(controlcard,"NFILE_BIN",nfile_bin(ii,ib,iparm),0)
301 call readi(controlcard,"NFILE_ASC",nfile_asc(ii,ib,iparm),0)
302 call readi(controlcard,"NFILE_CX",nfile_cx(ii,ib,iparm),0)
303 call readi(controlcard,"REC_START",rec_start(ii,ib,iparm),1)
304 call readi(controlcard,"REC_END",rec_end(ii,ib,iparm),
305 & maxstr*isampl(iparm)+rec_start(ii,ib,iparm)-1)
306 call reada(controlcard,"TIME_START",
307 & time_start_collect(ii,ib,iparm),0.0d0)
308 call reada(controlcard,"TIME_END",time_end_collect(ii,ib,iparm),
310 write (iout,*) "rec_start",rec_start(ii,ib,iparm),
311 & " rec_end",rec_end(ii,ib,iparm)
312 write (iout,*) "time_start",time_start_collect(ii,ib,iparm),
313 & " time_end",time_end_collect(ii,ib,iparm)
315 if (replica(iparm)) then
316 call readi(controlcard,"TOTRAJ",totraj(ii,iparm),1)
317 write (iout,*) "Number of trajectories",totraj(ii,iparm)
320 if (nfile_bin(ii,ib,iparm).lt.2
321 & .and. nfile_asc(ii,ib,iparm).eq.0
322 & .and. nfile_cx(ii,ib,iparm).eq.0) then
323 write (iout,*) "Error - no action specified!"
326 if (nfile_bin(ii,ib,iparm).gt.0) then
327 call card_concat(controlcard,.false.)
328 call split_string(controlcard,protfiles(1,1,ii,ib,iparm),
329 & maxfile_prot,nfile_bin(ii,ib,iparm))
331 write(iout,*)"nfile_bin",nfile_bin(ii,ib,iparm)
332 write(iout,*) (protfiles(i,1,ii,ib,iparm),
333 & i=1,nfile_bin(ii,ib,iparm))
336 if (nfile_asc(ii,ib,iparm).gt.0) then
337 call card_concat(controlcard,.false.)
338 call split_string(controlcard,protfiles(1,2,ii,ib,iparm),
339 & maxfile_prot,nfile_asc(ii,ib,iparm))
341 write(iout,*) "nfile_asc(ii,ib,iparm)",nfile_asc(ii,ib,iparm)
342 write(iout,*) (protfiles(i,2,ii,ib,iparm),
343 & i=1,nfile_asc(ii,ib,iparm))
345 else if (nfile_cx(ii,ib,iparm).gt.0) then
346 call card_concat(controlcard,.false.)
347 call split_string(controlcard,protfiles(1,2,ii,ib,iparm),
348 & maxfile_prot,nfile_cx(ii,ib,iparm))
350 write(iout,*) "nfile_cx(ii,ib,iparm)",nfile_cx(ii,ib,iparm)
351 write(iout,*) (protfiles(i,2,ii,ib,iparm),
352 & i=1,nfile_cx(ii,ib,iparm))
363 c-------------------------------------------------------------------------------
364 subroutine opentmp(islice,iunit,bprotfile_temp)
367 include "DIMENSIONS.ZSCOPT"
368 include "DIMENSIONS.FREE"
371 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
374 include "COMMON.IOUNITS"
375 include "COMMON.PROTFILES"
376 include "COMMON.PROT"
377 include "COMMON.FREE"
378 character*64 bprotfile_temp
379 character*3 liczba,liczba2
386 write (liczba1,'(bz,i2.2)') islice
387 write (liczba,'(bz,i3.3)') me
389 c write (iout,*) "separate_parset ",separate_parset,
391 if (separate_parset) then
392 write (liczba2,'(bz,i3.3)') myparm
393 bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
394 & prefix(:ilen(prefix))//liczba//"_"//liczba2//".xbin.tmp"//liczba1
395 open (iunit,file=bprotfile_temp,status="unknown",
396 & form="unformatted",access="direct",recl=lenrec)
398 bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
399 & prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1
400 open (iunit,file=bprotfile_temp,status="unknown",
401 & form="unformatted",access="direct",recl=lenrec)
404 bprotfile_temp = scratchdir(:ilen(scratchdir))//
405 & "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1
406 open (iunit,file=bprotfile_temp,status="unknown",
407 & form="unformatted",access="direct",recl=lenrec)
409 c write (iout,*) "OpenTmp iunit",iunit," bprotfile_temp",
414 c-------------------------------------------------------------------------------
415 subroutine read_database(*)
418 include "DIMENSIONS.ZSCOPT"
419 include "DIMENSIONS.FREE"
422 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
425 include "COMMON.CHAIN"
426 include "COMMON.IOUNITS"
427 include "COMMON.PROTFILES"
428 include "COMMON.NAMES"
431 include "COMMON.ENEPS"
432 include "COMMON.PROT"
433 include "COMMON.INTERACT"
434 include "COMMON.FREE"
435 include "COMMON.SBRIDGE"
436 include "COMMON.OBCINKA"
437 real*4 csingle(3,maxres2)
438 character*64 nazwa,bprotfile_temp
441 integer i,j,ii,jj(maxslice),k,kk(maxslice),l,
442 & ll(maxslice),mm(maxslice),if
443 integer nrec,nlines,iscor,iunit,islice
444 double precision energ
447 double precision rmsdev,energia(0:max_ene),efree,eini,temp
448 double precision prop(maxQ)
449 integer ntot_all(maxslice,0:maxprocs-1), maxslice_buff
450 integer iparm,ib,iib,ir,nprop,nthr,npars
451 double precision etot,time
455 lenrec1=12*(nres+nct-nnt+1)+4*(2*nss+2)+24
456 lenrec2=12*(nres+nct-nnt+1)+4*(2*nss+2)+24+8*nQ
458 write (iout,*) "lenrec",lenrec," lenrec1",lenrec1,
468 write (iout,*) "nparmset",nparmset
476 if (replica(iparm)) then
483 do iR=1,nRR(ib,iparm)
485 write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ
491 IF (NFILE_BIN(iR,ib,iparm).GT.0) THEN
492 c Read conformations from binary DA files (one per batch) and write them to
493 c a binary DA scratchfile.
494 write (liczba,'(bz,i3.3)') me
495 do if=1,nfile_bin(iR,ib,iparm)
496 nazwa=protfiles(if,1,iR,ib,iparm)
497 & (:ilen(protfiles(if,1,iR,ib,iparm)))//".bx"
498 open (ientin,file=nazwa,status="old",form="unformatted",
499 & access="direct",recl=lenrec2,err=1111)
502 call opentmp(islice,ientout,bprotfile_temp)
503 call bxread(nazwa,ii,jj(islice),kk(islice),ll(islice),
504 & mm(islice),iR,ib,iparm)
511 IF (NFILE_ASC(iR,ib,iparm).GT.0) THEN
512 c Read conformations from multiple ASCII int files and write them to a binary
514 do if=1,nfile_asc(iR,ib,iparm)
515 nazwa=protfiles(if,2,iR,ib,iparm)
516 & (:ilen(protfiles(if,2,iR,ib,iparm)))//".x"
517 open(unit=ientin,file=nazwa,status='old',err=1111)
518 write(iout,*) "reading ",nazwa(:ilen(nazwa))
520 call xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm)
523 IF (NFILE_CX(iR,ib,iparm).gt.0) THEN
524 c Read conformations from cx files and write them to a binary
526 do if=1,nfile_cx(iR,ib,iparm)
527 nazwa=protfiles(if,2,iR,ib,iparm)
528 & (:ilen(protfiles(if,2,iR,ib,iparm)))//".cx"
529 write(iout,*) "reading ",nazwa(:ilen(nazwa))
531 print *,"Calling cxread"
532 call cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm,
535 write (iout,*) "exit cxread"
541 stot(islice)=stot(islice)+jj(islice)
546 write (iout,*) "IPARM",iparm
549 if (nslice.eq.1) then
551 write (liczba,'(bz,i3.3)') me
552 bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
553 & prefix(:ilen(prefix))//liczba//".xbin.tmp"
555 bprotfile_temp = scratchdir(:ilen(scratchdir))//
556 & "/"//prefix(:ilen(prefix))//".xbin.tmp"
558 write(iout,*) mm(1)," conformations read",ll(1),
559 & " conformations written to ",
560 & bprotfile_temp(:ilen(bprotfile_temp))
563 write (liczba1,'(bz,i2.2)') islice
565 write (liczba,'(bz,i3.3)') me
566 bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
567 & prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1
569 bprotfile_temp = scratchdir(:ilen(scratchdir))//
570 & "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1
572 write(iout,*) mm(islice)," conformations read",ll(islice),
573 & " conformations written to ",
574 & bprotfile_temp(:ilen(bprotfile_temp))
579 c Check if everyone has the same number of conformations
581 c call MPI_ALLgather(MPI_IN_PLACE,stot(1),MPI_DATATYPE_NULL,
582 c & ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR)
584 maxslice_buff=maxslice
586 call MPI_Allgather(stot(1),maxslice_buff,MPI_INTEGER,
587 & ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR)
592 if (stot(islice).ne.ntot_all(islice,i)) then
593 write (iout,*) "Number of conformations at processor",i,
594 & " differs from that at processor",me,
595 & stot(islice),ntot_all(islice,i)," slice",islice
603 write (iout,*) "Numbers of conformations read by processors"
606 write (iout,'(8i10)') i,(ntot_all(islice,i),islice=1,nslice)
608 write (iout,*) "Calculation terminated."
613 ntot(islice)=stot(islice)
617 1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa))
621 c------------------------------------------------------------------------------
622 subroutine card_concat(card,to_upper)
624 include 'DIMENSIONS.ZSCOPT'
625 include "COMMON.IOUNITS"
627 character*80 karta,ucase
631 read (inp,'(a)') karta
632 if (to_upper) karta=ucase(karta)
634 do while (karta(80:80).eq.'&')
635 card=card(:ilen(card)+1)//karta(:79)
636 read (inp,'(a)') karta
637 if (to_upper) karta=ucase(karta)
639 card=card(:ilen(card)+1)//karta
642 c------------------------------------------------------------------------------
643 subroutine readi(rekord,lancuch,wartosc,default)
645 character*(*) rekord,lancuch
646 integer wartosc,default
649 iread=index(rekord,lancuch(:ilen(lancuch))//"=")
654 iread=iread+ilen(lancuch)+1
655 read (rekord(iread:),*) wartosc
658 c----------------------------------------------------------------------------
659 subroutine reada(rekord,lancuch,wartosc,default)
661 character*(*) rekord,lancuch
663 double precision wartosc,default
666 iread=index(rekord,lancuch(:ilen(lancuch))//"=")
671 iread=iread+ilen(lancuch)+1
672 read (rekord(iread:),*) wartosc
675 c----------------------------------------------------------------------------
676 subroutine multreadi(rekord,lancuch,tablica,dim,default)
679 integer tablica(dim),default
680 character*(*) rekord,lancuch
687 iread=index(rekord,lancuch(:ilen(lancuch))//"=")
688 if (iread.eq.0) return
689 iread=iread+ilen(lancuch)+1
690 read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
693 c----------------------------------------------------------------------------
694 subroutine multreada(rekord,lancuch,tablica,dim,default)
697 double precision tablica(dim),default
698 character*(*) rekord,lancuch
705 iread=index(rekord,lancuch(:ilen(lancuch))//"=")
706 if (iread.eq.0) return
707 iread=iread+ilen(lancuch)+1
708 read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
711 c----------------------------------------------------------------------------
712 subroutine reads(rekord,lancuch,wartosc,default)
714 character*(*) rekord,lancuch,wartosc,default
716 integer ilen,lenlan,lenrec,iread,ireade
722 iread=index(rekord,lancuch(:lenlan)//"=")
723 c print *,"rekord",rekord," lancuch",lancuch
724 c print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
730 c print *,"iread",iread
731 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
732 do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
734 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
736 c print *,"iread",iread
737 if (iread.gt.lenrec) then
742 c print *,"ireade",ireade
743 do while (ireade.lt.lenrec .and.
744 & .not.iblnk(rekord(ireade:ireade)))
747 wartosc=rekord(iread:ireade)
750 c----------------------------------------------------------------------------
751 subroutine multreads(rekord,lancuch,tablica,dim,default)
754 character*(*) rekord,lancuch,tablica(dim),default
756 integer ilen,lenlan,lenrec,iread,ireade
765 iread=index(rekord,lancuch(:lenlan)//"=")
766 c print *,"rekord",rekord," lancuch",lancuch
767 c print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
768 if (iread.eq.0) return
771 c print *,"iread",iread
772 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
773 do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
775 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
777 c print *,"iread",iread
778 if (iread.gt.lenrec) return
780 c print *,"ireade",ireade
781 do while (ireade.lt.lenrec .and.
782 & .not.iblnk(rekord(ireade:ireade)))
785 tablica(i)=rekord(iread:ireade)
789 c----------------------------------------------------------------------------
790 subroutine split_string(rekord,tablica,dim,nsub)
792 integer dim,nsub,i,ii,ll,kk
793 character*(*) tablica(dim)
804 C Find the start of term name
806 do while (ii.le.ll .and. rekord(ii:ii).eq." ")
809 C Parse the name into TABLICA(i) until blank found
810 do while (ii.le.ll .and. rekord(ii:ii).ne." ")
812 tablica(i)(kk:kk)=rekord(ii:ii)
815 if (kk.gt.0) nsub=nsub+1
820 c--------------------------------------------------------------------------------
821 integer function iroof(n,m)
823 if (ii*m .lt. n) ii=ii+1