My Project
mod_set_time.f90
Go to the documentation of this file.
1 
2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 !/===========================================================================/
13 ! Copyright (c) 2007, The University of Massachusetts Dartmouth
14 ! Produced at the School of Marine Science & Technology
15 ! Marine Ecosystem Dynamics Modeling group
16 ! All rights reserved.
17 !
18 ! FVCOM has been developed by the joint UMASSD-WHOI research team. For
19 ! details of authorship and attribution of credit please see the FVCOM
20 ! technical manual or contact the MEDM group.
21 !
22 !
23 ! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu
24 ! The full copyright notice is contained in the file COPYRIGHT located in the
25 ! root directory of the FVCOM code. This original header must be maintained
26 ! in all distributed versions.
27 !
28 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
29 ! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
30 ! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
31 ! PURPOSE ARE DISCLAIMED.
32 !
33 !/---------------------------------------------------------------------------/
34 ! CVS VERSION INFORMATION
35 ! $Id$
36 ! $Name$
37 ! $Revision$
38 !/===========================================================================/
39 
40 MODULE mod_set_time
41  USE control
42  USE mod_nctools
43  USE mod_input
44  USE mod_time
45  IMPLICIT NONE
46 
47  INTERFACE set_startup_file_stack
48  MODULE PROCEDURE set_startup_file_stack_by_time
49  MODULE PROCEDURE set_startup_file_stack_by_cycle
50  END INTERFACE
51 
52 CONTAINS
53 
54  SUBROUTINE setup_time
55  !===============================================================================!
56  ! SETUP_TIME
57  !===============================================================================!
58  IMPLICIT NONE
59  INTEGER STATUS
60  TYPE(time) :: RTIME
61  TYPE(ncfile), POINTER :: NCF
62  TYPE(ncvar), POINTER :: VAR
63  LOGICAL FOUND
64 
65  TYPE(time) :: INTERVAL_TIME, NEXT_TIME,PREV_TIME
66  INTEGER :: STKLEN, STKMAX,PREVSTK,NEXTSTK
67 
68  INTEGER(itime) :: Dummy
69  INTEGER :: I
70  CHARACTER(LEN=4) :: BFLAG,EFLAG,FLAG
71 
72 
73  ! SET THE TIME STEP
74  CALL set_model_timestep !from runfile (imdte, dte, imdti, dti)
75 
76 
77  SELECT CASE(startup_type)
78  !=================================================
79  ! HOTSTART
80  CASE("hotstart")
81  !=================================================
82  if(dbg_set(dbg_log)) then
83  WRITE(ipt,*)'! SET TIME FOR HOTSTART !'
84  WRITE(ipt,*)'! !'
85  end if
86  IF(.NOT. ASSOCIATED(nc_start)) CALL fatal_error&
87  & ('STARUP FILE IS NOT ASSOCIATED IN SETUP_TIME!')
88 
89 
90  SELECT CASE(use_real_world_time)
91  CASE(.true.)
92 
93  ! GET THE START TIME
94  starttime = read_datetime(start_date,date_format,timezone,status)
95  if (status == 0) &
96  & Call fatal_error("Could not read the date string START_DATE: "//trim(start_date))
97  runfile_starttime = starttime
98 
99  ! GET THE END TIME
100  EndTime = READ_DATETIME(END_DATE,DATE_FORMAT,TIMEZONE,status)
101  if (status == 0) &
102  & Call fatal_error("Could not read the date string END_DATE: "&
103  &//trim(end_date))
104  ! SANITY CHECK
105  if(starttime .GT. endtime) &
106  & Call fatal_error("Runfile Start_Date exceeds or equal to End_Date")
107 
108  ! FIND THE START TIME IN THE RESTART FILE AND SET ISTART
109  CALL set_startup_file_stack(starttime,iint)
110 
111  ! ADVANCE THE TO THE FIRST TIME STEP OF THE MODEL FROM THE
112  ! INITIAL CONDITION
113  istart = iint +1
114 
115  !CALCULATE THE NUMBER OF STEPS AND IEND
116  nsteps = calculate_number_of_timesteps(starttime,endtime)
117  iend = istart + nsteps
118 
119  ! GET THE REFERENCE DATE TIME
120  IF(date_reference /= 'default')THEN
121  referencedate = read_datetime(date_reference,date_format,timezone,status)
122  if (status == 0 ) &
123  & Call fatal_error("Could not read the date string DATE_REFERENCE: "//trim(date_reference))
124  ELSE
125  referencedate%MJD = 0
126  referencedate%MuSOD = 0
127  END IF
128 
129  CASE (.false.)
130 
131  ! GET THE START AND END INFORMATION
132  CALL ideal_time_string2time(start_date,bflag,starttime,iint)
133  CALL ideal_time_string2time(end_date,eflag,endtime,iend)
134 
135  ! SANITY CHECK
136  IF (bflag /= eflag) CALL fatal_error&
137  ('IDEALIZED MODEL TIME SPECIFICATION IS INCORRENT',&
138  &'BEGIN AND END CAN BE IN EITHER CYCLES OR TIME BUT NOT MIXED',&
139  & trim(start_date),trim(end_date) )
140 
141  IF (bflag == 'time') THEN ! IF START AND END TIME WERE SPECIFIED
142 
143  !CALCULATE THE NUMBER OF STEPS
144  nsteps = calculate_number_of_timesteps(starttime,endtime)
145 
146  ! FIND THE INITIAL CONDITION IN THE RESTART FILE
147  CALL set_startup_file_stack(starttime,iint)
148 
149  ! ADVANCE THE TO THE FIRST TIME STEP OF THE MODEL FROM THE
150  ! INITIAL CONDITION
151  istart = iint +1
152 
153  ! GET IEND
154  iend = istart + nsteps
155 
156 
157  ELSE IF(bflag == 'step') THEN ! IF START AND END IINT WERE SPECIFIED
158 
159  ! CALCULATE NSTEPS
160  nsteps = iend - iint
161 
162  ! SANITY CHECK
163  IF(nsteps .LT. 0) CALL fatal_error&
164  &('Number of steps can not be less than zero')
165 
166 
167  ! FIND THE START IINT CYCLE IN THE RESTART FILE AND GET
168  ! THE START TIME
169  CALL set_startup_file_stack(iint,starttime)
170 
171  ! CALCULATE THE END TIME
172  EndTime = StartTime + IMDTI * nsteps
173 
174  ! ADVANCE THE TO THE FIRST TIME STEP OF THE MODEL FROM THE
175  ! INITIAL CONDITION
176  istart = iint + 1
177 
178 
179  ELSE
180  CALL fatal_error('IDEAL_TIME_STRING2TIME returned invalid flag')
181 
182  END IF
183 
184  END SELECT
185 
186  ! SET THE INITIAL MODEL TIME
187  inttime = starttime
188  exttime = starttime
189  runfile_starttime = starttime
190 
191 
192 
193  ! INITIALIZE IEXT
194  iext = 1
195 
196  CALL report_time_setup
197 
198 ! SET THE OUT PUT TIME FOR THE DIFFERENT FILES
199  IF (ncav_on) THEN
200 
201  CALL get_first_output_time(trim(ncav_first_out),next_time)
202 
203  CALL get_output_file_interval(trim(ncav_out_interval),interval_time)
204 
205  nextstk = 0
206  prevstk = 0
207  prev_time = zerotime
208  stklen = 0
209  stkmax = ncav_output_stack
210 
211 
212  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! TIME AVERAGE OUTPUT:"
213  CALL set_output_file_time(nc_avg,interval_time,next_time&
214  &,nextstk,prev_time,prevstk,stklen,stkmax)
215 
216 
217  if (starttime > next_time)&
218  & Call fatal_error("The time of the first averaged output &
219  &must be greater than or equal to the start time")
220 
221  if (endtime < next_time)&
222  & Call fatal_error("The time of the first averaged output &
223  &must be less than or equal to the end time")
224 
225  END IF
226 
227  IF (nc_on) THEN
228 
229  CALL get_first_output_time(trim(nc_first_out),next_time)
230 
231  CALL get_output_file_interval(trim(nc_out_interval),interval_time)
232 
233  nextstk = 0
234  prevstk = 0
235  prev_time = zerotime
236  stklen = 0
237  stkmax = nc_output_stack
238 
239 
240  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! NETCDF OUTPUT:"
241  CALL set_output_file_time(nc_dat,interval_time,next_time&
242  &,nextstk,prev_time,prevstk,stklen,stkmax)
243 
244 
245 
246  if (starttime > next_time)&
247  & Call fatal_error("The time of the first file output &
248  &must be greater than or equal to the start time")
249 
250  if (endtime < next_time)&
251  & Call fatal_error("The time of the first file output &
252  &must be less than or equal to the end time")
253 
254  END IF
255 
256  IF (rst_on) THEN
257 
258 
259 
260  CALL get_first_output_time(trim(rst_first_out),next_time)
261 
262  CALL get_output_file_interval(trim(rst_out_interval),interval_time)
263 
264  nextstk = 0
265  prevstk = 0
266  prev_time = zerotime
267  stklen = 0
268  stkmax = rst_output_stack
269 
270 
271  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! RESTART OUTPUT:"
272  CALL set_output_file_time(nc_rst,interval_time,next_time&
273  &,nextstk,prev_time,prevstk,stklen,stkmax)
274 
275 
276 
277  if (starttime > next_time)&
278  & Call fatal_error("The time of the first restart output &
279  &must be greater than or equal to the start time")
280 
281  if (endtime < next_time)&
282  & Call fatal_error("The time of the first restart output &
283  &must be less than or equal to the end time")
284 
285  END IF
286 
287 
288 !=================================================
289 ! CRASHSTART
290  CASE("crashrestart") ! OR FORECAST MODE
291 !=================================================
292  if(dbg_set(dbg_log)) then
293  WRITE(ipt,*)'! SET TIME FOR CRASHRESTART !'
294  WRITE(ipt,*)'! !'
295  end if
296 
297  IF(.NOT. ASSOCIATED(nc_start)) CALL fatal_error&
298  & ('STARUP FILE IS NOT ASSOCIATED IN SETUP_TIME!')
299 
300  IF(forecast_mode) THEN
301  ! GET THE START TIME FROM THE NAMELIST
302  starttime = read_datetime(start_date,date_format,timezone,status)
303  if (status == 0) &
304  & Call fatal_error("Could not read the date string START_DATE: "//trim(start_date))
305 
306  CALL set_startup_file_stack(starttime,iint)
307 
308  ELSE
309  ! OTHERWISE GET THE LAST TIME IN THE RESTART FILE
310  CALL set_last_file_time(nc_start,starttime, iint)
311  END IF
312 
313  SELECT CASE(use_real_world_time)
314  CASE(.true.)
315 
316  runfile_starttime = read_datetime(start_date,date_format,timezone,status)
317  if (status == 0) &
318  & Call fatal_error("Could not read the date string START_DATE: "//trim(start_date))
319 
320 
321  ! GET THE END TIME
322  EndTime = READ_DATETIME(END_DATE,DATE_FORMAT,TIMEZONE,status)
323  if (status == 0) &
324  & Call fatal_error("Could not read the date string END_DATE: "&
325  &//trim(end_date))
326 
327  ! SANITY CHECK
328  if(starttime .GT. endtime) &
329  & Call fatal_error("Runfile Start_Date exceeds or equal to End_Date")
330 
331  ! ADVANCE TO THE FIRST TIME STEP OF THE MODEL FROM THE
332  ! INITIAL CONDITION
333  istart = iint +1
334 
335  !CALCULATE THE NUMBER OF STEPS AND IEND
336  nsteps = calculate_number_of_timesteps(starttime,endtime)
337  iend = istart + nsteps
338 
339  ! GET THE REFERENCE DATE TIME
340  IF(date_reference /= 'default')THEN
341  referencedate = read_datetime(date_reference,date_format,timezone,status)
342  if (status == 0 ) &
343  & Call fatal_error("Could not read the date string DATE_REFERENCE: "//trim(date_reference))
344  ELSE
345  referencedate%MJD = 0
346  referencedate%MuSOD = 0
347  END IF
348 
349  CASE (.false.)
350 
351  ! GET THE START AND END INFORMATION
352  CALL ideal_time_string2time(start_date,bflag,runfile_starttime,istart)
353 
354 
355  CALL ideal_time_string2time(end_date,eflag,endtime,iend)
356 
357  ! SANITY CHECK
358  IF (bflag /= eflag) CALL fatal_error&
359  ('IDEALIZED MODEL TIME SPECIFICATION IS INCORRENT',&
360  &'BEGIN AND END CAN BE IN EITHER CYCLES OR TIME BUT NOT MIXED',&
361  & trim(start_date),trim(end_date) )
362 
363  IF (eflag == 'time') THEN ! IF START AND END TIME WERE SPECIFIED
364 
365  !CALCULATE THE NUMBER OF STEPS
366  nsteps = calculate_number_of_timesteps(starttime,endtime)
367 
368  ! ADVANCE THE TO THE FIRST TIME STEP OF THE MODEL FROM THE
369  ! INITIAL CONDITION
370  istart = iint +1
371 
372  ! GET IEND
373  iend = istart + nsteps
374 
375 
376  ELSE IF(eflag == 'step') THEN ! IF START AND END IINT WERE SPECIFIED
377 
378  ! CALCULATE THE RUNFILE START TIME
379  runfile_starttime = imdti * istart
380 
381  ! CALCULATE NSTEPS
382  nsteps = iend - iint
383 
384  ! SANITY CHECK
385  IF(nsteps .LT. 0) CALL fatal_error&
386  &('Number of steps can not be less than zero')
387 
388  IF(istart .LT. 0) CALL fatal_error&
389  &('Starting time step can not be less than zero')
390 
391  ! CALCULATE THE END TIME
392  EndTime = StartTime + IMDTI * nsteps
393 
394  ! ADVANCE THE TO THE FIRST TIME STEP OF THE MODEL FROM THE
395  ! INITIAL CONDITION
396  istart = iint + 1
397 
398  ELSE
399  CALL fatal_error('IDEAL_TIME_STRING2TIME returned invalid flag')
400 
401  END IF
402 
403  END SELECT
404 
405  ! SET THE INITIAL MODEL TIME
406  inttime = starttime
407  exttime = starttime
408 
409 
410  ! INITIALIZE IEXT
411  iext = 1
412 
413  CALL report_time_setup
414 
415 ! SET THE OUT PUT TIME FOR THE DIFFERENT FILES
416  IF (ncav_on) THEN
417 
418  ! GET THE OUT PUT INTERVAL FROM RUN FILE
419  CALL get_output_file_interval(trim(ncav_out_interval),interval_time)
420 
421  ! FIRST OUPUT TIME: Must open existing file and find out!
422  ncf => new_file()
423  ncf%FNAME=nc_avg%FNAME
424 
425  Call nc_open(ncf)
426  CALL nc_load(ncf)
427 
428  ! GET THE CURRENT STACK LENGTH
429  stklen = ncf%FTIME%stk_len
430 
431  !!! DAS{ 5.28.14
432 
433  ! GET THE TIME OF THE FIRST OUTPUT
434  IF (stklen .GT. 1) THEN
435 
436  CALL update_file_bracket(ncf,starttime,status)
437  IF(status == 0) THEN
438 
439  !PREV_TIME = NCF%FTIME%PREV_IO
440  !PREVSTK= NCF%FTIME%PREV_STKCNT
441  !
442  !! SET THE NEXT OUTPUT
443  !Nextstk = NCF%FTIME%NEXT_STKCNT
444  !NEXT_TIME = NCF%FTIME%NEXT_IO
445 
446  ! The last output will be the previous
447  !PREV_TIME = NCF%FTIME%NEXT_IO
448  !PREVSTK = NCF%FTIME%NEXT_STKCNT
449 
450  !Nextstk = NCF%FTIME%NEXT_STKCNT + 1
451  !NEXT_TIME = NCF%FTIME%NEXT_IO + INTERVAL_TIME
452  !!! END DAS
453 
454  IF(ncf%FTIME%NEXT_IO == starttime) then
455  next_time = starttime
456  nextstk = ncf%FTIME%NEXT_STKCNT + 1
457 
458  prev_time = ncf%FTIME%PREV_IO
459  prevstk = ncf%FTIME%PREV_STKCNT + 1
460 
461  else if (ncf%FTIME%PREV_IO == starttime) then
462  next_time = starttime
463  nextstk = ncf%FTIME%NEXT_STKCNT
464 
465  prev_time = starttime - interval_time
466  prevstk = ncf%FTIME%PREV_STKCNT
467 
468  else
469  call fatal_error('Something is very wrong with update_file_bracket!')
470 
471  end if
472 
473  ELSE
474 
475  call fatal_error('Start time is before or after average output ???')
476 
477  ! THERE IS NO SAVED OUTPUT PAST THE RESART TIME
478  !NEXT_TIME = GET_FILE_TIME_NCF(NCF,stklen)
479  !NEXTSTK= STKLEN
480 
481  !prevstk = stklen - 1
482  !PREV_TIME = NEXT_TIME - INTERVAL_TIME
483  !
484  !IF(StartTime > PREV_TIME) call Fatal_error&
485  ! &("COULD NOT FIND VALID BRACKET FOR START TIME IN THE DATA FILE",&
486  ! & "Try comparing the time in the restart and the data file?")
487 
488  END IF
489 
490  ELSE IF(stklen .eq. 1)THEN
491 
492  ! CHECK TO SEE WHETHER THIS OUTPUT IS AHEAD OF THE START TIME
493  !PREV_TIME = GET_FILE_TIME_NCF(NCF,stklen)
494  !IF (PREV_TIME <= StartTime) THEN
495  ! PREVSTK= STKLEN
496  !
497  ! ! SET THE NEXT OUTPUR
498  ! Nextstk = stklen + 1
499  ! NEXT_TIME = PREV_TIME + INTERVAL_TIME
500  !ELSE
501  ! NEXTSTK=STKLEN
502  ! NEXT_TIME= PREV_TIME
503  ! PREV_TIME= ZEROTIME
504  !END IF
505 
506  next_time = get_file_time_ncf(ncf,stklen)
507  if (next_time == starttime) then
508  nextstk = stklen + 1
509 
510  prev_time = zerotime
511  prevstk = 0
512 
513 
514  else
515 
516  call fatal_error('Cant crash restart when the restart time is not an average output time!')
517 
518  end if
519 
520 
521 
522  ELSE
523  ! IF THERE ARE NOT YET ANY TIMESTEPS IN THE FILE
524  prev_time=zerotime
525  prevstk=0
526  nextstk=1
527  CALL get_first_output_time(trim(ncav_first_out),next_time)
528  END IF
529 
530  !DAS} 5.28.14
531 
532 
533  IF(next_time < starttime) THEN
534  CALL print_time(starttime,ipt,"Start Time")
535  CALL print_time(next_time,ipt,"First AVG OUTPUT")
536 
537  CALL fatal_error&
538  & ("CAN NOT CONNECT TO EXISTING FILE - THERE IS A TIME GAP",&
539  "BETWEEN THE EXISTING OUTPUT AND THE START TIME?")
540 
541  END IF
542 
543 
544  if (endtime < next_time)&
545  & Call fatal_error("The time of the first averaged output &
546  &must be less than or equal to the end time")
547 
548 
549  ! FINISHED WITH FILE
550  CALL kill_file(ncf)
551 
552 
553  ! SET THE STACK MAX
554  stkmax = ncav_output_stack
555 
556 
557  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! TIME AVERAGE OUTPUT:"
558  CALL set_output_file_time(nc_avg,interval_time,next_time&
559  &,nextstk,prev_time,prevstk,stklen,stkmax)
560 
561 
562  Call print_file(nc_avg)
563 
564  END IF
565 
566  IF (nc_on) THEN
567 
568  CALL get_output_file_interval(trim(nc_out_interval),interval_time)
569 
570  ! FIRST OUPUT TIME: Must open existing file and find out!
571  ncf => new_file()
572  ncf%FNAME=nc_dat%FNAME
573 
574  Call nc_open(ncf)
575  CALL nc_load(ncf)
576 
577  ! GET THE CURRENT STACK LENGTH
578  stklen = ncf%FTIME%stk_len
579 
580  ! GET THE TIME OF THE FIRST OUTPUT
581  IF (stklen .GT. 1) THEN
582 
583  CALL update_file_bracket(ncf,starttime,status)
584  IF(status == 0) THEN
585  prev_time = ncf%FTIME%PREV_IO
586  prevstk= ncf%FTIME%PREV_STKCNT
587 
588  ! SET THE NEXT OUTPUT
589  nextstk = ncf%FTIME%NEXT_STKCNT
590  next_time = ncf%FTIME%NEXT_IO
591 
592  ELSE
593 
594  ! THERE IS NO SAVED OUTPUT PAST THE RESART TIME
595  prev_time = get_file_time_ncf(ncf,stklen)
596  prevstk= stklen
597 
598  nextstk = stklen + 1
599  next_time = prev_time + interval_time
600 
601  IF(starttime > next_time) call fatal_error&
602  &("COULD NOT FIND VALID BRACKET FOR START TIME IN THE DATA FILE",&
603  & "Try comparing the time in the restart and the data file?")
604 
605  END IF
606 
607  ELSE IF(stklen .eq. 1) THEN
608 
609  prev_time = get_file_time_ncf(ncf,stklen)
610  IF (prev_time <= starttime) THEN
611  prevstk= stklen
612 
613  ! SET THE NEXT OUTPUR
614  nextstk = stklen + 1
615  next_time = prev_time + interval_time
616  ELSE
617  nextstk=stklen
618  next_time= prev_time
619  prev_time= zerotime
620  END IF
621 
622  ELSE
623  ! IF THERE ARE NOT YET ANY TIMESTEPS IN THE FILE
624  prev_time=zerotime
625  prevstk=0
626  nextstk=1
627  CALL get_first_output_time(trim(nc_first_out),next_time)
628  END IF
629 
630  IF(next_time < starttime) THEN
631  CALL print_time(starttime,ipt,"Start Time")
632  CALL print_time(next_time,ipt,"First DATA OUTPUT")
633 
634  CALL fatal_error&
635  & ("CAN NOT CONNECT TO EXISTING FILE - THERE IS A TIME GAP",&
636  "BETWEEN THE EXISTING OUTPUT AND THE START TIME?")
637 
638  END IF
639 
640  if (endtime < next_time)&
641  & Call fatal_error("The time of the first file output &
642  &must be less than or equal to the end time")
643 
644 
645  ! SET THE STACK MAX
646  stkmax = nc_output_stack
647 
648  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! NETCDF OUTPUT:"
649  CALL set_output_file_time(nc_dat,interval_time,next_time&
650  &,nextstk,prev_time,prevstk,stklen,stkmax)
651 
652  ! FINISHED WITH FILE
653  CALL kill_file(ncf)
654 
655  END IF
656 
657  IF (rst_on) THEN
658 
659  CALL get_output_file_interval(trim(rst_out_interval),interval_time)
660 
661  ! GET THE CURRENT STACK LENGTH
662  stklen = nc_start%FTIME%stk_len
663 
664  ncf => nc_start
665 
666  ! GET THE TIME OF THE FIRST OUTPUT
667  IF (stklen .GT. 1) THEN
668 
669  ! RESET STACK AND TIME AND LET BRACKET FIND IT
670  ncf%FTIME%PREV_IO = zerotime
671  ncf%FTIME%prev_stkcnt = 0
672  CALL update_file_bracket(ncf,starttime,status)
673  IF(status /= 0) call fatal_error&
674  &(" COULD NOT FIND VALID BRACKET FOR START TIME IN THE DATA FILE")
675 
676  ! SPECIAL FOR THE RESTART FILE -
677  ! MAKE SURE THE PREVIOUS TIME IS THE START TIME FOR
678  ! READING HOTSTART
679  IF (ncf%FTIME%PREV_IO == starttime) THEN
680 
681  prev_time = ncf%FTIME%PREV_IO
682  prevstk= ncf%FTIME%PREV_STKCNT
683 
684  ! SET THE NEXT OUTPUT
685  nextstk = ncf%FTIME%NEXT_STKCNT
686  next_time = ncf%FTIME%NEXT_IO
687  ELSE IF (ncf%FTIME%NEXT_IO == starttime) THEN
688 
689  prev_time= ncf%FTIME%NEXT_IO
690  prevstk= ncf%FTIME%NEXT_STKCNT
691 
692  next_time= prev_time + interval_time
693  nextstk = prevstk + 1
694 
695  ELSE
696  CALL fatal_error("DID NOT MATCH START TIME TO RESTART FILE")
697  END IF
698 
699 
700  ELSE IF(stklen .eq. 1) THEN
701 
702  prev_time = get_file_time_ncf(ncf,stklen)
703  prevstk= stklen
704 
705  ! SET THE NEXT OUTPUT
706  nextstk = stklen + 1
707  next_time = prev_time + interval_time
708 
709 
710  ELSE
711 
712  CALL fatal_error("What a mess this is... ",&
713  &"I suggest a strong cocktail before you try and figure this one out!")
714 
715  END IF
716 
717 
718  ! SET BACK TO CORRECT TIME FOR STARTUP
719  ncf%FTIME%PREV_IO= prev_time
720  ncf%FTIME%PREV_STKCNT=prevstk
721 
722  ncf%FTIME%NEXT_IO = next_time
723  ncf%FTIME%NEXT_STKCNT = nextstk
724 
725  if (endtime < next_time)&
726  & Call fatal_error("The time of the first file output &
727  &must be less than or equal to the end time")
728 
729  ! SET THE STACK MAX
730  stkmax = rst_output_stack
731 
732  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! RESTART OUTPUT:"
733  CALL set_output_file_time(nc_rst,interval_time,next_time&
734  &,nextstk,prev_time,prevstk,stklen,stkmax)
735 
736 
737  END IF
738 
739 !=================================================
740 ! COLDSTART
741  CASE("coldstart")
742 !=================================================
743  if(dbg_set(dbg_log)) then
744  WRITE(ipt,*)'! SET TIME FOR COLDSTART !'
745  WRITE(ipt,*)'! !'
746  end if
747 
748 
749  SELECT CASE(use_real_world_time)
750  CASE(.true.)
751 
752  ! GET THE START TIME
753  starttime = read_datetime(start_date,date_format,timezone,status)
754  if (status == 0 ) &
755  & Call fatal_error("Could not read the date string START_DATE: "//trim(start_date))
756 
757  ! GET THE END TIME
758  EndTime = READ_DATETIME(END_DATE,DATE_FORMAT,TIMEZONE,status)
759  if (status == 0) &
760  & Call fatal_error("Could not read the date string END_DATE: "&
761  &//trim(end_date))
762 
763  ! SANITY CHECK
764  if(starttime .GT. endtime) &
765  & Call fatal_error("Runfile Start_Date exceeds or equal to End_Date")
766 
767  ! GET THE REFERENCE DATE TIME
768  IF(date_reference /= 'default')THEN
769  referencedate = read_datetime(date_reference,date_format,timezone,status)
770  if (status == 0 ) &
771  & Call fatal_error("Could not read the date string DATE_REFERENCE: "//trim(date_reference))
772  ELSE
773  referencedate%MJD = 0
774  referencedate%MuSOD = 0
775  END IF
776 
777  !CALCULATE THE NUMBER OF STEPS AND IEND
778  iint = 0
779  istart = 1
780  nsteps = calculate_number_of_timesteps(starttime,endtime)
781  iend = istart + nsteps
782 
783  IF(ASSOCIATED(nc_start)) THEN
784  IF(dbg_set(dbg_log)) WRITE(ipt,*) &
785  & "! SETTING PREV_STCKNT FOR NETCDF COLD START FILE 1"
786 
787  CALL set_startup_file_stack(starttime)
788 
789  ELSE
790  IF(dbg_set(dbg_log)) WRITE(ipt,*) &
791  & "! NO NETCDF COLD START FILE"
792 
793  END IF
794 
795 
796 
797  CASE(.false.) ! THIS MODEL IS USING IDEALIZED TIME
798 
799  ! GET THE START AND END INFORMATION
800  CALL ideal_time_string2time(start_date,bflag,starttime,iint)
801  CALL ideal_time_string2time(end_date,eflag,endtime,iend)
802 
803  ! SANITY CHECK
804  IF (bflag /= eflag) CALL fatal_error&
805  ('IDEALIZED MODEL TIME SPECIFICATION IS INCORRENT',&
806  &'BEGIN AND END CAN BE IN EITHER CYCLES OR TIME BUT NOT MIXED',&
807  & trim(start_date),trim(end_date) )
808 
809  IF (bflag == 'time') THEN
810 
811  !CALCULATE THE NUMBER OF STEPS
812  iint = 0
813  istart = 1
814  nsteps = calculate_number_of_timesteps(starttime,endtime)
815  iend = istart + nsteps
816 
817  IF(ASSOCIATED(nc_start)) THEN
818  IF(dbg_set(dbg_log)) WRITE(ipt,*) &
819  & "! SETTING PREV_STCKNT FOR NETCDF COLD START FI&
820  &LE 2"
821 
822  CALL set_startup_file_stack(starttime)
823 
824  ELSE
825  IF(dbg_set(dbg_log)) WRITE(ipt,*) &
826  & "! NO NETCDF COLD START FILE"
827 
828  END IF
829 
830 
831  ELSE IF(bflag == 'step') THEN
832 
833  ! CALCULATE NSTEPS
834  nsteps = iend - iint
835 
836  ! SANITY CHECK
837  IF(nsteps .LT. 0) CALL fatal_error&
838  &('Number of steps can not be less than zero')
839 
840  ! CALCULATE THE START TIME
841  starttime = imdti * iint
842 
843  ! CALCULATE THE END TIME
844  EndTime = IMDTI * iend
845 
846  ! ADVANCE THE TO THE FIRST TIME STEP OF THE MODEL FROM THE
847  ! INITIAL CONDITION
848  istart = iint +1
849 
850 
851  IF(ASSOCIATED(nc_start)) THEN
852  IF(dbg_set(dbg_log)) WRITE(ipt,*) &
853  & "! SETTING PREV_STCKNT FOR NETCDF COLD START FI&
854  &LE 3"
855 
856  CALL set_startup_file_stack(iint)
857 
858  ELSE
859  IF(dbg_set(dbg_log)) WRITE(ipt,*) &
860  & "! NO NETCDF COLD START FILE"
861 
862  END IF
863 
864  ELSE
865  CALL fatal_error('IDEAL_TIME_STRING2TIME returned invalid flag')
866 
867  END IF
868 
869  END SELECT
870 
871  inttime = starttime
872  exttime = starttime
873  runfile_starttime = starttime
874 
875 
876  ! INITIALIZE IEXT
877  iext = 1
878 
879  ! IF THERE IS AN INITIAL CONDITION FILE SET THE STCKNT
880  IF(ASSOCIATED(nc_start)) THEN ! ONLY DO THIS IF THERE IS A STARTUP FILE
881  CALL set_startup_file_stack(starttime)
882  END IF
883 
884  CALL report_time_setup
885 
886 ! SET THE OUT PUT TIME FOR THE DIFFERENT FILES
887  IF (ncav_on) THEN
888 
889  CALL get_first_output_time(trim(ncav_first_out),next_time)
890 
891  CALL get_output_file_interval(trim(ncav_out_interval),interval_time)
892 
893  nextstk = 0
894  prevstk = 0
895  prev_time = zerotime
896  stklen = 0
897  stkmax = ncav_output_stack
898 
899 
900  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! TIME AVERAGE OUTPUT:"
901  CALL set_output_file_time(nc_avg,interval_time,next_time&
902  &,nextstk,prev_time,prevstk,stklen,stkmax)
903 
904 
905  if (starttime > next_time)&
906  & Call fatal_error("The time of the first averaged output &
907  &must be greater than or equal to the start time")
908 
909  if (endtime < next_time)&
910  & Call fatal_error("The time of the first averaged output &
911  &must be less than or equal to the end time")
912 
913  END IF
914 
915  IF (nc_on) THEN
916 
917  CALL get_first_output_time(trim(nc_first_out),next_time)
918 
919  CALL get_output_file_interval(trim(nc_out_interval),interval_time)
920 
921  nextstk = 0
922  prevstk = 0
923  prev_time = zerotime
924  stklen = 0
925  stkmax = nc_output_stack
926 
927 
928  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! NETCDF OUTPUT:"
929  CALL set_output_file_time(nc_dat,interval_time,next_time&
930  &,nextstk,prev_time,prevstk,stklen,stkmax)
931 
932 
933 
934  if (starttime > next_time)&
935  & Call fatal_error("The time of the first file output &
936  &must be greater than or equal to the start time")
937 
938  if (endtime < next_time)&
939  & Call fatal_error("The time of the first file output &
940  &must be less than or equal to the end time")
941 
942  END IF
943 
944  IF (rst_on) THEN
945 
946 
947 
948  CALL get_first_output_time(trim(rst_first_out),next_time)
949 
950  CALL get_output_file_interval(trim(rst_out_interval),interval_time)
951 
952  nextstk = 0
953  prevstk = 0
954  prev_time = zerotime
955  stklen = 0
956  stkmax = rst_output_stack
957 
958 
959  IF(dbg_set(dbg_log)) WRITE(ipt,*) "! RESTART OUTPUT:"
960  CALL set_output_file_time(nc_rst,interval_time,next_time&
961  &,nextstk,prev_time,prevstk,stklen,stkmax)
962 
963 
964 
965  if (starttime > next_time)&
966  & Call fatal_error("The time of the first restart output &
967  &must be greater than or equal to the start time")
968 
969  if (endtime < next_time)&
970  & Call fatal_error("The time of the first restart output &
971  &must be less than or equal to the end time")
972 
973  END IF
974 
975 !===========================================
976  CASE DEFAULT
977 !===========================================
978 
979  CALL fatal_error("UNKNOWN STARUP TYPE IN RUNFILE")
980 
981 !===========================================
982  END SELECT
983 !===========================================
984 
985 
986 !================================================
987 !
988 ! MAKE SURE THAT OUTPUT INTERVALS ARE AN INTEGER
989 ! NUMBER OF TIME STEPS
990 !
991 !================================================
992 
993  IF(rst_on) THEN
994  interval_time = nc_rst%FTIME%INTERVAL
995  next_time = nc_rst%FTIME%NEXT_IO
996 
997  IF(mod(interval_time,imdti) /= zerotime) THEN
998  CALL fatal_error("RST_OUT_INTERVAL must be an integer number of int&
999  &ernal time steps!")
1000  END IF
1001  IF(mod((next_time - starttime),imdti) /= zerotime) THEN
1002  CALL fatal_error("RST_FIRST_OUT must be an integer number of int&
1003  &ernal time steps from the StartTime!")
1004  END IF
1005 
1006  END IF
1007 
1008  IF(nc_on)THEN
1009  interval_time = nc_dat%FTIME%INTERVAL
1010  next_time = nc_dat%FTIME%NEXT_IO
1011  IF(mod(interval_time,imdti) /= zerotime) THEN
1012  CALL fatal_error("NC_OUT_INTERVAL must be an integer number of int&
1013  &ernal time steps!")
1014  END IF
1015  IF(mod((next_time - starttime),imdti) /= zerotime) THEN
1016  CALL fatal_error("NC_FIRST_OUT must be an integer number of int&
1017  &ernal time steps from the StartTime!")
1018  END IF
1019 
1020 
1021  END IF
1022 
1023  IF(ncav_on)THEN
1024  interval_time = nc_avg%FTIME%INTERVAL
1025  next_time = nc_avg%FTIME%NEXT_IO
1026 
1027  IF(mod(interval_time,imdti) /= zerotime) THEN
1028  CALL fatal_error("NCAV_OUT_INTERVAL must be an integer number of int&
1029  &ernal time steps!")
1030  END IF
1031  IF(mod((next_time - starttime),imdti) /= zerotime) THEN
1032  CALL fatal_error("NCAV_FIRST_OUT must be an integer number of int&
1033  &ernal time steps from the StartTime!")
1034  END IF
1035 
1036 
1037  ! CHECK TO MAKE SURE THAT THE RESTART TIMES MATCH THE AVERAGE
1038  ! OUTPUT TIMES
1039  IF(rst_on) THEN
1040  IF(mod(nc_rst%FTIME%INTERVAL,interval_time) /= zerotime) THEN
1041  CALL fatal_error("NCAV_OUT_INTERVAL: The restart file int&
1042  &erval must be an integer number of Average intervals!")
1043 
1044  END IF
1045 
1046  IF(mod(nc_rst%FTIME%NEXT_IO-next_time,interval_time) /= zerotime) THEN
1047  CALL fatal_error&
1048  &("NCAV_FIRST_OUT: Any Restart dump time must also be a average output time!",&
1049  & "MOD(RST_FIRST_OUT - NCAV_FIRST_OUT,NCAV_OUT_INTERVAL)/=0 IS AN ERROR")
1050 
1051  END IF
1052 
1053 
1054  END IF
1055 
1056  END IF
1057 
1058 
1059 
1060 !================================================
1061 !
1062 ! SETUP RECALCULATION TIMES FOR RHO_MEAN
1063 !
1064 !================================================
1065  IF(recalculate_rho_mean) THEN
1066  recalc_rho_mean = starttime
1067 
1068  CALL ideal_time_string2time(interval_rho_mean,flag,delt_rho_mean,nsteps)
1069 
1070  IF(flag == 'step') THEN
1071 
1072  ! SANITY CHECK
1073  IF(nsteps .LE. 0) CALL fatal_error&
1074  &('Number of steps for INTERVAL_RHO_MEAN can not be less than zero')
1075 
1076  ! CALCULATE THE START TIME
1077  delt_rho_mean = imdti * nsteps
1078 
1079  ELSE IF(flag == 'time') THEN
1080 
1081  ! SANITY CHECK
1082  IF(delt_rho_mean .LE. zerotime) CALL fatal_error&
1083  &('INTERVAL_RHO_MEAN can not be LE zero seconds!')
1084 
1085  END IF
1086 
1087  IF (rst_on) THEN
1088 
1089  interval_time = nc_rst%FTIME%INTERVAL
1090  next_time = nc_rst%FTIME%NEXT_IO
1091 
1092  IF(mod(interval_time,delt_rho_mean) /= zerotime) THEN
1093  CALL warning("MODEL RESTART IS NOT PERFECT WHEN USING RHO MEAN RECALCULATION,",&
1094  "TO FIX: SET MOD(RST_OUT_INTERVAL,INTERVAL_RHO_MEAN)==0!")
1095  END IF
1096 
1097 
1098  IF(mod((next_time - starttime),delt_rho_mean) /= zerotime) THEN
1099  CALL warning("MODEL RESTART IS NOT PERFECT WHEN USING RHO MEAN RECALCULATION,",&
1100  "TO FIX: SET MOD(RST_FIRST_OUT-StartTime,INTERVAL_RHO_MEAN)==0!")
1101  END IF
1102 
1103  END IF
1104 
1105  END IF
1106 
1107 
1108  END SUBROUTINE setup_time
1109 !=========================================================================
1110  SUBROUTINE report_time_setup
1111  IMPLICIT NONE
1112 
1113 
1114  SELECT CASE(use_real_world_time)
1115  CASE(.true.)
1116 
1117  if(dbg_set(dbg_log)) then
1118 
1119  write(ipt,*) "! This case uses real world with specified start and end dates"
1120 
1121 
1122  call print_real_time(starttime,ipt,"Start Time",timezone)
1123 
1124 
1125  call print_real_time(endtime,ipt,"End Time",timezone)
1126 
1127  call print_time(imdte,ipt,"External Time STEP")
1128  write(ipt,*) "! DTE(seconds) = ",dte
1129  call print_time(imdti,ipt,"Internal Time STEP")
1130  write(ipt,*) "! DTI(seconds) = ",dti
1131 
1132  write(ipt,*) "!============================="
1133  write(ipt,*) "! ISTART = ",istart
1134  write(ipt,*) "! IEND = ",iend
1135  write(ipt,*) "!============================="
1136  write(ipt,*) "!+++++++++++ FINISED MODEL TIME SETUP ++++++++++++++"
1137  write(ipt,*) "!==================================================="
1138  end if
1139  CASE(.false.)
1140 
1141  if(dbg_set(dbg_log)) then
1142 
1143  write(ipt,*) "!This is an idealized case with a specified runtime"
1144 
1145 
1146  call print_time(starttime,ipt,"Start Time")
1147 
1148 
1149  call print_time(endtime,ipt,"End Time")
1150 
1151  call print_time(imdte,ipt,"External Time STEP")
1152  write(ipt,*) "! DTE(seconds) = ",dte
1153  call print_time(imdti,ipt,"Internal Time STEP")
1154  write(ipt,*) "! DTI(seconds) = ",dti
1155 
1156 
1157  write(ipt,*) "! ============================="
1158  write(ipt,*) "! ISTART = ",istart
1159  write(ipt,*) "! IEND = ",iend
1160  write(ipt,*) "! ============================="
1161  write(ipt,*) "! +++++++++++ FINISED MODEL TIME SETUP ++++++++++++++"
1162  write(ipt,*) "! ==================================================="
1163  end if
1164  END SELECT
1165 
1166  END SUBROUTINE report_time_setup
1167 
1168 
1169 
1170  SUBROUTINE set_model_timestep
1171  IMPLICIT NONE
1172  if(dbg_set(dbg_log)) &
1173  & write(ipt,*) "!========= Setting up model time parameters ==========="
1174 
1175 
1176  ! CONVERT EXTSTEP TO MICROSECONDS AND MAKE IT AN INT
1177  imdte = seconds2time(extstep_seconds)
1178 
1179  ! Get floating point DTE from IMDTE
1180  dte = seconds(imdte)
1181 
1182  if(dbg_set(dbg_io)) write(ipt,*) "! IMDTE (microseconds)= ",imdte
1183  if(dbg_set(dbg_io)) write(ipt,*) "! DTE (seconds) = ",dte
1184 
1185  if (imdte .LE. zerotime) &
1186  & Call fatal_error("EXTSTEP_SECONDS must be greater than 10**-6 seconds!")
1187 
1188  if (isplit .LE. 0) &
1189  & Call fatal_error("ISPLIT must be greater than zero!")
1190 
1191  ! Get DTI from DTE and ISPLIT
1192  imdti = isplit * imdte
1193  dti = seconds(imdti)
1194 
1195 
1196 
1197  END SUBROUTINE set_model_timestep
1198 
1199  SUBROUTINE ideal_time_string2time(string,flag,ntime,tstep)
1200  IMPLICIT NONE
1201  CHARACTER(LEN=*),INTENT(IN) :: STRING
1202  TYPE(time), INTENT(OUT) :: NTIME
1203  INTEGER(ITIME), INTENT(OUT) :: tstep
1204  CHARACTER(LEN=4), INTENT(OUT) :: FLAG
1205 
1206  INTEGER :: I
1207 
1208  INTEGER :: NLINE, NCHAR, INTVAL(150), NVAL
1209  REAL(DP) :: REALVAL(150)
1210  CHARACTER(LEN=40) :: VARNAME
1211  CHARACTER(LEN=80) :: STRINGVAL(150)
1212  CHARACTER(LEN=7) :: VARTYPE
1213  LOGICAL :: LOGVAL
1214 
1215 
1216  nline = -1
1217  nchar = len_trim(string)
1218 
1219  CALL get_value(nline,nchar,string,varname,vartype,logval&
1220  &,stringval,realval,intval,nval)
1221 
1222 
1223  SELECT CASE(varname)
1224  CASE('days')
1225  IF(vartype == 'float')THEN
1226  ntime= days2time(realval(1))
1227  flag = "time"
1228  ELSE
1229  CALL fatal_error("IDEAL_TIME_STRING2TIME: Unknown Time or Length of Time:",&
1230  & trim(string), "Bad type (check for missing '.')")
1231  END IF
1232  CASE('seconds')
1233 
1234  IF(vartype == 'float')THEN
1235  ntime = seconds2time(realval(1))
1236  flag = "time"
1237 
1238  ELSE
1239  CALL fatal_error("IDEAL_TIME_STRING2TIME: Unknown Time or Length of Time:",&
1240  & trim(string), "Bad type (check for missing '.')")
1241 
1242  END IF
1243 
1244  CASE('cycle')
1245 
1246  IF(vartype == 'integer')THEN
1247 
1248  tstep = intval(1)
1249  flag = "step"
1250 
1251  ELSE
1252  CALL fatal_error("IDEAL_TIME_STRING2TIME: Unknown Time or Length of Time::",&
1253  & trim(string), "Bad type (remove '.' ?)")
1254  END IF
1255 
1256  CASE DEFAULT
1257 
1258  CALL fatal_error("IDEAL_TIME_STRING2TIME: Unknown Time or Length of Time::",&
1259  & trim(string), "Bad units, can be 'seconds' 'days' or 'cycle'")
1260 
1261  END SELECT
1262 
1263 
1264  END SUBROUTINE ideal_time_string2time
1265 
1266 
1267  FUNCTION calculate_number_of_timesteps(STIME,ETIME) RESULT(TSTEP)
1268  IMPLICIT NONE
1269  INTEGER(itime) :: tstep
1270  TYPE(time), INTENT(IN) :: stime, etime
1271  real(dp) :: temp
1272 
1273 
1274  ! CALCULAT THE NUMBER OF TIME STEPS
1275  temp = seconds(etime-stime) / seconds(imdti)
1276  tstep = ceiling(temp)-1
1277 
1278  END FUNCTION calculate_number_of_timesteps
1279 
1280  SUBROUTINE set_last_file_time(NCF,STIME, STEP)
1281  IMPLICIT NONE
1282  TYPE(ncfile), POINTER :: NCF
1283  TYPE(time), INTENT(OUT) :: Stime
1284  INTEGER(ITIME), INTENT(OUT) :: STEP
1285 
1286  INTEGER, TARGET :: FSTEP
1287  TYPE(time) :: Atime
1288  integer :: status, I
1289  real(DP) :: temp
1290  TYPE(ncvar), POINTER :: VAR
1291  logical found
1292 
1293  IF(.NOT. ASSOCIATED(ncf)) CALL fatal_error &
1294  & ("SET_LAST_FILE_TIME: The file object is not assocaited!")
1295 
1296 
1297  status = set_file_time_type(ncf)
1298  IF(status /= 0) CALL fatal_error &
1299  & ("COULD NOT FIND A VALID TIME VARIABLE IN THE RESTART FILE: ",&
1300  & trim(ncf%FNAME))
1301 
1302 
1303  i = ncf%FTIME%STK_LEN
1304 
1305  IF (i .LE. 0) CALL fatal_error("FILE LENGTH IS LESS THAN ONE - NO VALID RESTART TIMES!")
1306 
1307  stime =get_file_time_ncf(ncf,i)
1308 
1309  ncf%FTIME%PREV_STKCNT = i
1310  ncf%FTIME%PREV_IO = stime
1311 
1312  var => find_var(ncf,'iint',found)
1313  IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'iint'&
1314  & IN THE CRASH RESTART FILE OBJECT")
1315  var%scl_int => fstep
1316  CALL nc_read_var(var,i)
1317 
1318  step = fstep
1319 
1320  END SUBROUTINE set_last_file_time
1321 
1322  SUBROUTINE set_startup_file_stack_by_time(STIME,STEP)
1323  IMPLICIT NONE
1324  TYPE(time), INTENT(IN) :: Stime
1325  INTEGER(ITIME), INTENT(OUT),OPTIONAL :: STEP
1326 
1327  INTEGER, TARGET :: FSTEP
1328  TYPE(time) :: Atime
1329  integer :: status, I
1330  real(DP) :: temp
1331  TYPE(ncfile), POINTER :: NCF
1332  TYPE(ncvar), POINTER :: VAR
1333  logical found
1334 
1335 
1336  IF(.NOT. ASSOCIATED(nc_start)) CALL fatal_error &
1337  & ("The file object NC_START is not assocaited!")
1338 
1339 
1340  status = set_file_time_type(nc_start)
1341  IF(status /= 0) CALL fatal_error &
1342  & ("COULD NOT FIND A VALID TIME VARIABLE IN THE RESTART FILE: ",&
1343  & trim(nc_start%FNAME))
1344 
1345  i = 0
1346  DO
1347  i = i + 1
1348  IF (i .GT. nc_start%FTIME%STK_LEN) THEN
1349 
1350  IF(dbg_set(dbg_log))&
1351  & CALL print_real_time(stime,ipt,"Asked for Start Time")
1352 
1353  IF(i == 2) THEN
1354  IF(dbg_set(dbg_log))&
1355  & CALL print_real_time(get_file_time_ncf(nc_start,1),ipt,"The Only Restart Time Is")
1356 
1357  ELSE IF(i==1)THEN
1358  CALL fatal_error &
1359  & ("Restart file has time dimension equal zero!:",&
1360  & trim(nc_start%FNAME))
1361  ELSE
1362  atime =get_file_time_ncf(nc_start,1)
1363  IF(dbg_set(dbg_log))&
1364  & CALL print_real_time(atime,ipt,"First Restart Time")
1365 
1366  atime =get_file_time_ncf(nc_start,i-1)
1367  IF(dbg_set(dbg_log))&
1368  & CALL print_real_time(atime,ipt,"Last Restart Time")
1369  END IF
1370 
1371  CALL fatal_error &
1372  & ("COULD NOT FIND A MATCHING START TIME IN THE RESTART FILE!:",&
1373  & "(See time options printed above?)",&
1374  & trim(nc_start%FNAME))
1375  END IF
1376 
1377  atime = get_file_time_ncf(nc_start,i)
1378 
1379 
1380  !IF (ATIME == STime) THEN
1381  IF(abs(atime -stime)<0.1_sp*imdti) THEN
1382 
1383  nc_start%FTIME%PREV_STKCNT = i
1384  !NC_START%FTIME%PREV_IO = ATIME
1385 
1386  nc_start%FTIME%PREV_IO = stime
1387 
1388  IF (PRESENT(step)) THEN
1389  var => find_var(nc_start,'iint',found)
1390  IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'iint'&
1391  & IN THE HOTSTART FILE OBJECT")
1392  var%scl_int => fstep
1393  CALL nc_read_var(var,i)
1394 
1395  step = fstep
1396  END IF
1397 
1398  return
1399  END IF
1400 
1401  END DO
1402 
1403 
1404  END SUBROUTINE set_startup_file_stack_by_time
1405 
1406  SUBROUTINE set_startup_file_stack_by_cycle(step,ATIME)
1407  IMPLICIT NONE
1408  INTEGER(ITIME), INTENT(IN) :: STEP
1409  TYPE(time), OPTIONAL, INTENT(OUT) :: Atime
1410  integer :: status, I
1411  real(DP) :: temp
1412  TYPE(ncfile), POINTER :: NCF
1413  TYPE(ncvar), POINTER :: VAR
1414  INTEGER, TARGET :: FSTEP
1415  logical found
1416 
1417  IF(.NOT. ASSOCIATED(nc_start)) CALL fatal_error &
1418  & ("The file object NC_START is not assocaited!")
1419 
1420 
1421  status = set_file_time_type(nc_start)
1422  IF(status /= 0) CALL fatal_error &
1423  & ("COULD NOT FIND A VALID TIME VARIABLE IN THE RESTART FILE: ",&
1424  & trim(nc_start%FNAME))
1425 
1426  i = 0
1427  DO
1428  i = i + 1
1429  IF (i .GT. nc_start%FTIME%STK_LEN) THEN
1430 
1431  CALL fatal_error &
1432  & ("COULD NOT FIND A MATCHING IINT CYCLE NUMBER IN THE RESTART FILE!:",&
1433  & trim(nc_start%FNAME))
1434  END IF
1435 
1436  var => find_var(nc_start,'iint',found)
1437  IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'iint'&
1438  & IN THE HOTSTART FILE OBJECT")
1439  var%scl_int => fstep
1440  CALL nc_read_var(var,i)
1441 
1442  IF (fstep == step) THEN
1443 
1444  if (PRESENT(atime)) THEN
1445  atime = get_file_time_ncf(nc_start,i)
1446 
1447  nc_start%FTIME%PREV_STKCNT = i
1448  nc_start%FTIME%PREV_IO = atime
1449  END if
1450 
1451  return
1452  END IF
1453 
1454  END DO
1455 
1456 
1457  END SUBROUTINE set_startup_file_stack_by_cycle
1458 
1459  SUBROUTINE check_startup_file_dimensions
1460  IMPLICIT NONE
1461  integer :: status, I
1462  real(DP) :: temp
1463  TYPE(time) :: Atime
1464  TYPE(ncfile), POINTER :: NCF
1465  TYPE(ncdim), POINTER :: DIM
1466  logical found
1467 
1468 
1469 !!!!!
1470 !!!! I DON'T THINK WE REALLY NEED TO IMPLIMENT THIS - JUST LET IT
1471 !!!! CRASH LATER!
1472 !!!!!
1473 
1474  IF(.NOT. ASSOCIATED(nc_start)) CALL fatal_error &
1475  & ("The file object NC_START is not assocaited!")
1476 
1477 
1478 
1479  IF (startup_type .EQ. startup_type_crashrestart .OR. &
1480  & startup_type .EQ. startup_type_hotstart) THEN
1481 
1482  dim => find_dim(nc_start,"nele",found)
1483  IF(.not. found) CALL fatal_error&
1484  & ("START FILE IS MISSING A CRITICAL DIMENSION:",&
1485  & trim(nc_start%FNAME))
1486 
1487  IF (dim%DIM /= ngl) CALL fatal_error&
1488  & ("START FILE DIMENSION 'nele' DOES NOT MATCH:",&
1489  & trim(nc_start%FNAME))
1490 
1491  dim => find_dim(nc_start,"node",found)
1492  IF(.not. found) CALL fatal_error&
1493  & ("START FILE IS MISSING A CRITICAL DIMENSION:",&
1494  & trim(nc_start%FNAME))
1495 
1496  IF (dim%DIM /= mgl) CALL fatal_error&
1497  & ("START FILE DIMENSION 'node' DOES NOT MATCH THE RUN FILE:",&
1498  & trim(nc_start%FNAME))
1499  END IF
1500 
1501  IF(startup_uv_type .eq. startup_type_setvalues .OR. &
1502  & startup_turb_type .eq. startup_type_setvalues .OR.&
1503  & startup_ts_type .eq. startup_type_setvalues) THEN
1504 
1505  dim => find_dim(nc_start,"siglay",found)
1506  IF(.not. found) CALL fatal_error&
1507  & ("RESTART FILE IS MISSING A CRITICAL DIMENSION:",&
1508  & trim(nc_start%FNAME))
1509 
1510  IF (dim%DIM /= kbm1) CALL fatal_error&
1511  & ("RESTART FILE DIMENSION 'siglay' DOES NOT MATCH THE RUN FILE:",&
1512  & trim(nc_start%FNAME))
1513 
1514  dim => find_dim(nc_start,"siglev",found)
1515  IF(.not. found) CALL fatal_error&
1516  & ("RESTART FILE IS MISSING A CRITICAL DIMENSION:",&
1517  & trim(nc_start%FNAME))
1518 
1519  IF (dim%DIM /= kbm1) CALL fatal_error&
1520  & ("RESTART FILE DIMENSION 'siglay' DOES NOT MATCH THE RUN FILE:",&
1521  & trim(nc_start%FNAME))
1522  END IF
1523 
1524  END SUBROUTINE check_startup_file_dimensions
1525 
1526  SUBROUTINE get_first_output_time(STRING,FIRST_TIME)
1527  IMPLICIT NONE
1528  CHARACTER(LEN=*),INTENT(IN) :: STRING
1529  TYPE(time), INTENT(OUT) :: FIRST_TIME
1530  INTEGER ::STATUS
1531 
1532  if (use_real_world_time) then
1533  first_time = read_datetime(string,date_format,timezone,status)
1534  if (status == 0 ) Call fatal_error &
1535  ("GET_FIRST_OUTPUT_TIME: Could not read the date string: "//trim(string))
1536  else
1537  ! THIS IS REALLY THE SAME AS WHAT IS NEEDED IN THIS CASE
1538  ! REALLY WE ARE GETTING THE START TIME NOT THE INTERVAL
1539  CALL get_output_file_interval(trim(string),first_time)
1540  end if
1541 
1542  END SUBROUTINE get_first_output_time
1543 
1544 
1545 
1546  SUBROUTINE get_output_file_interval(STRING,INTERVAL)
1547  IMPLICIT NONE
1548  CHARACTER(LEN=*),INTENT(IN) :: STRING
1549  TYPE(time), INTENT(OUT) :: INTERVAL
1550 
1551  CHARACTER(LEN=4) :: FLAG
1552  TYPE(time) :: NTIME
1553  INTEGER(ITIME) :: tstep
1554  INTEGER :: I
1555 
1556  CALL ideal_time_string2time(string,flag,ntime,tstep)
1557 
1558  IF (flag == 'time') THEN ! IF START AND END TIME WERE SPECIFIED
1559 
1560  interval = ntime
1561 
1562  ELSE IF(flag == 'step') THEN ! IF START AND END IINT WERE SPECIFIED
1563 
1564  interval= tstep * imdti
1565 
1566  ELSE
1567  CALL fatal_error('GET_OUTPUT_FILE_INTERVAL: bad flag value?')
1568  END IF
1569 
1570 
1571  END SUBROUTINE get_output_file_interval
1572 
1573 
1574  SUBROUTINE set_output_file_time(NCF,OUT_INTERVAL,NEXT_TIME,NEXT_STK,PREV_TIME,PREV_STK,STKLEN,STACK_MAX)
1575  IMPLICIT NONE
1576  TYPE(ncfile), POINTER :: NCF
1577  TYPE(time), INTENT(IN) :: NEXT_TIME, PREV_TIME
1578  TYPE(time), INTENT(IN) :: OUT_INTERVAL
1579  INTEGER, INTENT(IN) :: STACK_MAX,STKLEN,NEXT_STK, PREV_STK
1580 
1581  TYPE(time) :: ZEROTIME
1582  TYPE(ncftime), POINTER :: FTM
1583  logical found
1584 
1585  IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"SET_OUTPUT_FILE_TIME: START"
1586 
1587  IF(dbg_set(dbg_io)) THEN
1588  WRITE(ipt,*)"=== PRINTING IO INFO FOR: SET_OUTPUT_FILE_TIME ==="
1589  CALL print_time(out_interval,ipt,"OUT_INTERVAL")
1590  CALL print_time(next_time,ipt,"NEXT_TIME")
1591  WRITE(ipt,*)"NEXT_STK=",next_stk
1592  CALL print_time(prev_time,ipt,"PREV_TIME")
1593  WRITE(ipt,*)"PREV_STK=",prev_stk
1594  WRITE(ipt,*)"STKLEN=",stklen
1595  WRITE(ipt,*)"STACK_MAX=",stack_max
1596  WRITE(ipt,*)"=== END IO INFO FOR: SET_OUTPUT_FILE_TIME ==="
1597  END IF
1598 
1599  IF (.NOT.ASSOCIATED(ncf)) CALL fatal_error &
1600  & ('SET_OUTPUT_FILE_TIME: FILE OBJECT HANDLE IS NOT ASSOCIATED')
1601 
1602  IF (.NOT.ASSOCIATED(ncf%FTIME)) ncf%FTIME=>new_ftime()
1603  ftm => ncf%FTIME
1604 
1605  if (out_interval < zerotime) Call fatal_error &
1606  & ("The output interval must be greater than or equal to zero",&
1607  & "Check the run file INTERVAL")
1608 
1609  ! SET CURRENT STACK LENGTH
1610  ftm%STK_LEN=stklen
1611 
1612  ! SET THE MAXIMUM STACK SIZE FOR THE FILE
1613  ftm%MAX_STKCNT = stack_max
1614 
1615  ! SET THE OUPUT INTERVAL TIME
1616  ftm%INTERVAL = out_interval
1617 
1618  ! SET THE TIME OF THE NEXT OUTPUT
1619  ftm%NEXT_IO = next_time
1620 
1621  !SET THE STK OF THE NEXT OUTPUT
1622  ftm%NEXT_STKCNT = next_stk
1623 
1624  ! SET THE TIME OF THE PREV OUTPUT
1625  ftm%PREV_IO = prev_time
1626 
1627  !SET THE STK OF THE PREV OUTPUT
1628  ftm%PREV_STKCNT = prev_stk
1629 
1630 
1631  IF(dbg_set(dbg_io)) THEN
1632  WRITE(ipt,*) "! === DUMPING OUTPUT FILE TIMING INFO: ==="
1633  CALL print_ftime(ftm)
1634  WRITE(ipt,*) "! ========================================"
1635 
1636  ELSE IF (dbg_set(dbg_log)) THEN
1637 
1638  IF (use_real_world_time) then
1639  CALL print_real_time(next_time,ipt,'First Output Time')
1640  ELSE
1641  CALL print_time(next_time,ipt,'First Output Time')
1642  END IF
1643 
1644  CALL print_time(out_interval,ipt,"Output Interval")
1645 
1646  END IF
1647 
1648  nullify(ftm)
1649 
1650  IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"SET_OUTPUT_FILE_TIME: END"
1651 
1652  END SUBROUTINE set_output_file_time
1653 
1654 END MODULE mod_set_time
mod_set_time::setup_time
subroutine setup_time
Definition: mod_set_time.f90:55
control::iend
integer(itime) iend
Definition: mod_main.f90:853
control::date_format
character(len=80) date_format
Definition: mod_main.f90:125
mod_set_time::get_output_file_interval
subroutine get_output_file_interval(STRING, INTERVAL)
Definition: mod_set_time.f90:1547
control::referencedate
type(time) referencedate
Definition: mod_main.f90:835
control::startup_type
character(len=80) startup_type
Definition: mod_main.f90:141
mod_set_time::check_startup_file_dimensions
subroutine check_startup_file_dimensions
Definition: mod_set_time.f90:1460
mod_set_time::set_startup_file_stack
Definition: mod_set_time.f90:47
mod_set_time::set_startup_file_stack_by_cycle
subroutine set_startup_file_stack_by_cycle(step, ATIME)
Definition: mod_set_time.f90:1407
control::starttime
type(time) starttime
Definition: mod_main.f90:833
control::istart
integer(itime) istart
Definition: mod_main.f90:852
control::date_reference
character(len=80) date_reference
Definition: mod_main.f90:129
control::iint
integer(itime) iint
Definition: mod_main.f90:850
mod_time
Definition: mod_time.f90:40
mod_set_time::set_last_file_time
subroutine set_last_file_time(NCF, STIME, STEP)
Definition: mod_set_time.f90:1281
mod_time::read_datetime
type(time) function read_datetime(timestr, frmt, TZONE, status)
Definition: mod_time.f90:640
control::timezone
character(len=80) timezone
Definition: mod_main.f90:126
control::runfile_starttime
type(time) runfile_starttime
Definition: mod_main.f90:834
mod_time::time
Definition: mod_time.f90:59
control::endtime
type(time) endtime
Definition: mod_main.f90:832
control::use_real_world_time
logical use_real_world_time
Definition: mod_main.f90:131
control::end_date
character(len=80) end_date
Definition: mod_main.f90:128
mod_set_time::set_model_timestep
subroutine set_model_timestep
Definition: mod_set_time.f90:1171
mod_set_time::get_first_output_time
subroutine get_first_output_time(STRING, FIRST_TIME)
Definition: mod_set_time.f90:1527
control::nsteps
integer(itime) nsteps
Definition: mod_main.f90:854
mod_set_time::ideal_time_string2time
subroutine ideal_time_string2time(string, flag, ntime, tstep)
Definition: mod_set_time.f90:1200
control::ipt
integer ipt
Definition: mod_main.f90:922
mod_set_time::calculate_number_of_timesteps
integer(itime) function calculate_number_of_timesteps(STIME, ETIME)
Definition: mod_set_time.f90:1268
mod_set_time
Definition: mod_set_time.f90:40
mod_nctools
Definition: mod_nctools.f90:40
control::start_date
character(len=80) start_date
Definition: mod_main.f90:127
mod_set_time::set_output_file_time
subroutine set_output_file_time(NCF, OUT_INTERVAL, NEXT_TIME, NEXT_STK, PREV_TIME, PREV_STK, STKLEN, STACK_MAX)
Definition: mod_set_time.f90:1575
mod_input
Definition: mod_input.f90:40
mod_set_time::report_time_setup
subroutine report_time_setup
Definition: mod_set_time.f90:1111
mod_set_time::set_startup_file_stack_by_time
subroutine set_startup_file_stack_by_time(STIME, STEP)
Definition: mod_set_time.f90:1323
mod_input::nc_start
type(ncfile), pointer nc_start
Definition: mod_input.f90:51
Generated by   doxygen 1.8.15