Changeset 12116 for NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/SBC
- Timestamp:
- 2019-12-09T08:53:27+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/SBC/fldread.F90
r11536 r12116 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 … … 150 153 ! ! etc. 151 154 !! 152 INTEGER :: itmp ! local variable153 155 INTEGER :: imf ! size of the structure sd 154 156 INTEGER :: jf ! dummy indices 155 INTEGER :: isecend ! number of second since Jan. 1st 00h of nit000 year at nitend156 157 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 158 LOGICAL :: ll_firstcall ! true if this is the first call to fld_read for this set of fields 159 REAL(wp) :: zt_offset ! local time offset variable 162 160 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 163 161 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation … … 167 165 IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1 168 166 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) )167 IF ( nn_components == jp_iam_sas ) THEN ; zt_offset = REAL( nn_fsbc, wp ) 168 ELSE ; zt_offset = 0. 169 ENDIF 170 IF( PRESENT(kt_offset) ) zt_offset = REAL( kt_offset, wp ) 171 172 ! Note that all varibles starting by nsec_* are shifted time by +1/2 time step to be centrered 173 IF( PRESENT(kit) ) THEN ! ignore kn_fsbc in this case 174 isecsbc = nsec_year + nsec1jan000 + NINT( ( REAL( kit,wp) + zt_offset ) * rdt / REAL(nn_baro,wp) ) 177 175 ELSE ! middle of sbc time step 178 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdt) + it_offset * NINT(rdt) 176 ! note: we use kn_fsbc-1 because nsec_year is defined at the middle of the current time step 177 isecsbc = nsec_year + nsec1jan000 + NINT( ( 0.5*REAL(kn_fsbc-1,wp) + zt_offset ) * rdt ) 179 178 ENDIF 180 179 imf = SIZE( sd ) … … 183 182 DO jf = 1, imf 184 183 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)184 CALL fld_init( isecsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 186 185 END DO 187 186 IF( lwp ) CALL wgt_print() ! control print … … 192 191 ! 193 192 DO jf = 1, imf ! --- loop over field --- ! 194 193 ! 195 194 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? 195 CALL fld_update( isecsbc, sd(jf) ) 196 ! 280 197 END DO ! --- end loop over field --- ! 281 198 … … 292 209 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 293 210 & 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_offset211 WRITE(numout, *) ' zt_offset is : ',zt_offset 295 212 ENDIF 296 213 ! temporal interpolation weights … … 316 233 317 234 318 SUBROUTINE fld_init( k n_fsbc, sdjf )235 SUBROUTINE fld_init( ksecsbc, sdjf ) 319 236 !!--------------------------------------------------------------------- 320 237 !! *** ROUTINE fld_init *** 321 238 !! 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)239 !! ** Purpose : - first call(s) to fld_def to define before values 240 !! - open file 241 !!---------------------------------------------------------------------- 242 INTEGER , INTENT(in ) :: ksecsbc ! 326 243 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 244 !!--------------------------------------------------------------------- 245 ! 246 IF( nflag == 0 ) nflag = -( HUGE(0) - 10 ) 247 ! 248 CALL fld_def( sdjf ) 249 IF( sdjf%ln_tint .AND. ksecsbc < sdjf%nrecsec(1) ) CALL fld_def( sdjf, ldprev = .TRUE. ) 250 ! 251 CALL fld_clopn( sdjf ) 252 sdjf%nrec_a(:) = (/ 1, nflag /) ! default definition to force flp_update to read the file. 428 253 ! 429 254 END SUBROUTINE fld_init 430 255 431 256 432 SUBROUTINE fld_ rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset)433 !!--------------------------------------------------------------------- 434 !! *** ROUTINE fld_ rec***257 SUBROUTINE fld_update( ksecsbc, sdjf ) 258 !!--------------------------------------------------------------------- 259 !! *** ROUTINE fld_update *** 435 260 !! 436 261 !! ** Purpose : Compute … … 441 266 !! nrec_b(2) and nrec_a(2): time of the beginning and end of the record 442 267 !!---------------------------------------------------------------------- 443 INTEGER , INTENT(in ) :: k n_fsbc ! sbc computation period (in time step)268 INTEGER , INTENT(in ) :: ksecsbc ! 444 269 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) 270 ! 271 INTEGER :: ja ! end of this record (in seconds) 272 !!---------------------------------------------------------------------- 273 ! 274 IF( ksecsbc > sdjf%nrec_a(2) ) THEN ! --> we need to update after data 275 276 ! find where is the new after record... (it is not necessary sdjf%nrec_a(1)+1 ) 277 ja = sdjf%nrec_a(1) 278 DO WHILE ( ksecsbc >= sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast ) ! Warning: make sure ja <= sdjf%nreclast in this test 279 ja = ja + 1 280 END DO 281 IF( ksecsbc > sdjf%nrecsec(ja) ) ja = ja + 1 ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast) 282 283 ! if ln_tint and if the new after is not ja+1, we need also to update after data before the swap 284 ! so, after the swap, sdjf%nrec_b(2) will still be the closest value located just before ksecsbc 285 IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec_a(1) + 1 .OR. sdjf%nrec_a(2) == nflag ) ) THEN 286 sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! update nrec_a with before information 287 CALL fld_get( sdjf ) ! read after data that will be used as before data 288 ENDIF 289 290 ! if after is in the next file... 291 IF( ja > sdjf%nreclast ) THEN 292 293 CALL fld_def( sdjf ) 294 IF( ksecsbc > sdjf%nrecsec(sdjf%nreclast) ) CALL fld_def( sdjf, ldnext = .TRUE. ) 295 CALL fld_clopn( sdjf ) ! open next file 296 297 ! find where is after in this new file 298 ja = 1 299 DO WHILE ( ksecsbc > sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast ) 300 ja = ja + 1 301 END DO 302 IF( ksecsbc > sdjf%nrecsec(ja) ) ja = ja + 1 ! in case ksecsbc > sdjf%nrecsec(sdjf%nreclast) 303 304 IF( ja > sdjf%nreclast ) THEN 305 CALL ctl_stop( "STOP", "fld_def: need next-next file? we should not be there... file: "//TRIM(sdjf%clrootname) ) 498 306 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 307 308 ! if ln_tint and if after is not the first record, we must (potentially again) update after data before the swap 309 IF( sdjf%ln_tint .AND. ja > 1 ) THEN 310 IF( sdjf%nrecsec(0) /= nflag ) THEN ! no trick used: after file is not the current file 311 sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! update nrec_a with before information 312 CALL fld_get( sdjf ) ! read after data that will be used as before data 313 ENDIF 526 314 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 315 316 ENDIF 317 318 IF( sdjf%ln_tint ) THEN 319 ! Swap data 320 sdjf%nrec_b(:) = sdjf%nrec_a(:) ! swap before record informations 321 sdjf%rotn(1) = sdjf%rotn(2) ! swap before rotate informations 322 sdjf%fdta(:,:,:,1) = sdjf%fdta(:,:,:,2) ! swap before record field 588 323 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 324 sdjf%nrec_b(:) = (/ ja-1, sdjf%nrecsec(ja-1) /) ! only for print 325 ENDIF 326 327 ! read new after data 328 sdjf%nrec_a(:) = (/ ja, sdjf%nrecsec(ja) /) ! update nrec_a as it is used by fld_get 329 CALL fld_get( sdjf ) ! read after data (with nrec_a informations) 330 331 ENDIF 332 ! 333 END SUBROUTINE fld_update 598 334 599 335 … … 1030 766 sd(ju)%fdta(:,:,jk,jn) = utmp(:,:) ; sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:) 1031 767 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(:,:) )768 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->i', utmp(:,:) ) 769 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->j', vtmp(:,:) ) 1034 770 sd(ju)%fnow(:,:,jk ) = utmp(:,:) ; sd(iv)%fnow(:,:,jk ) = vtmp(:,:) 1035 771 ENDIF … … 1047 783 1048 784 1049 SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop ) 785 SUBROUTINE fld_def( sdjf, ldprev, ldnext ) 786 !!--------------------------------------------------------------------- 787 !! *** ROUTINE fld_def *** 788 !! 789 !! ** Purpose : define the record(s) of the file and its name 790 !!---------------------------------------------------------------------- 791 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables 792 LOGICAL, OPTIONAL, INTENT(in ) :: ldprev ! 793 LOGICAL, OPTIONAL, INTENT(in ) :: ldnext ! 794 ! 795 INTEGER :: jt 796 INTEGER :: idaysec ! number of seconds in 1 day = NINT(rday) 797 INTEGER :: iyr, imt, idy, isecwk 798 INTEGER :: indexyr, indexmt 799 INTEGER :: ireclast 800 INTEGER :: ishift, istart 801 INTEGER, DIMENSION(2) :: isave 802 REAL(wp) :: zfreqs 803 LOGICAL :: llprev, llnext, llstop 804 LOGICAL :: llprevmt, llprevyr 805 LOGICAL :: llnextmt, llnextyr 806 !!---------------------------------------------------------------------- 807 idaysec = NINT(rday) 808 ! 809 IF( PRESENT(ldprev) ) THEN ; llprev = ldprev 810 ELSE ; llprev = .FALSE. 811 ENDIF 812 IF( PRESENT(ldnext) ) THEN ; llnext = ldnext 813 ELSE ; llnext = .FALSE. 814 ENDIF 815 816 ! current file parameters 817 IF ( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the current week 818 isecwk = ksec_week( sdjf%cltype(6:8) ) ! seconds between the beginning of the week and half of current time step 819 llprevmt = isecwk > nsec_month ! longer time since beginning of the current week than the current month 820 llprevyr = llprevmt .AND. nmonth == 1 821 iyr = nyear - COUNT((/llprevyr/)) 822 imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 823 idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 824 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and current week beginning 825 ELSE 826 iyr = nyear 827 imt = nmonth 828 idy = nday 829 isecwk = 0 830 ENDIF 831 832 ! previous file parameters 833 IF( llprev ) THEN 834 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of previous week 835 isecwk = isecwk + 7 * idaysec ! seconds between the beginning of previous week and half of the time step 836 llprevmt = isecwk > nsec_month ! longer time since beginning of the previous week than the current month 837 llprevyr = llprevmt .AND. nmonth == 1 838 iyr = nyear - COUNT((/llprevyr/)) 839 imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 840 idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 841 isecwk = nsec_year - isecwk ! seconds between 00h jan 1st of current year and previous week beginning 842 ELSE 843 idy = nday - COUNT((/ sdjf%cltype == 'daily' /)) 844 imt = nmonth - COUNT((/ sdjf%cltype == 'monthly' .OR. idy == 0 /)) 845 iyr = nyear - COUNT((/ sdjf%cltype == 'yearly' .OR. imt == 0 /)) 846 IF( idy == 0 ) idy = nmonth_len(imt) 847 IF( imt == 0 ) imt = 12 848 isecwk = 0 849 ENDIF 850 ENDIF 851 852 ! next file parameters 853 IF( llnext ) THEN 854 IF( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of next week 855 isecwk = 7 * idaysec - isecwk ! seconds between half of the time step and the beginning of next week 856 llnextmt = isecwk > ( nmonth_len(nmonth)*idaysec - nsec_month ) ! larger than the seconds to the end of the month 857 llnextyr = llnextmt .AND. nmonth == 12 858 iyr = nyear + COUNT((/llnextyr/)) 859 imt = nmonth + COUNT((/llnextmt/)) - 12 * COUNT((/llnextyr/)) 860 idy = nday - nmonth_len(nmonth) * COUNT((/llnextmt/)) + isecwk / idaysec + 1 861 isecwk = nsec_year + isecwk ! seconds between 00h jan 1st of current year and next week beginning 862 ELSE 863 idy = nday + COUNT((/ sdjf%cltype == 'daily' /)) 864 imt = nmonth + COUNT((/ sdjf%cltype == 'monthly' .OR. idy > nmonth_len(nmonth) /)) 865 iyr = nyear + COUNT((/ sdjf%cltype == 'yearly' .OR. imt == 13 /)) 866 IF( idy > nmonth_len(nmonth) ) idy = 1 867 IF( imt == 13 ) imt = 1 868 isecwk = 0 869 ENDIF 870 ENDIF 871 ! 872 ! find the last record to be read -> update sdjf%nreclast 873 indexyr = iyr - nyear + 1 ! which year are we looking for? previous(0), current(1) or next(2)? 874 indexmt = imt + 12 * ( indexyr - 1 ) ! which month are we looking for (relatively to current year)? 875 ! 876 ! Last record to be read in the current file 877 ! Predefine the number of record in the file according of its type. 878 ! We could compare this number with the number of records in the file and make a stop if the 2 numbers do not match... 879 ! However this would be much less fexible (e.g. for tests) and will force to rewite input files according to nleapy... 880 IF ( NINT(sdjf%freqh) == -12 ) THEN ; ireclast = 1 ! yearly mean: consider only 1 record 881 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean: 882 IF( sdjf%cltype == 'monthly' ) THEN ; ireclast = 1 ! consider that the file has 1 record 883 ELSE ; ireclast = 12 ! consider that the file has 12 record 884 ENDIF 885 ELSE ! higher frequency mean (in hours) 886 IF( sdjf%cltype == 'monthly' ) THEN ; ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh ) 887 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; ireclast = NINT( 24. * 7. / sdjf%freqh ) 888 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ireclast = NINT( 24. / sdjf%freqh ) 889 ELSE ; ireclast = NINT( 24. * REAL( nyear_len(indexyr), wp) / sdjf%freqh ) 890 ENDIF 891 ENDIF 892 893 sdjf%nreclast = ireclast 894 ! Allocate arrays for beginning/middle/end of each record (seconds since Jan. 1st 00h of nit000 year) 895 IF( ALLOCATED(sdjf%nrecsec) ) DEALLOCATE( sdjf%nrecsec ) 896 ALLOCATE( sdjf%nrecsec( 0:ireclast ) ) 897 ! 898 IF ( NINT(sdjf%freqh) == -12 ) THEN ! yearly mean and yearly file 899 SELECT CASE( indexyr ) 900 CASE(0) ; sdjf%nrecsec(0) = nsec1jan000 - nyear_len( 0 ) * idaysec 901 CASE(1) ; sdjf%nrecsec(0) = nsec1jan000 902 CASE(2) ; sdjf%nrecsec(0) = nsec1jan000 + nyear_len( 1 ) * idaysec 903 ENDSELECT 904 sdjf%nrecsec(1) = sdjf%nrecsec(0) + nyear_len( indexyr ) * idaysec 905 ELSEIF( NINT(sdjf%freqh) == -1 ) THEN ! monthly mean: 906 IF( sdjf%cltype == 'monthly' ) THEN ! monthly file 907 sdjf%nrecsec(0 ) = nsec1jan000 + nmonth_beg(indexmt ) 908 sdjf%nrecsec(1 ) = nsec1jan000 + nmonth_beg(indexmt+1) 909 ELSE ! yearly file 910 ishift = 12 * ( indexyr - 1 ) 911 sdjf%nrecsec(0:12) = nsec1jan000 + nmonth_beg(1+ishift:13+ishift) 912 ENDIF 913 ELSE ! higher frequency mean (in hours) 914 IF( sdjf%cltype == 'monthly' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) 915 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; istart = nsec1jan000 + isecwk 916 ELSEIF( sdjf%cltype == 'daily' ) THEN ; istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec 917 ELSEIF( indexyr == 0 ) THEN ; istart = nsec1jan000 - nyear_len( 0 ) * idaysec 918 ELSEIF( indexyr == 2 ) THEN ; istart = nsec1jan000 + nyear_len( 1 ) * idaysec 919 ELSE ; istart = nsec1jan000 920 ENDIF 921 zfreqs = sdjf%freqh * rhhmm * rmmss 922 DO jt = 0, sdjf%nreclast 923 sdjf%nrecsec(jt) = istart + NINT( zfreqs * REAL(jt,wp) ) 924 END DO 925 ENDIF 926 ! 927 IF( sdjf%ln_tint ) THEN ! record time defined in the middle of the record 928 sdjf%nrecsec(1:sdjf%nreclast) = 0.5 * ( sdjf%nrecsec(0:sdjf%nreclast-1) + sdjf%nrecsec(1:sdjf%nreclast) ) 929 END IF 930 ! 931 sdjf%clname = fld_filename( sdjf, idy, imt, iyr ) 932 ! 933 END SUBROUTINE fld_def 934 935 936 SUBROUTINE fld_clopn( sdjf ) 1050 937 !!--------------------------------------------------------------------- 1051 938 !! *** ROUTINE fld_clopn *** 1052 939 !! 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 940 !! ** Purpose : close/open the files 941 !!---------------------------------------------------------------------- 942 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables 943 ! 944 INTEGER, DIMENSION(2) :: isave 945 LOGICAL :: llprev, llnext, llstop 946 !!---------------------------------------------------------------------- 947 ! 948 llprev = sdjf%nrecsec(sdjf%nreclast) < nsec000_1jan000 ! file ends before the beginning of the job -> file may not exist 949 llnext = sdjf%nrecsec( 0 ) > nsecend_1jan000 ! file begins after the end of the job -> file may not exist 950 951 llstop = sdjf%ln_clim .OR. .NOT. ( llprev .OR. llnext ) 952 953 IF( sdjf%num <= 0 .OR. .NOT. sdjf%ln_clim ) THEN 954 IF( sdjf%num > 0 ) CALL iom_close( sdjf%num ) ! close file if already open 955 CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 956 ENDIF 957 ! 958 IF( sdjf%num <= 0 .AND. .NOT. llstop ) THEN ! file not found but we do accept this... 959 ! 960 IF( llprev ) THEN ! previous file does not exist : go back to current and accept to read only the first record 961 CALL ctl_warn('previous file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file') 962 isave(1:2) = sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) ! save previous file info 963 CALL fld_def( sdjf ) ! go back to current file 964 sdjf%nreclast = 1 ! force to use only the first record (do as if other were not existing...) 965 sdjf%nrecsec(0:1) = isave(1:2) 966 ENDIF 967 ! 968 IF( llnext ) THEN ! next file does not exist : go back to current and accept to read only the last record 969 CALL ctl_warn('next file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file') 970 isave(1:2) = sdjf%nrecsec(0:1) ! save next file info 971 CALL fld_def( sdjf ) ! go back to current file 972 ! -> read last record but keep record info from the first record of next file 973 sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) = isave(1:2) 974 sdjf%nrecsec(0:sdjf%nreclast-2) = nflag 975 ENDIF 976 ! 977 CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 1138 978 ! 1139 979 ENDIF … … 1751 1591 1752 1592 1593 FUNCTION fld_filename( sdjf, kday, kmonth, kyear ) 1594 !!--------------------------------------------------------------------- 1595 !! *** FUNCTION fld_filename *** 1596 !! 1597 !! ** Purpose : define the filename according to a given date 1598 !!--------------------------------------------------------------------- 1599 TYPE(FLD), INTENT(in) :: sdjf ! input field related variables 1600 INTEGER , INTENT(in) :: kday, kmonth, kyear 1601 ! 1602 CHARACTER(len = 256) :: clname, fld_filename 1603 !!--------------------------------------------------------------------- 1604 1605 1606 ! build the new filename if not climatological data 1607 clname=TRIM(sdjf%clrootname) 1608 ! 1609 ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name 1610 IF( .NOT. sdjf%ln_clim ) THEN 1611 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 1612 IF( sdjf%cltype /= 'yearly' ) WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname ), kmonth ! add month 1613 ELSE 1614 ! build the new filename if climatological data 1615 IF( sdjf%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 1616 ENDIF 1617 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 1618 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), kday ! add day 1619 1620 fld_filename = clname 1621 1622 END FUNCTION fld_filename 1623 1624 1753 1625 FUNCTION ksec_week( cdday ) 1754 1626 !!--------------------------------------------------------------------- 1755 !! *** FUNCTION ks hift_week ***1756 !! 1757 !! ** Purpose : return the first 3 letters of the first day of the weekly file1627 !! *** FUNCTION ksec_week *** 1628 !! 1629 !! ** Purpose : seconds between 00h of the beginning of the week and half of the current time step 1758 1630 !!--------------------------------------------------------------------- 1759 1631 CHARACTER(len=*), INTENT(in) :: cdday ! first 3 letters of the first day of the weekly file … … 1771 1643 ishift = ijul * NINT(rday) 1772 1644 ! 1773 ksec_week = nsec_ week+ ishift1645 ksec_week = nsec_monday + ishift 1774 1646 ksec_week = MOD( ksec_week, 7*NINT(rday) ) 1775 1647 !
Note: See TracChangeset
for help on using the changeset viewer.