pkg/fizhi/fizhi_clockstuff.F

a456aa407c Andr*0001 #include "FIZHI_OPTIONS.h"
813eb1e07a Jean*0002
                0003 C--  File fizhi_clockstuff.F:
                0004 C--   Contents
                0005 C--   o SET_ALARM
                0006 C--   o GET_ALARM
                0007 C--   o ALARM      (function)
                0008 C--   o ALARM2     (function)
                0009 C--   o ALARM2NEXT (function)
                0010 C--   o SET_TIME
                0011 C--   o GET_TIME
                0012 C--   o NSECF      (function)
                0013 C--   o NHMSF      (function)
                0014 C--   o NSECF2     (function)
                0015 C--   o FIXDATE
                0016 C--   o INTERP_TIME
                0017 C--   o TICK
                0018 C--   o TIC_TIME
17e5b05fae Jean*0019 C--   o NALARM     (function)
                0020 C--   o NALARM2    (function)
                0021 C--   o INCYMD     (function)
                0022 C--   o ASTRO
813eb1e07a Jean*0023 C--   o TIME_BOUND
                0024 C--   o TIME2FREQ2
                0025
                0026 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0027
660d83f1cd Andr*0028       subroutine set_alarm (tag,datein,timein,freq)
0889f02121 Jean*0029 C***********************************************************************
                0030 C  Purpose
                0031 C  -------
d1fef4a45f Andr*0032 C     Utility to Set Internal Alarms
                0033 C
0889f02121 Jean*0034 C  Argument Description
                0035 C  --------------------
d1fef4a45f Andr*0036 C     tag ....... Character String Tagging Alarm Process
                0037 C     date ...... Begining Date for Alarm
                0038 C     time ...... Begining Time for Alarm
                0039 C     freq ...... Repeating Frequency Interval for Alarm
                0040 C
0889f02121 Jean*0041 C***********************************************************************
d1fef4a45f Andr*0042
                0043       implicit none
53135ac441 Jean*0044 #include "EEPARAMS.h"
                0045 #include "chronos.h"
                0046
d1fef4a45f Andr*0047       character*(*) tag
660d83f1cd Andr*0048       integer       freq,datein,timein
d1fef4a45f Andr*0049
53135ac441 Jean*0050 C-    functions:
                0051       INTEGER  ILNBLNK
                0052       EXTERNAL ILNBLNK
d1fef4a45f Andr*0053
53135ac441 Jean*0054 C-    local variables:
ed0b0d8f16 Andr*0055       integer myid
175684e43e Andr*0056       logical first,set
d1fef4a45f Andr*0057       data          first /.true./
53135ac441 Jean*0058       integer n, iL
d1fef4a45f Andr*0059
813eb1e07a Jean*0060       myid = 1
d1fef4a45f Andr*0061       if(first) then
                0062          ntags    = 1
                0063           tags(1) = tag
                0064          freqs(1) = freq
660d83f1cd Andr*0065          dates(1) = datein
                0066          times(1) = timein
53135ac441 Jean*0067          iL = ILNBLNK(tag)
                0068          WRITE(standardMessageUnit,'(A,I8,A,I6.6,A,I10,2A)')
                0069      &    '  Set Alarm for: ', datein, '  ', timein,
                0070      &    ', with frequency: ', freq, ', and Tag: ',tag(1:iL)
d1fef4a45f Andr*0071       else
                0072
                0073       set = .false.
                0074       do n=1,ntags
ed0b0d8f16 Andr*0075        if(tag.eq.tags(n)) then
                0076         if( myid.eq.1 ) then
                0077          print *, 'Warning!  Alarm has already been set for Tag: ',tag
                0078          print *, 'Changing  Alarm Information:'
                0079          print *, 'Frequency: ',freqs(n),' (Old) ',freq,' (New)'
660d83f1cd Andr*0080          print *, '    Date0: ',dates(n),' (Old) ',datein,' (New)'
                0081          print *, '    Time0: ',times(n),' (Old) ',timein,' (New)'
ed0b0d8f16 Andr*0082         endif
                0083         freqs(n) = freq
660d83f1cd Andr*0084         dates(n) = datein
                0085         times(n) = timein
ed0b0d8f16 Andr*0086         set = .true.
                0087        endif
d1fef4a45f Andr*0088       enddo
                0089       if(.not.set) then
                0090             ntags = ntags+1
                0091          if(ntags.gt.maxtag ) then
3811d190df Andr*0092             if( myid.eq.1 ) then
d1fef4a45f Andr*0093             print *, 'Too many Alarms are Set!!'
                0094             print *, 'Maximum Number of Alarms = ',maxtag
                0095             endif
                0096          call my_finalize
                0097          call my_exit (101)
                0098          endif
                0099           tags(ntags) = tag
                0100          freqs(ntags) = freq
660d83f1cd Andr*0101          dates(ntags) = datein
                0102          times(ntags) = timein
53135ac441 Jean*0103          iL = ILNBLNK(tag)
                0104          WRITE(standardMessageUnit,'(A,I8,A,I6.6,A,I10,2A)')
                0105      &    '  Set Alarm for: ', datein, '  ', timein,
                0106      &    ', with frequency: ', freq, ', and Tag: ',tag(1:iL)
d1fef4a45f Andr*0107       endif
                0108       endif
                0109
                0110       first = .false.
                0111       return
                0112       end
                0113
660d83f1cd Andr*0114       subroutine get_alarm (tag,datein,timein,freq,tleft)
0889f02121 Jean*0115 C***********************************************************************
                0116 C  Purpose
                0117 C  -------
d1fef4a45f Andr*0118 C     Utility to Get Internal Alarm Information
                0119 C
                0120 C  Input
                0121 C  -----
                0122 C     tag ....... Character String Tagging Alarm Process
                0123 C
                0124 C  Output
                0125 C  ------
660d83f1cd Andr*0126 C     datein ...... Begining  Date for Alarm
                0127 C     timein ...... Begining  Time for Alarm
                0128 C     freq ........ Frequency Interval for Alarm
                0129 C     tleft ....... Time Remaining (seconds) before Alarm is TRUE
d1fef4a45f Andr*0130 C
0889f02121 Jean*0131 C***********************************************************************
d1fef4a45f Andr*0132
                0133       implicit none
                0134       character*(*) tag
660d83f1cd Andr*0135       integer freq,datein,timein,tleft
d1fef4a45f Andr*0136
                0137 #include "chronos.h"
                0138
                0139       logical set,alarm
2a3ae9099b Andr*0140       external alarm
ed0b0d8f16 Andr*0141       integer myid,n,nalarm,nsecf
d1fef4a45f Andr*0142
3811d190df Andr*0143       myid = 1
d1fef4a45f Andr*0144       set = .false.
                0145       do n=1,ntags
813eb1e07a Jean*0146        if (tag.eq.tags(n)) then
                0147          freq   = freqs(n)
                0148          datein = dates(n)
                0149          timein = times(n)
                0150
                0151          if ( alarm(tag) ) then
                0152           tleft = 0
                0153          else
                0154           call get_time (nymd,nhms)
                0155           tleft = nsecf(freq) - nalarm(freq,nymd,nhms,datein,timein )
                0156          endif
