Back to home page

MITgcm
 
 

    

File indexing completed on 2022-08-15 05:09:21 UTC

view on githubraw file Latest commit cf705a6c on 2022-08-14 22:40:32 UTC
ac486aa51f Gael*0001 #include "ECCO_OPTIONS.h"
6b47d550f4 Mart*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
ac486aa51f Gael*0005 
f586fdfa8f Gael*0006 C--  File ecco_toolbox.F: Routines to handle basic operations common in ecco.
                0007 C--   Contents
11c3150c71 Mart*0008 C--   o ECCO_ZERO
                0009 C--   o ECCO_CP
                0010 C--   o ECCO_CPRSRL
                0011 C--   o ECCO_DIFFMSK
                0012 C--   o ECCO_ADDCOST
                0013 C--   o ECCO_ADD         (currently not used)
                0014 C--   o ECCO_SUBTRACT
                0015 C--   o ECCO_ADDMASK
                0016 C--   o ECCO_DIV
                0017 C--   o ECCO_DIVFIELD
                0018 C--   o ECCO_MULT
                0019 C--   o ECCO_MULTFIELD   (currently not used)
                0020 C--   o ECCO_MASKMINDEPTH
                0021 C--   o ECCO_OFFSET
                0022 C--   o ECCO_READBAR
                0023 C--   o ECCO_READWEI
                0024 C--   o ECCO_ERROR
f586fdfa8f Gael*0025 
ac486aa51f Gael*0026 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0027 CBOP
11c3150c71 Mart*0028 C     !ROUTINE: ECCO_ZERO
ac486aa51f Gael*0029 C     !INTERFACE:
11c3150c71 Mart*0030       SUBROUTINE ECCO_ZERO( fld, nzIn, zeroLoc, myThid )
ac486aa51f Gael*0031 C     !DESCRIPTION: \bv
11c3150c71 Mart*0032 C     fill a field with zeroLoc
ac486aa51f Gael*0033 C     \ev
                0034 
                0035 C     !USES:
                0036       IMPLICIT NONE
                0037 
11c3150c71 Mart*0038 C     == Global variables ==
ac486aa51f Gael*0039 #include "EEPARAMS.h"
                0040 #include "SIZE.h"
                0041 
11c3150c71 Mart*0042 C     !INPUT/OUTPUT PARAMETERS:
                0043       INTEGER nzIn
ac486aa51f Gael*0044       INTEGER myThid
11c3150c71 Mart*0045       _RL fld    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0046       _RL zeroLoc
ac486aa51f Gael*0047 
                0048 #ifdef ALLOW_ECCO
11c3150c71 Mart*0049 C     !LOCAL VARIABLES:
                0050       INTEGER bi,bj,i,j,k
f586fdfa8f Gael*0051 CEOP
ac486aa51f Gael*0052 
11c3150c71 Mart*0053       DO bj = myByLo(myThid),myByHi(myThid)
                0054        DO bi = myBxLo(myThid),myBxHi(myThid)
                0055         DO k = 1,nzIn
                0056          DO j = 1-OLy,sNy+OLy
                0057           DO i = 1-OLx,sNx+OLx
                0058            fld(i,j,k,bi,bj) = zeroLoc
                0059           ENDDO
                0060          ENDDO
                0061         ENDDO
                0062        ENDDO
                0063       ENDDO
ac486aa51f Gael*0064 
                0065 #endif /* ALLOW_ECCO */
                0066 
f586fdfa8f Gael*0067       RETURN
                0068       END
                0069 
                0070 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0071 CBOP
11c3150c71 Mart*0072 C     !ROUTINE: ECCO_DIFFMSK
f586fdfa8f Gael*0073 C     !INTERFACE:
11c3150c71 Mart*0074       SUBROUTINE ECCO_DIFFMSK(
                0075      I                   localBar, localObs, localMask,
                0076      I                   nzIn, nLev, spMinLoc, spMaxLoc, spzeroLoc,
                0077      O                   localDif, difMask,
                0078      I                   myThid )
f586fdfa8f Gael*0079 
                0080 C     !DESCRIPTION: \bv
                0081 C     compute masked difference between model and observations
                0082 C     \ev
                0083 
                0084 C     !USES:
                0085       IMPLICIT NONE
                0086 
11c3150c71 Mart*0087 C     == Global variables ==
f586fdfa8f Gael*0088 #include "EEPARAMS.h"
                0089 #include "SIZE.h"
                0090 
11c3150c71 Mart*0091 C     !INPUT PARAMETERS:
                0092       INTEGER nzIn, nLev
