pkg/exf/exf_check_range.F

793277f3cc Patr*0001 #include "EXF_OPTIONS.h"
                0002
a69c3cf465 Jean*0003       SUBROUTINE EXF_CHECK_RANGE( myTime, myIter, myThid )
793277f3cc Patr*0004
a69c3cf465 Jean*0005 C     ==================================================================
                0006 C     SUBROUTINE EXF_CHECK_RANGE
                0007 C     ==================================================================
793277f3cc Patr*0008
a69c3cf465 Jean*0009       IMPLICIT NONE
793277f3cc Patr*0010
a69c3cf465 Jean*0011 C     == global variables ==
793277f3cc Patr*0012 #include "EEPARAMS.h"
                0013 #include "SIZE.h"
0320e25227 Mart*0014 #include "PARAMS.h"
793277f3cc Patr*0015 #include "GRID.h"
                0016
082e18c36c Jean*0017 #include "EXF_PARAM.h"
a69c3cf465 Jean*0018 c#include "EXF_CONSTANTS.h"
082e18c36c Jean*0019 #include "EXF_FIELDS.h"
793277f3cc Patr*0020
a69c3cf465 Jean*0021 C     == routine arguments ==
                0022 C     myThid - thread number for this instance of the routine.
                0023       _RL myTime
                0024       INTEGER myIter, myThid
793277f3cc Patr*0025
a69c3cf465 Jean*0026 C     == local variables ==
0320e25227 Mart*0027       INTEGER i, j, ks, bi, bj
a69c3cf465 Jean*0028       INTEGER exferr
793277f3cc Patr*0029
a69c3cf465 Jean*0030 C     == end of interface ==
793277f3cc Patr*0031
9b42fddb2a Patr*0032       exferr = 0
                0033
72e614f603 Jean*0034 C--   Only master thread can safely write directly to standard output:
                0035       _BARRIER
                0036       _BEGIN_MASTER( myThid )
a69c3cf465 Jean*0037
0320e25227 Mart*0038       ks = 1
                0039       IF ( usingPCoords ) ks = Nr
a69c3cf465 Jean*0040 c     DO bj = myByLo(myThid), myByHi(myThid)
                0041 c      DO bi = myBxLo(myThid), myBxHi(myThid)
                0042       DO bj = 1, nSy
                0043        DO bi = 1, nSx
1e27e6f431 Dimi*0044
                0045 C Change checking range because some atmospheric fields will
                0046 C not always have valid values in the tile edges.
