checkadj.F

Go to the documentation of this file.

#include "cppdefs.h"
      SUBROUTINE checkadj
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This subroutine checks activated C-preprocessing options for        !
!  consistency with all available algorithms.                          !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
      USE mod_scalars
      USE mod_strings
!
      USE strings_mod, ONLY : uppercase
!
      implicit none
!
!  Local variable declarations.
!
      integer :: ic = 0
      integer :: ifound
 
      character (len=40) :: string
!
!-----------------------------------------------------------------------
!  Report issues with various C-preprocessing options.
!-----------------------------------------------------------------------
!
#ifdef BIO_FASHAM
      ic=ic+1
      string=uppercase('bio_fasham')
      IF (master) WRITE(stdout,10) trim(string),                        &
     &            'CPP option renamed to '//uppercase('bio_fennel')
#endif
 
      string=uppercase('ts_smagorinsky')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        IF (master) WRITE(stdout,10) trim(string),                      &
     &                               'stability problems, WARNING'
      END IF
 
      string=uppercase('split_u3')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        IF (master) WRITE(stdout,10) trim(string),                      &
     &                               'stability problems, WARNING'
      END IF
 
      string=uppercase('uv_smagorinsky')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        IF (master) WRITE(stdout,10) trim(string),                      &
     &                               'stability problems, WARNING'
      END IF
 
      string=uppercase('uv_u3adv_split')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        IF (master) WRITE(stdout,10) trim(string),                      &
     &                               'stability problems, WARNING'
      END IF
 
#ifdef IS4DVAR
      string=uppercase('is4dvar')
      IF (master) WRITE(stdout,10) trim(string),                        &
     &                             'deprecated option, use ' //         &
     &                             uppercase('i4dvar') //               &
     &                             ' instead, WARNING'
#endif
 
#ifdef IS4DVAR_SENSITIVITY
      string=uppercase('is4dvar_sensitivity')
      IF (master) WRITE(stdout,10) trim(string),                        &
     &                             'deprecated option, use ' //         &
     &                         uppercase('i4dvar_ana_sensitivity') //   &
     &                             ' instead, WARNING'
#endif
 
#ifdef W4DPSAS
      string=uppercase('w4dpsas')
      IF (master) WRITE(stdout,10) trim(string),                        &
     &                             'deprecated option, use ' //         &
     &                             uppercase('rbl4dvar') //             &
     &                             ' instead, WARNING'
#endif
 
#ifdef W4DPSAS_SENSITIVITY
      string=uppercase('w4dpsas_sensitivity')
      IF (master) WRITE(stdout,10) trim(string),                        &
     &                             'deprecated option, use ' //         &
     &                         uppercase('rbl4dvar_ana_sensitivity') // &
     &                             ' instead, WARNING'
#endif
 
#ifdef W4DPSAS_FCT_SENSITIVITY
      string=uppercase('w4dpsas_fct_sensitivity')
      IF (master) WRITE(stdout,10) trim(string),                        &
     &                             'deprecated option, use ' //         &
     &                         uppercase('rbl4dvar_fct_sensitivity') // &
     &                             ' instead, WARNING'
#endif
 
#ifdef W4DVAR
      string=uppercase('w4dvar')
      IF (master) WRITE(stdout,10) trim(string),                        &
     &                             'deprecated option, use ' //         &
     &                             uppercase('r4dvar') //               &
     &                             ' instead, WARNING'
#endif
 
#ifdef W4DVAR_SENSITIVITY
      string=uppercase('w4dvar_sensitivity')
      IF (master) WRITE(stdout,10) trim(string),                        &
     &                             'deprecated option, use ' //         &
     &                         uppercase('r4dvar_ana_sensitivity') //   &
     &                             ' instead, WARNING'
#endif
 
# ifdef NL_BULK_FLUXES
      string=uppercase('nl_bulk_fluxes')
      ic=ic+1
      IF (master) WRITE(stdout,20) trim(string),                        &
     &                             'deprecated option, use ' //         &
     &                         uppercase('forward_fluxes')//' and ' //  &
     &                         uppercase('prior_bulk_fluxes') //        &
     &                             ' instead, FATAL ERROR'
# endif
 
#if defined TANGENT || defined TL_IOMS || defined ADJOINT
!
!-----------------------------------------------------------------------
!  Stop if unsupported C-preprocessing options are activated for the
!  adjoint-based algorithms.
!-----------------------------------------------------------------------
!
      string=uppercase('bedload_mpm')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('bedload_soulsby')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('bio_fennel')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
 
# ifndef FORWARD_MIXING
!
      string=uppercase('bvf_mixing')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
# endif
!
      string=uppercase('clima_ts_mix')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        IF (master) WRITE(stdout,10) trim(string),                      &
     &                               'not tested, WARNING'
      END IF