f586fdfa8f Gael*0093       INTEGER myThid
11c3150c71 Mart*0094       _RL localBar (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0095       _RL localObs (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0096       _RL localMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0097       _RL spMinLoc, spMaxLoc, spzeroLoc
                0098 C     !OUTPUT PARAMETERS:
                0099       _RL localDif (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0100       _RL difMask  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
f586fdfa8f Gael*0101 
                0102 #ifdef ALLOW_ECCO
11c3150c71 Mart*0103 C     !LOCAL VARIABLES:
                0104       INTEGER bi,bj,i,j,k
f586fdfa8f Gael*0105 CEOP
                0106 
11c3150c71 Mart*0107 c--   Determine the model-data difference mask
                0108       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_DIFFMSK',
                0109      &     'nLev > nzIn not allowed.', myThid )
                0110       DO bj = myByLo(myThid),myByHi(myThid)
                0111        DO bi = myBxLo(myThid),myBxHi(myThid)
                0112         DO k = 1,nLev
                0113          DO j = 1,sNy
                0114           DO i = 1,sNx
                0115            difMask(i,j,k,bi,bj) = localMask(i,j,k,bi,bj)
                0116            IF ( localObs(i,j,k,bi,bj) .LT. spMinLoc .OR.
                0117      &          localObs(i,j,k,bi,bj) .GT. spMaxLoc .OR.
                0118      &          localObs(i,j,k,bi,bj) .EQ. spzeroLoc ) THEN
                0119             difMask(i,j,k,bi,bj) = 0. _d 0
                0120            ENDIF
                0121            localDif(i,j,k,bi,bj) = difMask(i,j,k,bi,bj)*
                0122      &          (localBar(i,j,k,bi,bj)-localObs(i,j,k,bi,bj))
                0123           ENDDO
                0124          ENDDO
                0125         ENDDO
                0126        ENDDO
                0127       ENDDO
f586fdfa8f Gael*0128 
                0129 #endif /* ALLOW_ECCO */
ac486aa51f Gael*0130 
                0131       RETURN
                0132       END
                0133 
f586fdfa8f Gael*0134 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0135 CBOP
11c3150c71 Mart*0136 C     !ROUTINE: ECCO_CP
e073e2c5c9 Gael*0137 C     !INTERFACE:
11c3150c71 Mart*0138       SUBROUTINE ECCO_CP(
                0139      I                   fldIn,
                0140      U                   fldOut,
                0141      I                   nzIn, nlev, myThid )
e073e2c5c9 Gael*0142 
                0143 C     !DESCRIPTION: \bv
11c3150c71 Mart*0144 C     copy a field to another array
e073e2c5c9 Gael*0145 C     \ev
                0146 
                0147 C     !USES:
                0148       IMPLICIT NONE
                0149 
11c3150c71 Mart*0150 C     == Global variables ==
e073e2c5c9 Gael*0151 #include "EEPARAMS.h"
                0152 #include "SIZE.h"
                0153 
11c3150c71 Mart*0154 C     !INPUT/OUTPUT PARAMETERS:
                0155       INTEGER nzIn, nLev
e073e2c5c9 Gael*0156       INTEGER myThid
11c3150c71 Mart*0157       _RL fldIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0158       _RL fldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
e073e2c5c9 Gael*0159 
                0160 #ifdef ALLOW_ECCO
11c3150c71 Mart*0161 C     !LOCAL VARIABLES:
                0162       INTEGER bi,bj,i,j,k
e073e2c5c9 Gael*0163 CEOP
                0164 
11c3150c71 Mart*0165       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_CP',
                0166      &     'nLev > nzIn not allowed.', myThid )
                0167       DO bj = myByLo(myThid),myByHi(myThid)
                0168        DO bi = myBxLo(myThid),myBxHi(myThid)
                0169         DO k = 1,nLev
                0170          DO j = 1,sNy
                0171           DO i = 1,sNx
                0172            fldOut(i,j,k,bi,bj) = fldIn(i,j,k,bi,bj)
                0173           ENDDO
                0174          ENDDO
                0175         ENDDO
                0176        ENDDO
                0177       ENDDO
e073e2c5c9 Gael*0178 
                0179 #endif /* ALLOW_ECCO */
                0180 
                0181       RETURN
                0182       END
                0183 
                0184 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0185 CBOP
11c3150c71 Mart*0186 C     !ROUTINE: ECCO_CPRSRL
e073e2c5c9 Gael*0187 C     !INTERFACE:
11c3150c71 Mart*0188       SUBROUTINE ECCO_CPRSRL(
                0189      I                   fldIn,
                0190      U                   fldOut,
                0191      I                   nzIn, nlev, myThid )
e073e2c5c9 Gael*0192 
                0193 C     !DESCRIPTION: \bv
11c3150c71 Mart*0194 C     copy a field to another array, switching from _RS to _RL
e073e2c5c9 Gael*0195 C     \ev
                0196 
                0197 C     !USES:
                0198       IMPLICIT NONE
                0199 
11c3150c71 Mart*0200 C     == Global variables ==
e073e2c5c9 Gael*0201 #include "EEPARAMS.h"
                0202 #include "SIZE.h"
                0203 
11c3150c71 Mart*0204 C     !INPUT/OUTPUT PARAMETERS:
                0205       INTEGER nzIn, nLev
e073e2c5c9 Gael*0206       INTEGER myThid
11c3150c71 Mart*0207       _RS fldIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0208       _RL fldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
e073e2c5c9 Gael*0209 
                0210 #ifdef ALLOW_ECCO
11c3150c71 Mart*0211 C     !LOCAL VARIABLES:
                0212       INTEGER bi,bj,i,j,k
e073e2c5c9 Gael*0213 CEOP
                0214 
11c3150c71 Mart*0215       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_CPRSRL',
                0216      &     'nLev > nzIn not allowed.', myThid )
                0217       DO bj = myByLo(myThid),myByHi(myThid)
                0218        DO bi = myBxLo(myThid),myBxHi(myThid)
                0219         DO k = 1,nLev
                0220          DO j = 1,sNy
                0221           DO i = 1,sNx
                0222            fldOut(i,j,k,bi,bj) = fldIn(i,j,k,bi,bj)
                0223           ENDDO
                0224          ENDDO
                0225         ENDDO
                0226        ENDDO
                0227       ENDDO
e073e2c5c9 Gael*0228 
                0229 #endif /* ALLOW_ECCO */
                0230 
                0231       RETURN
                0232       END
                0233 
                0234 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0235 CBOP
11c3150c71 Mart*0236 C     !ROUTINE: ECCO_ADDCOST
f586fdfa8f Gael*0237 C     !INTERFACE:
11c3150c71 Mart*0238       SUBROUTINE ECCO_ADDCOST(
                0239      I     localDif, localWeight, difMask, nzIn, nLev, doSumSq,
                0240      U     objf_local, num_local,
                0241      I     myThid )
f586fdfa8f Gael*0242 
                0243 C     !DESCRIPTION: \bv
11c3150c71 Mart*0244 C     adds to a cost function term
f586fdfa8f Gael*0245 C     \ev
                0246 
                0247 C     !USES:
                0248       IMPLICIT NONE
                0249 
11c3150c71 Mart*0250 C     == Global variables ==
f586fdfa8f Gael*0251 #include "EEPARAMS.h"
                0252 #include "SIZE.h"
                0253 
