
**************************************
C     PROGRAM SCRNYMOD.f
C*************************************
      COMMON/EN/EN(251),P(251),B(251),DE(251)
      COMMON/PFLUX/FDIF(251),FINT(251)
      COMMON/SUNSP/W(600),T(600),NW                                                                                                                                                                                                       
      COMMON/PARAMP/Cp(7,10),Gp(7,10),AGp(7,10),BGp(7,10)
      COMMON/PARAMH/CH(7,10),GH(7,10),AGH(7,10),BGH(7,10)                                                                                                                                                                                                             COMMON/EN/EN(251),P(251),B(251),DE(251)
      COMMON/BASE/E0(13),P0(7)
      COMMON/PROB/PB(801),FXPRB(13,801),FPB(13,7),FF(801)
      COMMON/ZZZ/PROB(7),ANSEP
      COMMON/DISTFUN/FX30DST(801)
      COMMON/PAR/NE,NPB,NEN,NF,NEI(13),DM(12)
      COMMON/NNN/NOM(13),SS(13)
      COMMON/FLUX/MNX
      COMMON/PARFIN/C(7),G(7),AG(7),BG(7)
      COMMON/ZRZ/NZ,RZ(28),AQ(28)  
      COMMON/ENI/ENI(13)
      COMMON/NUMB/BN(10),PRB(7)
      DIMENSION PP(4,7),CC(7,10)
      DATA BN/1.,2.,4.,8.,16.,32.,64.,128.,256.,512./
      DATA PRB/0.9,0.7,0.5,0.3,0.1,0.032,0.01/
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC CHOISE, WHAT SEP ION SPECTRA IS NEEDED TO CALCULATE
CCCCC    POSSIBLE ELEMENTS -1,2,     6,7,8,  10,11,12,13,14,15,16,17,18,19,
CCCCC                       20,   22,  24,  26,  28 (INDICATOR BOARD - ID) 
CC      NZ=26
	READ *,NZ

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC CHOISE, YOU NEED IN FLUENCE (MNX=1) OR PEAK FLUX (MNX=2) CALCULATION
CCCCC    FLUENCE (MNX=1) OR PEAK FLUX (MNX=2)   - ID  CCCCCCCCCCCCCCCCCCCCCCCC
CC      MNX=1
	READ *,MNX

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC CHOISE, THE PROBABILITY WITH WHAT THE GIVEN SPECTRA IS EXCEEDED
CCCCC IF PRB=0.1 NPB=1; IF PRB=0.7 NPB=2; IF PRB=0.5 NPB=3;
CCCCC IF PRB=0.3 NPB=4; IF PRB=0.1 NPB=5; IF PRB=0.032 NPB=6;
CCCCC IF PRB=0.01 NPB=7
CC      NPB=5
	READ *,NPB

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC CHOISE, THE TIME INTERVAL NEEDED (YEAR, MONTH)
CCCCC TIME INTERVAL (YEAR, MONTH)
CCCCC T START  YEAR FROM 1969, 1970....)  - ID   (JAN, VEBR, MART.......) - ID
CC      TY1=1988.
CC      M1=3
	READ *, TY1
	READ *, M1


CCCCCC T FINISH     BIS ...2017, 2018) - ID (JAN, FEBR, MART, ......... ID)   
CC      TY2=1989.
CC      M2=12
	READ *, TY2
	READ *, M2

CCCCC      DETERMINATION OF THE MEAN ACCEPTED SEP NUMBER AS MODEL PARAMETER
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC DETEMINATION THE MODEL PARAMETER ANSEP (NUMBER EVENTS F>10**5)
      CALL NSEPW(TY1,M1,TY2,M2,AN)     
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC LIMITATIONS
      IF(AN.LE.1.9.AND.NPB.LE.2)GOTO 777 
      IF(AN.LE.3.9.AND.NPB.LE.1)GOTO 777




