Changeset 3851
- Timestamp:
- 2013-03-27T11:03:54+01:00 (11 years ago)
- Location:
- trunk/NEMOGCM/NEMO
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r3703 r3851 207 207 IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2 208 208 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 209 & jit=jit, time_offset=time_offset )209 & kit=jit, kt_offset=time_offset ) 210 210 IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2 211 211 … … 255 255 jend = nb_bdy_fld(ib_bdy) 256 256 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 257 & map=nbmap_ptr(jstart:jend), time_offset=time_offset )257 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 258 258 ! 259 259 igrd = 2 ! zonal velocity … … 279 279 jend = nb_bdy_fld(ib_bdy) 280 280 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 281 & map=nbmap_ptr(jstart:jend), time_offset=time_offset )281 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 282 282 ENDIF 283 283 ! If full velocities in boundary data then split into barotropic and baroclinic data -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r3764 r3851 153 153 IF ( nleapy == 1 ) THEN ! we are using calandar with leap years 154 154 IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN 155 nyear_len(0) = 366156 ENDIF 157 IF ( MOD(nyear , 4) == 0 .AND. ( MOD(nyear, 400) == 0 .OR. MOD(nyear, 100) /= 0 ) ) THEN155 nyear_len(0) = 366 156 ENDIF 157 IF ( MOD(nyear , 4) == 0 .AND. ( MOD(nyear , 400) == 0 .OR. MOD(nyear , 100) /= 0 ) ) THEN 158 158 nmonth_len(2) = 29 159 nyear_len(1) = 366 159 nyear_len(1) = 366 160 ENDIF 161 IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN 162 nyear_len(2) = 366 160 163 ENDIF 161 164 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r3680 r3851 218 218 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation 219 219 ! !: (cumulative duration of previous runs that may have used different time-step size) 220 INTEGER , PUBLIC, DIMENSION(0: 1) :: nyear_len !: length in days of the previous/current year220 INTEGER , PUBLIC, DIMENSION(0: 2) :: nyear_len !: length in days of the previous/current/next year 221 221 INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_len !: length in days of the months of the current year 222 222 INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_half !: second since Jan 1st 0h of the current year and the half of the months -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r3826 r3851 27 27 28 28 PUBLIC fld_map ! routine called by tides_init 29 PUBLIC fld_read, fld_fill ! called by sbc... modules 29 30 30 31 TYPE, PUBLIC :: FLD_N !: Namelist field informations … … 57 58 ! ! into the WGTLIST structure 58 59 CHARACTER(len = 34) :: vcomp ! symbolic name for a vector component that needs rotation 59 LOGICAL :: rotn ! flag to indicate whether field has been rotated 60 LOGICAL, DIMENSION(2) :: rotn ! flag to indicate whether before/after field has been rotated 61 INTEGER :: nreclast ! last record to be read in the current file 60 62 END TYPE FLD 61 63 … … 96 98 !$AGRIF_END_DO_NOT_TREAT 97 99 98 PUBLIC fld_read, fld_fill ! called by sbc... modules99 100 100 !!---------------------------------------------------------------------- 101 101 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 105 105 CONTAINS 106 106 107 SUBROUTINE fld_read( kt, kn_fsbc, sd, map, jit, time_offset )107 SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset ) 108 108 !!--------------------------------------------------------------------- 109 109 !! *** ROUTINE fld_read *** … … 120 120 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 121 121 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 122 TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping index 123 INTEGER , INTENT(in ), OPTIONAL :: jit ! subcycle timestep for timesplitting option 124 INTEGER , INTENT(in ), OPTIONAL :: time_offset ! provide fields at time other than "now" 125 ! time_offset = -1 => fields at "before" time level 126 ! time_offset = +1 => fields at "after" time levels 127 ! etc. 128 !! 122 TYPE(MAP_POINTER),INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices 123 INTEGER , INTENT(in ), OPTIONAL :: kit ! subcycle timestep for timesplitting option 124 INTEGER , INTENT(in ), OPTIONAL :: kt_offset ! provide fields at time other than "now" 125 ! kt_offset = -1 => fields at "before" time level 126 ! kt_offset = +1 => fields at "after" time level 127 ! etc. 128 !! 129 INTEGER :: itmp ! temporary variable 129 130 INTEGER :: imf ! size of the structure sd 130 131 INTEGER :: jf ! dummy indices 131 INTEGER :: ireclast ! last record to be read in the current year file132 132 INTEGER :: isecend ! number of second since Jan. 1st 00h of nit000 year at nitend 133 133 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 134 INTEGER :: it ime_add! local time offset variable134 INTEGER :: it_offset ! local time offset variable 135 135 LOGICAL :: llnxtyr ! open next year file? 136 136 LOGICAL :: llnxtmth ! open next month file? … … 140 140 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 141 141 CHARACTER(LEN=1000) :: clfmt ! write format 142 !!--------------------------------------------------------------------- 143 ll_firstcall = .false. 144 IF( PRESENT(jit) ) THEN 145 IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 146 ELSE 147 IF(kt == nit000) ll_firstcall = .true. 148 ENDIF 149 150 itime_add = 0 151 IF( PRESENT(time_offset) ) itime_add = time_offset 152 142 TYPE(MAP_POINTER) :: imap ! global-to-local mapping indices 143 !!--------------------------------------------------------------------- 144 ll_firstcall = kt == nit000 145 IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1 146 147 it_offset = 0 148 IF( PRESENT(kt_offset) ) it_offset = kt_offset 149 150 imap%ptr => NULL() 151 153 152 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 154 IF( present(jit) ) THEN 155 ! ignore kn_fsbc in this case 156 isecsbc = nsec_year + nsec1jan000 + (jit+itime_add)*rdt/REAL(nn_baro,wp) 157 ELSE 158 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + itime_add * rdttra(1) ! middle of sbc time step 153 IF( present(kit) ) THEN ! ignore kn_fsbc in this case 154 isecsbc = nsec_year + nsec1jan000 + (kit+it_offset)*NINT( rdt/REAL(nn_baro,wp) ) 155 ELSE ! middle of sbc time step 156 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + it_offset * NINT(rdttra(1)) 159 157 ENDIF 160 158 imf = SIZE( sd ) 161 159 ! 162 160 IF( ll_firstcall ) THEN ! initialization 163 IF( PRESENT(map) ) THEN 164 DO jf = 1, imf 165 CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr ) ! read each before field (put them in after as they will be swapped) 166 END DO 167 ELSE 168 DO jf = 1, imf 169 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 170 END DO 171 ENDIF 161 DO jf = 1, imf 162 IF( PRESENT(map) ) imap = map(jf) 163 CALL fld_init( kn_fsbc, sd(jf), imap ) ! read each before field (put them in after as they will be swapped) 164 END DO 172 165 IF( lwp ) CALL wgt_print() ! control print 173 CALL fld_rot( kt, sd ) ! rotate vector fiels if needed174 166 ENDIF 175 167 ! ! ====================================== ! … … 179 171 DO jf = 1, imf ! --- loop over field --- ! 180 172 181 IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN ! read/update the after data? 182 183 IF( sd(jf)%ln_tint ) THEN ! swap before record field and informations 184 sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:) 185 !CDIR COLLAPSE 186 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 173 IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN ! read/update the after data? 174 175 IF( PRESENT(map) ) imap = map(jf) ! temporary definition of map 176 177 sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:) ! swap before record informations 178 sd(jf)%rotn(1) = sd(jf)%rotn(2) ! swap before rotate informations 179 IF( sd(jf)%ln_tint ) sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) ! swap before record field 180 181 CALL fld_rec( kn_fsbc, sd(jf), kt_offset = it_offset, kit = kit ) ! update after record informations 182 183 ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd), 184 ! it is possible that the before value is no more the good one... we have to re-read it 185 ! if before is not the last record of the file currently opened and after is the first record to be read 186 ! in a new file which means after = 1 (the file to be opened corresponds to the current time) 187 ! or after = nreclast + 1 (the file to be opened corresponds to a future time step) 188 IF( .NOT. ll_firstcall .AND. sd(jf)%ln_tint .AND. sd(jf)%nrec_b(1) /= sd(jf)%nreclast & 189 & .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) == 1 ) THEN 190 itmp = sd(jf)%nrec_a(1) ! temporary storage 191 sd(jf)%nrec_a(1) = sd(jf)%nreclast ! read the last record of the file currently opened 192 CALL fld_get( sd(jf), imap ) ! read after data 193 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) ! re-swap before record field 194 sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1) ! update before record informations 195 sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - sd(jf)%nfreqh * 3600 ! assume freq to be in hours in this case 196 sd(jf)%rotn(1) = sd(jf)%rotn(2) ! update before rotate informations 197 sd(jf)%nrec_a(1) = itmp ! move back to after record 187 198 ENDIF 188 199 189 IF( PRESENT(jit) ) THEN 190 CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add, jit=jit ) ! update record informations 191 ELSE 192 CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add ) ! update record informations 193 ENDIF 194 195 ! do we have to change the year/month/week/day of the forcing field?? 200 CALL fld_clopn( sd(jf) ) ! Do we need to open a new year/month/week/day file? 201 196 202 IF( sd(jf)%ln_tint ) THEN 203 204 ! if kn_fsbc*rdttra is larger than nfreqh (which is kind of odd), 205 ! it is possible that the before value is no more the good one... we have to re-read it 206 ! if before record is not just just before the after record... 207 IF( .NOT. ll_firstcall .AND. MOD( sd(jf)%nrec_a(1), sd(jf)%nreclast ) /= 1 & 208 & .AND. sd(jf)%nrec_b(1) /= sd(jf)%nrec_a(1) - 1 ) THEN 209 sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - 1 ! move back to before record 210 CALL fld_get( sd(jf), imap ) ! read after data 211 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) ! re-swap before record field 212 sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1) ! update before record informations 213 sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - sd(jf)%nfreqh * 3600 ! assume freq to be in hours in this case 214 sd(jf)%rotn(1) = sd(jf)%rotn(2) ! update before rotate informations 215 sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1 ! move back to after record 216 ENDIF 217 218 ! do we have to change the year/month/week/day of the forcing field?? 197 219 ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current 198 220 ! 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) 199 221 ! will be larger than the record number that should be read for current year/month/week/day 200 201 ! last record to be read in the current file202 IF ( sd(jf)%nfreqh == -12 ) THEN ; ireclast = 1 ! yearly mean203 ELSEIF( sd(jf)%nfreqh == -1 ) THEN ! monthly mean204 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 1205 ELSE ; ireclast = 12206 ENDIF207 ELSE ! higher frequency mean (in hours)208 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh209 ELSEIF( sd(jf)%cltype(1:4) == 'week' ) THEN ; ireclast = 24 * 7 / sd(jf)%nfreqh210 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh211 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh212 ENDIF213 ENDIF214 215 222 ! do we need next file data? 216 IF( sd(jf)%nrec_a(1) > ireclast ) THEN217 218 sd(jf)%nrec_a(1) = 1 ! force to read the first record of the next file219 220 IF( .NOT. sd(jf)%ln_clim ) THEN ! close the current file and open a new one.221 223 IF( sd(jf)%nrec_a(1) > sd(jf)%nreclast ) THEN 224 225 sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) - sd(jf)%nreclast ! 226 227 IF( .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) THEN ! close/open the current/new file 228 222 229 llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth) ! open next month file? 223 230 llnxtyr = sd(jf)%cltype == 'yearly' .OR. (nmonth == 12 .AND. llnxtmth) ! open next year file? … … 228 235 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1)) ! second at the end of the run 229 236 llstop = isecend > sd(jf)%nrec_a(2) ! read more than 1 record of next year 230 237 ! we suppose that the date of next file is next day (should be ok even for weekly files...) 231 238 CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr /)) , & 232 239 & nmonth + COUNT((/llnxtmth/)) - 12 * COUNT((/llnxtyr /)), & … … 236 243 CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)// & 237 244 & ' not present -> back to current year/month/day') 238 CALL fld_clopn( sd(jf) , nyear, nmonth, nday) ! back to the current year/month/day239 sd(jf)%nrec_a(1) = ireclast ! force to read the last record to be read in the current year file245 CALL fld_clopn( sd(jf) ) ! back to the current year/month/day 246 sd(jf)%nrec_a(1) = sd(jf)%nreclast ! force to read the last record in the current year file 240 247 ENDIF 241 248 242 249 ENDIF 243 ENDIF 244 245 ELSE 246 ! if we are not doing time interpolation, we must change the year/month/week/day of the file just after 247 ! switching to the NEW year/month/week/day. If it is the case, we are at the beginning of the 248 ! year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) = 1 249 IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) & 250 & CALL fld_clopn( sd(jf), nyear, nmonth, nday ) 251 ENDIF 250 ENDIF ! open need next file? 251 252 ENDIF ! temporal interpolation? 252 253 253 254 ! read after data 254 IF( PRESENT(map) ) THEN 255 CALL fld_get( sd(jf), map(jf)%ptr ) 256 ELSE 257 CALL fld_get( sd(jf) ) 258 ENDIF 259 260 ENDIF 255 CALL fld_get( sd(jf), imap ) 256 257 ENDIF ! read new data? 261 258 END DO ! --- end loop over field --- ! 262 259 263 CALL fld_rot( kt, sd ) ! rotate vector fiels if needed260 CALL fld_rot( kt, sd ) ! rotate vector before/now/after fields if needed 264 261 265 262 DO jf = 1, imf ! --- loop over field --- ! … … 271 268 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 272 269 & 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 273 WRITE(numout, *) 'it ime_add is : ',itime_add270 WRITE(numout, *) 'it_offset is : ',it_offset 274 271 ENDIF 275 272 ! temporal interpolation weights … … 307 304 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 308 305 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 309 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map! global-to-local mapping indices306 TYPE(MAP_POINTER),INTENT(in) :: map ! global-to-local mapping indices 310 307 !! 311 308 LOGICAL :: llprevyr ! are we reading previous year file? … … 320 317 CHARACTER(LEN=1000) :: clfmt ! write format 321 318 !!--------------------------------------------------------------------- 322 323 ! some default definitions...324 sdjf%num = 0 ! default definition for non-opened file325 IF( sdjf%ln_clim ) sdjf%clname = TRIM( sdjf%clrootname ) ! file name defaut definition, never change in this case326 319 llprevyr = .FALSE. 327 320 llprevmth = .FALSE. … … 330 323 isec_week = 0 331 324 332 IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy == 0 ) &333 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs nn_leapy = 1')334 IF( sdjf%cltype(1:4) == 'week' .AND. sdjf%ln_clim ) &335 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs ln_clim = .FALSE.')336 337 325 ! define record informations 338 326 CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. ) ! return before values in sdjf%nrec_a (as we will swap it later) … … 348 336 llprevyr = .NOT. sdjf%ln_clim ! use previous year file? 349 337 ELSE 350 CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%cl name) )338 CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clrootname) ) 351 339 ENDIF 352 340 ELSEIF( sdjf%nfreqh == -1 ) THEN ! monthly mean … … 379 367 ENDIF 380 368 ENDIF 369 ! 381 370 IF ( sdjf%cltype(1:4) == 'week' ) THEN 382 371 isec_week = isec_week + ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week … … 394 383 ! if previous year/month/day file does not exist, we switch to the current year/month/day 395 384 IF( llprev .AND. sdjf%num <= 0 ) THEN 396 CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%cl name)// &385 CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clrootname)// & 397 386 & ' not present -> back to current year/month/week/day' ) 398 387 ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day 399 388 llprev = .FALSE. 400 389 sdjf%nrec_a(1) = 1 401 CALL fld_clopn( sdjf , nyear, nmonth, nday)390 CALL fld_clopn( sdjf ) 402 391 ENDIF 403 392 404 IF( llprev ) THEN ! check if the last record sdjf%nrec_n(1) exists in the file393 IF( llprev ) THEN ! check if the record sdjf%nrec_a(1) exists in the file 405 394 idvar = iom_varid( sdjf%num, sdjf%clvar ) ! id of the variable sdjf%clvar 406 395 IF( idvar <= 0 ) RETURN … … 409 398 ENDIF 410 399 411 ! read before data 412 IF( PRESENT(map) ) THEN 413 CALL fld_get( sdjf, map ) ! read before values in after arrays(as we will swap it later) 414 ELSE 415 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 416 ENDIF 400 ! read before data in after arrays(as we will swap it later) 401 CALL fld_get( sdjf, map ) 417 402 418 403 clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 419 404 IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 420 405 421 IF( llprev ) CALL iom_close( sdjf%num ) ! force to close previous year file (-> redefine sdjf%num to 0) 422 423 ENDIF 424 425 ! make sure current year/month/day file is opened 426 IF( sdjf%num <= 0 ) THEN 427 ! 428 IF ( sdjf%cltype(1:4) == 'week' ) THEN 429 isec_week = ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week 430 llprevmth = isec_week > nsec_month ! longer time since beginning of the week than the month 431 llprevyr = llprevmth .AND. nmonth == 1 432 ELSE 433 isec_week = 0 434 llprevmth = .FALSE. 435 llprevyr = .FALSE. 436 ENDIF 437 ! 438 iyear = nyear - COUNT((/llprevyr /)) 439 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 440 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 441 ! 442 CALL fld_clopn( sdjf, iyear, imonth, iday ) 443 ENDIF 406 ENDIF 444 407 ! 445 408 END SUBROUTINE fld_init 446 409 447 410 448 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit, time_offset )411 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, kit, kt_offset ) 449 412 !!--------------------------------------------------------------------- 450 413 !! *** ROUTINE fld_rec *** … … 460 423 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 461 424 LOGICAL , INTENT(in ), OPTIONAL :: ldbefore ! sent back before record values (default = .FALSE.) 462 INTEGER , INTENT(in ), OPTIONAL :: jit ! index of barotropic subcycle425 INTEGER , INTENT(in ), OPTIONAL :: kit ! index of barotropic subcycle 463 426 ! used only if sdjf%ln_tint = .TRUE. 464 INTEGER , INTENT(in ), OPTIONAL :: time_offset! Offset of required time level compared to "now"465 !time level in units of time steps.427 INTEGER , INTENT(in ), OPTIONAL :: kt_offset ! Offset of required time level compared to "now" 428 ! time level in units of time steps. 466 429 !! 467 430 LOGICAL :: llbefore ! local definition of ldbefore … … 470 433 INTEGER :: ifreq_sec ! frequency mean (in seconds) 471 434 INTEGER :: isec_week ! number of seconds since the start of the weekly file 472 INTEGER :: it ime_add! local time offset variable435 INTEGER :: it_offset ! local time offset variable 473 436 REAL(wp) :: ztmp ! temporary variable 474 437 !!---------------------------------------------------------------------- … … 480 443 ENDIF 481 444 ! 482 itime_add = 0 483 IF( PRESENT(time_offset) ) itime_add = time_offset 445 it_offset = 0 446 IF( PRESENT(kt_offset) ) it_offset = kt_offset 447 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) 448 ELSE ; it_offset = it_offset * NINT( rdttra(1) ) 449 ENDIF 484 450 ! 485 451 ! ! =========== ! … … 499 465 ! forcing record : 1 500 466 ! 501 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 502 IF( PRESENT(jit) ) THEN 503 ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 504 ELSE 505 ztmp = ztmp + itime_add*rdttra(1) 506 ENDIF 467 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp ) 507 468 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 508 469 ! swap at the middle of the year … … 532 493 ! forcing record : nmonth 533 494 ! 534 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 535 IF( PRESENT(jit) ) THEN 536 ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 537 ELSE 538 ztmp = ztmp + itime_add*rdttra(1) 539 ENDIF 495 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp ) 540 496 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 541 497 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) … … 563 519 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 564 520 ENDIF 565 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) ! shift time to be centrered in the middle of sbc time step 566 ztmp = ztmp + 0.01 * rdttra(1) ! add 0.01 time step to avoid truncation error 567 IF( PRESENT(jit) ) THEN 568 ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp) 569 ELSE 570 ztmp = ztmp + itime_add*rdttra(1) 571 ENDIF 521 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) + REAL( it_offset, wp ) ! centrered in the middle of sbc time step 522 ztmp = ztmp + 0.01 * rdttra(1) ! avoid truncation error 572 523 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 573 524 ! 574 ! INT( ztmp)525 ! INT( ztmp/ifreq_sec + 0.5 ) 575 526 ! /|\ 576 527 ! 2 | *-----( … … 578 529 ! 0 |--( 579 530 ! |--+--|--+--|--+--|--> time 580 ! 0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec)531 ! 0 /|\ 1 /|\ 2 /|\ 3 (ztmp/ifreq_sec) 581 532 ! | | | 582 533 ! | | | … … 586 537 ELSE ! no time interpolation 587 538 ! 588 ! INT( ztmp)539 ! INT( ztmp/ifreq_sec ) 589 540 ! /|\ 590 541 ! 2 | *-----( … … 592 543 ! 0 |-----( 593 544 ! |--+--|--+--|--+--|--> time 594 ! 0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec)545 ! 0 /|\ 1 /|\ 2 /|\ 3 (ztmp/ifreq_sec) 595 546 ! | | | 596 547 ! | | | … … 599 550 ztmp= ztmp / REAL(ifreq_sec, wp) 600 551 ENDIF 601 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) ! record n omber to be read552 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) ! record number to be read 602 553 603 554 iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000 ! end of this record (in second) … … 625 576 !!---------------------------------------------------------------------- 626 577 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 627 INTEGER , INTENT(in), OPTIONAL, DIMENSION(:) :: map! global-to-local mapping indices578 TYPE(MAP_POINTER),INTENT(in) :: map ! global-to-local mapping indices 628 579 !! 629 580 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) … … 631 582 INTEGER :: ipdom ! index of the domain 632 583 !!--------------------------------------------------------------------- 633 ! 584 ! 634 585 ipk = SIZE( sdjf%fnow, 3 ) 635 586 ! 636 IF( PRESENT(map) ) THEN637 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map )638 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map )587 IF( ASSOCIATED(map%ptr) ) THEN 588 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map%ptr ) 589 ELSE ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1), map%ptr ) 639 590 ENDIF 640 591 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN … … 659 610 ENDIF 660 611 ! 661 sdjf%rotn = .false. ! vector not yet rotated612 sdjf%rotn(2) = .false. ! vector not yet rotated 662 613 663 614 END SUBROUTINE fld_get … … 665 616 SUBROUTINE fld_map( num, clvar, dta, nrec, map ) 666 617 !!--------------------------------------------------------------------- 667 !! *** ROUTINE fld_ get***618 !! *** ROUTINE fld_map *** 668 619 !! 669 620 !! ** Purpose : read global data from file and map onto local data … … 673 624 USE bdy_oce, ONLY: dta_global, dta_global2 ! workspace to read in global data arrays 674 625 #endif 675 676 626 INTEGER , INTENT(in ) :: num ! stream number 677 627 CHARACTER(LEN=*) , INTENT(in ) :: clvar ! variable name … … 706 656 #endif 707 657 708 709 658 IF(lwp) WRITE(numout,*) 'Dim size for ',TRIM(clvar),' is ', ilendta 710 659 IF(lwp) WRITE(numout,*) 'Number of levels for ',TRIM(clvar),' is ', ipk 711 660 712 713 661 SELECT CASE( ipk ) 714 CASE(1) 715 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1 ), nrec ) 716 CASE DEFAULT 717 CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 662 CASE(1) ; CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1 ), nrec ) 663 CASE DEFAULT ; CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec ) 718 664 END SELECT 719 665 ! … … 746 692 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 747 693 !! 748 INTEGER :: ju, jv, jk! loop indices694 INTEGER :: ju,jv,jk,jn ! loop indices 749 695 INTEGER :: imf ! size of the structure sd 750 696 INTEGER :: ill ! character length … … 761 707 DO ju = 1, imf 762 708 ill = LEN_TRIM( sd(ju)%vcomp ) 763 IF( ill > 0 .AND. .NOT. sd(ju)%rotn ) THEN ! find vector rotations required 764 IF( sd(ju)%vcomp(1:1) == 'U' ) THEN ! east-west component has symbolic name starting with 'U' 765 ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V' 766 clcomp = 'V' // sd(ju)%vcomp(2:ill) ! works even if ill == 1 767 iv = -1 768 DO jv = 1, imf 769 IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) ) iv = jv 770 END DO 771 IF( iv > 0 ) THEN ! fields ju and iv are two components which need to be rotated together 772 DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 773 IF( sd(ju)%ln_tint )THEN 774 CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->i', utmp(:,:) ) 775 CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->j', vtmp(:,:) ) 776 sd(ju)%fdta(:,:,jk,2) = utmp(:,:) ; sd(iv)%fdta(:,:,jk,2) = vtmp(:,:) 777 ELSE 778 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->i', utmp(:,:) ) 779 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->j', vtmp(:,:) ) 780 sd(ju)%fnow(:,:,jk ) = utmp(:,:) ; sd(iv)%fnow(:,:,jk ) = vtmp(:,:) 781 ENDIF 782 END DO 783 sd(ju)%rotn = .TRUE. ! vector was rotated 784 IF( lwp .AND. kt == nit000 ) WRITE(numout,*) & 785 & 'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid' 786 ENDIF 787 ENDIF 788 ENDIF 709 DO jn = 2-COUNT((/sd(ju)%ln_tint/)), 2 710 IF( ill > 0 .AND. .NOT. sd(ju)%rotn(jn) ) THEN ! find vector rotations required 711 IF( sd(ju)%vcomp(1:1) == 'U' ) THEN ! east-west component has symbolic name starting with 'U' 712 ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V' 713 clcomp = 'V' // sd(ju)%vcomp(2:ill) ! works even if ill == 1 714 iv = -1 715 DO jv = 1, imf 716 IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) ) iv = jv 717 END DO 718 IF( iv > 0 ) THEN ! fields ju and iv are two components which need to be rotated together 719 DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 720 IF( sd(ju)%ln_tint )THEN 721 CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->i', utmp(:,:) ) 722 CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->j', vtmp(:,:) ) 723 sd(ju)%fdta(:,:,jk,jn) = utmp(:,:) ; sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:) 724 ELSE 725 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->i', utmp(:,:) ) 726 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->j', vtmp(:,:) ) 727 sd(ju)%fnow(:,:,jk ) = utmp(:,:) ; sd(iv)%fnow(:,:,jk ) = vtmp(:,:) 728 ENDIF 729 END DO 730 sd(ju)%rotn(jn) = .TRUE. ! vector was rotated 731 IF( lwp .AND. kt == nit000 ) WRITE(numout,*) & 732 & 'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid' 733 ENDIF 734 ENDIF 735 ENDIF 736 END DO 789 737 END DO 790 738 ! … … 801 749 !!---------------------------------------------------------------------- 802 750 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables 803 INTEGER 804 INTEGER 805 INTEGER 751 INTEGER, OPTIONAL, INTENT(in ) :: kyear ! year value 752 INTEGER, OPTIONAL, INTENT(in ) :: kmonth ! month value 753 INTEGER, OPTIONAL, INTENT(in ) :: kday ! day value 806 754 LOGICAL, OPTIONAL, INTENT(in ) :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 807 !!---------------------------------------------------------------------- 808 809 IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open 755 !! 756 LOGICAL :: llprevyr ! are we reading previous year file? 757 LOGICAL :: llprevmth ! are we reading previous month file? 758 INTEGER :: iyear, imonth, iday ! first day of the current file in yyyy mm dd 759 INTEGER :: isec_week ! number of seconds since start of the weekly file 760 INTEGER :: indexyr ! year undex (O/1/2: previous/current/next) 761 INTEGER :: iyear_len, imonth_len ! length (days) of iyear and imonth ! 762 CHARACTER(len = 256):: clname ! temporary file name 763 !!---------------------------------------------------------------------- 764 IF( PRESENT(kyear) ) THEN ! use given values 765 iyear = kyear 766 imonth = kmonth 767 iday = kday 768 ELSE ! use current day values 769 IF ( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the week 770 isec_week = ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week 771 llprevmth = isec_week > nsec_month ! longer time since beginning of the week than the month 772 llprevyr = llprevmth .AND. nmonth == 1 773 ELSE 774 isec_week = 0 775 llprevmth = .FALSE. 776 llprevyr = .FALSE. 777 ENDIF 778 iyear = nyear - COUNT((/llprevyr /)) 779 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 780 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 781 ENDIF 782 810 783 ! build the new filename if not climatological data 811 sdjf%clname=TRIM(sdjf%clrootname)812 ! 813 ! note that sdjf%ln_clim is is only acting on presence of the year in the file784 clname=TRIM(sdjf%clrootname) 785 ! 786 ! note that sdjf%ln_clim is is only acting on the presence of the year in the file name 814 787 IF( .NOT. sdjf%ln_clim ) THEN 815 WRITE( sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year816 IF( sdjf%cltype /= 'yearly' ) WRITE( sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month788 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), iyear ! add year 789 IF( sdjf%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), imonth ! add month 817 790 ELSE 818 791 ! build the new filename if climatological data 819 IF( sdjf%cltype /= 'yearly' ) WRITE( sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month792 IF( sdjf%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), imonth ! add month 820 793 ENDIF 821 794 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 822 & WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 823 ! 824 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 825 ! 795 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), iday ! add day 796 ! 797 IF( TRIM(clname) /= TRIM(sdjf%clname) .OR. sdjf%num == 0 ) THEN ! new file to be open 798 799 sdjf%clname = TRIM(clname) 800 IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open 801 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 802 803 ! find the last record to be read -> update sdjf%nreclast 804 indexyr = iyear - nyear + 1 805 iyear_len = nyear_len( indexyr ) 806 SELECT CASE ( indexyr ) 807 CASE ( 0 ) ; imonth_len = 31 ! previous year -> imonth = 12 808 CASE ( 1 ) ; imonth_len = nmonth_len(imonth) 809 CASE ( 2 ) ; imonth_len = 31 ! next year -> imonth = 1 810 END SELECT 811 812 ! last record to be read in the current file 813 IF ( sdjf%nfreqh == -12 ) THEN ; sdjf%nreclast = 1 ! yearly mean 814 ELSEIF( sdjf%nfreqh == -1 ) THEN ! monthly mean 815 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nreclast = 1 816 ELSE ; sdjf%nreclast = 12 817 ENDIF 818 ELSE ! higher frequency mean (in hours) 819 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nreclast = 24 * imonth_len / sdjf%nfreqh 820 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; sdjf%nreclast = 24 * 7 / sdjf%nfreqh 821 ELSEIF( sdjf%cltype == 'daily' ) THEN ; sdjf%nreclast = 24 / sdjf%nfreqh 822 ELSE ; sdjf%nreclast = 24 * iyear_len / sdjf%nfreqh 823 ENDIF 824 ENDIF 825 826 ENDIF 827 ! 826 828 END SUBROUTINE fld_clopn 827 829 … … 845 847 DO jf = 1, SIZE(sdf) 846 848 sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname ) 849 sdf(jf)%clname = "not yet defined" 847 850 sdf(jf)%nfreqh = sdf_n(jf)%nfreqh 848 851 sdf(jf)%clvar = sdf_n(jf)%clvar … … 850 853 sdf(jf)%ln_clim = sdf_n(jf)%ln_clim 851 854 sdf(jf)%cltype = sdf_n(jf)%cltype 852 sdf(jf)%wgtname = " " 855 sdf(jf)%num = -1 856 sdf(jf)%wgtname = " " 853 857 IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 ) sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 854 sdf(jf)%vcomp = sdf_n(jf)%vcomp 855 sdf(jf)%rotn = .TRUE. 858 sdf(jf)%vcomp = sdf_n(jf)%vcomp 859 sdf(jf)%rotn(:) = .TRUE. ! pretend to be rotated -> won't try to rotate data before the first call to fld_get 860 IF( sdf(jf)%cltype(1:4) == 'week' .AND. nn_leapy == 0 ) & 861 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs nn_leapy = 1') 862 IF( sdf(jf)%cltype(1:4) == 'week' .AND. sdf(jf)%ln_clim ) & 863 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs ln_clim = .FALSE.') 856 864 END DO 857 865 -
trunk/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r3334 r3851 161 161 IF ( nleapy == 1 ) THEN ! we are using calandar with leap years 162 162 IF ( MOD(nyear-1, 4) == 0 .AND. ( MOD(nyear-1, 400) == 0 .OR. MOD(nyear-1, 100) /= 0 ) ) THEN 163 nyear_len(0) = 366164 ENDIF 165 IF ( MOD(nyear , 4) == 0 .AND. ( MOD(nyear, 400) == 0 .OR. MOD(nyear, 100) /= 0 ) ) THEN163 nyear_len(0) = 366 164 ENDIF 165 IF ( MOD(nyear , 4) == 0 .AND. ( MOD(nyear , 400) == 0 .OR. MOD(nyear , 100) /= 0 ) ) THEN 166 166 nmonth_len(2) = 29 167 nyear_len(1) = 366 167 nyear_len(1) = 366 168 ENDIF 169 IF ( MOD(nyear+1, 4) == 0 .AND. ( MOD(nyear+1, 400) == 0 .OR. MOD(nyear+1, 100) /= 0 ) ) THEN 170 nyear_len(2) = 366 168 171 ENDIF 169 172 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.