11c3150c71 Mart*0254 C     !INPUT PARAMETERS:
                0255       INTEGER nzIn, nLev
                0256       LOGICAL doSumSq
f586fdfa8f Gael*0257       INTEGER myThid
11c3150c71 Mart*0258       _RL localDif   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0259       _RL localWeight(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0260       _RL difMask    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0261 C     !OUTPUT PARAMETERS:
                0262       _RL objf_local (nSx,nSy)
                0263       _RL num_local  (nSx,nSy)
f586fdfa8f Gael*0264 
                0265 #ifdef ALLOW_ECCO
11c3150c71 Mart*0266 C     !LOCAL VARIABLES:
                0267       INTEGER bi,bj,i,j,k
                0268       _RL localwww
                0269       _RL localcost
                0270       _RL junk
f586fdfa8f Gael*0271 CEOP
                0272 
11c3150c71 Mart*0273       localwww = 0. _d 0
                0274 
                0275       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_ADDCOST',
                0276      &     'nLev > nzIn not allowed.', myThid )
                0277 c--     Compute normalized model-obs cost function
                0278       DO bj = myByLo(myThid),myByHi(myThid)
                0279        DO bi = myBxLo(myThid),myBxHi(myThid)
                0280         localcost    = 0. _d 0
                0281         DO k = 1,nLev
                0282          DO j = 1,sNy
                0283           DO i = 1,sNx
                0284            localwww  = localWeight(i,j,k,bi,bj) * difMask(i,j,k,bi,bj)
                0285            junk      = localDif(i,j,k,bi,bj)
                0286            IF ( doSumSq ) THEN
                0287             localcost = localcost + junk*junk*localwww
                0288            ELSE
                0289             localcost = localcost + junk*localwww
                0290            ENDIF
                0291            IF ( localwww .NE. 0. )
                0292      &               num_local(bi,bj) = num_local(bi,bj) + 1. _d 0
                0293           ENDDO
                0294          ENDDO
                0295         ENDDO
                0296         objf_local(bi,bj) = objf_local(bi,bj) + localcost
                0297        ENDDO
                0298       ENDDO
f586fdfa8f Gael*0299 
                0300 #endif /* ALLOW_ECCO */
                0301 
                0302       RETURN
                0303       END
                0304 
679b3bfece Gael*0305 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0306 CBOP
11c3150c71 Mart*0307 C     !ROUTINE: ECCO_ADD
679b3bfece Gael*0308 C     !INTERFACE:
11c3150c71 Mart*0309       SUBROUTINE ECCO_ADD(
                0310      U                    fldOut,
                0311      I                    fldIn, nzIn, nLev, myThid )
679b3bfece Gael*0312 
                0313 C     !DESCRIPTION: \bv
11c3150c71 Mart*0314 C     add a field (fldIn) to another field (fldOut)
679b3bfece Gael*0315 C     \ev
                0316 
                0317 C     !USES:
                0318       IMPLICIT NONE
                0319 
11c3150c71 Mart*0320 C     == Global variables ==
679b3bfece Gael*0321 #include "EEPARAMS.h"
                0322 #include "SIZE.h"
                0323 
11c3150c71 Mart*0324 C     !INPUT/OUTPUT PARAMETERS:
                0325       INTEGER nzIn, nLev
679b3bfece Gael*0326       INTEGER myThid
11c3150c71 Mart*0327       _RL fldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0328       _RL fldIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
679b3bfece Gael*0329 
                0330 #ifdef ALLOW_ECCO
11c3150c71 Mart*0331 C     !LOCAL VARIABLES:
                0332       INTEGER bi,bj,i,j,k
679b3bfece Gael*0333 CEOP
                0334 
11c3150c71 Mart*0335       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_ADD',
                0336      &     'nLev > nzIn not allowed.', myThid )
                0337       DO bj = myByLo(myThid),myByHi(myThid)
                0338        DO bi = myBxLo(myThid),myBxHi(myThid)
                0339         DO k = 1,nLev
                0340          DO j = 1,sNy
                0341           DO i = 1,sNx
                0342            fldOut(i,j,k,bi,bj) = fldOut(i,j,k,bi,bj)
                0343      &                         + fldIn (i,j,k,bi,bj)
                0344           ENDDO
                0345          ENDDO
                0346         ENDDO
                0347        ENDDO
                0348       ENDDO
679b3bfece Gael*0349 
                0350 #endif /* ALLOW_ECCO */
                0351 
                0352       RETURN
                0353       END
f586fdfa8f Gael*0354 
                0355 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0356 CBOP
11c3150c71 Mart*0357 C     !ROUTINE: ECCO_SUBTRACT
f586fdfa8f Gael*0358 C     !INTERFACE:
11c3150c71 Mart*0359       SUBROUTINE ECCO_SUBTRACT(
                0360      U                         fldOut,
                0361      I                         fldIn, nzIn, nLev, myThid )
f586fdfa8f Gael*0362 
                0363 C     !DESCRIPTION: \bv
11c3150c71 Mart*0364 C     subtract a field (fldIn) from another field (fldOut)
f586fdfa8f Gael*0365 C     \ev
                0366 
                0367 C     !USES:
                0368       IMPLICIT NONE
                0369 
11c3150c71 Mart*0370 C     == Global variables ==
f586fdfa8f Gael*0371 #include "EEPARAMS.h"
                0372 #include "SIZE.h"
                0373 #include "PARAMS.h"
11c3150c71 Mart*0374 #ifdef ALLOW_ECCO
                0375 # include "ECCO_SIZE.h"
                0376 # include "ECCO.h"
                0377 #endif
f586fdfa8f Gael*0378 
11c3150c71 Mart*0379 C     !INPUT/OUTPUT PARAMETERS:
                0380       INTEGER nzIn, nLev
f586fdfa8f Gael*0381       INTEGER myThid
11c3150c71 Mart*0382       _RL fldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0383       _RL fldIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
13e29837cc An T*0384 
f586fdfa8f Gael*0385 #ifdef ALLOW_ECCO
11c3150c71 Mart*0386 C     !LOCAL VARIABLES:
                0387       INTEGER bi,bj,i,j,k