CCCCC   DETERMINATION OF THE ARBITARY SCALES
      CALL ARBITARY(AN)

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC FOR PROBABILITIES: 0.9, 0.7, 0.5, 0.25, 0.1, 0.032 AND 0.01
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      DO 333 I=1,10
      PRINT 427,AN,BN(I)
  427 FORMAT(2F7.2)
      IF(BN(I).GE.AN)GOTO 334
  333 CONTINUE
  334 NN=I-1

      NC=0
  444 NC=NC+1 
      DO 7 J=1,7
      DO 1 I=1,10
      IF(NZ.GE.2)GOTO 31
      IF(NC.EQ.1)CC(J,I)=CP(J,I)     
      IF(NC.EQ.2)CC(J,I)=GP(J,I)
      IF(NC.EQ.3)CC(J,I)=AGP(J,I)      
      IF(NC.EQ.4)CC(J,I)=BGP(J,I)
      GOTO 1
   31 CONTINUE
      IF(NC.EQ.1)CC(J,I)=CH(J,I)     
      IF(NC.EQ.2)CC(J,I)=GH(J,I)
      IF(NC.EQ.3)CC(J,I)=AGH(J,I)      
      IF(NC.EQ.4)CC(J,I)=BGH(J,I)
    1 CONTINUE
      CN=BN(NN)
      CNN=BN(NN+1)
      IF(CC(J,NN+1).LT.CC(J,NN))GOTO 111
      PP(NC,J)=CC(J,NN)+(CC(J,NN+1)-CC(J,NN))*(ALOG10(AN)-ALOG10(CN))/
     *(ALOG10(CNN)-ALOG10(CN))
      GOTO 222
  111 CONTINUE
      PP(NC,J)=CC(J,NN+1)+(CC(J,NN)-CC(J,NN+1))*(ALOG10(CNN)-
     *ALOG10(AN))/(ALOG10(CNN)-ALOG10(CN))
  222 CONTINUE
    7 CONTINUE
      IF(NC.LT.4)GOTO 444
      DO 21 I=1,7
   21 PP(1,I)=10.**PP(1,I)

      IF(NZ.GT.2)GOTO 998
      IF(NZ.EQ.1)OPEN(UNIT=22,FILE='PARAMP.DAT')
      IF(NZ.GE.2)OPEN(UNIT=22,FILE='PARAMHE.DAT')
      WRITE(22,33)((PP(J,I),I=1,7),J=1,4)
   33 FORMAT(7E10.2)
      CLOSE(22)
      DO 838 IPB=1,7
      A1=PP(1,IPB)
      A2=PP(2,IPB)
      A3=PP(3,IPB)          
      A4=PP(4,IPB)          
      CALL SPECTERC(A1,A2,A3,A4)      
CCCCC OUTPUT OF INTEGRAL AND DIFFERENTIAL ENERFY SPECTRA
      IF(NZ.GE.2)GOTO 41
      IF(NPB.NE.IPB)GOTO 838
      IF(IPB.EQ.1)OPEN(UNIT=11,FILE='ENP1.DAT')
      IF(IPB.EQ.2)OPEN(UNIT=11,FILE='ENP2.DAT')
      IF(IPB.EQ.3)OPEN(UNIT=11,FILE='ENP3.DAT')
      IF(IPB.EQ.4)OPEN(UNIT=11,FILE='ENP4.DAT')
      IF(IPB.EQ.5)OPEN(UNIT=11,FILE='ENP5.DAT')
      IF(IPB.EQ.6)OPEN(UNIT=11,FILE='ENP6.DAT')
      IF(IPB.EQ.7)OPEN(UNIT=11,FILE='ENP7.DAT')
      GOTO 42
   41 CONTINUE
      IF(NZ.GT.2)GOTO 998
      IF(IPB.EQ.1)OPEN(UNIT=11,FILE='ENHe1.DAT')
      IF(IPB.EQ.2)OPEN(UNIT=11,FILE='ENHe2.DAT')
      IF(IPB.EQ.3)OPEN(UNIT=11,FILE='ENHe3.DAT')
      IF(IPB.EQ.4)OPEN(UNIT=11,FILE='ENHe4.DAT')
      IF(IPB.EQ.5)OPEN(UNIT=11,FILE='ENHe5.DAT')
      IF(IPB.EQ.6)OPEN(UNIT=11,FILE='ENHe6.DAT')
      IF(IPB.EQ.7)OPEN(UNIT=11,FILE='ENHe7.DAT')
   42 WRITE(11,545)(EN(I),FDIF(I),FINT(I),I=1,NEN,5)
      CLOSE(11)
  838 CONTINUE
  545 FORMAT(3E12.5)
      
      IF(NZ.EQ.1)OPEN(UNIT=41,FILE='PARP.DAT')
      IF(NZ.GE.2)OPEN(UNIT=41,FILE='PARHe.DAT')
      WRITE(41,341)(PROB(IPB),PP(1,IPB),PP(2,IPB),PP(3,IPB),PP(4,IPB),
     *IPB=1,NPB)
      CLOSE(41)

  341 FORMAT(2X,F7.4,2X,E11.4,2X,F7.4,2X,F7.4,2X,F7.4,E12.5)
      IF(NZ.LE.2) GOTO 999
  998 CONTINUE
      IF(NZ.GE.30)NZ=30
      GOTO(999,999,777,777,777,996,996,996,777,996,
     *     996,996,996,996,996,996,996,996,996,996,
     *     777,996,996,996,777,996,777,996,777,777),NZ
  996 CONTINUE
