xref: /phasta/svLS/CPUT.f (revision 712d3df0b59ebebaaeaea358162c8d2c043c6e08)
1*1e99f302SBen Matthews!     This software is Copyright (c) 2012-2015 The Regents of the
2*1e99f302SBen Matthews!     University of California. All Rights Reserved.
3*1e99f302SBen Matthews!
4*1e99f302SBen Matthews!     Permission to copy and modify this software and its documentation
5*1e99f302SBen Matthews!     for educational, research and non-profit purposes, without fee,
6*1e99f302SBen Matthews!     and without a written agreement is hereby granted, provided that
7*1e99f302SBen Matthews!     the above copyright notice, this paragraph and the following three
8*1e99f302SBen Matthews!     paragraphs appear in all copies.
9*1e99f302SBen Matthews!
10*1e99f302SBen Matthews!     Permission to make commercial use of this software may be obtained
11*1e99f302SBen Matthews!     by contacting:
12*1e99f302SBen Matthews!
13*1e99f302SBen Matthews!     Technology Transfer Office
14*1e99f302SBen Matthews!     9500 Gilman Drive, Mail Code 0910
15*1e99f302SBen Matthews!     University of California
16*1e99f302SBen Matthews!     La Jolla, CA 92093-0910
17*1e99f302SBen Matthews!     (858) 534-5815
18*1e99f302SBen Matthews!     invent@ucsd.edu
19*1e99f302SBen Matthews!
20*1e99f302SBen Matthews!     This software program and documentation are copyrighted by The
21*1e99f302SBen Matthews!     Regents of the University of California. The software program and
22*1e99f302SBen Matthews!     documentation are supplied "as is", without any accompanying
23*1e99f302SBen Matthews!     services from The Regents. The Regents does not warrant that the
24*1e99f302SBen Matthews!     operation of the program will be uninterrupted or error-free. The
25*1e99f302SBen Matthews!     end-user understands that the program was developed for research
26*1e99f302SBen Matthews!     purposes and is advised not to rely exclusively on the program for
27*1e99f302SBen Matthews!     any reason.
28*1e99f302SBen Matthews!
29*1e99f302SBen Matthews!     IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
30*1e99f302SBen Matthews!     PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
31*1e99f302SBen Matthews!     DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS
32*1e99f302SBen Matthews!     SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
33*1e99f302SBen Matthews!     CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34*1e99f302SBen Matthews!     THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY
35*1e99f302SBen Matthews!     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
36*1e99f302SBen Matthews!     OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
37*1e99f302SBen Matthews!     SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE
38*1e99f302SBen Matthews!     UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO PROVIDE
39*1e99f302SBen Matthews!     MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
40*1e99f302SBen Matthews
41*1e99f302SBen Matthews      FUNCTION CPUT()
42*1e99f302SBen Matthews
43*1e99f302SBen Matthews      IMPLICIT NONE
44*1e99f302SBen Matthews
45*1e99f302SBen Matthews      INTEGER timeArray(8), i
46*1e99f302SBen Matthews      INTEGER, PARAMETER::nD(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
47*1e99f302SBen Matthews
48*1e99f302SBen Matthews      REAL*8 CPUT
49*1e99f302SBen Matthews
50*1e99f302SBen Matthews      CALL DATE_AND_TIME (VALUES=timeArray)
51*1e99f302SBen Matthews
52*1e99f302SBen Matthews      timeArray(3) = timeArray(3) + (timeArray(1) - 2010)*365
53*1e99f302SBen Matthews      DO i=1, timeArray(2) - 1
54*1e99f302SBen Matthews         timeArray(3) = timeArray(3) + nD(i)
55*1e99f302SBen Matthews      END DO
56*1e99f302SBen Matthews      CPUT = timeArray(3)*8.64D4
57*1e99f302SBen Matthews     2   + timeArray(5)*3.6D3
58*1e99f302SBen Matthews     3   + timeArray(6)*6D1
59*1e99f302SBen Matthews     4   + timeArray(7)*1D0
60*1e99f302SBen Matthews     5   + timeArray(8)*1D-3
61*1e99f302SBen Matthews
62*1e99f302SBen Matthews      RETURN
63*1e99f302SBen Matthews      END FUNCTION CPUT
64