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) INTEGER :: nclim ! =0 interannuel, =1 climatology INTEGER :: nstrec ! starting record, used if nclim=1 (=0 last record of previous year) 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) INTEGER :: nyear ! year of the file (=0000 if climatology) INTEGER :: nclim ! =0 interannuel, =1 climatology INTEGER :: nstrec ! starting record if nclim=1 (=0 last record of previous year) INTEGER :: num ! logical units of the jpfld files to be read REAL(wp) , DIMENSION(2) :: rec_b ! before record info (1: index, 2: second since Jan. 1st 00h) REAL(wp) , DIMENSION(2) :: rec_n ! now record info (1: index, 2: second since Jan. 1st 00h) REAL(wp) , DIMENSION(2) :: rec_a ! next record info (1: index, 2: second since Jan. 1st 00h) REAL(wp) , DIMENSION(2) :: rec ! record time in second since jan. 1st for the 2 records read 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 ! 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 ! ocean time step TYPE(FLD), INTENT(inout), DIMENSION(:) :: sd ! input field related variables !! INTEGER :: jf ! dummy indices INTEGER :: imf ! size of the structure sd REAL(wp) :: zt ! ratio at kt between the 2 records REAL(wp), DIMENSION(2) :: zrec_kt !!--------------------------------------------------------------------- imf = SIZE( sd ) ! dummy indices ! ! ===================== ! DO jf = 1, imf ! LOOP OVER FIELD ! ! ! ===================== ! ! ! ! ====================== ! IF( kt == nit000 ) THEN ! Initialisation ! ! ! ====================== ! ! ! ! set filename for current year SELECT CASE( sd(jf)%nclim ) CASE( 0 ) WRITE(sd(jf)%clname, '(a,"_",i4,".nc")' ) TRIM( sd(jf)%clrootname ), nyear sd(jf)%nyear = nyear CASE( 1 ) WRITE(sd(jf)%clname, '(a, ".nc")' ) TRIM( sd(jf)%clrootname ) sd(jf)%nyear = 0000 END SELECT CALL iom_open( sd(jf)%clname, sd(jf)%num ) ! open input files ! IF( sd(jf)%ln_tint ) THEN ! time interpolation: read previous record in now field ! sd(jf)%rec_n = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 ) ! record index and time ! ! ! read record CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), INT( sd(jf)%rec_n(1) ) ) ! ! ! control print IF(lwp) WRITE(numout,*)'fld_read : time-interpolation for ', TRIM( sd(jf)%clvar ), & & ' read previous record =', INT(sd(jf)%rec_n(1)), ' at time = ', sd(jf)%rec_n(2)/rday, ' days' ! ENDIF ! ! next record to be read sd(jf)%rec_a = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) IF(lwp) WRITE(numout,*)' ', & & ' after record =', INT(sd(jf)%rec_a(1)), ' at time = ', sd(jf)%rec_a(2)/rday, ' days' ! ENDIF ! ! ! ============================= ! IF( sd(jf)%nclim == 0 .AND. & ! New Year ! sd(jf)%nyear == nyear - 1 ) THEN ! ============================= ! ! CALL iom_close( sd(jf)%num ) IF(lwp) WRITE(numout,*) 'fldread : switch to a new year= ', nyear WRITE( sd(jf)%clname, '(a,"_",i4,".nc")' ) TRIM( sd(jf)%clrootname ), nyear sd(jf)%nyear = nyear CALL iom_open( sd(jf)%clname, sd(jf)%num ) ! IF( sd(jf)%ln_tint ) THEN ! no record index change, update record time sd(jf)%rec_b(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 ) sd(jf)%rec_n(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, +1 ) ELSE ! ??? sd(jf)%rec_n(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 ) sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) ENDIF ! ENDIF ! ! ! ============================= ! ! ! Read / Update input fields ! ! ! ============================= ! ! ! current record index zrec_kt(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, 0 ) ! ! read next record (if required) IF( zrec_kt(1) == sd(jf)%rec_a(1) ) THEN ! IF( sd(jf)%ln_tint ) THEN ! time interpolation: swap sd(jf)%rec_b = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, -1 ) ! record index & time !CDIR COLLAPSE sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) ! record field ENDIF ! sd(jf)%rec_n(:) = zrec_kt(:) ! update now record index & time ! ! read record CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), INT( sd(jf)%rec_n(1) ) ) ! ! ! after record index & time sd(jf)%rec_a(1:2) = fld_rec( sd(jf)%freqh, sd(jf)%ln_tint, sd(jf)%nclim, +1 ) ! ! ! control print IF( sd(jf)%ln_tint ) THEN IF(lwp .AND. nitend - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & & ' D/M=', nday,'/',nmonth,' rec bna:', INT(sd(jf)%rec_b(1)), INT(sd(jf)%rec_n(1)),INT(sd(jf)%rec_a(1)), & & ' zrec bna', sd(jf)%rec_b(2)/rday, sd(jf)%rec_n(2)/rday, sd(jf)%rec_a(2)/rday ELSE IF(lwp .AND. nitend - nit000 <= 100 ) WRITE(numout,*)'fld_read: var ', TRIM( sd(jf)%clvar ), & & ' D/M=', nday,'/',nmonth, ' record :', INT(sd(jf)%rec_n(1)), & & ' at', sd(jf)%rec_n(2)/rday, 'day, next rec', INT(sd(jf)%rec_a(1)) ENDIF ENDIF IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN !** update field at each kn_fsbc time-step ! IF( sd(jf)%ln_tint ) THEN !* linear time interpolated field zt = ( rsec_year - sd(jf)%rec_b(2) ) / ( sd(jf)%rec_n(2) - sd(jf)%rec_b(2) ) !CDIR COLLAPSE sd(jf)%fnow(:,:) = ( 1. - zt ) * sd(jf)%fdta(:,:,1) + zt * sd(jf)%fdta(:,:,2) ELSE !CDIR COLLAPSE sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2) !* piecewise constant field ENDIF ! ENDIF ! ! ! ======================== ! IF( kt == nitend ) THEN ! Close the input files ! ! ! ======================== ! CALL iom_close( sd(jf)%num ) ENDIF ! ! ===================== ! END DO ! END LOOP OVER FIELD ! ! ! ===================== ! END SUBROUTINE fld_read FUNCTION fld_rec( pfreq, ld_tint, kclim, kshift ) RESULT( prec_info ) !!--------------------------------------------------------------------- !! *** ROUTINE fld_rec *** !! !! ** Purpose : provide !! !! ** Method : !!---------------------------------------------------------------------- REAL(wp), INTENT(in) :: pfreq ! record frequency (>0 in hours, <0 in months) LOGICAL , INTENT(in) :: ld_tint ! time interpolation flag (T/F) INTEGER , INTENT(in) :: kclim ! climatology flag (=0/1) INTEGER , INTENT(in) :: kshift ! record shift REAL(wp), DIMENSION(2) :: prec_info ! 1: file record + kshift ! ! 2: associated time [sec] centered at half the record frequency !! INTEGER :: iendh, irec REAL(wp) :: zrec !!---------------------------------------------------------------------- ! IF( pfreq == -12. ) THEN ! monthly data ! iendh = 12 ! 12 records per year IF( ld_tint) THEN ! time interpolation, shift by 1/2 record zrec = REAL( nday ) / REAL( nmonth_len(nmonth) ) + 0.5 ELSE zrec = REAL( nday - 1 ) / REAL( nmonth_len(nmonth) ) ENDIF irec = nmonth + kshift + INT( zrec ) ! record index (from 0 to 13) zrec = rmonth_half(irec) ! record time (second since 00h, Jan. 1st) ! ELSE ! high frequency data (pfreq in hours) ! iendh = INT( 365 * 24 / pfreq ) ! iendh records per year IF( ld_tint ) THEN ! time interpolation, shift by 1/2 record zrec = rsec_year / ( pfreq * 3600. ) + 0.5 ELSE zrec = rsec_year / ( pfreq * 3600. ) ENDIF irec = 1 + kshift + INT( zrec ) ! record index (from 0 to iendh+1) zrec = - 0.5 * 3600. * pfreq + 3600. * pfreq * REAL( irec ) ! record time (second since 00h, Jan. 1st) ! ENDIF ! ! ! adjuste the record index (climatology or interannual) IF( kclim /= 1 ) THEN irec = irec + 1 ! interannual: additional first record ELSE IF( irec == 0 ) irec = iendh ! climatology: record 0 is the last record (iendh) IF( irec >= iendh + 1 ) irec = MOD( irec, iendh ) ! climatology: apply a modulo iendh ENDIF ! prec_info(1) = REAL( irec, wp ) prec_info(2) = zrec ! END FUNCTION fld_rec !!====================================================================== END MODULE fldread