Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_date_time.F @ 3567

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 31.2 KB

Rev	Line
[2759]	1	!WRF:MODEL_LAYER:UTIL
	2	!
	3	MODULE module_date_time
	4
	5	USE module_wrf_error
	6	USE module_configure
	7	USE module_model_constants
	8
	9	CHARACTER* 24 :: start_date = ' '
	10	CHARACTER* 24 :: current_date
	11	INTEGER , PARAMETER :: len_current_date = 24
	12	REAL , PRIVATE :: xtime
	13
	14	! 1. geth_idts (ndate, odate, idts)
	15	! Get the time period between two dates.
	16
	17	! 2. geth_newdate ( ndate, odate, idts)
	18	! Get the new date based on the old date and a time difference.
	19
	20	! 3. split_date_char ( date , century_year , month , day , hour , minute , second , ten_thousandth)
	21	! Given the date, return the integer components.
	22
	23	CONTAINS
	24
	25	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	26
	27	SUBROUTINE get_julgmt(date_str,julyr,julday,gmt)
	28	IMPLICIT NONE
	29	! Arguments
	30	CHARACTER (LEN=24) , INTENT(IN) :: date_str
	31	INTEGER, INTENT(OUT ) :: julyr
	32	INTEGER, INTENT(OUT ) :: julday
	33	REAL , INTENT(OUT ) :: gmt
	34	! Local
	35	INTEGER :: ny , nm , nd , nh , ni , ns , nt
	36	INTEGER :: my1, my2, my3, monss
	37	INTEGER, DIMENSION(12) :: mmd
	38	DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
	39	CALL split_date_char ( date_str , ny , nm , nd , nh , ni , ns , nt )
	40	#ifdef PLANET
	41	GMT=nh+FLOAT(ni)/60.+(FLOAT(ns)+FLOAT(nt)/1.e6)/3600.
	42	JULDAY=nd
	43	JULYR=ny
	44	#else
	45	GMT=nh+FLOAT(ni)/60.+FLOAT(ns)/3600.
	46	MY1=MOD(ny,4)
	47	MY2=MOD(ny,100)
	48	MY3=MOD(ny,400)
	49	IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
	50	JULDAY=nd
	51	JULYR=ny
	52	DO MONSS=1,nm-1
	53	JULDAY=JULDAY+MMD(MONSS)
	54	ENDDO
	55	#endif
	56	END SUBROUTINE get_julgmt
	57
	58
	59	SUBROUTINE geth_julgmt(julyr,julday, gmt)
	60	IMPLICIT NONE
	61	! Arguments
	62	INTEGER, INTENT(OUT ) :: julyr
	63	INTEGER, INTENT(OUT ) :: julday
	64	REAL , INTENT(OUT ) :: gmt
	65	! Local
	66	INTEGER :: ny , nm , nd , nh , ni , ns , nt
	67	INTEGER :: my1, my2, my3, monss
	68	INTEGER, DIMENSION(12) :: mmd
	69	DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
	70	CALL split_date_char ( current_date , ny , nm , nd , nh , ni , ns , nt )
	71	#ifdef PLANET
	72	GMT=nh+FLOAT(ni)/60.+(FLOAT(ns)+FLOAT(nt)/1.e6)/3600.
	73	JULDAY=nd
	74	JULYR=ny
	75	#else
	76	GMT=nh+FLOAT(ni)/60.+FLOAT(ns)/3600.
	77	MY1=MOD(ny,4)
	78	MY2=MOD(ny,100)
	79	MY3=MOD(ny,400)
	80	IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
	81	JULDAY=nd
	82	JULYR=ny
	83	DO MONSS=1,nm-1
	84	JULDAY=JULDAY+MMD(MONSS)
	85	ENDDO
	86	#endif
	87	END SUBROUTINE geth_julgmt
	88
	89	SUBROUTINE calc_current_date (id, time)
	90	! This subroutines calculates current_date and xtime
	91	IMPLICIT NONE
	92	! Arguments
	93	INTEGER, INTENT(IN ) :: id ! grid id
	94	REAL, INTENT(IN ) :: time ! time in seconds since start time
	95	! Local
	96	INTEGER :: julyr, julday, idt
	97	CHARACTER*19 new_date
	98	CHARACTER*24 base_date
	99	CHARACTER*128 mess
	100	REAL :: gmt
	101
	102	xtime = time/60.
	103	CALL nl_get_gmt (id, gmt)
	104	CALL nl_get_julyr (id, julyr)
	105	CALL nl_get_julday (id, julday)
	106	idt = 86400(julday-1)+nint(3600gmt)
	107	write (mess,*) 'calc_current_date called: time = ',time,' idt = ',idt
	108	CALL wrf_debug(300,TRIM(mess))
	109	write (mess,*) 'calc_current_date called: gmt = ',gmt
	110	CALL wrf_debug(300,TRIM(mess))
	111	write (mess,*) 'calc_current_date called: julyr = ',julyr
	112	CALL wrf_debug(300,TRIM(mess))
	113	write (mess,*) 'calc_current_date called: julday = ',julday
	114	CALL wrf_debug(300,TRIM(mess))
	115	#ifdef PLANET
	116	base_date = '0000-00001_00:00:00.0000'
	117	#else
	118	base_date = '0000-01-01_00:00:00.0000'
	119	#endif
	120	write(base_date(1:4),'(I4.4)')julyr
	121	CALL geth_newdate (start_date(1:19), base_date(1:19), idt)
	122	CALL geth_newdate (new_date, start_date(1:19), nint(time))
	123	write (current_date(1:24),fmt=340)new_date
	124	340 format(a19, '.0000')
	125	write (mess,*) current_date,gmt,julday,julyr,'=current_date,gmt,julday,julyr: calc_current_date'
	126	CALL wrf_debug(300,TRIM(mess))
	127	END SUBROUTINE calc_current_date
	128
	129	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	130
	131	SUBROUTINE geth_idts (ndate, odate, idts)
	132
	133	IMPLICIT NONE
	134
	135	! From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'),
	136	! or ('YYYY-DDDDD HH:MM:SS.ffff'),
	137	! compute the time difference.
	138
	139	! on entry - ndate - the new hdate.
	140	! odate - the old hdate.
	141
	142	! on exit - idts - the change in time in seconds.
	143
	144	CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
	145	INTEGER , INTENT(OUT) :: idts
	146
	147	! Local Variables
	148
	149	! yrnew - indicates the year associated with "ndate"
	150	! yrold - indicates the year associated with "odate"
	151	! monew - indicates the month associated with "ndate"
	152	! moold - indicates the month associated with "odate"
	153	! dynew - indicates the day associated with "ndate"
	154	! dyold - indicates the day associated with "odate"
	155	! hrnew - indicates the hour associated with "ndate"
	156	! hrold - indicates the hour associated with "odate"
	157	! minew - indicates the minute associated with "ndate"
	158	! miold - indicates the minute associated with "odate"
	159	! scnew - indicates the second associated with "ndate"
	160	! scold - indicates the second associated with "odate"
	161	! i - loop counter
	162	! mday - a list assigning the number of days in each month
	163
	164	CHARACTER (LEN=24) :: tdate
	165	INTEGER :: olen, nlen
	166	INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew
	167	INTEGER :: yrold, moold, dyold, hrold, miold, scold
	168	INTEGER :: mday(12), i, newdys, olddys
	169	LOGICAL :: npass, opass
	170	INTEGER :: isign
	171
	172	IF (odate.GT.ndate) THEN
	173	isign = -1
	174	tdate=ndate
	175	ndate=odate
	176	odate=tdate
	177	ELSE
	178	isign = 1
	179	END IF
	180
	181	! Assign the number of days in a months
	182
	183	mday( 1) = 31
	184	mday( 2) = 28
	185	mday( 3) = 31
	186	mday( 4) = 30
	187	mday( 5) = 31
	188	mday( 6) = 30
	189	mday( 7) = 31
	190	mday( 8) = 31
	191	mday( 9) = 30
	192	mday(10) = 31
	193	mday(11) = 30
	194	mday(12) = 31
	195
	196	! Break down old hdate into parts
	197
	198	hrold = 0
	199	miold = 0
	200	scold = 0
	201	olen = LEN(odate)
	202
	203	READ(odate(1:4), '(I4)') yrold
	204	#ifdef PLANET
	205	READ(odate(6:10), '(I5)') dyold
	206	moold=0.
	207	#else
	208	READ(odate(6:7), '(I2)') moold
	209	READ(odate(9:10), '(I2)') dyold
	210	#endif
	211	IF (olen.GE.13) THEN
	212	READ(odate(12:13),'(I2)') hrold
	213	IF (olen.GE.16) THEN
	214	READ(odate(15:16),'(I2)') miold
	215	IF (olen.GE.19) THEN
	216	READ(odate(18:19),'(I2)') scold
	217	END IF
	218	END IF
	219	END IF
	220
	221	! Break down new hdate into parts
	222
	223	hrnew = 0
	224	minew = 0
	225	scnew = 0
	226	nlen = LEN(ndate)
	227
	228	READ(ndate(1:4), '(I4)') yrnew
	229	#ifdef PLANET
	230	READ(ndate(6:10), '(I5)') dynew
	231	monew=0.
	232	#else
	233	READ(ndate(6:7), '(I2)') monew
	234	READ(ndate(9:10), '(I2)') dynew
	235	#endif
	236	IF (nlen.GE.13) THEN
	237	READ(ndate(12:13),'(I2)') hrnew
	238	IF (nlen.GE.16) THEN
	239	READ(ndate(15:16),'(I2)') minew
	240	IF (nlen.GE.19) THEN
	241	READ(ndate(18:19),'(I2)') scnew
	242	END IF
	243	END IF
	244	END IF
	245
	246	! Check that the dates make sense.
	247
	248	npass = .true.
	249	opass = .true.
	250
	251	#ifdef PLANET
	252	! Check that the day of NDATE makes sense.
	253
	254	IF ((dynew > PLANET_YEAR).or.(dynew < 1)) THEN
	255	PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
	256	npass = .false.
	257	END IF
	258
	259	! Check that the day of ODATE makes sense.
	260
	261	IF ((dyold > PLANET_YEAR).or.(dyold < 1)) THEN
	262	PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
	263	opass = .false.
	264	END IF
	265
	266	#else
	267	! Check that the month of NDATE makes sense.
	268
	269	IF ((monew.GT.12).or.(monew.LT.1)) THEN
	270	PRINT*, 'GETH_IDTS: Month of NDATE = ', monew
	271	npass = .false.
	272	END IF
	273
	274	! Check that the month of ODATE makes sense.
	275
	276	IF ((moold.GT.12).or.(moold.LT.1)) THEN
	277	PRINT*, 'GETH_IDTS: Month of ODATE = ', moold
	278	opass = .false.
	279	END IF
	280
	281	! Check that the day of NDATE makes sense.
	282
	283	IF (monew.ne.2) THEN
	284	! ...... For all months but February
	285	IF ((dynew.GT.mday(monew)).or.(dynew.LT.1)) THEN
	286	PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
	287	npass = .false.
	288	END IF
	289	ELSE IF (monew.eq.2) THEN
	290	! ...... For February
	291	IF ((dynew.GT.nfeb(yrnew)).OR.(dynew.LT.1)) THEN
	292	PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
	293	npass = .false.
	294	END IF
	295	END IF
	296
	297	! Check that the day of ODATE makes sense.
	298
	299	IF (moold.ne.2) THEN
	300	! ...... For all months but February
	301	IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
	302	PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
	303	opass = .false.
	304	END IF
	305	ELSE IF (moold.eq.2) THEN
	306	! ....... For February
	307	IF ((dyold.GT.nfeb(yrold)).or.(dyold.LT.1)) THEN
	308	PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
	309	opass = .false.
	310	END IF
	311	END IF
	312	#endif
	313	! Check that the hour of NDATE makes sense.
	314
	315	IF ((hrnew.GT.23).or.(hrnew.LT.0)) THEN
	316	PRINT*, 'GETH_IDTS: Hour of NDATE = ', hrnew
	317	npass = .false.
	318	END IF
	319
	320	! Check that the hour of ODATE makes sense.
	321
	322	IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
	323	PRINT*, 'GETH_IDTS: Hour of ODATE = ', hrold
	324	opass = .false.
	325	END IF
	326
	327	! Check that the minute of NDATE makes sense.
	328
	329	IF ((minew.GT.59).or.(minew.LT.0)) THEN
	330	PRINT*, 'GETH_IDTS: Minute of NDATE = ', minew
	331	npass = .false.
	332	END IF
	333
	334	! Check that the minute of ODATE makes sense.
	335
	336	IF ((miold.GT.59).or.(miold.LT.0)) THEN
	337	PRINT*, 'GETH_IDTS: Minute of ODATE = ', miold
	338	opass = .false.
	339	END IF
	340
	341	! Check that the second of NDATE makes sense.
	342
	343	IF ((scnew.GT.59).or.(scnew.LT.0)) THEN
	344	PRINT*, 'GETH_IDTS: SECOND of NDATE = ', scnew
	345	npass = .false.
	346	END IF
	347
	348	! Check that the second of ODATE makes sense.
	349
	350	IF ((scold.GT.59).or.(scold.LT.0)) THEN
	351	PRINT*, 'GETH_IDTS: Second of ODATE = ', scold
	352	opass = .false.
	353	END IF
	354
	355	IF (.not. npass) THEN
	356	WRITE( wrf_err_message , * ) 'module_date_time: geth_idts: Bad NDATE: ', ndate(1:nlen)
	357	CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
	358	END IF
	359
	360	IF (.not. opass) THEN
	361	WRITE( wrf_err_message , * ) 'module_date_time: geth_idts: Bad ODATE: ', odate(1:olen)
	362	CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
	363	END IF
	364
	365	! Date Checks are completed. Continue.
	366
	367	! Compute number of days from 1 January ODATE, 00:00:00 until ndate
	368	! Compute number of hours from 1 January ODATE, 00:00:00 until ndate
	369	! Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
	370
	371	newdys = 0
	372	#ifdef PLANET
	373	DO i = yrold, yrnew - 1
	374	newdys = newdys + PLANET_YEAR
	375	END DO
	376	#else
	377	DO i = yrold, yrnew - 1
	378	newdys = newdys + (365 + (nfeb(i)-28))
	379	END DO
	380
	381	IF (monew .GT. 1) THEN
	382	mday(2) = nfeb(yrnew)
	383	DO i = 1, monew - 1
	384	newdys = newdys + mday(i)
	385	END DO
	386	mday(2) = 28
	387	END IF
	388	#endif
	389
	390	newdys = newdys + dynew-1
	391
	392	! Compute number of hours from 1 January ODATE, 00:00:00 until odate
	393	! Compute number of minutes from 1 January ODATE, 00:00:00 until odate
	394
	395	olddys = 0
	396
	397	#ifndef PLANET
	398	IF (moold .GT. 1) THEN
	399	mday(2) = nfeb(yrold)
	400	DO i = 1, moold - 1
	401	olddys = olddys + mday(i)
	402	END DO
	403	mday(2) = 28
	404	END IF
	405	#endif
	406
	407	olddys = olddys + dyold-1
	408
	409	! Determine the time difference in seconds
	410
	411	idts = (newdys - olddys) * 86400
	412	idts = idts + (hrnew - hrold) * 3600
	413	idts = idts + (minew - miold) * 60
	414	idts = idts + (scnew - scold)
	415
	416	IF (isign .eq. -1) THEN
	417	tdate=ndate
	418	ndate=odate
	419	odate=tdate
	420	idts = idts * isign
	421	END IF
	422
	423	END SUBROUTINE geth_idts
	424
	425	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	426
	427	SUBROUTINE geth_newdate (ndate, odate, idt)
	428
	429	IMPLICIT NONE
	430
	431	! From old date ('YYYY-MM-DD HH:MM:SS.ffff') and
	432	! [or ('YYYY-DDDDD HH:MM:SS.ffff')]
	433	! delta-time, compute the new date.
	434
	435	! on entry - odate - the old hdate.
	436	! idt - the change in time
	437
	438	! on exit - ndate - the new hdate.
	439
	440	INTEGER , INTENT(IN) :: idt
	441	CHARACTER (LEN=*) , INTENT(OUT) :: ndate
	442	CHARACTER (LEN=*) , INTENT(IN) :: odate
	443
	444
	445	! Local Variables
	446
	447	! yrold - indicates the year associated with "odate"
	448	! moold - indicates the month associated with "odate"
	449	! dyold - indicates the day associated with "odate"
	450	! hrold - indicates the hour associated with "odate"
	451	! miold - indicates the minute associated with "odate"
	452	! scold - indicates the second associated with "odate"
	453
	454	! yrnew - indicates the year associated with "ndate"
	455	! monew - indicates the month associated with "ndate"
	456	! dynew - indicates the day associated with "ndate"
	457	! hrnew - indicates the hour associated with "ndate"
	458	! minew - indicates the minute associated with "ndate"
	459	! scnew - indicates the second associated with "ndate"
	460
	461	! mday - a list assigning the number of days in each month
	462
	463	! i - loop counter
	464	! nday - the integer number of days represented by "idt"
	465	! nhour - the integer number of hours in "idt" after taking out
	466	! all the whole days
	467	! nmin - the integer number of minutes in "idt" after taking out
	468	! all the whole days and whole hours.
	469	! nsec - the integer number of minutes in "idt" after taking out
	470	! all the whole days, whole hours, and whole minutes.
	471
	472	INTEGER :: nlen, olen
	473	INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
	474	INTEGER :: yrold, moold, dyold, hrold, miold, scold, frold
	475	INTEGER :: mday(12), nday, nhour, nmin, nsec, nfrac, i, ifrc
	476	LOGICAL :: opass
	477	CHARACTER (LEN=10) :: hfrc
	478	CHARACTER (LEN=1) :: sp
	479	! INTEGER, EXTERNAL :: nfeb ! in the same module now
	480
	481	! Assign the number of days in a months
	482
	483	mday( 1) = 31
	484	mday( 2) = 28
	485	mday( 3) = 31
	486	mday( 4) = 30
	487	mday( 5) = 31
	488	mday( 6) = 30
	489	mday( 7) = 31
	490	mday( 8) = 31
	491	mday( 9) = 30
	492	mday(10) = 31
	493	mday(11) = 30
	494	mday(12) = 31
	495
	496	! Break down old hdate into parts
	497
	498	hrold = 0
	499	miold = 0
	500	scold = 0
	501	frold = 0
	502	olen = LEN(odate)
	503	IF (olen.GE.11) THEN
	504	sp = odate(11:11)
	505	else
	506	sp = ' '
	507	END IF
	508
	509	! Use internal READ statements to convert the CHARACTER string
	510	! date into INTEGER components.
	511
	512	READ(odate(1:4), '(I4)') yrold
	513	#ifdef PLANET
	514	READ(odate(6:10), '(I5)') dyold
	515	moold=0.
	516	#else
	517	READ(odate(6:7), '(I2)') moold
	518	READ(odate(9:10), '(I2)') dyold
	519	#endif
	520	IF (olen.GE.13) THEN
	521	READ(odate(12:13),'(I2)') hrold
	522	IF (olen.GE.16) THEN
	523	READ(odate(15:16),'(I2)') miold
	524	IF (olen.GE.19) THEN
	525	READ(odate(18:19),'(I2)') scold
	526	IF (olen.GT.20) THEN
	527	READ(odate(21:olen),'(I2)') frold
	528	END IF
	529	END IF
	530	END IF
	531	END IF
	532
	533	! Set the number of days in February for that year.
	534
	535	mday(2) = nfeb(yrold)
	536
	537	! Check that ODATE makes sense.
	538
	539	opass = .TRUE.
	540
	541	#ifdef PLANET
	542	! Check that the day of ODATE makes sense.
	543	IF ((dyold.GT.PLANET_YEAR).or.(dyold.LT.1)) THEN
	544	WRITE(,) 'GETH_NEWDATE: Day of ODATE = ', dyold
	545	opass = .FALSE.
	546	END IF
	547	#else
	548	! Check that the month of ODATE makes sense.
	549
	550	IF ((moold.GT.12).or.(moold.LT.1)) THEN
	551	WRITE(,) 'GETH_NEWDATE: Month of ODATE = ', moold
	552	opass = .FALSE.
	553	END IF
	554
	555	! Check that the day of ODATE makes sense.
	556
	557	IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
	558	WRITE(,) 'GETH_NEWDATE: Day of ODATE = ', dyold
	559	opass = .FALSE.
	560	END IF
	561	#endif
	562	! Check that the hour of ODATE makes sense.
	563
	564	IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
	565	WRITE(,) 'GETH_NEWDATE: Hour of ODATE = ', hrold
	566	opass = .FALSE.
	567	END IF
	568
	569	! Check that the minute of ODATE makes sense.
	570
	571	IF ((miold.GT.59).or.(miold.LT.0)) THEN
	572	WRITE(,) 'GETH_NEWDATE: Minute of ODATE = ', miold
	573	opass = .FALSE.
	574	END IF
	575
	576	! Check that the second of ODATE makes sense.
	577
	578	IF ((scold.GT.59).or.(scold.LT.0)) THEN
	579	WRITE(,) 'GETH_NEWDATE: Second of ODATE = ', scold
	580	opass = .FALSE.
	581	END IF
	582
	583	! Check that the fractional part of ODATE makes sense.
	584
	585
	586	IF (.not.opass) THEN
	587	WRITE( wrf_err_message , * ) 'module_date_time: GETH_NEWDATE: Bad ODATE: ', odate(1:olen), olen
	588	CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
	589	END IF
	590
	591	! Date Checks are completed. Continue.
	592
	593
	594	! Compute the number of days, hours, minutes, and seconds in idt
	595
	596	IF (olen.GT.20) THEN !idt should be in fractions of seconds
	597	ifrc = olen-20
	598	ifrc = 10**ifrc
	599	nday = ABS(idt)/(86400*ifrc)
	600	nhour = MOD(ABS(idt),86400ifrc)/(3600ifrc)
	601	nmin = MOD(ABS(idt),3600ifrc)/(60ifrc)
	602	nsec = MOD(ABS(idt),60*ifrc)/(ifrc)
	603	nfrac = MOD(ABS(idt), ifrc)
	604	ELSE IF (olen.eq.19) THEN !idt should be in seconds
	605	ifrc = 1
	606	nday = ABS(idt)/86400 ! Integer number of days in delta-time
	607	nhour = MOD(ABS(idt),86400)/3600
	608	nmin = MOD(ABS(idt),3600)/60
	609	nsec = MOD(ABS(idt),60)
	610	nfrac = 0
	611	ELSE IF (olen.eq.16) THEN !idt should be in minutes
	612	ifrc = 1
	613	nday = ABS(idt)/1440 ! Integer number of days in delta-time
	614	nhour = MOD(ABS(idt),1440)/60
	615	nmin = MOD(ABS(idt),60)
	616	nsec = 0
	617	nfrac = 0
	618	ELSE IF (olen.eq.13) THEN !idt should be in hours
	619	ifrc = 1
	620	nday = ABS(idt)/24 ! Integer number of days in delta-time
	621	nhour = MOD(ABS(idt),24)
	622	nmin = 0
	623	nsec = 0
	624	nfrac = 0
	625	ELSE IF (olen.eq.10) THEN !idt should be in days
	626	ifrc = 1
	627	nday = ABS(idt)/24 ! Integer number of days in delta-time
	628	nhour = 0
	629	nmin = 0
	630	nsec = 0
	631	nfrac = 0
	632	ELSE
	633	WRITE( wrf_err_message , * ) 'module_date_time: GETH_NEWDATE: Strange length for ODATE: ',olen
	634	CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
	635	END IF
	636
	637	IF (idt.GE.0) THEN
	638
	639	frnew = frold + nfrac
	640	IF (frnew.GE.ifrc) THEN
	641	frnew = frnew - ifrc
	642	nsec = nsec + 1
	643	END IF
	644
	645	scnew = scold + nsec
	646	IF (scnew .GE. 60) THEN
	647	scnew = scnew - 60
	648	nmin = nmin + 1
	649	END IF
	650
	651	minew = miold + nmin
	652	IF (minew .GE. 60) THEN
	653	minew = minew - 60
	654	nhour = nhour + 1
	655	END IF
	656
	657	hrnew = hrold + nhour
	658	IF (hrnew .GE. 24) THEN
	659	hrnew = hrnew - 24
	660	nday = nday + 1
	661	END IF
	662
	663	dynew = dyold
	664	monew = moold
	665	yrnew = yrold
	666	DO i = 1, nday
	667	dynew = dynew + 1
	668	#ifdef PLANET
	669	IF (dynew .GT. PLANET_YEAR) THEN
	670	dynew = dynew - PLANET_YEAR
	671	yrnew = yrnew + 1
	672	END IF
	673	#else
	674	IF (dynew.GT.mday(monew)) THEN
	675	dynew = dynew - mday(monew)
	676	monew = monew + 1
	677	IF (monew .GT. 12) THEN
	678	monew = 1
	679	yrnew = yrnew + 1
	680	! If the year changes, recompute the number of days in February
	681	mday(2) = nfeb(yrnew)
	682	END IF
	683	END IF
	684	#endif
	685	END DO
	686
	687	ELSE IF (idt.LT.0) THEN
	688
	689	frnew = frold - nfrac
	690	IF (frnew .LT. 0) THEN
	691	frnew = frnew + ifrc
	692	nsec = nsec - 1
	693	END IF
	694
	695	scnew = scold - nsec
	696	IF (scnew .LT. 00) THEN
	697	scnew = scnew + 60
	698	nmin = nmin + 1
	699	END IF
	700
	701	minew = miold - nmin
	702	IF (minew .LT. 00) THEN
	703	minew = minew + 60
	704	nhour = nhour + 1
	705	END IF
	706
	707	hrnew = hrold - nhour
	708	IF (hrnew .LT. 00) THEN
	709	hrnew = hrnew + 24
	710	nday = nday + 1
	711	END IF
	712
	713	dynew = dyold
	714	monew = moold
	715	yrnew = yrold
	716	DO i = 1, nday
	717	dynew = dynew - 1
	718	#ifdef PLANET
	719	IF (dynew.eq.0) THEN
	720	dynew = PLANET_YEAR
	721	yrnew = yrnew - 1
	722	END IF
	723	#else
	724	IF (dynew.eq.0) THEN
	725	monew = monew - 1
	726	IF (monew.eq.0) THEN
	727	monew = 12
	728	yrnew = yrnew - 1
	729	! If the year changes, recompute the number of days in February
	730	mday(2) = nfeb(yrnew)
	731	END IF
	732	dynew = mday(monew)
	733	END IF
	734	#endif
	735	END DO
	736	END IF
	737
	738	! Now construct the new mdate
	739
	740	nlen = LEN(ndate)
	741
	742	#ifdef PLANET
	743	IF (nlen.GT.20) THEN
	744	WRITE(ndate(1:19),19) yrnew, dynew, hrnew, minew, scnew
	745	WRITE(hfrc,'(I10)') frnew+1000000000
	746	ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
	747
	748	ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
	749	WRITE(ndate(1:19),19) yrnew, dynew, hrnew, minew, scnew
	750	19 format(I4.4,'-',I5.5,'_',I2.2,':',I2.2,':',I2.2)
	751	IF (nlen.eq.20) ndate = ndate(1:19)//'.'
	752
	753	ELSE IF (nlen.eq.16) THEN
	754	WRITE(ndate,16) yrnew, dynew, hrnew, minew
	755	16 format(I4.4,'-',I5.5,'_',I2.2,':',I2.2)
	756
	757	ELSE IF (nlen.eq.13) THEN
	758	WRITE(ndate,13) yrnew, dynew, hrnew
	759	13 format(I4.4,'-',I5.5,'_',I2.2)
	760
	761	ELSE IF (nlen.eq.10) THEN
	762	WRITE(ndate,10) yrnew, dynew
	763	10 format(I4.4,'-',I5.5)
	764
	765	END IF
	766
	767	IF (olen.GE.11) ndate(11:11) = sp
	768	#else
	769	IF (nlen.GT.20) THEN
	770	WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
	771	WRITE(hfrc,'(I10)') frnew+1000000000
	772	ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
	773
	774	ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
	775	WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
	776	19 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
	777	IF (nlen.eq.20) ndate = ndate(1:19)//'.'
	778
	779	ELSE IF (nlen.eq.16) THEN
	780	WRITE(ndate,16) yrnew, monew, dynew, hrnew, minew
	781	16 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
	782
	783	ELSE IF (nlen.eq.13) THEN
	784	WRITE(ndate,13) yrnew, monew, dynew, hrnew
	785	13 format(I4,'-',I2.2,'-',I2.2,'_',I2.2)
	786
	787	ELSE IF (nlen.eq.10) THEN
	788	WRITE(ndate,10) yrnew, monew, dynew
	789	10 format(I4,'-',I2.2,'-',I2.2)
	790
	791	END IF
	792
	793	IF (olen.GE.11) ndate(11:11) = sp
	794	#endif
	795	END SUBROUTINE geth_newdate
	796
	797	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	798
	799	FUNCTION nfeb ( year ) RESULT (num_days)
	800
	801	! Compute the number of days in February for the given year
	802
	803	IMPLICIT NONE
	804
	805	INTEGER :: year
	806	INTEGER :: num_days
	807
	808	num_days = 28 ! By default, February has 28 days ...
	809	IF (MOD(year,4).eq.0) THEN
	810	num_days = 29 ! But every four years, it has 29 days ...
	811	IF (MOD(year,100).eq.0) THEN
	812	num_days = 28 ! Except every 100 years, when it has 28 days ...
	813	IF (MOD(year,400).eq.0) THEN
	814	num_days = 29 ! Except every 400 years, when it has 29 days.
	815	END IF
	816	END IF
	817	END IF
	818
	819	END FUNCTION nfeb
	820
	821	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	822	SUBROUTINE split_date_char ( date , century_year , month , day , hour , minute , second , ten_thousandth)
	823
	824	IMPLICIT NONE
	825
	826	! Input data.
	827
	828	CHARACTER(LEN=24) , INTENT(IN) :: date
	829
	830	! Output data.
	831
	832	INTEGER , INTENT(OUT) :: century_year , month , day , hour , minute , second , ten_thousandth
	833
	834	READ(date,FMT='( I4)') century_year
	835	#ifdef PLANET
	836	month = 0
	837	READ(date,FMT='( 5X,I5)') day
	838	#else
	839	READ(date,FMT='( 5X,I2)') month
	840	READ(date,FMT='( 8X,I2)') day
	841	#endif
	842	READ(date,FMT='(11X,I2)') hour
	843	READ(date,FMT='(14X,I2)') minute
	844	READ(date,FMT='(17X,I2)') second
	845	READ(date,FMT='(20X,I4)') ten_thousandth
	846
	847	END SUBROUTINE split_date_char
	848
	849	SUBROUTINE init_module_date_time
	850	END SUBROUTINE init_module_date_time
	851
	852	END MODULE module_date_time
	853
	854
	855	! TBH: NOTE:
	856	! TBH: Linkers whine if these routines are placed inside the module. Not
	857	! TBH: sure if these should live here or inside an external package. They
	858	! TBH: have dependencies both on WRF (for the format of the WRF date-time
	859	! TBH: strings) and on the time manager. Currently, the format of the WRF
	860	! TBH: date-time strings is a slight variant on ISO 8601 (ISO is
	861	! TBH: "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss"). If we
	862	! TBH: change the WRF format to match the standard, then we remove the
	863	! TBH: WRF dependence...
	864
	865	! Converts WRF date-time string into an WRFU_Time object.
	866	! The format of the WRF date-time strings is a slight variant on ISO 8601:
	867	! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".
	868	SUBROUTINE wrf_atotime ( str, time )
	869	USE module_utility
	870	CHARACTER (LEN=*), INTENT(INOUT) :: str
	871	TYPE(WRFU_Time), INTENT(OUT) :: time
	872	INTEGER yr, mm, dd, h, m, s, ms
	873	INTEGER rc
	874	IF ( LEN( str ) .GE. 20 ) THEN
	875	IF ( str(20:20) .EQ. '.' ) THEN
	876	#ifdef PLANET
	877	READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2,1x,I4.4)') yr,dd,h,m,s,ms
	878	mm = 1
	879	#else
	880	READ(str,34) yr,mm,dd,h,m,s,ms
	881	#endif
	882	! last four digits are ten-thousandths of a sec, convert to ms
	883	ms=nint(real(ms)/10)
	884	ELSE
	885	#ifdef PLANET
	886	READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2)') yr,dd,h,m,s
	887	mm = 1
	888	#else
	889	READ(str,33) yr,mm,dd,h,m,s
	890	#endif
	891	ms = 0
	892	ENDIF
	893	ELSE
	894	#ifdef PLANET
	895	READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2)') yr,dd,h,m,s
	896	mm = 1
	897	#else
	898	READ(str,33) yr,mm,dd,h,m,s
	899	#endif
	900	ms = 0
	901	ENDIF
	902	CALL WRFU_TimeSet( time, YY=yr, MM=mm, DD=dd, H=h, M=m, S=s, MS=ms, rc=rc )
	903	CALL wrf_check_error( WRFU_SUCCESS, rc, &
	904	'WRFU_TimeSet() in wrf_atotime() FAILED', &
	905	__FILE__ , &
	906	__LINE__ )
	907	33 FORMAT (I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2)
	908	34 FORMAT (I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I4.4)
	909	RETURN
	910	END SUBROUTINE wrf_atotime
	911
	912
	913
	914	! Converts an WRFU_Time object into a WRF date-time string.
	915	! The format of the WRF date-time strings is a slight variant on ISO 8601:
	916	! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".
	917	SUBROUTINE wrf_timetoa ( time, str )
	918	USE module_utility
	919	TYPE(WRFU_Time), INTENT(INOUT) :: time
	920	CHARACTER (LEN=*), INTENT(OUT) :: str
	921	INTEGER strlen, rc
	922	CHARACTER (LEN=256) :: mess, tmpstr
	923	! Assertion
	924	IF ( LEN(str) < 19 ) THEN
	925	CALL wrf_error_fatal( 'wrf_timetoa: str is too short' )
	926	ENDIF
	927	tmpstr = ''
	928	CALL WRFU_TimeGet( time, timeString=tmpstr, rc=rc )
	929	CALL wrf_check_error( WRFU_SUCCESS, rc, &
	930	'WRFU_TimeGet() in wrf_timetoa() FAILED', &
	931	__FILE__ , &
	932	__LINE__ )
	933	! change ISO 8601 'T' to WRF '_' and hack off fraction if str is not
	934	! big enough to hold it
	935	strlen = MIN( LEN(str), LEN_TRIM(tmpstr) )
	936	str = ''
	937	str(1:strlen) = tmpstr(1:strlen)
	938	str(11:11) = '_'
	939	WRITE (mess,*) 'DEBUG wrf_timetoa(): returning with str = [',TRIM(str),']'
	940	CALL wrf_debug ( 150 , TRIM(mess) )
	941	RETURN
	942	END SUBROUTINE wrf_timetoa
	943
	944
	945
	946	! Converts an WRFU_TimeInterval object into a time-interval string.
	947	SUBROUTINE wrf_timeinttoa ( timeinterval, str )
	948	USE module_utility
	949	TYPE(WRFU_TimeInterval), INTENT(INOUT) :: timeinterval
	950	CHARACTER (LEN=*), INTENT(OUT) :: str
	951	INTEGER rc
	952	CHARACTER (LEN=256) :: mess
	953	CALL WRFU_TimeIntervalGet( timeinterval, timeString=str, rc=rc )
	954	CALL wrf_check_error( WRFU_SUCCESS, rc, &
	955	'WRFU_TimeIntervalGet() in wrf_timeinttoa() FAILED', &
	956	__FILE__ , &
	957	__LINE__ )
	958	WRITE (mess,*) 'DEBUG wrf_timeinttoa(): returning with str = [',TRIM(str),']'
	959	CALL wrf_debug ( 150 , TRIM(mess) )
	960	RETURN
	961	END SUBROUTINE wrf_timeinttoa
	962
	963
	964
	965	! Debug routine to print key clock information.
	966	! Every printed line begins with pre_str.
	967	SUBROUTINE wrf_clockprint ( level, clock, pre_str )
	968	USE module_utility
	969	INTEGER, INTENT( IN) :: level
	970	TYPE(WRFU_Clock), INTENT( IN) :: clock
	971	CHARACTER (LEN=*), INTENT( IN) :: pre_str
	972	INTEGER rc
	973	INTEGER :: debug_level
	974	TYPE(WRFU_Time) :: currTime, startTime, stopTime
	975	TYPE(WRFU_TimeInterval) :: timeStep
	976	CHARACTER (LEN=64) :: currTime_str, startTime_str, stopTime_str
	977	CHARACTER (LEN=64) :: timeStep_str
	978	CHARACTER (LEN=256) :: mess
	979	CALL get_wrf_debug_level( debug_level )
	980	IF ( level .LE. debug_level ) THEN
	981	CALL WRFU_ClockGet( clock, CurrTime=currTime, StartTime=startTime, &
	982	StopTime=stopTime, TimeStep=timeStep, rc=rc )
	983	CALL wrf_check_error( WRFU_SUCCESS, rc, &
	984	'wrf_clockprint: WRFU_ClockGet() FAILED', &
	985	__FILE__ , &
	986	__LINE__ )
	987	CALL wrf_timetoa( currTime, currTime_str )
	988	CALL wrf_timetoa( startTime, startTime_str )
	989	CALL wrf_timetoa( stopTime, stopTime_str )
	990	CALL wrf_timeinttoa( timeStep, timeStep_str )
	991	WRITE (mess,*) TRIM(pre_str),' clock start time = ',TRIM(startTime_str)
	992	CALL wrf_message(TRIM(mess))
	993	WRITE (mess,*) TRIM(pre_str),' clock current time = ',TRIM(currTime_str)
	994	CALL wrf_message(TRIM(mess))
	995	WRITE (mess,*) TRIM(pre_str),' clock stop time = ',TRIM(stopTime_str)
	996	CALL wrf_message(TRIM(mess))
	997	WRITE (mess,*) TRIM(pre_str),' clock time step = ',TRIM(timeStep_str)
	998	CALL wrf_message(TRIM(mess))
	999	ENDIF
	1000	RETURN
	1001	END SUBROUTINE wrf_clockprint
	1002

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format