lugive.f

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lugive.f

    
C*********************************************************************  
    
      SUBROUTINE lugive(CHIN)   
    
C...Purpose: to set values of commonblock variables.    
      common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
      SAVE /lujets/ 
      common/ludat1/mstu(200),paru(200),mstj(200),parj(200) 
      SAVE /ludat1/ 
      common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)    
      SAVE /ludat2/ 
      common/ludat3/mdcy(500,3),mdme(2000,2),brat(2000),kfdp(2000,5)    
      SAVE /ludat3/ 
      common/ludat4/chaf(500)   
      CHARACTER chaf*8  
      SAVE /ludat4/ 
      CHARACTER chin*(*),chfix*104,chbit*104,chold*8,chnew*8,   
     &chnam*4,chvar(17)*4,chalp(2)*26,chind*8,chini*10,chinr*16 
      DATA chvar/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',    
     &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF'/  
      DATA chalp/'abcdefghijklmnopqrstuvwxyz',  
     &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ 
    
C...Length of character variable. Subdivide it into instructions.   
      IF(mstu(12).GE.1) CALL lulist(0)  
      chbit=chin//' '   
      lbit=101  
  100 lbit=lbit-1   
      IF(chbit(lbit:lbit).EQ.' ') goto 100  
      ltot=0    
      DO 110 lcom=1,lbit    
      IF(chbit(lcom:lcom).EQ.' ') goto 110  
      ltot=ltot+1   
      chfix(ltot:ltot)=chbit(lcom:lcom) 
  110 CONTINUE  
      llow=0    
  120 lhig=llow+1   
  130 lhig=lhig+1   
      IF(lhig.LE.ltot.AND.chfix(lhig:lhig).NE.';') goto 130 
      lbit=lhig-llow-1  
      chbit(1:lbit)=chfix(llow+1:lhig-1)    
    
