! **********************************************************************
      SUBROUTINE spectra
! **********************************************************************
      USE gms
      use communicate
      IMPLICIT REAL*8 (a-h,o-z)
      CHARACTER*7 sspecfile(0:2) 
      CHARACTER*4 charfoo
      REAL(8), DIMENSION(nlines) :: spec_aux1
      REAL(8), DIMENSION(nlines) :: wavelen
      REAL(8), DIMENSION(nlines) :: avoigt
      REAL(8), DIMENSION(nlines) :: tint  ! Non-Broaden line intensity
      REAL(8), DIMENSION(4001) :: profile 
      character(len=70) :: envstring
      DATA iprtflag/0/
      SAVE iprtflag

! ---------------------------------
! -- Diagnostics
!     INTEGER           :: unitnum
!     CHARACTER(len=30) :: ctemp
!     CHARACTER(len=3)  :: cagain
!     DATA iagain /0/
!     SAVE iagain
!     iagain=iagain+1
!     write(cagain,'(i3.3)') iagain
! ---------------------------------
     if(me.ne.0)then
! ---------------------------------------------------------------
! -- Diagnostics
!        envstring = 'WORKDIR'
!        unitnum=89
!        ctemp = 'diag'//trim(adjustl(get_cmytid()))//"."//cagain
!        call openf(unitnum,ctemp,envstring)
! ---------------------------------------------------------------
      src_lineshape=1.0d-14
      endif

      sspecfile(0)='sspecLi'
      sspecfile(1)='sspecAg'
      sspecfile(2)='sspecPt'
      IF(iprtflag.EQ.1)THEN
        OPEN(unit=88,file='/home/manolo/mac/'//sspecfile(me))
      ENDIF
      open(90,file='/tmp/mac/norm')
      stephnu=(hnu2-hnu1)/4000.0
      do k=1,4001
         specwavlen(k)=hnu1+stephnu*(k-1)
      enddo
      DO i=1,iradat
        IF(me.eq.0)then  ! Li only
        if((i.eq.1).or.(i.eq.4).or.(i.eq.7).or.(i.eq.10.).or.(i.eq.13))then
           do k=1,4001
              hnup=hnu1+stephnu*(k-1)
              levnum=i
              call get_starkprofiles(levnum,src_rNe,hnup,val,workdir) 
              src_lineshape(i,k)=val 
           enddo
           profile(:)=src_lineshape(i,:)
         endif
         ENDIF 
       ENDDO                  
       IF(iprtflag.EQ.1)THEN
         DO i=1,iradat
            DO k=1,4001
              profile(k)=src_lineshape(i,k)
            ENDDO  
         ENDDO 
         DO k=1,specgrid
           WRITE(88,900) specwavlen(k),(src_lineshape(i,k), i=1,iradat)
         ENDDO
         iprtflag=0
         CLOSE(88)
       ENDIF
!D    close(89)
900   FORMAT((1x,e12.5),500(2x,e12.5)) 
      END SUBROUTINE SPECTRA
