PDAF_3dvar_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_3dvar_init --- PDAF-internal initialization of 3DVAR
!
! !INTERFACE:
SUBROUTINE PDAF_3dvar_init(subtype, param_int, dim_pint, param_real, dim_preal, &
     ensemblefilter, fixedbasis, verbose, outflag)

! !DESCRIPTION:
! Initialization of 3DVAR 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:
! 2021-03 - Lars Nerger - Initial code
! Later revisions - see svn log
!
! !USES:
  USE PDAF_mod_filter, &
       ONLY: incremental, dim_ens, type_opt, dim_cvec, dim_cvec_ens, &
       beta_3dvar, localfilter, forget, &
       type_forget, dim_bias_p, type_trans, dim_lag, &
       eps_cg_var, maxiter_cg_var, eps_cgplus_var, method_cgplus_var, irest_cgplus_var, &
       factr_lbfgs_var, pgtol_lbfgs_var, m_lbfgs_var

  IMPLICIT NONE

! !ARGUMENTS:
  INTEGER, INTENT(in) :: 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

! *** local variables ***


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

  dim_lag = 0
  type_forget = 0
  incremental = 0
  type_trans = 0
  dim_bias_p = 0

  ! Define whether filter is domain localized
  localfilter = 0

  IF (subtype==0 .AND. dim_ens > 1) THEN
     WRITE (*, '(/5x, a/)') 'PDAF-ERROR(6): 3D-Var must be run with ensemble size = 1!'
     outflag = 6
  END IF

  ! Initialize variable to prevent compiler warning
  forget = param_real(1)

  ! choice of optimizer
  IF (dim_pint>=3) THEN
     type_opt = param_int(3)
     IF (type_opt==0) THEN
        WRITE (*, '(/5x, a/)') 'PDAF-ERROR(4): Incorrect choice of solver!'
        outflag = 4
     END IF
  END IF

  IF (dim_pint>=4) THEN
     dim_cvec = param_int(4)
  ELSE
     IF (subtype==0 .OR. subtype==4 .OR. subtype==6 .OR. subtype==7) THEN
        WRITE (*, '(/5x, a/)') 'PDAF-ERROR(3): Missing specification of control vector dimension!'
        outflag = 3
     END IF
  END IF

  IF (dim_pint>=5) THEN
     dim_cvec_ens = param_int(5)
  ELSE
     IF (subtype==1 .OR. subtype==4) THEN
        dim_cvec_ens = dim_ens
     END IF
  END IF

  IF (dim_pint>=6) THEN
     m_lbfgs_var = param_int(6)
     method_cgplus_var = param_int(6)
     maxiter_cg_var = param_int(6)
  END IF

  IF (dim_pint>=7) THEN
     irest_cgplus_var = param_int(7)
  END IF

  IF (dim_preal>=2) THEN
     beta_3dvar = param_real(2)
  END IF

  IF (dim_preal>=3) THEN
     eps_cg_var = param_real(3)
     eps_cgplus_var = param_real(3)
     pgtol_lbfgs_var = param_real(3)
  END IF

  IF (dim_preal>=4) THEN
     factr_lbfgs_var = param_real(4)
  END IF

  ! Define whether filter is mode-based or ensemble-based
  ensemblefilter = .TRUE.
 
  ! 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 > 0) THEN
  
     WRITE(*, '(/a, 4x, a)') 'PDAF', '+++++++++++++++++++++++++++++++++++++++++++++++++++++++'
     WRITE(*, '(a, 4x, a)')  'PDAF', '+++                      3D-Var                     +++'
     WRITE(*, '(a, 4x, a)')  'PDAF', '+++                                                 +++'
     WRITE(*, '(a, 4x, a)')  'PDAF', '+++      3D-Var variants implemented following      +++'
     WRITE(*, '(a, 4x, a)')  'PDAF', '+++      Bannister, Q. J. Royal Meteorol. Soc.,     +++'
     WRITE(*, '(a, 4x, a)')  'PDAF', '+++     143 (2017) 607-633, doi:10.1002/qj.2982     +++'
     WRITE(*, '(a, 4x, a)')  'PDAF', '+++++++++++++++++++++++++++++++++++++++++++++++++++++++'

     ! *** General output ***
     WRITE (*, '(/a, 4x, a)') 'PDAF', '3DVAR configuration'
     WRITE (*, '(a, 9x, a, i1)') 'PDAF', 'filter sub-type = ', subtype
     IF (subtype == 0) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> 3DVAR incremental with control variable transform'
        WRITE (*, '(a, 12x, a, i7)') 'PDAF', '--> size of control vector', dim_cvec
     ELSEIF (subtype == 1) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> ensemble 3DVAR using LESTKF for ensemble transformation'
        WRITE (*, '(a, 12x, a, i7)') 'PDAF', '--> size of control vector', dim_cvec_ens
     ELSEIF (subtype == 4) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> ensemble 3DVAR using ESTKF for ensemble transformation'
        WRITE (*, '(a, 12x, a, i7)') 'PDAF', '--> size of control vector', dim_cvec_ens
     ELSE IF (subtype == 5) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> offline mode - choose method by the PDAF_assimilate/_put_state routine'
     ELSEIF (subtype == 6) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> hybrid 3DVAR using LESTKF for ensemble transformation'
        WRITE (*, '(a, 12x, a, f10.3)') 'PDAF', '--> hybrid weight', beta_3dvar
        WRITE (*, '(a, 12x, a, i7)') 'PDAF', '--> total size of control vector', dim_cvec_ens + dim_cvec
        WRITE (*, '(a, 12x, a, 2i7)') 'PDAF', '--> size of ensemble and parameterized parts', dim_cvec_ens, dim_cvec
     ELSEIF (subtype == 7) THEN
        WRITE (*, '(a, 12x, a)') 'PDAF', '--> hybrid 3DVAR using ESTKF for ensemble transformation'
        WRITE (*, '(a, 12x, a, f10.3)') 'PDAF', '--> hybrid weight', beta_3dvar
        WRITE (*, '(a, 12x, a, i7)') 'PDAF', '--> total size of control vector', dim_cvec_ens + dim_cvec
        WRITE (*, '(a, 12x, a, 2i7)') 'PDAF', '--> size of ensemble and parameterized parts', dim_cvec_ens, dim_cvec
     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
     IF (subtype == 1 .OR. subtype == 2) &
          WRITE (*, '(a, 12x, a, i5)') 'PDAF', '--> ensemble size:', dim_ens

  END IF filter_pe2

END SUBROUTINE PDAF_3dvar_init