d1fef4a45f Andr*0157
813eb1e07a Jean*0158          set = .true.
                0159        endif
d1fef4a45f Andr*0160       enddo
                0161
                0162       if(.not.set) then
3811d190df Andr*0163       if( myid.eq.1 ) print *, 'Alarm has not been set for Tag: ',tag
d1fef4a45f Andr*0164       freq  = 0
660d83f1cd Andr*0165       datein  = 0
                0166       timein  = 0
d1fef4a45f Andr*0167       tleft = 0
                0168       endif
                0169
                0170       return
                0171       end
                0172
813eb1e07a Jean*0173       LOGICAL FUNCTION ALARM (tag)
d1fef4a45f Andr*0174       implicit none
                0175       character*(*) tag
                0176 #include "chronos.h"
                0177
813eb1e07a Jean*0178       integer datein,timein
                0179       integer n,nalarm
                0180       external nalarm
d1fef4a45f Andr*0181
660d83f1cd Andr*0182       call get_time (datein,timein)
d1fef4a45f Andr*0183
                0184       alarm = .false.
                0185       do n=1,ntags
813eb1e07a Jean*0186        if( tags(n).eq.tag  ) then
                0187         if( freqs(n).eq.0 ) then
660d83f1cd Andr*0188           alarm = (dates(n).eq.datein) .and. (times(n).eq.timein)
813eb1e07a Jean*0189         else
660d83f1cd Andr*0190           alarm = ( datein.gt.dates(n) .or.
813eb1e07a Jean*0191      &             (datein.eq.dates(n) .and. timein.ge.times(n)) )
                0192      &    .and. nalarm( freqs(n),datein,timein,dates(n),times(n) ).eq.0
                0193         endif
                0194        endif
d1fef4a45f Andr*0195       enddo
                0196
                0197       return
                0198       end
                0199
813eb1e07a Jean*0200       LOGICAL FUNCTION ALARM2 (tag)
333e96bf9c Andr*0201       implicit none
                0202       character*(*) tag
                0203 #include "chronos.h"
                0204
813eb1e07a Jean*0205       integer datein,timein
                0206       integer n,nalarm2
                0207       external nalarm2
333e96bf9c Andr*0208
                0209       call get_time (datein,timein)
                0210
                0211       alarm2 = .false.
                0212       do n=1,ntags
813eb1e07a Jean*0213        if( tags(n).eq.tag  ) then
                0214         if( freqs(n).eq.0 ) then
333e96bf9c Andr*0215           alarm2 = (dates(n).eq.datein) .and. (times(n).eq.timein)
813eb1e07a Jean*0216         else
333e96bf9c Andr*0217           alarm2 = ( datein.gt.dates(n) .or.
813eb1e07a Jean*0218      &              (datein.eq.dates(n) .and. timein.ge.times(n)) )
                0219      &    .and. nalarm2( freqs(n),datein,timein,dates(n),times(n) ).eq.0
                0220         endif
                0221        endif
333e96bf9c Andr*0222       enddo
                0223
                0224       return
                0225       end
                0226
813eb1e07a Jean*0227       LOGICAL FUNCTION ALARM2NEXT (tag,deltat)
615a167388 Andr*0228       implicit none
                0229       character*(*) tag
                0230       _RL deltat
                0231 #include "chronos.h"
                0232
813eb1e07a Jean*0233       integer datein,timein,ndt
                0234       integer dateminus,timeminus
                0235       integer n,nalarm2
                0236       external nalarm2
615a167388 Andr*0237
                0238       ndt = int(deltat)
                0239       call get_time (dateminus,timeminus)
                0240       datein = dateminus
                0241       timein = timeminus
                0242       call tick(datein,timein,ndt)
                0243
                0244       alarm2next = .false.
                0245       do n=1,ntags
813eb1e07a Jean*0246        if( tags(n).eq.tag  ) then
                0247         if( freqs(n).eq.0 ) then
615a167388 Andr*0248           alarm2next = (dates(n).eq.datein) .and. (times(n).eq.timein)
813eb1e07a Jean*0249         else
615a167388 Andr*0250           alarm2next = ( datein.gt.dates(n) .or.
813eb1e07a Jean*0251      &                  (datein.eq.dates(n) .and. timein.ge.times(n)) )
                0252      &    .and. nalarm2( freqs(n),datein,timein,dates(n),times(n) ).eq.0
                0253         endif
                0254        endif
615a167388 Andr*0255       enddo
                0256
                0257       return
                0258       end
                0259
660d83f1cd Andr*0260       subroutine set_time (datein,timein)
d1fef4a45f Andr*0261       implicit none
660d83f1cd Andr*0262       integer  datein,timein
d1fef4a45f Andr*0263
                0264 #include "chronos.h"
                0265
ed0b0d8f16 Andr*0266       integer myid
d1fef4a45f Andr*0267
3811d190df Andr*0268       myid = 1
                0269       if(  myid.eq.1 ) then
d1fef4a45f Andr*0270       print *, 'Setting Clock'
660d83f1cd Andr*0271       print *, 'Date: ',datein
                0272       print *, 'Time: ',timein
d1fef4a45f Andr*0273       endif
                0274
660d83f1cd Andr*0275       nymd = datein
                0276       nhms = timein
d1fef4a45f Andr*0277       return
                0278       end
                0279
660d83f1cd Andr*0280       subroutine get_time (datein,timein)
d1fef4a45f Andr*0281       implicit none
660d83f1cd Andr*0282       integer datein,timein
d1fef4a45f Andr*0283
                0284 #include "chronos.h"
                0285
660d83f1cd Andr*0286       datein = nymd
                0287       timein = nhms
d1fef4a45f Andr*0288       return
                0289       end
                0290
                0291       function nsecf (nhms)
                0292 C***********************************************************************
                0293 C  Purpose
                0294 C     Converts NHMS format to Total Seconds
                0295 C
                0296 C***********************************************************************
                0297       implicit none
                0298       integer  nhms, nsecf
                0299       nsecf =  nhms/10000*3600 + mod(nhms,10000)/100*60 + mod(nhms,100)
                0300       return
                0301       end
                0302
                0303       function nhmsf (nsec)
                0304 C***********************************************************************
                0305 C  Purpose
                0306 C     Converts Total Seconds to NHMS format
                0307 C
                0308 C***********************************************************************
                0309       implicit none
                0310       integer  nhmsf, nsec
                0311       nhmsf =  nsec/3600*10000 + mod(nsec,3600)/60*100 + mod(nsec,60)
                0312       return
                0313       end
                0314
                0315       function nsecf2 (nhhmmss,nmmdd,nymd)
                0316 C***********************************************************************
                0317 C  Purpose
                0318 C     Computes the Total Number of seconds from NYMD using NHHMMSS & NMMDD
                0319 C
                0320 C  Arguments   Description
                0321 C     NHHMMSS  IntervaL Frequency (HHMMSS)
                0322 C     NMMDD    Interval Frequency (MMDD)
                0323 C     NYMD     Current  Date      (YYMMDD)
                0324 C
                0325 C  NOTE:
                0326 C     IF (NMMDD.ne.0), THEN HOUR FREQUENCY HH MUST BE < 24
                0327 C
                0328 C***********************************************************************
