Changeset 1132 for trunk/NEMO/OPA_SRC/SBC/fldread.F90
- Timestamp:
- 2008-06-24T17:14:21+02:00 (16 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/SBC/fldread.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/SBC/fldread.F90
r892 r1132 26 26 CHARACTER(len = 34) :: clvar ! generic name of the variable in the NetCDF flux file 27 27 LOGICAL :: ln_tint ! time interpolation or not (T/F) 28 INTEGER :: nclim ! =0 interannuel, =1 climatology29 INTEGER :: nstrec ! starting record, used if nclim=1 (=0 last record of previous year)28 LOGICAL :: ln_clim ! climatology or not (T/F) 29 CHARACTER(len = 7) :: cltype ! type of data file 'monthly' or yearly' 30 30 END TYPE FLD_N 31 31 … … 36 36 CHARACTER(len = 34) :: clvar ! generic name of the variable in the NetCDF flux file 37 37 LOGICAL :: ln_tint ! time interpolation or not (T/F) 38 INTEGER :: nyear ! year of the file (=0000 if climatology) 39 INTEGER :: nclim ! =0 interannuel, =1 climatology 40 INTEGER :: nstrec ! starting record if nclim=1 (=0 last record of previous year) 41 INTEGER :: num ! logical units of the jpfld files to be read 42 REAL(wp) , DIMENSION(2) :: rec_b ! before record info (1: index, 2: second since Jan. 1st 00h) 43 REAL(wp) , DIMENSION(2) :: rec_n ! now record info (1: index, 2: second since Jan. 1st 00h) 44 REAL(wp) , DIMENSION(2) :: rec_a ! next record info (1: index, 2: second since Jan. 1st 00h) 45 REAL(wp) , DIMENSION(2) :: rec ! record time in second since jan. 1st for the 2 records read 38 LOGICAL :: ln_clim ! climatology or not (T/F) 39 CHARACTER(len = 7) :: cltype ! type of data file 'monthly' or yearly' 40 INTEGER :: num ! iom id of the jpfld files to be read 41 REAL(wp) :: swap_sec ! swapping time in second since Jan. 1st 00h of nit000 year 42 REAL(wp) , DIMENSION(2) :: rec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year 43 REAL(wp) , DIMENSION(2) :: rec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year 46 44 REAL(wp) , DIMENSION(jpi,jpj) :: fnow ! input fields interpolated to now time step 47 REAL(wp) , DIMENSION(jpi,jpj,2) :: fdta ! 45 REAL(wp) , DIMENSION(jpi,jpj,2) :: fdta ! 2 consecutive record of input fields 48 46 END TYPE FLD 49 47 50 PUBLIC fld_read 48 PUBLIC fld_read, fld_fill ! called by sbc... modules 51 49 52 50 !!---------------------------------------------------------------------- … … 71 69 !!---------------------------------------------------------------------- 72 70 INTEGER , INTENT(in ) :: kt ! ocean time step 73 INTEGER , INTENT(in ) :: kn_fsbc ! ocean time step71 INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) 74 72 TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables 75 73 !! 76 INTEGER :: jf 77 INTEGER :: imf ! size of the structure sd78 REAL(wp) :: z t ! ratio at kt between the 2 records79 REAL(wp), DIMENSION(2) :: zrec_kt80 !!---------------------------------------------------------------------81 82 imf = SIZE( sd ) ! dummy indices83 74 INTEGER :: jf ! dummy indices 75 REAL(wp) :: zreclast ! last record to be read in the current year file 76 REAL(wp) :: zsecend ! number of second since Jan. 1st 00h of nit000 year at nitend 77 LOGICAL :: llnxtyr ! open next year file? 78 LOGICAL :: llstop ! stop is the file is not existing 79 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 80 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 81 !!--------------------------------------------------------------------- 84 82 ! ! ===================== ! 85 DO jf = 1, imf! LOOP OVER FIELD !83 DO jf = 1, SIZE( sd ) ! LOOP OVER FIELD ! 86 84 ! ! ===================== ! 87 85 ! 88 ! ! ====================== ! 89 IF( kt == nit000 ) THEN ! Initialisation ! 90 ! ! ====================== ! 86 IF( kt == nit000 ) CALL fld_init( sd(jf) ) 87 ! 88 ! read/update the after data? 89 IF( rsec_year + sec1jan000 > sd(jf)%swap_sec ) THEN 90 91 IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap before record field 92 !CDIR COLLAPSE 93 sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) 94 ENDIF 95 96 ! update record informations 97 CALL fld_rec( sd(jf) ) 98 99 ! do we have to change the year/month of the forcing field?? 100 IF( sd(jf)%ln_tint ) THEN 101 ! if we do time interpolation we will need to open next year/month file before the end of the current year/month 102 ! if it is the case, we are still before the end of the year/month when calling fld_rec so sd(jf)%rec_a(1) will 103 ! be larger than the record number that should be read for current year/month (for ex. 13 for monthly mean file) 104 105 ! last record to be read in the current file 106 IF( sd(jf)%freqh == -1. ) THEN ; zreclast = 12. 107 ELSE 108 IF( sd(jf)%cltype == 'monthly' ) THEN ; zreclast = 24. / sd(jf)%freqh * REAL( nmonth_len(nmonth), wp ) 109 ELSE ; zreclast = 24. / sd(jf)%freqh * REAL( nyear_len( 1 ), wp ) 110 ENDIF 111 ENDIF 112 113 ! do we need next year data? 114 IF( sd(jf)%rec_a(1) > zreclast ) THEN 115 116 sd(jf)%rec_a(1) = 1. ! force to read the first record of the next year 117 118 IF( .NOT. sd(jf)%ln_clim ) THEN ! close the current file and open a new one. 119 120 llnxtyr = sd(jf)%cltype /= 'monthly' .OR. nmonth == 12 ! do we need to open next year file? 121 ! if the run finishes at the end of the current year/month, we do accept that next year/month file does 122 ! not exist. If the run continue farther than the current year/month, next year/month file must exist 123 zsecend = rsec_year + sec1jan000 + REAL(nitend - kt, wp) * rdttra(1) ! second at the end of the run 124 llstop = zsecend > sd(jf)%swap_sec ! read more than 1 record of next year 125 126 CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr/)), nmonth + 1 - 12 * COUNT((/llnxtyr/)), llstop ) 127 128 IF( sd(jf)%num == 0 .AND. .NOT. llstop ) THEN ! next year file is not existing 129 CALL ctl_warn('next year/month file: '//TRIM(sd(jf)%clname)//' not existing -> back to current year/month') 130 CALL fld_clopn( sd(jf), nyear, nmonth ) ! back to the current year/month 131 sd(jf)%rec_a(1) = zreclast ! force to read the last record to be read in the current year file 132 ENDIF 133 134 ENDIF 135 ENDIF 136 137 ELSE 138 ! if we are not doing time interpolation, we must change the year/month of the file just afer switching 139 ! to the NEW year/month. If it is the case, we are at the beginning of the year/month when calling fld_rec 140 ! so sd(jf)%rec_a(1) = 1 141 IF( sd(jf)%rec_a(1) == 1 ) CALL fld_clopn( sd(jf), nyear, nmonth ) ! back to the current year/month 142 ENDIF 143 144 ! read after data 145 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), NINT( sd(jf)%rec_a(1) ) ) 146 147 ENDIF 148 149 ! update field at each kn_fsbc time-step 150 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 91 151 ! 92 ! ! set filename for current year 93 SELECT CASE( sd(jf)%nclim ) 94 CASE( 0 ) 95 WRITE(sd(jf)%clname, '(a,"_",i4,".nc")' ) TRIM( sd(jf)%clrootname ), nyear 96 sd(jf)%nyear = nyear 97 CASE( 1 ) 98 WRITE(sd(jf)%clname, '(a, ".nc")' ) TRIM( sd(jf)%clrootname ) 99 sd(jf)%nyear = 0000 100 END SELECT 101 CALL iom_open( sd(jf)%clname, sd(jf)%num ) ! open input files 102 ! 103 IF( sd(jf)%ln_tint ) THEN ! time interpolation: read previous record in now field 152 IF( sd(jf)%ln_tint ) THEN 153 IF(lwp .AND. kt - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & 154 & ' kt = ', kt,' Y/M/D = ', nyear,'/', nmonth,'/', nday,' records b/a:', NINT(sd(jf)%rec_b(1)), & 155 & '/', NINT(sd(jf)%rec_a(1)), ' (', sd(jf)%rec_b(2)/rday,'/', sd(jf)%rec_a(2)/rday, ' days)' 104 156 ! 105 sd(jf)%rec_n = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 ) ! record index and time 106 ! 107 ! ! read record 108 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), INT( sd(jf)%rec_n(1) ) ) 109 ! 110 ! ! control print 111 IF(lwp) WRITE(numout,*)'fld_read : time-interpolation for ', TRIM( sd(jf)%clvar ), & 112 & ' read previous record =', INT(sd(jf)%rec_n(1)), ' at time = ', sd(jf)%rec_n(2)/rday, ' days' 113 ! 114 ENDIF 115 ! ! next record to be read 116 sd(jf)%rec_a = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) 117 118 IF(lwp) WRITE(numout,*)' ', & 119 & ' after record =', INT(sd(jf)%rec_a(1)), ' at time = ', sd(jf)%rec_a(2)/rday, ' days' 120 ! 121 ENDIF 122 ! 123 ! ! ============================= ! 124 IF( sd(jf)%nclim == 0 .AND. & ! New Year ! 125 sd(jf)%nyear == nyear - 1 ) THEN ! ============================= ! 126 ! 127 CALL iom_close( sd(jf)%num ) 128 IF(lwp) WRITE(numout,*) 'fldread : switch to a new year= ', nyear 129 WRITE( sd(jf)%clname, '(a,"_",i4,".nc")' ) TRIM( sd(jf)%clrootname ), nyear 130 sd(jf)%nyear = nyear 131 CALL iom_open( sd(jf)%clname, sd(jf)%num ) 132 ! 133 IF( sd(jf)%ln_tint ) THEN ! no record index change, update record time 134 sd(jf)%rec_b(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 ) 135 sd(jf)%rec_n(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) 136 sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, +1 ) 137 ELSE ! ??? 138 sd(jf)%rec_n(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 ) 139 sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) 157 ztinta = ( rsec_year + sec1jan000 - sd(jf)%rec_b(2) ) / ( sd(jf)%rec_a(2) - sd(jf)%rec_b(2) ) 158 ztintb = 1. - ztinta 159 !CDIR COLLAPSE 160 sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) 161 ELSE 162 IF(lwp .AND. kt - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & 163 & ' kt = ', kt, ' Y/M/D = ', nyear,'/', nmonth,'/', nday, ' record :', INT(sd(jf)%rec_a(1)), & 164 & ' at ', sd(jf)%rec_a(2)/rday, 'day' 165 !CDIR COLLAPSE 166 sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2) ! piecewise constant field 167 140 168 ENDIF 141 169 ! 142 170 ENDIF 143 ! 144 ! ! ============================= ! 145 ! ! Read / Update input fields ! 146 ! ! ============================= ! 147 ! 148 ! current record index 149 zrec_kt(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) 150 ! 151 ! read next record (if required) 152 IF( zrec_kt(1) == sd(jf)%rec_a(1) ) THEN 153 ! 154 IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap 155 sd(jf)%rec_b = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 ) ! record index & time 156 !CDIR COLLAPSE 157 sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) ! record field 158 ENDIF 159 ! 160 sd(jf)%rec_n(:) = zrec_kt(:) ! update now record index & time 161 ! ! read record 162 CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), INT( sd(jf)%rec_n(1) ) ) 163 ! 164 ! ! after record index & time 165 sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, +1 ) 166 ! 167 ! ! control print 168 IF( sd(jf)%ln_tint ) THEN 169 IF(lwp .AND. nitend - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & 170 & ' D/M=', nday,'/',nmonth,' rec bna:', INT(sd(jf)%rec_b(1)), INT(sd(jf)%rec_n(1)),INT(sd(jf)%rec_a(1)), & 171 & ' zrec bna', sd(jf)%rec_b(2)/rday, sd(jf)%rec_n(2)/rday, sd(jf)%rec_a(2)/rday 172 ELSE 173 IF(lwp .AND. nitend - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & 174 & ' D/M=', nday,'/',nmonth, ' record :', INT(sd(jf)%rec_n(1)), & 175 & ' at', sd(jf)%rec_n(2)/rday, 'day, next rec', INT(sd(jf)%rec_a(1)) 176 ENDIF 177 ENDIF 178 179 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN !** update field at each kn_fsbc time-step 180 ! 181 IF( sd(jf)%ln_tint ) THEN !* linear time interpolated field 182 zt = ( rsec_year - sd(jf)%rec_b(2) ) / ( sd(jf)%rec_n(2) - sd(jf)%rec_b(2) ) 183 !CDIR COLLAPSE 184 sd(jf)%fnow(:,:) = ( 1. - zt ) * sd(jf)%fdta(:,:,1) + zt * sd(jf)%fdta(:,:,2) 185 ELSE 186 !CDIR COLLAPSE 187 sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2) !* piecewise constant field 188 ENDIF 189 ! 190 ENDIF 191 ! 192 ! ! ======================== ! 193 IF( kt == nitend ) THEN ! Close the input files ! 194 ! ! ======================== ! 195 CALL iom_close( sd(jf)%num ) 196 ENDIF 171 172 IF( kt == nitend ) CALL iom_close( sd(jf)%num ) ! Close the input files 173 197 174 ! ! ===================== ! 198 175 END DO ! END LOOP OVER FIELD ! … … 201 178 202 179 203 FUNCTION fld_rec( pfreq, ld_tint, kclim, kshift ) RESULT( prec_info ) 180 SUBROUTINE fld_init( sdjf ) 181 !!--------------------------------------------------------------------- 182 !! *** ROUTINE fld_init *** 183 !! 184 !! ** Purpose : - if time interpolation, read before data 185 !! - open current year file 186 !! 187 !! ** Method : 188 !!---------------------------------------------------------------------- 189 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 190 !! 191 LOGICAL :: llprevyr ! are we reading previous year file? 192 LOGICAL :: llprevmth ! are we reading previous month file? 193 LOGICAL :: llprev ! llprevyr .OR. llprevmth 194 INTEGER :: idvar ! variable id 195 INTEGER :: inrec ! number of record existing for this variable 196 !!--------------------------------------------------------------------- 197 198 ! some default definitions... 199 sdjf%num = 0 ! default definition for non-opened file 200 IF( sdjf%ln_clim ) sdjf%clname = TRIM( sdjf%clrootname ) ! file name defaut definition, never change in this case 201 llprevyr = .FALSE. 202 llprevmth = .FALSE. 203 204 ! define record informations 205 CALL fld_rec( sdjf ) 206 207 IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure 208 209 IF( sdjf%rec_b(1) == 0.e0 ) THEN ! we redefine record sdjf%rec_b(1) with the last record of previous year file 210 IF( sdjf%freqh == -1. ) THEN ! monthly mean 211 sdjf%rec_b(1) = 12. ! force to read december mean 212 ELSE 213 IF( sdjf%cltype == 'monthly' ) THEN ! monthly file 214 sdjf%rec_b(1) = 24. / sdjf%freqh * REAL( nmonth_len(nmonth-1), wp ) ! last record of previous month 215 llprevmth = sdjf%ln_clim ! use previous month file? 216 llprevyr = sdjf%ln_clim .AND. nmonth == 1 ! use previous year file? 217 ELSE ! yearly file 218 sdjf%rec_b(1) = 24. / sdjf%freqh * REAL( nyear_len(0), wp ) ! last record of year month 219 llprevyr = sdjf%ln_clim ! use previous year file? 220 ENDIF 221 ENDIF 222 ENDIF 223 llprev = llprevyr .OR. llprevmth 224 225 CALL fld_clopn( sdjf, nyear - COUNT((/llprevyr/)), nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr/)), llprev ) 226 227 ! if previous year/month file is not existing, we switch to the current year/month 228 IF( llprev .AND. sdjf%num == 0 ) THEN 229 CALL ctl_warn( 'previous year/month file: '//TRIM(sdjf%clname)//' not existing -> back to current year/month' ) 230 ! we force to read the first record of the current year/month instead of last record of previous year/month 231 llprev = .false. 232 sdjf%rec_b(1) = 1. 233 CALL fld_clopn( sdjf, nyear, nmonth ) 234 ENDIF 235 236 IF( llprev ) THEN ! check if the last record sdjf%rec_n(1) exists in the file 237 idvar = iom_varid( sdjf%num, sdjf%clvar ) ! id of the variable sdjf%clvar 238 IF( idvar <= 0 ) RETURN 239 inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar ) ! size of the last dim of idvar 240 sdjf%rec_b(1) = MIN( sdjf%rec_b(1), REAL( inrec, wp ) ) ! make sure we select an existing record 241 ENDIF 242 243 ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 244 CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), NINT( sdjf%rec_b(1) ) ) 245 246 IF(lwp) WRITE(numout,*)'fld_init : time-interpolation for ', TRIM( sdjf%clvar ), & 247 & ' read previous record =', NINT(sdjf%rec_b(1)), ' at time = ', sdjf%rec_b(2)/rday, ' days' 248 249 IF( llprev ) CALL iom_close( sdjf%num ) ! close previous year file (-> redefine sdjf%num to 0) 250 251 ENDIF 252 253 IF( sdjf%num == 0 ) CALL fld_clopn( sdjf, nyear, nmonth ) ! make sure current year/month file is opened 254 255 sdjf%swap_sec = rsec_year + sec1jan000 - 1. ! force read/update the after data in the following part of fld_read 256 257 END SUBROUTINE fld_init 258 259 260 SUBROUTINE fld_rec( sdjf ) 204 261 !!--------------------------------------------------------------------- 205 262 !! *** ROUTINE fld_rec *** 206 263 !! 207 !! ** Purpose : provide264 !! ** Purpose : compute rec_a, rec_b and swap_sec 208 265 !! 209 266 !! ** Method : 210 267 !!---------------------------------------------------------------------- 211 REAL(wp), INTENT(in) :: pfreq ! record frequency (>0 in hours, <0 in months) 212 LOGICAL , INTENT(in) :: ld_tint ! time interpolation flag (T/F) 213 INTEGER , INTENT(in) :: kclim ! climatology flag (=0/1) 214 INTEGER , INTENT(in) :: kshift ! record shift 215 REAL(wp), DIMENSION(2) :: prec_info ! 1: file record + kshift 216 ! ! 2: associated time [sec] centered at half the record frequency 217 !! 218 INTEGER :: iendh, irec 219 REAL(wp) :: zrec 268 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 269 !! 270 INTEGER :: irec ! record number 271 REAL(wp) :: zrec ! record number 272 REAL(wp) :: ztmp ! temporary variable 273 REAL(wp) :: zfreq_sec ! frequency mean (in seconds) 220 274 !!---------------------------------------------------------------------- 221 275 ! 222 IF( pfreq == -12. ) THEN ! monthly data 223 ! 224 iendh = 12 ! 12 records per year 225 IF( ld_tint) THEN ! time interpolation, shift by 1/2 record 226 zrec = REAL( nday ) / REAL( nmonth_len(nmonth) ) + 0.5 276 IF( sdjf%freqh == -1. ) THEN ! monthly mean 277 ! 278 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 279 ! 280 ! INT( ztmp ) 281 ! /|\ 282 ! 1 | *---- 283 ! 0 |----( 284 ! |----+----|--> time 285 ! 0 /|\ 1 (nday/nmonth_len(nmonth)) 286 ! | 287 ! | 288 ! forcing record : nmonth 289 ! 290 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 227 291 ELSE 228 zrec = REAL( nday - 1 ) / REAL( nmonth_len(nmonth) ) 229 ENDIF 230 irec = nmonth + kshift + INT( zrec ) ! record index (from 0 to 13) 231 zrec = rmonth_half(irec) ! record time (second since 00h, Jan. 1st) 232 ! 233 ELSE ! high frequency data (pfreq in hours) 234 ! 235 iendh = INT( 365 * 24 / pfreq ) ! iendh records per year 236 IF( ld_tint ) THEN ! time interpolation, shift by 1/2 record 237 zrec = rsec_year / ( pfreq * 3600. ) + 0.5 292 ztmp = 0.e0 293 ENDIF 294 irec = nmonth + INT( ztmp ) 295 296 IF( sdjf%ln_tint ) THEN ; sdjf%swap_sec = rmonth_half(irec) ! swap at the middle of the month 297 ELSE ; sdjf%swap_sec = rmonth_end( irec) ! swap at the end of the month 298 ENDIF 299 300 sdjf%rec_a(:) = (/ REAL( irec, wp ), rmonth_half(irec) /) ! define after record number and time 301 irec = irec - 1 ! move back to previous record 302 sdjf%rec_b(:) = (/ REAL( irec, wp ), rmonth_half(irec) /) ! define before record number and time 303 ! 304 ELSE ! higher frequency mean (in hours) 305 ! 306 zfreq_sec = sdjf%freqh * 3600. ! frequency mean (in seconds) 307 ! number of second since the beginning of the file 308 IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = rsec_month ! since Jan 1 of the current year 309 ELSE ; ztmp = rsec_year ! since the first day of the current month 310 ENDIF 311 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 312 ! 313 ! INT( ztmp ) 314 ! /|\ 315 ! 2 | *-----( 316 ! 1 | *-----( 317 ! 0 |--( 318 ! |--+--|--+--|--+--|--> time 319 ! 0 /|\ 1 /|\ 2 /|\ 3 (rsec_year/zfreq_sec) or (rsec_month/zfreq_sec) 320 ! | | | 321 ! | | | 322 ! forcing record : 1 2 3 323 ! 324 ztmp= ztmp / zfreq_sec + 0.5 238 325 ELSE 239 zrec = rsec_year / ( pfreq * 3600. ) 240 ENDIF 241 irec = 1 + kshift + INT( zrec ) ! record index (from 0 to iendh+1) 242 zrec = - 0.5 * 3600. * pfreq + 3600. * pfreq * REAL( irec ) ! record time (second since 00h, Jan. 1st) 326 ! 327 ! INT( ztmp ) 328 ! /|\ 329 ! 2 | *-----( 330 ! 1 | *-----( 331 ! 0 |-----( 332 ! |--+--|--+--|--+--|--> time 333 ! 0 /|\ 1 /|\ 2 /|\ 3 (rsec_year/zfreq_sec) or (rsec_month/zfreq_sec) 334 ! | | | 335 ! | | | 336 ! forcing record : 1 2 3 337 ! 338 ztmp= ztmp / zfreq_sec 339 ENDIF 340 zrec = 1. + REAL( INT( ztmp ), wp ) 341 342 ! after record index and second since Jan. 1st 00h of nit000 year 343 sdjf%rec_a(:) = (/ zrec, zfreq_sec * ( zrec - 0.5 ) + sec1jan000 /) 344 IF( sdjf%cltype == 'monthly' ) & ! add the number of second between Jan 1 and the end of previous month 345 sdjf%rec_a(2) = sdjf%rec_a(2) + rday * REAL(SUM(nmonth_len(1:nmonth -1)), wp) ! ok if nmonth=1 346 347 ! before record index and second since Jan. 1st 00h of nit000 year 348 zrec = zrec - 1. ! move back to previous record 349 sdjf%rec_b(:) = (/ zrec, zfreq_sec * ( zrec - 0.5 ) + sec1jan000 /) 350 IF( sdjf%cltype == 'monthly' ) & ! add the number of second between Jan 1 and the end of previous month 351 sdjf%rec_b(2) = sdjf%rec_b(2) + rday * REAL(SUM(nmonth_len(1:nmonth -1)), wp) ! ok if nmonth=1 352 353 ! swapping time in second since Jan. 1st 00h of nit000 year 354 IF( sdjf%ln_tint ) THEN ; sdjf%swap_sec = sdjf%rec_a(2) ! swap at the middle of the record 355 ELSE ; sdjf%swap_sec = sdjf%rec_a(2) + 0.5 * zfreq_sec ! swap at the end of the record 356 ENDIF 243 357 ! 244 358 ENDIF 245 359 ! 246 ! ! adjuste the record index (climatology or interannual) 247 IF( kclim /= 1 ) THEN 248 irec = irec + 1 ! interannual: additional first record 249 ELSE 250 IF( irec == 0 ) irec = iendh ! climatology: record 0 is the last record (iendh) 251 IF( irec >= iendh + 1 ) irec = MOD( irec, iendh ) ! climatology: apply a modulo iendh 360 END SUBROUTINE fld_rec 361 362 363 SUBROUTINE fld_clopn( sdjf, kyear, kmonth, ldstop ) 364 !!--------------------------------------------------------------------- 365 !! *** ROUTINE fld_clopn *** 366 !! 367 !! ** Purpose : update the file name and open the file 368 !! 369 !! ** Method : 370 !!---------------------------------------------------------------------- 371 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 372 INTEGER , INTENT(in ) :: kyear ! year value 373 INTEGER , INTENT(in ) :: kmonth ! month value 374 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 375 376 IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open 377 ! build the new filename if not climatological data 378 IF( .NOT. sdjf%ln_clim ) THEN ; WRITE(sdjf%clname, '(a,"_y",i4)' ) TRIM( sdjf%clrootname ), kyear ! add year 379 IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"m",i2)' ) TRIM( sdjf%clname ), kmonth ! add month 252 380 ENDIF 381 CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop ) 253 382 ! 254 prec_info(1) = REAL( irec, wp ) 255 prec_info(2) = zrec 383 END SUBROUTINE fld_clopn 384 385 386 SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam ) 387 !!--------------------------------------------------------------------- 388 !! *** ROUTINE fld_fill *** 389 !! 390 !! ** Purpose : fill sdf with sdf_n and control print 391 !! 392 !! ** Method : 393 !!---------------------------------------------------------------------- 394 TYPE(FLD) , DIMENSION(:), INTENT(inout) :: sdf ! structure of input fields (file informations, fields read) 395 TYPE(FLD_N), DIMENSION(:), INTENT(in ) :: sdf_n ! array of namelist information structures 396 CHARACTER(len=*) , INTENT(in ) :: cdir ! Root directory for location of flx files 397 CHARACTER(len=*) , INTENT(in ) :: cdcaller ! 398 CHARACTER(len=*) , INTENT(in ) :: cdtitle ! 399 CHARACTER(len=*) , INTENT(in ) :: cdnam ! 256 400 ! 257 END FUNCTION fld_rec 258 259 !!====================================================================== 401 INTEGER :: jf ! dummy indices 402 !!--------------------------------------------------------------------- 403 404 DO jf = 1, SIZE(sdf) 405 sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname ) 406 sdf(jf)%freqh = sdf_n(jf)%freqh 407 sdf(jf)%clvar = sdf_n(jf)%clvar 408 sdf(jf)%ln_tint = sdf_n(jf)%ln_tint 409 sdf(jf)%ln_clim = sdf_n(jf)%ln_clim 410 IF( sdf(jf)%freqh == -1. ) THEN ; sdf(jf)%cltype = 'yearly' 411 ELSE ; sdf(jf)%cltype = sdf_n(jf)%cltype 412 ENDIF 413 END DO 414 415 IF(lwp) THEN ! control print 416 WRITE(numout,*) 417 WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) 418 WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) 419 WRITE(numout,*) ' '//TRIM( cdnam )//' Namelist' 420 WRITE(numout,*) ' list of files and frequency (>0: in hours ; <0 in months)' 421 DO jf = 1, SIZE(sdf) 422 WRITE(numout,*) ' root filename: ' , TRIM( sdf(jf)%clrootname ), & 423 & ' variable name: ' , TRIM( sdf(jf)%clvar ) 424 WRITE(numout,*) ' frequency: ' , sdf(jf)%freqh , & 425 & ' time interp: ' , sdf(jf)%ln_tint , & 426 & ' climatology: ' , sdf(jf)%ln_clim , & 427 & ' data type: ' , sdf(jf)%cltype 428 END DO 429 ENDIF 430 431 END SUBROUTINE fld_fill 432 433 260 434 END MODULE fldread
Note: See TracChangeset
for help on using the changeset viewer.
