New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4144 for branches/2013/dev_r3987_UKMO6_C1D/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90 – NEMO

Ignore:
Timestamp:
2013-10-28T14:50:08+01:00 (11 years ago)
Author:
rfurner
Message:

Commit for 2013 changes; see #1085

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_r3987_UKMO6_C1D/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r3851 r4144  
    2121   USE lib_mpp         ! MPP library 
    2222   USE wrk_nemo        ! work arrays 
     23   USE lbclnk          ! ocean lateral boundary conditions (C1D case) 
    2324   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar 
    2425 
     
    3132   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations 
    3233      CHARACTER(len = 256) ::   clname      ! generic name of the NetCDF flux file 
    33       INTEGER              ::   nfreqh      ! frequency of each flux file 
     34      REAL(wp)             ::   nfreqh      ! frequency of each flux file 
    3435      CHARACTER(len = 34)  ::   clvar       ! generic name of the variable in the NetCDF flux file 
    3536      LOGICAL              ::   ln_tint     ! time interpolation or not (T/F) 
     
    4546      CHARACTER(len = 256)            ::   clrootname   ! generic name of the NetCDF file 
    4647      CHARACTER(len = 256)            ::   clname       ! current name of the NetCDF file 
    47       INTEGER                         ::   nfreqh       ! frequency of each flux file 
     48      REAL(wp)                        ::   nfreqh       ! frequency of each flux file 
    4849      CHARACTER(len = 34)             ::   clvar        ! generic name of the variable in the NetCDF flux file 
    4950      LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F) 
     
    193194                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field 
    194195                  sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations 
    195                   sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - sd(jf)%nfreqh * 3600  ! assume freq to be in hours in this case 
     196                  sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%nfreqh * 3600 )  ! assume freq to be in hours in this case 
    196197                  sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations 
    197198                  sd(jf)%nrec_a(1) = itmp                       ! move back to after record  
     
    211212                     sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)   ! re-swap before record field 
    212213                     sd(jf)%nrec_b(1) = sd(jf)%nrec_a(1)           ! update before record informations 
    213                      sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - sd(jf)%nfreqh * 3600  ! assume freq to be in hours in this case 
     214                     sd(jf)%nrec_b(2) = sd(jf)%nrec_a(2) - NINT( sd(jf)%nfreqh * 3600 )  ! assume freq to be in hours in this case 
    214215                     sd(jf)%rotn(1)   = sd(jf)%rotn(2)             ! update before rotate informations 
    215216                     sd(jf)%nrec_a(1) = sd(jf)%nrec_a(1) + 1       ! move back to after record 
     
    264265            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation 
    265266               IF(lwp .AND. kt - nit000 <= 100 ) THEN  
    266                   clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    267                      &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')" 
     267                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
     268                     &    "', records b/a: ', i6.4, '/', i6.4, ' (days ', f9.4,'/', f9.4, ')')" 
    268269                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &             
    269270                     & 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 
     
    277278            ELSE   ! nothing to do... 
    278279               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
    279                   clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
    280                      &    "', record: ', i4.4, ' (days ', f7.2, ' <-> ', f7.2, ')')" 
     280                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   & 
     281                     &    "', record: ', i6.4, ' (days ', f9.4, ' <-> ', f9.4, ')')" 
    281282                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,    & 
    282283                     &                 sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
     
    349350            ELSE                                ! higher frequency mean (in hours)  
    350351               IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file 
    351                   sdjf%nrec_a(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh                 ! last record of previous month 
     352                  sdjf%nrec_a(1) = NINT( 24 * nmonth_len(nmonth-1) / sdjf%nfreqh )         ! last record of previous month 
    352353                  llprevmth = .TRUE.                                                       ! use previous month file? 
    353354                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    354355               ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ! weekly file 
    355356                  llprevweek = .TRUE.                                                      ! use previous week  file? 
    356                   sdjf%nrec_a(1) = 24 * 7 / sdjf%nfreqh                                    ! last record of previous week 
     357                  sdjf%nrec_a(1) = NINT( 24 * 7 / sdjf%nfreqh )                            ! last record of previous week 
    357358                  isec_week = NINT(rday) * 7                                               ! add a shift toward previous week 
    358359               ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file 
    359                   sdjf%nrec_a(1) = 24 / sdjf%nfreqh                                        ! last record of previous day 
     360                  sdjf%nrec_a(1) = NINT( 24 / sdjf%nfreqh )                                ! last record of previous day 
    360361                  llprevday = .TRUE.                                                       ! use previous day   file? 
    361362                  llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file? 
    362363                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    363364               ELSE                                           ! yearly file 
    364                   sdjf%nrec_a(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of previous year  
     365                  sdjf%nrec_a(1) = NINT( 24 * nyear_len(0) / sdjf%nfreqh )                 ! last record of previous year  
    365366                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file? 
    366367               ENDIF 
     
    401402         CALL fld_get( sdjf, map ) 
    402403 
    403          clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')" 
     404         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i6, ' at time = ', f7.2, ' days')" 
    404405         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday 
    405406 
     
    511512         !                                   ! ================================ ! 
    512513         ! 
    513          ifreq_sec = sdjf%nfreqh * 3600                                                 ! frequency mean (in seconds) 
     514         ifreq_sec = NINT( sdjf%nfreqh * 3600 )                                         ! frequency mean (in seconds) 
    514515         IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week 
    515516         ! number of second since the beginning of the file 
     
    581582      INTEGER                  ::   iw     ! index into wgts array 
    582583      INTEGER                  ::   ipdom  ! index of the domain 
     584      INTEGER                  ::   idvar  ! variable ID 
     585      INTEGER                  ::   idmspc ! number of spatial dimensions 
     586      LOGICAL                  ::   lmoor  ! C1D case: point data 
    583587      !!--------------------------------------------------------------------- 
    584588      ! 
     
    598602         ELSE                                  ;  ipdom = jpdom_unknown 
    599603         ENDIF 
     604         ! C1D case: If product of spatial dimensions == ipk, then x,y are of 
     605         ! size 1 (point/mooring data): this must be read onto the central grid point 
     606         idvar  = iom_varid( sdjf%num, sdjf%clvar ) 
     607         idmspc = iom_file( sdjf%num )%ndims( idvar ) 
     608         IF( iom_file( sdjf%num )%luld( idvar ) )   idmspc = idmspc - 1 
     609         lmoor  = (idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk) 
     610         ! 
    600611         SELECT CASE( ipk ) 
    601612         CASE(1) 
    602             IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 
    603             ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) ) 
     613            IF( lk_c1d .AND. lmoor ) THEN 
     614               IF( sdjf%ln_tint ) THEN 
     615                  CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,2), sdjf%nrec_a(1) ) 
     616                  CALL lbc_lnk( sdjf%fdta(:,:,1,2),'Z',1. ) 
     617               ELSE 
     618                  CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1  ), sdjf%nrec_a(1) ) 
     619                  CALL lbc_lnk( sdjf%fnow(:,:,1  ),'Z',1. ) 
     620               ENDIF 
     621            ELSE 
     622               IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 
     623               ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) ) 
     624               ENDIF 
    604625            ENDIF 
    605626         CASE DEFAULT 
    606             IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    607             ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) ) 
     627            IF (lk_c1d .AND. lmoor ) THEN 
     628               IF( sdjf%ln_tint ) THEN 
     629                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) 
     630                  CALL lbc_lnk( sdjf%fdta(:,:,:,2),'Z',1. ) 
     631               ELSE 
     632                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,:  ), sdjf%nrec_a(1) ) 
     633                  CALL lbc_lnk( sdjf%fnow(:,:,:  ),'Z',1. ) 
     634               ENDIF 
     635            ELSE 
     636               IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
     637               ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) ) 
     638               ENDIF 
    608639            ENDIF 
    609640         END SELECT 
     
    817848            ENDIF 
    818849         ELSE                                                                       ! higher frequency mean (in hours) 
    819             IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = 24 * imonth_len / sdjf%nfreqh  
    820             ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   sdjf%nreclast = 24 * 7          / sdjf%nfreqh 
    821             ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   sdjf%nreclast = 24              / sdjf%nfreqh 
    822             ELSE                                           ;   sdjf%nreclast = 24 * iyear_len  / sdjf%nfreqh  
     850            IF(     sdjf%cltype      == 'monthly' ) THEN   ;   sdjf%nreclast = NINT( 24 * imonth_len / sdjf%nfreqh ) 
     851            ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   sdjf%nreclast = NINT( 24 * 7          / sdjf%nfreqh ) 
     852            ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   sdjf%nreclast = NINT( 24              / sdjf%nfreqh ) 
     853            ELSE                                           ;   sdjf%nreclast = NINT( 24 * iyear_len  / sdjf%nfreqh ) 
    823854            ENDIF 
    824855         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.