ed0b0d8f16 Andr*0329       implicit none
                0330
                0331       integer nsecf2,nhhmmss,nmmdd,nymd
d1fef4a45f Andr*0332
ed0b0d8f16 Andr*0333       INTEGER NSDAY, NCYCLE
d1fef4a45f Andr*0334       PARAMETER ( NSDAY  = 86400 )
                0335       PARAMETER ( NCYCLE = 1461*24*3600 )
                0336
ed0b0d8f16 Andr*0337       INTEGER YEAR, MONTH, DAY
d1fef4a45f Andr*0338
0889f02121 Jean*0339 c     INTEGER  MNDY(12,4)
                0340       INTEGER  MNDY(12*4)
d1fef4a45f Andr*0341       DATA MNDY /0,31,60,91,121,152,182,213,244,274,305,335,366,
53135ac441 Jean*0342      &           397,34*0 /
d1fef4a45f Andr*0343
ed0b0d8f16 Andr*0344       integer nsecf,i,nsegm,nsegd,iday,iday2,nday
                0345
d1fef4a45f Andr*0346 C***********************************************************************
                0347 C*                 COMPUTE # OF SECONDS FROM NHHMMSS                   *
                0348 C***********************************************************************
                0349
                0350       nsecf2 = nsecf( nhhmmss )
                0351
                0352       if( nmmdd.eq.0 ) return
                0353
                0354 C***********************************************************************
                0355 C*                 COMPUTE # OF DAYS IN A 4-YEAR CYCLE                 *
                0356 C***********************************************************************
                0357
ed0b0d8f16 Andr*0358       DO I=15,48
0889f02121 Jean*0359 c     MNDY(I,1) = MNDY(I-12,1) + 365
                0360         MNDY(I) = MNDY(I-12) + 365
ed0b0d8f16 Andr*0361       ENDDO
d1fef4a45f Andr*0362
                0363 C***********************************************************************
                0364 C*                 COMPUTE # OF SECONDS FROM NMMDD                     *
                0365 C***********************************************************************
                0366
                0367       nsegm =     nmmdd/100
                0368       nsegd = mod(nmmdd,100)
                0369
                0370       YEAR   = NYMD / 10000
                0371       MONTH  = MOD(NYMD,10000) / 100
                0372       DAY    = MOD(NYMD,100)
                0373
0889f02121 Jean*0374 c     IDAY   = MNDY( MONTH ,MOD(YEAR ,4)+1 )
                0375       IDAY   = MNDY( MONTH +12*MOD(YEAR ,4) )
4936127039 Andr*0376       month = month + nsegm
                0377       If( month.gt.12 ) then
                0378       month = month - 12
                0379       year = year + 1
d1fef4a45f Andr*0380       endif
0889f02121 Jean*0381 c     IDAY2  = MNDY( MONTH ,MOD(YEAR ,4)+1 )
                0382       IDAY2  = MNDY( MONTH +12*MOD(YEAR ,4) )
d1fef4a45f Andr*0383
4936127039 Andr*0384                     nday = iday2-iday
d1fef4a45f Andr*0385       if(nday.lt.0) nday = nday + 1461
                0386                     nday = nday + nsegd
                0387
                0388       nsecf2 = nsecf2 + nday*nsday
                0389
                0390       return
                0391       end
                0392
                0393       subroutine fixdate (nymd)
                0394       implicit none
                0395       integer nymd
                0396
813eb1e07a Jean*0397 C Modify 6-digit YYMMDD for dates between 1950-2050
                0398 C -------------------------------------------------
d1fef4a45f Andr*0399       if (nymd .lt. 500101) then
                0400         nymd = 20000000 + nymd
                0401       else if (nymd .le. 991231) then
                0402         nymd = 19000000 + nymd
                0403       endif
                0404
                0405       return
                0406       end
                0407
0889f02121 Jean*0408       subroutine interp_time ( nymd ,nhms ,
53135ac441 Jean*0409      &                         nymd1,nhms1, nymd2,nhms2, fac1,fac2 )
0889f02121 Jean*0410 C***********************************************************************
                0411 C
d1fef4a45f Andr*0412 C  PURPOSE:
                0413 C  ========
                0414 C    Compute interpolation factors, fac1 & fac2, to be used in the
                0415 C    calculation of the instantanious boundary conditions, ie:
                0416 C
                0417 C               q(i,j) = fac1*q1(i,j) + fac2*q2(i,j)
                0418 C    where:
                0419 C               q(i,j) => Boundary Data valid    at (nymd  , nhms )
                0420 C              q1(i,j) => Boundary Data centered at (nymd1 , nhms1)
                0421 C              q2(i,j) => Boundary Data centered at (nymd2 , nhms2)
0889f02121 Jean*0422 C
                0423 C  INPUT:
                0424 C  ======
d1fef4a45f Andr*0425 C    nymd     : Date (yymmdd) of Current Timestep
                0426 C    nhms     : Time (hhmmss) of Current Timestep
                0427 C    nymd1    : Date (yymmdd) of Boundary Data 1
                0428 C    nhms1    : Time (hhmmss) of Boundary Data 1
                0429 C    nymd2    : Date (yymmdd) of Boundary Data 2
                0430 C    nhms2    : Time (hhmmss) of Boundary Data 2
0889f02121 Jean*0431 C
                0432 C  OUTPUT:
                0433 C  =======
d1fef4a45f Andr*0434 C    fac1     : Interpolation factor for Boundary Data 1
                0435 C    fac2     : Interpolation factor for Boundary Data 2
0889f02121 Jean*0436 C
                0437 C
                0438 C***********************************************************************
ed0b0d8f16 Andr*0439       implicit none
                0440
                0441       integer nhms,nymd,nhms1,nymd1,nhms2,nymd2
813eb1e07a Jean*0442       _RL fac1,fac2
0889f02121 Jean*0443
ed0b0d8f16 Andr*0444       INTEGER  YEAR , MONTH , DAY , SEC
d1fef4a45f Andr*0445       INTEGER  YEAR1, MONTH1, DAY1, SEC1
                0446       INTEGER  YEAR2, MONTH2, DAY2, SEC2
                0447
660d83f1cd Andr*0448       _RL time00, time1, time2
0889f02121 Jean*0449
                0450       INTEGER    DAYSCY
b292841e25 Andr*0451       parameter ( dayscy   = 365*4 + 1 )
d1fef4a45f Andr*0452
0889f02121 Jean*0453       INTEGER MNDY(12*4)
                0454
                0455       LOGICAL FIRST
                0456       DATA    FIRST/.TRUE./
                0457
                0458       DATA MNDY /0,31,60,91,121,152,182,213,244,274,305,335,366,
53135ac441 Jean*0459      &           397,34*0 /
ed0b0d8f16 Andr*0460
                0461       integer i,nsecf
0889f02121 Jean*0462
                0463 C***********************************************************************
                0464 C*                         SET TIME BOUNDARIES                         *
                0465 C***********************************************************************
                0466
ed0b0d8f16 Andr*0467       YEAR   = NYMD / 10000
                0468       MONTH  = MOD(NYMD,10000) / 100
                0469       DAY    = MOD(NYMD,100)
                0470       SEC    = NSECF(NHMS)
