Versions Compared

Old Version 13

changes.mady.by.user Marcus Slavenas

Saved on

compared with

New Version 14

changes.mady.by.user Marcus Slavenas

Saved on

Key

  • This line was added.
  • This line was removed.
  • Formatting was changed.

...

run modelexample
./cmp_n_week <state> <climate division> <year>./cmp_n_week 11 09 2017






Code Block

c input - get previous year quarterly temperature and precipitation diffeences
  print *, '2 CD = ',CD
  open(unit=1,file=ST//CD,status='old', form='formatted')
   do i=1,366
  tmn(i)=999.9
  ppt(i)=999.9
  enddo
c normals are done
CodeComments

 Code Block
program compute
   
program
 
compute
week
 
week
   implicit none

c

    ! compute: norms curr_week_diffs and MIR

c


    ! compute 30-yr (1981-2010) daily weather normal data from each Illinois CD

c


    ! for analysis year and previous year compute based on CDC EPI week

c

    ! in 2016 and 2017, begin day use = saturday to friday

c

    ! in 2018, change to sunday to Saturday

c


    ! CDC defines ending saturday: The first epi week of the year ends,

c

    !  by definition, on the first Saturday of January,

c

    !  as long as it falls at least four days into the month.

c

    !  Each epi week begins on a Sunday and ends on a Saturday.

c


 
get
 
daily
 
data 
 ! get daily data for analysis year.

c

    !   compute weekly normals and weekly current year observations.

c

    !   compute weekly difference between analysis year and normals.

c

    ! weekly temp avg ( C);

c

    ! weekly precip tot (cm);

c

    ! weekly degree day avg based on 22 C. (accumate over time from Jan 1 to dec 31)

c


    ! first saturday set up through 2020.

c

    ! 2017, change to first sunday

c

    ! VET-MED first epi week ends on first saturday of january, unless falls after

c

    ! January 3, then ends in corresponding december day.

c


    ! as per Karki:

c

 
begin
 
jan
 
1 
 ! begin jan 1 all years and go thru 365 days.

c

    ! weeks: 49-52,1-9 = WInter

c

    !        10-22 = SPring (CDC spring ends week 22)

c

    !        23-35 = SUmmer

c

    !        36-48 = FAll

c


    ! bflg=0

c

    ! bflg=1



    character*1 c


    character*2 ST, CD, cstate


    character*4 ayear



    integer icd, iyear, year, mon, day, i, j, k, m, bflg


    integer mm(366), dd(366)


    integer icdi


    real t(366, 30), p(366, 30), d(366, 30), dum_d, dsum_d


    real wt(53, 30), wp(53, 30), wd(53, 30)



    real tmax, tmin, tmean, prcp


    real wknorm_t(53), wknorm_p(53), wknorm_d(53), wknorm_np(53)


    real wksum_t(53), wksum_p(53), wksum_d, wksum_np(53)



    real tmn(366), ppt(366), ddd(366)



    real wctmn(53), wcppt(53), wcddd(53), wcsum_d


    real df_wkt(53), df_wkp(53), df_wkd(53), df_wknp(53)

c


    !       integer begday(40),begmon(40)


    integer begyr(40), ndays(40)


    integer nbegday(40), nbegyr(40), nbegmon(40)


    integer bday, bmon, nday, byear, n, end, endk



    real WInorm_t, SPnorm_t, SUnorm_t, FAnorm_t


    real WIsum_t, SPsum_t, SUsum_t, FAsum_t


    real WInorm_d, SPnorm_d, SUnorm_d, FAnorm_d


    real WIsum_d, SPsum_d, SUsum_d, FAsum_d



    real WInorm_p, SPnorm_p, SUnorm_p, FAnorm_p


    real WIsum_p, SPsum_p, SUsum_p, FAsum_p



    real WInorm_np, SPnorm_np, SUnorm_np, FAnorm_np


    real WIsum_np, SPsum_np, SUsum_np, FAsum_np



    real SP_prev_yr_t, SP_prev_yr_d, SP_prev_yr_p, SP_prev_yr_np


    real SU_prev_yr_t, SU_prev_yr_d, SU_prev_yr_p, SU_prev_yr_np


    real FA_prev_yr_t, FA_prev_yr_d, FA_prev_yr_p, FA_prev_yr_np



    real SP_prev_sum_t, SP_prev_sum_d, SP_prev_sum_p, SP_prev_sum_np


    real SU_prev_sum_t, SU_prev_sum_d, SU_prev_sum_p, SU_prev_sum_np


    real FA_prev_sum_t, FA_prev_sum_d, FA_prev_sum_p, FA_prev_sum_np



    real WI_curr_yr_t, 
 
WI_curr_yr_d, 
 
WI_curr_yr_p,
 
 WI_curr_yr_np


    real SP_curr_yr_t,
 
 SP_curr_yr_d, 
 
SP_curr_yr_p,
 
 SP_curr_yr_np



    real WI_curr_sum_t, WI_curr_sum_d, WI_curr_sum_p, WI_curr_sum_np


    real SP_curr_sum_t, SP_curr_sum_d, SP_curr_sum_p, SP_curr_sum_np



    real df_WIc_t, df_WIc_p, df_WIc_d, df_WIc_np


    real df_SPc_t, df_SPc_p, df_SPc_d, df_SPc_np


    real df_SPp_t, df_SPp_p, df_SPp_d, df_SPp_np


    real df_SUp_t, df_SUp_p, df_SUp_d, df_SUp_np


    real df_FAp_t, df_FAp_p, df_FAp_d, df_FAp_np



    character *86 line1


    integer wk(53), cumwk(53)


    real cd_dylt(53, 9), cd_avg_mir(53, 13), cd_2012mir(53, 13)



    real dum1, dum2, dum3, dum4, dum5, dum6, dum7


    real mir(53), daylit(53), mir_cur(53)


    real mir2012(53, 13)


    real ACT_mir(52, 9), ACTm_mir(52, 9), ACTp_mir(52, 9)


    real cd_act_mir(53, 13)



    real intercept(13)


    real cDW_Lg1(13), cDW_Lg2(13), cDW_Lg3(13), cDW_Lg4(13)


    real cPr_Lg1(13), cPr_Lg2(13), cPr_Lg3(13), cPr_Lg4(13)


    real cDWLg1xPLg1(13), cDWLg1xPLg2(13)


    real cDWLg1xPLg3(13), cDWLg1xPLg4(13)


    real cDWLg2xPLg1(13), cDWLg2xPLg2(13)


    real cDWLg2xPLg3(13), cDWLg2xPLg4(13)


    real cDWLg3xPLg1(13), cDWLg3xPLg2(13)


    real cDWLg3xPLg3(13), cDWLg3xPLg4(13)


    real cDWLg4xPLg1(13), cDWLg4xPLg2(13)


    real cDWLg4xPLg3(13), cDWLg4xPLg4(13)


    real cSPc_temp(13), CSPc_prcp(13)


    real cWIc_temp(13), cSPp_temp(13), cSUp_temp(13), cFAp_temp(13)


    real cWIc_prcp(13), cSPp_prcp(13), cSUp_prcp(13), cFAp_prcp(13)


    real cDayLite(13), cDWLg1xDayLite_Lg1(13)


    real cDayLite_Lg1(13), cDayLite_Lg2(13)


    real cDayLite_Lg3(13), cDayLite_Lg4(13)



    integer ilcd, rundate


    character*10 valdate


    character*6 cprcp6


    character*5 lab1


    character*20 lab(40)


    real prcpd(10, 9), mxtemp(10, 9), mntemp(11, 9), prcp6(13, 9)


    integer n_mxT, n_mnT, n_ppt


    integer ncurr


    integer firstmon, firstday


    character*2 cfirstmon, cfirstday



    integer pday(53), pmon(53), pdd(366), pmm(366)


    character*2 cpdd, cpmm


    integer nwk(53)


    integer pm, pd


    integer wmonth(52), wday(52), wweek(52), wyear


    character*10 wdate


    character*3 wdow


    integer emon, eday

c


 
used
 
to
 
comply 
 ! used to comply with epi week beginning in December

c

    ! for previous year (iyear-1) and analysis year (iyear)

c

    ! for 2016 and 2017


    data nbegday/3, 2, 1, 31, 29, 28, 3, 2, 31, 30,

 ! 29,28,2,1,31,30,29,3,2,1,
 ! 30,29,28,3,1,31,30,29,3,2,
 ! 1,31,29,28,3,2,31,30,29,28/
   data nbegmon/1,1,1,12,12,12,1,1,12,12,
 ! 12,12,1,1,12,12,12,1,1,1,
 ! 12,12,12,1,1,12,12,12,1,1,
 ! 1,12,12,12,1,1,12,12,12,12/
   data nbegyr/1981,1982,1983,1983,1984,1985,1987,1988,1988,1989,
 ! 1990,1991,1993,1994,1994,1995,1996,1998,1999,2000,
 ! 2000,2001,2002,2004,2005,2005,2006,2007,2009,2010,
 ! 2011,2011,2012,2013,2015,2016,2016,2017,2018,2019/
c for 2018
c defining years, months, days, epi weeks for previous year and analysis years
c data nbegday/4,3,2,1,30,29,4,3,1,31,
c ! 30,29,3,2,1,31,30,4,3,2,
c ! 31,30,29,4,2,1,31,30,4,3,
c ! 2,1,30,29,4,3,1,31,30,29/
c
 &
            1, 31, 29, 28, 3, 2, 31, 30, 29, 28/
    data nbegmon/1, 1, 1, 12, 12, 12, 1, 1, 12, 12, &
            1, 12, 12, 12, 1, 1, 12, 12, 12, 12/
    data nbegyr/1981, 1982, 1983, 1983, 1984, 1985, 1987, 1988, 1988, 1989, &
            2011, 2011, 2012, 2013, 2015, 2016, 2016, 2017, 2018, 2019/


    ! for 2018
    ! defining years, months, days, epi weeks for previous year and analysis years
    !        data nbegday/4,3,2,1,30,29,4,3,1,31,
    !     !         30,29,3,2,1,31,30,4,3,2,
    !     !         31,30,29,4,2,1,31,30,4,3,
    !     !         2,1,30,29,4,3,1,31,30,29/
    !        data nbegmon/1,1,1,1,12,12,1,1,1,12,

c

    !     !         12,12,1,1,1,12,12,1,1,1,

c !

    !     !         12,12,12,1,1,1,12,12,1,1,

c

    !
 1,1,
     !         1,1,12,12,1,1,1,12,12,12/

c

    !        data nbegyr/1981,1982,1983,1984,1984,1985,1987,1988,1989,1989,

c !

    !     !        1990,1991,1993,1994,1995,1995,1996,1998,1999,2000,

c

    !     !        2000,2001,2002,2004,2005,2006,2006,2007,2009,2010,

c !

    !     !        2011,2012,2012,2013,2015,2016,2017,2017,2018,2019/

c


    ! USE REGARDLESS


    data begyr/1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990,

 ! 1991,1992,1993,1994,1995,1996,1997,1998,1999,2000,
 ! 2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,
 ! 2011,2012,2013,2014,2015,2016,2017,2018,2019,2020/
 &
            2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020/
    data ndays/365, 365, 365, 366, 365, 365, 365, 366, 365, 365,

 !
 &
            365, 366, 365, 365, 365, 366, 365, 365,
365,366,
 
! 365,365,365,366,365,365,
365
,366
,
365,365,
 !
 
365,
366
,365,365,365,366,365,365,365,366/
/
    call getarg (1, ST)


    call getarg (1, ST)


    call getarg (2, CD)


    call getarg (3, ayear)

c


    ! read from character to integer


    read(ayear, 25) iyear


    25    format(i4)


    read(CD, 26) icd


    26    format(i2)

c

    !        print *, 'CD = ',icd,' ST = ',ST,'iyear= ',iyear



    c = ','



    do j = 1,
30
 30
        do i = 1,
366
 366
            t(i, j) = 999.9


            d(i, j) = 0.0


            p(i, j) = 999.9


        enddo


    enddo

  • Initialize

 Code Block
!
c
 input for days of week for current year

  

open(unit = 2, file = 'week_days_2016.csv', status = 'old',

 !
 &
        form = 'formatted')

   

read (2, *) line1

   

do i = 1, 52


    read (2, *) wmonth(i), wday(i), wweek(i), wyear, wdate, wdow

   enddo
  

enddo
close(2)

cMONTH

!MONTH,DAY,WEEK,YEAR,DATE,DOW

c1

!1,2,1,2016,1/2/2016,SAT



INPUT FILE
week_days_2016.csv
  • Read in CDC Week
    • can this be generalized?

 Code Block
c
! input for normals (1981-2010 daily)

  

open(unit = 3, file = ST // CD // 'w_' // ayear,

 &
  
! status=
      status = 'unknown', form = 'formatted')

OUTPUT FILE
e.g., 1109w_2017
 SPRING Prev_YR NORM DIF for T D and P
  14.57, 13.22,  1.35,      0.00,  0.00,  0.00,      2.95,  2.52,  0.43
 SUMMER Prev_YR NORM DIF for T D and P
  25.48, 24.38,  1.09,      0.00, 15.34,  0.00,      3.47,  1.80,  1.67
 FALL Prev_YR NORM DIF for T D and P
  16.03, 14.05,  1.98,      0.00, 32.28,  0.00,      1.59,  2.03, -0.44


 Code Block

c ananlyis file
  open(unit=4,file=ST//CD//'_'//ayear//'_mir',
 ! status='unknown',form='formatted')
  write (4,*) ' i i+1 CD iyr yr week MIR avg_mir mir_cur act_
 !mir day_lt df_wkd df_wkp aSPc_p aWIc_p aFAp_p aSUp_p aSPp_p
 ! aSPc_t aWIc_t aFAp_t aSUp_t aSPp_t'
OUTPUT FILE

 Code Block

c MIR file
  open(unit=8,file=ST//CD//'_'//ayear//'_plot',
 ! status='unknown',form='formatted')
   write (8,*) ' CD yr week month day 2012_mir avg_mir curr_mir
 ! ACT_mir ACTm_mir ACTp_mir'
OUTPUT FILE

 Code Block

c NORMALS computations
c put data in daily,yearly array to compute normalso
c same normals for each analysis year
c week 1, 8 days, dec 29-Jan 5;
c all other weeks=7 days (skip day 365 on new year)

c read into array
  print *, '1 CD = ',CD
   print *, ST//CD//'n'
  open(unit=10,file=ST//CD//'n',status='old', form='formatted')
c for normals
  bmon = 12
  bday = 29
  emon = 12
  eday = 28
  nday=365
c becasue skip 2/29

  do j=1,30
  bflg=0

c print *, 'byear ',byear,'bmon ',bmon,'bday ',bday,' nday ',nday


  do i=1,nday
1 read (10,5,end=999) cstate,icd,year,mon,day,tmax,tmin,prcp
5 format (a2,1x,i2,1x,i4,1x,i2,1x,i2,1x,f5.1,1x,f5.1,1x,f8.2)
     if (mon .eq. 2 .and. day .eq. 29) go to 1

  if (bflg .eq. 1) go to 3
  if (bflg .eq. 0 .and.
 ! year.lt.byear .or. mon.lt.bmon .or. day.lt.bday) then
c print *,'passed test ',year,byear,mon,bmon,day,bday
  go to 1
  endif

3 bflg=1
  dd(i)=day
     mm(i)=mon

    if (year.gt.2010) then
 go to 999
 endif
c write (*,*) i,year,mon,day,tmax,tmin,prcp,byear,bmon,bday
COMPUTE NORMALS

 Code Block

c compute daily mean
c convert to celcius from farenheit
c compute degree days, base 22 C
c convert to cm from inches
  t(i,j)=(5.0/9.0)*(((tmax+tmin)/2.0)-32.0)
    p(i,j)=prcp*2.54

  if (day.eq.eday .and. mon.eq.emon) then
  print *,i,' ',j,' ',year,' ',mon,' ',day
    go to 998
  endif
c go to next year at nday=365
998 enddo

c close(10)
  enddo

999 close(10)


 Code Block

c compute weekly daily averages for d and t (and weekly sum for precip) for each 30 years of data (1981-2010)

  do j=1,30

c compute average T and sum P for 7 day weeks
  do i=1,8
  k=1
  wt(1,j) = (t(i,j)+t((i+1),j)+t((i+2),j)+t((i+3),j)+t((i+4),j)
 ! +t((i+5),j)+t((i+6),j)+t((i+7),j))/8.0
  wp(1,j) = (p(i,j)+p((i+1),j)+p((i+2),j)+p((i+3),j)+p((i+4),j)
 ! +p((i+5),j)+p((i+6),j)+p((i+7),j))

   print *, j,k,t(i,j),t((i+1),j),t((i+2),j),t((i+3),j),t((i+4),j),
 ! t((i+5),j),t((i+6),j)
   enddo

  do i=9,365,7
  k=k+1
c compute average T and sum P for 7 day weeks

  wt(k,j) = (t(i,j)+t((i+1),j)+t((i+2),j)+t((i+3),j)+t((i+4),j)
 ! +t((i+5),j)+t((i+6),j))/7.0
  wp(k,j) = (p(i,j)+p((i+1),j)+p((i+2),j)+p((i+3),j)+p((i+4),j)
 ! +p((i+5),j)+p((i+6),j))

c print *, i,j,k,t(i,j),t((i+1),j),t((i+2),j),t((i+3),j),t((i+4),j),
c ! t((i+5),j),t((i+6),j)
c print *,'weekly sum and avg ppt_cm',i,j,k,wp(k,j),(wp(k,j)/7.0)
c print *,i,j,k,p(i,j),p((i+1),j),p((i+2),j),p((i+3),j),p((i+4),j),
c ! p((i+5),j),p((i+6),j),wp(k,j),(wp(k,j)/7.0)

  enddo
  enddo
COMPUTE WEEKLY DAILY AVERAGES
d,t?
 Code Block

c compute 30-year weekly normals
  do k=1,53
  wknorm_t(k)=0.0
  wknorm_p(k)=0.0
  wknorm_d(k)=0.0
  wksum_t(k)=0.0
  wksum_p(k)=0.0
  enddo

c compute weekly 30-year normals
  do k=1,52
  do j=1,30
  wksum_t(k)=wksum_t(k)+wt(k,j)
       wksum_p(k)=wksum_p(k)+wp(k,j)
c wksum_d(k)=wksum_d(k)+wd(k,j)
  enddo
  wknorm_t(k)=wksum_t(k)/30.
  wknorm_p(k)=wksum_p(k)/30.
c wknorm_d(k)=wksum_d(k)
/30.
c print *,'wk,week_norms_p,weeksum_p',k,wknorm_p(k),wksum_p(k)
  enddo
  wknorm_t(53)=wknorm_t(1)
       wknorm_p(53)=wknorm_p(1)
c wknorm_d(53)=wknorm_d(1)
c compute weekly dw 30-yr normals
  do k=1,53
  wknorm_d(k)=0.0
  enddo
  do k=1,53
c if weekly average temperature is greater than 22:
  if(wknorm_t(k) .gt. 22.0) then
  wksum_d = wksum_d+(wknorm_t(k)-22.0)
   elseif (wknorm_t(k) .le. 22.0) then
  wksum_d = wksum_d+0.0
  endif
  wknorm_d(k)=wksum_d
   enddo
c compute seasonal weekly 30-year normals
  do k=1,9
  WIsum_t =WIsum_t +wknorm_t(k)
       WIsum_p =WIsum_p +wknorm_p(k)
c WIsum_np=WIsum_np+wknorm_np(k)
  WIsum_d =WIsum_d +wknorm_d(k)
   enddo
  do k=49,52
  WIsum_t =WIsum_t +wknorm_t(k)
       WIsum_p =WIsum_p +wknorm_p(k)
c WIsum_np=WIsum_np+wknorm_np(k)
  WIsum_d =WIsum_d +wknorm_d(k)
   enddo
  do k=10,22
  SPsum_t =SPsum_t +wknorm_t(k)
       SPsum_p =SPsum_p +wknorm_p(k)
c SPsum_np=SPsum_np+wknorm_np(k)
  SPsum_d =SPsum_d +wknorm_d(k)
   enddo
  do k=23,35
  SUsum_t =SUsum_t+wknorm_t(k)
       SUsum_p =SUsum_p+wknorm_p(k)
c SUsum_np=SUsum_np+wknorm_np(k)
  SUsum_d =SUsum_d+wknorm_d(k)
   enddo
  do k=36,48
  FAsum_t =FAsum_t +wknorm_t(k)
       FAsum_p =FAsum_p +wknorm_p(k)
c FAsum_np=FAsum_np+wknorm_np(k)
  FAsum_d =FAsum_d +wknorm_d(k)
   enddo
c seasonal weekly normals
  WInorm_t=WIsum_t/13.
  SPnorm_t=SPsum_t/13.
  SUnorm_t=SUsum_t/13.
  FAnorm_t=FAsum_t/13.
  WInorm_d=WIsum_d/13.
  SPnorm_d=SPsum_d/13.
  SUnorm_d=SUsum_d/13.
  FAnorm_d=FAsum_d/13.
  WInorm_p=WIsum_p/13.
  SPnorm_p=SPsum_p/13.
  SUnorm_p=SUsum_p/13.
  FAnorm_p=FAsum_p/13.
print *, 'seasonal Weekly Norm Temp deg_day prcp'
print *, 'WInter norm',' ',WInorm_t,' ',WInorm_d,' ',WInorm_p
print *, 'SPring norm',' ',SPnorm_t,' ',SPnorm_d,' ',SPnorm_p
print *, 'SUmmer norm',' ',SUnorm_t,' ',SUnorm_d,' ',SUnorm_p
print *, 'FAll norm ',' ',FAnorm_t,' ',FAnorm_d,' ',FAnorm_p
COMPUTE NORMALS
/30.
c print *,'wk,week_norms_p,weeksum_p',k,wknorm_p(k),wksum_p(k)
  enddo
  wknorm_t(53)=wknorm_t(1)
       wknorm_p(53)=wknorm_p(1)
c wknorm_d(53)=wknorm_d(1)

c compute weekly dw 30-yr normals
  do k=1,53
  wknorm_d(k)=0.0
  enddo

  do k=1,53
c if weekly average temperature is greater than 22:
  if(wknorm_t(k) .gt. 22.0) then
  wksum_d = wksum_d+(wknorm_t(k)-22.0)
   elseif (wknorm_t(k) .le. 22.0) then
  wksum_d = wksum_d+0.0
  endif
  wknorm_d(k)=wksum_d
   enddo

c compute seasonal weekly 30-year normals
  do k=1,9
  WIsum_t =WIsum_t +wknorm_t(k)
       WIsum_p =WIsum_p +wknorm_p(k)
c WIsum_np=WIsum_np+wknorm_np(k)
  WIsum_d =WIsum_d +wknorm_d(k)
   enddo
  do k=49,52
  WIsum_t =WIsum_t +wknorm_t(k)
       WIsum_p =WIsum_p +wknorm_p(k)
c WIsum_np=WIsum_np+wknorm_np(k)
  WIsum_d =WIsum_d +wknorm_d(k)
   enddo

  do k=10,22
  SPsum_t =SPsum_t +wknorm_t(k)
       SPsum_p =SPsum_p +wknorm_p(k)
c SPsum_np=SPsum_np+wknorm_np(k)
  SPsum_d =SPsum_d +wknorm_d(k)
   enddo
  do k=23,35
  SUsum_t =SUsum_t+wknorm_t(k)
       SUsum_p =SUsum_p+wknorm_p(k)
c SUsum_np=SUsum_np+wknorm_np(k)
  SUsum_d =SUsum_d+wknorm_d(k)
   enddo
  do k=36,48
  FAsum_t =FAsum_t +wknorm_t(k)
       FAsum_p =FAsum_p +wknorm_p(k)
c FAsum_np=FAsum_np+wknorm_np(k)
  FAsum_d =FAsum_d +wknorm_d(k)
   enddo

c seasonal weekly normals
  WInorm_t=WIsum_t/13.
  SPnorm_t=SPsum_t/13.
  SUnorm_t=SUsum_t/13.
  FAnorm_t=FAsum_t/13.

  WInorm_d=WIsum_d/13.
  SPnorm_d=SPsum_d/13.
  SUnorm_d=SUsum_d/13.
  FAnorm_d=FAsum_d/13.

  WInorm_p=WIsum_p/13.
  SPnorm_p=SPsum_p/13.
  SUnorm_p=SUsum_p/13.
  FAnorm_p=FAsum_p/13.

print *, 'seasonal Weekly Norm Temp deg_day prcp'
print *, 'WInter norm',' ',WInorm_t,' ',WInorm_d,' ',WInorm_p
print *, 'SPring norm',' ',SPnorm_t,' ',SPnorm_d,' ',SPnorm_p
print *, 'SUmmer norm',' ',SUnorm_t,' ',SUnorm_d,' ',SUnorm_p
print *, 'FAll norm ',' ',FAnorm_t,' ',FAnorm_d,' ',FAnorm_p
COMPUTE NORMALS

 Code Block

c input - get previous year quarterly temperature and precipitation diffeences

  print *, '2 CD = ',CD
  open(unit=1,file=ST//CD,status='old', form='formatted')
   do i=1,366
  tmn(i)=999.9
  ppt(i)=999.9
  enddo

c normals are done
GET PREVIOUS YEAR
1109
 Code Block

c previouw year = iyear-1
c good for 1981 to 2020 (i=1 to 40)
  do i=1,40
  if (begyr(i) .eq. iyear-1) then
  byear=nbegyr(i)
     nday=ndays(i)
     bday=nbegday(i)
     bmon=nbegmon(i)
   endif
  enddo

  n=0
  bflg=0
  dsum_d=0
  do i=1,nday
9 read (1,5,end=19) cstate,icd,year,mon,day,tmax,tmin,prcp
    if (bflg.eq. 1) go to 18
  if (bflg.eq. 0 .and.
 ! year.lt.byear .or. mon.lt. bmon .or. day.lt.bday) then
  dsum_d=0
  go to 9
  endif
  bflg=1
c18 write (*,*) i,iyear,year,mon,day,tmax,tmin,prcp,bflg
18 n=n+1

  if (tmax .eq. 999.9) go to 19
c mean temperature
c convert to centigrade
c convert to cm
  write (*,5) cstate,icd,year,mon,day,tmax,tmin,prcp
    tmn(i)=(5.0/9.0)*(((tmax+tmin)/2.0)-32.0)
    ppt(i)=prcp*2.54
  if (ppt(i) .lt. 0) ppt(i)=999.9
c write (*,*) i,iyear,year,mon,day,tmn(i),ppt(i)
  enddo
19 close(1)
   print *,'iyear,n,nday = ',iyear,n,nday



 Code Block

c compute weekly averages for previous year
  do k=1,53
  wctmn(k)=999.9
  wcppt(k)=999.9
  enddo

  k=0
  do i=1,366,7
  k=k+1

c write (*,*) k,i,i+1,i+2,i+3,i+4,i+5,i+6
c print *, k, tmn(i),tmn(i+1),tmn(i+2),tmn(i+3),tmn(i+4),
c ! tmn(i+5),tmn(i+6)
c print *, k, ppt(i),ppt(i+1),ppt(i+2),ppt(i+3),ppt(i+4),
c ! ppt(i+5),ppt(i+6)

  wctmn(k) = (tmn(i)+tmn(i+1)+tmn(i+2)+tmn(i+3)+tmn(i+4)
 ! +tmn(i+5)+tmn(i+6))/7.0
  wcppt(k) = (ppt(i)+ppt(i+1)+ppt(i+2)+ppt(i+3)+ppt(i+4)
 ! +ppt(i+5)+ppt(i+6))

c print *, 'prev_ yr weekly sum avg ppt ',wcppt(k),(wcppt(k)/7.0)
c write (*,*) ppt(i),ppt(i+1),ppt(i+2),ppt(i+3),ppt(i+4),
c ! ppt(i+5),ppt(i+6),wcppt(k),(wcppt(k)/7.0)
c print *, ' k,wcppt(k) = ',k,wcppt(k)
  enddo

  SP_prev_sum_t=0.0
  SP_prev_sum_p=0.0
  SP_prev_yr_t=0.0
  SP_prev_yr_p=0.0

  SU_prev_sum_t=0.0
  SU_prev_sum_p=0.0
  SU_prev_yr_t=0.0
  SU_prev_yr_p=0.0

  FA_prev_sum_t=0.0
  FA_prev_sum_p=0.0
  FA_prev_yr_t=0.0
  FA_prev_yr_p=0.0

c get december from previous year
  WI_curr_sum_t=0.0
  WI_curr_sum_p=0.0
  WI_curr_yr_t=0.0
  WI_curr_yr_p=0.0


  do k=10,22
  SP_prev_sum_t = SP_prev_sum_t+wctmn(k)
   SP_prev_sum_p = SP_prev_sum_p+wcppt(k)
   enddo
  SP_prev_yr_t=SP_prev_sum_t/13.0
  SP_prev_yr_p=SP_prev_sum_p/13.0
c SP_prev_yr_p=SP_prev_sum_p

  do k=23,35
  SU_prev_sum_t = SU_prev_sum_t+wctmn(k)
   SU_prev_sum_p = SU_prev_sum_p+wcppt(k)
   enddo
  SU_prev_yr_t=SU_prev_sum_t/13.0
  SU_prev_yr_p=SU_prev_sum_p/13.0
c SU_prev_yr_p=SU_prev_sum_p

  do k=36,48
  FA_prev_sum_t = FA_prev_sum_t+wctmn(k)
   FA_prev_sum_p = FA_prev_sum_p+wcppt(k)
   enddo
  FA_prev_yr_t=FA_prev_sum_t/13.0
  FA_prev_yr_p=FA_prev_sum_p/13.0
c FA_prev_yr_p=FA_prev_sum_p

  do k=49,52
  WI_curr_sum_t = WI_curr_sum_t+wctmn(k)
   WI_curr_sum_p = WI_curr_sum_p+wcppt(k)
   enddo


 Code Block

c compute quarterly previous year differences

  df_SPp_t=SP_prev_yr_t-SPnorm_t
   df_SPp_p=(SP_prev_yr_p-SPnorm_p)

   df_SUp_t=SU_prev_yr_t-SUnorm_t
   df_SUp_p=(SU_prev_yr_p-SUnorm_p)

   df_FAp_t=FA_prev_yr_t-FAnorm_t
   df_FAp_p=(FA_prev_yr_p-FAnorm_p)

   write (3,*)  'SPRING Prev_YR NORM DIF for T D and P'
  write (3,51) SP_prev_yr_t,c,SPnorm_t,c,df_SPp_t,c, SP_prev_yr_d,
 ! c,SPnorm_d,c,df_SPp_d,c, SP_prev_yr_p,c,SPnorm_p,c,df_SPp_p
   write (3,*)  'SUMMER Prev_YR NORM DIF for T D and P'
  write (3,51) SU_prev_yr_t,c,SUnorm_t,c,df_SUp_t,c, SU_prev_yr_d,
 ! c,SUnorm_d,c,df_SUp_d,c, SU_prev_yr_p,c,SUnorm_p,c,df_SUp_p
   write (3,*)  'FALL Prev_YR NORM DIF for T D and P'
  write (3,51) FA_prev_yr_t,c,FAnorm_t,c,df_FAp_t,c, FA_prev_yr_d,
 ! c,FAnorm_d,c,df_FAp_d,c, FA_prev_yr_p,c,FAnorm_p,c,df_FAp_p

   write (*,*)  'SPRING Prev_YR NORM DIF for T D and P'
  write (*,51) SP_prev_yr_t,c,SPnorm_t,c,df_SPp_t,c, SP_prev_yr_d,
 ! c,SPnorm_d,c,df_SPp_d,c, SP_prev_yr_p,c,SPnorm_p,c,df_SPp_p
   write (*,*)  'SUMMER Prev_YR NORM DIF for T D and P'
  write (*,51) SU_prev_yr_t,c,SUnorm_t,c,df_SUp_t,c, SU_prev_yr_d,
 ! c,SUnorm_d,c,df_SUp_d,c, SU_prev_yr_p,c,SUnorm_p,c,df_SUp_p
   write (*,*)  'FALL Prev_YR NORM DIF for T D and P'
  write (*,51) FA_prev_yr_t,c,FAnorm_t,c,df_FAp_t,c, FA_prev_yr_d,
 ! c,FAnorm_d,c,df_FAp_d,c, FA_prev_yr_p,c,FAnorm_p,c,df_FAp_p


 Code Block

c input - get model analysis year

  print *, '3 CD = ',CD
  open(unit=1,file=ST//CD,status='old',form='formatted')
   do i=1,366
  tmn(i)=999.9
  ppt(i)=999.9
  ddd(i)=0.0
  enddo

  do i=1,53
  df_wkd(k)=0.0
  enddo

GET PREVIOUS YEAR
1109
c previouw year = iyear-1
c good for 1981 to 2020 (i=1 to 40)
  do i=1,40
  if (begyr(i) .eq. iyear-1) then
  byear=nbegyr(i)
     nday=ndays(i)
     bday=nbegday(i)
     bmon=nbegmon(i)
   endif
  enddo
  n=0
  bflg=0
  dsum_d=0
  do i=1,nday
9 read (1,5,end=19) cstate,icd,year,mon,day,tmax,tmin,prcp
  

 Code Block

c set current analysis year = iyear
  do i=1,40
  if (begyr(i) .eq. iyear) then
  byear=nbegyr(i)
     nday=ndays(i)
     bday=nbegday(i)
     bmon=nbegmon(i)
   endif
  enddo
  print *,'byear nday bday bmon ',byear,' ',nday,' ',bday,' ',bmon

   n=0
  bflg=0
  dsum_d=0
  do i=1,nday
    cfirstmon='01'
  cfirstday='01'
10 read (1,5,end=88) cstate,icd,year,mon,day,tmax,tmin,prcp
    if (year.lt.byear .and. day.lt.bday .and. mon.lt.bmon) go to 10
c write (*,*) cstate,icd,year,mon,day,tmax,tmin,prcp,'begin',
c ! byear,bday,bmon

  if ((tmax .eq. -99 .or. tmin .eq. -99 .or. prcp .lt. 0.0)
 ! .and. n.gt.140) then
c for forecast
  firstday=day
    firstmon=mon
    write(cfirstmon,11) firstmon
    write(cfirstday,11) firstday
11 format(i2)
c to compensate for blanks ...
  if (cfirstmon .eq. ' 1') cfirstmon = '01'
  if (cfirstmon .eq. ' 2') cfirstmon = '02'
  if (cfirstmon .eq. ' 3') cfirstmon = '03'
  if (cfirstmon .eq. ' 4') cfirstmon = '04'
  if (cfirstmon .eq. ' 5') cfirstmon = '05'
  if (cfirstmon .eq. ' 6') cfirstmon = '06'
  if (cfirstmon .eq. ' 7') cfirstmon = '07'
  if (cfirstmon .eq. ' 8') cfirstmon = '08'
  if (cfirstmon .eq. ' 9') cfirstmon = '09'
  if (cfirstday .eq. ' 1') cfirstday = '01'
  if (cfirstday .eq. ' 2') cfirstday = '02'
  if (cfirstday .eq. ' 3') cfirstday = '03'
  if (cfirstday .eq. ' 4') cfirstday = '04'
  if (cfirstday .eq. ' 5') cfirstday = '05'
  if (cfirstday .eq. ' 6') cfirstday = '06'
  if (cfirstday .eq. ' 7') cfirstday = '07'
  if (cfirstday .eq. ' 8') cfirstday = '08'
  if (cfirstday .eq. ' 9') cfirstday = '09'
  go to 88
  endif

  if (bflg.eq. 1) go to 
18
8
  if (bflg.eq. 0 .and.
 ! year.lt.byear .or. mon.lt. bmon .or. day.lt.
bday) then
  dsum_d=0
  go to 9
  endif
  bflg=1
c18 write (*,*) i,iyear,year,mon,day,tmax,tmin,prcp,bflg
18 n=n+1
  if (tmax .eq. 999.9) go to 19
c mean temperature
c convert to centigrade
c convert to cm
  write (*,5) cstate,icd,year,mon,day,tmax,tmin,prcp
    tmn(i)=(5.0/9.0)*(((tmax+tmin)/2.0)-32.0)
    ppt(i)=prcp*2.54
  if (ppt(i) .lt. 0) ppt(i)=999.9
c
bday) then
  dsum_d=0
c print *, 'got iyear',iyear,'mon ',mon,'day ',day,'eday ',eday
  go to 10
  endif

  bflg=1
  write (*,*)'first bflg=1, i year mon day tmax tmin prcp'
  write (*,*) i,year,mon,day,' ',tmax,tmin,prcp
8 write (*,*) i,iyear,year,mon,day
,tmn(i),ppt(i)
  enddo
,tmax,tmin,prcp,bflg
  n=n+1


 Code Block



 Code Block



 Code Block



 Code Block



 Code Block



 Code Block