File indexing completed on 2021-11-10 06:15:11 UTC
view on githubraw file Latest commit deacece5 on 2021-11-09 17:35:09 UTC
6d54cf9ca1 Ed H*0001 #include "CAL_OPTIONS.h"
a63ed37559 Patr*0002
0003 subroutine cal_GetMonthsRec(
0004 O fac, first, changed,
deacece587 Oliv*0005 O month0, month1, year0, year1,
a63ed37559 Patr*0006 I mytime, myiter, mythid
0007 & )
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
deacece587 Oliv*0023
a63ed37559 Patr*0024
0025
0026
0027
0028
0029 implicit none
0030
0031
0032
0033 #include "cal.h"
0034
0035
0036
0037 _RL fac
0038 logical first
0039 logical changed
deacece587 Oliv*0040 integer month0
0041 integer month1
0042 integer year0
0043 integer year1
a63ed37559 Patr*0044 _RL mytime
0045 integer myiter
0046 integer mythid
0047
0048
0049
0050 integer currentdate(4)
0051 integer midtime(4)
0052 integer middate(4)
9e3f725f89 Jean*0053 integer tempDate(4)
0054 integer middate0_1, middate0_2
a63ed37559 Patr*0055 integer middate0(4)
9e3f725f89 Jean*0056 integer middate1_1, middate1_2
a63ed37559 Patr*0057 integer middate1(4)
0058 integer prevdate(4)
0059 integer shifttime(4)
9e3f725f89 Jean*0060 integer startofmonth_1, startofmonth_2
0061 integer endofmonth_1, endofmonth_2
a63ed37559 Patr*0062 integer startofmonth(4)
0063 integer endofmonth(4)
0064 integer difftime(4)
deacece587 Oliv*0065 integer presentmonth
0066 integer presentyear
a63ed37559 Patr*0067 integer previous
0068 integer next
0069 integer prevcount
0070 integer modelsteptime(4)
0071
0072 _RL currentsecs
0073 _RL prevsecs
0074 _RL midsecs_np
0075 _RL diffsecs
0076 _RL midsecs
0077
0078
0079
0080
0081
0082 shifttime(1) = 1
0083 shifttime(2) = 0
0084 shifttime(3) = 0
0085 shifttime(4) = -1
0086
0087 call cal_TimeInterval( -modelstep, 'secs', modelsteptime,
0088 & mythid )
0089
0090
0091 call cal_GetDate( myiter, mytime, currentdate, mythid )
0092
deacece587 Oliv*0093 presentyear = currentdate(1)/10000
0094 presentmonth = mod(currentdate(1)/100,100)
9e3f725f89 Jean*0095 startofmonth_1 = (currentdate(1)/100)*100 + 1
0096 startofmonth_2 = 0
0097 call cal_FullDate( startofmonth_1, startofmonth_2,
a63ed37559 Patr*0098 & startofmonth, mythid )
9e3f725f89 Jean*0099
0100 endofmonth_1 = (currentdate(1)/100)*100 +
deacece587 Oliv*0101 & ndaymonth(presentmonth,currentdate(3))
9e3f725f89 Jean*0102 endofmonth_2 = 235959
0103 call cal_FullDate( endofmonth_1, endofmonth_2,
a63ed37559 Patr*0104 & endofmonth, mythid )
0105
0106
0107 currentsecs = float(
0108 & (mod(currentdate(1),100)-1)*secondsperday +
0109 & currentdate(2)/10000*secondsperhour +
0110 & mod(currentdate(2)/100,100)*secondsperminute +
0111 & mod(currentdate(2),100)
0112 & )
deacece587 Oliv*0113 midsecs = float(ndaymonth(presentmonth,currentdate(3))*
a63ed37559 Patr*0114 & secondsperday/2)
0115
0116 call cal_TimeInterval( midsecs, 'secs', midtime, mythid )
0117 call cal_AddTime( startofmonth, midtime, middate, mythid )
0118 call cal_AddTime( currentdate, modelsteptime, prevdate, mythid )
0119
0120 prevsecs = float(
0121 & (mod(prevdate(1),100)-1)*secondsperday +
0122 & prevdate(2)/10000*secondsperhour +
0123 & mod(prevdate(2)/100,100)*secondsperminute +
0124 & mod(prevdate(2),100)
0125 & )
0126
0127
0128 first = ((mytime - modelstart) .lt. 0.5*modelstep)
0129
0130 if ( first ) then
0131 changed = .false.
0132 endif
0133
0134 if ( currentsecs .lt. midsecs ) then
0135
deacece587 Oliv*0136 month0 = mod(presentmonth+nmonthyear-2,nmonthyear)+1
0137 year0 = presentyear
0138 if (month0 .EQ. 12) year0 = year0 - 1
0139 prevcount = month0
a63ed37559 Patr*0140
0141 shifttime(1) = -shifttime(1)
0142 call cal_AddTime( startofmonth, shifttime, middate0, mythid )
9e3f725f89 Jean*0143 middate0_1 = (middate0(1)/100)*100 + 1
0144 middate0_2 = 0
0145 call cal_FullDate( middate0_1, middate0_2, tempDate,
a63ed37559 Patr*0146 & mythid )
0147
9e3f725f89 Jean*0148 previous = mod(tempDate(1)/100,100)
a63ed37559 Patr*0149
9e3f725f89 Jean*0150 midsecs_np = float(ndaymonth(previous,tempDate(3))*
a63ed37559 Patr*0151 & secondsperday/2)
0152
0153 call cal_TimeInterval( midsecs_np, 'secs', midtime, mythid )
9e3f725f89 Jean*0154 call cal_AddTime( tempDate, midtime, middate0, mythid )
a63ed37559 Patr*0155
deacece587 Oliv*0156 month1 = presentmonth
0157 year1 = presentyear
a63ed37559 Patr*0158
0159 middate1(1) = middate(1)
0160 middate1(2) = middate(2)
0161 middate1(3) = middate(3)
0162 middate1(4) = middate(4)
0163
0164 else
0165
deacece587 Oliv*0166 month0 = presentmonth
0167 year0 = presentyear
a63ed37559 Patr*0168
0169 if ( prevsecs .lt. midsecs ) then
deacece587 Oliv*0170 prevcount = mod(presentmonth+nmonthyear-2,nmonthyear)+1
a63ed37559 Patr*0171 else
deacece587 Oliv*0172 prevcount = presentmonth
a63ed37559 Patr*0173 endif
0174
0175 middate0(1) = middate(1)
0176 middate0(2) = middate(2)
0177 middate0(3) = middate(3)
0178 middate0(4) = middate(4)
0179
deacece587 Oliv*0180 month1 = mod(presentmonth, nmonthyear) + 1
0181 year1 = presentyear
0182 if ( month1 .EQ. 1 ) year1 = year1 + 1
a63ed37559 Patr*0183
0184 call cal_AddTime( endofmonth, shifttime, middate1, mythid )
9e3f725f89 Jean*0185 middate1_1 = (middate1(1)/100)*100 + 1
0186 middate1_2 = 0
a63ed37559 Patr*0187
9e3f725f89 Jean*0188 call cal_FullDate( middate1_1, middate1_2, tempDate,
a63ed37559 Patr*0189 & mythid )
9e3f725f89 Jean*0190 next = mod(tempDate(1)/100,100)
0191 midsecs_np = float(ndaymonth(next,tempDate(3))*
a63ed37559 Patr*0192 & secondsperday/2)
0193 call cal_TimeInterval( midsecs_np, 'secs', midtime, mythid )
9e3f725f89 Jean*0194 call cal_AddTime( tempDate, midtime, middate1, mythid )
a63ed37559 Patr*0195
0196 endif
0197
0198 call cal_SubDates( middate1, middate0, difftime, mythid )
0199 call cal_ToSeconds( difftime, diffsecs, mythid )
0200
0201
deacece587 Oliv*0202
0203 if ( (.not. first) .and. (prevcount .ne. month0) ) then
a63ed37559 Patr*0204 changed = .true.
0205 else
0206 changed = .false.
0207 endif
0208
0209 if ( currentsecs .lt. midsecs ) then
0210 fac = (midsecs - currentsecs)/diffsecs
0211 else
0212 fac = (2.*midsecs + midsecs_np - currentsecs)/
0213 & diffsecs
0214 endif
0215
0216 return
0217 end
0218