/[MITgcm]/MITgcm/pkg/cal/cal_checkdate.F
ViewVC logotype

Diff of /MITgcm/pkg/cal/cal_checkdate.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by heimbach, Mon May 14 22:07:26 2001 UTC revision 1.3 by dimitri, Tue Sep 23 06:33:44 2003 UTC
# Line 27  c Line 27  c
27  c              - Introduced new routine and function names, cal_<NAME>,  c              - Introduced new routine and function names, cal_<NAME>,
28  c                for verion 0.1.3.  c                for verion 0.1.3.
29  c  c
30    c              21-Sep-2003: fixed check_sign logic to work with
31    c              negative intervals (menemenlis@jpl.nasa.gov)
32    c
33  c     ==================================================================  c     ==================================================================
34  c     SUBROUTINE cal_CheckDate  c     SUBROUTINE cal_CheckDate
35  c     ==================================================================  c     ==================================================================
# Line 52  c     == local variables == Line 55  c     == local variables ==
55        integer hhmmss        integer hhmmss
56        integer yymmdd        integer yymmdd
57        integer fac        integer fac
58        integer check_sign_1        _RL check_sign
       integer check_sign_2  
59    
60  c     == end of interface ==  c     == end of interface ==
61    
# Line 62  c     == end of interface == Line 64  c     == end of interface ==
64        calerr = 0        calerr = 0
65        fac    = 1        fac    = 1
66    
67          check_sign = 1
68          if ( ( (date(1).lt.0) .and. date(2).gt.0 ) .or.
69         &     ( (date(1).gt.0) .and. date(2).lt.0 ) )
70         &     check_sign = -1
71    
72        if (date(4) .le. 0) then        if (date(4) .le. 0) then
73          if (date(4) .ne. -1) then          if (date(4) .ne. -1) then
74            calerr = 1801            calerr = 1801
# Line 69  c     == end of interface == Line 76  c     == end of interface ==
76            if (date(3) .ne. 0) then            if (date(3) .ne. 0) then
77              calerr = 1802              calerr = 1802
78            else            else
79              check_sign_1 = sign(1,date(1))              if (check_sign .lt. 0) then
             check_sign_2 = sign(1,date(2))  
             if (check_sign_1*check_sign_2 .lt. 0) then  
80                calerr = 1803                calerr = 1803
81              else              else
82                call cal_ConvDate(date,yy,mm,dd,nsecs,lp,wd,mythid)                call cal_ConvDate(date,yy,mm,dd,nsecs,lp,wd,mythid)
# Line 95  c     == end of interface == Line 100  c     == end of interface ==
100       &        (date(3) .ne. 2)) then       &        (date(3) .ne. 2)) then
101              calerr = 1806              calerr = 1806
102            else            else
103              check_sign_1 = sign(1,date(1))              if (check_sign .lt. 0) then
             check_sign_2 = sign(1,date(2))  
             if (check_sign_1*check_sign_2 .lt. 0) then  
104                calerr = 1803                calerr = 1803
105              else              else
106                call cal_ConvDate( date,yy,mm,dd,nsecs,lp,wd,mythid )                call cal_ConvDate( date,yy,mm,dd,nsecs,lp,wd,mythid )

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.22