f586fdfa8f Gael*0388 CEOP
                0389 
11c3150c71 Mart*0390       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_SUBTRACT',
                0391      &     'nLev > nzIn not allowed.', myThid )
                0392       DO bj = myByLo(myThid),myByHi(myThid)
                0393        DO bi = myBxLo(myThid),myBxHi(myThid)
                0394         DO k = 1,nLev
                0395          DO j = 1,sNy
                0396           DO i = 1,sNx
                0397            fldOut(i,j,k,bi,bj) = fldOut(i,j,k,bi,bj)
                0398      &                         - fldIn (i,j,k,bi,bj)
                0399           ENDDO
                0400          ENDDO
                0401         ENDDO
                0402        ENDDO
                0403       ENDDO
f586fdfa8f Gael*0404 
                0405 #endif /* ALLOW_ECCO */
                0406 
                0407       RETURN
                0408       END
679b3bfece Gael*0409 
                0410 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0411 CBOP
11c3150c71 Mart*0412 C     !ROUTINE: ECCO_ADDMASK
679b3bfece Gael*0413 C     !INTERFACE:
11c3150c71 Mart*0414       SUBROUTINE ECCO_ADDMASK(
                0415      I                   fldIn, fldInmask,
                0416      U                   fldOut, fldOutnum,
                0417      I                   nzIn, nLev, myThid )
679b3bfece Gael*0418 
                0419 C     !DESCRIPTION: \bv
11c3150c71 Mart*0420 C     add a field to another array only grids where the mask is non-zero.
                0421 C     Also increase the counter by one one those girds.
679b3bfece Gael*0422 C     \ev
                0423 
                0424 C     !USES:
                0425       IMPLICIT NONE
                0426 
11c3150c71 Mart*0427 C     == Global variables ==
679b3bfece Gael*0428 #include "EEPARAMS.h"
                0429 #include "SIZE.h"
                0430 
11c3150c71 Mart*0431 C     !INPUT/OUTPUT PARAMETERS:
                0432       INTEGER nzIn, nLev
679b3bfece Gael*0433       INTEGER myThid
11c3150c71 Mart*0434       _RL fldIn     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0435       _RL fldInmask (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0436       _RL fldOut    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0437       _RL fldOutnum (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
679b3bfece Gael*0438 
                0439 #ifdef ALLOW_ECCO
11c3150c71 Mart*0440 C     !LOCAL VARIABLES:
                0441       INTEGER bi,bj,i,j,k
679b3bfece Gael*0442 CEOP
                0443 
11c3150c71 Mart*0444       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_ADDMASK',
                0445      &     'nLev > nzIn not allowed.', myThid )
                0446       DO bj = myByLo(myThid),myByHi(myThid)
                0447        DO bi = myBxLo(myThid),myBxHi(myThid)
                0448         DO k = 1,nLev
                0449          DO j = 1,sNy
                0450           DO i = 1,sNx
                0451            IF ( fldInmask(i,j,k,bi,bj) .NE. 0. _d 0 ) THEN
                0452             fldOut(i,j,k,bi,bj) = fldOut(i,j,k,bi,bj)
                0453      &                          + fldIn (i,j,k,bi,bj)
                0454             fldOutnum(i,j,k,bi,bj) = fldOutnum(i,j,k,bi,bj) + 1. _d 0
                0455            ENDIF
                0456           ENDDO
                0457          ENDDO
                0458         ENDDO
                0459        ENDDO
                0460       ENDDO
679b3bfece Gael*0461 
                0462 #endif /* ALLOW_ECCO */
                0463 
                0464       RETURN
                0465       END
                0466 
                0467 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0468 CBOP
11c3150c71 Mart*0469 C     !ROUTINE: ECCO_DIV
765ec9ffa2 Gael*0470 C     !INTERFACE:
11c3150c71 Mart*0471       SUBROUTINE ECCO_DIV(
                0472      U                    fld,
                0473      I                    numerLoc, nzIn, nLev, myThid )
765ec9ffa2 Gael*0474 C     !DESCRIPTION: \bv
11c3150c71 Mart*0475 C     divide a field with RL constant
765ec9ffa2 Gael*0476 C     \ev
                0477 
                0478 C     !USES:
                0479       IMPLICIT NONE
                0480 
11c3150c71 Mart*0481 C     == Global variables ==
765ec9ffa2 Gael*0482 #include "EEPARAMS.h"
                0483 #include "SIZE.h"
                0484 
11c3150c71 Mart*0485 C     !INPUT/OUTPUT PARAMETERS:
                0486       INTEGER nzIn, nLev
765ec9ffa2 Gael*0487       INTEGER myThid
11c3150c71 Mart*0488       _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0489       _RL numerLoc
765ec9ffa2 Gael*0490 
                0491 #ifdef ALLOW_ECCO
11c3150c71 Mart*0492 C     !LOCAL VARIABLES:
                0493       INTEGER bi,bj,i,j,k
                0494       _RL recip_num
765ec9ffa2 Gael*0495 CEOP
                0496 
11c3150c71 Mart*0497       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_DIV',
                0498      &     'nLev > nzIn not allowed.', myThid )
                0499       IF ( numerLoc .NE. 0. _d 0 ) THEN
                0500        recip_num = 1. _d 0 / numerLoc
                0501        DO bj = myByLo(myThid),myByHi(myThid)
                0502         DO bi = myBxLo(myThid),myBxHi(myThid)
                0503          DO k = 1,nLev
                0504           DO j = 1,sNy
                0505            DO i = 1,sNx
                0506             fld(i,j,k,bi,bj) = fld(i,j,k,bi,bj) * recip_num
                0507            ENDDO
                0508           ENDDO
                0509          ENDDO
                0510         ENDDO
                0511        ENDDO
                0512       ENDIF