C...Identify commonblock variable.  
      lnam=1    
  140 lnam=lnam+1   
      IF(chbit(lnam:lnam).NE.'('.AND.chbit(lnam:lnam).NE.'='.AND.   
     &lnam.LE.4) goto 140   
      chnam=chbit(1:lnam-1)//' '    
      DO 150 lcom=1,lnam-1  
      DO 150 lalp=1,26  
  150 IF(chnam(lcom:lcom).EQ.chalp(1)(lalp:lalp)) chnam(lcom:lcom)= 
     &chalp(2)(lalp:lalp)   
      ivar=0    
      DO 160 iv=1,17    
  160 IF(chnam.EQ.chvar(iv)) ivar=iv    
      IF(ivar.EQ.0) THEN    
        CALL luerrm(18,'(LUGIVE:) do not recognize variable '//chnam)   
        llow=lhig   
        IF(llow.LT.ltot) goto 120   
        RETURN  
      ENDIF 
    
C...Identify any indices.   
      i=0   
      j=0   
      IF(chbit(lnam:lnam).EQ.'(') THEN  
        lind=lnam   
  170   lind=lind+1 
        IF(chbit(lind:lind).NE.')'.AND.chbit(lind:lind).NE.',') goto 170    
        chind=' '   
        IF((chbit(lnam+1:lnam+1).EQ.'C'.OR.chbit(lnam+1:lnam+1).EQ.'c').    
     &  and.(ivar.EQ.9.OR.ivar.EQ.10.OR.ivar.EQ.13.OR.ivar.EQ.17)) THEN 
          chind(lnam-lind+11:8)=chbit(lnam+2:lind-1)    
          READ(chind,'(I8)') i1 
          i=lucomp(i1)  
        ELSE    
          chind(lnam-lind+10:8)=chbit(lnam+1:lind-1)    
          READ(chind,'(I8)') i  
        ENDIF   
        lnam=lind   
        IF(chbit(lnam:lnam).EQ.')') lnam=lnam+1 
      ENDIF 
      IF(chbit(lnam:lnam).EQ.',') THEN  
        lind=lnam   
  180   lind=lind+1 
        IF(chbit(lind:lind).NE.')'.AND.chbit(lind:lind).NE.',') goto 180    
        chind=' '   
        chind(lnam-lind+10:8)=chbit(lnam+1:lind-1)  
        READ(chind,'(I8)') j    
        lnam=lind+1 
      ENDIF 
    
C...Check that indices allowed and save old value.  
      ierr=1    
      IF(chbit(lnam:lnam).NE.'=') goto 190  
      IF(ivar.EQ.1) THEN    
        IF(i.NE.0.OR.j.NE.0) goto 190   
        iold=n  
      ELSEIF(ivar.EQ.2) THEN    
        IF(i.LT.1.OR.i.GT.mstu(4).OR.j.LT.1.OR.j.GT.5) goto 190 
        iold=k(i,j) 
      ELSEIF(ivar.EQ.3) THEN    
        IF(i.LT.1.OR.i.GT.mstu(4).OR.j.LT.1.OR.j.GT.5) goto 190 
        rold=p(i,j) 
      ELSEIF(ivar.EQ.4) THEN    
        IF(i.LT.1.OR.i.GT.mstu(4).OR.j.LT.1.OR.j.GT.5) goto 190 
        rold=v(i,j) 
      ELSEIF(ivar.EQ.5) THEN    
        IF(i.LT.1.OR.i.GT.200.OR.j.NE.0) goto 190   
        iold=mstu(i)    
      ELSEIF(ivar.EQ.6) THEN    
        IF(i.LT.1.OR.i.GT.200.OR.j.NE.0) goto 190   
        rold=paru(i)    
      ELSEIF(ivar.EQ.7) THEN    
        IF(i.LT.1.OR.i.GT.200.OR.j.NE.0) goto 190   
        iold=mstj(i)    
      ELSEIF(ivar.EQ.8) THEN    
        IF(i.LT.1.OR.i.GT.200.OR.j.NE.0) goto 190   
        rold=parj(i)    
      ELSEIF(ivar.EQ.9) THEN    
        IF(i.LT.1.OR.i.GT.mstu(6).OR.j.LT.1.OR.j.GT.3) goto 190 
        iold=kchg(i,j)  
      ELSEIF(ivar.EQ.10) THEN   
        IF(i.LT.1.OR.i.GT.mstu(6).OR.j.LT.1.OR.j.GT.4) goto 190 
        rold=pmas(i,j)  
      ELSEIF(ivar.EQ.11) THEN   
        IF(i.LT.1.OR.i.GT.2000.OR.j.NE.0) goto 190  
        rold=parf(i)    
      ELSEIF(ivar.EQ.12) THEN   
        IF(i.LT.1.OR.i.GT.4.OR.j.LT.1.OR.j.GT.4) goto 190   
        rold=vckm(i,j)  
      ELSEIF(ivar.EQ.13) THEN   
        IF(i.LT.1.OR.i.GT.mstu(6).OR.j.LT.1.OR.j.GT.3) goto 190 
        iold=mdcy(i,j)  
      ELSEIF(ivar.EQ.14) THEN   
        IF(i.LT.1.OR.i.GT.mstu(7).OR.j.LT.1.OR.j.GT.2) goto 190 
        iold=mdme(i,j)  
      ELSEIF(ivar.EQ.15) THEN   
        IF(i.LT.1.OR.i.GT.mstu(7).OR.j.NE.0) goto 190   
        rold=brat(i)    
      ELSEIF(ivar.EQ.16) THEN   
        IF(i.LT.1.OR.i.GT.mstu(7).OR.j.LT.1.OR.j.GT.5) goto 190 
        iold=kfdp(i,j)  
      ELSEIF(ivar.EQ.17) THEN   
        IF(i.LT.1.OR.i.GT.mstu(6).OR.j.NE.0) goto 190   
        chold=chaf(i)   
      ENDIF 
      ierr=0    
  190 IF(ierr.EQ.1) THEN    
        CALL luerrm(18,'(LUGIVE:) unallowed indices for '// 
     &  chbit(1:lnam-1))    
        llow=lhig   
        IF(llow.LT.ltot) goto 120   
        RETURN  
      ENDIF 
    
C...Print current value of variable. Loop back. 
      IF(lnam.GE.lbit) THEN 
        chbit(lnam:14)=' '  
        chbit(15:60)=' has the value                                '   
        IF(ivar.EQ.1.OR.ivar.EQ.2.OR.ivar.EQ.5.OR.ivar.EQ.7.OR. 
     &  ivar.EQ.9.OR.ivar.EQ.13.OR.ivar.EQ.14.OR.ivar.EQ.16) THEN   
          WRITE(chbit(51:60),'(I10)') iold  
        ELSEIF(ivar.NE.17) THEN 
          WRITE(chbit(47:60),'(F14.5)') rold    
        ELSE    
          chbit(53:60)=chold    
        ENDIF   
        IF(mstu(13).GE.1) WRITE(mstu(11),1000) chbit(1:60)  
        llow=lhig   
        IF(llow.LT.ltot) goto 120   
        RETURN  
      ENDIF 
    
C...Read in new variable value. 
      IF(ivar.EQ.1.OR.ivar.EQ.2.OR.ivar.EQ.5.OR.ivar.EQ.7.OR.   
     &ivar.EQ.9.OR.ivar.EQ.13.OR.ivar.EQ.14.OR.ivar.EQ.16) THEN 
        chini=' '   
        chini(lnam-lbit+11:10)=chbit(lnam+1:lbit)   
        READ(chini,'(I10)') inew    
      ELSEIF(ivar.NE.17) THEN   
        chinr=' '   
        chinr(lnam-lbit+17:16)=chbit(lnam+1:lbit)   
        READ(chinr,'(F16.2)') rnew  
      ELSE  
        chnew=chbit(lnam+1:lbit)//' '   
      ENDIF 
    
C...Store new variable value.   
      IF(ivar.EQ.1) THEN    
        n=inew  
      ELSEIF(ivar.EQ.2) THEN    
        k(i,j)=inew 
      ELSEIF(ivar.EQ.3) THEN    
        p(i,j)=rnew 
      ELSEIF(ivar.EQ.4) THEN    
        v(i,j)=rnew 
      ELSEIF(ivar.EQ.5) THEN    
        mstu(i)=inew    
      ELSEIF(ivar.EQ.6) THEN    
        paru(i)=rnew    
      ELSEIF(ivar.EQ.7) THEN    
        mstj(i)=inew    
      ELSEIF(ivar.EQ.8) THEN    
        parj(i)=rnew    
      ELSEIF(ivar.EQ.9) THEN    
        kchg(i,j)=inew  
      ELSEIF(ivar.EQ.10) THEN   
        pmas(i,j)=rnew  
      ELSEIF(ivar.EQ.11) THEN   
        parf(i)=rnew    
      ELSEIF(ivar.EQ.12) THEN   
        vckm(i,j)=rnew  
      ELSEIF(ivar.EQ.13) THEN   
        mdcy(i,j)=inew  
      ELSEIF(ivar.EQ.14) THEN   
        mdme(i,j)=inew  
      ELSEIF(ivar.EQ.15) THEN   
        brat(i)=rnew    
      ELSEIF(ivar.EQ.16) THEN   
        kfdp(i,j)=inew  
      ELSEIF(ivar.EQ.17) THEN   
        chaf(i)=chnew   
      ENDIF 
    
C...Write old and new value. Loop back. 
      chbit(lnam:14)=' '    
      chbit(15:60)=' changed from                to               ' 
      IF(ivar.EQ.1.OR.ivar.EQ.2.OR.ivar.EQ.5.OR.ivar.EQ.7.OR.   
     &ivar.EQ.9.OR.ivar.EQ.13.OR.ivar.EQ.14.OR.ivar.EQ.16) THEN 
        WRITE(chbit(33:42),'(I10)') iold    
        WRITE(chbit(51:60),'(I10)') inew    
      ELSEIF(ivar.NE.17) THEN   
        WRITE(chbit(29:42),'(F14.5)') rold  
        WRITE(chbit(47:60),'(F14.5)') rnew  
      ELSE  
        chbit(35:42)=chold  
        chbit(53:60)=chnew  
      ENDIF 
      IF(mstu(13).GE.1) WRITE(mstu(11),1000) chbit(1:60)    
      llow=lhig 
      IF(llow.LT.ltot) goto 120 
    
C...Format statement for output on unit MSTU(11) (by default 6).    
 1000 FORMAT(5x,a60)    
    
      RETURN    
      END