Program set_ancillary_time ,6FPANCTIM.35
FPANCTIM.36
implicit none FPANCTIM.37
FPANCTIM.38
! declaration of globals FPANCTIM.39
FPANCTIM.40
*CALL CUNITNOS 
FPANCTIM.41
*CALL CREFTIM FPANCTIM.42
FPANCTIM.43
! declaration of local scalars FPANCTIM.44
FPANCTIM.45
integer fvhh,fvdd,fvmm,fvyy ! first validity time FPANCTIM.46
integer lvhh,lvdd,lvmm,lvyy ! last validity time FPANCTIM.47
integer ivhh,ivdd,ivmm,ivyy ! interval between fields in file FPANCTIM.48
FPANCTIM.49
logical year360 ! true for 360-day calendar FPANCTIM.50
FPANCTIM.51
integer first_vt_offset ! offset in hours of first validity FPANCTIM.52
! time from reference time FPANCTIM.53
FPANCTIM.54
integer last_vt_offset ! offset in hours of first validity FPANCTIM.55
! time from reference time FPANCTIM.56
FPANCTIM.57
integer imins, isecs ! minutes and seconds discarded FPANCTIM.58
FPANCTIM.59
integer icode ! error return code; > 0 => error FPANCTIM.60
FPANCTIM.61
FPANCTIM.62
! declaration of namelists FPANCTIM.63
FPANCTIM.64
namelist /offset_vt/ first_vt_offset,last_vt_offset FPANCTIM.65
FPANCTIM.66
namelist /first_vt/ fvhh,fvdd,fvmm,fvyy FPANCTIM.67
namelist /last_vt/ lvhh,lvdd,lvmm,lvyy FPANCTIM.68
namelist /interval/ year360,ivhh,ivdd,ivmm,ivyy FPANCTIM.69
FPANCTIM.70
! declaration of externals FPANCTIM.71
external open_file, readhk, add_hours FPANCTIM.72
!---------------------------------------------------------------------- FPANCTIM.73
FPANCTIM.74
! 0. Preliminaries FPANCTIM.75
icode = 0 FPANCTIM.76
FPANCTIM.77
! 1. Open files for input and output FPANCTIM.78
FPANCTIM.79
! 1.1 open housekeeping file FPANCTIM.80
call open_file(UnitHK, 'Formatted ', 'Unknown', icode) FPANCTIM.81
if ( icode .ne. 0 ) then FPANCTIM.82
write(6,*) ' ERROR: set_ancillary_time: 1.1 ', FPANCTIM.83
# ' unable to open housekeeping file' FPANCTIM.84
go to 9999 FPANCTIM.85
end if FPANCTIM.86
FPANCTIM.87
FPANCTIM.88
! open Validity time selection file FPANCTIM.89
call open_file(UnitVT, 'Formatted ', 'Unknown', icode) FPANCTIM.90
if ( icode .ne. 0 ) then FPANCTIM.91
write(6,*) ' ERROR: set_ancillary_time: 1.2 ', FPANCTIM.92
# ' unable to open Validity time selection file' FPANCTIM.93
go to 9999 FPANCTIM.94
end if FPANCTIM.95
FPANCTIM.96
! open output file for ancillary file validity times namelist FPANCTIM.97
call open_file(UnitVTOut, 'Formatted ', 'Unknown', icode) FPANCTIM.98
if ( icode .ne. 0 ) then FPANCTIM.99
write(6,*) ' ERROR: set_ancillary_time: 1.3 ', FPANCTIM.100
# ' unable to open Validity times output file' FPANCTIM.101
go to 9999 FPANCTIM.102
end if FPANCTIM.103
FPANCTIM.104
FPANCTIM.105
! 1. Read house keeping file to set reference date FPANCTIM.106
RefSec = 0 FPANCTIM.107
RefMin = 0 FPANCTIM.108
call readhk(UnitHK, RefHour, RefDay, RefMonth, RefYear,icode) FPANCTIM.109
FPANCTIM.110
! Read offset_vt namelist FPANCTIM.111
first_vt_offset = 0 FPANCTIM.112
last_vt_offset = 0 FPANCTIM.113
FPANCTIM.114
read ( UnitVT, offset_vt ) FPANCTIM.115
write ( 6, offset_vt ) FPANCTIM.116
FPANCTIM.117
! Read interval namelist FPANCTIM.118
FPANCTIM.119
year360=.false. FPANCTIM.120
ivhh=0 FPANCTIM.121
ivdd=0 FPANCTIM.122
ivmm=0 FPANCTIM.123
ivyy=0 FPANCTIM.124
FPANCTIM.125
read ( UnitVT, interval ) FPANCTIM.126
write ( 6, interval ) FPANCTIM.127
FPANCTIM.128
! Set first validity time FPANCTIM.129
call add_hours ( FPANCTIM.130
*CALL AREFTIM FPANCTIM.131
# fvyy, fvmm, fvdd, fvhh, imins, isecs, FPANCTIM.132
# first_vt_offset ) FPANCTIM.133
FPANCTIM.134
write (6, first_vt) FPANCTIM.135
FPANCTIM.136
! Set last validity time FPANCTIM.137
call add_hours ( FPANCTIM.138
*CALL AREFTIM FPANCTIM.139
# lvyy, lvmm, lvdd, lvhh, imins, isecs, FPANCTIM.140
# last_vt_offset ) FPANCTIM.141
FPANCTIM.142
write (6, last_vt) FPANCTIM.143
FPANCTIM.144
! Write output namelists FPANCTIM.145
FPANCTIM.146
write ( UnitVTOut, first_vt ) FPANCTIM.147
write ( UnitVTOut, interval ) FPANCTIM.148
write ( UnitVTOut, last_vt ) FPANCTIM.149
FPANCTIM.150
! close files FPANCTIM.151
close (UnitHK) FPANCTIM.152
close (UnitVT) FPANCTIM.153
close (UnitVTOut) FPANCTIM.154
FPANCTIM.155
9999 continue FPANCTIM.156
FPANCTIM.157
stop FPANCTIM.158
end FPANCTIM.159
!---------------------------------------------------------------------- FPANCTIM.160
*ENDIF FPANCTIM.161