pkg/cal/cal_daysformonth.F

C $Header: /u/gcmpack/development/heimbach/ecco_env/pkg/cal/cal_daysformonth.F,v 1.5 2001/02/02 16:57:22 heimbach Exp $

#include "CAL_CPPOPTIONS.h"

      subroutine cal_DaysForMonth( 
     I                             imonth,
     O                             firstday,
     O                             lastday,
     O                             ndays,
     I                             mythid
     &                           )

c     ==================================================================
c     SUBROUTINE cal_DaysForMonth
c     ==================================================================
c
c     o Given the current month of the integration this routine returns
c       first, the last and the number of calendar days that will have
c       to be performed.
c
c       This routine also checks consistency of variables quite
c       extensively.
c
c     started: Christian Eckert eckert@mit.edu  06-Apr-2000
c
c     changed: 
c
c     ==================================================================
c     SUBROUTINE cal_DaysForMonth
c     ==================================================================

      implicit none

c     == global variables ==

#include "cal.h"

c     == routine arguments ==

      integer imonth
      integer firstday
      integer lastday
      integer ndays
      integer mythid

c     == local variables ==

      integer i
      integer ierr
      integer nummonths
      integer numdays
      integer firstyear
      integer firstmonth
      integer firstd
      integer lyfirst
      integer lastyear
      integer lastmonth
      integer lastd
      integer lastsecs
      integer lylast
      integer currentyear
      integer currentmonth
      integer lycurrent

c     == external ==

      integer  cal_IntMonths
      external cal_IntMonths
      integer  cal_IsLeap
      external cal_IsLeap

c     == end of interface ==

      lyfirst     = cal_IsLeap( firstyear, mythid )
      lylast      = cal_IsLeap( lastyear, mythid )

      nummonths   = cal_Intmonths( mythid )

      firstyear   = modelstartdate(1)/10000
      firstmonth  = mod(modelstartdate(1)/100,100)
      firstd      = mod(modelstartdate(1),100)
      lastyear    = modelenddate(1)/10000
      lastmonth   = mod(modelenddate(1)/100,100)
      lastd       = mod(modelenddate(1),100)
      lastsecs    = modelenddate(2)/10000*secondsperhour +
     &              mod(modelenddate(2)/100,100)*secondsperminute +
     &              mod(modelenddate(2),100)

      if ( nummonths .eq. 1 ) then
        if ( imonth .eq. 1 ) then
c--       Get the number of days in the first month.
          if ( firstmonth .eq. lastmonth ) then
            if (lastsecs .eq. 0) then
c--           Not really another day.
              lastday  = lastd - 1
            else
              lastday  = lastd
            endif
            firstday = 1
          else if ( mod(firstmonth+1,nmonthyear) .eq. lastmonth ) then
c--         This can only happen if we end at midnight of the first
c--         day of the next month.
            if ( ( modelenddate(2) .eq. 0 ) .and.
     &           ( mod(modelenddate(1),100) .eq. 1 ) ) then
              firstday = firstd
              lastday  = ndaymonth(firstmonth,lyfirst)
            else
c--           We do not end at midnight of the first day of
c--           the next month.
              ierr = 2704
              call cal_PrintError( ierr, mythid )
              stop ' stopped in cal_DaysForMonth.'
            endif
          else
c--         The first and the last month are inconsistent with imonth.
            ierr = 2703
            call cal_PrintError( ierr, mythid )
            stop ' stopped in cal_DaysForMonth.'
          endif
        else
c--       The variables nummonths and imonth are inconsistent;
c--       ( imonth .gt. nummonths ).
          ierr = 2702
          call cal_PrintError( ierr, mythid )
          stop ' stopped in cal_DaysForMonth.'
        endif

      else if ( nummonths .gt. 1 ) then
c--     More than one month of integration.
        if ( imonth .eq. 1 ) then
          firstday = 1
          lastday  = ndaymonth(firstmonth,lyfirst) - firstd + 1
        else if ( ( imonth .gt.     1     )        .and.
     &            ( imonth .lt. nummonths )       ) then
c--       Somewhere between first and last month.
          currentmonth = firstmonth
          currentyear  = firstyear
          numdays      = ndaymonth(firstmonth,lyfirst) - firstd + 1
          do i = 2,imonth-1
c--         Accumulate days of the intermediate months.
            currentmonth = mod(currentmonth+1,nmonthyear)
            if ( currentmonth .eq. 1 ) then
              currentyear = currentyear + 1
            endif
            lycurrent = cal_IsLeap( currentyear, mythid )
            numdays   = numdays + ndaymonth(currentmonth,lycurrent)
          enddo
          currentmonth = mod(currentmonth+1,nmonthyear)
          if ( currentmonth .eq. 1 ) then
            currentyear = currentyear + 1
          endif
          lycurrent = cal_IsLeap( currentyear, mythid )
          firstday  = numdays + 1
          lastday   = numdays + ndaymonth(currentmonth,lycurrent)
        else if ( imonth .eq. nummonths ) then
