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 2059 – NEMO

Changeset 2059


Ignore:
Timestamp:
2010-08-18T11:44:33+02:00 (14 years ago)
Author:
cbricaud
Message:

add modifications to have the possibility to read weekly files with fldread

Location:
branches/dev_1784_WEEK/NEMO/OPA_SRC
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_1784_WEEK/NEMO/OPA_SRC/DOM/daymod.F90

    r1730 r2059  
    6767      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 
    6868      !!---------------------------------------------------------------------- 
     69      INTEGER :: inbday, irest 
     70      REAL(wp) :: zjul 
     71      !!---------------------------------------------------------------------- 
    6972 
    7073      ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0 
     
    105108      ! day since january 1st 
    106109      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 
    107        
     110 
     111      !compute number of days between last monday and today       
     112      IF( nn_leapy==1 )THEN 
     113         CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (monday) 
     114         inbday = INT(fjulday) - NINT(zjul)       ! compute nb day between  01.01.1900 and current day fjulday  
     115         irest = MOD(inbday,7)                    ! compute nb day between last monday and current day fjulday  
     116         IF(irest==0 )irest = 7  
     117      ENDIF 
     118 
    108119      ! number of seconds since the beginning of current year/month at the middle of the time-step 
    109120      nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step 
    110121      nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step 
    111122      nsec_day   =             nsecd - ndt05 
     123      nsec_week  = 0 
     124      IF( nn_leapy==1 ) nsec_week  = irest     * nsecd - ndt05 
    112125 
    113126      ! control print 
    114127      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
    115            &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day 
     128           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week 
    116129 
    117130      ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 
     
    200213      nsec_year  = nsec_year  + ndt  
    201214      nsec_month = nsec_month + ndt                  
     215      IF( nn_leapy==1 ) nsec_week  = nsec_week  + ndt 
    202216      nsec_day   = nsec_day   + ndt                 
    203217      adatrj  = adatrj  + rdttra(1) / rday 
     
    228242         ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date 
    229243         ! 
     244         !compute first day of the year in julian days 
     245         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear ) 
     246         ! 
    230247         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   & 
    231248              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year 
    232249         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   & 
    233               &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day 
    234       ENDIF 
     250              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week 
     251      ENDIF 
     252 
     253      IF( nsec_week .GT. 7*86400 ) nsec_week = ndt05 
    235254       
    236255      IF(ln_ctl) THEN 
  • branches/dev_1784_WEEK/NEMO/OPA_SRC/DOM/dom_oce.F90

    r1730 r2059  
    195195   !! calendar variables 
    196196   !! --------------------------------------------------------------------- 
    197    INTEGER , PUBLIC ::   nyear       !: current year 
    198    INTEGER , PUBLIC ::   nmonth      !: current month 
    199    INTEGER , PUBLIC ::   nday        !: current day of the month 
    200    INTEGER , PUBLIC ::   ndastp      !: time step date in yyyymmdd format 
    201    INTEGER , PUBLIC ::   nday_year   !: current day counted from jan 1st of the current year 
    202    INTEGER , PUBLIC ::   nsec_year   !: current time step counted in second since 00h jan 1st of the current year 
    203    INTEGER , PUBLIC ::   nsec_month  !: current time step counted in second since 00h 1st day of the current month 
    204    INTEGER , PUBLIC ::   nsec_day    !: current time step counted in second since 00h of the current day 
    205    REAL(wp), PUBLIC ::   fjulday     !: julian day  
    206    REAL(wp), PUBLIC ::   adatrj      !: number of elapsed days since the begining of the whole simulation 
    207    !                                 !: (cumulative duration of previous runs that may have used different time-step size) 
     197   INTEGER , PUBLIC ::   nyear         !: current year 
     198   INTEGER , PUBLIC ::   nmonth        !: current month 
     199   INTEGER , PUBLIC ::   nday          !: current day of the month 
     200   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format 
     201   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year 
     202   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year 
     203   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month 
     204   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday 
     205   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day 
     206   REAL(wp), PUBLIC ::   fjulday       !: current julian day  
     207   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
     208   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
     209   !                                   !: (cumulative duration of previous runs that may have used different time-step size) 
    208210   INTEGER , PUBLIC, DIMENSION(0: 1) ::   nyear_len     !: length in days of the previous/current year 
    209211   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year 
  • branches/dev_1784_WEEK/NEMO/OPA_SRC/SBC/fldread.F90

    r1730 r2059  
    1515   USE oce             ! ocean dynamics and tracers 
    1616   USE dom_oce         ! ocean space and time domain 
     17   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar 
    1718   USE phycst          ! ??? 
    1819   USE in_out_manager  ! I/O manager 
     
    2930      LOGICAL              ::   ln_tint     ! time interpolation or not (T/F) 
    3031      LOGICAL              ::   ln_clim     ! climatology or not (T/F) 
    31       CHARACTER(len = 7)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly' 
     32      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly' 
    3233      CHARACTER(len = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
    3334      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation 
     
    4344      LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F) 
    4445      LOGICAL                         ::   ln_clim      ! climatology or not (T/F) 
    45       CHARACTER(len = 7)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly' 
     46      CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly' 
    4647      INTEGER                         ::   num          ! iom id of the jpfld files to be read 
    4748      INTEGER                         ::   nswap_sec    ! swapping time in second since Jan. 1st 00h of nit000 year 
     
    159160               IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12 
    160161               ELSE                              
    161                   IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
    162                   ELSEIF( sd(jf)%cltype == 'daily'     ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh 
    163                   ELSE                                         ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh  
     162                  IF(     sd(jf)%cltype      == 'monthly' ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
     163                  ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN  ;   ireclast = 24.* 7                  / sd(jf)%nfreqh 
     164                  ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh 
     165                  ELSE                                            ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh  
    164166                  ENDIF 
    165167               ENDIF 
     
    313315      TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables 
    314316      !! 
    315       LOGICAL :: llprevyr       ! are we reading previous year  file? 
    316       LOGICAL :: llprevmth      ! are we reading previous month file? 
    317       LOGICAL :: llprevday      ! are we reading previous day   file? 
    318       LOGICAL :: llprev         ! llprevyr .OR. llprevmth .OR. llprevday 
    319       INTEGER :: idvar          ! variable id  
    320       INTEGER :: inrec          ! number of record existing for this variable 
     317      LOGICAL :: llprevyr              ! are we reading previous year  file? 
     318      LOGICAL :: llprevmth             ! are we reading previous month file? 
     319      LOGICAL :: llprevweek            ! are we reading previous week file? 
     320      LOGICAL :: llprevday             ! are we reading previous day   file? 
     321      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevday 
     322      INTEGER :: idvar                 ! variable id  
     323      INTEGER :: inrec                 ! number of record existing for this variable 
    321324      INTEGER :: kwgt 
     325      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd 
     326      INTEGER :: isec_week             ! number of seconds since start of the weekly file 
    322327      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    323328      !!--------------------------------------------------------------------- 
    324  
     329       
    325330      ! some default definitions... 
    326331      sdjf%num = 0   ! default definition for non-opened file 
    327332      IF( sdjf%ln_clim )   sdjf%clname = TRIM( sdjf%clrootname )   ! file name defaut definition, never change in this case 
    328       llprevyr  = .FALSE. 
    329       llprevmth = .FALSE. 
    330       llprevday = .FALSE. 
     333      llprevyr   = .FALSE. 
     334      llprevmth  = .FALSE. 
     335      llprevweek = .FALSE. 
     336      llprevday  = .FALSE. 
     337      isec_week  = 0 
    331338             
    332339      ! define record informations 
     
    350357                  llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
    351358                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
     359               ELSE IF ( sdjf%cltype(1:4) == 'week' ) THEN !weekly file 
     360                  isec_week = 86400 * 7 
     361                  sdjf%nrec_b(1) = 24. / sdjf%nfreqh * 7                                   ! last record of previous weekly file 
    352362               ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 
    353363                  sdjf%nrec_b(1) = 24 / sdjf%nfreqh                                        ! last record of previous day 
     
    361371            ENDIF 
    362372         ENDIF 
    363          llprev = llprevyr .OR. llprevmth .OR. llprevday 
    364  
    365          CALL fld_clopn( sdjf, nyear  - COUNT((/llprevyr /))                                              ,               & 
    366             &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               & 
    367             &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 
    368           
     373         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 
     374 
     375         IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     376            isec_week  = ksec_week( sdjf%cltype(6:8) ) 
     377            if(lwp)write(numout,*)'cbr test2 isec_week = ',isec_week 
     378            llprevmth  = ( isec_week .GT. nsec_month ) 
     379            llprevyr   = llprevmth  .AND. nmonth==1 
     380         ENDIF 
     381         ! 
     382         iyear  = nyear  - COUNT((/llprevyr /)) 
     383         imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 
     384         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - INT( isec_week )/86400 
     385         ! 
     386         CALL fld_clopn( sdjf , iyear , imonth , iday , .NOT. llprev ) 
     387 
    369388         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    370389         IF( llprev .AND. sdjf%num == 0 ) THEN 
     
    399418      ENDIF 
    400419 
    401       IF( sdjf%num == 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
     420      ! make sure current year/month/day file is opened 
     421      IF( sdjf%num == 0 ) THEN 
     422         isec_week   = 0 
     423         llprevyr    = .FALSE. 
     424         llprevmth   = .FALSE. 
     425         llprevweek  = .FALSE. 
     426         ! 
     427         IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     428            isec_week  = ksec_week( sdjf%cltype(6:8) ) 
     429            llprevmth  = ( isec_week .GT. nsec_month ) 
     430            llprevyr   = llprevmth  .AND. nmonth==1 
     431         ENDIF 
     432         ! 
     433         iyear  = nyear  - COUNT((/llprevyr /)) 
     434         imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 
     435         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week/86400 
     436         ! 
     437         CALL fld_clopn( sdjf, iyear, imonth, iday ) 
     438      ENDIF  
    402439 
    403440      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read  
    404        
     441 
    405442   END SUBROUTINE fld_init 
    406443 
     
    420457      REAL(wp) ::   ztmp        ! temporary variable 
    421458      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds) 
     459      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file 
    422460      !!---------------------------------------------------------------------- 
    423461      ! 
     
    453491         ! 
    454492         ifreq_sec = sdjf%nfreqh * 3600   ! frequency mean (in seconds) 
     493         IF( sdjf%cltype(1:4) == 'week'    ) isec_week = ksec_week( sdjf%cltype(6:8)) !since the first day of the current week 
    455494         ! number of second since the beginning of the file 
    456          IF(     sdjf%cltype == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)   ! since 00h on the 1st day of the current month 
    457          ELSEIF( sdjf%cltype == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)   ! since 00h of the current day 
    458          ELSE                                      ;   ztmp = REAL(nsec_year ,wp)   ! since 00h on Jan 1 of the current year 
     495         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month ,wp)  ! since 00h on the 1st day of the current month 
     496         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week  ,wp)  ! since the first day of the current week 
     497         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day   ,wp)  ! since 00h of the current day 
     498         ELSE                                           ;   ztmp = REAL(nsec_year  ,wp)  ! since 00h on Jan 1 of the current year 
    459499         ENDIF 
    460500         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
     
    492532         ! after record index and second since Jan. 1st 00h of nit000 year 
    493533         sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 
    494          IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
     534         IF( sdjf%cltype == 'monthly' )       &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
    495535            sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1 
    496          IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
     536         IF( sdjf%cltype(1:4) == 'week'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous week  
     537            sdjf%nrec_a(2) = sdjf%nrec_a(2) + ( nsec_year - isec_week ) 
     538         IF( sdjf%cltype == 'daily'   )       &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
    497539            sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 ) 
    498540 
     
    500542         irec = irec - 1.                           ! move back to previous record 
    501543         sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 
    502          IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
     544         IF( sdjf%cltype == 'monthly' )       &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
    503545            sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1 
    504          IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
     546         IF( sdjf%cltype(1:4) == 'week'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous week 
     547            sdjf%nrec_b(2) = sdjf%nrec_b(2) + ( nsec_year - isec_week ) 
     548         IF( sdjf%cltype == 'daily'   )       &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
    505549            sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 ) 
    506550 
     
    523567      !! ** Method  :    
    524568      !!---------------------------------------------------------------------- 
    525       TYPE(FLD), INTENT(inout)           ::   sdjf     ! input field related variables 
    526       INTEGER  , INTENT(in   )           ::   kyear    ! year value 
    527       INTEGER  , INTENT(in   )           ::   kmonth   ! month value 
    528       INTEGER  , INTENT(in   )           ::   kday     ! day value 
    529       LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
     569      TYPE(FLD), INTENT(inout)           ::   sdjf                      ! input field related variables 
     570      INTEGER  , INTENT(in   )           ::   kyear                     ! year value 
     571      INTEGER  , INTENT(in   )           ::   kmonth                    ! month value 
     572      INTEGER  , INTENT(in   )           ::   kday                      ! day value 
     573      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop                    ! stop if open to read a non-existing file (default = .TRUE.) 
     574      INTEGER                            ::   iyear, imonth, iday       ! firt day of the current week in yyyy mm dd 
     575      REAL(wp)                           ::   zsec, zjul                !temp variable 
    530576 
    531577      IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
    532578      ! build the new filename if not climatological data 
    533       IF( .NOT. sdjf%ln_clim ) THEN   ;   WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
    534          IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    535          IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
     579      sdjf%clname=TRIM(sdjf%clrootname) 
     580      ! 
     581      IF(  sdjf%cltype(1:4) == 'week' .AND. nn_leapy==0 )CALL ctl_stop( 'fld_clopn: weekly file and nn_leapy=0 are not compatible' ) 
     582      ! 
     583      IF( .NOT. sdjf%ln_clim ) THEN    
     584         WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
     585         IF( sdjf%cltype /= 'yearly'        )   &  
     586            &     WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth   ! add month 
     587         IF( sdjf%cltype == 'daily'  .OR. sdjf%cltype(1:4) == 'week' ) & 
     588            &     WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday     ! add day 
    536589      ENDIF 
    537590      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
     
    9981051 
    9991052   END SUBROUTINE fld_interp 
    1000    
     1053 
     1054   FUNCTION ksec_week( cdday ) 
     1055      !!--------------------------------------------------------------------- 
     1056      !!                    ***  FUNCTION kshift_week ***  
     1057      !! 
     1058      !! ** Purpose :   
     1059      !! 
     1060      !! ** Method  : 
     1061      !!--------------------------------------------------------------------- 
     1062      CHARACTER(len=*), INTENT(in)   ::   cdday   !3 first letters of the first day of the weekly file 
     1063      !! 
     1064      INTEGER                        ::   ksec_week  ! output variable 
     1065      INTEGER                        ::   ijul       !temp variable 
     1066      INTEGER                        ::   ishift     !temp variable 
     1067      CHARACTER(len=3),DIMENSION(7)  ::   cl_week  
     1068      !!---------------------------------------------------------------------- 
     1069      cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/) 
     1070      DO ijul=1,7 
     1071         IF(  cl_week(ijul)==TRIM(cdday) ) EXIT 
     1072      ENDDO 
     1073      IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): ',TRIM(cdday) ) 
     1074      ! 
     1075      ishift = ( ijul  ) * 86400 
     1076      !  
     1077      ksec_week = nsec_week + ishift 
     1078      ksec_week = MOD( ksec_week , 86400*7 ) 
     1079      if(lwp)write(numout,*)'cbr ijul ksec_week ',ijul,ksec_week 
     1080      !  
     1081   END FUNCTION ksec_week 
     1082 
    10011083END MODULE fldread 
Note: See TracChangeset for help on using the changeset viewer.