CCCCCC  CORRECTIONS FOR THE SPECTRAL PARAMETERS OF HEAVY YONS
CCCCCC  Correction of spectral coefficient D 
      Z=NZ
      DO 995 J=1,7
      IF(NZ.GE.6.AND.NZ.LE.8)S1=1./PRB(J)**(1.35E-06*Z**4.57)
      IF(NZ.GE.6.AND.NZ.LE.8)S2=9.39E-07*Z**4.6/PRB(J)**(0.026+0.0121*Z)
      IF(NZ.GE.10.AND.NZ.LE.17)S1=1./PRB(J)**(0.00297*Z**1.18)
      IF(NZ.GE.10.AND.NZ.LE.17)S2=0.00244*Z**1.122/PRB(J)**(0.1584
     *-0.0013*Z)
      IF(NZ.GE.18.AND.NZ.LE.28)S1=1./PRB(J)**(0.04*Z**0.588)
      IF(NZ.GE.18.AND.NZ.LE.28)S2=0.02854*Z**0.572/PRB(J)**(0.1215
     *-0.00129*Z)
      PP(1,J)=PP(1,J)*RZ(NZ)/RZ(2)*S1*AN**S2

CCCCCC  Correction of spectral INDEX AG
      IF(NZ.LE.17)DA=0.
      IF(NZ.GE.18)DA=(-0.0045-0.0054*ALOG(PRB(J)))*ALOG(AN)
      PP(3,J)=PP(3,J)+DA

CCCCCC  Correction of spectral coefficient BG
      IF(NZ.GE.10.AND.NZ.LE.17)G1=1.2E-04*Z-3.10E-04
      IF(NZ.GE.10.AND.NZ.LE.17)G2=9.4E-05*Z-3.72E-04
      IF(NZ.GE.18)G1=6.9E-05*Z+0.00233
      IF(NZ.GE.18)G2=8.26E-05*Z+9.05E-04
      IF(NZ.GE.10)PP(4,J)=PP(4,J)*AN**(G1-G2*ALOG(PRB(J)))
  995 CONTINUE

      OPEN(UNIT=22,FILE='PARAM8.DAT')
      WRITE(22,33)((PP(J,I),I=1,7),J=1,4)

      DO 738 IPB=1,7
      A1=PP(1,IPB)
      A2=PP(2,IPB)
      A3=PP(3,IPB)          
      A4=PP(4,IPB)          
      CALL SPECTERC(A1,A2,A3,A4)      
CCCCC OUTPUT OF INTEGRAL AND DIFFERENTIAL ENERFY SPECTRA
      
      IF(IPB.EQ.1)OPEN(UNIT=11,FILE='EN26Z1.DAT')
      IF(IPB.EQ.2)OPEN(UNIT=11,FILE='EN26Z2.DAT')
      IF(IPB.EQ.3)OPEN(UNIT=11,FILE='EN26Z3.DAT')
      IF(IPB.EQ.4)OPEN(UNIT=11,FILE='EN26Z4.DAT')
      IF(IPB.EQ.5)OPEN(UNIT=11,FILE='EN26Z5.DAT')
      IF(IPB.EQ.6)OPEN(UNIT=11,FILE='EN26Z6.DAT')
      IF(IPB.EQ.7)OPEN(UNIT=11,FILE='EN26Z7.DAT')
      WRITE(11,545)(EN(I),FDIF(I),FINT(I),I=1,NEN,5)
      CLOSE(11)
  738 CONTINUE      
      OPEN(UNIT=41,FILE='PARZ26.DAT')
      
      WRITE(41,341)(PROB(IPB),PP(1,IPB),PP(2,IPB),PP(3,IPB),PP(4,IPB),
     *IPB=1,NPB)
      CLOSE(41)
      GOTO 999

  777 CONTINUE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC  ID  -  THE SPECTRUM FOR THIS PARTICLES OR PROBABILITY IS NOT PERMITTED 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

  999 END
      
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCC DETERMINATION OF THE MODEL PARAMETER ANSEP
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE NSEPW(TY1,M1,TY2,M2,ANSEP)
      COMMON/PAR/NE,NPB,NEN,NF,NEI(13),DM(12)
      COMMON/SUNSP/WS(600),T(600),NW    
      DO 11 I=1,NW
      TT=I
   11 T(I)=1968.958333+0.083333*TT
      T1=TY1
      DO 1 I=1,M1
      IF(I.LT.M1)T1=T1+DM(I)/365.
      IF(I.EQ.M1)T1=T1+DM(I)/730.
    1 CONTINUE
      T2=TY2
      DO 2 I=1,M2
      IF(I.LT.M2)T2=T2+DM(I)/365.
      IF(I.EQ.M2)T2=T2+DM(I)/730.
    2 CONTINUE
      DO 3 I=1,NW
      IF(T(I).LT.T1.OR.T(I).GT.T2)GOTO 3
      WWM=WWM+WS(I)
    3 CONTINUE
      PRINT 545,T1,T2,TY1,M1,TY2,M2,WWM
  545 FORMAT(3F8.2,I3,F8.2,I3,F9.2)