c--       The last month of the integration.
          currentmonth = firstmonth
          currentyear  = firstyear
          numdays      = ndaymonth(firstmonth,lyfirst) - firstd + 1
          do i = 2,nummonths-1
c--         Accumulate days of the intermediate months.
            currentmonth = mod(currentmonth+1,nmonthyear)
            if ( currentmonth .eq. 1 ) then
              currentyear = currentyear + 1
            endif
            lycurrent = cal_IsLeap( currentyear, mythid )
            numdays   = numdays + ndaymonth(currentmonth,lycurrent)
          enddo
c--       Prepare for the last month of integration.
          currentmonth = mod(currentmonth+1,nmonthyear)
          if ( currentmonth .eq. 1 ) then
            currentyear = currentyear + 1
          endif
          lycurrent = cal_IsLeap( currentyear, mythid )
          if ( ( modelenddate(2) .eq. 0 ) .and.
     &         ( mod(modelenddate(1),100) .eq. 1 ) ) then
c--         This can only happen if we end at midnight of the first
c--         day of the next month.
            lastday  = numdays + ndaymonth(currentmonth,lycurrent)
          else
c--         We do not stop at midnight of the first day of the
c--         next month.
            if (lastsecs .eq. 0) then
c--           But we might stop at midnight of a day.
              lastday = numdays + lastd - 1
            else
              lastday = numdays + lastd
            endif
          endif
          firstday = numdays + 1
        else
c--       The variables imonth and nummonths are inconsistent.
          ierr = 2705
          call cal_PrintError( ierr, mythid )
          stop ' stopped in cal_DaysForMonth.'
        endif
      else
c--     The number of months to integrate is wrong; check cal_IntMonths.
        ierr = 2701
        call cal_PrintError( ierr, mythid )
        stop ' stopped in cal_DaysForMonth.'
      endif

c--   The number of days to integrate in the given month.
      ndays = lastday - firstday + 1

      return
      end

