- Timestamp:
- 2019-12-13T16:11:51+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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 !
Note: See TracChangeset
for help on using the changeset viewer.