	PARAMETER(NMA=50001)
 	character NOM*10,YN*2,LIN*80
	REAL*4 BLAM(NMA),DINST(NMA)
        character*80 fichier1,fichier2,fic
        character*256 line
        REAL*4 TR(6)/0.,1.,0.,0.,0.,1./
c
	CALL PGBEGIN(0,'spectre.ps/PS',1,5)
        do n=1,70
	ALAMC=3000+(n-1)*100
        ALAMF=ALAMC+99.
	NRET=0
	IF(ALAMC.LT.10000)CALL VISIB(ALAMC,ALAMF,NRET,JK,BLAM,DINST)
	IF(ALAMC.GE.10000)CALL INFRA(ALAMC,ALAMF,NRET,JK,BLAM,DINST)
	IF(NRET.EQ.1) THEN
        CALL PGEND
        STOP 'ERREUR'
        ENDIF
	NOM='ATLASATLAS'
C	XMIN=ALAMC
C	XMAX=ALAMF
	XMIN=BLAM(1)
	XMAX=BLAM(JK)
	YMIN=0.
	IF(ALAMC.GE. 10000.)YMIN=-100.
	YMAX=10000.
C	PRINT *,' XMIN,ALAMC,XMAX,ALAMF',XMIN,ALAMC,XMAX,ALAMF
        CALL PGSCI(1)
        CALL PGSCH(2.0)
        CALL PGADVANCE
        CALL PGVPORT(0.,1.,0.25,0.95)
        CALL PGWINDOW(XMIN,XMAX,YMIN,YMAX)
	CALL PGBOX('ABCINT',0.,0,'ABC',0.,0)
	CALL PGLINE(JK,BLAM,DINST)
	enddo
        CALL PGEND
 	stop
        end

	SUBROUTINE VISIB(ALAMC,ALAMF,NRET,JK,BLAM,DINST)
	PARAMETER(NMA=50001)
 	character*4 ent(513),ENT2(13),don(500),QA
	REAL*4 BLAM(NMA),DINST(NMA)
	NRECL=2048
	I1=1
	I2=3
	ILF1=512
	ILF2=12
	open(unit=11,recl=2048,readonly,STATUS='old',name='atlasvi.dat')

	DO IJ=1,8
	read(11,100)(ent(I),I=1,ILF1)
C	PRINT *,ENT(2)
	ENDDO

	JK=0
	DO 12 IJ=1,10000
	read(11,100,END=5)(ent2(I),I=1,ILF2),DON
C	PRINT *,ENT2(I1),ENT2(I2)
	DECODE(4,106,ENT2(I1))ALAMI
	IF(IJ.EQ.1.AND.ALAMC.LT.ALAMI)THEN
	IF(ALAMF.LE.ALAMI)THEN
	NRET=1
	RETURN
	ENDIF
	ALAMC=ALAMI
	ENDIF
	QA=ENT2(I2)
C	PRINT *,' QA',QA
	DECODE(2,107,QA(1:2))DLAMI
C	PRINT *,ALAMI,DLAMI
	IF(JK.GT.0)GO TO 55
	IF(ALAMC.GE.ALAMI+0.500*DLAMI)GO TO 12
C	PRINT *,'ALA',ALAMI,DLAMI
55	DO IL=1,500
	HLAM=ALAMI+(IL-1.)*DLAMI*0.001
	IF(HLAM.GE.ALAMC)THEN
	IF(HLAM.GT.ALAMF)GO TO 5
	JK=JK+1
	BLAM(JK)=HLAM
	DECODE(4,106,DON(IL))DINST(JK)
	IF(JK.EQ.NMA)GO TO 5
	ENDIF
	ENDDO
12	CONTINUE
100     format(513A4)
110     format(1x,I5,5X,a)
111     format(1x,a)
106     format(F4.0)
107     format(F2.0)
5	IF(JK.EQ.0)THEN
	CLOSE(11)
	NRET=1
	RETURN
	ENDIF 
C	PRINT 109,(LO,BLAM(LO),DINST(LO),LO=1,JK)
	RETURN
	END



	SUBROUTINE INFRA(ALAMC,ALAMF,NRET,JK,BLAM,DINST)
	PARAMETER(NMA=50001)
	REAL*4 BLAM(NMA),DINST(NMA),BW(NMA),AIR(NMA)
	REAL*8 Z,AN,XX
	INTEGER IR(16)
	CHARACTER LINE*80
	OPEN(UNIT=11,READONLY,STATUS='OLD',NAME='atlasir.dat')
	AN=1.E+08/1.000274
	NRET=0
	DO I=1,158
	READ(11,100)LINE
C	PRINT *,LINE
	ENDDO
100	FORMAT(A)
	WF=AN/ALAMC
	WC=AN/ALAMF
	JK=0
	DO 12 IJ=1,10000
      READ(11,3800,end=5) NREC,WREF,DELW,INOISE,IOBS,SWITCH                       
 3800 FORMAT(I5,F15.4,F10.4,6X,I4,I5,F15.4)                                     
C	PRINT *,NREC,WREF,DELW
	ALAMI=WREF
	IF(ALAMI+10. .LE.WC)GO TO 13
C	PRINT *,' ZAZA'
C	PRINT *,NREC,WREF,DELW
      DO 4000 J=1,157                                                           
      K=J*16-15                                           
      READ(11,3900) (IR(II),II=1,16)                                        
 3900 FORMAT(16I5)
C	PRINT 3900,IR
	IFF=16
	IF(J.EQ.157)IFF=4
 	DO 66 II=1,IFF
	HLAM=ALAMI+(K+II-2)*DELW
	IF(HLAM.GT.WF)GO TO 5
	IF(HLAM.LT.WC)GO TO 66
	JK=JK+1
	BW(JK)=HLAM
	AIR(JK)=IR(II)
	IF(JK.EQ.NMA)GO TO 5
66	CONTINUE
 4000 CONTINUE  
	GO TO 12
13	DO I=1,157
	READ(11,100)LINE
C	PRINT *,LINE
	ENDDO
12	CONTINUE
5	CONTINUE
	IF(JK.EQ.0)THEN
	NRET=1
	CLOSE(11)
	RETURN
	ENDIF 
C	PRINT 109,(LO,BLAM(LO),DINST(LO),LO=1,JK)
	DO IU=1,JK
	Z=(BW(JK-IU+1)/10000.)**2
	AN=1.0D0+6.4328D-05+0.0294981D0/(146.D0-Z)+0.2554D-03/(41.D0-Z)
	AN=1.E+08/AN
	XX=AN/BW(JK-IU+1)	
	BLAM(IU)=XX
	DINST(IU)=AIR(JK-IU+1)
	ENDDO
	CLOSE(11)
	RETURN
 	END

      subroutine length(line,lcar)
      character*(*) line
      l=len(line)
      lcar=0
      do i=l,1,-1
        if(line(i:i).ne.' ') then
          lcar=i
          return
        endif
      enddo
      end   