0889f02121 Jean*0471
ed0b0d8f16 Andr*0472       YEAR1  = NYMD1 / 10000
                0473       MONTH1 = MOD(NYMD1,10000) / 100
                0474       DAY1   = MOD(NYMD1,100)
                0475       SEC1   = NSECF(NHMS1)
0889f02121 Jean*0476
ed0b0d8f16 Andr*0477       YEAR2  = NYMD2 / 10000
                0478       MONTH2 = MOD(NYMD2,10000) / 100
                0479       DAY2   = MOD(NYMD2,100)
                0480       SEC2   = NSECF(NHMS2)
0889f02121 Jean*0481
                0482 C***********************************************************************
                0483 C*                    COMPUTE DAYS IN 4-YEAR CYCLE                     *
                0484 C***********************************************************************
                0485
ed0b0d8f16 Andr*0486       IF(FIRST) THEN
                0487       DO I=15,48
0889f02121 Jean*0488         MNDY(I) = MNDY(I-12) + 365
d1fef4a45f Andr*0489       ENDDO
ed0b0d8f16 Andr*0490       FIRST=.FALSE.
                0491       ENDIF
0889f02121 Jean*0492
                0493 C***********************************************************************
                0494 C*                     COMPUTE INTERPOLATION FACTORS                   *
                0495 C***********************************************************************
                0496
                0497       time00 = DAY + MNDY(MONTH +12*MOD(YEAR ,4)) + float(sec )/86400.
                0498       time1 = DAY1 + MNDY(MONTH1+12*MOD(YEAR1,4)) + float(sec1)/86400.
                0499       time2 = DAY2 + MNDY(MONTH2+12*MOD(YEAR2,4)) + float(sec2)/86400.
d1fef4a45f Andr*0500
660d83f1cd Andr*0501       if( time00 .lt.time1 ) time00  = time00  + dayscy
d1fef4a45f Andr*0502       if( time2.lt.time1 ) time2 = time2 + dayscy
                0503
660d83f1cd Andr*0504       fac1  = (time2-time00)/(time2-time1)
                0505       fac2  = (time00-time1)/(time2-time1)
d1fef4a45f Andr*0506
ed0b0d8f16 Andr*0507       RETURN
                0508       END
d1fef4a45f Andr*0509
                0510       subroutine tick (nymd,nhms,ndt)
                0511 C***********************************************************************
                0512 C  Purpose
                0513 C     Tick the Date (nymd) and Time (nhms) by NDT (seconds)
                0514 C
                0515 C***********************************************************************
ed0b0d8f16 Andr*0516       implicit none
                0517
                0518       integer nymd,nhms,ndt
                0519
                0520       integer nsec,nsecf,incymd,nhmsf
d1fef4a45f Andr*0521
                0522       IF(NDT.NE.0) THEN
                0523       NSEC = NSECF(NHMS) + NDT
                0524
                0525       IF (NSEC.GT.86400)  THEN
                0526       DO WHILE (NSEC.GT.86400)
                0527       NSEC = NSEC - 86400
                0528       NYMD = INCYMD (NYMD,1)
                0529       ENDDO
0889f02121 Jean*0530       ENDIF
                0531
d1fef4a45f Andr*0532       IF (NSEC.EQ.86400)  THEN
                0533       NSEC = 0
                0534       NYMD = INCYMD (NYMD,1)
0889f02121 Jean*0535       ENDIF
                0536
d1fef4a45f Andr*0537       IF (NSEC.LT.00000)  THEN
                0538       DO WHILE (NSEC.LT.0)
                0539       NSEC = 86400 + NSEC
                0540       NYMD = INCYMD (NYMD,-1)
                0541       ENDDO
0889f02121 Jean*0542       ENDIF
                0543
d1fef4a45f Andr*0544       NHMS = NHMSF (NSEC)
0889f02121 Jean*0545       ENDIF
d1fef4a45f Andr*0546
813eb1e07a Jean*0547 #ifdef FIZHI_USE_FIXED_DAY
                0548       NYMD = 20040321
                0549 #endif
                0550
0889f02121 Jean*0551       RETURN
                0552       END
d1fef4a45f Andr*0553
                0554       subroutine tic_time (mymd,mhms,ndt)
                0555 C***********************************************************************
                0556 C  PURPOSE
                0557 C     Tick the Clock by NDT (seconds)
                0558 C
                0559 C***********************************************************************
ed0b0d8f16 Andr*0560       implicit none
                0561 #include "chronos.h"
d1fef4a45f Andr*0562
ed0b0d8f16 Andr*0563       integer mymd,mhms,ndt
                0564
                0565       integer nsec,nsecf,incymd,nhmsf
d1fef4a45f Andr*0566
                0567       IF(NDT.NE.0) THEN
                0568       NSEC = NSECF(NHMS) + NDT
                0569
                0570       IF (NSEC.GT.86400)  THEN
                0571       DO WHILE (NSEC.GT.86400)
                0572       NSEC = NSEC - 86400
                0573       NYMD = INCYMD (NYMD,1)
                0574       ENDDO
0889f02121 Jean*0575       ENDIF
                0576
d1fef4a45f Andr*0577       IF (NSEC.EQ.86400)  THEN
                0578       NSEC = 0
                0579       NYMD = INCYMD (NYMD,1)
0889f02121 Jean*0580       ENDIF
                0581
d1fef4a45f Andr*0582       IF (NSEC.LT.00000)  THEN
                0583       DO WHILE (NSEC.LT.0)
                0584       NSEC = 86400 + NSEC
                0585       NYMD = INCYMD (NYMD,-1)
                0586       ENDDO
0889f02121 Jean*0587       ENDIF
                0588
d1fef4a45f Andr*0589       NHMS = NHMSF (NSEC)
0889f02121 Jean*0590       ENDIF
d1fef4a45f Andr*0591
813eb1e07a Jean*0592 C Pass Back Current Updated Time
                0593 C ------------------------------
d1fef4a45f Andr*0594       mymd = nymd
                0595       mhms = nhms
                0596
0889f02121 Jean*0597       RETURN
                0598       END
                0599
                0600       FUNCTION NALARM (MHMS,NYMD,NHMS,NYMD0,NHMS0)
                0601 C***********************************************************************
                0602 C  PURPOSE
                0603 C     COMPUTES MODULO-FRACTION BETWEEN MHHS AND TOTAL TIME
                0604 C  USAGE
                0605 C  ARGUMENTS   DESCRIPTION
                0606 C     MHMS     INTERVAL FREQUENCY (HHMMSS)
                0607 C     NYMD     CURRENT   YYMMDD
                0608 C     NHMS     CURRENT   HHMMSS
                0609 C     NYMD0    BEGINNING YYMMDD
                0610 C     NHMS0    BEGINNING HHMMSS
                0611 C
                0612 C***********************************************************************
ed0b0d8f16 Andr*0613       implicit none
                0614
                0615       integer nalarm,MHMS,NYMD,NHMS,NYMD0,NHMS0
                0616
                0617       integer nsday, ncycle
                0618       PARAMETER ( NSDAY  = 86400 )
                0619       PARAMETER ( NCYCLE = 1461*24*3600 )
                0620
                0621       INTEGER YEAR, MONTH, DAY, SEC, YEAR0, MONTH0, DAY0, SEC0
                0622
