| 1 | 
dimitri | 
1.1 | 
C $Header: /u/gcmpack/MITgcm/pkg/gmredi/gmredi_check.F,v 1.15 2007/11/05 19:03:26 jmc Exp $ | 
| 2 | 
  | 
  | 
C $Name:  $ | 
| 3 | 
  | 
  | 
 | 
| 4 | 
  | 
  | 
#include "GMREDI_OPTIONS.h" | 
| 5 | 
  | 
  | 
#ifdef ALLOW_PTRACERS | 
| 6 | 
  | 
  | 
# include "PTRACERS_OPTIONS.h" | 
| 7 | 
  | 
  | 
#endif | 
| 8 | 
  | 
  | 
 | 
| 9 | 
  | 
  | 
CBOP | 
| 10 | 
  | 
  | 
C     !ROUTINE: GMREDI_CHECK | 
| 11 | 
  | 
  | 
C     !INTERFACE: | 
| 12 | 
  | 
  | 
      SUBROUTINE GMREDI_CHECK( myThid ) | 
| 13 | 
  | 
  | 
 | 
| 14 | 
  | 
  | 
C     !DESCRIPTION: \bv | 
| 15 | 
  | 
  | 
C     *==========================================================* | 
| 16 | 
  | 
  | 
C     | SUBROUTINE GMREDI_CHECK | 
| 17 | 
  | 
  | 
C     | o Check consistency with model configuration | 
| 18 | 
  | 
  | 
C     *==========================================================* | 
| 19 | 
  | 
  | 
C     *==========================================================* | 
| 20 | 
  | 
  | 
C     \ev | 
| 21 | 
  | 
  | 
 | 
| 22 | 
  | 
  | 
C     !USES: | 
| 23 | 
  | 
  | 
      IMPLICIT NONE | 
| 24 | 
  | 
  | 
 | 
| 25 | 
  | 
  | 
C     === Global variables === | 
| 26 | 
  | 
  | 
#include "SIZE.h" | 
| 27 | 
  | 
  | 
#include "EEPARAMS.h" | 
| 28 | 
  | 
  | 
#include "PARAMS.h" | 
| 29 | 
  | 
  | 
#include "GMREDI.h" | 
| 30 | 
  | 
  | 
#ifdef ALLOW_GENERIC_ADVDIFF | 
| 31 | 
  | 
  | 
# include "GAD.h" | 
| 32 | 
  | 
  | 
#endif | 
| 33 | 
  | 
  | 
#ifdef ALLOW_PTRACERS | 
| 34 | 
  | 
  | 
# include "PTRACERS_SIZE.h" | 
| 35 | 
  | 
  | 
# include "PTRACERS_PARAMS.h" | 
| 36 | 
  | 
  | 
#endif | 
| 37 | 
  | 
  | 
 | 
| 38 | 
  | 
  | 
C     !INPUT/OUTPUT PARAMETERS: | 
| 39 | 
  | 
  | 
C     === Routine arguments === | 
| 40 | 
  | 
  | 
C     myThid :: my Thread Id number | 
| 41 | 
  | 
  | 
      INTEGER myThid | 
| 42 | 
  | 
  | 
 | 
| 43 | 
  | 
  | 
#ifdef ALLOW_GMREDI | 
| 44 | 
  | 
  | 
C     !LOCAL VARIABLES: | 
| 45 | 
  | 
  | 
C     === Local variables === | 
| 46 | 
  | 
  | 
C     msgBuf :: Informational/error meesage buffer | 
| 47 | 
  | 
  | 
      CHARACTER*(MAX_LEN_MBUF) msgBuf | 
| 48 | 
  | 
  | 
CEOP | 
| 49 | 
  | 
  | 
#ifdef ALLOW_PTRACERS | 
| 50 | 
  | 
  | 
      INTEGER iTr | 
| 51 | 
  | 
  | 
      LOGICAL redFlag | 
| 52 | 
  | 
  | 
