Changeset 1748 for trunk/NEMO/OFF_SRC/DOM/daymod.F90
- Timestamp:
- 2009-11-23T11:51:20+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/DOM/daymod.F90
r1747 r1748 4 4 !! Ocean : calendar 5 5 !!===================================================================== 6 !! History : !94-09 (M. Pontaud M. Imbard) Original code7 !! !97-03 (O. Marti)8 !! !97-05 (G. Madec)9 !! !97-08 (M. Imbard)10 !! 9.0 !03-09 (G. Madec) F90 + nyear, nmonth, nday11 !! !04-01 (A.M. Treguier) new calculation based on adatrj12 !! !06-08 (G. Madec) surface module major update6 !! History : OPA ! 1994-09 (M. Pontaud M. Imbard) Original code 7 !! ! 1997-03 (O. Marti) 8 !! ! 1997-05 (G. Madec) 9 !! ! 1997-08 (M. Imbard) 10 !! NEMO 1.0 ! 2003-09 (G. Madec) F90 + nyear, nmonth, nday 11 !! ! 2004-01 (A.M. Treguier) new calculation based on adatrj 12 !! ! 2006-08 (G. Madec) surface module major update 13 13 !!---------------------------------------------------------------------- 14 14 … … 29 29 USE phycst ! physical constants 30 30 USE in_out_manager ! I/O manager 31 USE ioipsl, ONLY : ymds2ju ! for calendar 31 32 USE prtctl ! Print control 32 USE ioipsl, ONLY : ymds2ju ! for calendar33 33 34 34 IMPLICIT NONE 35 35 PRIVATE 36 36 37 PUBLIC day ! called by step.F90 38 PUBLIC day_init ! called by istate.F90 39 40 !!---------------------------------------------------------------------- 41 !! OPA 9.0 , LOCEAN-IPSL (2006) 37 PUBLIC day ! called by step.F90 38 PUBLIC day_init ! called by istate.F90 39 40 INTEGER :: nsecd, nsecd05, ndt, ndt05 41 42 !!---------------------------------------------------------------------- 43 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 42 44 !! $Id$ 43 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 57 59 !! - nday : current day of the month nmonth 58 60 !! - nday_year : current day of the year nyear 59 !! - rsec_year : current time step counted in second since 00h jan 1st of the current year60 !! - rsec_month : current time step counted in second since 00h 1st day of the current month61 !! - rsec_day : current time step counted in second since 00h of the current day62 !! - sec1jan000: second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year63 !! - nmonth_len, nyear_len, rmonth_half, rmonth_end through day_mth61 !! - nsec_year : current time step counted in second since 00h jan 1st of the current year 62 !! - nsec_month : current time step counted in second since 00h 1st day of the current month 63 !! - nsec_day : current time step counted in second since 00h of the current day 64 !! - nsec1jan000 : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year 65 !! - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 64 66 !!---------------------------------------------------------------------- 65 67 66 68 ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0 67 IF( MOD( rday, rdttra(1) ) /= 0 ) CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 69 IF( MOD( rday , rdttra(1) ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 70 IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' ) 71 IF( MOD( rdttra(1), 2. ) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' ) 72 nsecd = NINT(rday ) 73 nsecd05 = NINT(0.5 * rday ) 74 ndt = NINT( rdttra(1)) 75 ndt05 = NINT(0.5 * rdttra(1)) 76 68 77 69 78 ! set the calandar from ndastp (read in restart file and namelist) 79 70 80 nyear = ndastp / 10000 71 81 nmonth = ( ndastp - (nyear * 10000) ) / 100 … … 73 83 74 84 CALL ymds2ju( nyear, nmonth, nday, 0.0, fjulday ) ! we assume that we start run at 00:00 85 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 75 86 fjulday = fjulday + 1. ! move back to the day at nit000 (and not at nit000 - 1) 76 87 77 78 sec1jan000 = 0.e0 88 nsec1jan000 = 0 79 89 CALL day_mth 80 90 … … 86 96 nmonth = 12 87 97 nyear = nyear - 1 88 sec1jan000 = sec1jan000 - rday * REAL( nyear_len(0), wp)98 nsec1jan000 = nsec1jan000 - nsecd * nyear_len(0) 89 99 IF( nleapy == 1 ) CALL day_mth 90 100 ENDIF … … 94 104 95 105 ! number of seconds since the beginning of current year/month at the middle of the time-step 96 rsec_year = REAL( nday_year, wp ) * rday - 0.5 * rdttra(1)! 1 time step before the middle of the first time step97 rsec_month = REAL( nday , wp ) * rday - 0.5 * rdttra(1)! because day will be called at the beginning of step98 rsec_day = rday - 0.5 * rdttra(1)106 nsec_year = nday_year * nsecd - ndt05 ! 1 time step before the middle of the first time step 107 nsec_month = nday * nsecd - ndt05 ! because day will be called at the beginning of step 108 nsec_day = nsecd - ndt05 99 109 100 110 ! control print 101 IF(lwp) WRITE(numout,*)' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', & 102 & nyear, '/', nmonth, '/', nday, ' rsec_day:', rsec_day 111 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', & 112 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day 113 114 ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 115 ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init 116 CALL day( nit000 ) 117 103 118 104 119 END SUBROUTINE day_init … … 113 128 !! ** Action : - nmonth_len : length in days of the months of the current year 114 129 !! - nyear_len : length in days of the previous/current year 115 !! - rmonth_half : second since the beginning of the year and the halft of the months116 !! - rmonth_end : second since the beginning of the year and the end of the months130 !! - nmonth_half : second since the beginning of the year and the halft of the months 131 !! - nmonth_end : second since the beginning of the year and the end of the months 117 132 !!---------------------------------------------------------------------- 118 133 INTEGER :: jm ! dummy loop indice … … 143 158 ! month number 0 1 2 ... 11 12 13 144 159 ! 145 ! rmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) )146 rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len(0), wp)160 ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) ) 161 nmonth_half(0) = - nsecd05 * nmonth_len(0) 147 162 DO jm = 1, 13 148 rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm), wp)163 nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) ) 149 164 END DO 150 165 151 rmonth_end(0) = 0.166 nmonth_end(0) = 0 152 167 DO jm = 1, 13 153 rmonth_end(jm) = rmonth_end(jm-1) + rday * REAL( nmonth_len(jm), wp)168 nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm) 154 169 END DO 155 170 ! 156 171 END SUBROUTINE 157 172 … … 171 186 !! - ndastp : = nyear*10000 + nmonth*100 + nday 172 187 !! - adatrj : date in days since the beginning of the run 173 !! - rsec_year : current time of the year (in second since 00h, jan 1st)188 !! - nsec_year : current time of the year (in second since 00h, jan 1st) 174 189 !!---------------------------------------------------------------------- 175 190 INTEGER, INTENT(in) :: kt ! ocean time-step indices 176 191 ! 177 192 CHARACTER (len=25) :: charout 178 !!---------------------------------------------------------------------- 179 193 REAL(wp) :: zprec ! fraction of day corresponding to 0.1 second 194 !!---------------------------------------------------------------------- 195 zprec = 0.1 / rday 180 196 ! ! New time-step 181 rsec_year = rsec_year + rdttra(1)182 rsec_month = rsec_month + rdttra(1)183 rsec_day = rsec_day + rdttra(1)184 adatrj = adatrj+ rdttra(1) / rday197 nsec_year = nsec_year + ndt 198 nsec_month = nsec_month + ndt 199 nsec_day = nsec_day + ndt 200 adatrj = adatrj + rdttra(1) / rday 185 201 fjulday = fjulday + rdttra(1) / rday 186 187 IF( rsec_day > rday ) THEN ! NEW day 202 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 203 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error 204 205 IF( nsec_day > nsecd ) THEN ! NEW day 188 206 ! 189 207 nday = nday + 1 190 208 nday_year = nday_year + 1 191 rsec_day = 0.5 * rdttra(1)209 nsec_day = ndt05 192 210 ! 193 211 IF( nday == nmonth_len(nmonth) + 1 ) THEN ! NEW month 194 212 nday = 1 195 213 nmonth = nmonth + 1 196 rsec_month = 0.5 * rdttra(1)214 nsec_month = ndt05 197 215 IF( nmonth == 13 ) THEN ! NEW year 198 216 nyear = nyear + 1 199 217 nmonth = 1 200 218 nday_year = 1 201 rsec_year = 0.5 * rdttra(1)202 sec1jan000 = sec1jan000 + rday * REAL( nyear_len(1), wp)219 nsec_year = ndt05 220 nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1) 203 221 IF( nleapy == 1 ) CALL day_mth 204 222 ENDIF … … 209 227 IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt, & 210 228 & ' New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year 211 IF(lwp) WRITE(numout,'(a, F9.0,a,F9.0,a,F9.0)') ' rsec_year = ', rsec_year, &212 & ' rsec_month = ', rsec_month, ' rsec_day = ', rsec_day229 IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') ' nsec_year = ', nsec_year, & 230 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day 213 231 ENDIF 214 232 … … 218 236 ENDIF 219 237 220 !221 238 END SUBROUTINE day 239 222 240 !!====================================================================== 223 241 END MODULE daymod
Note: See TracChangeset
for help on using the changeset viewer.