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