Changeset 1132


Ignore:
Timestamp:
2008-06-24T17:14:21+02:00 (12 years ago)
Author:
smasson
Message:

fldread properly working…, see ticket #218

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/SBC/fldread.F90

    r892 r1132  
    2626      CHARACTER(len = 34) ::   clvar       ! generic name of the variable in the NetCDF flux file 
    2727      LOGICAL             ::   ln_tint     ! time interpolation or not (T/F) 
    28       INTEGER             ::   nclim       ! =0 interannuel, =1 climatology 
    29       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' 
    3030   END TYPE FLD_N 
    3131 
     
    3636      CHARACTER(len = 34)             ::   clvar        ! generic name of the variable in the NetCDF flux file 
    3737      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 
    4644      REAL(wp) , DIMENSION(jpi,jpj)   ::   fnow         ! input fields interpolated to now time step 
    47       REAL(wp) , DIMENSION(jpi,jpj,2) ::   fdta         !  2 consecutive record of input fields 
     45      REAL(wp) , DIMENSION(jpi,jpj,2) ::   fdta         ! 2 consecutive record of input fields 
    4846   END TYPE FLD 
    4947 
    50    PUBLIC   fld_read    ! called by sbc... modules 
     48   PUBLIC   fld_read, fld_fill   ! called by sbc... modules 
    5149 
    5250   !!---------------------------------------------------------------------- 
     
    7169      !!---------------------------------------------------------------------- 
    7270      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
    73       INTEGER  , INTENT(in   )               ::   kn_fsbc   ! ocean time step 
     71      INTEGER  , INTENT(in   )               ::   kn_fsbc   ! sbc computation period (in time step)  
    7472      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    7573      !! 
    76       INTEGER  ::   jf                     ! dummy indices 
    77       INTEGER  ::   imf                    ! size of the structure sd 
    78       REAL(wp) ::   zt                     ! ratio at kt between the 2 records 
    79       REAL(wp), DIMENSION(2) ::   zrec_kt 
    80       !!--------------------------------------------------------------------- 
    81  
    82       imf = SIZE( sd )       ! dummy indices 
    83  
     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      !!--------------------------------------------------------------------- 
    8482      !                                         ! ===================== ! 
    85       DO jf = 1, imf                            !    LOOP OVER FIELD    ! 
     83      DO jf = 1, SIZE( sd )                     !    LOOP OVER FIELD    ! 
    8684         !                                      ! ===================== ! 
    8785         ! 
    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    
    91151            ! 
    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)' 
    104156               ! 
    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  
    140168            ENDIF 
    141169            ! 
    142170         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 
    197174         !                                      ! ===================== ! 
    198175      END DO                                    !  END LOOP OVER FIELD  ! 
     
    201178 
    202179 
    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 ) 
    204261      !!--------------------------------------------------------------------- 
    205262      !!                    ***  ROUTINE fld_rec  *** 
    206263      !! 
    207       !! ** Purpose :   provide  
     264      !! ** Purpose :   compute rec_a, rec_b and swap_sec 
    208265      !! 
    209266      !! ** Method  :    
    210267      !!---------------------------------------------------------------------- 
    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) 
    220274      !!---------------------------------------------------------------------- 
    221275      ! 
    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 
    227291         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 
    238325         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        
    243357         ! 
    244358      ENDIF 
    245359      ! 
    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 
    252380      ENDIF 
     381      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop ) 
    253382      ! 
    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      !  
    256400      ! 
    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 
    260434END MODULE fldread 
Note: See TracChangeset for help on using the changeset viewer.