PDAF_seek_init.F90 Source File


Source Code

! Copyright (c) 2004-2024 Lars Nerger
!
! This file is part of PDAF.
!
! PDAF is free software: you can redistribute it and/or modify
! it under the terms of the GNU Lesser General Public License
! as published by the Free Software Foundation, either version
! 3 of the License, or (at your option) any later version.
!
! PDAF is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU Lesser General Public License for more details.
!
! You should have received a copy of the GNU Lesser General Public
! License along with PDAF.  If not, see <http://www.gnu.org/licenses/>.
!
!$Id$
!BOP
!
! !ROUTINE: PDAF_seek_init --- PDAF-internal initialization of SEEK filter
!
! !INTERFACE:
SUBROUTINE PDAF_seek_init(subtype, param_int, dim_pint, param_real, dim_preal, &
     ensemblefilter, fixedbasis, verbose, outflag)

! !DESCRIPTION:
! Initialization of SEEK within PDAF. Performed are:\\
!   - initialize filter-specific parameters\\
!   - Print screen information on filter configuration.
!
! !  This is a core routine of PDAF and
!    should not be changed by the user   !
!
! !REVISION HISTORY:
! 2003-08 - Lars Nerger - Initial code
! Later revisions - see svn log
!
! !USES:
  USE PDAF_mod_filter, &
       ONLY: offline_mode, incremental, dim_eof, forget, &
       int_rediag, epsilon, type_forget, dim_ens

  IMPLICIT NONE

! !ARGUMENTS:
  INTEGER, INTENT(inout) :: subtype             ! Sub-type of filter
  INTEGER, INTENT(in) :: dim_pint               ! Number of integer parameters
  INTEGER, INTENT(inout) :: param_int(dim_pint) ! Integer parameter array
  INTEGER, INTENT(in) :: dim_preal              ! Number of real parameters 
  REAL, INTENT(inout) :: param_real(dim_preal)  ! Real parameter array
  LOGICAL, INTENT(out) :: ensemblefilter ! Is the chosen filter ensemble-based?
  LOGICAL, INTENT(out) :: fixedbasis     ! Does the filter run with fixed error-space basis?
  INTEGER, INTENT(in) :: verbose                ! Control screen output
  INTEGER, INTENT(inout):: outflag              ! Status flag

! !CALLING SEQUENCE:
! Called by: PDAF_init_filters
!EOP


! ****************************
! *** INITIALIZE VARIABLES ***
! ****************************

  ! Whether incremental updating is performed
  if (dim_pint>=4) THEN
     incremental = param_int(4)
     IF (param_int(4) /= 0 .AND. param_int(4) /= 1) THEN
        WRITE (*,'(/5x, a/)') &
             'PDAF-ERROR(10): Invalid setting for incremental updating!'
        outflag = 10
     END IF
  END IF

  ! Interval to perform rediagonalization
  IF (dim_pint >= 3) THEN
     int_rediag = param_int(3)
     IF (int_rediag <= 0) THEN
        WRITE (*,'(/5x, a/)') &
             'PDAF-ERROR(101): Invalid setting for re-diag interval!'
        outflag = 101
     END IF
  END IF

  ! epsilon for approximated TLM evolution in SEEK
  IF (dim_pint >= 2 .AND. .not.offline_mode) THEN
     epsilon = param_real(2)
     IF (epsilon <= 0.0) THEN
        WRITE (*,'(/5x, a/)') &
             'PDAF-ERROR(102): Invalid setting for epsilon in SEEK!'
        outflag = 102
     END IF
  END IF

  ! For fixed basis SEEK do not perform rediagonalization
  IF (subtype == 2 .OR. subtype == 3) THEN
     int_rediag = 0
  END IF

  ! Type of forgetting factor - not a choice for SEEK
  type_forget = 0
     
  ! Special for SEEK: Initialize number of modes
  dim_eof = dim_ens

  ! Define whether filter is mode-based or ensemble-based
  ensemblefilter = .FALSE.

  ! Initialize flag for fixed-basis filters
  IF (subtype == 2 .OR. subtype == 3) THEN
     fixedbasis = .TRUE.
  ELSE
     fixedbasis = .FALSE.
  END IF


! *********************
! *** Screen output ***
! *********************

  filter_pe2: IF (verbose == 1) THEN
  
     WRITE(*, '(/a, 5x, a)') 'PDAF', '++++++++++++++++++++++++++++++++++++++++++++++++++++++'
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++                  SEEK Filter                   +++'
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++                                                +++'
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++    Pham et al., J. Mar. Syst. 16 (1998) 323    +++'
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++          This implementation follows           +++'
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++      Nerger et al., Tellus 57A (2005) 715      +++'
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++                                                +++'     
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++ NOTE: The SEEK filter in PDAF is deprecated    +++'     
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++       as of Version 1.14. It will be removed   +++'
     WRITE(*, '(a, 5x, a)')  'PDAF', '+++       in the future.                           +++'     
     WRITE(*, '(a, 5x, a)')  'PDAF', '++++++++++++++++++++++++++++++++++++++++++++++++++++++'

     ! *** General output ***
     WRITE (*, '(/a, 4x, a)') 'PDAF', 'SEEK configuration'
     WRITE (*, '(a, 10x, a, i1)') 'PDAF', 'filter sub-type = ', subtype
     IF (subtype == 0) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> Standard SEEK with unit modes'
     ELSE IF (subtype == 1) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> SEEK with non-unit modes'
     ELSE IF (subtype == 2) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> fixed basis filter with update of matrix U'
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> no re-diagonalization of VUV^T'
     ELSE IF (subtype == 3) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> fixed basis filter & no update of matrix U'
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> no re-diagonalization of VUV^T'
     ELSE IF (subtype == 5) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> offline mode'

        ! Reset subtype
        subtype = 0
     ELSE
        WRITE (*, '(/5x, a/)') 'PDAF-ERROR(2): No valid sub type!'
        outflag = 2
     END IF
     IF (incremental == 1) &
          WRITE (*, '(a, 12x, a)') 'PDAF', '--> Perform incremental updating'
     IF (type_forget == 0) THEN
        WRITE (*, '(a, 12x, a, f5.2)') 'PDAF', '--> Use fixed forgetting factor:', forget
     ELSE
        WRITE (*, '(/5x, a/)') 'PDAF-ERROR(8): Invalid type of forgetting factor!'
        outflag = 8
     ENDIF
     WRITE (*, '(a, 12x, a, i5)') 'PDAF', '--> number of EOFs:', dim_eof
     IF (.not.offline_mode) THEN
        IF ((int_rediag > 0) .AND. ((subtype /= 2) .OR. (subtype /= 3))) THEN
           IF (int_rediag == 1) THEN
              WRITE (*, '(a, 10x, a, i4, a)') 'PDAF', 'Re-diag at each analysis step'
           ELSE
              WRITE (*, '(a, 10x, a, i4, a)') 'PDAF', 'Re-diag at each ', int_rediag, &
                   '-th analysis step'
           END IF
        END IF
     ELSE
        IF (int_rediag == 1) THEN
           WRITE (*, '(a, 5x, a)') 'PDAF', 'Perform re-diagonalization'
        ELSE
           WRITE (*, '(a, 5x, a)') 'PDAF', 'No re-diagonalization'
        END IF
     END IF
  END IF filter_pe2

END SUBROUTINE PDAF_seek_init