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 5997 for branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90 – NEMO

Ignore:
Timestamp:
2015-12-03T17:04:43+01:00 (8 years ago)
Author:
timgraham
Message:

Merged branches/2014/dev_r4650_UKMO7_STARTHOUR into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_MetOffice_merge_2015/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r5836 r5997  
    1111   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init  
    1212   !!            3.4  ! 2012-10  (A. Weaver and K. Mogensen) Fix for direct initialization 
     13   !!                 ! 2014-09  (D. Lea)  Local calc_date removed use routine from OBS 
     14   !!                 ! 2015-11  (D. Lea)  Handle non-zero initial time of day 
    1315   !!---------------------------------------------------------------------- 
    1416 
    1517   !!---------------------------------------------------------------------- 
    1618   !!   asm_inc_init   : Initialize the increment arrays and IAU weights 
    17    !!   calc_date      : Compute the calendar date YYYYMMDD on a given step 
    1819   !!   tra_asm_inc    : Apply the tracer (T and S) increments 
    1920   !!   dyn_asm_inc    : Apply the dynamic (u and v) increments 
     
    3839#endif 
    3940   USE sbc_oce          ! Surface boundary condition variables. 
     41   USE diaobs, ONLY: calc_date     ! Compute the calendar date on a given step 
    4042 
    4143   IMPLICIT NONE 
     
    4345    
    4446   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights 
    45    PUBLIC   calc_date      !: Compute the calendar date YYYYMMDD on a given step 
    4647   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments 
    4748   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments 
     
    111112      INTEGER :: iiauper         ! Number of time steps in the IAU period 
    112113      INTEGER :: icycper         ! Number of time steps in the cycle 
    113       INTEGER :: iitend_date     ! Date YYYYMMDD of final time step 
    114       INTEGER :: iitbkg_date     ! Date YYYYMMDD of background time step for Jb term 
    115       INTEGER :: iitdin_date     ! Date YYYYMMDD of background time step for DI 
    116       INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step 
    117       INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
    118       ! 
     114      REAL(KIND=dp) :: ditend_date     ! Date YYYYMMDD.HHMMSS of final time step 
     115      REAL(KIND=dp) :: ditbkg_date     ! Date YYYYMMDD.HHMMSS of background time step for Jb term 
     116      REAL(KIND=dp) :: ditdin_date     ! Date YYYYMMDD.HHMMSS of background time step for DI 
     117      REAL(KIND=dp) :: ditiaustr_date  ! Date YYYYMMDD.HHMMSS of IAU interval start time step 
     118      REAL(KIND=dp) :: ditiaufin_date  ! Date YYYYMMDD.HHMMSS of IAU interval final time step 
     119 
    119120      REAL(wp) :: znorm        ! Normalization factor for IAU weights 
    120121      REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights (should be equal to one) 
     
    178179      icycper = nitend      - nit000      + 1  ! Cycle interval length 
    179180 
    180       CALL calc_date( nit000, nitend     , ndate0, iitend_date    )     ! Date of final time step 
    181       CALL calc_date( nit000, nitbkg_r   , ndate0, iitbkg_date    )     ! Background time for Jb referenced to ndate0 
    182       CALL calc_date( nit000, nitdin_r   , ndate0, iitdin_date    )     ! Background time for DI referenced to ndate0 
    183       CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0 
    184       CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )     ! IAU end time referenced to ndate0 
    185       ! 
     181      ! Date of final time step 
     182      CALL calc_date( nitend, ditend_date ) 
     183 
     184      ! Background time for Jb referenced to ndate0 
     185      CALL calc_date( nitbkg_r, ditbkg_date ) 
     186 
     187      ! Background time for DI referenced to ndate0 
     188      CALL calc_date( nitdin_r, ditdin_date ) 
     189 
     190      ! IAU start time referenced to ndate0 
     191      CALL calc_date( nitiaustr_r, ditiaustr_date ) 
     192 
     193      ! IAU end time referenced to ndate0 
     194      CALL calc_date( nitiaufin_r, ditiaufin_date ) 
     195 
    186196      IF(lwp) THEN 
    187197         WRITE(numout,*) 
     
    198208         WRITE(numout,*) '       ndastp         = ', ndastp 
    199209         WRITE(numout,*) '       ndate0         = ', ndate0 
    200          WRITE(numout,*) '       iitend_date    = ', iitend_date 
    201          WRITE(numout,*) '       iitbkg_date    = ', iitbkg_date 
    202          WRITE(numout,*) '       iitdin_date    = ', iitdin_date 
    203          WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date 
    204          WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date 
     210         WRITE(numout,*) '       nn_time0       = ', nn_time0 
     211         WRITE(numout,*) '       ditend_date    = ', ditend_date 
     212         WRITE(numout,*) '       ditbkg_date    = ', ditbkg_date 
     213         WRITE(numout,*) '       ditdin_date    = ', ditdin_date 
     214         WRITE(numout,*) '       ditiaustr_date = ', ditiaustr_date 
     215         WRITE(numout,*) '       ditiaufin_date = ', ditiaufin_date 
    205216      ENDIF 
    206217 
     
    360371            WRITE(numout,*)  
    361372            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', & 
    362                &            ' between dates ', NINT( z_inc_dateb ),' and ',  & 
    363                &            NINT( z_inc_datef ) 
     373               &            ' between dates ', z_inc_dateb,' and ',  & 
     374               &            z_inc_datef 
    364375            WRITE(numout,*) '~~~~~~~~~~~~' 
    365376         ENDIF 
    366377 
    367          IF (     ( NINT( z_inc_dateb ) < ndastp      ) & 
    368             & .OR.( NINT( z_inc_datef ) > iitend_date ) ) & 
     378         IF (     ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) & 
     379            & .OR.( z_inc_datef > ditend_date ) ) & 
    369380            & CALL ctl_warn( ' Validity time of assimilation increments is ', & 
    370381            &                ' outside the assimilation interval' ) 
    371382 
    372          IF ( ( ln_asmdin ).AND.( NINT( zdate_inc ) /= iitdin_date ) ) & 
     383         IF ( ( ln_asmdin ).AND.( zdate_inc /= ditdin_date ) ) & 
    373384            & CALL ctl_warn( ' Validity time of assimilation increments does ', & 
    374385            &                ' not agree with Direct Initialization time' ) 
     
    490501         IF(lwp) THEN 
    491502            WRITE(numout,*)  
    492             WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', NINT( zdate_bkg ) 
     503            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', & 
     504               &  zdate_bkg 
    493505            WRITE(numout,*) '~~~~~~~~~~~~' 
    494506         ENDIF 
    495507         ! 
    496          IF ( NINT( zdate_bkg ) /= iitdin_date ) & 
     508         IF ( zdate_bkg /= ditdin_date ) & 
    497509            & CALL ctl_warn( ' Validity time of assimilation background state does', & 
    498510            &                ' not agree with Direct Initialization time' ) 
     
    522534      ! 
    523535   END SUBROUTINE asm_inc_init 
    524  
    525  
    526    SUBROUTINE calc_date( kit000, kt, kdate0, kdate ) 
    527       !!---------------------------------------------------------------------- 
    528       !!                    ***  ROUTINE calc_date  *** 
    529       !!           
    530       !! ** Purpose : Compute the calendar date YYYYMMDD at a given time step. 
    531       !! 
    532       !! ** Method  : Compute the calendar date YYYYMMDD at a given time step. 
    533       !! 
    534       !! ** Action  :  
    535       !!---------------------------------------------------------------------- 
    536       INTEGER, INTENT(IN) :: kit000  ! Initial time step 
    537       INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000 
    538       INTEGER, INTENT(IN) :: kdate0  ! Initial date 
    539       INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0 
    540       ! 
    541       INTEGER :: iyea0    ! Initial year 
    542       INTEGER :: imon0    ! Initial month 
    543       INTEGER :: iday0    ! Initial day 
    544       INTEGER :: iyea     ! Current year 
    545       INTEGER :: imon     ! Current month 
    546       INTEGER :: iday     ! Current day 
    547       INTEGER :: idaystp  ! Number of days between initial and current date 
    548       INTEGER :: idaycnt  ! Day counter 
    549  
    550       INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    551  
    552       !----------------------------------------------------------------------- 
    553       ! Compute the calendar date YYYYMMDD 
    554       !----------------------------------------------------------------------- 
    555  
    556       ! Initial date 
    557       iyea0 =   kdate0 / 10000 
    558       imon0 = ( kdate0 - ( iyea0 * 10000 ) ) / 100 
    559       iday0 =   kdate0 - ( iyea0 * 10000 ) - ( imon0 * 100 )  
    560  
    561       ! Check that kt >= kit000 - 1 
    562       IF ( kt < kit000 - 1 ) CALL ctl_stop( ' kt must be >= kit000 - 1') 
    563  
    564       ! If kt = kit000 - 1 then set the date to the restart date 
    565       IF ( kt == kit000 - 1 ) THEN 
    566          kdate = ndastp 
    567          RETURN 
    568       ENDIF 
    569  
    570       ! Compute the number of days from the initial date 
    571       idaystp = INT( REAL( kt - kit000 ) * rdt / 86400. ) 
    572     
    573       iday    = iday0 
    574       imon    = imon0 
    575       iyea    = iyea0 
    576       idaycnt = 0 
    577  
    578       CALL calc_month_len( iyea, imonth_len ) 
    579  
    580       DO WHILE ( idaycnt < idaystp ) 
    581          iday = iday + 1 
    582          IF ( iday > imonth_len(imon) )  THEN 
    583             iday = 1 
    584             imon = imon + 1 
    585          ENDIF 
    586          IF ( imon > 12 ) THEN 
    587             imon = 1 
    588             iyea = iyea + 1 
    589             CALL calc_month_len( iyea, imonth_len )  ! update month lengths 
    590          ENDIF                  
    591          idaycnt = idaycnt + 1 
    592       END DO 
    593       ! 
    594       kdate = iyea * 10000 + imon * 100 + iday 
    595       ! 
    596    END SUBROUTINE 
    597  
    598  
    599    SUBROUTINE calc_month_len( iyear, imonth_len ) 
    600       !!---------------------------------------------------------------------- 
    601       !!                    ***  ROUTINE calc_month_len  *** 
    602       !!           
    603       !! ** Purpose : Compute the number of days in a months given a year. 
    604       !! 
    605       !! ** Method  :  
    606       !!---------------------------------------------------------------------- 
    607       INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    608       INTEGER :: iyear         !: year 
    609       !!---------------------------------------------------------------------- 
    610       ! 
    611       ! length of the month of the current year (from nleapy, read in namelist) 
    612       IF ( nleapy < 2 ) THEN  
    613          imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) 
    614          IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years 
    615             IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN 
    616                imonth_len(2) = 29 
    617             ENDIF 
    618          ENDIF 
    619       ELSE 
    620          imonth_len(:) = nleapy   ! all months with nleapy days per year 
    621       ENDIF 
    622       ! 
    623    END SUBROUTINE 
    624  
    625  
    626536   SUBROUTINE tra_asm_inc( kt ) 
    627537      !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.