#endif | 
| 53 | 
  | 
  | 
 | 
| 54 | 
  | 
  | 
      _BEGIN_MASTER(myThid) | 
| 55 | 
  | 
  | 
 | 
| 56 | 
  | 
  | 
       WRITE(msgBuf,'(A)') 'GMREDI_CHECK: #define GMREDI' | 
| 57 | 
  | 
  | 
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, | 
| 58 | 
  | 
  | 
     &                     SQUEEZE_RIGHT , myThid ) | 
| 59 | 
  | 
  | 
 | 
| 60 | 
  | 
  | 
C- print out some kee parameters : | 
| 61 | 
  | 
  | 
       CALL WRITE_0D_L( GM_AdvForm, INDEX_NONE, | 
| 62 | 
  | 
  | 
     &  'GM_AdvForm =', '  /* if FALSE => use SkewFlux Form */') | 
| 63 | 
  | 
  | 
       CALL WRITE_0D_L( GM_AdvSeparate, INDEX_NONE, | 
| 64 | 
  | 
  | 
     & 'GM_AdvSeparate =',' /* Calc Bolus & Euler Adv. separately */') | 
| 65 | 
  | 
  | 
       CALL WRITE_0D_L( GM_ExtraDiag, INDEX_NONE, | 
| 66 | 
  | 
  | 
     &  'GM_ExtraDiag =','  /* Tensor Extra Diag (line 1&2) non 0 */') | 
| 67 | 
  | 
  | 
       CALL WRITE_0D_R8( GM_isopycK, INDEX_NONE, 'GM_isopycK =', | 
| 68 | 
  | 
  | 
     &  '   /* Background Isopyc. Diffusivity ( m^2/s ) */') | 
| 69 | 
  | 
  | 
       CALL WRITE_0D_R8( GM_background_K*GM_skewflx, INDEX_NONE, | 
| 70 | 
  | 
  | 
     &  ' GM_skewflx*K =', | 
| 71 | 
  | 
  | 
     &  '   /* Background GM_SkewFlx Diffusivity ( m^2/s ) */') | 
| 72 | 
  | 
  | 
       CALL WRITE_0D_R8( GM_background_K*GM_advect, INDEX_NONE, | 
| 73 | 
  | 
  | 
     &  ' GM_advec*K =', | 
| 74 | 
  | 
  | 
     &  '   /* Backg. GM-Advec(=Bolus) Diffusivity ( m^2/s ) */') | 
| 75 | 
  | 
  | 
       CALL WRITE_0D_R8( GM_Visbeck_alpha, INDEX_NONE, | 
| 76 | 
  | 
  | 
     &  ' GM_Visbeck_alpha =','   /* Visbeck alpha coeff. ( ) */') | 
| 77 | 
  | 
  | 
       WRITE(msgBuf,'(A,A40)')' Tapering/Cliping : ',GM_taper_scheme | 
| 78 | 
  | 
  | 
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, | 
| 79 | 
  | 
  | 
     &                     SQUEEZE_RIGHT, myThid ) | 
| 80 | 
  | 
  | 
       CALL WRITE_0D_R8( GM_Small_Number, INDEX_NONE, | 
| 81 | 
  | 
  | 
     &  ' GM_Small_Number =','  /* epsilon used in slope calc */') | 
| 82 | 
  | 
  | 
       CALL WRITE_0D_R8( GM_slopeSqCutoff, INDEX_NONE, | 
| 83 | 
  | 
  | 
     &  ' GM_slopeSqCutoff =', '  /* Slope^2 cut-off value */') | 
| 84 | 
  | 
  | 
 | 
| 85 | 
  | 
  | 
 | 
| 86 | 
  | 
  | 
C--  Check parameters: | 
| 87 | 
  | 
  | 
 | 
| 88 | 
  | 
  | 
C-     GM/Redi needs implicit diffusion (will be packaged later) | 
| 89 | 
  | 
  | 
      IF ( .NOT.implicitDiffusion ) THEN | 
