* main programm */IOUROVEN JOB ('5.29.01',2),'CMCK-E1' 00003810 */ EXEC PGM=IEBUPDTE,PARM=NEW 00003820 */SYSPRINT DD SYSOUT=A 00003830 */SYSUT2 DD DSN=II.INSTITUT.SYM,DISP=(OLD,KEEP),VOL=SER=METEO, 00003840 */ UNIT=5061,DCB=(RECFM=F,LRECL=80,BLKSIZE=80) 00003850 */SYSIN DD DATA 00003860 */ ADD NAME=OCEZAGR,LEVEL=00,LIST=ALL 00003870 */ NUMBER NEW1=1,INCR=1 00003880 */IOUROVEN JOB ('5.29.01',2),'CMCK-E1' 00003890 */ EXEC FORTGCL 00003900 */FORT.SYSIN DD * 00003910 DIMENSION KO(20),CBI(20),CBP(20),AI(20),BI(20), 00003920 *DI(20),AP(20),BP(20),DP(20) 00003930 DIMENSION CPI(20,20),SI(20),CI(20),CP(20),SP(20) 00003940 DIMENSION SIMAX(20),SPMAX(20),SIB(20),SPB(20) 00003950 COMMON /ARX/AIM(20,90),APM(20,90),CBIM(20,12),CBPM(20,12), 00003960 *CIM(20,12),CPM(19,12),C12,R1 00003970 DIMENSION T1(90),NOM(20) 00003980 INTEGER GODP,MECP 00003990 REAL M1(20),M2(20),M3(20),M4(19) 00004000 INTEGER D1 00004010 INTEGER CPR,CN 00004020 DIMENSION S3(2000) 00004030 INTEGER D3(2000) 00004040 COMMON/UR/CBI,CBP 00004050 COMMON/URN/AI,AP,A 00004060 DIMENSION CBIG(20),CBPG(20),CIMG(20),CPMG(19),AIG(20),BIG(20), 00004070 *DIG(20),APG(20),BPG(20),DPG(20),CIMAX(20),CPMAX(19),DEI(20), 00004080 *DEP(20) 00004090 INTEGER Q(20,20),PDK(20) 00004190 INTEGER QM(20) 00004200 INTEGER SICP(20),SPCP(20),SCP 00004210 INTEGER SUM 00004220 INTEGER P,C,P1 00004230 INTEGER PH(11)/1,8,21,42,54,3,19,4,13,18,24/,GOD,MEC, 00004240 *DATA,CPOK 00004250 COMMON GOD 00004260 COMMON MECP 00004270 INTEGER CT(4,11)/'EHT','PA','H ',' ','AE','OB','CK',00004280 *' ','AE','OB','CK',' ','AE','OB','CK',' ', 00004290 *'EPB','OMA','CK',' ','EH','HCK',' ',' ','EH', 00004300 *'HCK',' ',' ','OKT','PC','K ',' ','OKT', 00004310 *'PC','K ', 00004320 *' ','EP','HC','K ',' ','KA','HHC','K ',' '/ 00004330 INTEGER SCCP 00004340 * DEFINE FILE 1(1,7200,E,II) 00004100 logical log1 character*3 stat1 inquire(file ='scuzaim',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(1, file='scuzaim', access='direct',recl=7200,status=stat1, & form='unformatted') * DEFINE FILE2(1,7200,E,II1) 00004110 inquire(file ='scuzapm',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(2, file='scuzapm', access='direct',recl=7200,status=stat1, & form='unformatted') * DEFINE FILE3(1,960,E,K1) 00004120 inquire(file ='scuzcbim',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(3, file='scuzcbim', access='direct',recl=960 ,status=stat1, & form='unformatted') * DEFINE FILE4(1,960,E,K2) 00004130 inquire(file ='scuzcbpm',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(4, file='scuzcbpm', access='direct',recl=960 ,status=stat1, & form='unformatted') * DEFINE FILE10(1,960,E,K3) 00004140 inquire(file ='scuzcim',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(10, file='scuzcim', access='direct',recl=960 ,status=stat1, & form='unformatted') * DEFINE FILE11(1,912,E,K4) 00004150 inquire(file ='scuzcpm',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(11, file='scuzcpm', access='direct',recl=912 ,status=stat1, & form='unformatted') * DEFINE FILE12(1,12,E,K5) 00004160 inquire(file ='scuzgkm',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(12, file='scuzgkm', access='direct',recl=12 ,status=stat1, & form='unformatted') * DEFINE FILE13(2000,8,E,K6) 00004170 inquire(file ='siozdis',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(13, file='siozdis', access='direct',recl=8,status=stat1, & form='unformatted') * DEFINE FILE14(9,1620,E,K7) 00004180 inquire(file ='siozcdg',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(14, file='siozcdg', access='direct',recl=1620,status=stat1, & form='unformatted') inquire(file ='zamer',exist =log1) if(log1) then stat1 = 'old' else stat1 = 'new' end if open(21, file='zamer',status=stat1,form='unformatted') READ(5,27)I,P,C,L4,L6 00004350 READ(5,100)CB,CB1,A,B,D,R,R1,C7,C8,C9,C10,C11,C12,C13 00004360 READ(5,101)(CBI(K),K=1,I) 00004370 READ(5,101)(CBP(M),M=1,P) 00004380 READ(5,101)(AI(K),K=1,I) 00004390 READ(5,101)(BI(K),K=1,I) 00004400 READ(5,125)(DI(K),K=1,I) 00004410 READ(5,101)(AP(M),M=1,P) 00004420 READ(5,101)(BP(M),M=1,P) 00004430 READ(5,101)(DP(M),M=1,P) 00004440 READ(5,102)(PDK(K),K=1,I) 00004450 READ(5,104)(QM(K),K=1,I) 00004460 READ(5,103)(KO(K),K=1,I) 00004470 READ(5,103)SUM 00004480 C OPAHA KA O CPOKAM 00004490 C2=0.0 00004500 L2=0 00004510 C9N=C9 00004520 CPR=0 00004530 IF(C.GT.9) GO TO 44 00004540 IF(C11.EQ.1.) GO TO 44 00004550 30 K7=1 00004560 * go to 44 !!!!!!!!!!!!!! READ(14,rec=K7,end=44)CPR,GOD,MEC,DATA,CPOK,((Q(M,K),M=1,P),K=1,I) 00004570 44 IF(L6.EQ.0) GO TO 28 00004580 DO 26 J1=1,L6 00004590 26 READ(21,END=123,ERR=122)GOD,MEC,DATA,CPOK,((Q(M,K),M=1,P),K=1,I) 00004600 28 CN=C+CPR 00004610 DO 1 J=1,CN 00004620 IF(L6.EQ.0) GO TO 24 00004630 READ(21,END=123,ERR=122)GOD,MEC,DATA,CPOK,((Q(M,K),M=1,P),K=1,I) 00004640 GO TO 29 00004650 24 IF(CPR.EQ.0) GO TO 45 00004660 C9=0. 00004670 IF(J.GT.CPR) GO TO 45 00004680 K7=J 00004690 READ(14,rec=K7)CPR,GOD,MEC,DATA,CPOK,((Q(M,K),M=1,P),K=1,I) 00004700 GO TO 29 00004710 45 READ(5,120)GOD,MEC,DATA,CPOK 00004720 DO 18 K=1,I 00004730 18 READ(5,104)(Q(M,K),M=1,P) 00004740 IF(C.GT.9) GO TO 29 00004750 C8=0. 00004760 C9=C9N 00004770 K7=J-CPR 00004780 IF(K7.GT.9) GO TO 29 00004790 WRITE(14,rec=K7)C,GOD,MEC,DATA,CPOK,((Q(M,K),M=1,P),K=1,I) 00004800 29 K5=1 00004810 * k6 = 1 !!!!! * go to 10000 !!!!!!! READ(12,rec=K5,end = 10000)GODP,MECP,K6 00004820 10000 continue !!!!!!! IF(K6.EQ.2001) K6=1 00004830 IF(MEC.EQ.0.OR.MEC.GT.12) GO TO 122 00004840 IF(GOD.LT.1970.OR.GOD.GT.2100) GO TO 122 00004850 IF(C8.NE.1.) GO TO 201 00004860 IF(MEC.NE.MECP) GO TO 200 00004870 201 GODP=GOD 00004880 MECP=MEC 00004890 L3=0 00004900 C3=0 00004910 C5=0. 00004920 C6=0. 00004930 DO 3 K=1,I 00004940 L=0 00004950 C1=0.0 00004960 DO 2 M=1,P 00004970 IF(Q(M,K).EQ.9999) GO TO 4 00004980 L5=Q(M,K) 00004990 IF(Q(M,K).GT.QM(K).AND.L4.EQ.0) GO TO 124 00005000 CPI(M,K)=(Q(M,K)*1.0)/(PDK(K)*KO(K)**R) 00005010 IF(CPI(M,K).LT.C5) GO TO 106 00005020 C5=CPI(M,K) 00005030 M5=M 00005040 K1=K 00005050 106 L=L+1 00005060 C1=C1+CPI(M,K) 00005070 GO TO 2 00005080 4 CPI(M,K)=9.99 00005090 2 CONTINUE 00005100 IF(L.EQ.0) CI(K)=9.99 00005110 IF(L.EQ.0) GO TO 3 00005120 CI(K)=C1/L 00005130 L3=L3+L 00005140 C3=C3+C1 00005150 3 continue * 吝 த if(l3 .eq. 0) go to 11 IF(C5*L3/C3.LT.C7) GO TO 107 00005190 C71=C7*C3/L3 00005200 C3=C3-C5+C71 00005210 C6=1. 00005220 L=0 00005230 DO 108 M=1,P 00005240 IF(CPI(M,K1).EQ.9.99) GO TO 108 00005250 L=L+1 00005260 C1=C1+CPI(M,K1) 00005270 108 CONTINUE 00005280 CI(K1)=(C1+C71-C5)/L 00005290 IF(CB.EQ.0.) GO TO 119 00005300 107 S=C3/(CB*L3) 00005310 GO TO 37 00005320 119 S=C3/L3 00005330 GO TO 37 00005340 11 S=9.99 00005350 37 DO 5 K=1,I 00005360 IF(CI(K).EQ.9.99) GO TO 9 00005370 IF(L.EQ.0) SI(K)=9.99 00005380 IF(CBI(K).EQ.0.) GO TO 131 00005390 SI(K)=CI(K)/CBI(K) 00005400 GO TO 5 00005410 131 SI(K)=CI(K) 00005420 GO TO 5 00005430 9 SI(K)=9.99 00005440 5 CONTINUE 00005450 IF(SUM.EQ.0) GO TO 16 00005460 DO 20 M=1,P 00005470 KP=0 00005480 IF((CPI(M,2).EQ.9.99).OR.(CPI(M,2).EQ.0.0)) GO TO 7 00005490 IF((CPI(M,4).NE.9.99).AND.(CPI(M,4).NE.0.0)) KP=KP+1 00005500 IF((CPI(M,6).NE.9.99).AND.(CPI(M,6).NE.0.0)) KP=KP+1 00005510 IF((CPI(M,8).NE.9.99).AND.(CPI(M,8).NE.0.0)) KP=KP+1 00005520 7 L=0 00005530 C1=0.0 00005540 DO 21 K=1,I 00005550 IF(CPI(M,K).EQ.9.99) GO TO 21 00005560 L=L+1 00005570 C1=C1+CPI(M,K) 00005580 21 CONTINUE 00005590 IF(L.NE..0) GO TO 23 00005600 CP(M)=9.99 00005610 SP(M)=9.99 00005620 GO TO 20 00005630 23 CP(M)=C1/(L-KP) 00005640 IF(C6.EQ.0.) GO TO 109 00005650 IF(M.NE.M5) GO TO 109 00005660 CP(M)=(C1-C5+C71)/(L-KP) 00005670 109 IF(CBP(M).EQ.0.) GO TO 132 00005680 SP(M)=CP(M)/CBP(M) 00005690 GO TO 20 00005700 132 SP(M)=CP(M) 00005710 20 CONTINUE 00005720 GO TO 66 00005730 16 DO 6 M=1,P 00005740 L=0 00005750 C1=0.0 00005760 DO 10 K=1,I 00005770 IF(CPI(M,K).EQ.9.99) GO TO 10 00005780 L=L+1 00005790 C1=C1+CPI(M,K) 00005800 10 CONTINUE 00005810 IF(L.NE.0) GO TO 22 00005820 CP(M)=9.99 00005830 SP(M)=9.99 00005840 GO TO 6 00005850 22 CP(M)=C1/L 00005860 IF(C6.EQ.0.) GO TO 118 00005870 IF(M.NE.M5) GO TO 118 00005880 CP(M)=(C1-C5+C71)/L 00005890 118 IF(CBP(M).EQ.0.) GO TO 134 00005900 SP(M)=CP(M)/CBP(M) 00005910 GO TO 6 00005920 134 SP(M)=CP(M) 00005930 6 CONTINUE 00005940 66 L=0 00005950 C1=0.0 00005960 DO 12 M=1,P 00005970 IF(CP(M).EQ.9.99) GO TO 12 00005980 L=L+1 00005990 C1=C1+CP(M) 00006000 12 CONTINUE 00006010 IF(L.EQ.0) GO TO 112 00006020 IF(CB1.EQ.0.) GO TO 126 00006030 S1=C1/(CB1*L) 00006040 GO TO 113 00006050 126 S1=C1/L 00006060 GO TO 113 00006070 112 S1=9.99 00006080 113 CONTINUE 00006090 C CPABHEHE O HPEEHTAM 00006100 DO 13 K=1,I 00006110 IF(CBI(K).EQ.0.) GO TO 67 00006120 IF(SI(K).EQ.9.99) GO TO 67 00006130 IF(SI(K).LT.1) SICP(K)=99 00006140 IF((SI(K).GE.1).AND.(SI(K).LT.AI(K))) SICP(K)=9 00006150 IF((SI(K).GE.AI(K)).AND.(SI(K).LT.BI(K))) SICP(K)=1 00006160 IF((SI(K).GE.BI(K)).AND.(SI(K).LT.DI(K))) SICP(K)=2 00006170 IF(SI(K).GE.DI(K)) SICP(K)=3 00006180 GO TO 13 00006190 67 SICP(K)=90 00006200 13 CONTINUE 00006210 C CPABHEHE O HKTAM 00006220 DO 14 M=1,P 00006230 IF(CBP(M).EQ.0.) GO TO 68 00006240 IF(SP(M).EQ.9.99) GO TO 68 00006250 IF(SP(M).LT.1) SPCP(M)=99 00006260 IF((SP(M).GE.1).AND.(SP(M).LT.AP(M))) SPCP(M)=9 00006270 IF((SP(M).GE.AP(M)).AND.(SP(M).LT.BP(M))) SPCP(M)=1 00006280 IF((SP(M).GE.BP(M)).AND.(SP(M).LT.DP(M))) SPCP(M)=2 00006290 IF(SP(M).GE.DP(M)) SPCP(M)=3 00006300 GO TO 14 00006310 68 SPCP(M)=90 00006320 14 CONTINUE 00006330 C CPABHEHE O OPO 00006340 IF(S.EQ.9.99) GO TO 114 00006350 IF(S.LT.1) SCP=99 00006360 IF((S.GE.1).AND.(S.LT.A)) SCP=9 00006370 IF((S.GE.A).AND.(S.LT.B)) SCP=1 00006380 IF((S.GE.B).AND.(S.LT.D)) SCP=2 00006390 IF(S.GE.D) SCP=3 00006400 GO TO 121 00006410 114 SCP=90 00006420 121 CONTINUE 00006430 IF(S.EQ.9.99) GO TO 115 00006440 C2=C2+S 00006450 L2=L2+1 00006460 115 CONTINUE 00006470 DO 35 J1=3,CN,3 00006480 IF(J-J1) 40,33,35 00006490 35 CONTINUE 00006500 33 IF(L2.EQ.0) GO TO 116 00006510 SC=C2/L2 00006520 IF(SC.LT.1) SCCP=99 00006530 IF((SC.GE.1).AND.(SC.LT.A)) SCCP=9 00006540 IF((SC.GE.A).AND.(SC.LT.B)) SCCP=1 00006550 IF((SC.GE.B).AND.(SC.LT.D)) SCCP=2 00006560 IF(SC.GE.D) SCCP=3 00006570 GO TO 117 00006580 116 SC=9.99 00006590 SCCP=90 00006600 117 L2=0 00006610 C2=0.0 00006620 40 CONTINUE 00006630 IF(C9.NE.1.) GO TO 41 00006640 WRITE(6,130) 00006650 130 FORMAT('X',30('*'),'HPEEHT',30('*'),/) 00006660 DO 19 M=1,P 00006670 19 WRITE(6,111)(Q(M,K),K=1,I) 00006680 111 FORMAT('X',18(I7)) 00006690 WRITE(6,52) 00006700 WRITE(6,51)DATA,MEC,GOD,CPOK 00006710 write(6,52) write(6,53) write(6,54) WRITE(6,55) 00006750 WRITE(6,56) 00006760 WRITE(6,52) 00006770 DO 60 M=1,P 00006780 * ????????????????????????????? 60 WRITE(6,57) (CT(K,M),K=1,4),PH(M),(CPI(M,K),K=1,I),SP(M), 00006790 * SPCP(M) 00006800 WRITE(6,52) 00006810 WRITE(6,58)(SI(K),K=1,I) 00006820 WRITE(6,52) 00006830 WRITE(6,59)(SICP(K),K=1,I) 00006840 WRITE(6,52) 00006850 WRITE(6,61)S 00006860 WRITE(6,62)S1 00006870 WRITE(6,63)SCP 00006880 IF(C6.EQ.1.) WRITE(6,110)C5 00006890 WRITE(6,52) 00006900 IF(C2.GT.0.0) GO TO 41 00006910 WRITE(6,31) 00006920 WRITE(6,32)SC,SCCP 00006930 WRITE(6,52) 00006940 41 CONTINUE 00006950 31 FORMAT('X',' CPEHE A POEE CTK'/) 00006960 51 FORMAT('X'//25X,'APHEHE OP.HOBOCPCKA',3X,I2,'.',I2,'.',I400006970 *,'',1X,'HA',I2,'AC'/) 00006980 52 FORMAT('X',110('*'),/) 00006990 53 FORMAT('X','*',17X,'I',19X,'HOPMPOBAHHE KOHEHTPA',15X, 00007000 *'I',/) 00007010 54 FORMAT('X','*',17X,'I H I I CEPH.I OKCI BOKI CAA I CEPO00007020 *-I OP I EHOI SP I POBEH APHEH ','*') 00007030 55 FORMAT('X','*',6X,' PAOH I / I',85X,'*') 00007040 56 FORMAT('X','*',17X,'I I',6X,'I A I EPI AOTAI', 00007050 *6X,' IBO IMA I',6X,'I',6X,'I',4X,' HA HKTE',8X,'*'/) 00007060 57 FORMAT('X','* ',4A4,'I',1X,I2,1X,8('I',F5.2,1X),'I',1X,F5.2, 00007070 *1X,'I',9X,I2,11X,'*'/) 00007080 58 FORMAT('X','* ',5X,'SI',14X,8('I',F5.2,1X),'I', 00007090 *6X,'I',22X,'*'/) 00007100 59 FORMAT('X','* P.A.OP.HPA I',8(2X,I2, 00007110 *2X,'I'),6X,'I',22X,'*'/) 00007120 61 FORMAT('X',' B EOM O OPO S=',F5.2,/) 00007130 62 FORMAT('X','OKAATE APHEH C ETOM CMMA S1=',F5.2/) 00007140 63 FORMAT('X',' POBEH APHEH OPOA= ',I2) 00007150 32 FORMAT('X','APHEHE OPOA S=', F5.2,'POBEH APHEH 00007160 *OPOA=',I2) 00007170 110 FORMAT('X','BEAC KOHEHTPA B ',F6.1,' K') 00007180 D1=CPOK+100*DATA+10000*MEC+1000000*GOD 00007190 D3(J)=D1 00007200 S3(J)=S 00007210 IF(C8.NE.1.) GO TO 1 00007220 IF(C13.EQ.1) GO TO 133 00007230 WRITE(13,rec=K6)D1,S 00007240 k6 = k6 + 1 !!!!!!!!! 133 CONTINUE 00007250 K5=1 00007260 WRITE(12,rec=K5)GODP,MECP,K6 00007270 CALL ZAPIS(I,P,J,SI,SP,S,S1) 00007280 * ????CALL ZAPIS(I,P,J,SI,SP,S,S1,AIM,APM) 00007280 GO TO 1 00007290 200 CALL SCHETM(I,P,J,MEC,CBI,CBP,CB,CB1,GODP) 00007300 * ???????????????????? DO 7070 L=1,90 00007310 DO 70 M=1,20 00007320 70 AIM(M,L)=99.99 00007330 7070 continue DO 71 L=1,90 00007340 DO 71 M=1,20 00007350 71 APM(M,L)=99.99 00007360 I1=1 00007370 WRITE(1,rec=I1)AIM 00007380 II1=1 00007390 WRITE(2,rec=II1)APM 00007400 IF(GOD.EQ.GODP) GO TO 201 00007410 CALL SCHETG(I,P,J,GODP,CB,CB1) 00007420 DO 72 L=1,12 00007430 DO 72 M=1,20 00007440 72 CBIM(M,L)=99.99 00007450 DO 73 L=1,12 00007460 DO 73 M=1,20 00007470 73 CBPM(M,L)=99.99 00007480 DO 74 L=1,12 00007490 DO 74 M=1,20 00007500 74 CIM(M,L)=99.99 00007510 DO 75 L=1,12 00007520 DO 75 M=1,19 00007530 75 CPM(M,L)=99.99 00007540 K1=1 00007550 WRITE(3,rec=K1)CBIM 00007560 K2=1 00007570 WRITE(4,rec=K2)CBPM 00007580 K3=1 00007590 WRITE(10,rec=K3)CIM 00007600 K4=1 00007610 WRITE(11,rec=K4)CPM 00007620 GO TO 201 00007630 1 CONTINUE 00007640 IF(C10.EQ.1.) WRITE(6,39)(D3(L),S3(L),L=1,C) 00007650 GO TO 123 00007660 122 WRITE(6,42)GODP,MECP,K6,K5,D1 00007670 GO TO 123 00007680 124 WRITE(6,43)D1,L5,M,K,K6 00007690 123 CONTINUE 00007700 27 FORMAT(2I3,I5,I3,I5) 00007710 39 FORMAT(8(' ',I10,F5.2)) 00007720 42 FORMAT('X',4I7,I15) 00007730 43 FORMAT('X',I15,4I5) 00007740 100 FORMAT(7F3.2,7F3.1) 00007750 101 FORMAT(20F3.2) 00007760 102 FORMAT(20I3) 00007770 103 FORMAT(20I1) 00007780 104 FORMAT(20I4) 00007790 125 FORMAT(20F4.2) 00007800 120 FORMAT(I4,I2,I2,I2) 00007810 END 00007820 SUBROUTINE HMAX(I,A,SMAX) 00007830 DIMENSION A(20,90),SMAX(20) 00007840 SMAX(I)=-1 00007850 DO 1 J=1,90 00007860 IF(A(I,J).EQ.9.99.OR.A(I,J).EQ.99.99) GO TO 1 00007870 IF(A(I,J).GT.SMAX(I)) SMAX(I)=A(I,J) 00007880 1 CONTINUE 00007890 IF(SMAX(I).EQ.-1)SMAX(I)=9.99 00007900 RETURN 00007910 END 00007920 SUBROUTINE HMAX1(I,A,SMAX) 00007930 DIMENSION A(20,12),SMAX(20) 00007940 SMAX(I)=-1 00007950 DO 1 J=1,12 00007960 IF(A(I,J).EQ.9.99.OR.A(I,J).EQ.99.99) GO TO 1 00007970 IF(A(I,J).GT.SMAX(I)) SMAX(I)=A(I,J) 00007980 1 CONTINUE 00007990 IF(SMAX(I).EQ.-1) SMAX(I)=9.99 00008000 RETURN 00008010 END 00008020 SUBROUTINE ZAPIS(I,P,J1,SI,SP,S,S1) 00008030 DIMENSION SI(20),SP(20) 00008040 COMMON/ARX/AIM(20,90),APM(20,90) 00008050 INTEGER P 00008060 I1=1 00008070 READ(1,rec=I1)AIM 00008080 II1=1 00008090 READ(2,rec=II1)APM 00008100 DO 1 J=1,90 00008110 IF(AIM(1,J).EQ.99.99) GO TO 2 00008120 GO TO 1 00008130 2 DO 3 K=1,I 00008140 3 AIM(K,J)=SI(K) 00008150 AIM(20,J)=S 00008160 GO TO 4 00008170 1 CONTINUE 00008180 4 CONTINUE 00008190 I1=1 00008200 WRITE(1,rec=I1)AIM 00008210 I1=1 00008220 READ(1,rec=I1)AIM 00008230 DO 7 J=1,90 00008240 IF(APM(1,J).EQ.99.99) GO TO 8 00008250 GO TO 7 00008260 8 DO 9 M=1,P 00008270 9 APM(M,J)=SP(M) 00008280 APM(20,J)=S1 00008290 GO TO 10 00008300 7 CONTINUE 00008310 10 CONTINUE 00008320 II1=1 00008330 WRITE(2,rec=II1)APM 00008340 II1=1 00008350 READ(2,rec=II1)APM 00008360 RETURN 00008370 END 00008380 SUBROUTINE SCHETM(I,P,J1,MEC,CBI,CBP,CB,CB1,GODP) 00008390 DIMENSION SIB(20),SPB(20),SIMAX(20),SPMAX(19) 00008400 DIMENSION CBI(20),CBP(20) 00008410 REAL M1(20),M2(20),M3(20),M4(19) 00008420 COMMON/ARX/AIM(20,90),APM(20,90),CBIM(20,12),CBPM(20,12), 00008430 *CIM(20,12),CPM(19,12),C12,R1 00008440 INTEGER MEC,MECP,GOD,GODP 00008450 COMMON GOD 00008460 COMMON MECP 00008470 INTEGER P 00008480 I1=1 00008490 READ(1,rec=I1)AIM 00008500 K1=1 00008510 READ(3,rec=K1)CBIM 00008520 K3=1 00008530 READ(10,rec=K3)CIM 00008540 DO 1 K=1,I 00008550 N1=0 00008560 S3=0.0 00008570 DO 2 J=1,90 00008580 IF(AIM(K,J).EQ.99.99) GO TO 2 00008590 IF(AIM(K,J).EQ.9.99) GO TO 2 00008600 S3=S3+AIM(K,J) 00008610 N1=N1+1 00008620 2 CONTINUE 00008630 SIB(K)=9.99 IF(N1.GT.0) SIB(K)=S3/N1 M1(K)=SIB(K)*CBI(K) IF(CBI(K).EQ.0.) M1(K)=SIB(K) 00008670 IF(SIB(K).EQ.9.99) M1(K)=9.99 00008680 DO 4 J=1,12 00008690 IF(CBIM(K,J).EQ.99.99) GO TO 5 00008700 GO TO 4 00008710 5 CBIM(K,J)=M1(K) 00008720 GO TO 10 00008730 4 CONTINUE 00008740 10 CONTINUE 00008750 CALL HMAX(K,AIM,SIMAX) 00008760 M3(K)=SIMAX(K)*CBI(K) 00008770 IF(CBI(K).EQ.0.) M3(K)=SIMAX(K) 00008780 IF(M1(K).EQ.9.99) M3(K)=9.99 00008790 DO 9 J=1,12 00008800 IF(CIM(K,J).NE.99.99) GO TO 9 00008810 CIM(K,J)=M3(K) 00008820 GO TO 15 00008830 9 CONTINUE 00008840 15 CONTINUE 00008850 1 CONTINUE 00008860 N2=0 00008870 S4=0.0 00008880 DO 3 J2=1,90 00008890 IF(AIM(20,J2).EQ.99.99) GO TO 3 00008900 IF(AIM(20,J2).EQ.9.99) GO TO 3 00008910 S4=S4+AIM(20,J2) 00008920 N2=N2+1 00008930 3 CONTINUE 00008940 SIB(20)=9.99 00008950 IF(N2.GT.0) SIB(20)=S4/N2 00008960 M1(20)=SIB(20)*CB 00008970 IF(CB.EQ.0.) M1(20)=SIB(20) 00008980 IF(SIB(20).EQ.9.99) M1(20)=9.99 00008990 DO 14 J=1,12 00009000 IF(CBIM(20,J).NE.99.99) GO TO 14 00009010 CBIM(20,J)=M1(20) 00009020 GO TO 6 00009030 14 CONTINUE 00009040 6 CONTINUE 00009050 K1=1 00009060 WRITE(3,rec=K1)CBIM 00009070 CALL HMAX(20,AIM,SIMAX) 00009080 M3(20)=SIMAX(20)*CB 00009090 IF(CB.EQ.0.) M3(20)=SIMAX(20) 00009100 IF(SIMAX(20).EQ.9.99) M3(20)=9.99 00009110 DO 12 J=1,12 00009120 IF(CIM(20,J).NE.99.99) GO TO 12 00009130 CIM(20,J)=M3(20) 00009140 GO TO 13 00009150 12 CONTINUE 00009160 13 CONTINUE 00009170 K3=1 00009180 WRITE(10,rec=K3)CIM 00009190 K1=1 00009200 READ(3,rec=K1)CBIM 00009210 K3=1 00009220 READ(10,rec=K3)CIM 00009230 II1=1 00009240 READ(2,rec=II1)APM 00009250 K2=1 00009260 READ(4,rec=K2)CBPM 00009270 K4=1 00009280 READ(11,rec=K4)CPM 00009290 DO 17 M=1,P 00009300 N1=0 00009310 S3=0.0 00009320 DO 28 J=1,90 00009330 IF(APM(M,J).EQ.99.99) GO TO 28 00009340 IF(APM(M,J).EQ.9.99) GO TO 28 00009350 S3=S3+APM(M,J) 00009360 N1=N1+1 00009370 28 CONTINUE 00009380 SPB(M)=9.99 00009390 IF(N1.GT.0) SPB(M)=S3/N1 00009400 M2(M)=SPB(M)*CBP(M) 00009410 IF(CBP(M).EQ.0.) M2(M)=SPB(M) 00009420 IF(SPB(M).EQ.9.99) M2(M)=9.99 00009430 DO 18 J=1,12 00009440 IF(CBPM(M,J).NE.99.99) GO TO 18 00009450 CBPM(M,J)=M2(M) 00009460 GO TO 19 00009470 18 CONTINUE 00009480 19 CONTINUE 00009490 CALL HMAX(M,APM,SPMAX) 00009500 M4(M)=SPMAX(M)*CBP(M) 00009510 IF(CBP(M).EQ.0.) M4(M)=SPMAX(M) 00009520 IF(M2(M).EQ.9.99) M4(M)=9.99 00009530 DO 20 J=1,12 00009540 IF(CPM(M,J).NE.99.99) GO TO 20 00009550 CPM(M,J)=M4(M) 00009560 GO TO 21 00009570 20 CONTINUE 00009580 21 CONTINUE 00009590 17 CONTINUE 00009600 N2=0 00009610 S4=0.0 00009620 DO 22 J=1,90 00009630 IF(APM(20,J).EQ.99.99) GO TO 22 00009640 IF(APM(20,J).EQ.9.99) GO TO 22 00009650 S4=S4+APM(20,J) 00009660 N2=N2+1 00009670 22 CONTINUE 00009680 SPB(20)=9.99 00009690 IF(N2.GT.0) SPB(20)=S4/N2 00009700 M2(20)=SPB(20)*CB1 00009710 IF(CB1.EQ.0.) M2(20)=SPB(20) 00009720 IF(SPB(20).EQ.9.99) M2(20)=9.99 00009730 DO 23 J=1,12 00009740 IF(CBPM(20,J).EQ.99.99) GO TO 33 00009750 GO TO 23 00009760 33 CBPM(20,J)=M2(20) 00009770 GO TO 24 00009780 23 CONTINUE 00009790 24 CONTINUE 00009800 K2=1 00009810 WRITE(4,rec=K2)CBPM 00009820 K4=1 00009830 WRITE(11,rec=K4)CPM 00009840 IF(C12.EQ.1) GO TO 44 00009850 WRITE(6,177) 00009860 WRITE(6,105)MECP,GODP 00009870 DO 40 J=1,90 00009880 40 WRITE(6,41)(AIM(K,J),K=1,I),AIM(20,J) 00009890 WRITE(6,43)(M1(K),K=1,I),M1(20) 00009900 WRITE(6,43)(M3(K),K=1,I),M3(20) 00009910 WRITE(6,177) 00009920 WRITE(6,106)MECP,GODP 00009930 DO 42 J=1,90 00009940 42 WRITE(6,41)(APM(M,J),M=1,P),APM(20,J) 00009950 WRITE(6,43)(M2(M),M=1,P),M2(20) 00009960 WRITE(6,43)(M4(M),M=1,P) 00009970 WRITE(6,177) 00009980 44 CONTINUE 00009990 41 FORMAT('X',20(F5.2,1X)) 00010000 43 FORMAT('X',20F6.3) 00010010 105 FORMAT(15X,'MECH APXB SI , S A MEC ',I2,I6,' OA') 00010020 106 FORMAT(15X,'MECH APXB SP , S1 A MEC ',I2,I6,' OA') 00010030 177 FORMAT('X',127('*')/) 00010040 RETURN 00010050 END 00010060 SUBROUTINE SCHETG(I,P,J1,GODP,CB,CB1) 00010070 COMMON/ARX/AIM(20,90),APM(20,90),CBIM(20,12),CBPM(20,12), 00010080 *CIM(20,12),CPM(19,12),C12,R1 00010090 COMMON/UR/CBI(20),CBP(20) 00010100 COMMON/URN/AI(20),AP(20),A 00010110 DIMENSION CBIG(20),CBPG(20),CIMG(20),CPMG(19),AIG(20),BIG(20), 00010120 *DIG(20),APG(20),BPG(20),DPG(20),CIMAX(20),CPMAX(19),DEI(20), 00010130 *DEP(20) 00010140 INTEGERP,GOD1,GOD2,GODP,GOD3 00010150 INTEGER GOD 00010160 COMMON GOD 00010170 K1=1 00010180 READ(3,rec=K1)CBIM 00010190 DO 1 K=1,I 00010200 S3=0.0 00010210 N1=0 00010220 DO 2 J=1,12 00010230 IF(CBIM(K,J).EQ.99.99) GO TO 2 00010240 IF(CBIM(K,J).EQ.9.99) GO TO 2 00010250 S3=S3+CBIM(K,J) 00010260 N1=N1+1 00010270 2 CONTINUE 00010280 IF(N1.GT.0) CBIG(K)=S3/N1 00010290 IF(N1.EQ.0) CBIG(K)=9.99 00010300 1 CONTINUE 00010310 S3=0.0 00010320 N1=0 00010330 DO 3 J=1,12 00010340 IF(CBIM(20,J).EQ.99.99) GO TO 3 00010350 IF(CBIM(20,J).EQ.9.99) GO TO 3 00010360 S3=S3+CBIM(20,J) 00010370 N1=N1+1 00010380 3 CONTINUE 00010390 IF(N1.GT.0) CBIG(20)=S3/N1 00010400 IF(N1.EQ.0) CBIG(20)=9.99 00010410 K2=1 00010420 READ(4,rec=K2)CBPM 00010430 DO 4 M=1,P 00010440 S2=0.0 00010450 N2=0 00010460 DO 5 J=1,12 00010470 IF(CBPM(M,J).EQ.99.99) GO TO 5 00010480 IF(CBPM(M,J).EQ.9.99) GO TO 5 00010490 S2=S2+CBPM(M,J) 00010500 N2=N2+1 00010510 5 CONTINUE 00010520 IF(N2.GT.0)CBPG(M)=S2/N2 00010530 IF(N2.EQ.0) CBPG(M)=9.99 00010540 4 CONTINUE 00010550 S2=0.0 00010560 N2=0 00010570 DO 6 J=1,12 00010580 IF(CBPM(20,J).EQ.99.99) GO TO 6 00010590 IF(CBPM(20,J).EQ.9.99) GO TO 6 00010600 S2=S2+CBPM(20,J) 00010610 N2=N2+1 00010620 6 CONTINUE 00010630 IF(N2.GT.0) CBPG(20)=S2/N2 00010640 IF(N2.EQ.0) CBPG(20)=9.99 00010650 K3=1 00010660 READ(10,rec=K3)CIM 00010670 DO 7 K=1,I 00010680 CALL HMAX1(K,CIM,CIMAX) 00010690 CIMG(K)=CIMAX(K) 00010700 7 CONTINUE 00010710 CALL HMAX1(20,CIM,CIMAX) 00010720 CIMG(20)=CIMAX(20) 00010730 K4=1 00010740 READ(11,rec=K4)CPM 00010750 DO 8 M=1,P 00010760 CPMG(M)=-1. 00010770 DO 13 J=1,12 00010780 IF(CPM(M,J).EQ.9.99.OR.CPM(M,J).EQ.99.99) GO TO 13 00010790 IF(CPM(M,J).GT.CPMG(M)) CPMG(M)=CPM(M,J) 00010800 13 CONTINUE 00010810 IF(CPMG(M).EQ.-1) CPMG(M)=9.99 00010820 8 CONTINUE 00010830 GOD2=GODP 00010840 GOD1=GODP-1 00010850 GOD3=GOD 00010860 WRITE(6,20) 00010870 WRITE(6,178)GODP 00010880 WRITE(6,20) 00010890 WRITE(6,101) 00010900 DO 50 J=1,12 00010910 50 WRITE(6,52)(CBIM(K,J),K=1,I),CBIM(20,J) 00010920 WRITE(6,20) 00010930 WRITE(6,102) 00010940 DO 51 J=1,12 00010950 51 WRITE(6,52)(CIM(K,J),K=1,I),CIM(20,J) 00010960 WRITE(6,20) 00010970 WRITE(6,103) 00010980 DO 53 J=1,12 00010990 53 WRITE(6,52)(CBPM(M,J),M=1,P),CBPM(20,J) 00011000 WRITE(6,20) 00011010 WRITE(6,104) 00011020 DO 54 J=1,12 00011030 54 WRITE(6,52)(CPM(M,J),M=1,P) 00011040 WRITE(6,20) 00011050 WRITE(6,21) 00011060 WRITE(6,20) 00011070 WRITE(6,22) 00011080 WRITE(6,23)GOD1,(CBI(K),K=1,I) 00011090 WRITE(6,23)GOD2,(CBIG(K),K=1,I) 00011100 WRITE(6,24) 00011110 WRITE(6,23)GOD1,(CBP(M),M=1,P) 00011120 WRITE(6,23)GOD2,(CBPG(M),M=1,P) 00011130 WRITE(6,25) 00011140 WRITE(6,26)GOD1,CB,CB1 00011150 WRITE(6,26)GOD2,CBIG(20),CBPG(20) 00011160 WRITE(6,20) 00011170 WRITE(6,27) 00011180 WRITE(6,20) 00011190 WRITE(6,22) 00011200 WRITE(6,23)GOD2,(CIMG(K),K=1,I) 00011210 WRITE(6,24) 00011220 WRITE(6,23)GOD2,(CPMG(M),M=1,P) 00011230 WRITE(6,28)GOD2,CIMG(20) 00011240 WRITE(6,20) 00011250 DO 9 K=1,I 00011260 IF(CBIG(K).EQ.0..OR.CBIG(K).EQ.9.99) GO TO 60 00011270 IF(CBI(K).EQ.0.) GO TO 64 00011280 CBIG(K)=(CBIG(K)+CBI(K))/2 00011290 64 IF(CIMG(K).GT.11*CBIG(K)) CIMG(K)=11.*CBIG(K) 00011300 IF(CBI(K).EQ.0.) GO TO 65 00011310 CIMG(K)=(CIMG(K)+(4*AI(K)-3)*CBI(K))/2 00011320 65 DEI(K)=((CIMG(K)/CBIG(K))-1)/4 00011330 GO TO 9 00011340 60 DEI(K)=.75 00011350 9 CONTINUE 00011360 DO 10 M=1,P 00011370 IF(CBPG(M).EQ.0..OR.CBPG(M).EQ.9.99) GO TO 61 00011380 IF(CBP(M).EQ.0.) GO TO 66 00011390 CBPG(M)=(CBPG(M)+CBP(M))/2 00011400 66 IF(CPMG(M).GT.11*CBPG(M)) CPMG(M)=11.*CBPG(M) 00011410 IF(CBP(M).EQ.0.) GO TO 67 00011420 CPMG(M)=(CPMG(M)+(4*AP(M)-3)*CBP(M))/2 00011430 67 DEP(M)=((CPMG(M)/CBPG(M))-1)/4 00011440 GO TO 10 00011450 61 DEP(M)=.75 00011460 10 CONTINUE 00011470 IF(CBIG(20).EQ.0..OR.CBIG(20).EQ.9.99) GO TO 62 00011480 IF(CB.EQ.0.) GO TO 68 00011490 CBIG(20)=(CBIG(20)+CB)/2 00011500 68 IF(CIMG(20).GT.11*CBIG(20)) CIMG(20)=11.*CBIG(20) 00011510 IF(CB.EQ.0.) GO TO 69 00011520 CIMG(20)=(CIMG(20)+(4*A-3)*CB)/2 00011530 69 DE=((CIMG(20)/CBIG(20))-1)/4 00011540 GO TO 63 00011550 62 DE=.75 00011560 63 CONTINUE 00011570 DO 11 K=1,I 00011580 AIG(K)=1+DEI(K)*R1 00011590 BIG(K)=AIG(K)+DEI(K) 00011600 DIG(K)=BIG(K)+DEI(K) 00011610 11 CONTINUE 00011620 DO 12 M=1,P 00011630 APG(M)=1+DEP(M)*R1 00011640 BPG(M)=APG(M)+DEP(M) 00011650 DPG(M)=BPG(M)+DEP(M) 00011660 12 CONTINUE 00011670 AG=1+DE*R1 00011680 BG=AG+DE 00011690 DG=BG+DE 00011700 WRITE(6,29)GOD3 00011710 WRITE(6,20) 00011720 WRITE(6,22) 00011730 WRITE(6,30)(CBIG(K),K=1,I) 00011740 WRITE(6,30)(AIG(K),K=1,I) 00011750 WRITE(6,30)(BIG(K),K=1,I) 00011760 WRITE(6,30)(DIG(K),K=1,I) 00011770 WRITE(6,24) 00011780 WRITE(6,30)(CBPG(M),M=1,P) 00011790 WRITE(6,30)(APG(M),M=1,P) 00011800 WRITE(6,30)(BPG(M),M=1,P) 00011810 WRITE(6,30)(DPG(M),M=1,P) 00011820 WRITE(6,31) 00011830 WRITE(6,30)CBIG(20),AG,BG,DG 00011840 WRITE(6,20) 00011850 20 FORMAT('X',127('*')/) 00011860 21 FORMAT(40X,'CPEHEOOBE HOPMPOBAHHE KOHEHTPA'/) 00011870 22 FORMAT(54X,'O HPEEHTAM'/) 00011880 23 FORMAT('X','*',1X,I4,1X,'*',19F6.3/) 00011890 24 FORMAT('X',54X,'O HKTAM'/) 00011900 25 FORMAT(55X,'O OPO'/26X,'E CMMA',52X, 00011910 *'C ETOM CMMA'/) 00011920 26 FORMAT('X','*',I5,1X,'*',30X,F6.3,50X,F6.3) 00011930 27 FORMAT(35X,'MAKCMAHE HOPMPOBAHHE KOHEHTPA'/) 00011940 28 FORMAT(10X,'O OPO E ETA CMMA',1X,I4,1X,'C MAX=',F6.3 00011950 */) 00011960 29 FORMAT(10X,'HOPMPOBAHE APAMETP HA',1X,I4,1X,'O'/) 00011970 30 FORMAT('X',20F6.3/) 00011980 31 FORMAT('X',2X,'O OPO'/) 00011990 52 FORMAT('X',20F6.3) 00012000 101 FORMAT(25X,'CBI MEC CB MEC') 00012010 102 FORMAT(26X,'CI MAX C MAX') 00012020 103 FORMAT(25X,'CBP MEC CB1 MEC') 00012030 WRITE(6,20) 00012040 104 FORMAT(26X,'CP MAX') 00012050 178 FORMAT('X',40X,'OOBO APXB A O ',I4/) 00012060 RETURN 00012070 END 00012080 ** 00012090 */LKED.SYSLMOD DD UNIT=5061,VOL=SER=METEO, 00012100 */ DISP=(MOD,KEEP), 00012110 */ DSNAME=II.LOAD 00012120 */LKED.SYSIN DD * 00012130 *NAME UROVN4(R) 00012140 ** 00012150 */ 00012160 */ ENDUP 00012170 ** 00012180 */ 00012190