File indexing completed on 2018-03-02 18:38:15 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002
0003 subroutine cal_DaysForMonth(
0004 I imonth,
0005 O firstday,
0006 O lastday,
0007 O ndays,
0008 I mythid
0009 & )
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029
0030 implicit none
0031
0032
0033
0034 #include "cal.h"
0035
0036
0037
0038 integer imonth
0039 integer firstday
0040 integer lastday
0041 integer ndays
0042 integer mythid
0043
0044
0045
0046 integer i
0047 integer ierr
0048 integer nummonths
0049 integer numdays
0050 integer firstyear
0051 integer firstmonth
0052 integer firstd
0053 integer lyfirst
0054 integer lastyear
0055 integer lastmonth
0056 integer lastd
0057 integer lastsecs
0058 integer lylast
0059 integer currentyear
0060 integer currentmonth
0061 integer lycurrent
0062
0063
0064
0065 integer cal_IntMonths
0066 external cal_IntMonths
0067 integer cal_IsLeap
0068 external cal_IsLeap
0069
0070
0071
0072 lyfirst = cal_IsLeap( firstyear, mythid )
0073 lylast = cal_IsLeap( lastyear, mythid )
0074
0075 nummonths = cal_Intmonths( mythid )
0076
0077 firstyear = modelstartdate(1)/10000
0078 firstmonth = mod(modelstartdate(1)/100,100)
0079 firstd = mod(modelstartdate(1),100)
0080 lastyear = modelenddate(1)/10000
0081 lastmonth = mod(modelenddate(1)/100,100)
0082 lastd = mod(modelenddate(1),100)
0083 lastsecs = modelenddate(2)/10000*secondsperhour +
0084 & mod(modelenddate(2)/100,100)*secondsperminute +
0085 & mod(modelenddate(2),100)
0086
0087 if ( nummonths .eq. 1 ) then
0088 if ( imonth .eq. 1 ) then
0089
0090 if ( firstmonth .eq. lastmonth ) then
0091 if (lastsecs .eq. 0) then
0092
0093 lastday = lastd - 1
0094 else
0095 lastday = lastd
0096 endif
0097 firstday = 1
0098 else if ( mod(firstmonth+1,nmonthyear) .eq. lastmonth ) then
0099
0100
0101 if ( ( modelenddate(2) .eq. 0 ) .and.
0102 & ( mod(modelenddate(1),100) .eq. 1 ) ) then
0103 firstday = firstd
0104 lastday = ndaymonth(firstmonth,lyfirst)
0105 else
0106
0107
0108 ierr = 2704
0109 call cal_PrintError( ierr, mythid )
0110 stop ' stopped in cal_DaysForMonth.'
0111 endif
0112 else
0113
0114 ierr = 2703
0115 call cal_PrintError( ierr, mythid )
0116 stop ' stopped in cal_DaysForMonth.'
0117 endif
0118 else
0119
0120
0121 ierr = 2702
0122 call cal_PrintError( ierr, mythid )
0123 stop ' stopped in cal_DaysForMonth.'
0124 endif
0125
0126 else if ( nummonths .gt. 1 ) then
0127
0128 if ( imonth .eq. 1 ) then
0129 firstday = 1
0130 lastday = ndaymonth(firstmonth,lyfirst) - firstd + 1
0131 else if ( ( imonth .gt. 1 ) .and.
0132 & ( imonth .lt. nummonths ) ) then
0133
0134 currentmonth = firstmonth
0135 currentyear = firstyear
0136 numdays = ndaymonth(firstmonth,lyfirst) - firstd + 1
0137 do i = 2,imonth-1
0138
0139 currentmonth = mod(currentmonth+1,nmonthyear)
e39e60293e Patr*0140 if ( currentmonth .eq. 0 ) then
0141 currentmonth = 12
0142 endif
a63ed37559 Patr*0143 if ( currentmonth .eq. 1 ) then
0144 currentyear = currentyear + 1
0145 endif
0146 lycurrent = cal_IsLeap( currentyear, mythid )
0147 numdays = numdays + ndaymonth(currentmonth,lycurrent)
0148 enddo
0149 currentmonth = mod(currentmonth+1,nmonthyear)
e39e60293e Patr*0150 if ( currentmonth .eq. 0 ) then
0151 currentmonth = 12
0152 endif
a63ed37559 Patr*0153 if ( currentmonth .eq. 1 ) then
0154 currentyear = currentyear + 1
0155 endif
0156 lycurrent = cal_IsLeap( currentyear, mythid )
0157 firstday = numdays + 1
0158 lastday = numdays + ndaymonth(currentmonth,lycurrent)
0159 else if ( imonth .eq. nummonths ) then
0160
0161 currentmonth = firstmonth
0162 currentyear = firstyear
0163 numdays = ndaymonth(firstmonth,lyfirst) - firstd + 1
0164 do i = 2,nummonths-1
0165
0166 currentmonth = mod(currentmonth+1,nmonthyear)
e39e60293e Patr*0167 if ( currentmonth .eq. 0 ) then
0168 currentmonth = 12
0169 endif
a63ed37559 Patr*0170 if ( currentmonth .eq. 1 ) then
0171 currentyear = currentyear + 1
0172 endif
0173 lycurrent = cal_IsLeap( currentyear, mythid )
0174 numdays = numdays + ndaymonth(currentmonth,lycurrent)
0175 enddo
0176
0177 currentmonth = mod(currentmonth+1,nmonthyear)
e39e60293e Patr*0178 if ( currentmonth .eq. 0 ) then
0179 currentmonth = 12
0180 endif
a63ed37559 Patr*0181 if ( currentmonth .eq. 1 ) then
0182 currentyear = currentyear + 1
0183 endif
0184 lycurrent = cal_IsLeap( currentyear, mythid )
0185 if ( ( modelenddate(2) .eq. 0 ) .and.
0186 & ( mod(modelenddate(1),100) .eq. 1 ) ) then
0187
0188
0189 lastday = numdays + ndaymonth(currentmonth,lycurrent)
0190 else
0191
0192
0193 if (lastsecs .eq. 0) then
0194
0195 lastday = numdays + lastd - 1
0196 else
0197 lastday = numdays + lastd
0198 endif
0199 endif
0200 firstday = numdays + 1
0201 else
0202
0203 ierr = 2705
0204 call cal_PrintError( ierr, mythid )
0205 stop ' stopped in cal_DaysForMonth.'
0206 endif
0207 else
0208
0209 ierr = 2701
0210 call cal_PrintError( ierr, mythid )
0211 stop ' stopped in cal_DaysForMonth.'
0212 endif
0213
0214
0215 ndays = lastday - firstday + 1
0216
0217 return
0218 end
0219