765ec9ffa2 Gael*0513 
                0514 #endif /* ALLOW_ECCO */
                0515 
                0516       RETURN
                0517       END
                0518 
                0519 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0520 CBOP
11c3150c71 Mart*0521 C     !ROUTINE: ECCO_DIVFIELD
e073e2c5c9 Gael*0522 C     !INTERFACE:
11c3150c71 Mart*0523       SUBROUTINE ECCO_DIVFIELD( fld, fldDenom, nzIn, nLev, myThid )
e073e2c5c9 Gael*0524 C     !DESCRIPTION: \bv
11c3150c71 Mart*0525 C     divide a field by another field
e073e2c5c9 Gael*0526 C     \ev
                0527 
                0528 C     !USES:
                0529       IMPLICIT NONE
                0530 
11c3150c71 Mart*0531 C     == Global variables ==
e073e2c5c9 Gael*0532 #include "EEPARAMS.h"
                0533 #include "SIZE.h"
                0534 
11c3150c71 Mart*0535 C     !INPUT/OUTPUT PARAMETERS:
                0536       INTEGER nzIn, nLev
e073e2c5c9 Gael*0537       INTEGER myThid
11c3150c71 Mart*0538       _RL fld     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0539       _RL fldDenom(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
e073e2c5c9 Gael*0540 
                0541 #ifdef ALLOW_ECCO
11c3150c71 Mart*0542 C     !LOCAL VARIABLES:
                0543       INTEGER bi,bj,i,j,k
e073e2c5c9 Gael*0544 CEOP
                0545 
11c3150c71 Mart*0546       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_DIVFIELD',
                0547      &     'nLev > nzIn not allowed.', myThid )
                0548       DO bj = myByLo(myThid),myByHi(myThid)
                0549        DO bi = myBxLo(myThid),myBxHi(myThid)
                0550         DO k = 1,nLev
                0551          DO j = 1,sNy
                0552           DO i = 1,sNx
                0553            IF ( fldDenom(i,j,k,bi,bj) .NE. 0. _d 0 ) THEN
                0554             fld(i,j,k,bi,bj) = fld(i,j,k,bi,bj)/fldDenom(i,j,k,bi,bj)
                0555            ELSE
                0556             fld(i,j,k,bi,bj) = 0. _d 0
                0557            ENDIF
                0558           ENDDO
                0559          ENDDO
                0560         ENDDO
                0561        ENDDO
                0562       ENDDO
e073e2c5c9 Gael*0563 
                0564 #endif /* ALLOW_ECCO */
                0565 
                0566       RETURN
                0567       END
                0568 
                0569 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0570 CBOP
11c3150c71 Mart*0571 C     !ROUTINE: ECCO_MULT
679b3bfece Gael*0572 C     !INTERFACE:
11c3150c71 Mart*0573       SUBROUTINE ECCO_MULT(
                0574      U                     fld,
                0575      I                     multLoc, nzIn, nLev, myThid )
679b3bfece Gael*0576 C     !DESCRIPTION: \bv
11c3150c71 Mart*0577 C     multiply a field with RL constant
679b3bfece Gael*0578 C     \ev
                0579 
                0580 C     !USES:
                0581       IMPLICIT NONE
                0582 
11c3150c71 Mart*0583 C     == Global variables ==
679b3bfece Gael*0584 #include "EEPARAMS.h"
                0585 #include "SIZE.h"
                0586 
11c3150c71 Mart*0587 C     !INPUT/OUTPUT PARAMETERS:
                0588       INTEGER nzIn, nLev
679b3bfece Gael*0589       INTEGER myThid
11c3150c71 Mart*0590       _RL multLoc
                0591       _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
679b3bfece Gael*0592 
                0593 #ifdef ALLOW_ECCO
11c3150c71 Mart*0594 C     !LOCAL VARIABLES:
                0595       INTEGER bi,bj,i,j,k
679b3bfece Gael*0596 CEOP
                0597 
11c3150c71 Mart*0598       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR('ECCO_MULT',
                0599      &     'nLev > nzIn not allowed.', myThid)
                0600       DO bj = myByLo(myThid),myByHi(myThid)
                0601        DO bi = myBxLo(myThid),myBxHi(myThid)
                0602         DO k = 1,nLev
                0603          DO j = 1,sNy
                0604           DO i = 1,sNx
                0605            fld(i,j,k,bi,bj) = fld(i,j,k,bi,bj)*multLoc
                0606           ENDDO
                0607          ENDDO
                0608         ENDDO
                0609        ENDDO
                0610       ENDDO
679b3bfece Gael*0611 
                0612 #endif /* ALLOW_ECCO */
                0613 
                0614       RETURN
                0615       END
                0616 
                0617 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e073e2c5c9 Gael*0618 CBOP
11c3150c71 Mart*0619 C     !ROUTINE: ECCO_MULTFIELD
e073e2c5c9 Gael*0620 C     !INTERFACE:
11c3150c71 Mart*0621       SUBROUTINE ECCO_MULTFIELD(
                0622      U                          fldOut,
                0623      I                          fldIn, nzIn, nLev, myThid )
e073e2c5c9 Gael*0624 C     !DESCRIPTION: \bv
11c3150c71 Mart*0625 C     multiply a field by another field, fldOut is updated on output
e073e2c5c9 Gael*0626 C     \ev
                0627 
                0628 C     !USES:
                0629       IMPLICIT NONE
                0630 
11c3150c71 Mart*0631 C     == Global variables ==
e073e2c5c9 Gael*0632 #include "EEPARAMS.h"
                0633 #include "SIZE.h"
                0634 
11c3150c71 Mart*0635 C     !INPUT/OUTPUT PARAMETERS:
                0636       INTEGER nzIn, nLev
e073e2c5c9 Gael*0637       INTEGER myThid
11c3150c71 Mart*0638       _RL fldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0639       _RL fldIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
e073e2c5c9 Gael*0640 
                0641 #ifdef ALLOW_ECCO
11c3150c71 Mart*0642 C     !LOCAL VARIABLES:
                0643       INTEGER bi,bj,i,j,k
