Changeset 2059 for branches/dev_1784_WEEK/NEMO/OPA_SRC/SBC/fldread.F90
- Timestamp:
- 2010-08-18T11:44:33+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_1784_WEEK/NEMO/OPA_SRC/SBC/fldread.F90
r1730 r2059 15 15 USE oce ! ocean dynamics and tracers 16 16 USE dom_oce ! ocean space and time domain 17 USE ioipsl, ONLY : ymds2ju, ju2ymds ! for calendar 17 18 USE phycst ! ??? 18 19 USE in_out_manager ! I/O manager … … 29 30 LOGICAL :: ln_tint ! time interpolation or not (T/F) 30 31 LOGICAL :: ln_clim ! climatology or not (T/F) 31 CHARACTER(len = 7) :: cltype ! type of data file 'daily', 'monthly' or yearly'32 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 32 33 CHARACTER(len = 34) :: wname ! generic name of a NetCDF weights file to be used, blank if not 33 34 CHARACTER(len = 34) :: vcomp ! symbolic component name if a vector that needs rotation … … 43 44 LOGICAL :: ln_tint ! time interpolation or not (T/F) 44 45 LOGICAL :: ln_clim ! climatology or not (T/F) 45 CHARACTER(len = 7) :: cltype ! type of data file 'daily', 'monthly' or yearly'46 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 46 47 INTEGER :: num ! iom id of the jpfld files to be read 47 48 INTEGER :: nswap_sec ! swapping time in second since Jan. 1st 00h of nit000 year … … 159 160 IF( sd(jf)%nfreqh == -1 ) THEN ; ireclast = 12 160 161 ELSE 161 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 162 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh 163 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh 162 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 163 ELSEIF( sd(jf)%cltype(1:4) == 'week' ) THEN ; ireclast = 24.* 7 / sd(jf)%nfreqh 164 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh 165 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh 164 166 ENDIF 165 167 ENDIF … … 313 315 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 314 316 !! 315 LOGICAL :: llprevyr ! are we reading previous year file? 316 LOGICAL :: llprevmth ! are we reading previous month file? 317 LOGICAL :: llprevday ! are we reading previous day file? 318 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprevday 319 INTEGER :: idvar ! variable id 320 INTEGER :: inrec ! number of record existing for this variable 317 LOGICAL :: llprevyr ! are we reading previous year file? 318 LOGICAL :: llprevmth ! are we reading previous month file? 319 LOGICAL :: llprevweek ! are we reading previous week file? 320 LOGICAL :: llprevday ! are we reading previous day file? 321 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprevday 322 INTEGER :: idvar ! variable id 323 INTEGER :: inrec ! number of record existing for this variable 321 324 INTEGER :: kwgt 325 INTEGER :: iyear, imonth, iday ! first day of the current file in yyyy mm dd 326 INTEGER :: isec_week ! number of seconds since start of the weekly file 322 327 CHARACTER(LEN=1000) :: clfmt ! write format 323 328 !!--------------------------------------------------------------------- 324 329 325 330 ! some default definitions... 326 331 sdjf%num = 0 ! default definition for non-opened file 327 332 IF( sdjf%ln_clim ) sdjf%clname = TRIM( sdjf%clrootname ) ! file name defaut definition, never change in this case 328 llprevyr = .FALSE. 329 llprevmth = .FALSE. 330 llprevday = .FALSE. 333 llprevyr = .FALSE. 334 llprevmth = .FALSE. 335 llprevweek = .FALSE. 336 llprevday = .FALSE. 337 isec_week = 0 331 338 332 339 ! define record informations … … 350 357 llprevmth = .NOT. sdjf%ln_clim ! use previous month file? 351 358 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 359 ELSE IF ( sdjf%cltype(1:4) == 'week' ) THEN !weekly file 360 isec_week = 86400 * 7 361 sdjf%nrec_b(1) = 24. / sdjf%nfreqh * 7 ! last record of previous weekly file 352 362 ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 353 363 sdjf%nrec_b(1) = 24 / sdjf%nfreqh ! last record of previous day … … 361 371 ENDIF 362 372 ENDIF 363 llprev = llprevyr .OR. llprevmth .OR. llprevday 364 365 CALL fld_clopn( sdjf, nyear - COUNT((/llprevyr /)) , & 366 & nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)), & 367 & nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 368 373 llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 374 375 IF ( sdjf%cltype(1:4) == 'week' ) THEN 376 isec_week = ksec_week( sdjf%cltype(6:8) ) 377 if(lwp)write(numout,*)'cbr test2 isec_week = ',isec_week 378 llprevmth = ( isec_week .GT. nsec_month ) 379 llprevyr = llprevmth .AND. nmonth==1 380 ENDIF 381 ! 382 iyear = nyear - COUNT((/llprevyr /)) 383 imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 384 iday = nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - INT( isec_week )/86400 385 ! 386 CALL fld_clopn( sdjf , iyear , imonth , iday , .NOT. llprev ) 387 369 388 ! if previous year/month/day file does not exist, we switch to the current year/month/day 370 389 IF( llprev .AND. sdjf%num == 0 ) THEN … … 399 418 ENDIF 400 419 401 IF( sdjf%num == 0 ) CALL fld_clopn( sdjf, nyear, nmonth, nday ) ! make sure current year/month/day file is opened 420 ! make sure current year/month/day file is opened 421 IF( sdjf%num == 0 ) THEN 422 isec_week = 0 423 llprevyr = .FALSE. 424 llprevmth = .FALSE. 425 llprevweek = .FALSE. 426 ! 427 IF ( sdjf%cltype(1:4) == 'week' ) THEN 428 isec_week = ksec_week( sdjf%cltype(6:8) ) 429 llprevmth = ( isec_week .GT. nsec_month ) 430 llprevyr = llprevmth .AND. nmonth==1 431 ENDIF 432 ! 433 iyear = nyear - COUNT((/llprevyr /)) 434 imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 435 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week/86400 436 ! 437 CALL fld_clopn( sdjf, iyear, imonth, iday ) 438 ENDIF 402 439 403 440 sdjf%nswap_sec = nsec_year + nsec1jan000 - 1 ! force read/update the after data in the following part of fld_read 404 441 405 442 END SUBROUTINE fld_init 406 443 … … 420 457 REAL(wp) :: ztmp ! temporary variable 421 458 INTEGER :: ifreq_sec ! frequency mean (in seconds) 459 INTEGER :: isec_week ! number of seconds since the start of the weekly file 422 460 !!---------------------------------------------------------------------- 423 461 ! … … 453 491 ! 454 492 ifreq_sec = sdjf%nfreqh * 3600 ! frequency mean (in seconds) 493 IF( sdjf%cltype(1:4) == 'week' ) isec_week = ksec_week( sdjf%cltype(6:8)) !since the first day of the current week 455 494 ! number of second since the beginning of the file 456 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month,wp) ! since 00h on the 1st day of the current month 457 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 458 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 495 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month ,wp) ! since 00h on the 1st day of the current month 496 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; ztmp = REAL(isec_week ,wp) ! since the first day of the current week 497 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 498 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 459 499 ENDIF 460 500 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record … … 492 532 ! after record index and second since Jan. 1st 00h of nit000 year 493 533 sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 494 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month534 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month 495 535 sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1)) ! ok if nmonth=1 496 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 536 IF( sdjf%cltype(1:4) == 'week' ) & ! add the number of seconds between 00h Jan 1 and the end of previous week 537 sdjf%nrec_a(2) = sdjf%nrec_a(2) + ( nsec_year - isec_week ) 538 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 497 539 sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 ) 498 540 … … 500 542 irec = irec - 1. ! move back to previous record 501 543 sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 502 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month544 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month 503 545 sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1)) ! ok if nmonth=1 504 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 546 IF( sdjf%cltype(1:4) == 'week' ) & ! add the number of seconds between 00h Jan 1 and the end of previous week 547 sdjf%nrec_b(2) = sdjf%nrec_b(2) + ( nsec_year - isec_week ) 548 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 505 549 sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 ) 506 550 … … 523 567 !! ** Method : 524 568 !!---------------------------------------------------------------------- 525 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 526 INTEGER , INTENT(in ) :: kyear ! year value 527 INTEGER , INTENT(in ) :: kmonth ! month value 528 INTEGER , INTENT(in ) :: kday ! day value 529 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 569 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 570 INTEGER , INTENT(in ) :: kyear ! year value 571 INTEGER , INTENT(in ) :: kmonth ! month value 572 INTEGER , INTENT(in ) :: kday ! day value 573 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 574 INTEGER :: iyear, imonth, iday ! firt day of the current week in yyyy mm dd 575 REAL(wp) :: zsec, zjul !temp variable 530 576 531 577 IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open 532 578 ! build the new filename if not climatological data 533 IF( .NOT. sdjf%ln_clim ) THEN ; WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 534 IF( sdjf%cltype /= 'yearly' ) WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 535 IF( sdjf%cltype == 'daily' ) WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 579 sdjf%clname=TRIM(sdjf%clrootname) 580 ! 581 IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy==0 )CALL ctl_stop( 'fld_clopn: weekly file and nn_leapy=0 are not compatible' ) 582 ! 583 IF( .NOT. sdjf%ln_clim ) THEN 584 WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 585 IF( sdjf%cltype /= 'yearly' ) & 586 & WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 587 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 588 & WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 536 589 ENDIF 537 590 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) … … 998 1051 999 1052 END SUBROUTINE fld_interp 1000 1053 1054 FUNCTION ksec_week( cdday ) 1055 !!--------------------------------------------------------------------- 1056 !! *** FUNCTION kshift_week *** 1057 !! 1058 !! ** Purpose : 1059 !! 1060 !! ** Method : 1061 !!--------------------------------------------------------------------- 1062 CHARACTER(len=*), INTENT(in) :: cdday !3 first letters of the first day of the weekly file 1063 !! 1064 INTEGER :: ksec_week ! output variable 1065 INTEGER :: ijul !temp variable 1066 INTEGER :: ishift !temp variable 1067 CHARACTER(len=3),DIMENSION(7) :: cl_week 1068 !!---------------------------------------------------------------------- 1069 cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/) 1070 DO ijul=1,7 1071 IF( cl_week(ijul)==TRIM(cdday) ) EXIT 1072 ENDDO 1073 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): ',TRIM(cdday) ) 1074 ! 1075 ishift = ( ijul ) * 86400 1076 ! 1077 ksec_week = nsec_week + ishift 1078 ksec_week = MOD( ksec_week , 86400*7 ) 1079 if(lwp)write(numout,*)'cbr ijul ksec_week ',ijul,ksec_week 1080 ! 1081 END FUNCTION ksec_week 1082 1001 1083 END MODULE fldread
Note: See TracChangeset
for help on using the changeset viewer.
