SUBROUTINE SPERD1 #include "com2d.h" C C ------------------------- SPE RUN ------------------------- COMMON/SPE/AIONPAIR,AIONHOX,AIONNOX,IYRSPE,FRCSPE(18), * ALTSPE(56),ALTHOX(56),PAIRION(40,365,60), * PAIRION360(40,360,60) DIMENSION DAYSPE(1000),CHJION(1000,56),ALTION(56) DIMENSION DAYREAD(8),PRODREAD(8,56),PITOT(56) INTEGER OCTETS,NUMYRS,CURYEAR,YR,NODAYS,FIRSTD,LASTD INTEGER EVENTDAY,JZ,JYR,JDAY,JSPE,IZSPE,IMAXEVDAY,NUMDAYS C OPEN (UNIT=18,NAME='f12ip25yr.dat',TYPE='OLD', c FORM='FORMATTED') ICOUNTER=1 NUMDAYS=0 EVENTDAY=0 C -------------------- READ IN SPE DATA -------------------- READ(18,9500)NUMYRS DO 9400, JYR=1,NUMYRS READ(18,9502)YR,OCTETS,NODAYS,FIRSTD,LASTD C WRITE(6,9502)YR,OCTETS,NODAYS,FIRSTD,LASTD C WRITE(41,9502)YR,OCTETS,NODAYS,FIRSTD,LASTD NUMDAYS=NUMDAYS+NODAYS IALT=56 DO 9300, IOCT=1, OCTETS READ(18,9504)(DAYREAD(JDAY),JDAY=1,8) c WRITE(6,9504)(DAYREAD(JDAY),JDAY=1,8) DO 9100, JZ=1,IALT READ(18,9506)ALTSPE(JZ),(PRODREAD(JDAY,JZ),JDAY=1,8) C WRITE(41,8000)JZ,ALTSPE(JZ) 8000 FORMAT(' JZ=',I5,' ALTSPE(JZ)=',1PE11.3) 9100 CONTINUE DO 7200, JDAY=1,8 IF (DAYREAD(JDAY).NE.0.0) THEN EVENTDAY=EVENTDAY+1 DAYSPE(EVENTDAY)=YR*1000+DAYREAD(JDAY) C IMAXEVDAY IS MAXIMUM EVENTDAY C IMAXEVDAY=EVENTDAY DO 9150,JZ=1,IALT CHJION(EVENTDAY,JZ)=PRODREAD(JDAY,JZ) 9150 CONTINUE ENDIF 7200 CONTINUE 9300 CONTINUE 9400 CONTINUE C 9500 FORMAT(I4) 9502 FORMAT(5I8) 9504 FORMAT(11X,8F11.2) 9506 FORMAT(1X,9E11.3) C INITIALIZE SPE-DAY POINTER JSPE = 1 ASPEDAY = DAYSPE(JSPE) C C --- Get first ASPEDAY for this run C --- Should only execute once ITTI=1 DO 2000 IYEAR=0,21 WRITE(6,8001)IYEAR 8001 FORMAT(' IYEAR=',I5) DO 1000 IDAY1=1,360 ICURDAY = INT((1963. + IYEAR)*1000. + IDAY1) ISPEDAY = INT(ASPEDAY) 9090 IF (ISPEDAY.LT.ICURDAY) THEN JSPE = JSPE + 1 IF(JSPE.GE.NUMDAYS)GO TO 9058 ASPEDAY = DAYSPE(JSPE) ISPEDAY = INT(ASPEDAY) GO TO 1000 ENDIF 9058 CONTINUE C --- IYRSPECO=IYEAR+1963 C --- SPE EFFECT ISET=0 AIONPAIR=0. IF (JSPE.LT.NUMDAYS) THEN ISET=0 IF (ICURDAY.EQ.ISPEDAY) THEN ISET=1 C WRITE(6,8181)ICURDAY,ISPEDAY,JSPE,NUMDAYS 8181 FORMAT(' ICURDAY=',I15,' ISPEDAY=',I15,' JSPE=',I5,' NUMDAYS=', C I5) DO 10100 IZSPE=1, 56 AIONPAIR = CHJION(JSPE,IZSPE) C WRITE(6,7171)AIONPAIR,JSPE,IZSPE 7171 FORMAT(' AIONPAIR=',1PE11.3,' JSPE=',I5,' IZSPE=',I5) IF (IYRSPECO.EQ.1972) THEN IF ((ALTSPE(IZSPE).LE.40.0).AND.(IDAY1.GT.200) C .AND.(IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 3.70 ENDIF IF ((ALTSPE(IZSPE).GT.40.1 .AND. ALTSPE(IZSPE).LE.42.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 3.5 ENDIF IF ((ALTSPE(IZSPE).GT.42.1 .AND. ALTSPE(IZSPE).LE.44.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 3.3 ENDIF IF ((ALTSPE(IZSPE).GT.44.1 .AND. ALTSPE(IZSPE).LE.46.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 3.0 ENDIF IF ((ALTSPE(IZSPE).GT.46.1 .AND. ALTSPE(IZSPE).LE.48.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 2.7 ENDIF IF ((ALTSPE(IZSPE).GT.48.1 .AND. ALTSPE(IZSPE).LE.50.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 2.4 ENDIF IF ((ALTSPE(IZSPE).GT.50.1 .AND. ALTSPE(IZSPE).LE.52.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 2.1 ENDIF IF ((ALTSPE(IZSPE).GT.52.1 .AND. ALTSPE(IZSPE).LE.54.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 1.8 ENDIF IF ((ALTSPE(IZSPE).GT.54.1 .AND. ALTSPE(IZSPE).LE.56.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 1.6 ENDIF IF ((ALTSPE(IZSPE).GT.56.1 .AND. ALTSPE(IZSPE).LE.58.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 1.4 ENDIF IF ((ALTSPE(IZSPE).GT.58.1 .AND. ALTSPE(IZSPE).LE.60.1) C .AND.(IDAY1.GT.200) .AND. (IDAY1.LT.230)) THEN AIONPAIR = AIONPAIR * 1.2 ENDIF ENDIF C ALTION(IZSPE)=AIONPAIR C ION PAIR PRODUCTIONS ARE IN # CM-3 SEC-1 AND ARE DAILY AVERAGES) C 10100 CONTINUE DO 10300 IK=1,Z$ DO 10200, IZSPE=1, 56 IF (ALTSPE(IZSPE).LT.ZKM(9,IK)) THEN VAL1 = (ZKM(9,IK)-ALTSPE(IZSPE))/2.E0 VAL2 = (ALTSPE(IZSPE-1)-ZKM(9,IK))/2.E0 PAIRION(IYEAR+1,IDAY1,IK) = C (VAL1*ALTION(IZSPE-1) + c VAL2*ALTION(IZSPE)) GO TO 10300 ENDIF 10200 CONTINUE 10300 CONTINUE C WRITE(6,10103)ASPEDAY,PAIRION(IYEAR+1,IDAY1,25) 10103 FORMAT(1X,' SPE ON DAY ',F10.2,' COMPLETED ',/, * ' ION PAIR PRODUCTION AT LEVEL 25',1PE12.3) JSPE = JSPE + 1 IF (JSPE.LE.NUMDAYS) ASPEDAY = DAYSPE(JSPE) ISPEDAY = INT(ASPEDAY) ENDIF ENDIF 1000 CONTINUE 2000 CONTINUE RETURN END