CCCC  ANSEP - NO EVENTS F>10**5; BNSEP - NO EVENTS F>10**6 (>30 MeV)
      ANSEP=0.01354*WWM
      BNSEP=ANSEP/2.
      WWY=WWM/12.
      PRINT 4,ANSEP,BNSEP
    4 FORMAT(2F7.2)
      OPEN(UNIT=11,FILE='NNN.DAT')
      WRITE(11,4)ANSEP,BNSEP
      CLOSE(11)
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      SUBROUTINE SPECTERC(CP,GAMMA,ALPHA,AK)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      COMMON/EN/EN(251),P(251),B(251),DE(251)
      COMMON/PFLUX/FDIF(251),FINT(251)
      COMMON/PAR/NE,NPB,NEN,NPN,NEI(13),DM(12)
      COMMON/E30/EN0,P0,EN1,P1
      SSS=CP/(GAMMA*AK-1.)/(P(NEN)/P1)**(GAMMA*AK-1.)*P1/B(NEN)
      FINT(NEN)=SSS
      FDIF(NEN)=CP/(P(NEN)/P1)**(GAMMA*AK)/B(NEN)
      DO 22 I=1,NEN-1
      J=NEN-I
      GAM=GAMMA*AK
      IF(EN(J).LT.EN1.AND.EN(J).GT.EN0)GAM=GAMMA
      IF(EN(J).LT.EN0)GAM=GAMMA*(EN(J)/EN0)**ALPHA
           
      FDIF(J)=CP/(P(J)/P1)**GAM/B(J)
      SSS=CP/(P(J)/P1)**GAM*DE(J)/B(J)+SSS
      FINT(J)=SSS
   22 CONTINUE
  333 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      SUBROUTINE ARBITARY(ANSEP)
      COMMON/FLUX/MNX
      COMMON/EN/EN(251),P(251),B(251),DE(251)
      COMMON/PROB/PB(801),FXPRB(13,801),FPB(13,7),FF(801)
      COMMON/PAR/NE,NPB,NEN,NF,NEI(13),DM(12)
      COMMON/E30/EN0,P0,EN1,P1
      COMMON/ZRZ/NZ,RZ(28),AQ(28)

      DO 1 I=1,NEN
      T=I
      EN(I)=3.16228*10.**((T-1.)/100.)
      DE(I)=3.16228*(10.**((T-0.5)/100.)-10.**((T-1.5)/100.))
      P(I)=SQRT(EN(I)*(EN(I)+2.*938.))
      B(I)=P(I)/SQRT(P(I)**2+938.**2)
    1 CONTINUE

      EN0=30.0
      P0=SQRT(EN0*(EN0+2.*938.))
      EN1=79.4
      P1=SQRT(EN1*(EN1+2.*938.))

      IF(NZ.EQ.1)CZ=1.
      IF(NZ.EQ.2)CZ=0.01
      IF(NZ.GT.2)CZ=0.00001
      IF(MNX.EQ.1)CNM=1.
      IF(MNX.EQ.2)CNM=1.0E-06
      IF(ANSEP.LE.2.)CC=0.01*CNM*CZ
      IF(ANSEP.GT.2.AND.ANSEP.LE.8.)CC=1.*CNM*CZ
      IF(ANSEP.GT.8.AND.ANSEP.LE.32.)CC=10.*CNM*CZ
      IF(ANSEP.GT.32.AND.ANSEP.LT.128.)CC=100.*CNM*CZ
      IF(ANSEP.GE.128.)CC=1000.*CNM*CZ

      DO 2 I=1,NF
      T=I-1
      PB(I)=CC*10.**(T*.02)
      FF(I)=1.0E-04*10.**(T*0.02)*CNM
    2 CONTINUE
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      BLOCK DATA
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      COMMON/PARAMP/Cp(7,10),Gp(7,10),AGp(7,10),BGp(7,10)
      COMMON/PARAMH/CH(7,10),GH(7,10),AGH(7,10),BGH(7,10)
      COMMON/SUNSP/W(600),T(600),NW                                                                                                                                                                                                                                                                                                                                                                                                              
      DIMENSION W69(12),W70(120),W80(120),W90(120),
     *W00(120),W10(120)
      EQUIVALENCE(W(1),W69(1))
      EQUIVALENCE(W(13),W70(1))
      EQUIVALENCE(W(133),W80(1))
      EQUIVALENCE(W(253),W90(1))
      EQUIVALENCE(W(373),W00(1))
      EQUIVALENCE(W(493),W10(1))     
      COMMON/DISTF/GF,FPD,FN0,FX0
      COMMON/DISTG/G0,DG
      COMMON/DISTA/CA,GAF,GAG,DA
      COMMON/ZZZ/PROB(7),ANSEP
      COMMON/ENI/ENI(13)
      COMMON/PAR/NE,NPB,NEN,NF,NEI(13),DM(12)
      COMMON/ZRZ/NZ,RZ(28),AQ(28)
CCCRZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ RZ
      DATA RZ/1.,2.8E-03,0.,0.,0.,3.18E-05,7.56E-06,6.29E-05,0.,9.8E-06,
     *6.62E-07,1.22E-05,8.7E-07,8.63E-06,4.0E-08,1.65E-06,1.25E-08,
     *1.6E-07,2.6E-08,4.6E-07,0.,1.6E-08,0.,8.6E-07,0.,4.59E-06,0.,
     *2.48E-07/
CCCAQ AQ AQ AQ AQ AQ AQ AQ AQ AQ AQ AQ AQ AQ AQ AQ AQ AQ
      DATA AQ/0.,2.,2.,2.,2.,2.03,2.12,2.13,0.,2.30,2.44,2.38,2.55,2.39,
     *2.44,2.48,2.60,2.92,2.96,2.99,3.0,3.0,3.0,3.0,3.0,3.035,3.08,3.12/
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      DATA GF,FPD,FN0,FX0/1.32,0.12,8.0E09,9.3E03/
CCC   Distribution of the spectral indexes
      DATA G0,DG/0.76,0.15/
      DATA CA,GAF,GAG,DA/1.16,0.059,0.143,0.0777/
CCC   ENERGY THRESOLDS
C     NE - NUMBER OF THE ENERGY THRESHOLDS
C     NE=NF - NUMBER OF ENERGY SCALE INTERVALS
C     NPB - NUMBER OF CONFIDENCE LEVELS
C     NF - NUMBER OF THE FLUENCE INTERVALS

      DATA NE,NPB,NEN,NF,NW/13,7,251,801,600/
C     PROB - CONFIDENCE LEVELS (0.001=99.9%, 0.1=90%, 0.9=10%)
      DATA PROB/0.9,0.70,0.5,0.25,0.1,0.0316,0.01/
CCCCC DAYS OF MONTH DM(12)
      DATA DM/31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31./
