C
C                        MOLLER_LEVELS.FOR
C*********************************************************************
C 		    v1.1, 20/08/1997, R.Capote
C*********************************************************************
C     This code is a modified version of the original one,
C     written by P.Moller, and provided with the SPL database(moller_levels.dat).
C     AUTHOR of the MODIFIED VERSION: Dr.R.Capote,
C     See capote_micro.for(sect.5.3 of the RIPL) for contact data.
C
C     It allow to extract single particle scheme from MOELLER-NIX SPL
C     database(moller_levels.dat) in the format required by the 
C     capote_micro.for(Sect.5.3) and obninsk_micro.for(Supplement)codes
C     for microscopical level density calculations.
C
C     INPUT FROM THE CONSOLE: Number of nucleus to retrieve SPL scheme
C                             Z and N for each requested nucleus
C     OUTPUT: SINGLE PARTICLE SPECTRA according to the Z,A numbers
C             (The extension of the output files is SPE)
C
C     REMARK:
C     This program assumes that file moller_levels.dat exists in the
C     same directory, where you are running this program. !!!!
C
      PROGRAM DENS_INP
      CHARACTER CTMP*1,CTMP2*2,FOUT*7,CTMP3*3
C     ,FNAME*3,FNAME1*2 
      DIMENSION IZT(20),INT(20),A(16),ILL(20),FOUT(20),DEF(6)
      WRITE(6,*) 'HOW MANY NUCLEUS TO GET SP DATA? =>'
      READ(5,*) NMAS
      IF(NMAS.LT.1) STOP ' SHOULD BE AT LEAST ONE NUCLEUS'
      IF(NMAS.GT.20) STOP ' YOU SHOULD ASK DATA FOR LESS THAN 20 NUCLEI'
      WRITE(6,*) 'INPUT Z,N =>'
      READ(5,*)(IZT(J),INT(J),J=1,NMAS)
      WRITE(6,103)(IZT(J),INT(J),J=1,NMAS)
      DO I=1,NMAS
        IA=INT(I)+IZT(I)
        IF(IZT(I).GT.9) THEN
         WRITE(CTMP2,'(I2)') IZT(I)
         FOUT(I)='Z'//CTMP2
         IL=3
        ELSE
         WRITE(CTMP,'(I1)') IZT(I)
         FOUT(I)='Z'//CTMP
         IL=2
        ENDIF
        IF(IA.GT.99) THEN
         WRITE(CTMP3,'(I3)') IA
         FOUT(I)=FOUT(I)(1:IL)//'A'//CTMP3
         IL=IL+4
        ELSE
         IF(IA.GT.9) THEN
           WRITE(CTMP2,'(I2)') IA
           FOUT(I)=FOUT(I)(1:IL)//'A'//CTMP2
           IL=IL+3
         ELSE
           WRITE(CTMP,'(I1)') IA
           FOUT(I)=FOUT(I)(1:IL)//'A'//CTMP
           IL=IL+2
         ENDIF
        ENDIF                                
        ILL(I)=IL
      ENDDO
  103 FORMAT(' REQUESTED    Z    N'/(10X,2I5))
      IREQ=0
      NINP=9
      NOUT=10
C     DO KR=1,14
C        IF(KR.GT.9) THEN
C         WRITE(CTMP2,'(I2)') KR
C         FNAME='A'//CTMP2
C         open(NINP,file=fname)
C        ELSE
C         WRITE(CTMP,'(I1)') KR
C         FNAME1='A'//CTMP
C         open(NINP,file=fname1)
C        ENDIF
      OPEN(NINP,file='moller_levels.dat')
C*******  ON TAPE NOUT STORES LEVELS SELECTED *************
  10  KMEMO=0
      READ(NINP,100,END=71)IZ,IN,IA
      DO 20 J=1,NMAS
      IF(IZ.EQ.IZT(J).AND.INT(J).EQ.IN)KMEMO=1
  20  CONTINUE
      IF(KMEMO.NE.0)IREQ=IREQ+1
      IF(KMEMO.NE.0)OPEN(NOUT,file=FOUT(IREQ)(1:ILL(IREQ))//'.SPE')
C     IF(KMEMO.NE.0)WRITE(NOUT,100)IZ,IN,IA,A(1),A(2),A(3)
C     IF(KMEMO.NE.0)WRITE(6,104)IZ,IN
C     READ(NINP,101)A
      IF(KMEMO.NE.0)THEN
        READ(NINP,*) DEF(1),DEF(2),DEF(3)                                     
        READ(NINP,*) DEF(4),DEF(5),DEF(6)                                     
      ELSE
        READ(NINP,101) A
        READ(NINP,101) A
      ENDIF
      IF(KMEMO.NE.0)WRITE(NOUT,1100)IZ,IN,IA,DEF
      IF(KMEMO.NE.0)WRITE(6,1104)IZ,IN,DEF
      IF(KMEMO.EQ.0) GO TO 31
      AIA=1.0/FLOAT(IA)**0.33333333
      FP=31.08*AIA
      FN=35.37*AIA 
C
C     NEUTRON LEVELS
C      
   31 READ(NINP,100) NUM
      IF(KMEMO.NE.0)WRITE(NOUT,100)NUM
      IF(KMEMO.NE.0)WRITE(6,106)NUM
      DO 9 I=1,NUM
      READ(NINP,121) E,IJ
      IF(KMEMO.EQ.0) GO TO 9
C     WRITE(6,121) E,IJ
C     E=E/FN
C     IF(I.EQ.1) E0=1.5-E
C     E=E+E0
      S=IJ/2.0
      PI=SIGN(1.0,S)
      S=ABS(S)
      WRITE(NOUT,122) E,S,PI
   9  CONTINUE
C
C     PROTON LEVELS
C      
      READ(NINP,100) NUM
      IF(KMEMO.NE.0)WRITE(NOUT,100)NUM
      IF(KMEMO.NE.0)WRITE(6,106)NUM
      DO 19I=1,NUM
      READ(NINP,121) E,IJ
      IF(KMEMO.EQ.0) GO TO 19
C      WRITE(6,121) E,IJ
C      E=E/FP
C      IF(I.EQ.1) E0=1.5-E
C      E=E+E0
      S=IJ/2.0
      PI=SIGN(1.0,S)
      S=ABS(S)
      WRITE(NOUT,122) E,S,PI
   19 CONTINUE
      IF(KMEMO.NE.0) CLOSE(NOUT,STATUS='KEEP')   
      IF(IREQ.GE.NMAS)GOTO 77
      GOTO 10
C  71 IF(KR.EQ.14) WRITE(6,111)
   71 WRITE(6,111)
      CLOSE(NINP)
C     ENDDO
C  70 CONTINUE
   77 CLOSE(NINP)
      STOP
  100 FORMAT(3I10)
 1100 FORMAT(3(I3,1X),6(E10.4,1X))  
  101 FORMAT(16A4)
  121 FORMAT(F10.4,I10)
  122 FORMAT(E16.6,F10.1,F5.0)                            
 1104 FORMAT(' SELECTED    Z    N'/(9X,2I5/10X,'DEF=',6(E10.4,1X))/)  
  104 FORMAT(' SELECTED    Z    N'/(9X,2I5))
  106 FORMAT(' NUMBER OF LEVELS ',I4)
  111 FORMAT(5X'  E N D   O F   T A P E S   ! ! ! ! ! ! ',/,
     X5X,'  SOME REQUESTED NUCLEI NOT FOUND')
      END