0889f02121 Jean*0623       integer MNDY(12*4)
ed0b0d8f16 Andr*0624       DATA MNDY /0,31,60,91,121,152,182,213,244,274,305,335,366,
53135ac441 Jean*0625      &           397,34*0 /
ed0b0d8f16 Andr*0626
                0627       integer i,nsecf,iday,iday0,nsec,nsec0,ntime
                0628
0889f02121 Jean*0629 C***********************************************************************
                0630 C*                 COMPUTE # OF DAYS IN A 4-YEAR CYCLE                 *
                0631 C***********************************************************************
ed0b0d8f16 Andr*0632
                0633       DO I=15,48
0889f02121 Jean*0634         MNDY(I) = MNDY(I-12) + 365
ed0b0d8f16 Andr*0635       ENDDO
                0636
0889f02121 Jean*0637 C***********************************************************************
                0638 C*                   SET CURRENT AND BEGINNING TIMES                   *
                0639 C***********************************************************************
ed0b0d8f16 Andr*0640
                0641       YEAR   = NYMD / 10000
                0642       MONTH  = MOD(NYMD,10000) / 100
                0643       DAY    = MOD(NYMD,100)
                0644       SEC    = NSECF(NHMS)
                0645
                0646       YEAR0  = NYMD0 / 10000
                0647       MONTH0 = MOD(NYMD0,10000) / 100
                0648       DAY0   = MOD(NYMD0,100)
                0649       SEC0   = NSECF(NHMS0)
                0650
0889f02121 Jean*0651 C***********************************************************************
                0652 C*      COMPUTE POSITIONS IN CYCLE FOR CURRENT AND BEGINNING TIMES     *
                0653 C***********************************************************************
                0654
                0655       IDAY   = (DAY -1) + MNDY( MONTH +12*MOD(YEAR ,4) )
                0656       IDAY0  = (DAY0-1) + MNDY( MONTH0+12*MOD(YEAR0,4) )
                0657
                0658       NSEC   = IDAY *NSDAY + SEC
                0659       NSEC0  = IDAY0*NSDAY + SEC0
                0660
                0661                        NTIME  = NSEC-NSEC0
                0662       IF (NTIME.LT.0 ) NTIME  = NTIME + NCYCLE
                0663                        NALARM = NTIME
                0664       IF ( MHMS.NE.0 ) NALARM = MOD( NALARM,NSECF(MHMS) )
                0665
                0666       RETURN
                0667       END
                0668
                0669       FUNCTION NALARM2(MHMS,NYMD,NHMS,NYMD0,NHMS0)
                0670 C***********************************************************************
                0671 C  PURPOSE
                0672 C     COMPUTES MODULO-FRACTION BETWEEN MHHS AND TOTAL TIME
                0673 C  USAGE
                0674 C  ARGUMENTS   DESCRIPTION
                0675 C     MHMS     INTERVAL FREQUENCY (MMDDHHMMSS)
                0676 C     NYMD     CURRENT   YYMMDD
                0677 C     NHMS     CURRENT   HHMMSS
                0678 C     NYMD0    BEGINNING YYMMDD
                0679 C     NHMS0    BEGINNING HHMMSS
                0680 C
                0681 C***********************************************************************
333e96bf9c Andr*0682       implicit none
                0683
                0684       integer nalarm2,MHMS,NYMD,NHMS,NYMD0,NHMS0
                0685
                0686       integer nsday, ncycle
                0687       PARAMETER ( NSDAY  = 86400 )
                0688       PARAMETER ( NCYCLE = 1461*24*3600 )
                0689
                0690       INTEGER YEAR, MONTH, DAY, SEC, YEAR0, MONTH0, DAY0, SEC0
                0691
0889f02121 Jean*0692       integer MNDY(12*4)
333e96bf9c Andr*0693       DATA MNDY /0,31,60,91,121,152,182,213,244,274,305,335,366,
53135ac441 Jean*0694      &           397,34*0 /
ff2bdf39c9 Andr*0695       INTEGER NDPM(12)
                0696       DATA NDPM /31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
333e96bf9c Andr*0697
813eb1e07a Jean*0698       integer i,nsecf,iday,iday0,nsec,nsec0,ntime
333e96bf9c Andr*0699       integer NHMMSS,NMMDD
ff2bdf39c9 Andr*0700       integer iloop
                0701       integer testnymd,testnhms,testndpm
333e96bf9c Andr*0702
0889f02121 Jean*0703 C***********************************************************************
                0704 C*                 COMPUTE # OF DAYS IN A 4-YEAR CYCLE                 *
                0705 C***********************************************************************
333e96bf9c Andr*0706
                0707       DO I=15,48
0889f02121 Jean*0708         MNDY(I) = MNDY(I-12) + 365
333e96bf9c Andr*0709       ENDDO
                0710
0889f02121 Jean*0711 C***********************************************************************
                0712 C*                   SET CURRENT AND BEGINNING TIMES                   *
                0713 C***********************************************************************
333e96bf9c Andr*0714
                0715       YEAR   = NYMD / 10000
                0716       MONTH  = MOD(NYMD,10000) / 100
                0717       DAY    = MOD(NYMD,100)
                0718       SEC    = NSECF(NHMS)
                0719
                0720       YEAR0  = NYMD0 / 10000
                0721       MONTH0 = MOD(NYMD0,10000) / 100
                0722       DAY0   = MOD(NYMD0,100)
                0723       SEC0   = NSECF(NHMS0)
                0724
0889f02121 Jean*0725 C***********************************************************************
                0726 C*      COMPUTE POSITIONS IN CYCLE FOR CURRENT AND BEGINNING TIMES     *
                0727 C***********************************************************************
                0728
                0729       IDAY   = (DAY -1) + MNDY( MONTH +12*MOD(YEAR ,4) )
                0730       IDAY0  = (DAY0-1) + MNDY( MONTH0+12*MOD(YEAR0,4) )
                0731
                0732       NSEC   = IDAY *NSDAY + SEC
                0733       NSEC0  = IDAY0*NSDAY + SEC0
                0734
                0735       NTIME  = NSEC-NSEC0
ff2bdf39c9 Andr*0736       IF(NTIME.LT.0) NTIME  = NTIME + NCYCLE
0889f02121 Jean*0737       NALARM2 = NTIME
c607322566 Andr*0738       IF(MHMS.NE.0)NALARM2 = MOD( NALARM2,NSECF(MHMS) )
                0739       IF(MHMS.GE.1000000) THEN
ff2bdf39c9 Andr*0740        testnymd=nymd0
                0741        testnhms=nhms0
333e96bf9c Andr*0742        NMMDD = MHMS / 1000000
                0743        NHMMSS = MOD(MHMS,1000000)
