C**** AVER070.S AVERage diagnostic accumulating files 98/04/10 C**** C**** AVER070 reads several diagnostic accumulating files written by C**** the Climate Model, sums the IDACC and diagnostic arrays, adjusts C**** the dates, and writes a new diagnostic accumulating file with the C**** summed arrays. C**** INCLUDE '/u/cmrun/C070.COM' PARAMETER (KDINT = 15 + 1 + 4 + 2*4 + 42*50, * KDACC = JM*KAJ*6 + JM*LMA*KAJL + JM*3*4 + IM*JM*KAIJ + * IM*JM*LMA*KAIJL + IM*JM*LMO*KOIJL + LMO*NMST*KOLNST + * 24*50*4) INTEGER*4 IPARM(300), IDIAG(KDINT) REAL*4 DIAGR4(KDACC),CONSR4(JM,KCON) EQUIVALENCE (IPARM,IM$),(IDIAG,IDACC),(DIAGR4,AJ) C**** INTEGER*4 MDYNAS,MDYNOS,MRADS,MSURFS,MCNDSS,MSRCOS,MDIAGS,MELSES REAL*8 CONS01(JM),CONS10(JM),CONS20(JM),CONS26(JM),CONS32(JM), * CONS38(JM),CONS43(JM),CONS47(JM),CONS51(JM),CONS55(JM), * CONS59(JM),CONS65(JM),CONS71(JM),CONS79(JM),CONS87(JM), * CONS95(JM),CONSA4(JM),CONSA9(JM),CONSB7(JM),CONSC5(JM), * CONSD1(JM),CONSRS CHARACTER*4 JMON1,JMON2, OUTYR,OUTMON CHARACTER*80 FILEIN,TITLE COMMON /ACCUMS/ DIAGS(KDACC),CONSRS(JM,KCON),IDACCS(15) C**** NARGS = IARGC() IF(NARGS.le.0) GO TO 800 C**** Read first input file to determine KDACCx CALL GETARG (1,FILEIN) OPEN (1,FILE=FILEIN,FORM='UNFORMATTED',STATUS='OLD',ERR=810) READ (1) IHOURX,LABEL,IPARM CLOSE (1) KDACCx = JM*KAJ$*6 + JM*LMA$*KAJL$ + JM*3*4 + IM*JM*KAIJ$ + * IM*JM*LMA$*KAIJL$ + IM*JM*LMO$*KOIJL$ + * LMO$*NMST$*KOLNS$ + 24*50*4 KCONx = KCON$ C**** C**** Zero out summing arrays C**** DO 10 N=1,15 10 IDACCS(N)=0 DO 20 K=1,KDACCx 20 DIAGS(K) = 0. DO 30 J=1,JM*KCONx 30 CONSRS(J,1) = 0. ITIME1 = 2147483647 ITIME2 = -1 MDYNAS = 0 MDYNOS = 0 MRADS = 0 MSURFS = 0 MCNDSS = 0 MSRCOS = 0 MDIAGS = 0 MELSES = 0 OPEN (6,FILE='AVER070.PRT') C**** C**** Loop over the input disk files C**** KFILE=0 100 KFILE=KFILE+1 IF(KFILE.gt.NARGS) GO TO 200 CALL GETARG (KFILE,FILEIN) C**** Open and read input file OPEN (1,FILE=FILEIN,FORM='UNFORMATTED',STATUS='OLD',ERR=810) READ (1) IHOURX,LABEL,IPARM,IDIAG,(DIAGR4(K),K=1,KDACCx), * (CONSR4(K,1),K=1,JM*KCONx),IHOURY CLOSE (1) IF(IHOURX.ne.IHOURY) GO TO 820 CALL STORYM (JYEAR0,JMON0, JYEAR,JMON) WRITE (6,911) JYEAR0,JMON0, JYEAR,JMON, FILEIN(1:70) C**** Accumulate diagnostics for time averaging, DO 130 N=1,15 130 IDACCS(N) = IDACCS(N) + IDACC(N) DO 140 K=1,KDACCx 140 DIAGS(K) = DIAGS(K) + DIAGR4(K) DO 150 J=1,JM*KCONx 150 CONSRS(J,1) = CONSRS(J,1) + CONSR4(J,1) C**** Adjust timing if necessary IF(ITIME2.lt.IHOUR) then ITIME2 = IHOUR IDT2 = IDT IHOUR2 = IHOUR IDAY2 = IDAY IYEAR2 = IYEAR JYEAR2 = JYEAR JMON2 = JMON JDATE2 = JDATE JHOUR2 = JHOUR JDAY2 = JDAY DO 160 J=1,JM CONS01(J) = CONSR4(J, 1) CONS10(J) = CONSR4(J, 10) CONS20(J) = CONSR4(J, 20) CONS26(J) = CONSR4(J, 26) CONS32(J) = CONSR4(J, 32) CONS38(J) = CONSR4(J, 38) CONS43(J) = CONSR4(J, 43) CONS47(J) = CONSR4(J, 47) CONS51(J) = CONSR4(J, 51) CONS55(J) = CONSR4(J, 55) CONS59(J) = CONSR4(J, 59) CONS65(J) = CONSR4(J, 65) CONS71(J) = CONSR4(J, 71) CONS79(J) = CONSR4(J, 79) CONS87(J) = CONSR4(J, 87) CONS95(J) = CONSR4(J, 95) CONSA4(J) = CONSR4(J,104) CONSA9(J) = CONSR4(J,109) CONSB7(J) = CONSR4(J,117) CONSC5(J) = CONSR4(J,125) 160 CONSD1(J) = CONSR4(J,131) endif IF(ITIME1.gt.((JYEAR0-IYEAR0)*366+JDAY0)*24+JHOUR0) then ITIME1 = ((JYEAR0-IYEAR0)*366+JDAY0)*24+JHOUR0 JYEAR1 = JYEAR0 JMON1 = JMON0 JDATE1 = JDATE0 JHOUR1 = JHOUR0 JDAY1 = JDAY0 endif C**** Accumulate computing time MDYNAS = MDYNAS + MDYNA MDYNOS = MDYNOS + MDYNO MRADS = MRADS + MRAD MSURFS = MSURFS + MSURF MCNDSS = MCDNSS + MCNDS MSRCOS = MSRCOS + MSRCO MDIAGS = MDIAGS + MDIAG MELSES = MELSES + MELSE GO TO 100 C**** C**** End of input files C**** C**** Print table of input years and months, calculate OUTYR and OUTMON 200 CALL PRNTYM (OUTYR,OUTMON) OPEN (2,FILE='AVER070.O',FORM='UNFORMATTED') C**** Store diagnostics for time averaging, DO 210 N=1,15 210 IDACC(N) = IDACCS(N) C**** Store adjusted timing IDT = IDT2 IHOUR = IHOUR2 IDAY = IDAY2 IYEAR = IYEAR2 JYEAR = JYEAR2 JMON = JMON2 JDATE = JDATE2 JHOUR = JHOUR2 JDAY = JDAY2 JYEAR0 = JYEAR1 JMON0 = JMON1 JDATE0 = JDATE1 JHOUR0 = JHOUR1 JDAY0 = JDAY1 DO 250 J=1,JM CONSRS(J, 1) = CONS01(J) CONSRS(J, 10) = CONS10(J) CONSRS(J, 20) = CONS20(J) CONSRS(J, 26) = CONS26(J) CONSRS(J, 32) = CONS32(J) CONSRS(J, 38) = CONS38(J) CONSRS(J, 43) = CONS43(J) CONSRS(J, 47) = CONS47(J) CONSRS(J, 51) = CONS51(J) CONSRS(J, 55) = CONS55(J) CONSRS(J, 59) = CONS59(J) CONSRS(J, 65) = CONS65(J) CONSRS(J, 71) = CONS71(J) CONSRS(J, 79) = CONS79(J) CONSRS(J, 87) = CONS87(J) CONSRS(J, 95) = CONS95(J) CONSRS(J,104) = CONSA4(J) CONSRS(J,109) = CONSA9(J) CONSRS(J,117) = CONSB7(J) CONSRS(J,125) = CONSC5(J) 250 CONSRS(J,131) = CONSD1(J) C**** Store computing time MDYNA = MDYNAS MDYNO = MDYNOS MRAD = MRADS MSURF = MSURFS MCNDS = MCNDSS MSRCO = MSRCOS MDIAG = MDIAGS MELSE = MELSES C**** C**** Write time averaged values to diagnostic output file C**** WRITE (2) IHOUR,LABEL,IPARM,IDIAG,(SNGL(DIAGS(K)),K=1,KDACCx), * (SNGL(CONSRS(K,1)),K=1,JM*KCONx),IHOUR CLOSE (2) C**** C**** Write timing to unit 6 C**** SUMM = MDYNA+MDYNO+MRAD+MSURF+MCNDS+MSRCO+MDIAG+MELSE MperD = SUMM / (IDACC(12)*6000) ! minutes per simulated day PDYNA = 100.d0*MDYNA/SUMM PDYNO = 100.d0*MDYNO/SUMM PRAD = 100.d0*MRAD /SUMM PSURF = 100.d0*MSURF/SUMM PCNDS = 100.d0*MCNDS/SUMM PSRCO = 100.d0*MSRCO/SUMM PDIAG = 100.d0*MDIAG/SUMM PELSE = 100.d0*MELSE/SUMM WRITE (6,940) MperD,PDYNA,PDYNO,PRAD,PSURF,PCNDS,PSRCO,PDIAG,PELSE C**** C**** Write OUTYR and OUTMON C**** WRITE (6,950) JYEAR0,JMON0, JYEAR,JMON WRITE (6,951) LABEL(1:5),OUTMON,OUTYR WRITE (0,951) LABEL(1:5),OUTMON,OUTYR CLOSE (6) GO TO 999 C**** 800 WRITE (0,*) 'Usage: AVER070 /raid1/C070/D*1979 ', * 'make AVERaged diagnostic file 98/04/10' GO TO 999 810 WRITE (0,*) 'Error accessing ',FILEIN STOP 810 820 WRITE (0,*) 'IHOURX and IHOURY do not match:',IHOURX,IHOURY STOP 820 C**** 911 FORMAT (' From',I6,A5,' to',I6,A5,' FILEIN= ',A) 940 FORMAT ('0per SimDay Atmo Dyn Ocean Dyn ', * ' Radiation Surface Condensat Ocean Src ', * ' Diagnost Other' / * 1X,F5.2,' (Min) Percent:',F6.1,7F12.1) 950 FORMAT (' From',I6,A5,' to',I6,A5,' Composite input files') 951 FORMAT (' AVERaged diagnostic file written:',A6,A5,A4) 999 END SUBROUTINE STORYM (JYEAR0,JMON0, JYEAR,JMON) C**** C**** STORYM receives years and months and stores them in an array. C**** C**** Start of accumulation period: JYEAR0, JMON0, day 1, hour 0 C**** End of accumulation period: JYEAR, JMON, day 1, hour 0 C**** INTEGER*4 NYofM(12) CHARACTER*1 QMY(12,0:2500) CHARACTER*4 JMON0,JMON, MON(12), OUTYR,OUTMON DATA QMY /30012*' '/, NYofM/12*0/, MINYR/2501/, MAXYR/-1/ DATA MON /'Jan','Feb','Mar','Apr','May','Jun', * 'Jul','Aug','Sep','Oct','Nov','Dec'/ C**** IF(JMON0.eq.'Ann ') JMON0 = 'Jan ' ! compatible with prior vers DO 10 I=1,12 10 IF(JMON0.eq.MON(I)) GO TO 20 WRITE (6,901) JYEAR0,JMON0, JYEAR,JMON, 'JMON0 is not a month.' WRITE (0,901) JYEAR0,JMON0, JYEAR,JMON, 'JMON0 is not a month.' STOP 10 20 IMON0 = I DO 30 I=1,12 30 IF(JMON.eq.MON(I)) GO TO 40 WRITE (6,901) JYEAR0,JMON0, JYEAR,JMON, 'JMON is not a month.' WRITE (0,901) JYEAR0,JMON0, JYEAR,JMON, 'JMON is not a month.' STOP 30 40 IMON = I IF(IMON.gt.IMON0) then IMON = IMON-1 IYEAR = JYEAR else IMON = IMON+11 IYEAR = JYEAR-1 endif C**** DO 50 IY=JYEAR0,IYEAR DO 50 IM=IMON0 ,IMON IF(QMY(IM,IY).eq.'*') GO TO 805 QMY(IM,IY) = '*' JM = 1 + MOD(IM-1,12) NYofM(JM) = NYofM(JM) + 1 IF(JYEAR0.lt.MINYR) MINYR = JYEAR0 50 IF(JYEAR .gt.MAXYR) MAXYR = JYEAR RETURN C**** C**** C**** ENTRY PRNTYM (OUTYR,OUTMON) C**** C**** PRNTYM prints a table of input years and month, and C**** calculates OUTYR and OUTMON C**** C**** Output: OUTYR = character describing input years C**** OUTMON = character describing input months C**** C**** Produce printer table of months and years received C**** WRITE (6,910) DO 110 IY=MINYR,MAXYR 110 WRITE (6,911) IY,(QMY(IM,IY),IM=1,12) C**** C**** Determine output month: a single month, three months, or an annual C**** DO 210 M=1,12 210 IF(NYofM(M).gt.0) GO TO 220 GO TO 800 C**** Is output month a single month ? 220 M1 = M DO 230 M=M1+1,12 230 IF(NYofM(M).gt.0) GO TO 240 OUTMON = MON(M1) GO TO 400 C**** Is output twelve months ? 240 IF(M1.ne.1) GO TO 260 DO 250 M=2,12 250 IF(NYofM(M).ne.NYofM(M1)) GO TO 260 OUTMON = 'Ann ' GO TO 400 C**** Is output month three consecutive months ? 260 IF(M1.ge.11) GO TO 800 IF(NYofM(M1+1).ne.NYofM(M1)) GO TO 280 IF(NYofM(M1+2).ne.NYofM(M1)) GO TO 300 DO 270 M=M1+3,12 270 IF(NYofM(M).ne.0) GO TO 800 OUTMON = MON(M1)(1:1) // MON(M1+1)(1:1) // MON(M1+2)(1:1) // ' ' GO TO 400 C**** Is output 3 months November, December and January ? 280 IF(NYofM(11).ne.NYofM(1) .or. NYofM(12).ne.NYofM(1)) GO TO 800 DO 290 M=2,10 290 IF(NYofM(M).ne.0) GO TO 800 OUTMON = 'NDJ ' GO TO 400 C**** Is output 3 months December, January and February ? 300 IF(NYofM(12).ne.NYofM(1) .or. NYofM(2).ne.NYofM(1)) GO TO 800 DO 310 M=3,11 310 IF(NYofM(M).ne.0) GO TO 800 OUTMON = 'DJF ' C**** C**** Calculate the first and last years received, C**** and determine a character string describing those years C**** 400 MAXYR = MINYR + NYofM(M1) - 1 WRITE (OUTYR,940) MINYR IF(MINYR.lt.MAXYR) * WRITE (OUTYR,941) MOD(MINYR,100),MOD(MAXYR,100) IF(MINYR+8.le.MAXYR .and. MINYR/10.eq.MAXYR/10) * WRITE (OUTYR,942) MINYR/10 WRITE (6,943) OUTYR,OUTMON RETURN C**** 800 WRITE (6,*) 'From AVER070: inconsistant year and months received' WRITE (0,*) 'From AVER070: inconsistant year and months received' STOP 800 805 WRITE (6,901) JYEAR0,JMON0, JYEAR,JMON, 'accumulated already' WRITE (0,901) JYEAR0,JMON0, JYEAR,JMON, 'accumulated already' STOP 805 C**** 901 FORMAT (' From',I6,A5,' to',I6,A5,1X,A) 910 FORMAT ('0The following months and years were received:' / '0', * 9X,'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec') 911 FORMAT (1X,I6,21A5) 940 FORMAT (I4) 941 FORMAT (2I2.2) 942 FORMAT (I3,'X') 943 FORMAT ('0Description of the years and months above:',2A5) END