pkg/cost/cost_depth.F

5ed655852f Jean*0001 #include "COST_OPTIONS.h"
11c3150c71 Mart*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
05b6d6742b Patr*0005
7c50f07931 Mart*0006 CBOP
                0007 C     !ROUTINE: COST_DEPTH
                0008 C     !INTERFACE:
                0009       SUBROUTINE COST_DEPTH( myThid )
                0010
                0011 C     !DESCRIPTION: \bv
05b6d6742b Patr*0012 C     /==========================================================\
7c50f07931 Mart*0013 C     | SUBROUTINE COST_DEPTH                                    |
05b6d6742b Patr*0014 C     | o this routine computes the cost function for the tiles  |
                0015 C     |   of this processor                                      |
                0016 C     |==========================================================|
                0017 C     |                                                          |
                0018 C     | Notes                                                    |
                0019 C     | =====                                                    |
                0020 C     \==========================================================/
7c50f07931 Mart*0021 C     \ev
                0022
                0023 C     !USES:
05b6d6742b Patr*0024       IMPLICIT NONE
                0025
                0026 C     == Global variables ===
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "GRID.h"
                0030 #include "cost.h"
11c3150c71 Mart*0031 #ifdef ALLOW_GENARR2D_CONTROL
                0032 # include "CTRL_SIZE.h"
                0033 # include "CTRL_GENARR.h"
                0034 #endif
05b6d6742b Patr*0035
7c50f07931 Mart*0036 C     !INPUT/OUTPUT PARAMETERS:
05b6d6742b Patr*0037 C     == Routine arguments ==
                0038 C     myThid - Thread number for this instance of the routine.
7c50f07931 Mart*0039       INTEGER myThid
05b6d6742b Patr*0040
                0041 #ifdef ALLOW_COST_DEPTH
7c50f07931 Mart*0042 C     !LOCAL VARIABLES:
                0043 C     == Local variables ==
                0044       INTEGER bi,bj,i,j
11c3150c71 Mart*0045 #ifdef ALLOW_GENARR2D_CONTROL
                0046       INTEGER iarr
                0047       INTEGER igen
                0048       _RL xx_depth(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0049 #else
                0050       _RL dr_low
                0051 #endif
7c50f07931 Mart*0052 CEOP
05b6d6742b Patr*0053
11c3150c71 Mart*0054 #ifdef ALLOW_GENARR2D_CONTROL
                0055       DO bj=myByLo(mythid),myByHi(mythid)
                0056        DO bi=myBxLo(mythid),myBxHi(mythid)
                0057         DO j = 1-OLy,sNy+OLy
                0058          DO i = 1-OLx,sNx+OLx
                0059           xx_depth(i,j,bi,bj) = 0. _d 0
                0060          ENDDO
                0061         ENDDO
                0062        ENDDO
                0063       ENDDO
                0064 C--   use generic 2D control variable infrastructure to set xx_depth
                0065       igen = 0
                0066       DO iarr = 1, maxCtrlArr2D
                0067        IF ( xx_genarr2d_weight(iarr).NE.' ' .AND.
                0068      &      xx_genarr2d_file(iarr)(1:8).EQ.'xx_depth') igen = iarr
                0069       ENDDO
                0070       IF ( igen .GT. 0 ) THEN
                0071        CALL CTRL_MAP_GENARR2D( xx_depth, igen, myThid )
                0072       ENDIF
05b6d6742b Patr*0073 C--   Calculate cost function on tile of this instance
                0074       DO bj=myByLo(myThid), myByHi(myThid)
                0075        DO bi=myBxLo(myThid), myBxHi(myThid)
7c50f07931 Mart*0076         DO j=1,sNy
                0077          DO i=1,sNx
11c3150c71 Mart*0078           IF ( maskInC(i,j,bi,bj) .NE. 0. ) THEN
                0079            objf_depth(bi,bj) = objf_depth(bi,bj)
                0080      &          + 0.5 _d 0 * xx_depth(i,j,bi,bj)*xx_depth(i,j,bi,bj)
05b6d6742b Patr*0081           ENDIF
                0082          END DO
                0083         END DO
                0084        END DO
                0085       END DO
11c3150c71 Mart*0086 #else
                0087 C--   Calculate cost function on tile of this instance
                0088       DO bj=myByLo(myThid), myByHi(myThid)
                0089        DO bi=myBxLo(myThid), myBxHi(myThid)
                0090         DO j=1,sNy
                0091          DO i=1,sNx
                0092           IF ( maskInC(i,j,bi,bj) .NE. 0. ) THEN
                0093 #ifdef ALLOW_DEPTH_CONTROL
                0094 C     This is just a test and does not make too much sense, because
                0095 C     R_low is recomputed after xx_r_low is set to "R_low +
                0096 C     xx_depth_file" so that dr_low is not the incremenent that would
                0097 C     make sense here.
                0098            dr_low = xx_r_low(i,j,bi,bj) - R_low(i,j,bi,bj)
                0099            objf_depth(bi,bj) = objf_depth(bi,bj)
                0100      &          + 0.5 _d 0 *dr_low*dr_low
                0101 #endif
                0102           ENDIF
                0103          END DO
                0104         END DO
                0105        END DO
                0106       END DO
                0107 #endif /* ALLOW_GENARR2D_CONTROL */
05b6d6742b Patr*0108 #endif /* ALLOW_COST_DEPTH */
                0109
                0110       RETURN
                0111       END