pkg/cal/cal_numints.F

6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002
                0003       integer function cal_NumInts(
                0004      I                              date_a,
                0005      I                              date_b,
                0006      I                              timeint,
                0007      I                              mythid
                0008      &                            )
                0009
                0010 c     ==================================================================
                0011 c     SUBROUTINE cal_NumInts
                0012 c     ==================================================================
                0013 c
                0014 c     o Determine the number of time intervals of size timeint between
                0015 c       date_a and date_b.
                0016 c
                0017 c     Note: date_a and date_b should also be checked.
                0018 c           treat case ((passed(1) .ne. 0) .and. (timeint(1) .ne. 0))
                0019 c
                0020 c     started: Christian Eckert eckert@mit.edu
                0021 c
                0022 c              - Introduced to version 0.1.4
                0023 c
                0024 c     changed:
                0025 c
                0026 c
                0027 c     ==================================================================
                0028 c     SUBROUTINE cal_NumInts
                0029 c     ==================================================================
                0030
                0031       implicit none
                0032
                0033 c     == global variables ==
                0034
                0035 #include "cal.h"
                0036
                0037 c     == routine arguments ==
                0038
                0039       integer date_a(4)
                0040       integer date_b(4)
                0041       integer timeint(4)
                0042       integer mythid
                0043
                0044 c     == local variables ==
                0045
                0046       _RL     timeintsecs
                0047       integer passed(4)
                0048       _RL     passedsecs
                0049       integer ierr
                0050
                0051 c     == end of interface ==
                0052
                0053       if ( timeint(4) .eq. -1 ) then
                0054         call cal_TimePassed( date_a, date_b, passed, mythid )
                0055
                0056         call cal_ToSeconds( passed,  passedsecs,  mythid )
                0057         call cal_ToSeconds( timeint, timeintsecs, mythid )
                0058
                0059         cal_NumInts = abs( passedsecs/timeintsecs )
                0060       else
                0061         ierr = 2501
                0062         call cal_PrintError( ierr, mythid )
                0063         stop ' stopped in cal_NumInts.'
                0064       endif
                0065
                0066       return
                0067       end