| 1 | MODULE fldread |
|---|
| 2 | !!====================================================================== |
|---|
| 3 | !! *** MODULE fldread *** |
|---|
| 4 | !! Ocean forcing: read input field for surface boundary condition |
|---|
| 5 | !!===================================================================== |
|---|
| 6 | !! History : 9.0 ! 06-06 (G. Madec) Original code |
|---|
| 7 | !!---------------------------------------------------------------------- |
|---|
| 8 | |
|---|
| 9 | !!---------------------------------------------------------------------- |
|---|
| 10 | !! fld_read : read input fields used for the computation of the |
|---|
| 11 | !! surface boundary condition |
|---|
| 12 | !!---------------------------------------------------------------------- |
|---|
| 13 | USE oce ! ocean dynamics and tracers |
|---|
| 14 | USE dom_oce ! ocean space and time domain |
|---|
| 15 | USE phycst ! ??? |
|---|
| 16 | USE daymod ! calendar |
|---|
| 17 | USE in_out_manager ! I/O manager |
|---|
| 18 | USE iom ! I/O manager library |
|---|
| 19 | |
|---|
| 20 | IMPLICIT NONE |
|---|
| 21 | PRIVATE |
|---|
| 22 | |
|---|
| 23 | TYPE, PUBLIC :: FLD_N !: Namelist field informations |
|---|
| 24 | CHARACTER(len = 34) :: clname ! generic name of the NetCDF flux file |
|---|
| 25 | REAL(wp) :: freqh ! frequency of each flux file |
|---|
| 26 | CHARACTER(len = 34) :: clvar ! generic name of the variable in the NetCDF flux file |
|---|
| 27 | LOGICAL :: ln_tint ! time interpolation or not (T/F) |
|---|
| 28 | LOGICAL :: ln_clim ! climatology or not (T/F) |
|---|
| 29 | CHARACTER(len = 7) :: cltype ! type of data file 'monthly' or yearly' |
|---|
| 30 | END TYPE FLD_N |
|---|
| 31 | |
|---|
| 32 | TYPE, PUBLIC :: FLD !: Input field related variables |
|---|
| 33 | CHARACTER(len = 256) :: clrootname ! generic name of the NetCDF file |
|---|
| 34 | CHARACTER(len = 256) :: clname ! current name of the NetCDF file |
|---|
| 35 | REAL(wp) :: freqh ! frequency of each flux file |
|---|
| 36 | CHARACTER(len = 34) :: clvar ! generic name of the variable in the NetCDF flux file |
|---|
| 37 | LOGICAL :: ln_tint ! time interpolation or not (T/F) |
|---|
| 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 |
|---|
| 44 | REAL(wp) , ALLOCATABLE, DIMENSION(:,:) :: fnow ! input fields interpolated to now time step |
|---|
| 45 | REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) :: fdta ! 2 consecutive record of input fields |
|---|
| 46 | END TYPE FLD |
|---|
| 47 | |
|---|
| 48 | PUBLIC fld_read, fld_fill ! called by sbc... modules |
|---|
| 49 | |
|---|
| 50 | !!---------------------------------------------------------------------- |
|---|
| 51 | !! OPA 9.0 , LOCEAN-IPSL (2006) |
|---|
| 52 | !! $Id$ |
|---|
| 53 | !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) |
|---|
| 54 | !!---------------------------------------------------------------------- |
|---|
| 55 | |
|---|
| 56 | CONTAINS |
|---|
| 57 | |
|---|
| 58 | SUBROUTINE fld_read( kt, kn_fsbc, sd ) |
|---|
| 59 | !!--------------------------------------------------------------------- |
|---|
| 60 | !! *** ROUTINE fld_read *** |
|---|
| 61 | !! |
|---|
| 62 | !! ** Purpose : provide at each time step the surface ocean fluxes |
|---|
| 63 | !! (momentum, heat, freshwater and runoff) |
|---|
| 64 | !! |
|---|
| 65 | !! ** Method : READ each input fields in NetCDF files using IOM |
|---|
| 66 | !! and intepolate it to the model time-step. |
|---|
| 67 | !! Several assumptions are made on the input file: |
|---|
| 68 | !! blahblahblah.... |
|---|
| 69 | !!---------------------------------------------------------------------- |
|---|
| 70 | INTEGER , INTENT(in ) :: kt ! ocean time step |
|---|
| 71 | INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) |
|---|
| 72 | TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables |
|---|
| 73 | !! |
|---|
| 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 | CHARACTER(LEN=1000) :: clfmt ! write format |
|---|
| 82 | !!--------------------------------------------------------------------- |
|---|
| 83 | ! ! ===================== ! |
|---|
| 84 | DO jf = 1, SIZE( sd ) ! LOOP OVER FIELD ! |
|---|
| 85 | ! ! ===================== ! |
|---|
| 86 | ! |
|---|
| 87 | IF( kt == nit000 ) CALL fld_init( sd(jf) ) |
|---|
| 88 | ! |
|---|
| 89 | ! read/update the after data? |
|---|
| 90 | IF( rsec_year + sec1jan000 > sd(jf)%swap_sec ) THEN |
|---|
| 91 | |
|---|
| 92 | IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap before record field |
|---|
| 93 | !CDIR COLLAPSE |
|---|
| 94 | sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) |
|---|
| 95 | ENDIF |
|---|
| 96 | |
|---|
| 97 | ! update record informations |
|---|
| 98 | CALL fld_rec( sd(jf) ) |
|---|
| 99 | |
|---|
| 100 | ! do we have to change the year/month of the forcing field?? |
|---|
| 101 | IF( sd(jf)%ln_tint ) THEN |
|---|
| 102 | ! if we do time interpolation we will need to open next year/month file before the end of the current year/month |
|---|
| 103 | ! 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 |
|---|
| 104 | ! be larger than the record number that should be read for current year/month (for ex. 13 for monthly mean file) |
|---|
| 105 | |
|---|
| 106 | ! last record to be read in the current file |
|---|
| 107 | IF( sd(jf)%freqh == -1. ) THEN ; zreclast = 12. |
|---|
| 108 | ELSE |
|---|
| 109 | IF( sd(jf)%cltype == 'monthly' ) THEN ; zreclast = 24. / sd(jf)%freqh * REAL( nmonth_len(nmonth), wp ) |
|---|
| 110 | ELSE ; zreclast = 24. / sd(jf)%freqh * REAL( nyear_len( 1 ), wp ) |
|---|
| 111 | ENDIF |
|---|
| 112 | ENDIF |
|---|
| 113 | |
|---|
| 114 | ! do we need next year data? |
|---|
| 115 | IF( sd(jf)%rec_a(1) > zreclast ) THEN |
|---|
| 116 | |
|---|
| 117 | sd(jf)%rec_a(1) = 1. ! force to read the first record of the next year |
|---|
| 118 | |
|---|
| 119 | IF( .NOT. sd(jf)%ln_clim ) THEN ! close the current file and open a new one. |
|---|
| 120 | |
|---|
| 121 | llnxtyr = sd(jf)%cltype /= 'monthly' .OR. nmonth == 12 ! do we need to open next year file? |
|---|
| 122 | ! if the run finishes at the end of the current year/month, we do accept that next year/month file does |
|---|
| 123 | ! not exist. If the run continue farther than the current year/month, next year/month file must exist |
|---|
| 124 | zsecend = rsec_year + sec1jan000 + REAL(nitend - kt, wp) * rdttra(1) ! second at the end of the run |
|---|
| 125 | llstop = zsecend > sd(jf)%swap_sec ! read more than 1 record of next year |
|---|
| 126 | |
|---|
| 127 | CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr/)), nmonth + 1 - 12 * COUNT((/llnxtyr/)), llstop ) |
|---|
| 128 | |
|---|
| 129 | IF( sd(jf)%num == 0 .AND. .NOT. llstop ) THEN ! next year file is not existing |
|---|
| 130 | CALL ctl_warn('next year/month file: '//TRIM(sd(jf)%clname)//' not existing -> back to current year/month') |
|---|
| 131 | CALL fld_clopn( sd(jf), nyear, nmonth ) ! back to the current year/month |
|---|
| 132 | sd(jf)%rec_a(1) = zreclast ! force to read the last record to be read in the current year file |
|---|
| 133 | ENDIF |
|---|
| 134 | |
|---|
| 135 | ENDIF |
|---|
| 136 | ENDIF |
|---|
| 137 | |
|---|
| 138 | ELSE |
|---|
| 139 | ! if we are not doing time interpolation, we must change the year/month of the file just afer switching |
|---|
| 140 | ! to the NEW year/month. If it is the case, we are at the beginning of the year/month when calling fld_rec |
|---|
| 141 | ! so sd(jf)%rec_a(1) = 1 |
|---|
| 142 | IF( sd(jf)%rec_a(1) == 1 .AND. .NOT. sd(jf)%ln_clim ) CALL fld_clopn( sd(jf), nyear, nmonth ) |
|---|
| 143 | ENDIF |
|---|
| 144 | |
|---|
| 145 | ! read after data |
|---|
| 146 | CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), NINT( sd(jf)%rec_a(1) ) ) |
|---|
| 147 | |
|---|
| 148 | ENDIF |
|---|
| 149 | |
|---|
| 150 | ! update field at each kn_fsbc time-step |
|---|
| 151 | IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN |
|---|
| 152 | ! |
|---|
| 153 | IF( sd(jf)%ln_tint ) THEN |
|---|
| 154 | IF(lwp .AND. kt - nit000 <= 100 ) THEN |
|---|
| 155 | clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & |
|---|
| 156 | & "' records b/a: ', i4.4, '/', i4.4, ' (', f7.2,'/', f7.2, ' days)')" |
|---|
| 157 | WRITE(numout, clfmt) TRIM( sd(jf)%clvar ), kt, nyear, nmonth, nday, & |
|---|
| 158 | & NINT(sd(jf)%rec_b(1)), NINT(sd(jf)%rec_a(1)), sd(jf)%rec_b(2)/rday, sd(jf)%rec_a(2)/rday |
|---|
| 159 | ENDIF |
|---|
| 160 | ! |
|---|
| 161 | ztinta = ( rsec_year + sec1jan000 - sd(jf)%rec_b(2) ) / ( sd(jf)%rec_a(2) - sd(jf)%rec_b(2) ) |
|---|
| 162 | ztintb = 1. - ztinta |
|---|
| 163 | !CDIR COLLAPSE |
|---|
| 164 | sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) |
|---|
| 165 | ELSE |
|---|
| 166 | IF(lwp .AND. kt - nit000 <= 100 ) THEN |
|---|
| 167 | clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & |
|---|
| 168 | & "' record: ', i4.4, ' at ', f7.2, ' day')" |
|---|
| 169 | WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, nyear, nmonth, nday, NINT(sd(jf)%rec_a(1)), sd(jf)%rec_a(2)/rday |
|---|
| 170 | ENDIF |
|---|
| 171 | !CDIR COLLAPSE |
|---|
| 172 | sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2) ! piecewise constant field |
|---|
| 173 | |
|---|
| 174 | ENDIF |
|---|
| 175 | ! |
|---|
| 176 | ENDIF |
|---|
| 177 | |
|---|
| 178 | IF( kt == nitend ) CALL iom_close( sd(jf)%num ) ! Close the input files |
|---|
| 179 | |
|---|
| 180 | ! ! ===================== ! |
|---|
| 181 | END DO ! END LOOP OVER FIELD ! |
|---|
| 182 | ! ! ===================== ! |
|---|
| 183 | END SUBROUTINE fld_read |
|---|
| 184 | |
|---|
| 185 | |
|---|
| 186 | SUBROUTINE fld_init( sdjf ) |
|---|
| 187 | !!--------------------------------------------------------------------- |
|---|
| 188 | !! *** ROUTINE fld_init *** |
|---|
| 189 | !! |
|---|
| 190 | !! ** Purpose : - if time interpolation, read before data |
|---|
| 191 | !! - open current year file |
|---|
| 192 | !! |
|---|
| 193 | !! ** Method : |
|---|
| 194 | !!---------------------------------------------------------------------- |
|---|
| 195 | TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables |
|---|
| 196 | !! |
|---|
| 197 | LOGICAL :: llprevyr ! are we reading previous year file? |
|---|
| 198 | LOGICAL :: llprevmth ! are we reading previous month file? |
|---|
| 199 | LOGICAL :: llprev ! llprevyr .OR. llprevmth |
|---|
| 200 | INTEGER :: idvar ! variable id |
|---|
| 201 | INTEGER :: inrec ! number of record existing for this variable |
|---|
| 202 | CHARACTER(LEN=1000) :: clfmt ! write format |
|---|
| 203 | !!--------------------------------------------------------------------- |
|---|
| 204 | |
|---|
| 205 | ! some default definitions... |
|---|
| 206 | sdjf%num = 0 ! default definition for non-opened file |
|---|
| 207 | IF( sdjf%ln_clim ) sdjf%clname = TRIM( sdjf%clrootname ) ! file name defaut definition, never change in this case |
|---|
| 208 | llprevyr = .FALSE. |
|---|
| 209 | llprevmth = .FALSE. |
|---|
| 210 | |
|---|
| 211 | ! define record informations |
|---|
| 212 | CALL fld_rec( sdjf ) |
|---|
| 213 | |
|---|
| 214 | IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure |
|---|
| 215 | |
|---|
| 216 | IF( sdjf%rec_b(1) == 0.e0 ) THEN ! we redefine record sdjf%rec_b(1) with the last record of previous year file |
|---|
| 217 | IF( sdjf%freqh == -1. ) THEN ! monthly mean |
|---|
| 218 | sdjf%rec_b(1) = 12. ! force to read december mean |
|---|
| 219 | ELSE |
|---|
| 220 | IF( sdjf%cltype == 'monthly' ) THEN ! monthly file |
|---|
| 221 | sdjf%rec_b(1) = 24. / sdjf%freqh * REAL( nmonth_len(nmonth-1), wp ) ! last record of previous month |
|---|
| 222 | llprevmth = sdjf%ln_clim ! use previous month file? |
|---|
| 223 | llprevyr = sdjf%ln_clim .AND. nmonth == 1 ! use previous year file? |
|---|
| 224 | ELSE ! yearly file |
|---|
| 225 | sdjf%rec_b(1) = 24. / sdjf%freqh * REAL( nyear_len(0), wp ) ! last record of year month |
|---|
| 226 | llprevyr = sdjf%ln_clim ! use previous year file? |
|---|
| 227 | ENDIF |
|---|
| 228 | ENDIF |
|---|
| 229 | ENDIF |
|---|
| 230 | llprev = llprevyr .OR. llprevmth |
|---|
| 231 | |
|---|
| 232 | CALL fld_clopn( sdjf, nyear - COUNT((/llprevyr/)), nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr/)), llprev ) |
|---|
| 233 | |
|---|
| 234 | ! if previous year/month file is not existing, we switch to the current year/month |
|---|
| 235 | IF( llprev .AND. sdjf%num == 0 ) THEN |
|---|
| 236 | CALL ctl_warn( 'previous year/month file: '//TRIM(sdjf%clname)//' not existing -> back to current year/month' ) |
|---|
| 237 | ! we force to read the first record of the current year/month instead of last record of previous year/month |
|---|
| 238 | llprev = .false. |
|---|
| 239 | sdjf%rec_b(1) = 1. |
|---|
| 240 | CALL fld_clopn( sdjf, nyear, nmonth ) |
|---|
| 241 | ENDIF |
|---|
| 242 | |
|---|
| 243 | IF( llprev ) THEN ! check if the last record sdjf%rec_n(1) exists in the file |
|---|
| 244 | idvar = iom_varid( sdjf%num, sdjf%clvar ) ! id of the variable sdjf%clvar |
|---|
| 245 | IF( idvar <= 0 ) RETURN |
|---|
| 246 | inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar ) ! size of the last dim of idvar |
|---|
| 247 | sdjf%rec_b(1) = MIN( sdjf%rec_b(1), REAL( inrec, wp ) ) ! make sure we select an existing record |
|---|
| 248 | ENDIF |
|---|
| 249 | |
|---|
| 250 | ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read |
|---|
| 251 | CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), NINT( sdjf%rec_b(1) ) ) |
|---|
| 252 | |
|---|
| 253 | clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" |
|---|
| 254 | IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), NINT(sdjf%rec_b(1)), sdjf%rec_b(2)/rday |
|---|
| 255 | |
|---|
| 256 | IF( llprev ) CALL iom_close( sdjf%num ) ! close previous year file (-> redefine sdjf%num to 0) |
|---|
| 257 | |
|---|
| 258 | ENDIF |
|---|
| 259 | |
|---|
| 260 | IF( sdjf%num == 0 ) CALL fld_clopn( sdjf, nyear, nmonth ) ! make sure current year/month file is opened |
|---|
| 261 | |
|---|
| 262 | sdjf%swap_sec = rsec_year + sec1jan000 - 1. ! force read/update the after data in the following part of fld_read |
|---|
| 263 | |
|---|
| 264 | END SUBROUTINE fld_init |
|---|
| 265 | |
|---|
| 266 | |
|---|
| 267 | SUBROUTINE fld_rec( sdjf ) |
|---|
| 268 | !!--------------------------------------------------------------------- |
|---|
| 269 | !! *** ROUTINE fld_rec *** |
|---|
| 270 | !! |
|---|
| 271 | !! ** Purpose : compute rec_a, rec_b and swap_sec |
|---|
| 272 | !! |
|---|
| 273 | !! ** Method : |
|---|
| 274 | !!---------------------------------------------------------------------- |
|---|
| 275 | TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables |
|---|
| 276 | !! |
|---|
| 277 | INTEGER :: irec ! record number |
|---|
| 278 | REAL(wp) :: zrec ! record number |
|---|
| 279 | REAL(wp) :: ztmp ! temporary variable |
|---|
| 280 | REAL(wp) :: zfreq_sec ! frequency mean (in seconds) |
|---|
| 281 | !!---------------------------------------------------------------------- |
|---|
| 282 | ! |
|---|
| 283 | IF( sdjf%freqh == -1. ) THEN ! monthly mean |
|---|
| 284 | ! |
|---|
| 285 | IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record |
|---|
| 286 | ! |
|---|
| 287 | ! INT( ztmp ) |
|---|
| 288 | ! /|\ |
|---|
| 289 | ! 1 | *---- |
|---|
| 290 | ! 0 |----( |
|---|
| 291 | ! |----+----|--> time |
|---|
| 292 | ! 0 /|\ 1 (nday/nmonth_len(nmonth)) |
|---|
| 293 | ! | |
|---|
| 294 | ! | |
|---|
| 295 | ! forcing record : nmonth |
|---|
| 296 | ! |
|---|
| 297 | ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 |
|---|
| 298 | ELSE |
|---|
| 299 | ztmp = 0.e0 |
|---|
| 300 | ENDIF |
|---|
| 301 | irec = nmonth + INT( ztmp ) |
|---|
| 302 | |
|---|
| 303 | IF( sdjf%ln_tint ) THEN ; sdjf%swap_sec = rmonth_half(irec) + sec1jan000 ! swap at the middle of the month |
|---|
| 304 | ELSE ; sdjf%swap_sec = rmonth_end( irec) + sec1jan000 ! swap at the end of the month |
|---|
| 305 | ENDIF |
|---|
| 306 | |
|---|
| 307 | sdjf%rec_a(:) = (/ REAL( irec, wp ), rmonth_half(irec) + sec1jan000 /) ! define after record number and time |
|---|
| 308 | irec = irec - 1 ! move back to previous record |
|---|
| 309 | sdjf%rec_b(:) = (/ REAL( irec, wp ), rmonth_half(irec) + sec1jan000 /) ! define before record number and time |
|---|
| 310 | ! |
|---|
| 311 | ELSE ! higher frequency mean (in hours) |
|---|
| 312 | ! |
|---|
| 313 | zfreq_sec = sdjf%freqh * 3600. ! frequency mean (in seconds) |
|---|
| 314 | ! number of second since the beginning of the file |
|---|
| 315 | IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = rsec_month ! since Jan 1 of the current year |
|---|
| 316 | ELSE ; ztmp = rsec_year ! since the first day of the current month |
|---|
| 317 | ENDIF |
|---|
| 318 | IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record |
|---|
| 319 | ! |
|---|
| 320 | ! INT( ztmp ) |
|---|
| 321 | ! /|\ |
|---|
| 322 | ! 2 | *-----( |
|---|
| 323 | ! 1 | *-----( |
|---|
| 324 | ! 0 |--( |
|---|
| 325 | ! |--+--|--+--|--+--|--> time |
|---|
| 326 | ! 0 /|\ 1 /|\ 2 /|\ 3 (rsec_year/zfreq_sec) or (rsec_month/zfreq_sec) |
|---|
| 327 | ! | | | |
|---|
| 328 | ! | | | |
|---|
| 329 | ! forcing record : 1 2 3 |
|---|
| 330 | ! |
|---|
| 331 | ztmp= ztmp / zfreq_sec + 0.5 |
|---|
| 332 | ELSE |
|---|
| 333 | ! |
|---|
| 334 | ! INT( ztmp ) |
|---|
| 335 | ! /|\ |
|---|
| 336 | ! 2 | *-----( |
|---|
| 337 | ! 1 | *-----( |
|---|
| 338 | ! 0 |-----( |
|---|
| 339 | ! |--+--|--+--|--+--|--> time |
|---|
| 340 | ! 0 /|\ 1 /|\ 2 /|\ 3 (rsec_year/zfreq_sec) or (rsec_month/zfreq_sec) |
|---|
| 341 | ! | | | |
|---|
| 342 | ! | | | |
|---|
| 343 | ! forcing record : 1 2 3 |
|---|
| 344 | ! |
|---|
| 345 | ztmp= ztmp / zfreq_sec |
|---|
| 346 | ENDIF |
|---|
| 347 | zrec = 1. + REAL( INT( ztmp ), wp ) |
|---|
| 348 | |
|---|
| 349 | ! after record index and second since Jan. 1st 00h of nit000 year |
|---|
| 350 | sdjf%rec_a(:) = (/ zrec, zfreq_sec * ( zrec - 0.5 ) + sec1jan000 /) |
|---|
| 351 | IF( sdjf%cltype == 'monthly' ) & ! add the number of second between Jan 1 and the end of previous month |
|---|
| 352 | sdjf%rec_a(2) = sdjf%rec_a(2) + rday * REAL(SUM(nmonth_len(1:nmonth -1)), wp) ! ok if nmonth=1 |
|---|
| 353 | |
|---|
| 354 | ! before record index and second since Jan. 1st 00h of nit000 year |
|---|
| 355 | zrec = zrec - 1. ! move back to previous record |
|---|
| 356 | sdjf%rec_b(:) = (/ zrec, zfreq_sec * ( zrec - 0.5 ) + sec1jan000 /) |
|---|
| 357 | IF( sdjf%cltype == 'monthly' ) & ! add the number of second between Jan 1 and the end of previous month |
|---|
| 358 | sdjf%rec_b(2) = sdjf%rec_b(2) + rday * REAL(SUM(nmonth_len(1:nmonth -1)), wp) ! ok if nmonth=1 |
|---|
| 359 | |
|---|
| 360 | ! swapping time in second since Jan. 1st 00h of nit000 year |
|---|
| 361 | IF( sdjf%ln_tint ) THEN ; sdjf%swap_sec = sdjf%rec_a(2) ! swap at the middle of the record |
|---|
| 362 | ELSE ; sdjf%swap_sec = sdjf%rec_a(2) + 0.5 * zfreq_sec ! swap at the end of the record |
|---|
| 363 | ENDIF |
|---|
| 364 | ! |
|---|
| 365 | ENDIF |
|---|
| 366 | ! |
|---|
| 367 | END SUBROUTINE fld_rec |
|---|
| 368 | |
|---|
| 369 | |
|---|
| 370 | SUBROUTINE fld_clopn( sdjf, kyear, kmonth, ldstop ) |
|---|
| 371 | !!--------------------------------------------------------------------- |
|---|
| 372 | !! *** ROUTINE fld_clopn *** |
|---|
| 373 | !! |
|---|
| 374 | !! ** Purpose : update the file name and open the file |
|---|
| 375 | !! |
|---|
| 376 | !! ** Method : |
|---|
| 377 | !!---------------------------------------------------------------------- |
|---|
| 378 | TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables |
|---|
| 379 | INTEGER , INTENT(in ) :: kyear ! year value |
|---|
| 380 | INTEGER , INTENT(in ) :: kmonth ! month value |
|---|
| 381 | LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) |
|---|
| 382 | |
|---|
| 383 | IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open |
|---|
| 384 | ! build the new filename if not climatological data |
|---|
| 385 | IF( .NOT. sdjf%ln_clim ) THEN ; WRITE(sdjf%clname, '(a,"_y",i4)' ) TRIM( sdjf%clrootname ), kyear ! add year |
|---|
| 386 | IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"m",i2)' ) TRIM( sdjf%clname ), kmonth ! add month |
|---|
| 387 | ENDIF |
|---|
| 388 | CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop ) |
|---|
| 389 | ! |
|---|
| 390 | END SUBROUTINE fld_clopn |
|---|
| 391 | |
|---|
| 392 | |
|---|
| 393 | SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam ) |
|---|
| 394 | !!--------------------------------------------------------------------- |
|---|
| 395 | !! *** ROUTINE fld_fill *** |
|---|
| 396 | !! |
|---|
| 397 | !! ** Purpose : fill sdf with sdf_n and control print |
|---|
| 398 | !! |
|---|
| 399 | !! ** Method : |
|---|
| 400 | !!---------------------------------------------------------------------- |
|---|
| 401 | TYPE(FLD) , DIMENSION(:), INTENT(inout) :: sdf ! structure of input fields (file informations, fields read) |
|---|
| 402 | TYPE(FLD_N), DIMENSION(:), INTENT(in ) :: sdf_n ! array of namelist information structures |
|---|
| 403 | CHARACTER(len=*) , INTENT(in ) :: cdir ! Root directory for location of flx files |
|---|
| 404 | CHARACTER(len=*) , INTENT(in ) :: cdcaller ! |
|---|
| 405 | CHARACTER(len=*) , INTENT(in ) :: cdtitle ! |
|---|
| 406 | CHARACTER(len=*) , INTENT(in ) :: cdnam ! |
|---|
| 407 | ! |
|---|
| 408 | INTEGER :: jf ! dummy indices |
|---|
| 409 | !!--------------------------------------------------------------------- |
|---|
| 410 | |
|---|
| 411 | DO jf = 1, SIZE(sdf) |
|---|
| 412 | sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname ) |
|---|
| 413 | sdf(jf)%freqh = sdf_n(jf)%freqh |
|---|
| 414 | sdf(jf)%clvar = sdf_n(jf)%clvar |
|---|
| 415 | sdf(jf)%ln_tint = sdf_n(jf)%ln_tint |
|---|
| 416 | sdf(jf)%ln_clim = sdf_n(jf)%ln_clim |
|---|
| 417 | IF( sdf(jf)%freqh == -1. ) THEN ; sdf(jf)%cltype = 'yearly' |
|---|
| 418 | ELSE ; sdf(jf)%cltype = sdf_n(jf)%cltype |
|---|
| 419 | ENDIF |
|---|
| 420 | END DO |
|---|
| 421 | |
|---|
| 422 | IF(lwp) THEN ! control print |
|---|
| 423 | WRITE(numout,*) |
|---|
| 424 | WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) |
|---|
| 425 | WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) |
|---|
| 426 | WRITE(numout,*) ' '//TRIM( cdnam )//' Namelist' |
|---|
| 427 | WRITE(numout,*) ' list of files and frequency (>0: in hours ; <0 in months)' |
|---|
| 428 | DO jf = 1, SIZE(sdf) |
|---|
| 429 | WRITE(numout,*) ' root filename: ' , TRIM( sdf(jf)%clrootname ), & |
|---|
| 430 | & ' variable name: ' , TRIM( sdf(jf)%clvar ) |
|---|
| 431 | WRITE(numout,*) ' frequency: ' , sdf(jf)%freqh , & |
|---|
| 432 | & ' time interp: ' , sdf(jf)%ln_tint , & |
|---|
| 433 | & ' climatology: ' , sdf(jf)%ln_clim , & |
|---|
| 434 | & ' data type: ' , sdf(jf)%cltype |
|---|
| 435 | END DO |
|---|
| 436 | ENDIF |
|---|
| 437 | |
|---|
| 438 | END SUBROUTINE fld_fill |
|---|
| 439 | |
|---|
| 440 | |
|---|
| 441 | END MODULE fldread |
|---|
