Changeset 2353
- Timestamp:
- 2010-11-04T12:18:58+01:00 (13 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
-
DOM/daymod.F90 (modified) (7 diffs)
-
SBC/fldread.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r2288 r2353 67 67 !! - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 68 68 !!---------------------------------------------------------------------- 69 INTEGER :: inbday, i rest69 INTEGER :: inbday, idweek 70 70 REAL(wp) :: zjul 71 71 !!---------------------------------------------------------------------- … … 110 110 111 111 !compute number of days between last monday and today 112 IF( nn_leapy==1 )THEN 113 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (monday) 114 inbday = INT(fjulday) - NINT(zjul) ! compute nb day between 01.01.1900 and current day fjulday 115 irest = MOD(inbday,7) ! compute nb day between last monday and current day fjulday 116 IF(irest==0 )irest = 7 117 ENDIF 118 119 ! number of seconds since the beginning of current year/month at the middle of the time-step 112 CALL ymds2ju( 1900, 01, 01, 0.0, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday) 113 inbday = NINT(fjulday - zjul) ! compute nb day between 01.01.1900 and current day 114 idweek = MOD(inbday, 7) ! compute nb day between last monday and current day 115 116 ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step 120 117 nsec_year = nday_year * nsecd - ndt05 ! 1 time step before the middle of the first time step 121 118 nsec_month = nday * nsecd - ndt05 ! because day will be called at the beginning of step 119 nsec_week = idweek * nsecd - ndt05 122 120 nsec_day = nsecd - ndt05 123 nsec_week = 0124 IF( nn_leapy==1 ) nsec_week = irest * nsecd - ndt05125 121 126 122 ! control print … … 213 209 nsec_year = nsec_year + ndt 214 210 nsec_month = nsec_month + ndt 215 IF( nn_leapy==1 )nsec_week = nsec_week + ndt211 nsec_week = nsec_week + ndt 216 212 nsec_day = nsec_day + ndt 217 213 adatrj = adatrj + rdttra(1) / rday … … 220 216 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error 221 217 222 IF( nsec_day > nsecd ) THEN ! NEWday218 IF( nsec_day > nsecd ) THEN ! New day 223 219 ! 224 220 nday = nday + 1 … … 226 222 nsec_day = ndt05 227 223 ! 228 IF( nday == nmonth_len(nmonth) + 1 ) THEN ! N EWmonth224 IF( nday == nmonth_len(nmonth) + 1 ) THEN ! New month 229 225 nday = 1 230 226 nmonth = nmonth + 1 231 227 nsec_month = ndt05 232 IF( nmonth == 13 ) THEN ! N EWyear228 IF( nmonth == 13 ) THEN ! New year 233 229 nyear = nyear + 1 234 230 nmonth = 1 … … 240 236 ENDIF 241 237 ! 242 ndastp = nyear * 10000 + nmonth * 100 + nday ! N EWdate238 ndastp = nyear * 10000 + nmonth * 100 + nday ! New date 243 239 ! 244 240 !compute first day of the year in julian days … … 251 247 ENDIF 252 248 253 IF( nsec_week .GT. 7*86400 ) nsec_week = ndt05249 IF( nsec_week > 7*nsecd ) nsec_week = ndt05 ! New week 254 250 255 251 IF(ln_ctl) THEN -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r2351 r2353 33 33 CHARACTER(len = 34) :: wname ! generic name of a NetCDF weights file to be used, blank if not 34 34 CHARACTER(len = 34) :: vcomp ! symbolic component name if a vector that needs rotation 35 ! a string starting with "U" or "V" for each component36 ! chars 2 onwards identify which components go together35 ! a string starting with "U" or "V" for each component 36 ! chars 2 onwards identify which components go together 37 37 END TYPE FLD_N 38 38 … … 46 46 CHARACTER(len = 8) :: cltype ! type of data file 'daily', 'monthly' or yearly' 47 47 INTEGER :: num ! iom id of the jpfld files to be read 48 INTEGER :: nswap_sec ! swapping time in second since Jan. 1st 00h of nit000 year49 48 INTEGER , DIMENSION(2) :: nrec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 50 49 INTEGER , DIMENSION(2) :: nrec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year) … … 54 53 ! into the WGTLIST structure 55 54 CHARACTER(len = 34) :: vcomp ! symbolic name for a vector component that needs rotation 56 LOGICAL , DIMENSION(2):: rotn ! flag to indicate whether field has been rotated55 LOGICAL :: rotn ! flag to indicate whether field has been rotated 57 56 END TYPE FLD 58 57 … … 76 75 ! =-1 not cyclic 77 76 LOGICAL :: cyclic ! east-west cyclic or not 78 INTEGER, DIMENSION(:,:,:), POINTER:: data_jpi ! array of source integers79 INTEGER, DIMENSION(:,:,:), POINTER:: data_jpj ! array of source integers77 INTEGER, DIMENSION(:,:,:), POINTER :: data_jpi ! array of source integers 78 INTEGER, DIMENSION(:,:,:), POINTER :: data_jpj ! array of source integers 80 79 REAL(wp), DIMENSION(:,:,:), POINTER :: data_wgt ! array of weights on model grid 81 80 REAL(wp), DIMENSION(:,:,:), POINTER :: fly_dta ! array of values on input grid … … 115 114 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 116 115 !! 117 CHARACTER (LEN=34) :: acomp ! dummy weight name 118 INTEGER :: kf, nf ! dummy indices 119 INTEGER :: imf ! size of the structure sd 120 REAL(wp), DIMENSION(jpi,jpj) :: utmp, vtmp! temporary arrays for vector rotation 121 116 INTEGER :: imf ! size of the structure sd 122 117 INTEGER :: jf ! dummy indices 123 INTEGER :: jk ! dummy indices124 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )125 INTEGER :: kw ! index into wgts array126 118 INTEGER :: ireclast ! last record to be read in the current year file 127 119 INTEGER :: isecend ! number of second since Jan. 1st 00h of nit000 year at nitend 120 INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 128 121 LOGICAL :: llnxtyr ! open next year file? 129 122 LOGICAL :: llnxtmth ! open next month file? … … 133 126 CHARACTER(LEN=1000) :: clfmt ! write format 134 127 !!--------------------------------------------------------------------- 135 ! 128 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 129 isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) ! middle of sbc time step 136 130 imf = SIZE( sd ) 137 ! ! ===================== ! 138 DO jf = 1, imf ! LOOP OVER FIELD ! 139 ! ! ===================== ! 140 ! 141 IF( kt == nit000 ) CALL fld_init( sd(jf) ) 142 ! 143 ! read/update the after data? 144 IF( nsec_year + nsec1jan000 > sd(jf)%nswap_sec ) THEN 145 146 IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap before record field 131 ! 132 IF( kt == nit000 ) THEN ! initialization 133 DO jf = 1, imf 134 CALL fld_init( kn_fsbc, sd(jf) ) ! read each before field (put them in after as they will be swapped) 135 END DO 136 IF( lwp ) CALL wgt_print() ! control print 137 CALL fld_rot( kt, sd ) ! rotate vector fiels if needed 138 ENDIF 139 ! ! ====================================== ! 140 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! update field at each kn_fsbc time-step ! 141 ! ! ====================================== ! 142 ! 143 DO jf = 1, imf ! --- loop over field --- ! 144 145 IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000 ) THEN ! read/update the after data? 146 147 IF( sd(jf)%ln_tint ) THEN ! swap before record field and informations 148 sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:) 147 149 !CDIR COLLAPSE 148 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 149 sd(jf)%rotn(1) = sd(jf)%rotn(2) 150 sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 151 ENDIF 152 153 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 154 155 ! do we have to change the year/month/week/day of the forcing field?? 156 IF( sd(jf)%ln_tint ) THEN 157 ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current 158 ! 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) 159 ! will be larger than the record number that should be read for current year/month/week/day 160 161 ! last record to be read in the current file 162 IF ( sd(jf)%nfreqh == -12 ) THEN ; ireclast = 1 ! yearly mean 163 ELSEIF( sd(jf)%nfreqh == -1 ) THEN ! monthly mean 164 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 1 165 ELSE ; ireclast = 12 166 ENDIF 167 ELSE ! higher frequency mean (in hours) 168 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 169 ELSEIF( sd(jf)%cltype(1:4) == 'week' ) THEN ; ireclast = 24 * 7 / sd(jf)%nfreqh 170 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh 171 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh 172 ENDIF 173 ENDIF 174 175 ! do we need next file data? 176 IF( sd(jf)%nrec_a(1) > ireclast ) THEN 177 178 sd(jf)%nrec_a(1) = 1 ! force to read the first record of the next file 179 180 IF( .NOT. sd(jf)%ln_clim ) THEN ! close the current file and open a new one. 181 182 llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth) ! open next month file? 183 llnxtyr = sd(jf)%cltype == 'yearly' .OR. (nmonth == 12 .AND. llnxtmth) ! open next year file? 184 185 ! if the run finishes at the end of the current year/month/week/day, we will allow next 186 ! year/month/week/day file to be not present. If the run continue further than the current 187 ! year/month/week/day, next year/month/week/day file must exist 188 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1)) ! second at the end of the run 189 llstop = isecend > sd(jf)%nrec_a(2) ! read more than 1 record of next year 190 191 CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr /)) , & 192 & nmonth + COUNT((/llnxtmth/)) - 12 * COUNT((/llnxtyr /)), & 193 & nday + 1 - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 194 195 IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN ! next year file does not exist 196 CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)// & 197 & ' not present -> back to current year/month/day') 198 CALL fld_clopn( sd(jf), nyear, nmonth, nday ) ! back to the current year/month/day 199 sd(jf)%nrec_a(1) = ireclast ! force to read the last record to be read in the current year file 200 ENDIF 201 202 ENDIF 203 ENDIF 204 205 ELSE 206 ! if we are not doing time interpolation, we must change the year/month/week/day of the file just after 207 ! switching to the NEW year/month/week/day. If it is the case, we are at the beginning of the 208 ! year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) = 1 209 IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) ) & 210 & CALL fld_clopn( sd(jf), nyear, nmonth, nday ) 211 ENDIF 212 213 ! read after data 214 CALL fld_get( sd(jf) ) 215 150 216 ENDIF 151 152 ! update record informations 153 CALL fld_rec( sd(jf) ) 154 155 ! do we have to change the year/month/day of the forcing field?? 156 IF( sd(jf)%ln_tint ) THEN 157 ! if we do time interpolation we will need to open next year/month/day file before the end of the current one 158 ! if so, we are still before the end of the year/month/day when calling fld_rec so sd(jf)%nrec_a(1) will be 159 ! larger than the record number that should be read for current year/month/day (for ex. 13 for monthly mean file) 160 161 ! last record to be read in the current file 162 IF( sd(jf)%nfreqh == -1 ) THEN 163 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 1 164 ELSE ; ireclast = 12 165 ENDIF 166 ELSE 167 IF( sd(jf)%cltype == 'monthly' ) THEN ; ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 168 ELSEIF( sd(jf)%cltype(1:4) == 'week' ) THEN ; ireclast = 24.* 7 / sd(jf)%nfreqh 169 ELSEIF( sd(jf)%cltype == 'daily' ) THEN ; ireclast = 24 / sd(jf)%nfreqh 170 ELSE ; ireclast = 24 * nyear_len( 1 ) / sd(jf)%nfreqh 171 ENDIF 172 ENDIF 173 174 ! do we need next file data? 175 IF( sd(jf)%nrec_a(1) > ireclast ) THEN 176 177 sd(jf)%nrec_a(1) = 1 ! force to read the first record of the next file 178 179 IF( .NOT. sd(jf)%ln_clim ) THEN ! close the current file and open a new one. 180 181 llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth) ! open next month file? 182 llnxtyr = sd(jf)%cltype == 'yearly' .OR. (nmonth == 12 .AND. llnxtmth) ! open next year file? 183 184 ! if the run finishes at the end of the current year/month/day, we will allow next year/month/day file to be 185 ! not present. If the run continue further than the current year/month/day, next year/month/day file must exist 186 isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1)) ! second at the end of the run 187 llstop = isecend > sd(jf)%nswap_sec ! read more than 1 record of next year 188 189 CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr /)) , & 190 & nmonth + COUNT((/llnxtmth/)) - 12 * COUNT((/llnxtyr /)), & 191 & nday + 1 - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 192 193 IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN ! next year file does not exist 194 CALL ctl_warn('next year/month/day file: '//TRIM(sd(jf)%clname)// & 195 & ' not present -> back to current year/month/day') 196 CALL fld_clopn( sd(jf), nyear, nmonth, nday ) ! back to the current year/month/day 197 sd(jf)%nrec_a(1) = ireclast ! force to read the last record to be read in the current year file 198 ENDIF 199 200 ENDIF 201 ENDIF 202 203 ELSE 204 ! if we are not doing time interpolation, we must change the year/month/day of the file just after switching 205 ! to the NEW year/month/day. If it is the case, we are at the beginning of the year/month/day when calling 206 ! fld_rec so sd(jf)%nrec_a(1) = 1 207 IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. sd(jf)%ln_clim ) CALL fld_clopn( sd(jf), nyear, nmonth, nday ) 208 ENDIF 209 210 ! read after data 211 ipk = SIZE( sd(jf)%fnow, 3 ) 212 IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 213 CALL wgt_list( sd(jf), kw ) 214 ipk = SIZE(sd(jf)%fnow,3) 215 IF( sd(jf)%ln_tint ) THEN 216 CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 217 ELSE 218 CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fnow(:,:,:) , sd(jf)%nrec_a(1) ) 219 ENDIF 220 ELSE 221 SELECT CASE( SIZE(sd(jf)%fnow,3) ) 222 CASE(1) 223 IF( sd(jf)%ln_tint ) THEN 224 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 225 ELSE 226 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,1) , sd(jf)%nrec_a(1) ) 227 ENDIF 228 CASE(jpk) 229 IF( sd(jf)%ln_tint ) THEN 230 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 231 ELSE 232 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,:) , sd(jf)%nrec_a(1) ) 233 ENDIF 234 END SELECT 235 ENDIF 236 sd(jf)%rotn(2) = .FALSE. 237 238 ENDIF 239 ! ! ===================== ! 240 END DO ! END LOOP OVER FIELD ! 241 ! ! ===================== ! 242 243 IF( kt == nit000 .AND. lwp ) CALL wgt_print() 244 245 !! Vector fields may need to be rotated onto the local grid direction 246 !! This has to happen before the time interpolations 247 !! (sga: following code should be modified so that pairs arent searched for each time 248 249 DO jf = 1, imf 250 !! find vector rotations required 251 IF( LEN(TRIM(sd(jf)%vcomp)) > 0 ) THEN 252 !! east-west component has symbolic name starting with 'U' 253 IF( sd(jf)%vcomp(1:1) == 'U' ) THEN 254 !! found an east-west component, look for the north-south component 255 !! which has same symbolic name but with 'U' replaced with 'V' 256 nf = LEN_TRIM( sd(jf)%vcomp ) 257 IF( nf == 1) THEN 258 acomp = 'V' 259 ELSE 260 acomp = 'V' // sd(jf)%vcomp(2:nf) 261 ENDIF 262 kf = -1 263 DO nf = 1, imf 264 IF( TRIM(sd(nf)%vcomp) == TRIM(acomp) ) kf = nf 265 END DO 266 IF( kf > 0 ) THEN 267 !! fields jf,kf are two components which need to be rotated together 268 IF( sd(jf)%ln_tint )THEN 269 DO nf = 1,2 270 !! check each time level of this pair 271 IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN 272 utmp(:,:) = 0.0 273 vtmp(:,:) = 0.0 274 ! 275 ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 276 DO jk = 1,ipk 277 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 278 CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 279 sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 280 sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 281 ENDDO 282 ! 283 sd(jf)%rotn(nf) = .TRUE. 284 sd(kf)%rotn(nf) = .TRUE. 285 IF( lwp .AND. kt == nit000 ) & 286 WRITE(numout,*) 'fld_read: vector pair (', & 287 TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), & 288 ') rotated on to model grid' 289 ENDIF 290 END DO 291 ELSE 292 !! check each time level of this pair 293 IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN 294 utmp(:,:) = 0.0 295 vtmp(:,:) = 0.0 296 ! 297 ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 298 DO jk = 1,ipk 299 CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->i', utmp(:,:) ) 300 CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->j', vtmp(:,:) ) 301 sd(jf)%fnow(:,:,jk) = utmp(:,:) 302 sd(kf)%fnow(:,:,jk) = vtmp(:,:) 303 ENDDO 304 ! 305 sd(jf)%rotn(nf) = .TRUE. 306 sd(kf)%rotn(nf) = .TRUE. 307 IF( lwp .AND. kt == nit000 ) & 308 WRITE(numout,*) 'fld_read: vector pair (', & 309 TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), & 310 ') rotated on to model grid' 311 ENDIF 312 ENDIF 313 ENDIF 314 ENDIF 315 ENDIF 316 END DO 317 318 ! ! ===================== ! 319 DO jf = 1, imf ! LOOP OVER FIELD ! 320 ! ! ===================== ! 321 ! 322 ! update field at each kn_fsbc time-step 323 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 217 END DO ! --- end loop over field --- ! 218 219 CALL fld_rot( kt, sd ) ! rotate vector fiels if needed 220 221 DO jf = 1, imf ! --- loop over field --- ! 324 222 ! 325 IF( sd(jf)%ln_tint ) THEN 223 IF( sd(jf)%ln_tint ) THEN ! temporal interpolation 326 224 IF(lwp .AND. kt - nit000 <= 100 ) THEN 327 clfmt = "('fld_read: var ', a, ' kt = ', i8, 'Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // &328 & "' records b/a: ', i4.4, '/', i4.4, ' (', f7.2,'/', f7.2, ' days)')"329 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, nyear, nmonth, nday, &225 clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 226 & "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 227 WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 330 228 & 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 331 229 ENDIF 332 ! 333 ztinta = REAL( nsec_year + nsec1jan000- sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp )230 ! temporal interpolation weights 231 ztinta = REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 334 232 ztintb = 1. - ztinta 335 233 !CDIR COLLAPSE 336 234 sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 337 ELSE 235 ELSE ! nothing to do... 338 236 IF(lwp .AND. kt - nit000 <= 100 ) THEN 339 clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 340 & "' record: ', i4.4, ' at ', f7.2, ' day')" 341 WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, nyear, nmonth, nday, sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_a(2),wp)/rday 237 clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 238 & "', record: ', i4.4, ' (days ', f7.2, ' <-> ', f7.2, ')')" 239 WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday, & 240 & sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 342 241 ENDIF 343 !CDIR COLLAPSE344 242 ENDIF 345 243 ! 346 ENDIF 347 348 IF( kt == nitend ) CALL iom_close( sd(jf)%num ) ! Close the input files 349 350 ! ! ===================== ! 351 END DO ! END LOOP OVER FIELD ! 352 ! ! ===================== ! 244 IF( kt == nitend - kn_fsbc + 1 ) CALL iom_close( sd(jf)%num ) ! Close the input files 245 246 END DO ! --- end loop over field --- ! 247 ! 248 ! ! ====================================== ! 249 ENDIF ! update field at each kn_fsbc time-step ! 250 ! ! ====================================== ! 251 ! 353 252 END SUBROUTINE fld_read 354 253 355 254 356 SUBROUTINE fld_init( sdjf )255 SUBROUTINE fld_init( kn_fsbc, sdjf ) 357 256 !!--------------------------------------------------------------------- 358 257 !! *** ROUTINE fld_init *** … … 363 262 !! ** Method : 364 263 !!---------------------------------------------------------------------- 365 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 264 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 265 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 366 266 !! 367 267 LOGICAL :: llprevyr ! are we reading previous year file? 368 268 LOGICAL :: llprevmth ! are we reading previous month file? 369 LOGICAL :: llprevweek ! are we reading previous week file?269 LOGICAL :: llprevweek ! are we reading previous week file? 370 270 LOGICAL :: llprevday ! are we reading previous day file? 371 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprev day271 LOGICAL :: llprev ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 372 272 INTEGER :: idvar ! variable id 373 273 INTEGER :: inrec ! number of record existing for this variable 374 INTEGER :: kwgt375 INTEGER :: jk !vertical loop variable376 INTEGER :: ipk !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )377 274 INTEGER :: iyear, imonth, iday ! first day of the current file in yyyy mm dd 378 275 INTEGER :: isec_week ! number of seconds since start of the weekly file … … 389 286 isec_week = 0 390 287 288 IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy == 0 ) & 289 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs nn_leapy = 1') 290 IF( sdjf%cltype(1:4) == 'week' .AND. sdjf%ln_clim ) & 291 & CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs ln_clim = .FALSE.') 292 391 293 ! define record informations 392 CALL fld_rec( sdjf ) 294 CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. ) ! return before values in sdjf%nrec_a (as we will swap it later) 295 296 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 393 297 394 298 IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure 395 396 IF( sdjf%nrec_b(1) == 0 ) THEN ! we redefine record sdjf%nrec_b(1) with the last record of previous year file 397 IF( sdjf%nfreqh == -1 ) THEN ! monthly mean 398 IF( sdjf%cltype == 'monthly' ) THEN ! monthly file 399 sdjf%nrec_b(1) = 1 ! force to read the unique record 299 300 IF( sdjf%nrec_a(1) == 0 ) THEN ! we redefine record sdjf%nrec_a(1) with the last record of previous year file 301 IF ( sdjf%nfreqh == -12 ) THEN ! yearly mean 302 IF( sdjf%cltype == 'yearly' ) THEN ! yearly file 303 sdjf%nrec_a(1) = 1 ! force to read the unique record 304 llprevyr = .NOT. sdjf%ln_clim ! use previous year file? 305 ELSE 306 CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clname) ) 307 ENDIF 308 ELSEIF( sdjf%nfreqh == -1 ) THEN ! monthly mean 309 IF( sdjf%cltype == 'monthly' ) THEN ! monthly file 310 sdjf%nrec_a(1) = 1 ! force to read the unique record 400 311 llprevmth = .TRUE. ! use previous month file? 401 312 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 402 ELSE ! yearly file403 sdjf%nrec_ b(1) = 12 ! force to read december mean313 ELSE ! yearly file 314 sdjf%nrec_a(1) = 12 ! force to read december mean 404 315 llprevyr = .NOT. sdjf%ln_clim ! use previous year file? 405 316 ENDIF 406 ELSE 407 IF ( sdjf%cltype== 'monthly' ) THEN ! monthly file408 sdjf%nrec_ b(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh ! last record of previous month409 llprevmth = . NOT. sdjf%ln_clim! use previous month file?317 ELSE ! higher frequency mean (in hours) 318 IF ( sdjf%cltype == 'monthly' ) THEN ! monthly file 319 sdjf%nrec_a(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh ! last record of previous month 320 llprevmth = .TRUE. ! use previous month file? 410 321 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 411 ELSE IF ( sdjf%cltype(1:4) == 'week' ) THEN !weekly file 412 isec_week = 86400 * 7 413 sdjf%nrec_b(1) = 24. / sdjf%nfreqh * 7 ! last record of previous weekly file 414 ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 415 sdjf%nrec_b(1) = 24 / sdjf%nfreqh ! last record of previous day 416 llprevday = .NOT. sdjf%ln_clim ! use previous day file? 322 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ! weekly file 323 llprevweek = .TRUE. ! use previous week file? 324 sdjf%nrec_a(1) = 24 * 7 / sdjf%nfreqh ! last record of previous week 325 isec_week = NINT(rday) * 7 ! add a shift toward previous week 326 ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 327 sdjf%nrec_a(1) = 24 / sdjf%nfreqh ! last record of previous day 328 llprevday = .TRUE. ! use previous day file? 417 329 llprevmth = llprevday .AND. nday == 1 ! use previous month file? 418 330 llprevyr = llprevmth .AND. nmonth == 1 ! use previous year file? 419 ELSE ! yearly file420 sdjf%nrec_ b(1) = 24 * nyear_len(0) / sdjf%nfreqh ! last record of year month331 ELSE ! yearly file 332 sdjf%nrec_a(1) = 24 * nyear_len(0) / sdjf%nfreqh ! last record of previous year 421 333 llprevyr = .NOT. sdjf%ln_clim ! use previous year file? 422 334 ENDIF 423 335 ENDIF 424 336 ENDIF 337 IF ( sdjf%cltype(1:4) == 'week' ) THEN 338 isec_week = isec_week + ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week 339 llprevmth = isec_week > nsec_month ! longer time since the beginning of the week than the month 340 llprevyr = llprevmth .AND. nmonth == 1 341 ENDIF 425 342 llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 426 427 CALL fld_clopn( sdjf, nyear - COUNT((/llprevyr /)) , &428 & nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)), &429 & nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev )430 431 IF ( sdjf%cltype(1:4) == 'week' ) THEN432 isec_week = ksec_week( sdjf%cltype(6:8) )433 if(lwp)write(numout,*)'cbr test2 isec_week = ',isec_week434 llprevmth = ( isec_week .GT. nsec_month )435 llprevyr = llprevmth .AND. nmonth==1436 ENDIF437 343 ! 438 344 iyear = nyear - COUNT((/llprevyr /)) 439 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))440 iday = nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - INT( isec_week )/86400441 ! 442 CALL fld_clopn( sdjf , iyear , imonth , iday, .NOT. llprev )345 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 346 iday = nday - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 347 ! 348 CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev ) 443 349 444 350 ! if previous year/month/day file does not exist, we switch to the current year/month/day 445 351 IF( llprev .AND. sdjf%num <= 0 ) THEN 446 CALL ctl_warn( 'previous year/month/day file: '//TRIM(sdjf%clname)//' not present -> back to current year/month/day') 352 CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clname)// & 353 & ' not present -> back to current year/month/week/day' ) 447 354 ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day 448 llprev = . false.449 sdjf%nrec_ b(1) = 1355 llprev = .FALSE. 356 sdjf%nrec_a(1) = 1 450 357 CALL fld_clopn( sdjf, nyear, nmonth, nday ) 451 358 ENDIF … … 455 362 IF( idvar <= 0 ) RETURN 456 363 inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar ) ! size of the last dim of idvar 457 sdjf%nrec_b(1) = MIN( sdjf%nrec_b(1), inrec ) ! make sure we select an existing record 458 ENDIF 459 460 ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 461 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 462 CALL wgt_list( sdjf, kwgt ) 463 ipk = SIZE(sdjf%fnow,3) 464 IF( sdjf%ln_tint ) THEN 465 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 466 ELSE 467 CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fnow(:,:,:) , sdjf%nrec_a(1) ) 468 ENDIF 364 sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec ) ! make sure we select an existing record 365 ENDIF 366 367 ! read before data 368 CALL fld_get( sdjf ) ! read before values in after arrays(as we will swap it later) 369 370 clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 371 IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 372 373 IF( llprev ) CALL iom_close( sdjf%num ) ! force to close previous year file (-> redefine sdjf%num to 0) 374 375 ENDIF 376 377 ! make sure current year/month/day file is opened 378 IF( sdjf%num <= 0 ) THEN 379 ! 380 IF ( sdjf%cltype(1:4) == 'week' ) THEN 381 isec_week = ksec_week( sdjf%cltype(6:8) ) ! second since the beginning of the week 382 llprevmth = isec_week > nsec_month ! longer time since beginning of the week than the month 383 llprevyr = llprevmth .AND. nmonth == 1 469 384 ELSE 470 SELECT CASE( SIZE(sdjf%fnow,3) ) 471 CASE(1) 472 IF( sdjf%ln_tint ) THEN 473 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 474 ELSE 475 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1) , sdjf%nrec_b(1) ) 476 ENDIF 477 CASE(jpk) 478 IF( sdjf%ln_tint ) THEN 479 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 480 ELSE 481 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:) , sdjf%nrec_b(1) ) 482 ENDIF 483 END SELECT 484 ENDIF 485 sdjf%rotn(2) = .FALSE. 486 487 clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 488 IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_b(1), REAL(sdjf%nrec_b(2),wp)/rday 489 490 IF( llprev ) CALL iom_close( sdjf%num ) ! close previous year file (-> redefine sdjf%num to 0) 491 492 ENDIF 493 494 IF( sdjf%num <= 0 ) CALL fld_clopn( sdjf, nyear, nmonth, nday ) ! make sure current year/month/day file is opened 495 ! make sure current year/month/day file is opened 496 IF( sdjf%num == 0 ) THEN 497 isec_week = 0 498 llprevyr = .FALSE. 499 llprevmth = .FALSE. 500 llprevweek = .FALSE. 501 ! 502 IF ( sdjf%cltype(1:4) == 'week' ) THEN 503 isec_week = ksec_week( sdjf%cltype(6:8) ) 504 llprevmth = ( isec_week .GT. nsec_month ) 505 llprevyr = llprevmth .AND. nmonth==1 385 isec_week = 0 386 llprevmth = .FALSE. 387 llprevyr = .FALSE. 506 388 ENDIF 507 389 ! 508 390 iyear = nyear - COUNT((/llprevyr /)) 509 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))510 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week /86400391 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 392 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 511 393 ! 512 394 CALL fld_clopn( sdjf, iyear, imonth, iday ) 513 395 ENDIF 514 396 515 sdjf%nswap_sec = nsec_year + nsec1jan000 - 1 ! force read/update the after data in the following part of fld_read516 517 518 397 END SUBROUTINE fld_init 519 398 520 399 521 SUBROUTINE fld_rec( sdjf)400 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore ) 522 401 !!--------------------------------------------------------------------- 523 402 !! *** ROUTINE fld_rec *** 524 403 !! 525 !! ** Purpose : compute nrec_a, nrec_b and nswap_sec 404 !! ** Purpose : Compute 405 !! if sdjf%ln_tint = .TRUE. 406 !! nrec_a: record number and its time (nrec_b is obtained from nrec_a when swapping) 407 !! if sdjf%ln_tint = .FALSE. 408 !! nrec_a(1): record number 409 !! nrec_b(2) and nrec_a(2): time of the beginning and end of the record (for print only) 526 410 !! 527 411 !! ** Method : 528 412 !!---------------------------------------------------------------------- 529 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 530 !! 531 INTEGER :: irec ! record number 532 INTEGER :: isecd ! rday 533 REAL(wp) :: ztmp ! temporary variable 413 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 414 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 415 LOGICAL , INTENT(in ), OPTIONAL :: ldbefore ! sent back before record values (default = .FALSE.) 416 ! used only if sdjf%ln_tint = .TRUE. 417 !! 418 LOGICAL :: llbefore ! local definition of ldbefore 419 INTEGER :: iendrec ! end of this record (in seconds) 420 INTEGER :: imth ! month number 534 421 INTEGER :: ifreq_sec ! frequency mean (in seconds) 535 422 INTEGER :: isec_week ! number of seconds since the start of the weekly file 536 !!---------------------------------------------------------------------- 537 ! 538 IF( sdjf%nfreqh == -1 ) THEN ! monthly mean 423 REAL(wp) :: ztmp ! temporary variable 424 !!---------------------------------------------------------------------- 425 ! 426 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 427 ! 428 IF( PRESENT(ldbefore) ) THEN ; llbefore = ldbefore .AND. sdjf%ln_tint ! needed only if sdjf%ln_tint = .TRUE. 429 ELSE ; llbefore = .FALSE. 430 ENDIF 431 ! 432 ! ! =========== ! 433 IF ( sdjf%nfreqh == -12 ) THEN ! yearly mean 434 ! ! =========== ! 435 ! 436 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 437 ! 438 ! INT( ztmp ) 439 ! /|\ 440 ! 1 | *---- 441 ! 0 |----( 442 ! |----+----|--> time 443 ! 0 /|\ 1 (nday/nyear_len(1)) 444 ! | 445 ! | 446 ! forcing record : 1 447 ! 448 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 449 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 450 ! swap at the middle of the year 451 IF( llbefore ) THEN ; sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0) 452 ELSE ; sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1) 453 ENDIF 454 ELSE ! no time interpolation 455 sdjf%nrec_a(1) = 1 456 sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000 ! swap at the end of the year 457 sdjf%nrec_b(2) = nsec1jan000 ! beginning of the year (only for print) 458 ENDIF 459 ! 460 ! ! ============ ! 461 ELSEIF( sdjf%nfreqh == -1 ) THEN ! monthly mean ! 462 ! ! ============ ! 539 463 ! 540 464 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record … … 550 474 ! forcing record : nmonth 551 475 ! 552 ztmp = 0.e0 553 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 554 ELSE 555 ztmp = 0.e0 556 ENDIF 557 irec = nmonth + INT( ztmp ) 558 559 IF( sdjf%ln_tint ) THEN ; sdjf%nswap_sec = nmonth_half(irec) + nsec1jan000 ! swap at the middle of the month 560 ELSE ; sdjf%nswap_sec = nmonth_end (irec) + nsec1jan000 ! swap at the end of the month 561 ENDIF 562 563 IF( sdjf%cltype == 'monthly' ) THEN 564 565 sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /) 566 sdjf%nrec_a(:) = (/ 1, nmonth_half(irec ) + nsec1jan000 /) 567 568 IF( ztmp == 1. ) THEN 569 sdjf%nrec_b(1) = 1 570 sdjf%nrec_a(1) = 2 476 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 477 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 478 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 479 ELSE ; sdjf%nrec_a(1) = imth 571 480 ENDIF 572 573 ELSE 574 575 sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define after record number and time 576 irec = irec - 1 ! move back to previous record 577 sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /) ! define before record number and time 578 579 ENDIF 580 ! 581 ELSE ! higher frequency mean (in hours) 582 ! 583 ifreq_sec = sdjf%nfreqh * 3600 ! frequency mean (in seconds) 584 IF( sdjf%cltype(1:4) == 'week' ) isec_week = ksec_week( sdjf%cltype(6:8)) !since the first day of the current week 481 sdjf%nrec_a(2) = nmonth_half( imth ) + nsec1jan000 ! swap at the middle of the month 482 ELSE ! no time interpolation 483 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 484 ELSE ; sdjf%nrec_a(1) = nmonth 485 ENDIF 486 sdjf%nrec_a(2) = nmonth_end(nmonth ) + nsec1jan000 ! swap at the end of the month 487 sdjf%nrec_b(2) = nmonth_end(nmonth-1) + nsec1jan000 ! beginning of the month (only for print) 488 ENDIF 489 ! 490 ! ! ================================ ! 491 ELSE ! higher frequency mean (in hours) 492 ! ! ================================ ! 493 ! 494 ifreq_sec = sdjf%nfreqh * 3600 ! frequency mean (in seconds) 495 IF( sdjf%cltype(1:4) == 'week' ) isec_week = ksec_week( sdjf%cltype(6:8) ) ! since the first day of the current week 585 496 ! number of second since the beginning of the file 586 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month ,wp) ! since 00h on the 1st day of the current month 587 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; ztmp = REAL(isec_week ,wp) ! since the first day of the current week 588 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 589 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 590 ENDIF 497 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = REAL(nsec_month,wp) ! since the first day of the current month 498 ELSEIF( sdjf%cltype(1:4) == 'week' ) THEN ; ztmp = REAL(isec_week ,wp) ! since the first day of the current week 499 ELSEIF( sdjf%cltype == 'daily' ) THEN ; ztmp = REAL(nsec_day ,wp) ! since 00h of the current day 500 ELSE ; ztmp = REAL(nsec_year ,wp) ! since 00h on Jan 1 of the current year 501 ENDIF 502 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) ! shift time to be centrered in the middle of sbc time step 503 ztmp = ztmp + 0.01 * rdttra(1) ! add 0.01 time step to avoid truncation error 591 504 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 592 505 ! … … 602 515 ! forcing record : 1 2 3 603 516 ! 604 ztmp= ztmp / ifreq_sec+ 0.5605 ELSE 517 ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5 518 ELSE ! no time interpolation 606 519 ! 607 520 ! INT( ztmp ) … … 616 529 ! forcing record : 1 2 3 617 530 ! 618 ztmp= ztmp / ifreq_sec 619 ENDIF 620 irec = 1 + INT( ztmp ) 621 622 isecd = NINT(rday) 623 ! after record index and second since Jan. 1st 00h of nit000 year 624 sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 625 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month 626 sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1)) ! ok if nmonth=1 627 IF( sdjf%cltype(1:4) == 'week' ) & ! add the number of seconds between 00h Jan 1 and the end of previous week 628 sdjf%nrec_a(2) = sdjf%nrec_a(2) + ( nsec_year - isec_week ) 629 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 630 sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 ) 631 632 ! before record index and second since Jan. 1st 00h of nit000 year 633 irec = irec - 1. ! move back to previous record 634 sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 635 IF( sdjf%cltype == 'monthly' ) & ! add the number of seconds between 00h Jan 1 and the end of previous month 636 sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1)) ! ok if nmonth=1 637 IF( sdjf%cltype(1:4) == 'week' ) & ! add the number of seconds between 00h Jan 1 and the end of previous week 638 sdjf%nrec_b(2) = sdjf%nrec_b(2) + ( nsec_year - isec_week ) 639 IF( sdjf%cltype == 'daily' ) & ! add the number of seconds between 00h Jan 1 and the end of previous day 640 sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 ) 641 642 ! swapping time in second since Jan. 1st 00h of nit000 year 643 IF( sdjf%ln_tint ) THEN ; sdjf%nswap_sec = sdjf%nrec_a(2) ! swap at the middle of the record 644 ELSE ; sdjf%nswap_sec = sdjf%nrec_a(2) + ifreq_sec / 2 ! swap at the end of the record 645 ENDIF 531 ztmp= ztmp / REAL(ifreq_sec, wp) 532 ENDIF 533 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) ! record nomber to be read 534 535 iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000 ! end of this record (in second) 536 ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1) 537 IF( sdjf%cltype == 'monthly' ) iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1)) 538 IF( sdjf%cltype(1:4) == 'week' ) iendrec = iendrec + ( nsec_year - isec_week ) 539 IF( sdjf%cltype == 'daily' ) iendrec = iendrec + NINT(rday) * ( nday_year - 1 ) 540 IF( sdjf%ln_tint ) THEN 541 sdjf%nrec_a(2) = iendrec - ifreq_sec / 2 ! swap at the middle of the record 542 ELSE 543 sdjf%nrec_a(2) = iendrec ! swap at the end of the record 544 sdjf%nrec_b(2) = iendrec - ifreq_sec ! beginning of the record (only for print) 545 ENDIF 646 546 ! 647 547 ENDIF … … 650 550 651 551 552 SUBROUTINE fld_get( sdjf ) 553 !!--------------------------------------------------------------------- 554 !! *** ROUTINE fld_clopn *** 555 !! 556 !! ** Purpose : read the data 557 !! 558 !! ** Method : 559 !!---------------------------------------------------------------------- 560 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 561 !! 562 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 563 INTEGER :: iw ! index into wgts array 564 !!--------------------------------------------------------------------- 565 566 ipk = SIZE( sdjf%fnow, 3 ) 567 IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 568 CALL wgt_list( sdjf, iw ) 569 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 570 ELSE ; CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk , sdjf%fnow(:,:,: ), sdjf%nrec_a(1) ) 571 ENDIF 572 ELSE 573 SELECT CASE( ipk ) 574 CASE(1) 575 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 576 ELSE ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec_a(1) ) 577 ENDIF 578 CASE(jpk) 579 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 580 ELSE ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1) ) 581 ENDIF 582 END SELECT 583 ENDIF 584 ! 585 sdjf%rotn = .false. ! vector not yet rotated 586 587 END SUBROUTINE fld_get 588 589 590 SUBROUTINE fld_rot( kt, sd ) 591 !!--------------------------------------------------------------------- 592 !! *** ROUTINE fld_clopn *** 593 !! 594 !! ** Purpose : Vector fields may need to be rotated onto the local grid direction 595 !! 596 !! ** Method : 597 !!---------------------------------------------------------------------- 598 INTEGER , INTENT(in ) :: kt ! ocean time step 599 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 600 !! 601 INTEGER :: ju, jv, jk ! loop indices 602 INTEGER :: imf ! size of the structure sd 603 INTEGER :: ill ! character length 604 INTEGER :: iv ! indice of V component 605 REAL(wp), DIMENSION(jpi,jpj) :: utmp, vtmp ! temporary arrays for vector rotation 606 CHARACTER (LEN=100) :: clcomp ! dummy weight name 607 !!--------------------------------------------------------------------- 608 !! (sga: following code should be modified so that pairs arent searched for each time 609 ! 610 imf = SIZE( sd ) 611 DO ju = 1, imf 612 ill = LEN_TRIM( sd(ju)%vcomp ) 613 IF( ill > 0 .AND. .NOT. sd(ju)%rotn ) THEN ! find vector rotations required 614 IF( sd(ju)%vcomp(1:1) == 'U' ) THEN ! east-west component has symbolic name starting with 'U' 615 ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V' 616 clcomp = 'V' // sd(ju)%vcomp(2:ill) ! works even if ill == 1 617 iv = -1 618 DO jv = 1, imf 619 IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) ) iv = jv 620 END DO 621 IF( iv > 0 ) THEN ! fields ju and iv are two components which need to be rotated together 622 DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 623 IF( sd(ju)%ln_tint )THEN 624 CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->i', utmp(:,:) ) 625 CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->j', vtmp(:,:) ) 626 sd(ju)%fdta(:,:,jk,2) = utmp(:,:) ; sd(iv)%fdta(:,:,jk,2) = vtmp(:,:) 627 ELSE 628 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->i', utmp(:,:) ) 629 CALL rot_rep( sd(ju)%fnow(:,:,jk ), sd(iv)%fnow(:,:,jk ), 'T', 'en->j', vtmp(:,:) ) 630 sd(ju)%fnow(:,:,jk ) = utmp(:,:) ; sd(iv)%fnow(:,:,jk ) = vtmp(:,:) 631 ENDIF 632 END DO 633 sd(ju)%rotn = .TRUE. ! vector was rotated 634 IF( lwp .AND. kt == nit000 ) WRITE(numout,*) & 635 & 'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid' 636 ENDIF 637 ENDIF 638 ENDIF 639 END DO 640 END SUBROUTINE fld_rot 641 642 652 643 SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop ) 653 644 !!--------------------------------------------------------------------- … … 658 649 !! ** Method : 659 650 !!---------------------------------------------------------------------- 660 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 661 INTEGER , INTENT(in ) :: kyear ! year value 662 INTEGER , INTENT(in ) :: kmonth ! month value 663 INTEGER , INTENT(in ) :: kday ! day value 664 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 665 INTEGER :: iyear, imonth, iday ! firt day of the current week in yyyy mm dd 666 REAL(wp) :: zsec, zjul !temp variable 651 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 652 INTEGER , INTENT(in ) :: kyear ! year value 653 INTEGER , INTENT(in ) :: kmonth ! month value 654 INTEGER , INTENT(in ) :: kday ! day value 655 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 667 656 668 657 IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open … … 670 659 sdjf%clname=TRIM(sdjf%clrootname) 671 660 ! 672 IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy==0 )CALL ctl_stop( 'fld_clopn: weekly file and nn_leapy=0 are not compatible' ) 673 ! 661 ! note that sdjf%ln_clim is is only acting on presence of the year in the file 674 662 IF( .NOT. sdjf%ln_clim ) THEN 675 WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 676 IF( sdjf%cltype /= 'yearly' ) & 677 & WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 678 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 679 & WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 663 WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear ! add year 664 IF( sdjf%cltype /= 'yearly' ) WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth ! add month 680 665 ELSE 681 666 ! build the new filename if climatological data 682 IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month667 IF( sdjf%cltype /= 'yearly' ) WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth ! add month 683 668 ENDIF 669 IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 670 & WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday ! add day 671 ! 684 672 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 685 673 ! … … 837 825 LOGICAL :: cyclical 838 826 INTEGER :: zwrap ! temporary integer 839 INTEGER :: overlap ! temporary integer840 827 !!---------------------------------------------------------------------- 841 828 ! … … 940 927 ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration. 941 928 ! a more robust solution will be given in next release 942 ipk = SIZE(sd%fnow, 3)929 ipk = SIZE(sd%fnow, 3) 943 930 ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 944 931 IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col(1,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) … … 1113 1100 END SUBROUTINE fld_interp 1114 1101 1102 1115 1103 FUNCTION ksec_week( cdday ) 1116 1104 !!--------------------------------------------------------------------- … … 1129 1117 !!---------------------------------------------------------------------- 1130 1118 cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/) 1131 DO ijul =1,71132 IF( cl_week(ijul)==TRIM(cdday) ) EXIT1119 DO ijul = 1, 7 1120 IF( cl_week(ijul) == TRIM(cdday) ) EXIT 1133 1121 ENDDO 1134 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): ',TRIM(cdday) )1135 ! 1136 ishift = ( ijul ) * 864001122 IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): '//TRIM(cdday) ) 1123 ! 1124 ishift = ijul * NINT(rday) 1137 1125 ! 1138 1126 ksec_week = nsec_week + ishift 1139 ksec_week = MOD( ksec_week , 86400*7 ) 1140 if(lwp)write(numout,*)'cbr ijul ksec_week ',ijul,ksec_week 1127 ksec_week = MOD( ksec_week, 7*NINT(rday) ) 1141 1128 ! 1142 1129 END FUNCTION ksec_week 1143 1130 1131 1144 1132 END MODULE fldread
Note: See TracChangeset
for help on using the changeset viewer.
