*IF DEF,CONTROL SETHIST1.2
C ******************************COPYRIGHT****************************** GTS2F400.8605
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8606
C GTS2F400.8607
C Use, duplication or disclosure of this code is subject to the GTS2F400.8608
C restrictions as set forth in the contract. GTS2F400.8609
C GTS2F400.8610
C Meteorological Office GTS2F400.8611
C London Road GTS2F400.8612
C BRACKNELL GTS2F400.8613
C Berkshire UK GTS2F400.8614
C RG12 2SZ GTS2F400.8615
C GTS2F400.8616
C If no contract has been raised with this copy of the code, the use, GTS2F400.8617
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8618
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8619
C Modelling at the above address. GTS2F400.8620
C ******************************COPYRIGHT****************************** GTS2F400.8621
C GTS2F400.8622
CLL Routine: SET_HISTORY_VALUES---------------------------------------- SETHIST1.3
CLL SETHIST1.4
CLL Purpose: Updates certain history file values before any calls SETHIST1.5
CLL to write out history file SETHIST1.6
CLL SETHIST1.7
CLL Tested under compiler: cft77 SETHIST1.8
CLL Tested under OS version: UNICOS 6.1.5A SETHIST1.9
CLL SETHIST1.10
CLL Author: R A Stratton SETHIST1.11
CLL SETHIST1.12
CLL Model Modification history from model version 3.0: SETHIST1.13
CLL version date SETHIST1.14
CLL 3.3 08/02/94 Modify calls to TIME2SEC/SEC2TIME to output/input TJ080294.492
CLL elapsed times in days & secs, for portability. TCJ TJ080294.493
CLL 3.4 17/06/94 Argument LCAL360 added and passed to SEC2TIME, GSS1F304.656
CLL TIME2SEC. S.J.Swarbrick WRB1F401.748
CLL 3.4 27/10/94 Set year correctly for Gregorian calendar ARJ2F304.2
CLL 4.1 18/04/96 Set RUN_ID from EXPT_ID & JOB_ID. RTHBarnes. WRB1F401.749
CLL ARJ2F304.3
CLL Programming standard: UM Doc Paper 3, version 1 (15/1/90) SETHIST1.16
CLL SETHIST1.17
CLL Logical components covered: H SETHIST1.18
CLL SETHIST1.19
CLL Project task: H SETHIST1.20
CLL SETHIST1.21
CLL External documentation: SETHIST1.22
CLL SETHIST1.23
CLL ------------------------------------------------------------------- SETHIST1.24
C*L Interface and arguments: ------------------------------------------ SETHIST1.25
C SETHIST1.26
SUBROUTINE SET_HISTORY_VALUES 4,7GDR3F305.168
C SETHIST1.28
IMPLICIT NONE SETHIST1.29
C SETHIST1.30
C*---------------------------------------------------------------------- SETHIST1.31
C Common blocks SETHIST1.32
C SETHIST1.33
*CALL CMAXSIZE 
GDR3F305.169
*CALL CSUBMODL GDR3F305.170
*CALL CHSUNITS GDR3F305.171
*CALL CHISTORY SETHIST1.34
*CALL CTIME SETHIST1.35
*CALL CCONTROL GDR3F305.172
C SETHIST1.36
C Subroutines called SETHIST1.37
C SETHIST1.38
EXTERNAL SEC2TIME,TIME2SEC,STP2TIME TJ080294.494
C SETHIST1.40
C Local variables SETHIST1.41
C SETHIST1.42
INTEGER SETHIST1.43
& ELAPSED_DAYS ! Elapsed time since basis time(days) TJ080294.495
&, ELAPSED_SECS ! Elapsed time since basis time(secs) TJ080294.496
&, ELAPSED_DAYA ! time since basis time atmosphere TJ080294.497
&, ELAPSED_SECA ! time since basis time atmosphere SETHIST1.45
&, ELAPSED_DAYO ! time since basis time Ocean TJ080294.498
&, ELAPSED_SECO ! time since basis time Ocean SETHIST1.46
&, FINAL_DAYS ! target time (days) TJ080294.499
&, FINAL_SECS ! target time (seconds) TJ080294.500
&, J_YEAR ! Year SETHIST1.48
&, J_MONTH ! month SETHIST1.49
&, J_DAY ! day SETHIST1.50
&, J_HOUR ! hour SETHIST1.51
&, J_MINUTE ! minute SETHIST1.52
&, J_SECOND ! second SETHIST1.53
&, J_DAY_NUMBER ! day number SETHIST1.54
CL SETHIST1.55
CL---------------------------------------------------------------------- SETHIST1.56
CL 1. Set Run target reached so far ready for possible resubmission SETHIST1.57
CL SETHIST1.58
*IF DEF,ATMOS SETHIST1.59
*IF -DEF,OCEAN SETHIST1.60
CALL STP2TIME(STEPim(A_IM), GDR3F305.173
& STEPS_PER_PERIODim(A_IM),SECS_PER_PERIODim(A_IM), GDR3F305.174
& ELAPSED_DAYS,ELAPSED_SECS) TJ080294.502
*ELSE SETHIST1.62
CALL STP2TIME(STEPim(A_IM), GDR3F305.175
& STEPS_PER_PERIODim(A_IM),SECS_PER_PERIODim(A_IM), GDR3F305.176
& ELAPSED_DAYA,ELAPSED_SECA) TJ080294.504
CALL STP2TIME(STEPim(O_IM), GDR3F305.177
& STEPS_PER_PERIODim(O_IM),SECS_PER_PERIODim(O_IM), GDR3F305.178
& ELAPSED_DAYO,ELAPSED_SECO) TJ080294.506
IF (ELAPSED_DAYA.LT.ELAPSED_DAYO) THEN TJ080294.507
ELAPSED_DAYS=ELAPSED_DAYA TJ080294.508
ELAPSED_SECS=ELAPSED_SECA TJ080294.509
ELSE TJ080294.510
ELAPSED_DAYS=ELAPSED_DAYO TJ080294.511
ELAPSED_SECS=ELAPSED_SECO TJ080294.512
ENDIF TJ080294.513
*ENDIF SETHIST1.66
*ENDIF SETHIST1.67
*IF DEF,OCEAN SETHIST1.68
CALL STP2TIME(STEPim(O_IM), GDR3F305.179
& STEPS_PER_PERIODim(O_IM),SECS_PER_PERIODim(O_IM), GDR3F305.180
& ELAPSED_DAYS,ELAPSED_SECS) @GCP1F304.2
*ENDIF SETHIST1.70
CL SETHIST1.71
CL convert ELAPSED_DAYS/SECS back into a time relative to Basis time TJ080294.514
CL SETHIST1.73
CALL SEC2TIME(ELAPSED_DAYS,ELAPSED_SECS,0,0, TJ080294.515
& J_YEAR,J_MONTH,J_DAY,J_HOUR, TJ080294.516
& J_MINUTE,J_SECOND,J_DAY_NUMBER,LCAL360) GSS1F304.661
IF (LCAL360) THEN ARJ2F304.4
RUN_RESUBMIT_TARGET(1)=J_YEAR SETHIST1.76
ELSE ARJ2F304.5
RUN_RESUBMIT_TARGET(1)=J_YEAR-1 ARJ2F304.6
ENDIF ARJ2F304.7
RUN_RESUBMIT_TARGET(2)=J_MONTH-1 SETHIST1.77
RUN_RESUBMIT_TARGET(3)=J_DAY-1 SETHIST1.78
RUN_RESUBMIT_TARGET(4)=J_HOUR SETHIST1.79
RUN_RESUBMIT_TARGET(5)=J_MINUTE SETHIST1.80
RUN_RESUBMIT_TARGET(6)=J_SECOND SETHIST1.81
SETHIST1.82
CL SETHIST1.83
CL check to see if final target date reached if resubmission is SETHIST1.84
CL operating. SETHIST1.85
CL SETHIST1.86
IF (RUN_RESUBMIT.EQ.'Y') THEN SETHIST1.87
CL SETHIST1.88
CL Work out final target date required in seconds SETHIST1.89
CL SETHIST1.90
J_YEAR = RUN_TARGET_END(1) SETHIST1.91
J_MONTH = RUN_TARGET_END(2) SETHIST1.92
J_DAY = RUN_TARGET_END(3) SETHIST1.93
J_HOUR = RUN_TARGET_END(4) SETHIST1.94
J_MINUTE = RUN_TARGET_END(5) SETHIST1.95
J_SECOND = RUN_TARGET_END(6) SETHIST1.96
IF (LCAL360) THEN GSS1F304.662
CALL TIME2SEC(J_YEAR,J_MONTH+1,J_DAY+1,J_HOUR,J_MINUTE, SETHIST1.98
& J_SECOND,0,0,FINAL_DAYS,FINAL_SECS,LCAL360) GSS1F304.663
ELSE GSS1F304.664
CALL TIME2SEC(J_YEAR+1,J_MONTH+1,J_DAY+1,J_HOUR,J_MINUTE, SETHIST1.101
& J_SECOND,0,0,FINAL_DAYS,FINAL_SECS,LCAL360) GSS1F304.665
END IF GSS1F304.666
IF (ELAPSED_DAYS.GE.FINAL_DAYS.AND.ELAPSED_SECS.GE.FINAL_SECS) TJ080294.520
& THEN TJ080294.521
RUN_RESUBMIT='N' SETHIST1.105
WRITE(6,*)'SETHIST: final target date reached automatic resubmiss GIE0F403.621
&ion switched off' SETHIST1.107
ENDIF SETHIST1.108
ENDIF SETHIST1.109
C Set RUN_IN for qxhistreport WRB1F401.750
RUN_ID = EXPT_ID//JOB_ID WRB1F401.751
SETHIST1.110
RETURN SETHIST1.111
CL---------------------------------------------------------------------- SETHIST1.112
END SETHIST1.113
C SETHIST1.114
*ENDIF SETHIST1.115