!
      IF (any(ad_lbc(ieast,isfsur,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isFsur)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(iwest,isfsur,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isFsur)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(isouth,isfsur,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isFsur)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(inorth,isfsur,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isFsur)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(ieast,isubar,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isUbar)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(iwest,isubar,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isUbar)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(isouth,isubar,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isUbar)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(inorth,isubar,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isUbar)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(ieast,isvbar,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isVbar)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(iwest,isvbar,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isVbar)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(isouth,isvbar,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isVbar)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(inorth,isvbar,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isVbar)',           &
     &                               'not finished, FATAL ERROR'
      END IF
 
# ifdef SOLVE3D
!
      IF (any(ad_lbc(ieast,isuvel,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isUvel)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(iwest,isuvel,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isUvel)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(isouth,isuvel,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isUvel)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(inorth,isuvel,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isUvel)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(ieast,isvvel,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isVvel)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(iwest,isvvel,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isVvel)',            &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(isouth,isvvel,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isVvel)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(inorth,isvvel,:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isVvel)',           &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(ieast,istvar(:),:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(ieast,isTvar(:))',         &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(iwest,istvar(:),:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(iwest,isTvar(:))',         &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(isouth,istvar(:),:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(isouth,isTvar(:))',        &
     &                               'not finished, FATAL ERROR'
      END IF
!
      IF (any(ad_lbc(inorth,istvar(:),:)%radiation)) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) 'ad_LBC(inorth,isTvar(:))',        &
     &                               'not finished, FATAL ERROR'
      END IF
# endif
!
      string=uppercase('ecosim')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('geopotential_hconv')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,10) trim(string),                      &
     &                               'experimental, AVOID USAGE'
      END IF
 
# ifndef FORWARD_MIXING
!
      string=uppercase('gls_mixing')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
!!      ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not differentiable, WARNING'
      END IF
# endif
!
      string=uppercase('hypoxia_srm')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('limit_bstress')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
 
# ifndef FORWARD_MIXING
!
      string=uppercase('lmd_mixing')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
!!      ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not differentiable, WARNING'
      END IF
# endif
!
      string=uppercase('mb_bbl')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
 
# ifndef FORWARD_MIXING
!
      string=uppercase('my25_mixing')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
!!      ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not differentiable, WARNING'
      END IF
# endif
!
      string=uppercase('wec')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('nemuro')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('nesting')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('npzd_franks')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
!!      ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not working, FATAL ERROR'
      END IF
!
      string=uppercase('pj_gradpq2')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('pj_gradpq4')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('red_tide')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('refdif_coupling')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not allowed, FATAL ERROR'
      END IF
!
      string=uppercase('sediment')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('sed_dens')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not tested, FATAL ERROR'
      END IF
!
      string=uppercase('sed_morph')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('sg_bbl')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('ssw_bbl')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('suspload')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('swan_coupling')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not allowed, FATAL ERROR'
      END IF
!
# if defined TANGENT || defined TL_IOMS
      IF (any(tl_hadvection(:,:)%MPDATA).or.                            &
     &    any(tl_vadvection(:,:)%MPDATA)) THEN
        string=uppercase('mpdata')
        ifound=index(trim(coptions), trim(string))
        IF (ifound.ne.0) THEN
          ic=ic+1
          IF (master) WRITE(stdout,20) trim(string),                    &
     &                                 'not coded, FATAL ERROR'
        END IF
      END IF
!
      IF (any(tl_hadvection(:,:)%HSIMT).or.                             &
     &    any(tl_vadvection(:,:)%HSIMT)) THEN
        string=uppercase('hsimt')
        ifound=index(trim(coptions), trim(string))
        IF (ifound.ne.0) THEN
          ic=ic+1
          IF (master) WRITE(stdout,20) trim(string),                    &
     &                                 'not coded, FATAL ERROR'
        END IF
      END IF
!
      IF (any(tl_hadvection(:,:)%SPLIT_U3).or.                          &
     &    any(tl_vadvection(:,:)%SPLIT_U3)) THEN
        string=uppercase('split_u3')
        ifound=index(trim(coptions), trim(string))
        IF (ifound.ne.0) THEN
          ic=ic+1
          IF (master) WRITE(stdout,20) trim(string),                    &
     &                                 'not coded, FATAL ERROR'
        END IF
      END IF
# endif
!
      string=uppercase('ts_smagorinsky')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('uv_smagorinsky')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('uv_u3adv_split')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20) trim(string),                      &
     &                               'not coded, FATAL ERROR'
      END IF
!
      string=uppercase('wet_dry')
      ifound=index(trim(coptions), trim(string))
      IF (ifound.ne.0) THEN
        ic=ic+1
        IF (master) WRITE(stdout,20)  trim(string),                     &
     &                                'not coded, FATAL ERROR'
      END IF
#endif
!
!-----------------------------------------------------------------------
!  Set execution error flag to stop execution.
!-----------------------------------------------------------------------
!
      IF (ic.gt.0) THEN
        exit_flag=5
      END IF
!
 10   FORMAT (/,' CHECKADJ - use caution when activating: ', a,/,12x,   &
     &        'REASON: ',a,'.')
#if defined TANGENT || defined TL_IOMS || defined ADJOINT
 20   FORMAT (/,' CHECKADJ - unsupported option in adjoint-based',      &
     &        ' algorithms: ',a,/,12x,'REASON: ',a,'.')
#endif
!
      RETURN
      END SUBROUTINE checkadj