SUBROUTINE SWITCH(INITM)
C     ========================
C
C     Procedure for evaluating the collisional-radiative switching
C     parameter lambda(R), denoted here CRSW(ID);
C     Original procedure suggested by Hummer and Voels,
C     Astron. Astrophys. 192, 279, 1988, was modified here by a
C     possibility of considering depth dependent switching parameter CRSW
C
C     Parameters SWPFAC, SWPLIM, SWPINC, and ICRSW are input
C     parameters, having the meaning:
C
C     ICRSW   = 0  - collisional-radiative switching not considered
C             > 0  - collisional-radiative switching is considered
C     SWPFAC  - initial CRSW = SWPFAC * min(collis.rate/rad.rate)
C     SWPLIM  - has the meaning: if CRSW > SWPLIM, then CRSW = 1
C     SWPINC  - CRSW(actual) = CRSW(previous) * SWPINC
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      DIMENSION SWTCH(MDEPTH)
C
      IF(ICRSW.EQ.0) RETURN
      IF(INITM.EQ.0) GO TO 10
C
C     Before the first iteration of complete linearization
C     initialisation of the collisional-radiative switching
C     parameters, as described by Hummer and Voels,
C     Astron. Astrophys. 192, 279, 1988;
C     modified here by considering depth-dependent swiching
C     parameter lambda(R) - denoted here CRSW(ID)
C
      SWMIN=UN
      DO ID=1,ND
         SWTCH(ID)=UN
         DO ITR=1,NTRANS
            C=COLRAT(ITR,ID)
            IF(RRU(ITR,ID).NE.0.) THEN
C
C     upward rates
C
               SWU=C/RRU(ITR,ID)
C
C     downward rates
C
               IF(LINE(ITR)) THEN
                  SWD=C*EXP(HK*FR0(ITR)/TEMP(ID))/RRD(ITR,ID)
                ELSE
                   SWD=C/RRD(ITR,ID)
               END IF
C
C     minimum value
C
               IF(SWU.LT.SWTCH(ID)) SWTCH(ID)=SWU
               IF(SWD.LT.SWTCH(ID)) SWTCH(ID)=SWD
            END IF
         END DO
         IF(SWTCH(ID).LT.SWMIN) SWMIN=SWTCH(ID)
      END DO
C
      DO ID=1,ND
         IF(ICRSW.EQ.1) THEN
            CRSW(ID)=SWMIN*SWPFAC
          ELSE
            CRSW(ID)=SWTCH(ID)*SWPFAC
         END IF
         IF(CRSW(ID).GT.SWPLIM) CRSW(ID)=UN
      END DO
      WRITE(6,601) (CRSW(ID),ID=1,ND)
      RETURN
C
C     After second and further iterations of complete linearization
C     evaluation of new collisional-radiative switching parameters
C     by multiplication of the previous ones by a prechosen factor
C     SWPINC
C
   10 CONTINUE
      DO ID=1,ND
         CRSW(ID)=CRSW(ID)*SWPINC
         IF(CRSW(ID).GT.SWPLIM) CRSW(ID)=UN
      END DO
      WRITE(6,601) (CRSW(ID),ID=1,ND)
  601 FORMAT(1P8D10.3)
      RETURN
      END