! !################################################################## !################################################################## !###### ###### !###### SUBROUTINE GET_TIME_STRING ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! SUBROUTINE get_time_string (curtime, time_string) 5,4 INCLUDE 'globcst.inc' REAL :: curtime CHARACTER (LEN=25) :: time_string INTEGER :: abstsec INTEGER :: rjday, wday INTEGER :: ryear,rmonth, rday, rhour, rmin, rsec CHARACTER (LEN=3) :: smonth(12) CHARACTER (LEN=3) :: weekday(0:6) CHARACTER (LEN=2) :: chour, cmin DATA smonth/'Jan','Feb','Mar','Apr','May','Jun', & 'Jul','Aug','Sep','Oct','Nov','Dec'/ DATA weekday/'Sun','Mon','Tue','Wed','Thu','Fri','Sat'/ CALL ctim2abss( year,month,day,hour,minute,second, abstsec ) ! print*,year,month,day,hour,minute,second, abstsec ! print*,'current time', curtime abstsec = abstsec + INT(curtime) CALL abss2ctim( abstsec, ryear, rmonth, rday, rhour, rmin, rsec) ! print*,abstsec, ryear, rmonth, rday, rhour, rmin, rsec CALL julday( ryear, rmonth, rday, rjday ) CALL getwekday ( ryear,rmonth, rday, wday ) IF(rhour < 10) THEN WRITE(chour,'(''0'',I1)') rhour ELSE WRITE(chour,'(i2)') rhour END IF IF(rmin < 10) THEN WRITE(cmin,'(''0'',I1)') rmin ELSE WRITE(cmin,'(i2)') rmin END IF WRITE(time_string, & '(a,'':'',A,''Z'','' '',A,'' '',I2,'' '',a,'' '',i4)') & chour, cmin, weekday(wday),rday,smonth(rmonth),ryear RETURN END SUBROUTINE get_time_string ! !################################################################## !################################################################## !###### ###### !###### SUBROUTINE GETWEKDAY ###### !###### ###### !###### Developed by ###### !###### Center for Analysis and Prediction of Storms ###### !###### University of Oklahoma ###### !###### ###### !################################################################## !################################################################## ! SUBROUTINE getwekday ( year, month, day, wekday ) 1,1 INTEGER :: year, month, day, wekday INTEGER :: jday, tmp1 INTEGER :: baseyear baseyear = 1960 ! have to be leap year CALL julday( year, month, day, jday ) ! current jday tmp1 = year-baseyear ! total years lp = (year + 3 - baseyear) / 4 ! Number of leap days since 1960 jday = jday + tmp1*365 + lp ! total day from baseyear/1/1/ IF( year == baseyear .AND. jday >= 60) jday = jday+1 wekday = MOD(jday+4, 7) !! 1960 1/1 is Friday RETURN END SUBROUTINE getwekday