ff2bdf39c9 Andr*0744        do iloop=1,100000
                0745         testnymd=testnymd + nmmdd
                0746         testnhms=testnhms + nhmmss
                0747         year0=testnymd/10000
                0748         month0=mod(testnymd,10000)/100
                0749         day0 = mod(testnymd,100)
                0750         testndpm = ndpm(month0)
                0751         if( month0.eq.2  .and. mod(year0,4).eq.0) testndpm = 29
                0752         if(testnhms.ge.240000) then
                0753          testnhms = testnhms-240000
                0754          testnymd = testnymd + 1
                0755          day0 = day0 + 1
                0756         endif
                0757         if(day0.gt.testndpm) then
                0758          testnymd = testnymd - testndpm
                0759          testnymd = testnymd + 100
                0760          day0 = day0 - testndpm
                0761          month0 = month0 + 1
                0762         endif
                0763         if(month0.gt.12) then
                0764          month0 = month0 - 12
                0765          year0 = year0 + 1
a7b78cc42e Andr*0766          testnymd = testnymd + 10000 - 1200
ff2bdf39c9 Andr*0767         endif
                0768         sec0 = nsecf(testnhms)
0889f02121 Jean*0769         iday0 = (day0-1) + MNDY(month0+12*mod(year0,4) )
ff2bdf39c9 Andr*0770         nsec0 = iday0 *nsday + sec0
0889f02121 Jean*0771         if( (testnymd.gt.nymd) .or.
53135ac441 Jean*0772      &         (testnymd.eq.testnymd) .and. (testnhms.gt.nhms) )
                0773      &                    go to 200
ff2bdf39c9 Andr*0774         nalarm2 = nsec-nsec0
                0775        enddo
                0776  200   continue
333e96bf9c Andr*0777       ENDIF
0889f02121 Jean*0778
                0779       RETURN
                0780       END
                0781
                0782       FUNCTION INCYMD (NYMD,M)
                0783 C***********************************************************************
                0784 C  PURPOSE
                0785 C     INCYMD:  NYMD CHANGED BY ONE DAY
                0786 C     MODYMD:  NYMD CONVERTED TO JULIAN DATE
b292841e25 Andr*0787 C  DESCRIPTION OF INPUT VARIABLES
0889f02121 Jean*0788 C     NYMD     CURRENT DATE IN YYMMDD FORMAT
                0789 C     M        +/- 1 (DAY ADJUSTMENT)
                0790 C
                0791 C***********************************************************************
ed0b0d8f16 Andr*0792       implicit none
                0793       integer incymd,nymd,m
0889f02121 Jean*0794
ed0b0d8f16 Andr*0795       integer ny,nm,nd,ny00,modymd
                0796
                0797       INTEGER NDPM(12)
                0798       DATA NDPM /31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31/
                0799       LOGICAL LEAP
                0800       DATA NY00 /1900 /
                0801       LEAP(NY) = MOD(NY,4).EQ.0 .AND. (NY.NE.0 .OR. MOD(NY00,400).EQ.0)
0889f02121 Jean*0802
                0803 C***********************************************************************
                0804 C
ed0b0d8f16 Andr*0805       NY = NYMD / 10000
                0806       NM = MOD(NYMD,10000) / 100
                0807       ND = MOD(NYMD,100) + M
0889f02121 Jean*0808
ed0b0d8f16 Andr*0809       IF (ND.EQ.0) THEN
                0810       NM = NM - 1
                0811       IF (NM.EQ.0) THEN
                0812           NM = 12
                0813           NY = NY - 1
                0814       ENDIF
                0815       ND = NDPM(NM)
                0816       IF (NM.EQ.2 .AND. LEAP(NY))  ND = 29
                0817       ENDIF
0889f02121 Jean*0818
ed0b0d8f16 Andr*0819       IF (ND.EQ.29 .AND. NM.EQ.2 .AND. LEAP(NY))  GO TO 20
                0820
                0821       IF (ND.GT.NDPM(NM)) THEN
                0822       ND = 1
                0823       NM = NM + 1
                0824       IF (NM.GT.12) THEN
                0825           NM = 1
                0826           NY = NY + 1
                0827       ENDIF
                0828       ENDIF
0889f02121 Jean*0829
ed0b0d8f16 Andr*0830    20 CONTINUE
                0831       INCYMD = NY*10000 + NM*100 + ND
                0832
                0833       RETURN
0889f02121 Jean*0834
                0835 C***********************************************************************
                0836 C                      E N T R Y    M O D Y M D
                0837 C***********************************************************************
                0838
ed0b0d8f16 Andr*0839       ENTRY MODYMD (NYMD)
d1fef4a45f Andr*0840
ed0b0d8f16 Andr*0841       NY = NYMD / 10000
                0842       NM = MOD(NYMD,10000) / 100
                0843       ND = MOD(NYMD,100)
0889f02121 Jean*0844
ed0b0d8f16 Andr*0845    40 CONTINUE
                0846       IF (NM.LE.1)  GO TO 60
                0847       NM = NM - 1
                0848       ND = ND + NDPM(NM)
                0849       IF (NM.EQ.2 .AND. LEAP(NY))  ND = ND + 1
                0850       GO TO 40
0889f02121 Jean*0851
ed0b0d8f16 Andr*0852    60 CONTINUE
                0853       MODYMD = ND
d1fef4a45f Andr*0854
ed0b0d8f16 Andr*0855       RETURN
                0856       END
9bc7f6e71e Andr*0857
                0858       SUBROUTINE ASTRO ( NYMD,NHMS,ALAT,ALON,IRUN,COSZ,RA )
                0859 C***********************************************************************
                0860 C
                0861 C  INPUT:
                0862 C  ======
                0863 C    NYMD      : CURRENT YYMMDD
                0864 C    NHMS      : CURRENT HHMMSS
                0865 C    ALAT(IRUN):LATITUDES  IN DEGREES.
                0866 C    ALON(IRUN):LONGITUDES IN DEGREES. (0 = GREENWICH, + = EAST).
                0867 C    IRUN      : # OF POINTS TO CALCULATE
                0868 C
                0869 C  OUTPUT:
                0870 C  =======
                0871 C    COSZ(IRUN)  : COSINE OF ZENITH ANGLE.
                0872 C    RA          : EARTH-SUN DISTANCE IN UNITS OF
                0873 C                  THE ORBITS SEMI-MAJOR AXIS.
                0874 C
                0875 C  NOTE:
                0876 C  =====
                0877 C  THE INSOLATION AT THE TOP OF THE ATMOSPHERE IS:
                0878 C
                0879 C  S(I) = (SOLAR CONSTANT)*(1/RA**2)*COSZ(I),
                0880 C
                0881 C  WHERE:
                0882 C  RA AND COSZ(I) ARE THE TWO OUTPUTS OF THIS SUBROUTINE.
                0883 C
                0884 C***********************************************************************
                0885
                0886       implicit none
                0887
813eb1e07a Jean*0888 C Input Variables
                0889 C ---------------
9bc7f6e71e Andr*0890       integer nymd, nhms, irun
b292841e25 Andr*0891       _RL getcon, cosz(irun), alat(irun), alon(irun), ra
9bc7f6e71e Andr*0892
813eb1e07a Jean*0893 C Local Variables
                0894 C ---------------
9bc7f6e71e Andr*0895       integer year, day, sec, month, iday, idayp1
                0896       integer dayscy