| 90 | 
  | 
  | 
        WRITE(msgBuf,'(A)') 'GM/Redi needs implicitDiffusion=.true.' | 
| 91 | 
  | 
  | 
        CALL PRINT_ERROR( msgBuf , myThid ) | 
| 92 | 
  | 
  | 
        STOP 'ABNORMAL END: S/R GMREDI_CHECK' | 
| 93 | 
  | 
  | 
      ENDIF | 
| 94 | 
  | 
  | 
 | 
| 95 | 
  | 
  | 
#ifndef GM_VISBECK_VARIABLE_K | 
| 96 | 
  | 
  | 
C     Make sure we are not trying to use something that is unavailable | 
| 97 | 
  | 
  | 
      IF ( GM_Visbeck_alpha.NE.0. ) THEN | 
| 98 | 
  | 
  | 
       WRITE(msgBuf,'(A)') | 
| 99 | 
  | 
  | 
     &   ' GMREDI_CHECK: Visbeck variables used in data.gmredi' | 
| 100 | 
  | 
  | 
       CALL PRINT_ERROR( msgBuf, myThid ) | 
| 101 | 
  | 
  | 
       WRITE(msgBuf,'(A)') | 
| 102 | 
  | 
  | 
     &   ' GMREDI_CHECK: without #define GM_VISBECK_VARIABLE_K' | 
| 103 | 
  | 
  | 
       CALL PRINT_ERROR( msgBuf, myThid ) | 
| 104 | 
  | 
  | 
       STOP 'ABNORMAL END: S/R GMREDI_CHECK' | 
| 105 | 
  | 
  | 
      ENDIF | 
| 106 | 
  | 
  | 
#endif | 
| 107 | 
  | 
  | 
 | 
| 108 | 
  | 
  | 
#ifndef GM_BOLUS_ADVEC | 
| 109 | 
  | 
  | 
C     Make sure we are not trying to use some arrays that are unavailable | 
| 110 | 
  | 
  | 
      IF ( GM_AdvForm ) THEN | 
| 111 | 
  | 
  | 
       WRITE(msgBuf,'(A)') | 
| 112 | 
  | 
  | 
     &   ' GMREDI_CHECK: GM Advection form used in data.gmredi' | 
| 113 | 
  | 
  | 
       CALL PRINT_ERROR( msgBuf, myThid ) | 
| 114 | 
  | 
  | 
       WRITE(msgBuf,'(A)') | 
| 115 | 
  | 
  | 
     &   ' GMREDI_CHECK: without #define GM_BOLUS_ADVEC' | 
| 116 | 
  | 
  | 
       CALL PRINT_ERROR( msgBuf, myThid ) | 
| 117 | 
  | 
  | 
       STOP 'ABNORMAL END: S/R GMREDI_CHECK' | 
| 118 | 
  | 
  | 
      ENDIF | 
| 119 | 
  | 
  | 
#endif | 
| 120 | 
  | 
  | 
 | 
| 121 | 
  | 
  | 
#ifndef GM_EXTRA_DIAGONAL | 
| 122 | 
  | 
  | 
C     Make sure we are not trying to use some arrays that are unavailable | 
| 123 | 
  | 
  | 
      IF ( GM_ExtraDiag ) THEN | 
| 124 | 
  | 
  | 
       WRITE(msgBuf,'(A)') | 
| 125 | 
  | 
  | 
     &   ' GMREDI_CHECK: GM_skew_Flux_K & GM_isopycK not equal' | 
| 126 | 
  | 
  | 
       CALL PRINT_ERROR( msgBuf, myThid ) | 
| 127 | 
  | 
  | 
       WRITE(msgBuf,'(A)') | 
| 128 | 
  | 
  | 
     &   ' GMREDI_CHECK: without #define GM_EXTRA_DIAGONAL' | 
| 129 | 
  | 
  | 
       CALL PRINT_ERROR( msgBuf, myThid ) | 