C      DATA W49/
C     *136.6,134.5,133.2,133.2,134.8,136.0,134.4,130.0,124.4,121.0,119.6,
C     *118.0/                                                             1949
C      DATA W50/
C     *115.0,111.9,106.4,99.5,92.9,86.6,82.2,79.0,75.3,72.2,71.4,72.3,    1950
C     *71.7,69.5,69.8,70.7,70.2,69.8,68.6,66.3,63.3,59.2,53.0,46.8,       1951
C     *43.2,42.0,39.5,36.0,33.6,31.9,30.8,29.4,28.2,27.6,27.1,26.0,       1952
C     *24.1,21.6,19.9,18.9,17.4,15.2,12.8,11.5,11.2,10.4,8.8,7.4,         1953
C     *6.3, 5.6, 4.2, 3.4, 3.7, 4.2, 5.4, 7.2, 7.8, 7.9, 9.5,12.0,        1954
C     *14.2,16.4,19.5,23.4,28.8,35.1,40.1,46.5,55.5,64.4,73.0,81.0,       1955
C     *88.8,98.5,109.3,118.8,127.5,136.9,145.5,151.3,154.8,159.1,163.0,   1956
C     *167.6,
C     *173.6,175.5,177.6,184.3,188.8,191.2,194.7,196.1,197.3,199.5,200.8, 1957
C     *200.1,
C     *199.0,200.9,201.3,196.8,191.4,186.8,185.2,184.9,183.8,182.2,180.7, 1958
C     *180.,
C     *178.6,176.9,174.5,169.2,165.1,161.4,155.8,151.3,146.3,141.1,137.1, 1959
C     *132.5/
C      DATA W60/
C     *128.9,125.0,121.6,119.6,117.0,113.9,108.6,102.4,97.9,93.3,87.9,    1960
C     *83.7,
C     *80.2,74.8,68.9,64.3,60.1,55.8,53.1,52.5,52.3,51.4,50.5,48.7,       1961
C     *45.2,41.8,39.8,39.4,39.2,38.3,36.8,34.9,32.7,30.8,30.0,29.8,       1962
C     *29.4,29.8,29.7,29.0,28.7,28.2,27.7,27.2,26.9,26.0,23.8,21.3,       1963
C     *19.5,17.8,15.4,12.7,10.9,10.2,10.3,10.2, 9.9, 9.6,10.1,11.0,       1964
C     *11.7,12.0,12.5,13.6,14.6,15.0,15.5,16.4,17.4,19.7,22.3,24.5,       1965
C     *27.7,31.3,34.5,37.4,40.7,44.7,50.3,56.7,63.1,67.6,70.2,72.7,       1966
C     *75.0,78.8,82.2,84.6,87.5,91.3,94.1,95.3,95.3,95.0,97.1,100.6,      1967
C     *102.6,102.9,104.7,107.2,107.6,106.6,105.2,104.8,107.0,109.9,110.6, 1968
C     *110.1,
      DATA W69/
     *110.0,109.6,108.0,106.4,106.2,106.1,105.9,106.5,105.4,104.1,104.6, 1969
     *104.9/
      DATA W70/
     *105.6,106.0,106.2,106.1,105.8,105.3,103.8,101.0,97.2,93.9,89.4,    1970
     *84.1,
     *80.4,77.8,74.4,70.9,68.1,66.7,65.4,64.6,65.8,66.2,66.8,69.4,       1971
     *70.8,71.2,72.4,73.4,72.9,70.5,68.2,65.5,62.2,60.6,58.7,55.1,       1972
     *50.9,46.5,44.2,42.7,40.7,39.1,37.5,36.1,34.4,32.6,31.8,31.5,       1973
     *32.7,34.4,34.0,33.9,34.6,34.5,34.0,33.1,32.1,30.2,27.5,25.2,       1974
     *23.0,22.1,21.2,18.6,16.8,16.0,15.0,14.3,14.4,15.4,16.1,16.3,       1975
     *15.2,13.2,12.2,12.6,12.5,12.2,12.9,14.0,14.3,13.5,13.5,14.8,       1976
     *16.7,18.1,20.0,22.2,24.2,26.3,29.0,33.4,39.1,45.6,51.9,56.9,       1977
     *61.3,64.5,69.6,76.9,83.2,89.3,97.4,104.0,108.4,111.1,113.3,117.7,  1978
     *123.7,130.9,136.5,141.1,147.3,153.0,155.0,155.4,155.7,157.8,162.3, 1979
     *164.5/
      DATA W80/
     *163.9,162.6,160.9,158.7,156.3,154.7,152.8,150.3,150.1,150.2,147.7, 1980
     *142.7,
     *140.3,141.5,143.0,143.4,142.9,141.5,140.3,141.1,142.8,142.2,138.8, 1981
     *137.8,
     *137.0,133.3,129.2,124.3,119.9,117.3,115.2,109.4,101.0,95.7,94.7,   1982
     *94.6,
     *92.8,90.3,85.9,81.5,77.1,70.5,65.5,65.8,67.9,68.2,66.8,64.0,       1983
     *60.2,56.4,53.0,49.8,47.5,46.5,44.1,39.6,33.9,29.0,24.8,21.8,       1984
     *20.6,19.8,18.7,18.4,18.4,18.2,17.5,17.3,17.5,17.4,16.9,15.3,       1985
     *13.9,13.2,13.0,13.7,14.4,13.9,13.8,13.2,12.3,13.2,14.9,16.3,       1986
     *17.6,19.6,22.1,24.4,26.5,29.6,33.7,37.3,41.4,46.0,49.1,53.8,       1987
     *60.2,67.0,73.7,80.0,86.1,94.8,104.3,113.7,121.3,125.3,130.4,137.6, 1988
     *142.0,145.0,149.7,153.5,156.9,158.4,158.5,157.7,156.6,157.4,157.5, 1989
     *153.5/
      DATA W90/
     *150.6,152.9,152.0,149.3,147.0,143.8,140.6,140.5,142.1,142.1,141.7, 1990
     *143.9,
     *136.9,167.5,141.9,140.0,121.3,169.7,173.7,176.3,125.3,144.1,108.2, 1991
     *144.4,
     *150.0,161.1,106.7,99.8,73.8,65.2,85.7,64.5,63.9,88.7,91.8,82.6,    1992
     *59.3,91.0,69.8,62.2,61.3,49.8,57.9,42.2,22.4,56.4,35.6,48.9,       1993
     *57.8,35.5,31.7,16.1,17.8,28.0,35.1,22.5,25.7,44.0,18.0,26.2,       1994
     *24.2,29.9,31.1,14.0,14.5,15.6,14.5,14.3,11.8,21.1,9.0,10.0,        1995
     *11.5,4.4,9.2,4.8,5.5,11.8,8.2,14.4,1.6,0.9,17.9,13.3,              1996
     *5.7,7.6,8.7,15.5,18.5,12.7,10.4,24.4,51.3,23.8,39.0,41.2,          1997
     *31.9,40.3,54.8,53.4,56.3,70.7,66.6,92.2,92.9,55.5,74.0,81.9,       1998
     *62.0,66.3,68.8,63.7,106.4,137.7,113.5,93.7,71.5,116.7,133.2,       1999
     *84.6/

      DATA W00/
     *90.1,112.9,138.5,125.5,121.6,124.9,170.1,130.5,109.7,99.4,106.8,   2000
     *104.4,
     *95.6,80.6,113.5,107.7,96.6,134.0,81.8,106.4,150.7,125.5,106.5,     2001
     *132.2,
     *114.1,107.4,98.4,120.7,120.8,88.3,99.6,116.4,109.6,97.5,95.5,      2002
     *80.8,
     *79.7,46.0,61.1,60.0,54.6,77.4,83.3,72.7,48.7,65.5,67.3,46.5,       2003
     *37.3,45.8,49.1,39.3,41.5,43.2,51.1,40.9,27.7,48.0,43.5,17.9,       2004
     *31.3,29.2,24.5,24.2,42.7,39.3,40.1,36.4,21.9,8.7,18.0,41.1,        2005
     *15.3,4.9,10.6,30.2,22.3,13.9,12.2,12.9,14.4,10.5,21.4,13.6,        2006
     *16.8,10.7,4.5,3.4,11.7,12.1,9.7,6.0,2.4,0.9,1.7,10.1,              2007
     *3.3,2.1,9.3,2.9,3.2,3.4,0.8,0.5,1.1,2.9,4.1,0.8,                   2008
     *1.3,1.4,0.7,0.8,2.9,2.9,3.2,0.0,4.3,4.8,4.1,10.8/                  2009
      DATA W10/
     *13.2,18.8,15.4,8.0,8.7,13.6,16.1,19.6,25.2,23.5,31.5,35.6,         2010
