pkg/ctrl/ctrl_bound.F

01719759b8 Jean*0001 #include "CTRL_OPTIONS.h"
                0002 C- note: although we just need CPP_EEOPTIONS.h here, prefer to
                0003 C        include the same option-file above as in the AD version.
6b46535faa Gael*0004
01719759b8 Jean*0005 C--  File ctrl_bound.F:
                0006 C--   Contents
                0007 C--   o CTRL_BOUND_3D
                0008 C--   o CTRL_BOUND_2D
                0009
                0010 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0011 CBOP
6b46535faa Gael*0012 C     !ROUTINE: CTRL_BOUND_3D
                0013 C     !INTERFACE:
                0014       SUBROUTINE CTRL_BOUND_3D(
01719759b8 Jean*0015      U                fieldCur,
c59dd234b1 Jean*0016      I                mask3D, boundsVec, myThid )
6b46535faa Gael*0017 C     !DESCRIPTION: \bv
                0018 C     *==========================================================*
f5f1792fb5 Gael*0019 C     | started: Gael Forget gforget@mit.edu 20-Aug-2007
                0020 C     |
                0021 C     | o in forward mode: impose bounds on ctrl vector values
                0022 C     | o in adjoint mode: do nothing ... or emulate local minimum
6b46535faa Gael*0023 C     *==========================================================*
01719759b8 Jean*0024 C     \ev
6b46535faa Gael*0025
01719759b8 Jean*0026 C     !USES:
                0027       IMPLICIT NONE
6b46535faa Gael*0028 #include "SIZE.h"
                0029 #include "EEPARAMS.h"
                0030
01719759b8 Jean*0031 C     !INPUT/OUTPUT PARAMETERS:
c59dd234b1 Jean*0032       _RL fieldCur(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0033       _RS mask3D  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
f5f1792fb5 Gael*0034       _RL boundsVec(5)
01719759b8 Jean*0035       INTEGER myThid
                0036
                0037 C     !LOCAL VARIABLES:
                0038       INTEGER bi,bj,i,j,k
                0039 CEOP
                0040
                0041       IF (boundsVec(1).LT.boundsVec(4)) THEN
                0042
                0043        DO bj=myByLo(myThid), myByHi(myThid)
                0044         DO bi=myBxLo(myThid), myBxHi(myThid)
                0045
                0046          DO k = 1,Nr
                0047           DO j = 1,sNy
                0048            DO i = 1,sNx
c59dd234b1 Jean*0049              IF (mask3D(i,j,k,bi,bj).NE.0.) THEN
01719759b8 Jean*0050               IF (fieldCur(i,j,k,bi,bj).GT.boundsVec(4)) THEN
                0051                fieldCur(i,j,k,bi,bj)=boundsVec(4)
                0052               ENDIF
                0053               IF (fieldCur(i,j,k,bi,bj).LT.boundsVec(1)) THEN
                0054                fieldCur(i,j,k,bi,bj)=boundsVec(1)
                0055               ENDIF
                0056              ENDIF
                0057            ENDDO
                0058           ENDDO
                0059          ENDDO
                0060
                0061         ENDDO
                0062        ENDDO
f5f1792fb5 Gael*0063
01719759b8 Jean*0064       ENDIF
6b46535faa Gael*0065
01719759b8 Jean*0066       RETURN
                0067       END
                0068
                0069 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0070 CBOP
                0071 C
6b46535faa Gael*0072 C     !ROUTINE: CTRL_BOUND_2D
                0073 C     !INTERFACE:
                0074       SUBROUTINE CTRL_BOUND_2D(
01719759b8 Jean*0075      U                fieldCur,
7b8b86ab99 Timo*0076      I                mask2D, boundsVec, myThid )
6b46535faa Gael*0077 C     !DESCRIPTION: \bv
                0078 C     *==========================================================*
f5f1792fb5 Gael*0079 C     | started: Gael Forget gforget@mit.edu 20-Aug-2007
                0080 C     |
                0081 C     | o in forward mode: impose bounds on ctrl vector values
                0082 C     | o in adjoint mode: do nothing ... or emulate local minimum
6b46535faa Gael*0083 C     *==========================================================*
01719759b8 Jean*0084 C     \ev
6b46535faa Gael*0085
01719759b8 Jean*0086 C     !USES:
                0087       IMPLICIT NONE
6b46535faa Gael*0088 #include "SIZE.h"
                0089 #include "EEPARAMS.h"
                0090
01719759b8 Jean*0091 C     !INPUT/OUTPUT PARAMETERS:
7b8b86ab99 Timo*0092       _RL fieldCur(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0093       _RS mask2D  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
f5f1792fb5 Gael*0094       _RL boundsVec(5)
01719759b8 Jean*0095       INTEGER myThid
                0096
                0097 C     !LOCAL VARIABLES:
                0098       INTEGER bi,bj,i,j
                0099 CEOP
                0100
                0101       IF (boundsVec(1).LT.boundsVec(4)) THEN
                0102
                0103        DO bj=myByLo(myThid), myByHi(myThid)
                0104         DO bi=myBxLo(myThid), myBxHi(myThid)
                0105
                0106           DO j = 1-OLy,sNy+OLy
                0107            DO i = 1-OLx,sNx+OLx
7b8b86ab99 Timo*0108              IF (mask2D(i,j,bi,bj).NE.0.) THEN
01719759b8 Jean*0109               IF (fieldCur(i,j,bi,bj).GT.boundsVec(4)) THEN
                0110                fieldCur(i,j,bi,bj)=boundsVec(4)
                0111               ENDIF
                0112               IF (fieldCur(i,j,bi,bj).LT.boundsVec(1)) THEN
                0113                fieldCur(i,j,bi,bj)=boundsVec(1)
                0114               ENDIF
                0115              ENDIF
                0116            ENDDO
                0117           ENDDO
                0118
                0119         ENDDO
                0120        ENDDO
                0121
                0122       ENDIF
6b46535faa Gael*0123
3c0a47830d Jean*0124       RETURN
                0125       END