ed0b0d8f16 Andr*0897       integer i,nsecf,k,km,kp
9bc7f6e71e Andr*0898
a20b61c7ed Andr*0899       _RL hc
                0900       _RL pi, zero, one, two, six, dg2rd, yrlen, eqnx, ob, ecc, per
                0901       _RL daylen, fac, thm, thp, thnow, zs, zc, sj, cj
9bc7f6e71e Andr*0902
17e5b05fae Jean*0903       parameter ( zero  = 0.0 )
9bc7f6e71e Andr*0904       parameter ( one   = 1.0 )
                0905       parameter ( two   = 2.0 )
                0906       parameter ( six   = 6.0 )
b292841e25 Andr*0907       parameter ( dayscy   = 365*4 + 1 )
9bc7f6e71e Andr*0908
0889f02121 Jean*0909       _RL      TH(DAYSCY),T0,T1,T2,T3,T4,FUN,Y
                0910       INTEGER  MNDY(12*4)
9bc7f6e71e Andr*0911
                0912       LOGICAL FIRST
                0913       DATA    FIRST/.TRUE./
                0914       SAVE
                0915
                0916       DATA MNDY /0,31,60,91,121,152,182,213,244,274,305,335,366,
53135ac441 Jean*0917      &           397,34*0 /
9bc7f6e71e Andr*0918
b292841e25 Andr*0919       FUN(Y,PI,ECC,YRLEN,PER) = (TWO*PI/((ONE-ECC**2)**1.5))*(ONE/YRLEN)
53135ac441 Jean*0920      &       * (ONE - ECC*COS(Y-PER)) ** 2
9bc7f6e71e Andr*0921
                0922 C***********************************************************************
b292841e25 Andr*0923 C*                         SET SOME CONSTANTS                          *
                0924 C***********************************************************************
                0925       pi = getcon('PI')
                0926       dg2rd = getcon('DEG2RAD')
                0927       yrlen = getcon('YRLEN')
                0928       ob =  getcon('OBLDEG') * dg2rd
                0929       daylen = getcon('SDAY')
                0930       eqnx = getcon('VERNAL EQUINOX')
                0931       ecc = getcon('ECCENTRICITY')
                0932       per = getcon('PERIHELION') * dg2rd
                0933
                0934 C***********************************************************************
9bc7f6e71e Andr*0935 C*                          SET CURRENT TIME                           *
                0936 C***********************************************************************
                0937
                0938       YEAR  = NYMD / 10000
                0939       MONTH = MOD(NYMD,10000) / 100
                0940       DAY   = MOD(NYMD,100)
                0941       SEC   = NSECF(NHMS)
                0942
                0943 C***********************************************************************
                0944 C*                 COMPUTE DAY-ANGLES FOR 4-YEAR CYCLE                 *
                0945 C***********************************************************************
                0946
                0947       IF(FIRST) THEN
                0948            DO 100 I=15,48
0889f02121 Jean*0949              MNDY(I) = MNDY(I-12) + 365
9bc7f6e71e Andr*0950 100        CONTINUE
                0951
                0952            KM  = INT(EQNX) + 1
                0953            FAC = KM-EQNX
                0954            T0 = ZERO
b292841e25 Andr*0955            T1 = FUN(T0,PI,ECC,YRLEN,PER         )*FAC
                0956            T2 = FUN(ZERO+T1/TWO,PI,ECC,YRLEN,PER)*FAC
                0957            T3 = FUN(ZERO+T2/TWO,PI,ECC,YRLEN,PER)*FAC
                0958            T4 = FUN(ZERO+T3,PI,ECC,YRLEN,PER    )*FAC
9bc7f6e71e Andr*0959            TH(KM) = (T1 + TWO*(T2 + T3) + T4) / SIX
                0960
                0961            DO 200 K=2,DAYSCY
b292841e25 Andr*0962            T1 = FUN(TH(KM),PI,ECC,YRLEN,PER       )
                0963            T2 = FUN(TH(KM)+T1/TWO,PI,ECC,YRLEN,PER)
                0964            T3 = FUN(TH(KM)+T2/TWO,PI,ECC,YRLEN,PER)
                0965            T4 = FUN(TH(KM)+T3,PI,ECC,YRLEN,PER    )
9bc7f6e71e Andr*0966            KP = MOD(KM,DAYSCY) + 1
                0967            TH(KP) = TH(KM) + (T1 + TWO*(T2 + T3) + T4) / SIX
                0968            KM = KP
                0969  200       CONTINUE
                0970
                0971            FIRST=.FALSE.
                0972       ENDIF
                0973
                0974 C***********************************************************************
                0975 C*            COMPUTE EARTH-SUN DISTANCE TO CURRENT SECOND             *
                0976 C***********************************************************************
                0977
0889f02121 Jean*0978       IDAY   = DAY + MNDY(MONTH+12*MOD(YEAR,4) )
9bc7f6e71e Andr*0979       IDAYP1 = MOD( IDAY,DAYSCY) + 1
                0980       THM    = MOD( TH(IDAY)  ,TWO*PI)
                0981       THP    = MOD( TH(IDAYP1),TWO*PI)
                0982
                0983       IF(THP.LT.THM) THP = THP + TWO*PI
                0984       FAC   = FLOAT(SEC)/DAYLEN
                0985       THNOW = THM*(ONE-FAC) + THP*FAC
                0986
                0987       ZS = SIN(THNOW) * SIN(OB)
                0988       ZC = SQRT(ONE-ZS*ZS)
                0989       RA = (1.-ECC*ECC) / ( ONE-ECC*COS(THNOW-PER) )
                0990
                0991 C***********************************************************************
                0992 C*                 COMPUTE COSINE OF THE ZENITH ANGLE                  *
                0993 C***********************************************************************
                0994
                0995       FAC  = FAC*TWO*PI + PI
                0996       DO I = 1,IRUN
                0997
                0998       HC = COS( FAC+ALON(I)*DG2RD )
                0999       SJ = SIN(ALAT(I)*DG2RD)
                1000       CJ = SQRT(ONE-SJ*SJ)
                1001
                1002           COSZ(I) = SJ*ZS + CJ*ZC*HC
                1003       IF( COSZ(I).LT.ZERO ) COSZ(I) = ZERO
                1004       ENDDO
                1005
                1006       RETURN
                1007       END
63416ca6a5 Andr*1008
                1009       subroutine time_bound(nymd,nhms,nymd1,nhms1,nymd2,nhms2,imnm,imnp)
                1010 C***********************************************************************
                1011 C  PURPOSE
                1012 C     Compute Date and Time boundaries.
                1013 C
                1014 C  ARGUMENTS   DESCRIPTION
                1015 C     nymd .... Current    Date
                1016 C     nhms .... Current    Time
                1017 C     nymd1 ... Previous   Date Boundary
                1018 C     nhms1 ... Previous   Time Boundary
                1019 C     nymd2 ... Subsequent Date Boundary
                1020 C     nhms2 ... Subsequent Time Boundary
                1021 C
                1022 C     imnm .... Previous   Time Index for Interpolation
                1023 C     imnp .... Subsequent Time Index for Interpolation
                1024 C
                1025 C***********************************************************************
                1026
                1027       implicit none
                1028       integer  nymd,nhms, nymd1,nhms1, nymd2,nhms2
                1029