cccccccccccccc  w predicted at NOAA  c  2010 nov 08  cccccccccccccccccccccccc
     *43.6,47.5,51.2,54.9,58.1,60.9,63.3,65.7,67.9,70.0,72.1,74.0,       2011
     *75.9,77.6,79.3,80.8,82.2,83.5,84.6,85.7,86.6,87.5,88.2,88.7,       2012
     *89.2,89.6,89.8,89.9,90.0,89.9,89.7,89.4,89.0,88.5,87.9,87.2,       2013
     *86.4,85.6,84.7,83.7,82.6,81.4,80.2,78.9,77.6,76.2,74.8,73.3,       2014
     *71.8,70.2,68.7,67.0,65.4,63.8,62.1,60.4,58.7,57.0,55.3,53.6,       2015
     *51.9,50.2,48.5,46.9,45.2,43.6,42.0,40.4,38.8,37.3,35.7,34.3,       2016
     *32.8,31.4,30.0,28.7,27.4,26.1,24.9,23.7,22.5,21.4,20.3,19.2,       2017
     *18.2,17.2,16.3,15.4,14.5,13.7,12.9,12.2,11.5,10.8,10.1,9.5,        2018
     *8.9,8.3,7.8,7.3,6.8,6.4,5.9,5.5,5.1,4.8,4.4,4.1/                   2019
     
      DATA Cp/2.646, 2.646, 2.646, 3.631, 4.709, 5.683, 6.304,
     *2.860, 2.860, 3.471, 4.417, 5.335, 6.095, 6.565,
     *3.001, 3.707, 4.283, 5.106, 5.830, 6.411, 6.772,
     *3.860, 4.517, 5.021, 5.681, 6.232, 6.663, 6.954,
     *4.694, 5.240, 5.639, 6.141, 6.551, 6.877, 7.106,
     *5.414, 5.847, 6.149, 6.519, 6.817, 7.064, 7.251,
     *6.042, 6.361, 6.579, 6.845, 7.059, 7.252, 7.396,
     *6.573, 6.800, 6.952, 7.140, 7.299, 7.444, 7.554,
     *7.021, 7.182, 7.291, 7.419, 7.536, 7.639, 7.726,
     *7.423, 7.530, 7.608, 7.699, 7.780, 7.855, 7.914/

      DATA Gp/5.754,  5.754,  5.754,  6.327,  6.448,  6.580,  6.649,
     *5.892,  5.892,  6.255,  6.414,  6.525,  6.642,  6.626,
     *5.935,  6.291,  6.385,  6.481,  6.616,  6.605,  6.602,
     *6.266,  6.384,  6.436,  6.556,  6.611,  6.620,  6.547,
     *6.356,  6.437,  6.508,  6.594,  6.607,  6.608,  6.524,
     *6.423,  6.492,  6.562,  6.609,  6.627,  6.618,  6.501,
     *6.494,  6.542,  6.577,  6.607,  6.627,  6.587,  6.480,
     *6.542,  6.566,  6.585,  6.607,  6.610,  6.564,  6.484,
     *6.546,  6.582,  6.596,  6.629,  6.622,  6.591,  6.506,
     *6.573,  6.609,  6.610,  6.633,  6.622,  6.604,  6.567/

      DATA AGp/.0689,.0689,.0689,.1085,.1871,0.2721,.3159,
     *.0721,   .0721,   .0955,   .1573,   .2377,   .3030,   .3169,
     *.0752,   .1038,   .1399,   .2076,   .2780,   .3133,   .3175,
     *.1027,   .1446,   .1858,   .2521,   .2983,   .3161,   .3009,
     *.1413,   .1885,   .2297,   .2796,   .3066,   .3113,   .2900,
     *.1825,   .2255,   .2590,   .2924,   .3054,   .3004,   .2732,
     *.2215,   .2543,   .2756,   .2957,   .3009,   .2880,   .2564,
     *.2491,   .2708,   .2826,   .2933,   .2925,   .2780,   .2476,
     *.2623,   .2780,   .2855,   .2908,   .2875,   .2705,   .2422,
     *.2737,   .2829,   .2860,   .2874,   .2821,   .2666,   .2418/

      DATA BGp/1.075,  1.075,  1.075,   .803,   .772,   .722,   .665,
     *.987,   .987,   .826,   .781,   .747,   .687,   .635,
     *.974,   .817,   .788,   .760,   .711,   .662,   .611,
     *.826,   .789,   .772,   .732,   .684,   .629,   .591,
     *.793,   .769,   .746,   .702,   .656,   .605,   .573,
     *.772,   .747,   .718,   .676,   .630,   .586,   .560,
     *.748,   .720,   .693,   .653,   .609,   .575,   .551,
     *.722,   .695,   .670,   .634,   .600,   .569,   .546,
     *.701,   .673,   .653,   .619,   .591,   .563,   .548,
     *.680,   .655,   .639,   .612,   .589,   .566,   .549/




      DATA CH/
     *-.119,   -.119,   -.119,    .934,   1.980,   2.975,   3.668,
     * .134,    .134,    .780,   1.696,   2.615,   3.440,   3.987,
     * .266,   1.013,   1.571,   2.390,   3.155,   3.810,   4.268,
     *1.162,   1.801,   2.295,   2.982,   3.590,   4.115,   4.495,
     *1.976,   2.517,   2.931,   3.476,   3.957,   4.378,   4.697,
     *2.701,   3.146,   3.472,   3.895,   4.267,   4.609,   4.886,
     *3.335,   3.683,   3.929,   4.255,   4.549,   4.827,   5.058,
     *3.885,   4.148,   4.334,   4.579,   4.807,   5.030,   5.216,
     *4.366,   4.559,   4.697,   4.881,   5.057,   5.231,   5.379,
     *4.789,   4.934,   5.039,   5.171,   5.303,   5.436,   5.553/


      DATA GH/
     *6.827,  6.827,  6.827,  7.353,  7.621,  7.582,  7.489,
     *6.873,  6.873,  7.260,  7.564,  7.655,  7.543,  7.472,
     *6.955,  7.313,  7.513,  7.630,  7.579,  7.462,  7.401,
     *7.311,  7.543,  7.631,  7.621,  7.529,  7.427,  7.371,
     *7.507,  7.621,  7.631,  7.575,  7.464,  7.407,  7.376,
     *7.602,  7.620,  7.587,  7.508,  7.432,  7.375,  7.362,
     *7.621,  7.581,  7.551,  7.473,  7.399,  7.388,  7.374,
     *7.601,  7.556,  7.510,  7.465,  7.421,  7.402,  7.446,
     *7.556,  7.524,  7.501,  7.470,  7.424,  7.443,  7.508,
     *7.550,  7.507,  7.482,  7.477,  7.442,  7.451,  7.503/


      DATA AGH/
     *.0922,   .0922,   .0922,   .0735,   .0939,   .1027,   .0917,
     *.0808,   .0808,   .0739,   .0856,   .1038,   .1013,   .0814,
     *.0825,   .0751,   .0827,   .0984,   .1047,   .0908,   .0663,
     *.0761,   .0859,   .0951,   .1039,   .0986,   .0778,   .0487,
     *.0838,   .0959,   .1019,   .1020,   .0876,   .0623,   .0309,
     *.0938,   .1016,   .1024,   .0945,   .0756,   .0451,   .0144,
     *.1004,   .1006,   .0977,   .0849,   .0617,   .0328,  -.0005,
     *.1017,   .0977,   .0902,   .0755,   .0518,   .0192,  -.0112,
     *.0976,   .0903,   .0827,   .0661,   .0408,   .0107,  -.0198,
     *.0936,   .0838,   .0749,   .0587,   .0327,  -.0002,  -.0323/

      DATA BGH/
     *1.094,  1.094,  1.094,   .750,   .672,   .636,   .588,
     *1.004,  1.004,   .789,   .687,   .648,   .609,   .557,
     *.977,   .772,   .704,   .660,  .629,   .582,   .534,
     *.777,   .698,   .668,   .639,  .602,   .555,   .511,
     *.705,   .667,   .648,   .616,   .577,   .529,   .482,
     *.671,   .646,   .627,   .594,   .552,   .505,   .464,
     *.648,   .626,   .604,   .570,   .530,   .483,   .444,
     *.627,   .604,   .583,   .548,   .509,   .465,   .424,
     *.607,   .584,   .562,   .529,   .493,   .450,   .409,
     *.586,   .565,   .546,   .513,   .481,   .441,   .402/


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      END