e073e2c5c9 Gael*0644 CEOP
                0645 
11c3150c71 Mart*0646       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_MULTFIELD',
                0647      &     'nLev > nzIn not allowed.', myThid )
                0648       DO bj = myByLo(myThid),myByHi(myThid)
                0649        DO bi = myBxLo(myThid),myBxHi(myThid)
                0650         DO k = 1,nLev
                0651          DO j = 1,sNy
                0652           DO i = 1,sNx
                0653            fldOut(i,j,k,bi,bj) = fldOut(i,j,k,bi,bj)*fldIn(i,j,k,bi,bj)
                0654           ENDDO
                0655          ENDDO
                0656         ENDDO
                0657        ENDDO
                0658       ENDDO
e073e2c5c9 Gael*0659 
                0660 #endif /* ALLOW_ECCO */
                0661 
                0662       RETURN
                0663       END
                0664 
                0665 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
9d58c52d64 An T*0666 CBOP
11c3150c71 Mart*0667 C     !ROUTINE: ECCO_MASKMINDEPTH
7da6a01a0d Gael*0668 C     !INTERFACE:
11c3150c71 Mart*0669       SUBROUTINE ECCO_MASKMINDEPTH(
                0670      U     difMask,
                0671      I     nzIn, nLev, topoMin, myThid )
7da6a01a0d Gael*0672 C     !DESCRIPTION: \bv
11c3150c71 Mart*0673 C     set difMask to zero where topography is shallower that topoMin
7da6a01a0d Gael*0674 C     \ev
                0675 
                0676 C     !USES:
                0677       IMPLICIT NONE
                0678 
11c3150c71 Mart*0679 C     == Global variables ==
7da6a01a0d Gael*0680 #include "EEPARAMS.h"
                0681 #include "SIZE.h"
11c3150c71 Mart*0682 #include "GRID.h"
7da6a01a0d Gael*0683 
11c3150c71 Mart*0684 C     !INPUT/OUTPUT PARAMETERS:
                0685       INTEGER nzIn, nLev
7da6a01a0d Gael*0686       INTEGER myThid
11c3150c71 Mart*0687       _RL difMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0688       _RL topoMin
7da6a01a0d Gael*0689 
                0690 #ifdef ALLOW_ECCO
11c3150c71 Mart*0691 C     !LOCAL VARIABLES:
                0692       INTEGER bi,bj,i,j,k
7da6a01a0d Gael*0693 CEOP
                0694 
11c3150c71 Mart*0695       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_MASMINDEPTH',
                0696      &     'nLev > nzIn not allowed.', myThid )
                0697       DO bj = myByLo(myThid),myByHi(myThid)
                0698        DO bi = myBxLo(myThid),myBxHi(myThid)
                0699          DO j = 1,sNy
                0700           DO i = 1,sNx
                0701            IF ( R_low(i,j,bi,bj) .GT. topoMin ) THEN
                0702             DO k = 1,nLev
                0703              difMask(i,j,k,bi,bj) = zeroRL
                0704             ENDDO
                0705            ENDIF
                0706          ENDDO
                0707         ENDDO
                0708        ENDDO
                0709       ENDDO
7da6a01a0d Gael*0710 
                0711 #endif /* ALLOW_ECCO */
                0712 
                0713       RETURN
                0714       END
                0715 
                0716 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0717 CBOP
11c3150c71 Mart*0718 C     !ROUTINE: ECCO_OFFSET
9d58c52d64 An T*0719 C     !INTERFACE:
11c3150c71 Mart*0720       SUBROUTINE ECCO_OFFSET(
                0721      I                   fName,
                0722      U                   fld,
                0723      I                   difMask, nzIn, nLev,
                0724      I                   myThid )
                0725 
9d58c52d64 An T*0726 C     !DESCRIPTION: \bv
11c3150c71 Mart*0727 C     remove mean of masked field
9d58c52d64 An T*0728 C     \ev
                0729 
                0730 C     !USES:
                0731       IMPLICIT NONE
                0732 
11c3150c71 Mart*0733 C     == Global variables ==
9d58c52d64 An T*0734 #include "EEPARAMS.h"
                0735 #include "SIZE.h"
                0736 
11c3150c71 Mart*0737 C     !INPUT/OUTPUT PARAMETERS:
9d58c52d64 An T*0738       INTEGER myThid
11c3150c71 Mart*0739       INTEGER nzIn, nLev
                0740       CHARACTER*(*) fName
                0741       _RL fld    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0742       _RL difMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
9d58c52d64 An T*0743 
                0744 #ifdef ALLOW_ECCO
11c3150c71 Mart*0745 C     !LOCAL VARIABLES:
                0746       INTEGER bi,bj,i,j,k
                0747       _RL volTile(nSx,nSy), sumTile(nSx,nSy)
                0748       _RL tmpVol, volGlob, sumGlob
                0749       _RL theMean
                0750       CHARACTER*(MAX_LEN_MBUF) msgBuf
9d58c52d64 An T*0751 CEOP
                0752 
