Changeset 12246 for NEMO/branches
- Timestamp:
- 2019-12-13T16:11:51+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src
- Files:
-
- 1 deleted
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/BDY/bdydta.F90
r12202 r12246 75 75 CONTAINS 76 76 77 SUBROUTINE bdy_dta( kt, kt_offset )77 SUBROUTINE bdy_dta( kt, pt_offset ) 78 78 !!---------------------------------------------------------------------- 79 79 !! *** SUBROUTINE bdy_dta *** … … 85 85 !!---------------------------------------------------------------------- 86 86 INTEGER, INTENT(in) :: kt ! ocean time-step index 87 INTEGER, INTENT(in), OPTIONAL :: kt_offset ! time offset in units of timesteps 88 ! ! kt_offset = 0 => get data at "now" time level 89 ! ! kt_offset = -1 => get data at "before" time level 90 ! ! kt_offset = +1 => get data at "after" time level 91 ! ! etc. 87 REAL(wp),INTENT(in), OPTIONAL :: pt_offset ! time offset in units of timesteps 92 88 ! 93 89 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices … … 214 210 ! read/update all bdy data 215 211 ! ------------------------ 216 CALL fld_read( kt, 1, bf_alias, kt_offset = kt_offset )212 CALL fld_read( kt, 1, bf_alias, pt_offset = pt_offset ) 217 213 218 214 ! apply some corrections in some specific cases... … … 335 331 nblen => idx_bdy(jbdy)%nblen 336 332 nblenrim => idx_bdy(jbdy)%nblenrim 337 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 338 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 339 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 340 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 341 ENDIF 342 END DO 343 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 344 ! 345 CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset ) 346 ENDIF 333 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) 334 ELSE ; ilen1(:)=nblenrim(:) 335 ENDIF 336 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 337 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 338 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 339 ENDIF 340 END DO 341 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 342 ! 343 CALL bdy_dta_tides( kt=kt, pt_offset=pt_offset ) 347 344 ENDIF 348 ! 349 IF( ln_timing ) CALL timing_stop('bdy_dta') 350 ! 351 END SUBROUTINE bdy_dta 345 ENDIF 346 ! 347 IF( ln_timing ) CALL timing_stop('bdy_dta') 348 ! 349 END SUBROUTINE bdy_dta 352 350 353 351 … … 448 446 IF( nn_ice_dta(jbdy) == 1 ) THEN ! if we get ice bdy data from netcdf file 449 447 CALL fld_fill( bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 ) ! use namelist info 450 CALL fld_clopn( bf(jp_bdya_i,jbdy), nyear, nmonth, nday ) ! not a problem when we call it again after 448 CALL fld_def( bf(jp_bdya_i,jbdy) ) 449 CALL iom_open( bf(jp_bdya_i,jbdy)%clname, bf(jp_bdya_i,jbdy)%num ) 451 450 idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 452 451 IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN ; ipl = i4dimsz(3) ! xylt or xyl 453 452 ELSE ; ipl = 1 ! xy or xyt 454 453 ENDIF 454 CALL iom_close( bf(jp_bdya_i,jbdy)%num ) 455 455 bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED' ! reset to default value as this subdomain may not need to read this bdy 456 456 ENDIF -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/BDY/bdytides.F90
r12202 r12246 269 269 270 270 271 SUBROUTINE bdy_dta_tides( kt, kit, kt_offset )271 SUBROUTINE bdy_dta_tides( kt, kit, pt_offset ) 272 272 !!---------------------------------------------------------------------- 273 273 !! *** SUBROUTINE bdy_dta_tides *** … … 278 278 INTEGER, INTENT(in) :: kt ! Main timestep counter 279 279 INTEGER, OPTIONAL, INTENT(in) :: kit ! Barotropic timestep counter (for timesplitting option) 280 INTEGER, OPTIONAL, INTENT(in) :: kt_offset ! time offset in units of timesteps. NB. if kit 281 ! ! is present then units = subcycle timesteps. 282 ! ! kt_offset = 0 => get data at "now" time level 283 ! ! kt_offset = -1 => get data at "before" time level 284 ! ! kt_offset = +1 => get data at "after" time level 285 ! ! etc. 280 REAL(wp),OPTIONAL, INTENT(in) :: pt_offset ! time offset in units of timesteps 286 281 ! 287 282 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 288 283 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices 289 INTEGER :: time_add ! time offset in units of timesteps290 284 INTEGER, DIMENSION(jpbgrd) :: ilen0 291 285 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts 292 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist 286 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset 293 287 !!---------------------------------------------------------------------- 294 288 ! … … 296 290 IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF 297 291 298 time_add = 0 299 IF( PRESENT(kt_offset) ) THEN 300 time_add = kt_offset 301 ENDIF 292 zt_offset = 0._wp 293 IF( PRESENT(pt_offset) ) zt_offset = pt_offset 302 294 303 295 ! Absolute time from model initialization: 304 296 IF( PRESENT(kit) ) THEN 305 z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt297 z_arg = ( REAL(kt, wp) + ( REAL(kit, wp) + zt_offset - 1. ) / REAL(nn_baro, wp) ) * rdt 306 298 ELSE 307 z_arg = ( kt + time_add) * rdt299 z_arg = ( REAL(kt, wp) + zt_offset ) * rdt 308 300 ENDIF 309 301 310 302 ! Linear ramp on tidal component at open boundaries 311 303 zramp = 1. 312 IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000*rdt)/(rn_tide_ramp_dt*rday),0.),1.)304 IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - REAL(nit000,wp)*rdt)/(rn_tide_ramp_dt*rday),0.),1.) 313 305 314 306 DO ib_bdy = 1,nb_bdy … … 327 319 IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 328 320 ! 329 kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt321 kt_tide = kt - NINT((REAL(nsec_day,wp) - 0.5_wp * rdt)/rdt) 330 322 ! 331 323 IF(lwp) THEN … … 339 331 ! 340 332 ENDIF 341 zoff = -kt_tide* rdt ! time offset relative to nodal factor computation time333 zoff = REAL(-kt_tide,wp) * rdt ! time offset relative to nodal factor computation time 342 334 ! 343 335 ! If time splitting, initialize arrays from slow varying open boundary data: -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DOM/daymod.F90
r12210 r12246 58 58 !! 59 59 !! ** Action : - nyear : current year 60 !! - nmonth : current month of the year nyear 61 !! - nday : current day of the month nmonth 62 !! - nday_year : current day of the year nyear 63 !! - nsec_year : current time step counted in second since 00h jan 1st of the current year 64 !! - nsec_month : current time step counted in second since 00h 1st day of the current month 65 !! - nsec_day : current time step counted in second since 00h of the current day 66 !! - nsec1jan000 : second since Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year 67 !! - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 68 !!---------------------------------------------------------------------- 69 INTEGER :: inbday, idweek ! local integers 60 !! - nmonth : current month of the current nyear 61 !! - nday : current day of the current nmonth 62 !! - nday_year : current day of the current nyear 63 !! - nsec_year : seconds between 00h jan 1st of the current year and half of the current time step 64 !! - nsec_month : seconds between 00h 1st day of the current month and half of the current time step 65 !! - nsec_monday : seconds between 00h of the last Monday and half of the current time step 66 !! - nsec_day : seconds between 00h of the current day and half of the current time step 67 !! - nsec1jan000 : seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h of the current year 68 !! - nmonth_len, nyear_len, nmonth_beg through day_mth 69 !!---------------------------------------------------------------------- 70 INTEGER :: inbday, imonday, isecrst ! local integers 70 71 REAL(wp) :: zjul ! local scalar 71 72 !!---------------------------------------------------------------------- … … 76 77 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 77 78 ENDIF 78 nsecd = NINT( rday)79 nsecd = NINT( rday ) 79 80 nsecd05 = NINT( 0.5 * rday ) 80 81 ndt = NINT( rdt ) … … 90 91 nhour = nn_time0 / 100 91 92 nminute = ( nn_time0 - nhour * 100 ) 92 93 CALL ymds2ju( nyear, nmonth, nday, nhour*3600._wp+nminute*60._wp, fjulday ) 93 isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 94 95 CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday ) 94 96 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 95 IF( n n_time0*3600 - ndt05 .lt. 0 ) fjulday = fjulday + 1.! move back to the day at nit000 (and not at nit000 - 1)97 IF( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1. ! move back to the day at nit000 (and not at nit000 - 1) 96 98 97 99 nsec1jan000 = 0 … … 112 114 nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 113 115 114 !compute number of days between last monday and today115 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday)116 inbday = FLOOR(fjulday - zjul) ! compute nb day between 01.01.1900 and start of current day117 i dweek = MOD(inbday, 7)! compute nb day between last monday and current day118 IF (i dweek .lt. 0) idweek=idweek+7! Avoid negative values for dates before 01.01.1900116 !compute number of days between last Monday and today 117 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday) 118 inbday = FLOOR(fjulday - zjul) ! compute nb day between 01.01.1900 and start of current day 119 imonday = MOD(inbday, 7) ! compute nb day between last monday and current day 120 IF (imonday .LT. 0) imonday = imonday + 7 ! Avoid negative values for dates before 01.01.1900 119 121 120 122 ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step 121 IF (nhour*3600+nminute*60-ndt05 .gt. 0) THEN123 IF( isecrst - ndt05 .GT. 0 ) THEN 122 124 ! 1 timestep before current middle of first time step is still the same day 123 nsec_year = (nday_year-1) * nsecd + nhour*3600+nminute*60- ndt05124 nsec_month = (nday-1) * nsecd + nhour*3600+nminute*60- ndt05125 nsec_year = (nday_year-1) * nsecd + isecrst - ndt05 126 nsec_month = (nday-1) * nsecd + isecrst - ndt05 125 127 ELSE 126 128 ! 1 time step before the middle of the first time step is the previous day 127 nsec_year = nday_year * nsecd + nhour*3600+nminute*60- ndt05128 nsec_month = nday * nsecd + nhour*3600+nminute*60- ndt05129 ENDIF 130 nsec_ week = idweek * nsecd + nhour*3600+nminute*60- ndt05131 nsec_day = nhour*3600+nminute*60- ndt05132 IF( nsec_day .lt. 0 ) nsec_day = nsec_day+ nsecd133 IF( nsec_ week .lt. 0 ) nsec_week = nsec_week+ nsecd*7129 nsec_year = nday_year * nsecd + isecrst - ndt05 130 nsec_month = nday * nsecd + isecrst - ndt05 131 ENDIF 132 nsec_monday = imonday * nsecd + isecrst - ndt05 133 nsec_day = isecrst - ndt05 134 IF( nsec_day .LT. 0 ) nsec_day = nsec_day + nsecd 135 IF( nsec_monday .LT. 0 ) nsec_monday = nsec_monday + nsecd*7 134 136 135 137 ! control print 136 138 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8,a,i8,a,i8)') & 137 139 & ' =======>> 1/2 time step before the start of the run DATE Y/M/D = ', & 138 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_ week:', nsec_week, ' &140 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_monday:', nsec_monday, ' & 139 141 & nsec_month:', nsec_month , ' nsec_year:' , nsec_year 140 142 143 nsec000_1jan000 = nsec1jan000 + nsec_year + ndt05 144 nsecend_1jan000 = nsec000_1jan000 + ndt * ( nitend - nit000 + 1 ) 145 141 146 ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 142 147 ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init … … 160 165 !! ** Purpose : calendar values related to the months 161 166 !! 162 !! ** Action : - nmonth_len : length in days of the months of the current year 163 !! - nyear_len : length in days of the previous/current year 164 !! - nmonth_half : second since the beginning of the year and the halft of the months 165 !! - nmonth_end : second since the beginning of the year and the end of the months 166 !!---------------------------------------------------------------------- 167 INTEGER :: jm ! dummy loop indice 167 !! ** Action : - nyear_len : length in days of the previous/current year 168 !! - nmonth_len : length in days of the months of the current year 169 !! - nmonth_half : second since the beginning of the current year and the halft of the months 170 !! - nmonth_end : second since the beginning of the current year and the end of the months 171 !!---------------------------------------------------------------------- 172 INTEGER :: jm ,jy ! dummy loop indice 173 INTEGER, DIMENSION(12) :: idaymt ! length in days of the 12 months for non-leap year 168 174 !!---------------------------------------------------------------------- 169 175 170 176 ! length of the month of the current year (from nleapy, read in namelist) 171 177 IF ( nleapy < 2 ) THEN 172 nmonth_len(:) = (/ 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31 /) 178 ! default values 179 idaymt(1:12) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) 180 nmonth_len(-11: 25) = (/ idaymt(1:12), idaymt(1:12), idaymt(1:12), idaymt(1) /) 173 181 nyear_len(:) = 365 182 ! 174 183 IF ( nleapy == 1 ) THEN ! we are using calandar with leap years 175 IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN 176 nyear_len(0) = 366 177 ENDIF 178 IF ( MOD(nyear , 4) == 0 .AND. ( MOD(nyear , 400) == 0 .OR. MOD(nyear , 100) /= 0 ) ) THEN 179 nmonth_len(2) = 29 180 nyear_len(1) = 366 181 ENDIF 182 IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN 183 nyear_len(2) = 366 184 ENDIF 184 DO jy = -1,1 185 IF ( MOD(nyear+jy, 4) == 0 .AND. ( MOD(nyear+jy, 400) == 0 .OR. MOD(nyear+jy, 100) /= 0 ) ) THEN 186 nmonth_len(2 + 12*jy) = 29 187 nyear_len( 1 + jy) = 366 188 ENDIF 189 ENDDO 185 190 ENDIF 186 191 ELSE … … 189 194 ENDIF 190 195 191 ! half month in second since the begining of the year:192 196 ! time since Jan 1st 0 1 2 ... 11 12 13 193 197 ! ---------*--|--*--|--*--| ... |--*--|--*--|--*--|-------------------------------------- 194 198 ! <---> <---> <---> ... <---> <---> <---> 195 199 ! month number 0 1 2 ... 11 12 13 196 ! 197 ! nmonth_half(jm) = rday * REAL( 0.5 * nmonth_len(jm) + SUM(nmonth_len(1:jm-1)) ) 198 nmonth_half(0) = - nsecd05 * nmonth_len(0) 199 DO jm = 1, 13 200 nmonth_half(jm) = nmonth_half(jm-1) + nsecd05 * ( nmonth_len(jm-1) + nmonth_len(jm) ) 200 nmonth_beg(1) = 0 201 DO jm = 2, 25 202 nmonth_beg(jm) = nmonth_beg(jm-1) + nsecd * nmonth_len(jm-1) 201 203 END DO 202 203 nmonth_end(0) = 0 204 DO jm = 1, 13 205 nmonth_end(jm) = nmonth_end(jm-1) + nsecd * nmonth_len(jm) 204 DO jm = 0,-11,-1 205 nmonth_beg(jm) = nmonth_beg(jm+1) - nsecd * nmonth_len(jm) 206 206 END DO 207 207 ! … … 235 235 zprec = 0.1 / rday 236 236 ! ! New time-step 237 nsec_year = nsec_year+ ndt238 nsec_month = nsec_month+ ndt239 nsec_ week = nsec_week+ ndt237 nsec_year = nsec_year + ndt 238 nsec_month = nsec_month + ndt 239 nsec_monday = nsec_monday + ndt 240 240 nsec_day = nsec_day + ndt 241 241 adatrj = adatrj + rdt / rday … … 272 272 & ' New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year 273 273 IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') ' nsec_year = ', nsec_year, & 274 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day, ' nsec_ week = ', nsec_week275 ENDIF 276 277 IF( nsec_ week > 7*nsecd ) nsec_week= ndt05 ! New week274 & ' nsec_month = ', nsec_month, ' nsec_day = ', nsec_day, ' nsec_monday = ', nsec_monday 275 ENDIF 276 277 IF( nsec_monday > 7*nsecd ) nsec_monday = ndt05 ! New week 278 278 279 279 IF(sn_cfctl%l_prtctl) THEN … … 319 319 ! 320 320 REAL(wp) :: zkt, zndastp, zdayfrac, ksecs, ktime 321 INTEGER :: ihour, iminute 321 INTEGER :: ihour, iminute, isecond 322 322 !!---------------------------------------------------------------------- 323 323 … … 349 349 CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios ) 350 350 CALL iom_get( numror, 'ntime' , ktime , ldxios = lrxios ) 351 nn_time0=INT(ktime)351 nn_time0 = NINT(ktime) 352 352 ! calculate start time in hours and minutes 353 zdayfrac=adatrj-INT(adatrj)354 ksecs = NINT(zdayfrac *86400) ! Nearest second to catch rounding errors in adatrj355 ihour = INT(ksecs/3600)356 iminute = ksecs /60-ihour*60353 zdayfrac = adatrj - REAL(INT(adatrj), wp) 354 ksecs = NINT(zdayfrac * rday) ! Nearest second to catch rounding errors in adatrj 355 ihour = ksecs / NINT( rhhmm*rmmss ) 356 iminute = ksecs / NINT(rmmss) - ihour*NINT(rhhmm) 357 357 358 358 ! Add to nn_time0 359 359 nhour = nn_time0 / 100 360 360 nminute = ( nn_time0 - nhour * 100 ) 361 nminute =nminute+iminute361 nminute = nminute + iminute 362 362 363 IF( nminute >= 60) THEN364 nminute =nminute-60365 nhour =nhour+1363 IF( nminute >= NINT(rhhmm) ) THEN 364 nminute = nminute - NINT(rhhmm) 365 nhour = nhour+1 366 366 ENDIF 367 367 nhour=nhour+ihour 368 IF( nhour >= 24) THEN369 nhour =nhour-24370 adatrj =adatrj+1368 IF( nhour >= NINT(rjjhh) ) THEN 369 nhour = nhour - NINT(rjjhh) 370 adatrj = adatrj + 1. 371 371 ENDIF 372 372 nn_time0 = nhour * 100 + nminute 373 adatrj = INT(adatrj) ! adatrj set to integer as nn_time0 updated373 adatrj = REAL(INT(adatrj), wp) ! adatrj set to integer as nn_time0 updated 374 374 ELSE 375 375 ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) … … 377 377 nhour = nn_time0 / 100 378 378 nminute = ( nn_time0 - nhour * 100 ) 379 IF( nhour*3600+nminute*60-ndt05 .lt. 0 ) ndastp=ndastp-1 ! Start hour is specified in the namelist (default 0) 379 isecond = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 380 IF( isecond - ndt05 .lt. 0 ) ndastp = ndastp - 1 ! Start hour is specified in the namelist (default 0) 380 381 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 381 382 ! note this is wrong if time step has changed during run … … 386 387 nhour = nn_time0 / 100 387 388 nminute = ( nn_time0 - nhour * 100 ) 388 IF( nhour*3600+nminute*60-ndt05 .lt. 0 ) ndastp=ndastp-1 ! Start hour is specified in the namelist (default 0) 389 isecond = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 390 IF( isecond - ndt05 .LT. 0 ) ndastp = ndastp - 1 ! Start hour is specified in the namelist (default 0) 389 391 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 390 392 ENDIF -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DOM/dom_oce.F90
r12166 r12246 187 187 INTEGER , PUBLIC :: ndastp !: time step date in yyyymmdd format 188 188 INTEGER , PUBLIC :: nday_year !: current day counted from jan 1st of the current year 189 INTEGER , PUBLIC :: nsec_year !: current time step counted in second since 00h jan 1st of the current year190 INTEGER , PUBLIC :: nsec_month !: current time step counted in second since 00h 1st day of the current month191 INTEGER , PUBLIC :: nsec_ week !: current time step counted in second since 00h of last monday192 INTEGER , PUBLIC :: nsec_day !: current time step counted in second since 00h of the current day189 INTEGER , PUBLIC :: nsec_year !: seconds between 00h jan 1st of the current year and half of the current time step 190 INTEGER , PUBLIC :: nsec_month !: seconds between 00h 1st day of the current month and half of the current time step 191 INTEGER , PUBLIC :: nsec_monday !: seconds between 00h of the last Monday and half of the current time step 192 INTEGER , PUBLIC :: nsec_day !: seconds between 00h of the current day and half of the current time step 193 193 REAL(wp), PUBLIC :: fjulday !: current julian day 194 194 REAL(wp), PUBLIC :: fjulstartyear !: first day of the current year in julian days 195 195 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation 196 196 ! !: (cumulative duration of previous runs that may have used different time-step size) 197 INTEGER , PUBLIC, DIMENSION(0: 2) :: nyear_len !: length in days of the previous/current/next year 198 INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_len !: length in days of the months of the current year 199 INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_half !: second since Jan 1st 0h of the current year and the half of the months 200 INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_end !: second since Jan 1st 0h of the current year and the end of the months 201 INTEGER , PUBLIC :: nsec1jan000 !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year 197 INTEGER , PUBLIC, DIMENSION( 0: 2) :: nyear_len !: length in days of the previous/current/next year 198 INTEGER , PUBLIC, DIMENSION(-11:25) :: nmonth_len !: length in days of the months of the current year 199 INTEGER , PUBLIC, DIMENSION(-11:25) :: nmonth_beg !: second since Jan 1st 0h of the current year and the half of the months 200 INTEGER , PUBLIC :: nsec1jan000 !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year 201 INTEGER , PUBLIC :: nsec000_1jan000 !: second since Jan 1st 0h of nit000 year and nit000 202 INTEGER , PUBLIC :: nsecend_1jan000 !: second since Jan 1st 0h of nit000 year and nitend 202 203 203 204 !!---------------------------------------------------------------------- -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DYN/dynspg_ts.F90
r12191 r12246 441 441 ! !== Update the forcing ==! (BDY and tides) 442 442 ! 443 IF( ln_bdy .AND. ln_tide ) CALL bdy_dta_tides( kt, kit=jn, kt_offset= noffset+1)443 IF( ln_bdy .AND. ln_tide ) CALL bdy_dta_tides( kt, kit=jn, pt_offset= REAL(noffset+1,wp) ) 444 444 ! Update tide potential at the beginning of current time substep 445 445 IF( ln_tide_pot .AND. ln_tide ) THEN -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/SBC/fldread.F90
r12154 r12246 13 13 !! fld_read : read input fields used for the computation of the surface boundary condition 14 14 !! fld_init : initialization of field read 15 !! fld_ rec : determined the record(s) to be read15 !! fld_def : define the record(s) of the file and its name 16 16 !! fld_get : read the data 17 17 !! fld_map : read global data from file and map onto local data using a general mapping (use for open boundaries) 18 18 !! fld_rot : rotate the vector fields onto the local grid direction 19 !! fld_clopn : update the data file name andclose/open the files19 !! fld_clopn : close/open the files 20 20 !! fld_fill : fill the data structure with the associated information read in namelist 21 21 !! wgt_list : manage the weights used for interpolation … … 25 25 !! seaoverland : create shifted matrices for seaoverland application 26 26 !! fld_interp : apply weights to input gridded data to create data on model grid 27 !! ksec_week : function returning the first 3 letters of the first day of the weekly file 27 !! fld_filename : define the filename according to a given date 28 !! ksec_week : function returning seconds between 00h of the beginning of the week and half of the current time step 28 29 !!---------------------------------------------------------------------- 29 30 USE oce ! ocean dynamics and tracers … … 44 45 PUBLIC fld_map ! routine called by tides_init 45 46 PUBLIC fld_read, fld_fill ! called by sbc... modules 46 PUBLIC fld_ clopn47 PUBLIC fld_def 47 48 48 49 TYPE, PUBLIC :: FLD_N !: Namelist field informations … … 72 73 INTEGER , DIMENSION(2) :: nrec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 73 74 INTEGER , DIMENSION(2) :: nrec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year) 74 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step 75 REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) :: fdta ! 2 consecutive record of input fields 75 INTEGER , ALLOCATABLE, DIMENSION(: ) :: nrecsec ! 76 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: fnow ! input fields interpolated to now time step 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: fdta ! 2 consecutive record of input fields 76 78 CHARACTER(len = 256) :: wgtname ! current name of the NetCDF weight file acting as a key 77 79 ! ! into the WGTLIST structure … … 118 120 TYPE( WGT ), DIMENSION(tot_wgts) :: ref_wgts ! array of wgts 119 121 INTEGER :: nxt_wgt = 1 ! point to next available space in ref_wgts array 122 INTEGER :: nflag = 0 120 123 REAL(wp), PARAMETER :: undeff_lsm = -999.00_wp 121 124 … … 129 132 CONTAINS 130 133 131 SUBROUTINE fld_read( kt, kn_fsbc, sd, kit, kt_offset )134 SUBROUTINE fld_read( kt, kn_fsbc, sd, kit, pt_offset ) 132 135 !!--------------------------------------------------------------------- 133 136 !! *** ROUTINE fld_read *** … … 145 148 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 146 149 INTEGER , INTENT(in ), OPTIONAL :: kit ! subcycle timestep for timesplitting option 147 INTEGER , INTENT(in ), OPTIONAL :: kt_offset ! provide fields at time other than "now" 148 ! ! kt_offset = -1 => fields at "before" time level 149 ! ! kt_offset = +1 => fields at "after" time level 150 ! ! etc. 151 !! 152 INTEGER :: itmp ! local variable 150 REAL(wp) , INTENT(in ), OPTIONAL :: pt_offset ! provide fields at time other than "now" 151 !! 153 152 INTEGER :: imf ! size of the structure sd 154 153 INTEGER :: jf ! dummy indices 155 INTEGER :: isecend ! number of second since Jan. 1st 00h of nit000 year at nitend156 154 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 157 INTEGER :: it_offset ! local time offset variable158 LOGICAL :: llnxtyr ! open next year file?159 LOGICAL :: llnxtmth ! open next month file?160 LOGICAL :: llstop ! stop is the file does not exist161 155 LOGICAL :: ll_firstcall ! true if this is the first call to fld_read for this set of fields 156 REAL(wp) :: zt_offset ! local time offset variable 162 157 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 163 158 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation … … 167 162 IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1 168 163 169 IF( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc170 ELSE ; it_offset = 0171 ENDIF 172 IF( PRESENT( kt_offset) ) it_offset = kt_offset173 174 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar175 IF( present(kit) ) THEN ! ignore kn_fsbc in this case176 isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) )164 IF( nn_components == jp_iam_sas ) THEN ; zt_offset = REAL( nn_fsbc, wp ) 165 ELSE ; zt_offset = 0. 166 ENDIF 167 IF( PRESENT(pt_offset) ) zt_offset = pt_offset 168 169 ! Note that all varibles starting by nsec_* are shifted time by +1/2 time step to be centrered 170 IF( PRESENT(kit) ) THEN ! ignore kn_fsbc in this case 171 isecsbc = nsec_year + nsec1jan000 + NINT( ( REAL( kit,wp) + zt_offset ) * rdt / REAL(nn_baro,wp) ) 177 172 ELSE ! middle of sbc time step 178 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt) 173 ! note: we use kn_fsbc-1 because nsec_year is defined at the middle of the current time step 174 isecsbc = nsec_year + nsec1jan000 + NINT( ( 0.5*REAL(kn_fsbc-1,wp) + zt_offset ) * rdt ) 179 175 ENDIF 180 176 imf = SIZE( sd ) … … 183 179 DO jf = 1, imf 184 180 IF( TRIM(sd(jf)%clrootname) == 'NOT USED' ) CYCLE 185 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped)181 CALL fld_init( isecsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 186 182 END DO 187 183 IF( lwp ) CALL wgt_print() ! control print … … 192 188 ! 193 189 DO jf = 1, imf ! --- loop over field --- ! 194 190 ! 195 191 IF( TRIM(sd(jf)%clrootname) == 'NOT USED' ) CYCLE 196 197 IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN ! read/update the after data? 198 199 sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:) ! swap before record informations 200 sd(jf)%rotn(1) = sd(jf)%rotn(2) ! swap before rotate informations 201 IF( sd(jf)%ln_tint ) sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) ! swap before record field 202 203 CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit ) ! update after record informations 204 205 ! if kn_fsbc*rdt is larger than freqh (which is kind of odd), 206 ! it is possible that the before value is no more the good one... we have to re-read it 207 ! if before is not the last record of the file currently opened and after is the first record to be read 208 ! in a new file which means after = 1 (the file to be opened corresponds to the current time) 209 ! or after = nreclast + 1 (the file to be opened corresponds to a future time step) 210 IF( .NOT. ll_firstcall .AND. sd(jf)%ln_tint .AND. sd(jf)%nrec_b(1) /= sd(jf)%nreclast & 211 & .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) == 1 ) THEN 212 itmp = sd(jf)%nrec_a(1) ! temporary storage 213 sd(jf)%nrec_a(1) = sd(jf)%nreclast ! read the last record of the file currently opened 214 CALL fld_get( sd(jf) ) ! read after data 215 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) ! re-swap before record field 216 sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1) ! update before record informations 217 sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%freqh * 3600. ) ! assume freq to be in hours in this case 218 sd(jf)%rotn(1) = sd(jf)%rotn(2) ! update before rotate informations 219 sd(jf)%nrec_a(1) = itmp ! move back to after record 220 ENDIF 221 222 CALL fld_clopn( sd(jf) ) ! Do we need to open a new year/month/week/day file? 223 224 IF( sd(jf)%ln_tint ) THEN 225 226 ! if kn_fsbc*rdt is larger than freqh (which is kind of odd), 227 ! it is possible that the before value is no more the good one... we have to re-read it 228 ! if before record is not just just before the after record... 229 IF( .NOT. ll_firstcall .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) /= 1 & 230 & .AND. sd(jf)%nrec_b(1) /= sd(jf)%nrec_a(1) - 1 ) THEN 231 sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - 1 ! move back to before record 232 CALL fld_get( sd(jf) ) ! read after data 233 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) ! re-swap before record field 234 sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1) ! update before record informations 235 sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%freqh * 3600. ) ! assume freq to be in hours in this case 236 sd(jf)%rotn(1) = sd(jf)%rotn(2) ! update before rotate informations 237 sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1 ! move back to after record 238 ENDIF 239 ENDIF ! temporal interpolation? 240 241 ! do we have to change the year/month/week/day of the forcing field?? 242 ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current 243 ! one. If so, we are still before the end of the year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) 244 ! will be larger than the record number that should be read for current year/month/week/day 245 ! do we need next file data? 246 ! This applies to both cases with or without time interpolation 247 IF( sd(jf)%nrec_a(1) > sd(jf)%nreclast ) THEN 248 249 sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - sd(jf)%nreclast ! 250 251 IF( .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) THEN ! close/open the current/new file 252 253 llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth) ! open next month file? 254 llnxtyr = sd(jf)%cltype == 'yearly' .OR. (nmonth == 12 .AND. llnxtmth) ! open next year file? 255 256 ! if the run finishes at the end of the current year/month/week/day, we will allow next 257 ! year/month/week/day file to be not present. If the run continue further than the current 258 ! year/month/week/day, next year/month/week/day file must exist 259 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdt) ! second at the end of the run 260 llstop = isecend > sd(jf)%nrec_a(2) ! read more than 1 record of next year 261 ! we suppose that the date of next file is next day (should be ok even for weekly files...) 262 CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr /)) , & 263 & nmonth + COUNT((/llnxtmth/)) - 12 * COUNT((/llnxtyr /)), & 264 & nday + 1 - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 265 266 IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN ! next year file does not exist 267 CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)// & 268 & ' not present -> back to current year/month/day') 269 CALL fld_clopn( sd(jf) ) ! back to the current year/month/day 270 sd(jf)%nrec_a(1) = sd(jf)%nreclast ! force to read the last record in the current year file 271 ENDIF 272 273 ENDIF 274 ENDIF ! open need next file? 275 276 ! read after data 277 CALL fld_get( sd(jf) ) 278 279 ENDIF ! read new data? 192 CALL fld_update( isecsbc, sd(jf) ) 193 ! 280 194 END DO ! --- end loop over field --- ! 281 195 … … 292 206 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 293 207 & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 294 WRITE(numout, *) ' it_offset is : ',it_offset208 WRITE(numout, *) ' zt_offset is : ',zt_offset 295 209 ENDIF 296 210 ! temporal interpolation weights … … 316 230 317 231 318 SUBROUTINE fld_init( k n_fsbc, sdjf )232 SUBROUTINE fld_init( ksecsbc, sdjf ) 319 233 !!--------------------------------------------------------------------- 320 234 !! *** ROUTINE fld_init *** 321 235 !! 322 !! ** Purpose : - first call to fld_recto define before values323 !! - if time interpolation, read before data324 !!---------------------------------------------------------------------- 325 INTEGER , INTENT(in ) :: k n_fsbc ! sbc computation period (in time step)236 !! ** Purpose : - first call(s) to fld_def to define before values 237 !! - open file 238 !!---------------------------------------------------------------------- 239 INTEGER , INTENT(in ) :: ksecsbc ! 326 240 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 327 !! 328 LOGICAL :: llprevyr ! are we reading previous year file? 329 LOGICAL :: llprevmth ! are we reading previous month file? 330 LOGICAL :: llprevweek ! are we reading previous week file? 331 LOGICAL :: llprevday ! are we reading previous day file? 332 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 333 INTEGER :: idvar ! variable id 334 INTEGER :: inrec ! number of record existing for this variable 335 INTEGER :: iyear, imonth, iday ! first day of the current file in yyyy mm dd 336 INTEGER :: isec_week ! number of seconds since start of the weekly file 337 CHARACTER(LEN=1000) :: clfmt ! write format 338 !!--------------------------------------------------------------------- 339 ! 340 llprevyr = .FALSE. 341 llprevmth = .FALSE. 342 llprevweek = .FALSE. 343 llprevday = .FALSE. 344 isec_week = 0 345 ! 346 ! define record informations 347 CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. ) ! return before values in sdjf%nrec_a (as we will swap it later) 348 ! 349 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 350 ! 351 IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure 352 ! 353 IF( sdjf%nrec_a(1) == 0 ) THEN ! we redefine record sdjf%nrec_a(1) with the last record of previous year file 354 IF ( NINT(sdjf%freqh) == -12 ) THEN ! yearly mean 355 IF( sdjf%cltype == 'yearly' ) THEN ! yearly file 356 sdjf%nrec_a(1) = 1 ! force to read the unique record 357 llprevyr = .NOT. sdjf%ln_clim ! use previous year file? 358 ELSE 359 CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clrootname) ) 360 ENDIF 361 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean 362 IF( sdjf%cltype == 'monthly' ) THEN ! monthly file 363 sdjf%nrec_a(1) = 1 ! force to read the unique record 364 llprevmth = .TRUE. ! use previous month file? 365 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 366 ELSE ! yearly file 367 sdjf%nrec_a(1) = 12 ! force to read december mean 368 llprevyr = .NOT. sdjf%ln_clim ! use previous year file? 369 ENDIF 370 ELSE ! higher frequency mean (in hours) 371 IF ( sdjf%cltype == 'monthly' ) THEN ! monthly file 372 sdjf%nrec_a(1) = NINT( 24. * REAL(nmonth_len(nmonth-1),wp) / sdjf%freqh )! last record of previous month 373 llprevmth = .TRUE. ! use previous month file? 374 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 375 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ! weekly file 376 llprevweek = .TRUE. ! use previous week file? 377 sdjf%nrec_a(1) = NINT( 24. * 7. / sdjf%freqh ) ! last record of previous week 378 isec_week = NINT(rday) * 7 ! add a shift toward previous week 379 ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 380 sdjf%nrec_a(1) = NINT( 24. / sdjf%freqh ) ! last record of previous day 381 llprevday = .TRUE. ! use previous day file? 382 llprevmth = llprevday .AND. nday == 1 ! use previous month file? 383 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 384 ELSE ! yearly file 385 sdjf%nrec_a(1) = NINT( 24. * REAL(nyear_len(0),wp) / sdjf%freqh ) ! last record of previous year 386 llprevyr = .NOT. sdjf%ln_clim ! use previous year file? 387 ENDIF 388 ENDIF 389 ENDIF 390 ! 391 IF( sdjf%cltype(1:4) == 'week' ) THEN 392 isec_week = isec_week + ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week 393 llprevmth = isec_week > nsec_month ! longer time since the beginning of the week than the month 394 llprevyr = llprevmth .AND. nmonth == 1 395 ENDIF 396 llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 397 ! 398 iyear = nyear - COUNT((/llprevyr /)) 399 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 400 iday = nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 401 ! 402 CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev ) 403 ! 404 ! if previous year/month/day file does not exist, we switch to the current year/month/day 405 IF( llprev .AND. sdjf%num <= 0 ) THEN 406 CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clrootname)// & 407 & ' not present -> back to current year/month/week/day' ) 408 ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day 409 llprev = .FALSE. 410 sdjf%nrec_a(1) = 1 411 CALL fld_clopn( sdjf ) 412 ENDIF 413 ! 414 IF( llprev ) THEN ! check if the record sdjf%nrec_a(1) exists in the file 415 idvar = iom_varid( sdjf%num, sdjf%clvar ) ! id of the variable sdjf%clvar 416 IF( idvar <= 0 ) RETURN 417 inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar ) ! size of the last dim of idvar 418 sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec ) ! make sure we select an existing record 419 ENDIF 420 ! 421 ! read before data in after arrays(as we will swap it later) 422 CALL fld_get( sdjf ) 423 ! 424 clfmt = "(' fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')" 425 IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 426 ! 427 ENDIF 241 !!--------------------------------------------------------------------- 242 ! 243 IF( nflag == 0 ) nflag = -( HUGE(0) - 10 ) 244 ! 245 CALL fld_def( sdjf ) 246 IF( sdjf%ln_tint .AND. ksecsbc < sdjf%nrecsec(1) ) CALL fld_def( sdjf, ldprev = .TRUE. ) 247 ! 248 CALL fld_clopn( sdjf ) 249 sdjf%nrec_a(:) = (/ 1, nflag /) ! default definition to force flp_update to read the file. 428 250 ! 429 251 END SUBROUTINE fld_init 430 252 431 253 432 SUBROUTINE fld_ rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset)433 !!--------------------------------------------------------------------- 434 !! *** ROUTINE fld_ rec***254 SUBROUTINE fld_update( ksecsbc, sdjf ) 255 !!--------------------------------------------------------------------- 256 !! *** ROUTINE fld_update *** 435 257 !! 436 258 !! ** Purpose : Compute … … 441 263 !! nrec_b(2) and nrec_a(2): time of the beginning and end of the record 442 264 !!---------------------------------------------------------------------- 443 INTEGER , INTENT(in ) :: k n_fsbc ! sbc computation period (in time step)265 INTEGER , INTENT(in ) :: ksecsbc ! 444 266 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 445 LOGICAL , INTENT(in ), OPTIONAL :: ldbefore ! sent back before record values (default = .FALSE.) 446 INTEGER , INTENT(in ), OPTIONAL :: kit ! index of barotropic subcycle 447 ! ! used only if sdjf%ln_tint = .TRUE. 448 INTEGER , INTENT(in ), OPTIONAL :: kt_offset ! Offset of required time level compared to "now" 449 ! ! time level in units of time steps. 450 ! 451 LOGICAL :: llbefore ! local definition of ldbefore 452 INTEGER :: iendrec ! end of this record (in seconds) 453 INTEGER :: imth ! month number 454 INTEGER :: ifreq_sec ! frequency mean (in seconds) 455 INTEGER :: isec_week ! number of seconds since the start of the weekly file 456 INTEGER :: it_offset ! local time offset variable 457 REAL(wp) :: ztmp ! temporary variable 458 !!---------------------------------------------------------------------- 459 ! 460 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 461 ! 462 IF( PRESENT(ldbefore) ) THEN ; llbefore = ldbefore .AND. sdjf%ln_tint ! needed only if sdjf%ln_tint = .TRUE. 463 ELSE ; llbefore = .FALSE. 464 ENDIF 465 ! 466 IF( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 467 ELSE ; it_offset = 0 468 ENDIF 469 IF( PRESENT(kt_offset) ) it_offset = kt_offset 470 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 471 ELSE ; it_offset = it_offset * NINT( rdt ) 472 ENDIF 473 ! 474 ! ! =========== ! 475 IF ( NINT(sdjf%freqh) == -12 ) THEN ! yearly mean 476 ! ! =========== ! 477 ! 478 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 479 ! 480 ! INT( ztmp ) 481 ! /|\ 482 ! 1 | *---- 483 ! 0 |----( 484 ! |----+----|--> time 485 ! 0 /|\ 1 (nday/nyear_len(1)) 486 ! | 487 ! | 488 ! forcing record : 1 489 ! 490 ztmp = REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 & 491 & + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday ) 492 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 493 ! swap at the middle of the year 494 IF( llbefore ) THEN ; sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + & 495 & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1) 496 ELSE ; sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + & 497 & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2) 267 ! 268 INTEGER :: ja ! end of this record (in seconds) 269 !!---------------------------------------------------------------------- 270 ! 271 IF( ksecsbc > sdjf%nrec_a(2) ) THEN ! --> we need to update after data 272 273 ! find where is the new after record... (it is not necessary sdjf%nrec_a(1)+1 ) 274 ja = sdjf%nrec_a(1) 275 DO WHILE ( ksecsbc >= sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast ) ! Warning: make sure ja <= sdjf%nreclast in this test 276 ja = ja + 1 277 END DO 278 IF( ksecsbc > sdjf%nrecsec(ja) ) ja = ja + 1 ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast) 279 280 ! if ln_tint and if the new after is not ja+1, we need also to update after data before the swap 281 ! so, after the swap, sdjf%nrec_b(2) will still be the closest value located just before ksecsbc 282 IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec_a(1) + 1 .OR. sdjf%nrec_a(2) == nflag ) ) THEN 283 sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! update nrec_a with before information 284 CALL fld_get( sdjf ) ! read after data that will be used as before data 285 ENDIF 286 287 ! if after is in the next file... 288 IF( ja > sdjf%nreclast ) THEN 289 290 CALL fld_def( sdjf ) 291 IF( ksecsbc > sdjf%nrecsec(sdjf%nreclast) ) CALL fld_def( sdjf, ldnext = .TRUE. ) 292 CALL fld_clopn( sdjf ) ! open next file 293 294 ! find where is after in this new file 295 ja = 1 296 DO WHILE ( ksecsbc > sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast ) 297 ja = ja + 1 298 END DO 299 IF( ksecsbc > sdjf%nrecsec(ja) ) ja = ja + 1 ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast) 300 301 IF( ja > sdjf%nreclast ) THEN 302 CALL ctl_stop( "STOP", "fld_def: need next-next file? we should not be there... file: "//TRIM(sdjf%clrootname) ) 498 303 ENDIF 499 ELSE ! no time interpolation 500 sdjf%nrec_a(1) = 1 501 sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000 ! swap at the end of the year 502 sdjf%nrec_b(2) = nsec1jan000 ! beginning of the year (only for print) 503 ENDIF 504 ! 505 ! ! ============ ! 506 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean ! 507 ! ! ============ ! 508 ! 509 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 510 ! 511 ! INT( ztmp ) 512 ! /|\ 513 ! 1 | *---- 514 ! 0 |----( 515 ! |----+----|--> time 516 ! 0 /|\ 1 (nday/nmonth_len(nmonth)) 517 ! | 518 ! | 519 ! forcing record : nmonth 520 ! 521 ztmp = REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 & 522 & + REAL( it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) 523 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 524 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 525 ELSE ; sdjf%nrec_a(1) = imth 304 305 ! if ln_tint and if after is not the first record, we must (potentially again) update after data before the swap 306 IF( sdjf%ln_tint .AND. ja > 1 ) THEN 307 IF( sdjf%nrecsec(0) /= nflag ) THEN ! no trick used: after file is not the current file 308 sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! update nrec_a with before information 309 CALL fld_get( sdjf ) ! read after data that will be used as before data 310 ENDIF 526 311 ENDIF 527 sdjf%nrec_a(2) = nmonth_half( imth ) + nsec1jan000 ! swap at the middle of the month 528 ELSE ! no time interpolation 529 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 530 ELSE ; sdjf%nrec_a(1) = nmonth 531 ENDIF 532 sdjf%nrec_a(2) = nmonth_end(nmonth ) + nsec1jan000 ! swap at the end of the month 533 sdjf%nrec_b(2) = nmonth_end(nmonth-1) + nsec1jan000 ! beginning of the month (only for print) 534 ENDIF 535 ! 536 ! ! ================================ ! 537 ELSE ! higher frequency mean (in hours) 538 ! ! ================================ ! 539 ! 540 ifreq_sec = NINT( sdjf%freqh * 3600. ) ! frequency mean (in seconds) 541 IF( sdjf%cltype(1:4) == 'week' ) isec_week = ksec_week( sdjf%cltype(6:8) ) ! since the first day of the current week 542 ! number of second since the beginning of the file 543 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month,wp) ! since the first day of the current month 544 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; ztmp = REAL(isec_week ,wp) ! since the first day of the current week 545 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 546 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 547 ENDIF 548 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdt + REAL( it_offset, wp ) ! centrered in the middle of sbc time step 549 ztmp = ztmp + 0.01 * rdt ! avoid truncation error 550 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 551 ! 552 ! INT( ztmp/ifreq_sec + 0.5 ) 553 ! /|\ 554 ! 2 | *-----( 555 ! 1 | *-----( 556 ! 0 |--( 557 ! |--+--|--+--|--+--|--> time 558 ! 0 /|\ 1 /|\ 2 /|\ 3 (ztmp/ifreq_sec) 559 ! | | | 560 ! | | | 561 ! forcing record : 1 2 3 562 ! 563 ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5 564 ELSE ! no time interpolation 565 ! 566 ! INT( ztmp/ifreq_sec ) 567 ! /|\ 568 ! 2 | *-----( 569 ! 1 | *-----( 570 ! 0 |-----( 571 ! |--+--|--+--|--+--|--> time 572 ! 0 /|\ 1 /|\ 2 /|\ 3 (ztmp/ifreq_sec) 573 ! | | | 574 ! | | | 575 ! forcing record : 1 2 3 576 ! 577 ztmp= ztmp / REAL(ifreq_sec, wp) 578 ENDIF 579 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) ! record number to be read 580 581 iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000 ! end of this record (in second) 582 ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1) 583 IF( sdjf%cltype == 'monthly' ) iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1)) 584 IF( sdjf%cltype(1:4) == 'week' ) iendrec = iendrec + ( nsec_year - isec_week ) 585 IF( sdjf%cltype == 'daily' ) iendrec = iendrec + NINT(rday) * ( nday_year - 1 ) 586 IF( sdjf%ln_tint ) THEN 587 sdjf%nrec_a(2) = iendrec - ifreq_sec / 2 ! swap at the middle of the record 312 313 ENDIF 314 315 IF( sdjf%ln_tint ) THEN 316 ! Swap data 317 sdjf%nrec_b(:) = sdjf%nrec_a(:) ! swap before record informations 318 sdjf%rotn(1) = sdjf%rotn(2) ! swap before rotate informations 319 sdjf%fdta(:,:,:,1) = sdjf%fdta(:,:,:,2) ! swap before record field 588 320 ELSE 589 sdjf%nrec_a(2) = iendrec ! swap at the end of the record 590 sdjf%nrec_b(2) = iendrec - ifreq_sec ! beginning of the record (only for print) 591 ENDIF 592 ! 593 ENDIF 594 ! 595 IF( .NOT. sdjf%ln_tint ) sdjf%nrec_a(2) = sdjf%nrec_a(2) - 1 ! last second belongs to bext record : *----( 596 ! 597 END SUBROUTINE fld_rec 321 sdjf%nrec_b(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! only for print 322 ENDIF 323 324 ! read new after data 325 sdjf%nrec_a(:) = (/ ja, sdjf%nrecsec(ja) /) ! update nrec_a as it is used by fld_get 326 CALL fld_get( sdjf ) ! read after data (with nrec_a informations) 327 328 ENDIF 329 ! 330 END SUBROUTINE fld_update 598 331 599 332 … … 1030 763 sd(ju)%fdta(:,:,jk,jn) = utmp(:,:) ; sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:) 1031 764 ELSE 1032 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk), 'T', 'en->i', utmp(:,:) )1033 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk), 'T', 'en->j', vtmp(:,:) )765 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->i', utmp(:,:) ) 766 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->j', vtmp(:,:) ) 1034 767 sd(ju)%fnow(:,:,jk ) = utmp(:,:) ; sd(iv)%fnow(:,:,jk ) = vtmp(:,:) 1035 768 ENDIF … … 1047 780 1048 781 1049 SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop ) 782 SUBROUTINE fld_def( sdjf, ldprev, ldnext ) 783 !!--------------------------------------------------------------------- 784 !! *** ROUTINE fld_def *** 785 !! 786 !! ** Purpose : define the record(s) of the file and its name 787 !!---------------------------------------------------------------------- 788 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables 789 LOGICAL, OPTIONAL, INTENT(in ) :: ldprev ! 790 LOGICAL, OPTIONAL, INTENT(in ) :: ldnext ! 791 ! 792 INTEGER :: jt 793 INTEGER :: idaysec ! number of seconds in 1 day = NINT(rday) 794 INTEGER :: iyr, imt, idy, isecwk 795 INTEGER :: indexyr, indexmt 796 INTEGER :: ireclast 797 INTEGER :: ishift, istart 798 INTEGER, DIMENSION(2) :: isave 799 REAL(wp) :: zfreqs 800 LOGICAL :: llprev, llnext, llstop 801 LOGICAL :: llprevmt, llprevyr 802 LOGICAL :: llnextmt, llnextyr 803 !!---------------------------------------------------------------------- 804 idaysec = NINT(rday) 805 ! 806 IF( PRESENT(ldprev) ) THEN ; llprev = ldprev 807 ELSE ; llprev = .FALSE. 808 ENDIF 809 IF( PRESENT(ldnext) ) THEN ; llnext = ldnext 810 ELSE ; llnext = .FALSE. 811 ENDIF 812 813 ! current file parameters 814 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the current week 815 isecwk = ksec_week( sdjf%cltype(6:8) ) ! seconds between the beginning of the week and half of current time step 816 llprevmt = isecwk > nsec_month ! longer time since beginning of the current week than the current month 817 llprevyr = llprevmt .AND. nmonth == 1 818 iyr = nyear - COUNT((/llprevyr/)) 819 imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 820 idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 821 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and current week beginning 822 ELSE 823 iyr = nyear 824 imt = nmonth 825 idy = nday 826 isecwk = 0 827 ENDIF 828 829 ! previous file parameters 830 IF( llprev ) THEN 831 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of previous week 832 isecwk = isecwk + 7 * idaysec ! seconds between the beginning of previous week and half of the time step 833 llprevmt = isecwk > nsec_month ! longer time since beginning of the previous week than the current month 834 llprevyr = llprevmt .AND. nmonth == 1 835 iyr = nyear - COUNT((/llprevyr/)) 836 imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 837 idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 838 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and previous week beginning 839 ELSE 840 idy = nday - COUNT((/ sdjf%cltype == 'daily' /)) 841 imt = nmonth - COUNT((/ sdjf%cltype == 'monthly' .OR. idy == 0 /)) 842 iyr = nyear - COUNT((/ sdjf%cltype == 'yearly' .OR. imt == 0 /)) 843 IF( idy == 0 ) idy = nmonth_len(imt) 844 IF( imt == 0 ) imt = 12 845 isecwk = 0 846 ENDIF 847 ENDIF 848 849 ! next file parameters 850 IF( llnext ) THEN 851 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of next week 852 isecwk = 7 * idaysec - isecwk ! seconds between half of the time step and the beginning of next week 853 llnextmt = isecwk > ( nmonth_len(nmonth)*idaysec - nsec_month ) ! larger than the seconds to the end of the month 854 llnextyr = llnextmt .AND. nmonth == 12 855 iyr = nyear + COUNT((/llnextyr/)) 856 imt = nmonth + COUNT((/llnextmt/)) - 12 * COUNT((/llnextyr/)) 857 idy = nday - nmonth_len(nmonth) * COUNT((/llnextmt/)) + isecwk / idaysec + 1 858 isecwk = nsec_year + isecwk ! seconds between 00h jan 1st of current year and next week beginning 859 ELSE 860 idy = nday + COUNT((/ sdjf%cltype == 'daily' /)) 861 imt = nmonth + COUNT((/ sdjf%cltype == 'monthly' .OR. idy > nmonth_len(nmonth) /)) 862 iyr = nyear + COUNT((/ sdjf%cltype == 'yearly' .OR. imt == 13 /)) 863 IF( idy > nmonth_len(nmonth) ) idy = 1 864 IF( imt == 13 ) imt = 1 865 isecwk = 0 866 ENDIF 867 ENDIF 868 ! 869 ! find the last record to be read -> update sdjf%nreclast 870 indexyr = iyr - nyear + 1 ! which year are we looking for? previous(0), current(1) or next(2)? 871 indexmt = imt + 12 * ( indexyr - 1 ) ! which month are we looking for (relatively to current year)? 872 ! 873 ! Last record to be read in the current file 874 ! Predefine the number of record in the file according of its type. 875 ! We could compare this number with the number of records in the file and make a stop if the 2 numbers do not match... 876 ! However this would be much less fexible (e.g. for tests) and will force to rewite input files according to nleapy... 877 IF ( NINT(sdjf%freqh) == -12 ) THEN ; ireclast = 1 ! yearly mean: consider only 1 record 878 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean: 879 IF( sdjf%cltype == 'monthly' ) THEN ; ireclast = 1 ! consider that the file has 1 record 880 ELSE ; ireclast = 12 ! consider that the file has 12 record 881 ENDIF 882 ELSE ! higher frequency mean (in hours) 883 IF( sdjf%cltype == 'monthly' ) THEN ; ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh ) 884 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; ireclast = NINT( 24. * 7. / sdjf%freqh ) 885 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ireclast = NINT( 24. / sdjf%freqh ) 886 ELSE ; ireclast = NINT( 24. * REAL( nyear_len(indexyr), wp) / sdjf%freqh ) 887 ENDIF 888 ENDIF 889 890 sdjf%nreclast = ireclast 891 ! Allocate arrays for beginning/middle/end of each record (seconds since Jan. 1st 00h of nit000 year) 892 IF( ALLOCATED(sdjf%nrecsec) ) DEALLOCATE( sdjf%nrecsec ) 893 ALLOCATE( sdjf%nrecsec( 0:ireclast ) ) 894 ! 895 IF ( NINT(sdjf%freqh) == -12 ) THEN ! yearly mean and yearly file 896 SELECT CASE( indexyr ) 897 CASE(0) ; sdjf%nrecsec(0) = nsec1jan000 - nyear_len( 0 ) * idaysec 898 CASE(1) ; sdjf%nrecsec(0) = nsec1jan000 899 CASE(2) ; sdjf%nrecsec(0) = nsec1jan000 + nyear_len( 1 ) * idaysec 900 ENDSELECT 901 sdjf%nrecsec(1) = sdjf%nrecsec(0) + nyear_len( indexyr ) * idaysec 902 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean: 903 IF( sdjf%cltype == 'monthly' ) THEN ! monthly file 904 sdjf%nrecsec(0 ) = nsec1jan000 + nmonth_beg(indexmt ) 905 sdjf%nrecsec(1 ) = nsec1jan000 + nmonth_beg(indexmt+1) 906 ELSE ! yearly file 907 ishift = 12 * ( indexyr - 1 ) 908 sdjf%nrecsec(0:12) = nsec1jan000 + nmonth_beg(1+ishift:13+ishift) 909 ENDIF 910 ELSE ! higher frequency mean (in hours) 911 IF( sdjf%cltype == 'monthly' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) 912 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; istart = nsec1jan000 + isecwk 913 ELSEIF( sdjf%cltype == 'daily' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec 914 ELSEIF( indexyr == 0 ) THEN ; istart = nsec1jan000 - nyear_len( 0 ) * idaysec 915 ELSEIF( indexyr == 2 ) THEN ; istart = nsec1jan000 + nyear_len( 1 ) * idaysec 916 ELSE ; istart = nsec1jan000 917 ENDIF 918 zfreqs = sdjf%freqh * rhhmm * rmmss 919 DO jt = 0, sdjf%nreclast 920 sdjf%nrecsec(jt) = istart + NINT( zfreqs * REAL(jt,wp) ) 921 END DO 922 ENDIF 923 ! 924 IF( sdjf%ln_tint ) THEN ! record time defined in the middle of the record 925 sdjf%nrecsec(1:sdjf%nreclast) = 0.5 * ( sdjf%nrecsec(0:sdjf%nreclast-1) + sdjf%nrecsec(1:sdjf%nreclast) ) 926 END IF 927 ! 928 sdjf%clname = fld_filename( sdjf, idy, imt, iyr ) 929 ! 930 END SUBROUTINE fld_def 931 932 933 SUBROUTINE fld_clopn( sdjf ) 1050 934 !!--------------------------------------------------------------------- 1051 935 !! *** ROUTINE fld_clopn *** 1052 936 !! 1053 !! ** Purpose : update the file name and close/open the files 1054 !!---------------------------------------------------------------------- 1055 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables 1056 INTEGER, OPTIONAL, INTENT(in ) :: kyear ! year value 1057 INTEGER, OPTIONAL, INTENT(in ) :: kmonth ! month value 1058 INTEGER, OPTIONAL, INTENT(in ) :: kday ! day value 1059 LOGICAL, OPTIONAL, INTENT(in ) :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 1060 ! 1061 LOGICAL :: llprevyr ! are we reading previous year file? 1062 LOGICAL :: llprevmth ! are we reading previous month file? 1063 INTEGER :: iyear, imonth, iday ! first day of the current file in yyyy mm dd 1064 INTEGER :: isec_week ! number of seconds since start of the weekly file 1065 INTEGER :: indexyr ! year undex (O/1/2: previous/current/next) 1066 REAL(wp) :: zyear_len, zmonth_len ! length (days) of iyear and imonth ! 1067 CHARACTER(len = 256) :: clname ! temporary file name 1068 !!---------------------------------------------------------------------- 1069 IF( PRESENT(kyear) ) THEN ! use given values 1070 iyear = kyear 1071 imonth = kmonth 1072 iday = kday 1073 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the week 1074 isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 ) 1075 llprevmth = isec_week > nsec_month ! longer time since beginning of the week than the month 1076 llprevyr = llprevmth .AND. nmonth == 1 1077 iyear = nyear - COUNT((/llprevyr /)) 1078 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 1079 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 1080 ENDIF 1081 ELSE ! use current day values 1082 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the week 1083 isec_week = ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week 1084 llprevmth = isec_week > nsec_month ! longer time since beginning of the week than the month 1085 llprevyr = llprevmth .AND. nmonth == 1 1086 ELSE 1087 isec_week = 0 1088 llprevmth = .FALSE. 1089 llprevyr = .FALSE. 1090 ENDIF 1091 iyear = nyear - COUNT((/llprevyr /)) 1092 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 1093 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 1094 ENDIF 1095 1096 ! build the new filename if not climatological data 1097 clname=TRIM(sdjf%clrootname) 1098 ! 1099 ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name 1100 IF( .NOT. sdjf%ln_clim ) THEN 1101 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), iyear ! add year 1102 IF( sdjf%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), imonth ! add month 1103 ELSE 1104 ! build the new filename if climatological data 1105 IF( sdjf%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), imonth ! add month 1106 ENDIF 1107 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 1108 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), iday ! add day 1109 ! 1110 IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN ! new file to be open 1111 ! 1112 sdjf%clname = TRIM(clname) 1113 IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open 1114 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 1115 ! 1116 ! find the last record to be read -> update sdjf%nreclast 1117 indexyr = iyear - nyear + 1 1118 zyear_len = REAL(nyear_len( indexyr ), wp) 1119 SELECT CASE ( indexyr ) 1120 CASE ( 0 ) ; zmonth_len = 31. ! previous year -> imonth = 12 1121 CASE ( 1 ) ; zmonth_len = REAL(nmonth_len(imonth), wp) 1122 CASE ( 2 ) ; zmonth_len = 31. ! next year -> imonth = 1 1123 END SELECT 1124 ! 1125 ! last record to be read in the current file 1126 IF ( sdjf%freqh == -12. ) THEN ; sdjf%nreclast = 1 ! yearly mean 1127 ELSEIF( sdjf%freqh == -1. ) THEN ! monthly mean 1128 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nreclast = 1 1129 ELSE ; sdjf%nreclast = 12 1130 ENDIF 1131 ELSE ! higher frequency mean (in hours) 1132 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nreclast = NINT( 24. * zmonth_len / sdjf%freqh ) 1133 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; sdjf%nreclast = NINT( 24. * 7. / sdjf%freqh ) 1134 ELSEIF( sdjf%cltype == 'daily' ) THEN ; sdjf%nreclast = NINT( 24. / sdjf%freqh ) 1135 ELSE ; sdjf%nreclast = NINT( 24. * zyear_len / sdjf%freqh ) 1136 ENDIF 1137 ENDIF 937 !! ** Purpose : close/open the files 938 !!---------------------------------------------------------------------- 939 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables 940 ! 941 INTEGER, DIMENSION(2) :: isave 942 LOGICAL :: llprev, llnext, llstop 943 !!---------------------------------------------------------------------- 944 ! 945 llprev = sdjf%nrecsec(sdjf%nreclast) < nsec000_1jan000 ! file ends before the beginning of the job -> file may not exist 946 llnext = sdjf%nrecsec( 0 ) > nsecend_1jan000 ! file begins after the end of the job -> file may not exist 947 948 llstop = sdjf%ln_clim .OR. .NOT. ( llprev .OR. llnext ) 949 950 IF( sdjf%num <= 0 .OR. .NOT. sdjf%ln_clim ) THEN 951 IF( sdjf%num > 0 ) CALL iom_close( sdjf%num ) ! close file if already open 952 CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 953 ENDIF 954 ! 955 IF( sdjf%num <= 0 .AND. .NOT. llstop ) THEN ! file not found but we do accept this... 956 ! 957 IF( llprev ) THEN ! previous file does not exist : go back to current and accept to read only the first record 958 CALL ctl_warn('previous file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file') 959 isave(1:2) = sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) ! save previous file info 960 CALL fld_def( sdjf ) ! go back to current file 961 sdjf%nreclast = 1 ! force to use only the first record (do as if other were not existing...) 962 sdjf%nrecsec(0:1) = isave(1:2) 963 ENDIF 964 ! 965 IF( llnext ) THEN ! next file does not exist : go back to current and accept to read only the last record 966 CALL ctl_warn('next file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file') 967 isave(1:2) = sdjf%nrecsec(0:1) ! save next file info 968 CALL fld_def( sdjf ) ! go back to current file 969 ! -> read last record but keep record info from the first record of next file 970 sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) = isave(1:2) 971 sdjf%nrecsec(0:sdjf%nreclast-2) = nflag 972 ENDIF 973 ! 974 CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 1138 975 ! 1139 976 ENDIF … … 1317 1154 CALL iom_open( sd%clname, inum, ldiof = LEN(TRIM(sd%wgtname)) > 0 ) 1318 1155 1319 !! get dimensions 1320 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1321 !IF( SIZE(sd%fnow, 3) > 1 ) THEN 1156 !! get dimensions: we consider 2D data as 3D data with vertical dim size = 1 1322 1157 IF( SIZE(sd%fnow, 3) > 0 ) THEN 1323 1158 ALLOCATE( ddims(4) ) … … 1642 1477 1643 1478 ref_wgts(kw)%fly_dta(:,:,:) = 0.0 1644 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1645 !SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 1646 !CASE(1) 1647 ! CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 1648 !CASE DEFAULT 1649 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 1650 !END SELECT 1479 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 1651 1480 ENDIF 1652 1481 … … 1692 1521 IF( jpi1 == 2 ) THEN 1693 1522 rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap 1694 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1695 !SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 1696 !CASE(1) 1697 ! CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 1698 !CASE DEFAULT 1699 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 1700 !END SELECT 1523 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 1701 1524 ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 1702 1525 ENDIF 1703 1526 IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 1704 1527 rec1(1) = 1 + ref_wgts(kw)%overlap 1705 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1706 !SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 1707 !CASE(1) 1708 ! CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn) 1709 !CASE DEFAULT 1710 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 1711 !END SELECT 1528 CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 1712 1529 ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 1713 1530 ENDIF … … 1756 1573 1757 1574 1575 FUNCTION fld_filename( sdjf, kday, kmonth, kyear ) 1576 !!--------------------------------------------------------------------- 1577 !! *** FUNCTION fld_filename *** 1578 !! 1579 !! ** Purpose : define the filename according to a given date 1580 !!--------------------------------------------------------------------- 1581 TYPE(FLD), INTENT(in) :: sdjf ! input field related variables 1582 INTEGER , INTENT(in) :: kday, kmonth, kyear 1583 ! 1584 CHARACTER(len = 256) :: clname, fld_filename 1585 !!--------------------------------------------------------------------- 1586 1587 1588 ! build the new filename if not climatological data 1589 clname=TRIM(sdjf%clrootname) 1590 ! 1591 ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name 1592 IF( .NOT. sdjf%ln_clim ) THEN 1593 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 1594 IF( sdjf%cltype /= 'yearly' ) WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname ), kmonth ! add month 1595 ELSE 1596 ! build the new filename if climatological data 1597 IF( sdjf%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 1598 ENDIF 1599 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 1600 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), kday ! add day 1601 1602 fld_filename = clname 1603 1604 END FUNCTION fld_filename 1605 1606 1758 1607 FUNCTION ksec_week( cdday ) 1759 1608 !!--------------------------------------------------------------------- 1760 !! *** FUNCTION ks hift_week ***1761 !! 1762 !! ** Purpose : return the first 3 letters of the first day of the weekly file1609 !! *** FUNCTION ksec_week *** 1610 !! 1611 !! ** Purpose : seconds between 00h of the beginning of the week and half of the current time step 1763 1612 !!--------------------------------------------------------------------- 1764 1613 CHARACTER(len=*), INTENT(in) :: cdday ! first 3 letters of the first day of the weekly file … … 1776 1625 ishift = ijul * NINT(rday) 1777 1626 ! 1778 ksec_week = nsec_ week+ ishift1627 ksec_week = nsec_monday + ishift 1779 1628 ksec_week = MOD( ksec_week, 7*NINT(rday) ) 1780 1629 ! -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/step.F90
r12184 r12246 114 114 IF( ln_tide ) CALL tide_update( kstp ) ! update tide potential 115 115 IF( ln_apr_dyn ) CALL sbc_apr ( kstp ) ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 116 IF( ln_bdy ) CALL bdy_dta ( kstp, kt_offset = +1) ! update dynamic & tracer data at open boundaries116 IF( ln_bdy ) CALL bdy_dta ( kstp, pt_offset = 1. ) ! update dynamic & tracer data at open boundaries 117 117 IF( ln_isf ) CALL isf_stp ( kstp ) ! ice shelf/ocean boundary condition 118 118 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OFF/dtadyn.F90
r12210 r12246 279 279 ! Open file for each variable to get his number of dimension 280 280 DO ifpr = 1, jfld 281 CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 281 CALL fld_def( sf_dyn(ifpr) ) 282 CALL iom_open( sf_dyn(ifpr)%clname, sf_dyn(ifpr)%num ) 282 283 idv = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 283 284 idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv) ! number of dimension for variable sdjf%clvar 284 IF( sf_dyn(ifpr)%num /= 0 ) CALL iom_close( sf_dyn(ifpr)%num )! close file if already open285 CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 285 286 ierr1=0 286 287 IF( idimv == 3 ) THEN ! 2D variable … … 504 505 ! Open file for each variable to get his number of dimension 505 506 DO ifpr = 1, jfld 506 CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 507 CALL fld_def( sf_dyn(ifpr) ) 508 CALL iom_open( sf_dyn(ifpr)%clname, sf_dyn(ifpr)%num ) 507 509 idv = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 508 510 idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv) ! number of dimension for variable sdjf%clvar 509 IF( sf_dyn(ifpr)%num /= 0 ) CALL iom_close( sf_dyn(ifpr)%num )! close file if already open511 CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 510 512 ierr1=0 511 513 IF( idimv == 3 ) THEN ! 2D variable -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/SAS/step.F90
r11536 r12246 96 96 ! From SAS: ocean bdy data are wrong (but we do not care) and ice bdy data are OK. 97 97 ! This is not clean and should be changed in the future. 98 IF( ln_bdy ) CALL bdy_dta ( kstp, kt_offset=+1) ! update dynamic & tracer data at open boundaries98 IF( ln_bdy ) CALL bdy_dta ( kstp, pt_offset=1. ) ! update dynamic & tracer data at open boundaries 99 99 ! ==> 100 100 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) -
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/TOP/trcbc.F90
r12209 r12246 364 364 IF( PRESENT(jit) ) THEN 365 365 ! 366 ! OPEN boundary conditions (use kt_offset=+1as they are applied at the end of the step)366 ! OPEN boundary conditions (use pt_offset=1. as they are applied at the end of the step) 367 367 IF( nb_trcobc > 0 ) THEN 368 368 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 369 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, kt_offset=+1)369 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kit=jit, pt_offset=1.) 370 370 ENDIF 371 371 ! … … 384 384 ELSE 385 385 ! 386 ! OPEN boundary conditions (use kt_offset=+1as they are applied at the end of the step)386 ! OPEN boundary conditions (use pt_offset=1. as they are applied at the end of the step) 387 387 IF( nb_trcobc > 0 ) THEN 388 388 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 389 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, kt_offset=+1)389 CALL fld_read( kt=kt, kn_fsbc=1, sd=sf_trcobc, pt_offset=1.) 390 390 ENDIF 391 391 !
Note: See TracChangeset
for help on using the changeset viewer.