| 130 | 
  | 
  | 
       STOP 'ABNORMAL END: S/R GMREDI_CHECK' | 
| 131 | 
  | 
  | 
      ENDIF | 
| 132 | 
  | 
  | 
#endif | 
| 133 | 
  | 
  | 
 | 
| 134 | 
dimitri | 
1.2 | 
#ifdef GM_SUBMESO | 
| 135 | 
  | 
  | 
      IF (GM_SM_Ce .gt. 0 _d 0) THEN | 
| 136 | 
  | 
  | 
C     Make sure we are not trying to use some arrays that are unavailable | 
| 137 | 
  | 
  | 
       IF ((.not.GM_ExtraDiag ).and.(.not.GM_AdvForm)) THEN | 
| 138 | 
  | 
  | 
        WRITE(msgBuf,'(A)') | 
| 139 | 
  | 
  | 
     &   ' GMREDI: GM_SUBMESO needs GM_EXTRA_DIAGONAL or GM_BOLUS_ADVEC' | 
| 140 | 
  | 
  | 
        CALL PRINT_ERROR( msgBuf, myThid ) | 
| 141 | 
  | 
  | 
        WRITE(msgBuf,'(A)') | 
| 142 | 
  | 
  | 
     &   ' GMREDI_CHECK: add #define GM_EXTRA_DIAGONAL' | 
| 143 | 
  | 
  | 
        CALL PRINT_ERROR( msgBuf, myThid ) | 
| 144 | 
  | 
  | 
        STOP 'ABNORMAL END: S/R GMREDI_CHECK' | 
| 145 | 
  | 
  | 
       ENDIF | 
| 146 | 
  | 
  | 
      ENDIF | 
| 147 | 
  | 
  | 
#endif | 
| 148 | 
  | 
  | 
 | 
| 149 | 
  | 
  | 
 | 
| 150 | 
dimitri | 
1.1 | 
#ifdef ALLOW_PTRACERS | 
| 151 | 
  | 
  | 
      IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate | 
| 152 | 
  | 
  | 
     &       .AND. usePTRACERS ) THEN | 
| 153 | 
  | 
  | 
        redFlag = .FALSE. | 
| 154 | 
  | 
  | 
        DO iTr=1,PTRACERS_numInUse | 
| 155 | 
  | 
  | 
         IF ( .NOT.PTRACERS_useGMRedi(iTr) ) THEN | 
| 156 | 
  | 
  | 
          redFlag = .TRUE. | 
| 157 | 
  | 
  | 
          WRITE(msgBuf,'(2A,I3,A,L5)') ' GMREDI_CHECK:', | 
| 158 | 
  | 
  | 
     &     ' pTracers_useGMRedi(',iTr,' )=', PTRACERS_useGMRedi(iTr) | 
| 159 | 
  | 
  | 
          CALL PRINT_ERROR( msgBuf, myThid ) | 
| 160 | 
  | 
  | 
         ENDIF | 
| 161 | 
  | 
  | 
        ENDDO | 
| 162 | 
  | 
  | 
        IF ( redFlag ) THEN | 
| 163 | 
  | 
  | 
          WRITE(msgBuf,'(2A)') ' GMREDI_CHECK:', | 
| 164 | 
  | 
  | 
     &     ' but GM Advective Form applies to all tracers !' | 
| 165 | 
  | 
  | 
          CALL PRINT_ERROR( msgBuf, myThid ) | 
| 166 | 
  | 
  | 
          STOP 'ABNORMAL END: S/R GMREDI_CHECK' | 
| 167 | 
  | 
  | 
        ENDIF | 
| 168 | 
  | 
  | 
      ENDIF | 
| 169 | 
  | 
  | 
#endif /* ALLOW_PTRACERS */ | 
| 170 | 
  | 
  | 
 | 
| 171 | 
  | 
  | 
#ifdef ALLOW_GENERIC_ADVDIFF | 
| 172 | 
  | 
  | 