11c3150c71 Mart*0753       IF ( nLev .GT. nzIn ) CALL ECCO_ERROR( 'ECCO_OFFSET',
                0754      &     'nLev > nzIn not allowed.', myThid )
                0755 c--   Compute the mean
                0756       DO bj = myByLo(myThid),myByHi(myThid)
                0757        DO bi = myBxLo(myThid),myBxHi(myThid)
                0758         volTile(bi,bj) = 0. _d 0
                0759         sumTile(bi,bj) = 0. _d 0
                0760         DO k = 1,nLev
                0761          DO j = 1,sNy
                0762           DO i = 1,sNx
                0763            tmpVol = difMask(i,j,k,bi,bj)
                0764            volTile(bi,bj) = volTile(bi,bj) + tmpVol
                0765            sumTile(bi,bj) = sumTile(bi,bj) + tmpVol*fld(i,j,k,bi,bj)
                0766           ENDDO
                0767          ENDDO
                0768         ENDDO
                0769        ENDDO
                0770       ENDDO
                0771 
                0772       CALL GLOBAL_SUM_TILE_RL( volTile, volGlob, myThid )
                0773       CALL GLOBAL_SUM_TILE_RL( sumTile, sumGlob, myThid )
                0774 
                0775       IF ( volGlob.GT.zeroRL ) THEN
                0776        theMean = sumGlob/volGlob
                0777        DO bj = myByLo(myThid),myByHi(myThid)
                0778         DO bi = myBxLo(myThid),myBxHi(myThid)
                0779          DO k = 1,nLev
                0780           DO j = 1,sNy
                0781            DO i = 1,sNx
                0782             IF (difMask(i,j,k,bi,bj) .NE. 0. _d 0) THEN
                0783              fld(i,j,k,bi,bj) = fld(i,j,k,bi,bj) - theMean
                0784             ENDIF
                0785            ENDDO
                0786           ENDDO
                0787          ENDDO
                0788         ENDDO
                0789        ENDDO
                0790       ELSE
                0791        theMean = 0. _d 0
                0792       ENDIF
                0793 
                0794 C     Print the global mean to standard output
                0795       _BEGIN_MASTER( myThid )
                0796       WRITE(msgBuf,'(3A,1PE21.14)')
                0797      &      'ecco_offset: # of nonzero constributions to mean of ',
                0798      &      fname, ' = ', volGlob
                0799       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0800      &      SQUEEZE_RIGHT, myThid )
                0801       WRITE(msgBuf,'(3A,1PE21.14)')
                0802      &      'ecco_offset:                         Global mean of ',
                0803      &      fname, ' = ', theMean
                0804       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0805      &      SQUEEZE_RIGHT, myThid )
                0806       _END_MASTER( myThid )
9d58c52d64 An T*0807 
                0808 #endif /* ALLOW_ECCO */
                0809 
                0810       RETURN
                0811       END
11c3150c71 Mart*0812 
9d58c52d64 An T*0813 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
679b3bfece Gael*0814 CBOP
11c3150c71 Mart*0815 C     !ROUTINE: ECCO_READBAR
679b3bfece Gael*0816 C     !INTERFACE:
11c3150c71 Mart*0817       SUBROUTINE ECCO_READBAR(
679b3bfece Gael*0818      I                           active_var_file,
                0819      O                           active_var,
11c3150c71 Mart*0820      I                           iRec, nzIn, nLev,
679b3bfece Gael*0821      I                           dummy,
11c3150c71 Mart*0822      I                           myThid )
679b3bfece Gael*0823 
                0824 C     !DESCRIPTION: \bv
                0825 C     reads one record from averaged time series ("bar file")
                0826 C     \ev
                0827 
                0828 C     !USES:
                0829       IMPLICIT NONE
                0830 
11c3150c71 Mart*0831 C     == Global variables ==
679b3bfece Gael*0832 #include "EEPARAMS.h"
                0833 #include "SIZE.h"
                0834 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0835 # include "ECCO_SIZE.h"
                0836 # include "ECCO.h"
679b3bfece Gael*0837 #endif
                0838 
11c3150c71 Mart*0839 C     !INPUT/OUTPUT PARAMETERS:
                0840 C     active_var_file :: filename
                0841 C     active_var      :: array
                0842 C     iRec            :: record number
                0843 C     nzIn            :: size of active_var
                0844 C     nLev            :: number vertical levels used
