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 10005 for branches/UKMO/dev_r5518_GO6_package_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90 – NEMO

Ignore:
Timestamp:
2018-07-26T13:07:55+02:00 (6 years ago)
Author:
timgraham
Message:

Included all of the functional changes from STARTHOUR branch in branches/2014

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r8400 r10005  
    4444#endif 
    4545   USE sbc_oce          ! Surface boundary condition variables. 
     46   USE diaobs, ONLY: calc_date     ! Compute the calendar date on a given step 
    4647 
    4748   IMPLICIT NONE 
     
    4950    
    5051   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights 
    51    PUBLIC   calc_date      !: Compute the calendar date YYYYMMDD on a given step 
    5252   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments 
    5353   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments 
     
    118118      INTEGER :: iiauper         ! Number of time steps in the IAU period 
    119119      INTEGER :: icycper         ! Number of time steps in the cycle 
    120       INTEGER :: iitend_date     ! Date YYYYMMDD of final time step 
    121       INTEGER :: iitbkg_date     ! Date YYYYMMDD of background time step for Jb term 
    122       INTEGER :: iitdin_date     ! Date YYYYMMDD of background time step for DI 
    123       INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step 
    124       INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step 
    125       ! 
     120      REAL(KIND=dp) :: ditend_date     ! Date YYYYMMDD.HHMMSS of final time step 
     121      REAL(KIND=dp) :: ditbkg_date     ! Date YYYYMMDD.HHMMSS of background time step for Jb term 
     122      REAL(KIND=dp) :: ditdin_date     ! Date YYYYMMDD.HHMMSS of background time step for DI 
     123      REAL(KIND=dp) :: ditiaustr_date  ! Date YYYYMMDD.HHMMSS of IAU interval start time step 
     124      REAL(KIND=dp) :: ditiaufin_date  ! Date YYYYMMDD.HHMMSS of IAU interval final time step 
     125 
    126126      REAL(wp) :: znorm        ! Normalization factor for IAU weights 
    127127      REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights (should be equal to one) 
     
    186186      icycper = nitend      - nit000      + 1  ! Cycle interval length 
    187187 
    188       CALL calc_date( nit000, nitend     , ndate0, iitend_date    )     ! Date of final time step 
    189       CALL calc_date( nit000, nitbkg_r   , ndate0, iitbkg_date    )     ! Background time for Jb referenced to ndate0 
    190       CALL calc_date( nit000, nitdin_r   , ndate0, iitdin_date    )     ! Background time for DI referenced to ndate0 
    191       CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )     ! IAU start time referenced to ndate0 
    192       CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )     ! IAU end time referenced to ndate0 
    193       ! 
     188      ! Date of final time step 
     189      CALL calc_date( nitend, ditend_date ) 
     190 
     191      ! Background time for Jb referenced to ndate0 
     192      CALL calc_date( nitbkg_r, ditbkg_date ) 
     193 
     194      ! Background time for DI referenced to ndate0 
     195      CALL calc_date( nitdin_r, ditdin_date ) 
     196 
     197      ! IAU start time referenced to ndate0 
     198      CALL calc_date( nitiaustr_r, ditiaustr_date ) 
     199 
     200      ! IAU end time referenced to ndate0 
     201      CALL calc_date( nitiaufin_r, ditiaufin_date ) 
     202 
    194203      IF(lwp) THEN 
    195204         WRITE(numout,*) 
     
    206215         WRITE(numout,*) '       ndastp         = ', ndastp 
    207216         WRITE(numout,*) '       ndate0         = ', ndate0 
    208          WRITE(numout,*) '       iitend_date    = ', iitend_date 
    209          WRITE(numout,*) '       iitbkg_date    = ', iitbkg_date 
    210          WRITE(numout,*) '       iitdin_date    = ', iitdin_date 
    211          WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date 
    212          WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date 
     217         WRITE(numout,*) '       nn_time0       = ', nn_time0 
     218         WRITE(numout,*) '       ditend_date    = ', ditend_date 
     219         WRITE(numout,*) '       ditbkg_date    = ', ditbkg_date 
     220         WRITE(numout,*) '       ditdin_date    = ', ditdin_date 
     221         WRITE(numout,*) '       ditiaustr_date = ', ditiaustr_date 
     222         WRITE(numout,*) '       ditiaufin_date = ', ditiaufin_date 
    213223      ENDIF 
    214224 
     
    368378            WRITE(numout,*)  
    369379            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', & 
    370                &            ' between dates ', NINT( z_inc_dateb ),' and ',  & 
    371                &            NINT( z_inc_datef ) 
     380               &            ' between dates ', z_inc_dateb,' and ',  & 
     381               &            z_inc_datef 
    372382            WRITE(numout,*) '~~~~~~~~~~~~' 
    373383         ENDIF 
    374384 
    375          IF (     ( NINT( z_inc_dateb ) < ndastp      ) & 
    376             & .OR.( NINT( z_inc_datef ) > iitend_date ) ) & 
     385         IF (     ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) & 
     386            & .OR.( z_inc_datef > ditend_date ) ) & 
    377387            & CALL ctl_warn( ' Validity time of assimilation increments is ', & 
    378388            &                ' outside the assimilation interval' ) 
    379389 
    380          IF ( ( ln_asmdin ).AND.( NINT( zdate_inc ) /= iitdin_date ) ) & 
     390         IF ( ( ln_asmdin ).AND.( zdate_inc /= ditdin_date ) ) & 
    381391            & CALL ctl_warn( ' Validity time of assimilation increments does ', & 
    382392            &                ' not agree with Direct Initialization time' ) 
     
    505515            WRITE(numout,*)  
    506516            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', & 
    507                &  NINT( zdate_bkg ) 
     517               &  zdate_bkg 
    508518            WRITE(numout,*) '~~~~~~~~~~~~' 
    509519         ENDIF 
    510520 
    511          IF ( NINT( zdate_bkg ) /= iitdin_date ) & 
     521         IF ( zdate_bkg /= ditdin_date ) & 
    512522            & CALL ctl_warn( ' Validity time of assimilation background state does', & 
    513523            &                ' not agree with Direct Initialization time' ) 
     
    537547      ! 
    538548   END SUBROUTINE asm_inc_init 
    539  
    540  
    541    SUBROUTINE calc_date( kit000, kt, kdate0, kdate ) 
    542       !!---------------------------------------------------------------------- 
    543       !!                    ***  ROUTINE calc_date  *** 
    544       !!           
    545       !! ** Purpose : Compute the calendar date YYYYMMDD at a given time step. 
    546       !! 
    547       !! ** Method  : Compute the calendar date YYYYMMDD at a given time step. 
    548       !! 
    549       !! ** Action  :  
    550       !!---------------------------------------------------------------------- 
    551       INTEGER, INTENT(IN) :: kit000  ! Initial time step 
    552       INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000 
    553       INTEGER, INTENT(IN) :: kdate0  ! Initial date 
    554       INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0 
    555       ! 
    556       INTEGER :: iyea0    ! Initial year 
    557       INTEGER :: imon0    ! Initial month 
    558       INTEGER :: iday0    ! Initial day 
    559       INTEGER :: iyea     ! Current year 
    560       INTEGER :: imon     ! Current month 
    561       INTEGER :: iday     ! Current day 
    562       INTEGER :: idaystp  ! Number of days between initial and current date 
    563       INTEGER :: idaycnt  ! Day counter 
    564  
    565       INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    566  
    567       !----------------------------------------------------------------------- 
    568       ! Compute the calendar date YYYYMMDD 
    569       !----------------------------------------------------------------------- 
    570  
    571       ! Initial date 
    572       iyea0 =   kdate0 / 10000 
    573       imon0 = ( kdate0 - ( iyea0 * 10000 ) ) / 100 
    574       iday0 =   kdate0 - ( iyea0 * 10000 ) - ( imon0 * 100 )  
    575  
    576       ! Check that kt >= kit000 - 1 
    577       IF ( kt < kit000 - 1 ) CALL ctl_stop( ' kt must be >= kit000 - 1') 
    578  
    579       ! If kt = kit000 - 1 then set the date to the restart date 
    580       IF ( kt == kit000 - 1 ) THEN 
    581  
    582          kdate = ndastp 
    583          RETURN 
    584  
    585       ENDIF 
    586  
    587       ! Compute the number of days from the initial date 
    588       idaystp = INT( REAL( kt - kit000 ) * rdt / 86400. ) 
    589     
    590       iday    = iday0 
    591       imon    = imon0 
    592       iyea    = iyea0 
    593       idaycnt = 0 
    594  
    595       CALL calc_month_len( iyea, imonth_len ) 
    596  
    597       DO WHILE ( idaycnt < idaystp ) 
    598          iday = iday + 1 
    599          IF ( iday > imonth_len(imon) )  THEN 
    600             iday = 1 
    601             imon = imon + 1 
    602          ENDIF 
    603          IF ( imon > 12 ) THEN 
    604             imon = 1 
    605             iyea = iyea + 1 
    606             CALL calc_month_len( iyea, imonth_len )  ! update month lengths 
    607          ENDIF                  
    608          idaycnt = idaycnt + 1 
    609       END DO 
    610       ! 
    611       kdate = iyea * 10000 + imon * 100 + iday 
    612       ! 
    613    END SUBROUTINE 
    614  
    615  
    616    SUBROUTINE calc_month_len( iyear, imonth_len ) 
    617       !!---------------------------------------------------------------------- 
    618       !!                    ***  ROUTINE calc_month_len  *** 
    619       !!           
    620       !! ** Purpose : Compute the number of days in a months given a year. 
    621       !! 
    622       !! ** Method  :  
    623       !!---------------------------------------------------------------------- 
    624       INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    625       INTEGER :: iyear         !: year 
    626       !!---------------------------------------------------------------------- 
    627       ! 
    628       ! length of the month of the current year (from nleapy, read in namelist) 
    629       IF ( nleapy < 2 ) THEN  
    630          imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) 
    631          IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years 
    632             IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN 
    633                imonth_len(2) = 29 
    634             ENDIF 
    635          ENDIF 
    636       ELSE 
    637          imonth_len(:) = nleapy   ! all months with nleapy days per year 
    638       ENDIF 
    639       ! 
    640    END SUBROUTINE 
    641  
    642549 
    643550   SUBROUTINE tra_asm_inc( kt ) 
Note: See TracChangeset for help on using the changeset viewer.