1	C $Header: /u/gcmpack/development/heimbach/ecco_env/pkg/cal/cal_daysformonth.F,v 1.5 2001/02/02 16:57:22 heimbach Exp $
2
3	#include "CAL_CPPOPTIONS.h"
4
5	subroutine cal_DaysForMonth(
6	I imonth,
7	O firstday,
8	O lastday,
9	O ndays,
10	I mythid
11	& )
12
13	c ==================================================================
14	c SUBROUTINE cal_DaysForMonth
15	c ==================================================================
16	c
17	c o Given the current month of the integration this routine returns
18	c first, the last and the number of calendar days that will have
19	c to be performed.
20	c
21	c This routine also checks consistency of variables quite
22	c extensively.
23	c
24	c started: Christian Eckert eckert@mit.edu 06-Apr-2000
25	c
26	c changed:
27	c
28	c ==================================================================
29	c SUBROUTINE cal_DaysForMonth
30	c ==================================================================
31
32	implicit none
33
34	c == global variables ==
35
36	#include "cal.h"
37
38	c == routine arguments ==
39
40	integer imonth
41	integer firstday
42	integer lastday
43	integer ndays
44	integer mythid
45
46	c == local variables ==
47
48	integer i
49	integer ierr
50	integer nummonths
51	integer numdays
52	integer firstyear
53	integer firstmonth
54	integer firstd
55	integer lyfirst
56	integer lastyear
57	integer lastmonth
58	integer lastd
59	integer lastsecs
60	integer lylast
61	integer currentyear
62	integer currentmonth
63	integer lycurrent
64
65	c == external ==
66
67	integer cal_IntMonths
68	external cal_IntMonths
69	integer cal_IsLeap
70	external cal_IsLeap
71
72	c == end of interface ==
73
74	lyfirst = cal_IsLeap( firstyear, mythid )
75	lylast = cal_IsLeap( lastyear, mythid )
76
77	nummonths = cal_Intmonths( mythid )
78
79	firstyear = modelstartdate(1)/10000
80	firstmonth = mod(modelstartdate(1)/100,100)
81	firstd = mod(modelstartdate(1),100)
82	lastyear = modelenddate(1)/10000
83	lastmonth = mod(modelenddate(1)/100,100)
84	lastd = mod(modelenddate(1),100)
85	lastsecs = modelenddate(2)/10000*secondsperhour +
86	& mod(modelenddate(2)/100,100)*secondsperminute +
87	& mod(modelenddate(2),100)
88
89	if ( nummonths .eq. 1 ) then
90	if ( imonth .eq. 1 ) then
91	c-- Get the number of days in the first month.
92	if ( firstmonth .eq. lastmonth ) then
93	if (lastsecs .eq. 0) then
94	c-- Not really another day.
95	lastday = lastd - 1
96	else
97	lastday = lastd
98	endif
99	firstday = 1
100	else if ( mod(firstmonth+1,nmonthyear) .eq. lastmonth ) then
101	c-- This can only happen if we end at midnight of the first
102	c-- day of the next month.
103	if ( ( modelenddate(2) .eq. 0 ) .and.
104	& ( mod(modelenddate(1),100) .eq. 1 ) ) then
105	firstday = firstd
106	lastday = ndaymonth(firstmonth,lyfirst)
107	else
108	c-- We do not end at midnight of the first day of
109	c-- the next month.
110	ierr = 2704
111	call cal_PrintError( ierr, mythid )
112	stop ' stopped in cal_DaysForMonth.'
113	endif
114	else
115	c-- The first and the last month are inconsistent with imonth.
116	ierr = 2703
117	call cal_PrintError( ierr, mythid )
118	stop ' stopped in cal_DaysForMonth.'
119	endif
120	else
121	c-- The variables nummonths and imonth are inconsistent;
122	c-- ( imonth .gt. nummonths ).
123	ierr = 2702
124	call cal_PrintError( ierr, mythid )
125	stop ' stopped in cal_DaysForMonth.'
126	endif
127
128	else if ( nummonths .gt. 1 ) then
129	c-- More than one month of integration.
130	if ( imonth .eq. 1 ) then
131	firstday = 1
132	lastday = ndaymonth(firstmonth,lyfirst) - firstd + 1
133	else if ( ( imonth .gt. 1 ) .and.
134	& ( imonth .lt. nummonths ) ) then
135	c-- Somewhere between first and last month.
136	currentmonth = firstmonth
137	currentyear = firstyear
138	numdays = ndaymonth(firstmonth,lyfirst) - firstd + 1
139	do i = 2,imonth-1
140	c-- Accumulate days of the intermediate months.
141	currentmonth = mod(currentmonth+1,nmonthyear)
142	if ( currentmonth .eq. 1 ) then
143	currentyear = currentyear + 1
144	endif
145	lycurrent = cal_IsLeap( currentyear, mythid )
146	numdays = numdays + ndaymonth(currentmonth,lycurrent)
147	enddo
148	currentmonth = mod(currentmonth+1,nmonthyear)
149	if ( currentmonth .eq. 1 ) then
150	currentyear = currentyear + 1
151	endif
152	lycurrent = cal_IsLeap( currentyear, mythid )
153	firstday = numdays + 1
154	lastday = numdays + ndaymonth(currentmonth,lycurrent)
155	else if ( imonth .eq. nummonths ) then
156	c-- The last month of the integration.
157	currentmonth = firstmonth
158	currentyear = firstyear
159	numdays = ndaymonth(firstmonth,lyfirst) - firstd + 1
160	do i = 2,nummonths-1
161	c-- Accumulate days of the intermediate months.
162	currentmonth = mod(currentmonth+1,nmonthyear)
163	if ( currentmonth .eq. 1 ) then
164	currentyear = currentyear + 1
165	endif
166	lycurrent = cal_IsLeap( currentyear, mythid )
167	numdays = numdays + ndaymonth(currentmonth,lycurrent)
168	enddo
169	c-- Prepare for the last month of integration.
170	currentmonth = mod(currentmonth+1,nmonthyear)
171	if ( currentmonth .eq. 1 ) then
172	currentyear = currentyear + 1
173	endif
174	lycurrent = cal_IsLeap( currentyear, mythid )
175	if ( ( modelenddate(2) .eq. 0 ) .and.
176	& ( mod(modelenddate(1),100) .eq. 1 ) ) then
177	c-- This can only happen if we end at midnight of the first
178	c-- day of the next month.
179	lastday = numdays + ndaymonth(currentmonth,lycurrent)
180	else
181	c-- We do not stop at midnight of the first day of the
182	c-- next month.
183	if (lastsecs .eq. 0) then
184	c-- But we might stop at midnight of a day.
185	lastday = numdays + lastd - 1
186	else
187	lastday = numdays + lastd
188	endif
189	endif
190	firstday = numdays + 1
191	else
192	c-- The variables imonth and nummonths are inconsistent.
193	ierr = 2705
194	call cal_PrintError( ierr, mythid )
195	stop ' stopped in cal_DaysForMonth.'
196	endif
197	else
198	c-- The number of months to integrate is wrong; check cal_IntMonths.
199	ierr = 2701
200	call cal_PrintError( ierr, mythid )
201	stop ' stopped in cal_DaysForMonth.'
202	endif
203
204	c-- The number of days to integrate in the given month.
205	ndays = lastday - firstday + 1
206
207	return
208	end
209