813eb1e07a Jean*1030 C Local Variables
                1031 C ---------------
63416ca6a5 Andr*1032       integer  month,day,nyear,midmon1,midmon,midmon2
                1033       integer  imnm,imnp
                1034       INTEGER  DAYS(14), daysm, days0, daysp
                1035       DATA     DAYS /31,31,28,31,30,31,30,31,31,30,31,30,31,31/
                1036
                1037       integer nmonf,ndayf,n
                1038       NMONF(N) = MOD(N,10000)/100
                1039       NDAYF(N) = MOD(N,100)
                1040
                1041 C*********************************************************************
                1042 C**** Find Proper Month and Time Boundaries for Climatological Data **
                1043 C*********************************************************************
                1044
                1045       MONTH  = NMONF(NYMD)
                1046       DAY    = NDAYF(NYMD)
                1047
                1048       daysm  = days(month  )
                1049       days0  = days(month+1)
                1050       daysp  = days(month+2)
                1051
813eb1e07a Jean*1052 C Check for Leap Year
                1053 C -------------------
63416ca6a5 Andr*1054       nyear = nymd/10000
                1055       if( 4*(nyear/4).eq.nyear ) then
                1056       if( month.eq.3 ) daysm = daysm+1
                1057       if( month.eq.2 ) days0 = days0+1
                1058       if( month.eq.1 ) daysp = daysp+1
                1059       endif
                1060
                1061       MIDMON1 = daysm/2 + 1
                1062       MIDMON  = days0/2 + 1
                1063       MIDMON2 = daysp/2 + 1
                1064
                1065
                1066       IF(DAY.LT.MIDMON) THEN
                1067          imnm = month
                1068          imnp = month + 1
                1069          nymd2 = (nymd/10000)*10000 + month*100 + midmon
                1070          nhms2 = 000000
                1071          nymd1 = nymd2
                1072          nhms1 = nhms2
                1073          call tick ( nymd1,nhms1,       -midmon  *86400 )
                1074          call tick ( nymd1,nhms1,-(daysm-midmon1)*86400 )
                1075       ELSE
                1076          IMNM = MONTH + 1
                1077          IMNP = MONTH + 2
                1078          nymd1 = (nymd/10000)*10000 + month*100 + midmon
                1079          nhms1 = 000000
                1080          nymd2 = nymd1
                1081          nhms2 = nhms1
                1082          call tick ( nymd2,nhms2,(days0-midmon)*86400 )
                1083          call tick ( nymd2,nhms2,       midmon2*86400 )
                1084       ENDIF
                1085
813eb1e07a Jean*1086 C -------------------------------------------------------------
                1087 C Note:  At this point, imnm & imnp range between 01-14, where
                1088 C        01    -> Previous years December
                1089 C        02-13 -> Current  years January-December
                1090 C        14    -> Next     years January
                1091 C -------------------------------------------------------------
63416ca6a5 Andr*1092
                1093       imnm = imnm-1
                1094       imnp = imnp-1
                1095
                1096       if( imnm.eq.0  ) imnm = 12
                1097       if( imnp.eq.0  ) imnp = 12
                1098       if( imnm.eq.13 ) imnm = 1
                1099       if( imnp.eq.13 ) imnp = 1
                1100
                1101       return
                1102       end
0889f02121 Jean*1103       subroutine time2freq2(MMDD,NYMD,NHMS,timeleft)
                1104 C***********************************************************************
                1105 C  PURPOSE
1c45378270 Andr*1106 C     COMPUTES TIME IN SECONDS UNTIL WE REACH THE NEXT MMDD
6baaecc600 Andr*1107 C       (ASSUME that the target time is 0Z)
0889f02121 Jean*1108 C
                1109 C  ARGUMENTS   DESCRIPTION
                1110 C     MMDD     FREQUENCY (MMDDHHMMSS)
                1111 C     NYMD     CURRENT   YYMMDD
                1112 C     NHMS     CURRENT   HHMMSS
1c45378270 Andr*1113 C     TIMELEFT TIME LEFT (SECONDS)
0889f02121 Jean*1114 C
1c45378270 Andr*1115 C  NOTES - Only used when the frequency is in units of months
0889f02121 Jean*1116 C          Assumes that we always want to be at a month boundary
                1117 C***********************************************************************
1c45378270 Andr*1118       implicit none
                1119
81042e38bf Andr*1120       integer mmdd,nymd,nhms,timeleft,daysleft
1c45378270 Andr*1121
                1122       integer nsday
a4c347b7e5 Andr*1123       PARAMETER ( NSDAY  = 86400 )
0889f02121 Jean*1124       integer year, month, day, sec
813eb1e07a Jean*1125       integer yearnext, monthnext, daynext
                1126       integer i,nsecf,iday,idaynext,nsec
1c45378270 Andr*1127       integer testnymd
0889f02121 Jean*1128       integer MNDY(12*4)
1c45378270 Andr*1129       DATA MNDY /0,31,60,91,121,152,182,213,244,274,305,335,366,
53135ac441 Jean*1130      &           397,34*0 /
1c45378270 Andr*1131
0889f02121 Jean*1132 C***********************************************************************
                1133 C*                 COMPUTE # OF DAYS IN A 4-YEAR CYCLE                 *
                1134 C***********************************************************************
1c45378270 Andr*1135       DO I=15,48
0889f02121 Jean*1136         MNDY(I) = MNDY(I-12) + 365
1c45378270 Andr*1137       ENDDO
0889f02121 Jean*1138 C***********************************************************************
                1139 C*                   SET CURRENT TIME ELEMENTS                                 *
                1140 C***********************************************************************
1c45378270 Andr*1141       YEAR   = NYMD / 10000
                1142       MONTH  = MOD(NYMD,10000) / 100
                1143       DAY    = MOD(NYMD,100)
                1144       SEC    = NSECF(NHMS)
0889f02121 Jean*1145 C***********************************************************************
                1146 C*      COMPUTE POSITIONS IN CYCLE FOR CURRENT AND BEGINNING TIMES     *
                1147 C***********************************************************************
                1148       IDAY   = (DAY -1) + MNDY( MONTH +12*MOD(YEAR ,4) )
                1149       NSEC   = IDAY *NSDAY + SEC
                1150
1c45378270 Andr*1151       testnymd=nymd + mmdd
                1152       yearnext=testnymd/10000
                1153       monthnext=mod(testnymd,10000)/100
                1154       daynext = 1
                1155       if(monthnext.gt.12) then
                1156        monthnext = monthnext - 12
                1157        yearnext = yearnext + 1
                1158       endif
                1159       testnymd = yearnext*10000 + monthnext*100 + daynext
0889f02121 Jean*1160       idaynext = MNDY(monthnext+12*mod(yearnext,4) )
81042e38bf Andr*1161       daysleft = idaynext - iday
                1162       if(daysleft.lt.0) daysleft = daysleft + 1461
1c45378270 Andr*1163
6baaecc600 Andr*1164       timeleft = daysleft * nsday - sec
0889f02121 Jean*1165
                1166       RETURN
                1167       END