pfuiinfo.f

一个有用的分子动力学小辅助程序

 	subroutine pfuiinfo(nunit,pfi,nfunmax,
     $                      nfun,nhamtyp,descr,tutype,ielem,extra,
     $                      nderiv,ntab,atumin,atumax,icode)

*	FE 29-oct-93

	implicit none
*	   PARAMETERS
*	     code for impossible hamitonian type code (quite arbitrary)
	integer impossible
	parameter (impossible=-9999999)
*	   ARGUMENTS
	integer nunit,nfunmax,nfun,nhamtyp,ielem(3,nfunmax),nderiv,
     $          ntab(nfunmax),icode
	logical pfi
	character descr(3,nfunmax)*80,tutype(nfunmax)*2
	double precision extra(3,nfunmax),
     $                   atumin(nfunmax),atumax(nfunmax)
*	   LOCAL
	logical frstread
	integer ifun,ideriv
	character descrT(3)*80,tutypeT*2
	integer ielemT(3),nderivT,ntabT,nhamtypT
	double precision extraT(3),atuminT,atumaxT,datuiT
	character*5 first5

 1	format (a80)
 2	format (a2,5i5)
 3	format (3d25.17)
 4	format (i10)
 5	format (a5)

*	   initialize all the ntab's to zero:
	do ifun=1,nfunmax
	   ntab(ifun) = 0
	enddo
	nhamtyp = impossible
	nfun = 0
	nderiv = 2
	frstread = .false.
	icode = 0

*	   read file until EOF
 11	continue
	   if (.not.frstread) then
*	         we have to read the first line for this function,
*	         which must contain the string PFUI1 in the first 5
*	         positions otherwise this is not a legal file.
	      if (pfi) then
	         if (nunit.lt.0) then
	            read(  *  ,5,err=9999,end=12) first5
	         else
	            read(nunit,5,err=9999,end=12) first5
	         endif
	      else
	         if (nunit.ge.0) then
	            read(nunit,err=9999,end=12) first5
	         endif
	      endif
	      if (first5.ne.'PFUI1') then
*	            this does not appear to be a Level 1 PFUI file
*	            and we reject it (bleah!)
	         icode = 2
	         return
	      endif
	   endif
	   nfun = nfun + 1

*	      read header
	   if (pfi) then
	      if (nunit.lt.0) then
	         read(  *  ,2,err=9999) tutypeT,nderivT,ielemT,nhamtypT
	         read(  *  ,1,err=9999) descrT
	         read(  *  ,3,err=9999) extraT
	         read(  *  ,4,err=9999) ntabT
	         read(  *  ,3,err=9999) atuminT,atumaxT,datuiT
	      else
	         read(nunit,2,err=9999) tutypeT,nderivT,ielemT,nhamtypT
	         read(nunit,1,err=9999) descrT
	         read(nunit,3,err=9999) extraT
	         read(nunit,4,err=9999) ntabT
	         read(nunit,3,err=9999) atuminT,atumaxT,datuiT
	      endif
	   else
	      if (nunit.ge.0) then
	         read(nunit,err=9999) tutypeT,nderivT,ielemT,nhamtypT
	         read(nunit,err=9999) descrT
	         read(nunit,err=9999) extraT
	         read(nunit,err=9999) ntabT
	         read(nunit,err=9999) atuminT,atumaxT,datuiT
	      endif
	   endif

*	      nderiv will be the minimum nderivT
	   if (nderivT.lt.nderiv) then
	      nderiv = nderivT
	   endif
*	      nhamtyp will be that attached to the first function
*	      encountered in the file.
	   if (nhamtyp.eq.impossible) then
	      nhamtyp = nhamtypT
	   endif
	   if (nfun.le.nfunmax) then
*	         copy all these informations in the user area
	      tutype(nfun) = tutypeT
	      ielem(1,nfun) = ielemT(1)
	      ielem(2,nfun) = ielemT(2)
	      ielem(3,nfun) = ielemT(3)
	      descr(1,nfun) = descrT(1)
	      descr(2,nfun) = descrT(2)
	      descr(3,nfun) = descrT(3)
	      extra(1,nfun) = extraT(1)
	      extra(2,nfun) = extraT(2)
	      extra(3,nfun) = extraT(3)
	      ntab(nfun) = ntabT
	      atumin(nfun) = atuminT
	      atumax(nfun) = atumaxT
	   else
*	         user area is filled
	      icode = 3
	   endif

*	      we must now skip the tables to get to the next
*	      function's header, or to the EOF.
	   if (pfi) then
*	         look for the start of the next function, if any.
 13	      continue
	         if (nunit.lt.0) then
	            read(  *  ,5,err=9999,end=12) first5
	         else
	            read(nunit,5,err=9999,end=12) first5
	         endif
	         if (first5.ne.'PFUI1') goto 13
	      frstread = .true.
	   else if (nunit.ge.0) then
*	         just skip the records with .pui files:
	      do ideriv=0,nderivT
	         read(nunit,err=9999)
	      enddo
	      frstread = .false.
	   endif

	   goto 11
 12	continue
*	   EOF reached.
	if (nfun.eq.0) icode = 2
	return

 9999	continue
*	   error in read:
	icode = 1
	return
	end