X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc_Eshel%2Fmisc.f;fp=source%2Funres%2Fsrc_Eshel%2Fmisc.f;h=e189839ca983822bd8f6240c17d6283bbb0c8d9a;hb=7308760ff07636ef6b1ee28d8c3a67a23c14b34b;hp=0000000000000000000000000000000000000000;hpb=9a54ab407f6d0d9d564d52763b3e2136450b9ffc;p=unres.git

diff --git a/source/unres/src_Eshel/misc.f b/source/unres/src_Eshel/misc.f
new file mode 100644
index 0000000..e189839
--- /dev/null
+++ b/source/unres/src_Eshel/misc.f
@@ -0,0 +1,203 @@
+C $Date: 1994/10/12 17:24:21 $
+C $Revision: 2.5 $
+C
+C
+C
+      logical function find_arg(ipos,line,errflag)
+      parameter (maxlen=80)
+      character*80 line
+      character*1 empty /' '/,equal /'='/
+      logical errflag
+* This function returns .TRUE., if an argument follows keyword keywd; if so
+* IPOS will point to the first non-blank character of the argument. Returns
+* .FALSE., if no argument follows the keyword; in this case IPOS points
+* to the first non-blank character of the next keyword.
+      do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen)
+        ipos=ipos+1
+      enddo 
+      errflag=.false.
+      if (line(ipos:ipos).eq.equal) then
+         find_arg=.true.
+         ipos=ipos+1
+         do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen)
+           ipos=ipos+1
+         enddo
+         if (ipos.gt.maxlen) errflag=.true.
+      else
+         find_arg=.false.
+      endif
+      return
+      end
+      logical function find_group(iunit,jout,key1)
+      character*(*) key1
+      character*80 karta,ucase
+      integer ilen
+      external ilen
+      logical lcom
+      rewind (iunit)
+      karta=' '
+      ll=ilen(key1)
+      do while (index(ucase(karta),key1(1:ll)).eq.0.or.lcom(1,karta)) 
+        read (iunit,'(a)',end=10) karta
+      enddo
+      write (jout,'(2a)') '> ',karta(1:78)
+      find_group=.true.
+      return
+   10 find_group=.false.
+      return
+      end
+      logical function iblnk(charc)
+      character*1 charc
+      integer n
+      n = ichar(charc)
+      iblnk = (n.eq.9) .or. (n.eq.10) .or. (charc.eq. ' ')
+      return
+      end
+      integer function ilen(string)
+      character*(*) string
+      logical iblnk
+ 
+      ilen = len(string)
+1     if ( ilen .gt. 0 ) then
+         if ( iblnk( string(ilen:ilen) ) ) then
+            ilen = ilen - 1
+            goto 1
+         endif
+      endif
+      return
+      end
+      integer function in_keywd_set(nkey,ikey,narg,keywd,keywdset)
+      character*16 keywd,keywdset(1:nkey,0:nkey)
+      character*16 ucase
+      do i=1,narg
+        if (ucase(keywd).eq.keywdset(i,ikey)) then
+* Match found
+          in_keywd_set=i
+          return
+        endif
+      enddo
+* No match to the allowed set of keywords if this point is reached. 
+      in_keywd_set=0
+      return
+      end
+      character*(*) function lcase(string)
+      integer i, k, idiff
+      character*(*) string
+      character*1 c
+      character*40 chtmp
+c
+      i = len(lcase)
+      k = len(string)
+      if (i .lt. k) then
+         k = i
+         if (string(k+1:) .ne. ' ') then
+            chtmp = string
+         endif
+      endif
+      idiff = ichar('a') - ichar('A')
+      lcase = string
+      do 99 i = 1, k
+         c = string(i:i)
+         if (lge(c,'A') .and. lle(c,'Z')) then
+            lcase(i:i) = char(ichar(c) + idiff)
+         endif
+   99 continue
+      return
+      end
+      logical function lcom(ipos,karta)
+      character*80 karta
+      character koment(2) /'!','#'/
+      lcom=.false.
+      do i=1,2
+        if (karta(ipos:ipos).eq.koment(i)) lcom=.true.
+      enddo 
+      return
+      end
+      logical function lower_case(ch)
+      character*(*) ch
+      lower_case=(ch.ge.'a' .and. ch.le.'z')
+      return
+      end
+      subroutine mykey(line,keywd,ipos,blankline,errflag) 
+* This subroutine seeks a non-empty substring keywd in the string LINE.
+* The substring begins with the first character different from blank and
+* "=" encountered right to the pointer IPOS (inclusively) and terminates
+* at the character left to the first blank or "=". When the subroutine is 
+* exited, the pointer IPOS is moved to the position of the terminator in LINE. 
+* The logical variable BLANKLINE is set at .TRUE., if LINE(IPOS:) contains
+* only separators or the maximum length of the data line (80) has been reached.
+* The logical variable ERRFLAG is set at .TRUE. if the string 
+* consists only from a "=".
+      parameter (maxlen=80)
+      character*1 empty /' '/,equal /'='/,comma /','/
+      character*(*) keywd
+      character*80 line
+      logical blankline,errflag,lcom
+      errflag=.false.
+      do while (line(ipos:ipos).eq.empty .and. (ipos.le.maxlen))
+        ipos=ipos+1
+      enddo
+      if (ipos.gt.maxlen .or. lcom(ipos,line) ) then
+* At this point the rest of the input line turned out to contain only blanks
+* or to be commented out.
+        blankline=.true.
+        return
+      endif
+      blankline=.false.
+      istart=ipos
+* Checks whether the current char is a separator.
+      do while (line(ipos:ipos).ne.empty .and. line(ipos:ipos).ne.equal
+     & .and. line(ipos:ipos).ne.comma .and. ipos.le.maxlen) 
+        ipos=ipos+1
+      enddo
+      iend=ipos-1 
+* Error flag set to .true., if the length of the keyword was found less than 1.
+      if (iend.lt.istart) then
+        errflag=.true.
+        return
+      endif
+      keywd=line(istart:iend)
+      return
+      end      
+      subroutine numstr(inum,numm)
+      character*10 huj /'0123456789'/
+      character*(*) numm
+      inumm=inum
+      inum1=inumm/10
+      inum2=inumm-10*inum1
+      inumm=inum1
+      numm(3:3)=huj(inum2+1:inum2+1)
+      inum1=inumm/10
+      inum2=inumm-10*inum1
+      inumm=inum1
+      numm(2:2)=huj(inum2+1:inum2+1)
+      inum1=inumm/10
+      inum2=inumm-10*inum1 
+      inumm=inum1
+      numm(1:1)=huj(inum2+1:inum2+1)
+      return
+      end       
+      character*(*) function ucase(string)
+      integer i, k, idiff
+      character*(*) string
+      character*1 c
+      character*40 chtmp
+c
+      i = len(ucase)
+      k = len(string)
+      if (i .lt. k) then
+         k = i
+         if (string(k+1:) .ne. ' ') then
+            chtmp = string
+         endif
+      endif
+      idiff = ichar('a') - ichar('A')
+      ucase = string
+      do 99 i = 1, k
+         c = string(i:i)
+         if (lge(c,'a') .and. lle(c,'z')) then
+            ucase(i:i) = char(ichar(c) - idiff)
+         endif
+   99 continue
+      return
+      end