MODULE fldread !!====================================================================== !! *** MODULE fldread *** !! Ocean forcing: read input field for surface boundary condition !!===================================================================== !! History : 9.0 ! 06-06 (G. Madec) Original code !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! fld_read : read input fields used for the computation of the !! surface boundary condition !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE phycst ! ??? USE daymod ! calendar USE in_out_manager ! I/O manager USE iom ! I/O manager library IMPLICIT NONE PRIVATE TYPE, PUBLIC :: FLD_N !: Namelist field informations CHARACTER(len = 34) :: clname ! generic name of the NetCDF flux file REAL(wp) :: freqh ! frequency of each flux file CHARACTER(len = 34) :: clvar ! generic name of the variable in the NetCDF flux file LOGICAL :: ln_tint ! time interpolation or not (T/F) LOGICAL :: ln_clim ! climatology or not (T/F) CHARACTER(len = 7) :: cltype ! type of data file 'monthly' or yearly' END TYPE FLD_N TYPE, PUBLIC :: FLD !: Input field related variables CHARACTER(len = 256) :: clrootname ! generic name of the NetCDF file CHARACTER(len = 256) :: clname ! current name of the NetCDF file REAL(wp) :: freqh ! frequency of each flux file CHARACTER(len = 34) :: clvar ! generic name of the variable in the NetCDF flux file LOGICAL :: ln_tint ! time interpolation or not (T/F) LOGICAL :: ln_clim ! climatology or not (T/F) CHARACTER(len = 7) :: cltype ! type of data file 'monthly' or yearly' INTEGER :: num ! iom id of the jpfld files to be read REAL(wp) :: swap_sec ! swapping time in second since Jan. 1st 00h of nit000 year REAL(wp) , DIMENSION(2) :: rec_b ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year REAL(wp) , DIMENSION(2) :: rec_a ! after record (1: index, 2: second since Jan. 1st 00h of nit000 year REAL(wp) , DIMENSION(jpi,jpj) :: fnow ! input fields interpolated to now time step REAL(wp) , DIMENSION(jpi,jpj,2) :: fdta ! 2 consecutive record of input fields END TYPE FLD PUBLIC fld_read, fld_fill ! called by sbc... modules !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $ Id: $ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE fld_read( kt, kn_fsbc, sd ) !!--------------------------------------------------------------------- !! *** ROUTINE fld_read *** !! !! ** Purpose : provide at each time step the surface ocean fluxes !! (momentum, heat, freshwater and runoff) !! !! ** Method : READ each input fields in NetCDF files using IOM !! and intepolate it to the model time-step. !! Several assumptions are made on the input file: !! blahblahblah.... !!---------------------------------------------------------------------- INTEGER , INTENT(in ) :: kt ! ocean time step INTEGER , INTENT(in ) :: kn_fsbc ! sbc computation period (in time step) TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables !! INTEGER :: jf ! dummy indices REAL(wp) :: zreclast ! last record to be read in the current year file REAL(wp) :: zsecend ! number of second since Jan. 1st 00h of nit000 year at nitend LOGICAL :: llnxtyr ! open next year file? LOGICAL :: llstop ! stop is the file is not existing REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation !!--------------------------------------------------------------------- ! ! ===================== ! DO jf = 1, SIZE( sd ) ! LOOP OVER FIELD ! ! ! ===================== ! ! IF( kt == nit000 ) CALL fld_init( sd(jf) ) ! ! read/update the after data? IF( rsec_year + sec1jan000 > sd(jf)%swap_sec ) THEN IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap before record field !CDIR COLLAPSE sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) ENDIF ! update record informations CALL fld_rec( sd(jf) ) ! do we have to change the year/month of the forcing field?? IF( sd(jf)%ln_tint ) THEN ! if we do time interpolation we will need to open next year/month file before the end of the current year/month ! 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 ! be larger than the record number that should be read for current year/month (for ex. 13 for monthly mean file) ! last record to be read in the current file IF( sd(jf)%freqh == -1. ) THEN ; zreclast = 12. ELSE IF( sd(jf)%cltype == 'monthly' ) THEN ; zreclast = 24. / sd(jf)%freqh * REAL( nmonth_len(nmonth), wp ) ELSE ; zreclast = 24. / sd(jf)%freqh * REAL( nyear_len( 1 ), wp ) ENDIF ENDIF ! do we need next year data? IF( sd(jf)%rec_a(1) > zreclast ) THEN sd(jf)%rec_a(1) = 1. ! force to read the first record of the next year IF( .NOT. sd(jf)%ln_clim ) THEN ! close the current file and open a new one. llnxtyr = sd(jf)%cltype /= 'monthly' .OR. nmonth == 12 ! do we need to open next year file? ! if the run finishes at the end of the current year/month, we do accept that next year/month file does ! not exist. If the run continue farther than the current year/month, next year/month file must exist zsecend = rsec_year + sec1jan000 + REAL(nitend - kt, wp) * rdttra(1) ! second at the end of the run llstop = zsecend > sd(jf)%swap_sec ! read more than 1 record of next year CALL fld_clopn( sd(jf), nyear + COUNT((/llnxtyr/)), nmonth + 1 - 12 * COUNT((/llnxtyr/)), llstop ) IF( sd(jf)%num == 0 .AND. .NOT. llstop ) THEN ! next year file is not existing CALL ctl_warn('next year/month file: '//TRIM(sd(jf)%clname)//' not existing -> back to current year/month') CALL fld_clopn( sd(jf), nyear, nmonth ) ! back to the current year/month sd(jf)%rec_a(1) = zreclast ! force to read the last record to be read in the current year file ENDIF ENDIF ENDIF ELSE ! if we are not doing time interpolation, we must change the year/month of the file just afer switching ! to the NEW year/month. If it is the case, we are at the beginning of the year/month when calling fld_rec ! so sd(jf)%rec_a(1) = 1 IF( sd(jf)%rec_a(1) == 1 ) CALL fld_clopn( sd(jf), nyear, nmonth ) ! back to the current year/month ENDIF ! read after data CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), NINT( sd(jf)%rec_a(1) ) ) ENDIF ! update field at each kn_fsbc time-step IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! IF( sd(jf)%ln_tint ) THEN IF(lwp .AND. kt - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & & ' kt = ', kt,' Y/M/D = ', nyear,'/', nmonth,'/', nday,' records b/a:', NINT(sd(jf)%rec_b(1)), & & '/', NINT(sd(jf)%rec_a(1)), ' (', sd(jf)%rec_b(2)/rday,'/', sd(jf)%rec_a(2)/rday, ' days)' ! ztinta = ( rsec_year + sec1jan000 - sd(jf)%rec_b(2) ) / ( sd(jf)%rec_a(2) - sd(jf)%rec_b(2) ) ztintb = 1. - ztinta !CDIR COLLAPSE sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) ELSE IF(lwp .AND. kt - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & & ' kt = ', kt, ' Y/M/D = ', nyear,'/', nmonth,'/', nday, ' record :', INT(sd(jf)%rec_a(1)), & & ' at ', sd(jf)%rec_a(2)/rday, 'day' !CDIR COLLAPSE sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2) ! piecewise constant field ENDIF ! ENDIF IF( kt == nitend ) CALL iom_close( sd(jf)%num ) ! Close the input files ! ! ===================== ! END DO ! END LOOP OVER FIELD ! ! ! ===================== ! END SUBROUTINE fld_read SUBROUTINE fld_init( sdjf ) !!--------------------------------------------------------------------- !! *** ROUTINE fld_init *** !! !! ** Purpose : - if time interpolation, read before data !! - open current year file !! !! ** Method : !!---------------------------------------------------------------------- TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables !! LOGICAL :: llprevyr ! are we reading previous year file? LOGICAL :: llprevmth ! are we reading previous month file? LOGICAL :: llprev ! llprevyr .OR. llprevmth INTEGER :: idvar ! variable id INTEGER :: inrec ! number of record existing for this variable !!--------------------------------------------------------------------- ! some default definitions... sdjf%num = 0 ! default definition for non-opened file IF( sdjf%ln_clim ) sdjf%clname = TRIM( sdjf%clrootname ) ! file name defaut definition, never change in this case llprevyr = .FALSE. llprevmth = .FALSE. ! define record informations CALL fld_rec( sdjf ) IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure IF( sdjf%rec_b(1) == 0.e0 ) THEN ! we redefine record sdjf%rec_b(1) with the last record of previous year file IF( sdjf%freqh == -1. ) THEN ! monthly mean sdjf%rec_b(1) = 12. ! force to read december mean ELSE IF( sdjf%cltype == 'monthly' ) THEN ! monthly file sdjf%rec_b(1) = 24. / sdjf%freqh * REAL( nmonth_len(nmonth-1), wp ) ! last record of previous month llprevmth = sdjf%ln_clim ! use previous month file? llprevyr = sdjf%ln_clim .AND. nmonth == 1 ! use previous year file? ELSE ! yearly file sdjf%rec_b(1) = 24. / sdjf%freqh * REAL( nyear_len(0), wp ) ! last record of year month llprevyr = sdjf%ln_clim ! use previous year file? ENDIF ENDIF ENDIF llprev = llprevyr .OR. llprevmth CALL fld_clopn( sdjf, nyear - COUNT((/llprevyr/)), nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr/)), llprev ) ! if previous year/month file is not existing, we switch to the current year/month IF( llprev .AND. sdjf%num == 0 ) THEN CALL ctl_warn( 'previous year/month file: '//TRIM(sdjf%clname)//' not existing -> back to current year/month' ) ! we force to read the first record of the current year/month instead of last record of previous year/month llprev = .false. sdjf%rec_b(1) = 1. CALL fld_clopn( sdjf, nyear, nmonth ) ENDIF IF( llprev ) THEN ! check if the last record sdjf%rec_n(1) exists in the file idvar = iom_varid( sdjf%num, sdjf%clvar ) ! id of the variable sdjf%clvar IF( idvar <= 0 ) RETURN inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar ) ! size of the last dim of idvar sdjf%rec_b(1) = MIN( sdjf%rec_b(1), REAL( inrec, wp ) ) ! make sure we select an existing record ENDIF ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), NINT( sdjf%rec_b(1) ) ) IF(lwp) WRITE(numout,*)'fld_init : time-interpolation for ', TRIM( sdjf%clvar ), & & ' read previous record =', NINT(sdjf%rec_b(1)), ' at time = ', sdjf%rec_b(2)/rday, ' days' IF( llprev ) CALL iom_close( sdjf%num ) ! close previous year file (-> redefine sdjf%num to 0) ENDIF IF( sdjf%num == 0 ) CALL fld_clopn( sdjf, nyear, nmonth ) ! make sure current year/month file is opened sdjf%swap_sec = rsec_year + sec1jan000 - 1. ! force read/update the after data in the following part of fld_read END SUBROUTINE fld_init SUBROUTINE fld_rec( sdjf ) !!--------------------------------------------------------------------- !! *** ROUTINE fld_rec *** !! !! ** Purpose : compute rec_a, rec_b and swap_sec !! !! ** Method : !!---------------------------------------------------------------------- TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables !! INTEGER :: irec ! record number REAL(wp) :: zrec ! record number REAL(wp) :: ztmp ! temporary variable REAL(wp) :: zfreq_sec ! frequency mean (in seconds) !!---------------------------------------------------------------------- ! IF( sdjf%freqh == -1. ) THEN ! monthly mean ! IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record ! ! INT( ztmp ) ! /|\ ! 1 | *---- ! 0 |----( ! |----+----|--> time ! 0 /|\ 1 (nday/nmonth_len(nmonth)) ! | ! | ! forcing record : nmonth ! ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 ELSE ztmp = 0.e0 ENDIF irec = nmonth + INT( ztmp ) IF( sdjf%ln_tint ) THEN ; sdjf%swap_sec = rmonth_half(irec) ! swap at the middle of the month ELSE ; sdjf%swap_sec = rmonth_end( irec) ! swap at the end of the month ENDIF sdjf%rec_a(:) = (/ REAL( irec, wp ), rmonth_half(irec) /) ! define after record number and time irec = irec - 1 ! move back to previous record sdjf%rec_b(:) = (/ REAL( irec, wp ), rmonth_half(irec) /) ! define before record number and time ! ELSE ! higher frequency mean (in hours) ! zfreq_sec = sdjf%freqh * 3600. ! frequency mean (in seconds) ! number of second since the beginning of the file IF( sdjf%cltype == 'monthly' ) THEN ; ztmp = rsec_month ! since Jan 1 of the current year ELSE ; ztmp = rsec_year ! since the first day of the current month ENDIF IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record ! ! INT( ztmp ) ! /|\ ! 2 | *-----( ! 1 | *-----( ! 0 |--( ! |--+--|--+--|--+--|--> time ! 0 /|\ 1 /|\ 2 /|\ 3 (rsec_year/zfreq_sec) or (rsec_month/zfreq_sec) ! | | | ! | | | ! forcing record : 1 2 3 ! ztmp= ztmp / zfreq_sec + 0.5 ELSE ! ! INT( ztmp ) ! /|\ ! 2 | *-----( ! 1 | *-----( ! 0 |-----( ! |--+--|--+--|--+--|--> time ! 0 /|\ 1 /|\ 2 /|\ 3 (rsec_year/zfreq_sec) or (rsec_month/zfreq_sec) ! | | | ! | | | ! forcing record : 1 2 3 ! ztmp= ztmp / zfreq_sec ENDIF zrec = 1. + REAL( INT( ztmp ), wp ) ! after record index and second since Jan. 1st 00h of nit000 year sdjf%rec_a(:) = (/ zrec, zfreq_sec * ( zrec - 0.5 ) + sec1jan000 /) IF( sdjf%cltype == 'monthly' ) & ! add the number of second between Jan 1 and the end of previous month sdjf%rec_a(2) = sdjf%rec_a(2) + rday * REAL(SUM(nmonth_len(1:nmonth -1)), wp) ! ok if nmonth=1 ! before record index and second since Jan. 1st 00h of nit000 year zrec = zrec - 1. ! move back to previous record sdjf%rec_b(:) = (/ zrec, zfreq_sec * ( zrec - 0.5 ) + sec1jan000 /) IF( sdjf%cltype == 'monthly' ) & ! add the number of second between Jan 1 and the end of previous month sdjf%rec_b(2) = sdjf%rec_b(2) + rday * REAL(SUM(nmonth_len(1:nmonth -1)), wp) ! ok if nmonth=1 ! swapping time in second since Jan. 1st 00h of nit000 year IF( sdjf%ln_tint ) THEN ; sdjf%swap_sec = sdjf%rec_a(2) ! swap at the middle of the record ELSE ; sdjf%swap_sec = sdjf%rec_a(2) + 0.5 * zfreq_sec ! swap at the end of the record ENDIF ! ENDIF ! END SUBROUTINE fld_rec SUBROUTINE fld_clopn( sdjf, kyear, kmonth, ldstop ) !!--------------------------------------------------------------------- !! *** ROUTINE fld_clopn *** !! !! ** Purpose : update the file name and open the file !! !! ** Method : !!---------------------------------------------------------------------- TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables INTEGER , INTENT(in ) :: kyear ! year value INTEGER , INTENT(in ) :: kmonth ! month value LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) IF( sdjf%num /= 0 ) CALL iom_close( sdjf%num ) ! close file if already open ! build the new filename if not climatological data IF( .NOT. sdjf%ln_clim ) THEN ; WRITE(sdjf%clname, '(a,"_y",i4)' ) TRIM( sdjf%clrootname ), kyear ! add year IF( sdjf%cltype == 'monthly' ) WRITE(sdjf%clname, '(a,"m",i2)' ) TRIM( sdjf%clname ), kmonth ! add month ENDIF CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop ) ! END SUBROUTINE fld_clopn SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam ) !!--------------------------------------------------------------------- !! *** ROUTINE fld_fill *** !! !! ** Purpose : fill sdf with sdf_n and control print !! !! ** Method : !!---------------------------------------------------------------------- TYPE(FLD) , DIMENSION(:), INTENT(inout) :: sdf ! structure of input fields (file informations, fields read) TYPE(FLD_N), DIMENSION(:), INTENT(in ) :: sdf_n ! array of namelist information structures CHARACTER(len=*) , INTENT(in ) :: cdir ! Root directory for location of flx files CHARACTER(len=*) , INTENT(in ) :: cdcaller ! CHARACTER(len=*) , INTENT(in ) :: cdtitle ! CHARACTER(len=*) , INTENT(in ) :: cdnam ! ! INTEGER :: jf ! dummy indices !!--------------------------------------------------------------------- DO jf = 1, SIZE(sdf) sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname ) sdf(jf)%freqh = sdf_n(jf)%freqh sdf(jf)%clvar = sdf_n(jf)%clvar sdf(jf)%ln_tint = sdf_n(jf)%ln_tint sdf(jf)%ln_clim = sdf_n(jf)%ln_clim IF( sdf(jf)%freqh == -1. ) THEN ; sdf(jf)%cltype = 'yearly' ELSE ; sdf(jf)%cltype = sdf_n(jf)%cltype ENDIF END DO IF(lwp) THEN ! control print WRITE(numout,*) WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle ) WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /) WRITE(numout,*) ' '//TRIM( cdnam )//' Namelist' WRITE(numout,*) ' list of files and frequency (>0: in hours ; <0 in months)' DO jf = 1, SIZE(sdf) WRITE(numout,*) ' root filename: ' , TRIM( sdf(jf)%clrootname ), & & ' variable name: ' , TRIM( sdf(jf)%clvar ) WRITE(numout,*) ' frequency: ' , sdf(jf)%freqh , & & ' time interp: ' , sdf(jf)%ln_tint , & & ' climatology: ' , sdf(jf)%ln_clim , & & ' data type: ' , sdf(jf)%cltype END DO ENDIF END SUBROUTINE fld_fill END MODULE fldread