



      SUBROUTINE ION_SET_PAR (R0,N,DIV,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IERR
      REAL          R0, N, DIV, ELMCR0, ELMC_N







      IERR=0








      IF (IONTYP.EQ.'* '.OR.IONTYP.EQ.' *'.OR.IONTYP.EQ.'**') THEN
         CALL ION_UNK_PAR (R0,N,DIV,IONLOW,IONHGH,IONRED) 
         GOTO 998
      END IF



      R0=ELMCR0(IONTYP)
      N =ELMC_N(IONTYP)



      IF (IONTYP.EQ.'NA') THEN
         DIV=1.0
         IONLOW=1.50
         IONHGH=3.50
         IONRED=1
         GOTO 998
      ELSE IF (IONTYP.EQ.'MG') THEN
         DIV=2.0
         IONLOW=1.50
         IONHGH=3.50
         IONRED=1
         GOTO 998
      ELSE IF (IONTYP.EQ.'CA') THEN
         DIV=2.0
         IONLOW=1.50
         IONHGH=3.50
         IONRED=1
         GOTO 998
      ELSE IF (IONTYP.EQ.' K'.OR.IONTYP.EQ.'K ') THEN
         DIV=1.0
         IONLOW=1.50
         IONHGH=3.50
         IONRED=1
         GOTO 998
      ELSE IF (IONTYP.EQ.'ZN') THEN
         DIV=2.0
         IONLOW=1.50
         IONHGH=3.00
         IONRED=2
         GOTO 998
      ELSE IF (IONTYP.EQ.'LI') THEN
         DIV=1.0
         IONLOW=1.25
         IONHGH=2.75
         IONRED=0
         GOTO 998
      ELSE IF (IONTYP.EQ.'MN') THEN
         DIV=2.0
         IONLOW=1.50
         IONHGH=3.00
         IONRED=2
         GOTO 998
      ELSE IF (IONTYP.EQ.'CD') THEN
         DIV=2.0
         IONLOW=1.50
         IONHGH=3.00
         IONRED=2
         GOTO 998
      ELSE IF (IONTYP.EQ.'N4') THEN
         DIV=1.0
         IONLOW=1.50
         IONHGH=3.75
         IONRED=1
         GOTO 998
      ELSE IF (IONTYP.EQ.'CU') THEN
         DIV=2.0
         IONLOW=1.50
         IONHGH=3.75
         IONRED=2
         GOTO 998
      ELSE IF (IONTYP.EQ.'SM') THEN
         DIV=3.0
         IONLOW=1.50
         IONHGH=3.25
         IONRED=0
         GOTO 998
      ELSE
         CALL GVST6C ('Unknown ion-type:',IONTYP,.TRUE.)
         CALL ION_UNK_PAR (R0,N,DIV,IONLOW,IONHGH,IONRED) 
      END IF



 998  CONTINUE


      RETURN
      END   
      SUBROUTINE ION_UNK_PAR (R0,N,DIV,IONLOW,IONHGH,IONRED)

















      IMPLICIT      NONE
      INTEGER       IONRED
      REAL          R0, N, DIV, IONLOW, IONHGH







      R0=1.622
      N=-4.29
      DIV=1.0
      IONLOW=1.25
      IONHGH=3.50
      IONRED=0





      RETURN
      END   
      SUBROUTINE ION_WRIT_TEXT (IUNIT,TEXT,VALUE,CHAR1)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DATBAS.INC'
      INTEGER       IUNIT, GVFLEN, LL
      REAL          VALUE
      CHARACTER*1   CHAR1
      CHARACTER*(*) TEXT







      CALL GVSSTX (LINE,TEXT)
      LL=GVFLEN(LINE)
      CALL GVSCTB (BIGLIN,132)
      WRITE (BIGLIN,'(a,1X,F7.2,1X,a)',ERR=998) LINE(1:LL),VALUE,CHAR1
      CALL GVSTT6 (BIGLIN)
      IF (IUNIT.NE.6.AND.IUNIT.NE.0) CALL GVSTTU (IUNIT,BIGLIN)
      IF (DATOPE) CALL GVSTTU (DATLOG,BIGLIN)



 998  CONTINUE


      RETURN
      END   
      SUBROUTINE ION_WRIT_VALENCY (ION,NUM,VNAP,IUNIT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'DATBAS.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       ION, NUM, IUNIT, LL, GVFLEN, IERR
      REAL          VNAP, ION_VALENCY,R0, N, DIV







      CALL ION_SET_PAR (R0,N,DIV,IERR)
      LL=GVFLEN(LINE)
      CALL GVSFMT ('?FMT1539')
      CALL GVSCTB (BIGLIN,132)
      WRITE (BIGLIN,FMT,ERR=998) R0,N,NINT(DIV)
      CALL GVSTT6 (BIGLIN)
      IF (IUNIT.NE.6.AND.IUNIT.NE.0) CALL GVSTTU (IUNIT,BIGLIN)
      IF (DATOPE) CALL GVSTTU (DATLOG,BIGLIN)



      IF (NUM.LE.3) THEN
         VNAP=0.01
         GOTO 998
      END IF



      CALL WIFPUSHPPP (465,0)
      VNAP=ION_VALENCY(ION)
      CALL WIFPOPPPP (465)
      IF (VNAP.LT.0.01) GOTO 998



      VNAP=VNAP*6.0/FLOAT(NUM)
      CALL ION_WRIT_TEXT (IUNIT,'?ION516',VNAP,' ')










  998 CONTINUE


      RETURN
      END   
      REAL FUNCTION ION_VALENCY(ION)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'CNTINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       ION, I, IERR
      REAL          RJ, N, R0, IONDST, DIV
      LOGICAL       GVFIBN







      ION_VALENCY=0.0



      IF (.NOT.GVFIBN(NUMCONIAT,1,20)) THEN
         CALL GVSTTI ('ERROR. NUMCONIAT in ION_VALENCY=',NUMCONIAT)
         GOTO 998
      END IF



      CALL ION_SET_PAR (R0,N,DIV,IERR)
      IF (IERR.NE.0) GOTO 998



      DO 10 I=1,NUMCONIAT
         RJ=IONDST(ION,I)
         ION_VALENCY=ION_VALENCY+WEIGHT(CONIAT(I))*((RJ/R0)**N)
 10   CONTINUE



      IF (WIFPAR(465).EQ.0) THEN
         ION_VALENCY=ION_VALENCY/DIV
      ELSE
         ION_VALENCY=(6.0*ION_VALENCY)/(DIV*FLOAT(NUMCONIAT))
      END IF



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE ION_ENV (IUNIT,ION,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DATBAS.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'CNTINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IUNIT, ION, IERR, WITHOUT
      LOGICAL       SYMON








      IERR=0
      CALL GVSTTR ('Analyzing environment up to:',IONHGH)
      IF (WIFPAR(590).EQ.0) THEN
         CALL GVSTT6 ('Presently, symmetry is switched OFF')
         SYMON=.FALSE.
      ELSE
         CALL GVSTT6 ('Presently, symmetry is switched ON')
         SYMON=.TRUE.
      END IF







      CALL WIFPUSHPPP (590,0)
      CALL ENVTOT
      CALL SYMIPG (IERR,' ')

      CALL SYMNEA

      CALL FCONAT (ION,1.0)

      CALL FCONRED (ION,IONHGH)

      CALL FCONREC




      IF (.NOT.SYMON) THEN
         CALL PRP208 ('?M4253',NUMCONIAT)
         CALL GVSTTI ('?M4253',NUMCONIAT)
         IF (IUNIT.NE.6) CALL GVSTUI (IUNIT,'?M4253',NUMCONIAT)
      ELSE
         CALL PRP208 ('?M4253A',NUMCONIAT)
         CALL GVSTTI ('?M4253A',NUMCONIAT)
         IF (IUNIT.NE.6) CALL GVSTUI (IUNIT,'?M4253A',NUMCONIAT)
      END IF
      WITHOUT=NUMCONIAT
      CALL WIFPOPPPP (590)



      CALL WIFPUSHPPP (590,1)
      CALL ENVTOT
      CALL SYMIPG (IERR,' ')
      CALL SYMNEA
      CALL FCONAT (ION,1.0)
      CALL FCONRED (ION,IONHGH)
      CALL FCONREC



      WIFPAR(455)=NUMCONIAT-WITHOUT
      IF (.NOT.SYMON) THEN
         IF (NUMCONIAT.GT.WITHOUT) THEN
            CALL GVSTTI ('?M4300',NUMCONIAT)
            IF (IUNIT.NE.6) CALL GVSTUI (IUNIT,'?M4300',NUMCONIAT)
            IF (DATOPE) CALL GVSTUI (DATLOG,'?M4300',NUMCONIAT)
         ELSE
            CALL GVSTT6 ('?M4299')
            IF (IUNIT.NE.6) CALL GVSTTU (IUNIT,'?M4299')
            IF (DATOPE) CALL GVSTTU (DATLOG,'?M4299')
         END IF
      ELSE
         IF (NUMCONIAT.GT.WITHOUT) THEN
            CALL GVSTTI ('?M4300',NUMCONIAT)
            IF (IUNIT.NE.6) CALL GVSTUI (IUNIT,'?M4300',NUMCONIAT)
            IF (DATOPE) CALL GVSTUI (DATLOG,'?M4300',NUMCONIAT)
         ELSE
            CALL GVSTT6 ('?M4299')
            IF (IUNIT.NE.6) CALL GVSTTU (IUNIT,'?M4299')
            IF (DATOPE) CALL GVSTTU (DATLOG,'?M4299')
         END IF
      END IF
      CALL WIFPOPPPP (590)



      IF (WIFPAR(590).LE.0) THEN
         CALL ENVTOT
         CALL SYMIPG (IERR,' ')
         CALL SYMNEA
         CALL FCONAT (ION,IONHGH)
         CALL FCONRED (ION,IONHGH)
         CALL FCONREC
      END IF



      IF (NUMCONIAT.LE.0) THEN
         IERR=1
         GOTO 998
      END IF



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE IS_ION_OK (ION,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       NFND, ION, IERR
      REAL          WTOT
      LOGICAL       SPOS







      IERR=0
      CALL ION100 (ION,SPOS,WTOT,NFND)



      IF (WTOT.LT.0.8.OR.XBFACT(ION).GT.80.0) THEN
         CALL GVSTTR2 ('?M4302',WTOT,XBFACT(ION))
         IERR=1
      END IF 





      RETURN
      END   
      SUBROUTINE ION_ANAL_1_LIG (ION,NUM,IUNIT,DONE)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       ION, NUM, IUNIT
      REAL          DIST, IONDST, DU
      LOGICAL       DONE







      DU=0.0
      DONE=.FALSE.



      IF (NUM.NE.1) GOTO 998









      DIST=IONDST(ION,1)
      CALL ION105 (IUNIT,'?M4896',DIST,DU,DU,DU,DU,DU,DU)



      CALL GVSSTX (PACTYP,'1.')
      CALL ION109 (ION)
      DONE=.TRUE.



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE ION_ANAL_2_LIG (ION,NUM,IUNIT,DONE)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       ION, NUM, IUNIT
      REAL          ANGL, IONANG, D1, D2, IONDST, DU
      LOGICAL       DONE







      DONE=.FALSE.
      DU=0.0



      IF (NUM.NE.2) GOTO 998









      D1=IONDST(ION,1)
      D2=IONDST(ION,2)
      CALL ION105 (IUNIT,'?M4898',D1,D2,DU,DU,DU,DU,DU)



      ANGL=IONANG(1,ION,2)
      CALL GVSTUR (IUNIT,'?M4901',ANGL)







      CALL GVSSTX (PACTYP,'2.')
      CALL ION109 (ION)
      DONE=.TRUE.



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE ION_SET_JR

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       I







      CALL GVSIT0 (JR,10)
      CALL GVSRT0 (XYZJR,3*10)




      CALL GVSCPI (JR,CONIAT,10)

      DO 10 I=1,NUMCONIAT
         CALL IONXYZ (XYZJR(1,I),I)

 10   CONTINUE





      RETURN
      END   
      SUBROUTINE IONXYZ (XYZSOU,IJR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'CNTINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IJR, ISYM
      REAL          XYZSOU(3)







      CALL GVSRT0 (XYZSOU,3)
      IF (IJR.GT.NUMCONIAT) THEN
         CALL GVSTTI2 ('?ION538',IJR,NUMCONIAT)
         CALL GVSKIL
         GOTO 998
      END IF



      ISYM=CONSYMAT(IJR)
      XYZSOU(1)=XCOORD(CONIAT(IJR))
      XYZSOU(2)=YCOORD(CONIAT(IJR))
      XYZSOU(3)=ZCOORD(CONIAT(IJR))



      CALL GVSMPV (XYZSOU,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE ION_SHOTYP

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'ESPACE.INC'







      IF (IONTYP.EQ.' *'.OR.IONTYP.EQ.'* ') THEN
         CALL GVSTTB ('?M5173')
         CALL GVSSTX (IONTYP,'**')
      END IF



      IF (IONTYP.EQ.'**') THEN
         CALL GVSTT6 ('?M5174')
      ELSE
         CALL GVST6C ('?M5175',IONTYP,.TRUE.)
      END IF   





      RETURN
      END   
      LOGICAL FUNCTION ION_USE(IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SUGARS.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IAA, ION
      LOGICAL       WIFIRMM, HASVIO, ION103







      ION_USE=.FALSE.
      ION=PNTAAS(IAA)



      IF (.NOT.WIFIRMM(IAA)) GOTO 998



      IF (IONTYP.NE.'**'.AND.ONESAT(ION)(1:2).NE.IONTYP) GOTO 998



      IF (.NOT.POLION) THEN
         IF (ION103(6,ION)) THEN
            CALL GVSNL6 (1)
            CALL SHOIAA (IAA)
            CALL GVSTT6 ('?M4247')
            GOTO 998
         END IF
      END IF



      IF (.NOT.HASVIO(ION)) GOTO 998



      ION_USE=.TRUE.



  998 CONTINUE


      RETURN
      END   
      LOGICAL FUNCTION HASVIO(ION)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ION, IAA, NUMTYP, I
      LOGICAL       CH4EQCH4
      CHARACTER*2   CROW(20)







      HASVIO=.FALSE.



      IAA=ATIAA(ION)
      IF (CH4EQCH4(ONESA3(IAA),'NH4 ').AND.
     +    ONESAT(ION)(1:2).EQ.' N') THEN
         HASVIO=.TRUE.
         GOTO 998
      END IF



      CALL ION113 (CROW,NUMTYP)
      DO 10 I=1,NUMTYP
         IF (ONESAT(ION)(1:2).EQ.CROW(I)) THEN
            HASVIO=.TRUE.
            GOTO 998
         END IF
 10   CONTINUE



  998 CONTINUE


      RETURN
      END