C     Check size of overlap region | 
| 173 | 
  | 
  | 
      IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate | 
| 174 | 
  | 
  | 
     &       .AND. GM_Visbeck_alpha.NE.0. | 
| 175 | 
  | 
  | 
     &       .AND. useMultiDimAdvec | 
| 176 | 
  | 
  | 
     &       .AND. (Olx.LT.3 .OR. Oly.LT.3) ) THEN | 
| 177 | 
  | 
  | 
C       Visbeck variable K requires 1 more row/column in the overlap: | 
| 178 | 
  | 
  | 
C       might need to increase Olx,Oly from 2 to 3 if GM advective | 
| 179 | 
  | 
  | 
C       form & multi-dim advection are used. This happens when: | 
| 180 | 
  | 
  | 
C       a) using a 5 points stencil advection scheme ; or | 
| 181 | 
  | 
  | 
C       b) using a 3 points stencil advection scheme on CS-grid | 
| 182 | 
  | 
  | 
C note: not clear how to check (b) since none of the advection scheme | 
| 183 | 
  | 
  | 
C       currently implemented falls in this category, except if | 
| 184 | 
  | 
  | 
C       GAD_FLUX_LIMITER.h is changed to use a "constant" flux-limiter | 
| 185 | 
  | 
  | 
C       (from Lax-Wendroff to 1rst Order upwind). | 
| 186 | 
  | 
  | 
C------- | 
| 187 | 
  | 
  | 
c       IF ( (useCubedSphereExchange | 
| 188 | 
  | 
  | 
c    &       .AND.(    tempAdvScheme.EQ.ENUM_LAXWENDROFF | 
| 189 | 
  | 
  | 
c    &            .OR. saltAdvScheme.EQ.ENUM_LAXWENDROFF ) | 
| 190 | 
  | 
  | 
c    &       ).OR.(    tempAdvScheme.EQ.ENUM_FLUX_LIMIT | 
| 191 | 
  | 
  | 
c    &            .OR. saltAdvScheme.EQ.ENUM_FLUX_LIMIT | 
| 192 | 
  | 
  | 
c    &            .OR. tempAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT | 
| 193 | 
  | 
  | 
c    &            .OR. saltAdvScheme.EQ.ENUM_DST3_FLUX_LIMIT | 
| 194 | 
  | 
  | 
c    &            .OR. tempAdvScheme.EQ.ENUM_DST3 | 
| 195 | 
  | 
  | 
c    &            .OR. saltAdvScheme.EQ.ENUM_DST3 ) | 
| 196 | 
  | 
  | 
c    &     ) THEN | 
| 197 | 
  | 
  | 
          WRITE(msgBuf,'(A,A)') | 
| 198 | 
  | 
  | 
     &     'GMREDI_CHECK: Visbeck + GM_AdvForm in MultiDimAdvec' | 
| 199 | 
  | 
  | 
          CALL PRINT_ERROR( msgBuf , myThid ) | 
| 200 | 
  | 
  | 
          WRITE(msgBuf,'(A)') 'GMREDI_CHECK: need at least Olx,Oly = 3' | 
| 201 | 
  | 
  | 
          CALL PRINT_ERROR( msgBuf , myThid ) | 
| 202 | 
  | 
  | 
          STOP 'ABNORMAL END: S/R GMREDI_CHECK' | 
| 203 | 
  | 
  | 
c       ENDIF | 
| 204 | 
  | 
  | 
      ENDIF | 
| 205 | 
  | 
  | 
#endif /* ALLOW_GENERIC_ADVDIFF */ | 
| 206 | 
  | 
  | 
 | 
| 207 | 
  | 
  | 
      _END_MASTER(myThid) | 
| 208 | 
  | 
  | 
 | 
| 209 | 
  | 
  | 
#endif /* ALLOW_GMREDI */ | 
| 210 | 
  | 
  | 
      RETURN | 
| 211 | 
  | 
  | 
      END |