pkg/ctrl/ctrl_depth_ini.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
05b6d6742b Patr*0002
                0003 CBOP
11c3150c71 Mart*0004 C     !ROUTINE: CTRL_DEPTH_INI
                0005
05b6d6742b Patr*0006 C     !INTERFACE:
11c3150c71 Mart*0007       SUBROUTINE CTRL_DEPTH_INI( mythid )
05b6d6742b Patr*0008
                0009 C     !DESCRIPTION: \bv
                0010 c     *=================================================================
7bfe6112e8 Jean*0011 c     | SUBROUTINE ctrl_depth_ini
05b6d6742b Patr*0012 c     | Add the depth part of the control vector to the model state
                0013 c     *=================================================================
                0014 C     \ev
                0015
                0016 C     !USES:
11c3150c71 Mart*0017       IMPLICIT NONE
05b6d6742b Patr*0018 #include "EEPARAMS.h"
                0019 #include "SIZE.h"
                0020 #include "GRID.h"
c04085ad02 Patr*0021 #include "CTRL_SIZE.h"
11c3150c71 Mart*0022 #ifdef ALLOW_GENARR2D_CONTROL
                0023 # include "CTRL_GENARR.h"
                0024 #endif
05b6d6742b Patr*0025
11c3150c71 Mart*0026 C     !INPUT PARAMETERS:
05b6d6742b Patr*0027       integer mythid
                0028
11c3150c71 Mart*0029 C     !OUTPUT PARAMETERS:
05b6d6742b Patr*0030
11c3150c71 Mart*0031 #ifdef ALLOW_DEPTH_CONTROL
                0032 C     !FUNCTIONS:
05b6d6742b Patr*0033
11c3150c71 Mart*0034 C     !LOCAL VARIABLES:
05b6d6742b Patr*0035
11c3150c71 Mart*0036       INTEGER bi,bj
                0037       INTEGER i,j
                0038 #ifdef ALLOW_GENARR2D_CONTROL
                0039       INTEGER iarr
                0040       INTEGER igen
                0041 #endif
                0042       CHARACTER*(MAX_LEN_MBUF) msgbuf
05b6d6742b Patr*0043 CEOP
                0044
11c3150c71 Mart*0045       WRITE(msgBuf,'(A,A)') 'CTRL_DEPTH_INI: ctrl update R_low, ',
                0046      &     'adding the control vector.'
                0047       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0048      &     SQUEEZE_RIGHT, myThid )
                0049
                0050 C     In contrast to other control variable starting with xx_, this
                0051 C     variable not an increment, but a full replacement of R_low, see
                0052 C     also GRID.h. This is necessary because TAF gets confused if we do
                0053 C     not do it like this.
                0054       DO bj=myByLo(mythid),myByHi(mythid)
                0055        DO bi=myBxLo(mythid),myBxHi(mythid)
                0056         DO j = 1-OLy,sNy+OLy
                0057          DO i = 1-OLx,sNx+OLx
                0058           xx_r_low(i,j,bi,bj) = R_low(i,j,bi,bj)
                0059          ENDDO
                0060         ENDDO
                0061        ENDDO
                0062       ENDDO
                0063 #ifdef ALLOW_GENARR2D_CONTROL
                0064 C--   use generic 2D control variable infrastructure to set xx_r_low
                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_r_low, igen, myThid )
                0072       ENDIF
                0073 #else
                0074       STOP 'ALLOW_DEPTH_CONTROL only works with ALLOW_GENARR2D_CONTROL'
                0075 #endif /* ALLOW_GENARR2D_CONTROL */
05b6d6742b Patr*0076 #endif /* ALLOW_DEPTH_CONTROL */
                0077
                0078       return
                0079       end