679b3bfece Gael*0845       CHARACTER*(*) active_var_file
11c3150c71 Mart*0846       INTEGER iRec, nzIn, nLev
679b3bfece Gael*0847       INTEGER myThid
11c3150c71 Mart*0848       _RL     active_var(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
679b3bfece Gael*0849       _RL     dummy
                0850 
                0851 #ifdef ALLOW_ECCO
11c3150c71 Mart*0852 C     !LOCAL VARIABLES:
                0853       LOGICAL doGlobalRead
679b3bfece Gael*0854       LOGICAL lAdInit
11c3150c71 Mart*0855       INTEGER i,j,bi,bj
                0856       _RL     tmpFld2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0857       CHARACTER*(MAX_LEN_MBUF) msgBuf
679b3bfece Gael*0858 CEOP
                0859 
11c3150c71 Mart*0860       doGlobalRead = .FALSE.
                0861       lAdInit      = .FALSE.
679b3bfece Gael*0862 
101f75e5cd Gael*0863 #ifdef ALLOW_AUTODIFF
11c3150c71 Mart*0864       IF ( nLev .EQ. 1 ) THEN
                0865        CALL ACTIVE_READ_XY( active_var_file, tmpFld2D,
                0866      &                      iRec, doGlobalRead,
                0867      &                      lAdInit, eccoiter, myThid,
679b3bfece Gael*0868      &                      dummy )
11c3150c71 Mart*0869       ELSEIF ( nLev .EQ. Nr .AND. nzIn .EQ. Nr ) THEN
                0870        CALL ACTIVE_READ_XYZ( active_var_file, active_var,
                0871      &                       iRec, doGlobalRead,
                0872      &                       lAdInit, eccoiter, myThid,
679b3bfece Gael*0873      &                       dummy )
11c3150c71 Mart*0874       ELSE
                0875        WRITE(msgBuf,'(A,I3,A)') 'nLev = ',nLev,' should not happen'
                0876        CALL ECCO_ERROR( 'ECCO_READBAR', msgBuf, myThid )
                0877       ENDIF
101f75e5cd Gael*0878 #else
11c3150c71 Mart*0879       IF ( nLev .EQ. 1 ) THEN
                0880        CALL READ_REC_XY_RL( active_var_file, tmpFld2D,
                0881      &                      iRec, 1, myThid )
                0882       ELSEIF ( nLev .EQ. Nr .AND. nzIn .EQ. Nr ) THEN
                0883        CALL READ_REC_XYZ_RL( active_var_file, active_var,
                0884      &                       iRec, 1, myThid )
                0885       ELSE
                0886        WRITE(msgBuf,'(A,I3,A)') 'nLev = ',nLev,' should not happen'
                0887        CALL ECCO_ERROR( 'ECCO_READBAR', msgBuf, myThid )
                0888       ENDIF
101f75e5cd Gael*0889 #endif
679b3bfece Gael*0890 
11c3150c71 Mart*0891       IF ( nLev .EQ. 1 ) THEN
                0892        DO bj = myByLo(myThid),myByHi(myThid)
                0893         DO bi = myBxLo(myThid),myBxHi(myThid)
                0894          DO j = 1,sNy
                0895           DO i = 1,sNx
                0896            active_var(i,j,1,bi,bj) = tmpFld2D(i,j,bi,bj)
                0897           ENDDO
                0898          ENDDO
                0899         ENDDO
                0900        ENDDO
                0901       ENDIF
                0902 
679b3bfece Gael*0903 #endif /* ALLOW_ECCO */
                0904 
                0905       RETURN
                0906       END
                0907 
3487aaa745 Gael*0908 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0909 CBOP
11c3150c71 Mart*0910 C     !ROUTINE: ECCO_READWEI
3487aaa745 Gael*0911 C     !INTERFACE:
11c3150c71 Mart*0912       SUBROUTINE ECCO_READWEI(
                0913      I                         localErr_file,
                0914      O                         localWeight,
                0915      I                         iRec, nzIn, nLev,
                0916      I                         doSumSq,
                0917      I                         myThid )
3487aaa745 Gael*0918 
                0919 C     !DESCRIPTION: \bv
                0920 C     reads uncertainty field and compute weight as squared inverse
                0921 C     \ev
                0922 
                0923 C     !USES:
                0924       IMPLICIT NONE
                0925 
11c3150c71 Mart*0926 C     == Global variables ==
3487aaa745 Gael*0927 #include "EEPARAMS.h"
                0928 #include "SIZE.h"
                0929 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0930 # include "ECCO_SIZE.h"
                0931 # include "ECCO.h"
3487aaa745 Gael*0932 #endif
                0933 
11c3150c71 Mart*0934 C     !INPUT/OUTPUT PARAMETERS:
                0935 C     localErr_file :: filename
                0936 C     localWeight   :: array
                0937 C     iRec          :: record number
                0938       CHARACTER*(*) localErr_file
                0939       INTEGER iRec, nzIn, nLev
                0940       LOGICAL doSumSq
3487aaa745 Gael*0941       INTEGER myThid
11c3150c71 Mart*0942       _RL     localWeight(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
3487aaa745 Gael*0943 
                0944 #ifdef ALLOW_ECCO
11c3150c71 Mart*0945 C     !LOCAL VARIABLES:
                0946       INTEGER bi,bj
                0947       INTEGER i,j,k
3487aaa745 Gael*0948 CEOP
                0949 
11c3150c71 Mart*0950       CALL READ_REC_LEV_RL( localErr_file, cost_iprec, nzIn, 1, nLev,
                0951      &                      localWeight, iRec, 1, myThid )
3487aaa745 Gael*0952 
                0953       DO bj=myByLo(myThid),myByHi(myThid)
                0954        DO bi=myBxLo(myThid),myBxHi(myThid)
11c3150c71 Mart*0955         DO k = 1,nLev
                0956          DO j = 1,sNy
                0957           DO i = 1,sNx
3487aaa745 Gael*0958 c--        Test for missing values.
11c3150c71 Mart*0959            IF (localWeight(i,j,k,bi,bj) .LT. -9900.) THEN
                0960              localWeight(i,j,k,bi,bj) = 0. _d 0
3487aaa745 Gael*0961 c--        Convert to weight
11c3150c71 Mart*0962            ELSEIF ( localWeight(i,j,k,bi,bj).NE.0. .AND. doSumSq ) THEN
                0963               localWeight(i,j,k,bi,bj) =
                0964      &          oneRL/localWeight(i,j,k,bi,bj)/localWeight(i,j,k,bi,bj)
                0965            ELSEIF ( localWeight(i,j,k,bi,bj).NE.0. ) THEN
                0966               localWeight(i,j,k,bi,bj) =
                0967      &           oneRL/localWeight(i,j,k,bi,bj)
                0968            ENDIF
                0969           ENDDO
                0970          ENDDO
                0971         ENDDO
                0972        ENDDO
                0973       ENDDO
                0974 
                0975 #endif /* ALLOW_ECCO */
                0976 
                0977       RETURN
                0978       END
                0979 
                0980 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0981 CBOP
                0982 C     !ROUTINE: ECCO_ERROR
                0983 C     !INTERFACE:
                0984       SUBROUTINE ECCO_ERROR( srName, errMsg, myThid )
                0985 C     !DESCRIPTION: \bv
                0986 C     prints error messages and stops
                0987 C     \ev
                0988 
                0989 C     !USES:
                0990       IMPLICIT NONE
                0991 
                0992 C     == Global variables ==
                0993 #include "SIZE.h"
                0994 #include "EEPARAMS.h"
                0995 
                0996 C     !INPUT/OUTPUT PARAMETERS:
                0997 C     srName :: name of caller
                0998 C     errMsg :: error message to be printed
                0999       CHARACTER*(*) srName, errMsg
                1000       INTEGER myThid
                1001 
                1002 #ifdef ALLOW_ECCO
                1003 C     !LOCAL VARIABLES:
                1004       CHARACTER*(MAX_LEN_MBUF) msgBuf
                1005 CEOP
                1006 
                1007       WRITE(msgBuf,'(A,A,A)') srName, ': ', errMsg
                1008       CALL PRINT_ERROR( msgBuf, myThid )
                1009       CALL ALL_PROC_DIE( myThid )
                1010       STOP 'ABNORMAL END: S/R ECCO_ERROR'
3487aaa745 Gael*1011 
                1012 #endif /* ALLOW_ECCO */
                1013 
                1014       RETURN
                1015       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!