a69c3cf465 Jean*0047 c       DO j = 1-OLy, sNy+OLy
                0048 c        DO i = 1-OLx, sNx+OLx
                0049         DO j = 1, sNy
                0050          DO i = 1, sNx
                0051
                0052 C     Heat flux.
                0053           IF ( ( hflux(i,j,bi,bj) .GT. 1600. .OR.
02be45b849 Mart*0054      &         hflux(i,j,bi,bj) .LT. -500. ) .AND.
0320e25227 Mart*0055      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0056            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0057      &          'EXF WARNING: hflux out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0058      &          bi, bj, i, j, myIter, hflux(i,j,bi,bj)
02be45b849 Mart*0059            exferr = 1
a69c3cf465 Jean*0060           ENDIF
                0061
                0062 C     Freshwater flux.
                0063           IF ( ABS(sflux(i,j,bi,bj)) .GT. 1.E-6 .AND.
0320e25227 Mart*0064      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0065            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0066      &          'EXF WARNING: sflux out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0067      &          bi, bj, i, j, myIter, sflux(i,j,bi,bj)
02be45b849 Mart*0068            exferr = 1
a69c3cf465 Jean*0069           ENDIF
                0070
                0071 C     Zonal wind stress.
                0072           IF ( ABS(ustress(i,j,bi,bj)) .GT. 2.7 .AND.
0320e25227 Mart*0073      &         maskW(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0074            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0075      &          'EXF WARNING: ustress out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0076      &          bi, bj, i, j, myIter, ustress(i,j,bi,bj)
02be45b849 Mart*0077            exferr = 1
a69c3cf465 Jean*0078           ENDIF
                0079
                0080 C     Meridional wind stress.
                0081           IF ( ABS(vstress(i,j,bi,bj)) .GT. 2.3 .AND.
0320e25227 Mart*0082      &         maskS(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0083            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0084      &          'EXF WARNING: vstress out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0085      &          bi, bj, i, j, myIter, vstress(i,j,bi,bj)
02be45b849 Mart*0086            exferr = 1
a69c3cf465 Jean*0087           ENDIF
                0088
                0089           IF ( useAtmWind ) THEN
                0090 C     zonal wind speed
                0091            IF ( ABS(uwind(i,j,bi,bj)) .GT. 100. .AND.
0320e25227 Mart*0092      &         maskW(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0093             WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0094      &          'EXF WARNING: uwind out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0095      &          bi, bj, i, j, myIter, uwind(i,j,bi,bj)
                0096             exferr = 1
                0097            ENDIF
                0098
                0099 C     zonal wind speed
                0100            IF ( ABS(vwind(i,j,bi,bj)) .GT. 100. .AND.
0320e25227 Mart*0101      &         maskS(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0102             WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0103      &          'EXF WARNING: vwind out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0104      &          bi, bj, i, j, myIter, vwind(i,j,bi,bj)
                0105             exferr = 1
                0106            ENDIF
                0107           ENDIF
                0108
                0109 C     wind speed modulus
                0110           IF ( ( wspeed(i,j,bi,bj) .LT. 0. .OR.
02be45b849 Mart*0111      &         wspeed(i,j,bi,bj) .GT. 100. ) .AND.
0320e25227 Mart*0112      &         maskS(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0113            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0114      &          'EXF WARNING: wspeed out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0115      &          bi, bj, i, j, myIter, wspeed(i,j,bi,bj)
02be45b849 Mart*0116            exferr = 1
a69c3cf465 Jean*0117           ENDIF
                0118
793277f3cc Patr*0119 #ifdef ALLOW_ATM_TEMP
a69c3cf465 Jean*0120 C     2-m air temperature
                0121           IF ( (atemp(i,j,bi,bj) .LT. 183 .OR.
02be45b849 Mart*0122      &         atemp(i,j,bi,bj) .GT. 343 ) .AND.
0320e25227 Mart*0123      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0124            WRITE(standardMessageUnit,'(2A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0125      &          'EXF WARNING: atemp + exf_offset_atemp ',
                0126      &          'out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0127      &          bi, bj, i, j, myIter, atemp(i,j,bi,bj)
02be45b849 Mart*0128            exferr = 1
a69c3cf465 Jean*0129           ENDIF
                0130
                0131 C     2-m specific humidity
                0132           IF ( (aqh(i,j,bi,bj) .LT. 0. .OR.
02be45b849 Mart*0133      &         aqh(i,j,bi,bj) .GT. 0.1 ) .AND.
0320e25227 Mart*0134      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0135            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0136      &          'EXF WARNING: aqh out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0137      &          bi, bj, i, j, myIter, aqh(i,j,bi,bj)
02be45b849 Mart*0138            exferr = 1
a69c3cf465 Jean*0139           ENDIF
                0140
                0141 C     precipitation rate
                0142           IF ( (precip(i,j,bi,bj) .LT. 0. .OR.
02be45b849 Mart*0143      &         precip(i,j,bi,bj) .GT. 2.E-6 ) .AND.
0320e25227 Mart*0144      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0145            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0146      &          'EXF WARNING: precip out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0147      &          bi, bj, i, j, myIter, precip(i,j,bi,bj)
02be45b849 Mart*0148            exferr = 1
a69c3cf465 Jean*0149           ENDIF
                0150
                0151 C     snow
                0152           IF ( (snowprecip(i,j,bi,bj) .LT. 0. .OR.
02be45b849 Mart*0153      &         snowprecip(i,j,bi,bj) .GT. 2.E-6 ) .AND.
0320e25227 Mart*0154      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0155            WRITE(standardMessageUnit,'(2A,5(1X,I6),2X,D22.15)')
                0156      &          'EXF WARNING: snowprecip out of range ',
02be45b849 Mart*0157      &          'for bi,bj,i,j,it= ',
a69c3cf465 Jean*0158      &          bi, bj, i, j, myIter, snowprecip(i,j,bi,bj)
02be45b849 Mart*0159            exferr = 1
a69c3cf465 Jean*0160           ENDIF
793277f3cc Patr*0161 #endif
                0162
                0163 #ifdef SHORTWAVE_HEATING
a69c3cf465 Jean*0164 C     Short wave radiative flux.
                0165           IF ( (swflux(i,j,bi,bj) .GT. 1. .OR.
02be45b849 Mart*0166      &         swflux(i,j,bi,bj) .LT. -1000. ) .AND.
0320e25227 Mart*0167      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0168            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0169      &          'EXF WARNING: swflux out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0170      &          bi, bj, i, j, myIter, swflux(i,j,bi,bj)
02be45b849 Mart*0171            exferr = 1
a69c3cf465 Jean*0172           ENDIF
793277f3cc Patr*0173 #endif
                0174
9b42fddb2a Patr*0175 #ifdef ALLOW_RUNOFF
a69c3cf465 Jean*0176 C     Runoff.
                0177           IF ( (runoff(i,j,bi,bj) .LT. 0. .OR.
02be45b849 Mart*0178      &         runoff(i,j,bi,bj) .GT. 1.E-6 ) .AND.
0320e25227 Mart*0179      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0180            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
02be45b849 Mart*0181      &          'EXF WARNING: runoff out of range for bi,bj,i,j,it= ',
a69c3cf465 Jean*0182      &          bi, bj, i, j, myIter, runoff(i,j,bi,bj)
                0183            WRITE(standardMessageUnit,'(A)')
02be45b849 Mart*0184      &          'Please note that input units for runoff are'
a69c3cf465 Jean*0185            WRITE(standardMessageUnit,'(A)')
02be45b849 Mart*0186      &          'm/s not m/yr.  If input file is in m/yr, set'
a69c3cf465 Jean*0187            WRITE(standardMessageUnit,'(A)')
02be45b849 Mart*0188      &          'exf_inscal_runoff=3.170979198E-8'
a69c3cf465 Jean*0189            WRITE(standardMessageUnit,'(A)')
02be45b849 Mart*0190      &          'in the data.exf input file.'
                0191            exferr = 1
a69c3cf465 Jean*0192           ENDIF
e603dbf008 Dimi*0193 # ifdef ALLOW_RUNOFTEMP
a69c3cf465 Jean*0194 C     Runoff temperature.
                0195           IF ( (runoftemp(i,j,bi,bj) .LT. -2. .OR.
e603dbf008 Dimi*0196      &         runoff(i,j,bi,bj) .GT. 36 ) .AND.
0320e25227 Mart*0197      &         maskC(i,j,ks,bi,bj) .NE. 0. ) THEN
a69c3cf465 Jean*0198            WRITE(standardMessageUnit,'(A,5(1X,I6),2X,D22.15)')
e603dbf008 Dimi*0199      &          'EXF WARNING: runoftemp out of range at bi,bj,i,j,it= ',
a69c3cf465 Jean*0200      &          bi, bj, i, j, myIter, runoff(i,j,bi,bj)
e603dbf008 Dimi*0201            exferr = 1
a69c3cf465 Jean*0202           ENDIF
e603dbf008 Dimi*0203 # endif /* ALLOW_RUNOFTEMP */
                0204 #endif /* ALLOW_RUNOFF */
a69c3cf465 Jean*0205          ENDDO
                0206         ENDDO
                0207
                0208        ENDDO
                0209       ENDDO
                0210
                0211       IF ( exferr .NE. 0 ) THEN
                0212        WRITE(standardMessageUnit,'(A)')
02be45b849 Mart*0213      &      'EXF WARNING: If you think these values are OK '
a69c3cf465 Jean*0214        WRITE(standardMessageUnit,'(A)')
02be45b849 Mart*0215      &      'EXF WARNING: then set useExfCheckRange=.FALSE.'
72e614f603 Jean*0216        STOP 'ABNORMAL END: S/R EXF_CHECK_RANGE'
a69c3cf465 Jean*0217       ENDIF
72e614f603 Jean*0218       _END_MASTER( myThid )
0320e25227 Mart*0219       _BARRIER
02be45b849 Mart*0220
72e614f603 Jean*0221       RETURN
                0222       END