pkg/ctrl/ctrl_toolbox.F

7b8b86ab99 Timo*0001 #include "CTRL_OPTIONS.h"
                0002
                0003 C--  File ctrl_toolbox.F: Routines to handle basic operations common in pkg/ctrl
                0004 C--  Note: basically same as ecco_toolbox routines, but copied here for package
                0005 C--  independence (pkg/ecco doesn't work with openad)
                0006 C--   Contents
                0007 C--   o CTRL_ASSIGN
                0008 C--   o CTRL_CPRLRL
                0009 C--   o CTRL_CPRSRL
                0010 C--   o CTRL_CPRSRS
                0011
                0012 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0013 CBOP
                0014 C     !ROUTINE: CTRL_ASSIGN
                0015 C     !INTERFACE:
                0016       SUBROUTINE CTRL_ASSIGN( fld, nnzloc, fill_value, myThid )
                0017 C     !DESCRIPTION: \bv
                0018 C     fill a field with fill_value
                0019 C     \ev
                0020
                0021 C     !USES:
                0022       IMPLICIT NONE
                0023 C     == global variables ==
                0024 #include "EEPARAMS.h"
                0025 #include "SIZE.h"
                0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028       INTEGER nnzloc
                0029       _RL fld   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nnzloc,nSx,nSy)
                0030       _RL fill_value
                0031       INTEGER myThid
                0032
                0033 #ifdef ALLOW_CTRL
                0034 C     !LOCAL VARIABLES:
                0035       INTEGER bi,bj
                0036       INTEGER i,j,k
                0037 CEOP
                0038
                0039       DO bj = myByLo(myThid), myByHi(myThid)
                0040        DO bi = myBxLo(myThid), myBxHi(myThid)
                0041         DO k = 1,nnzloc
                0042          DO j = 1-OLy,sNy+OLy
                0043           DO i = 1-OLx,sNx+OLx
                0044             fld(i,j,k,bi,bj) = fill_value
                0045           ENDDO
                0046          ENDDO
                0047         ENDDO
                0048        ENDDO
                0049       ENDDO
                0050
                0051 #endif /* ALLOW_CTRL */
                0052
                0053       RETURN
                0054       END
                0055
                0056 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0057 CBOP
                0058 C     !ROUTINE: CTRL_CPRLRL
                0059 C     !INTERFACE:
                0060       SUBROUTINE CTRL_CPRLRL(
                0061      I                   fldIn, nzIn, fldOut, nzOut,
                0062      I                   myThid )
                0063
                0064 C     !DESCRIPTION: \bv
                0065 C     copy a field (RL) to another array (RL)
                0066 C     \ev
                0067
                0068 C     !USES:
                0069       IMPLICIT NONE
                0070 C     == global variables ==
                0071 #include "EEPARAMS.h"
                0072 #include "SIZE.h"
                0073
                0074 C     !INPUT/OUTPUT PARAMETERS:
                0075       INTEGER nzIn, nzOut
                0076       _RL fldIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0077       _RL fldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzOut,nSx,nSy)
                0078       INTEGER myThid
                0079
                0080 #ifdef ALLOW_CTRL
                0081 C     !LOCAL VARIABLES:
                0082       INTEGER bi,bj
                0083       INTEGER i,j,k
                0084 CEOP
                0085
                0086       DO bj = myByLo(myThid), myByHi(myThid)
                0087        DO bi = myBxLo(myThid), myBxHi(myThid)
                0088         DO k = 1,nzOut
                0089          DO j = 1-OLy,sNy+OLy
                0090           DO i = 1-OLx,sNx+OLx
                0091             fldOut(i,j,k,bi,bj) = fldIn(i,j,k,bi,bj)
                0092           ENDDO
                0093          ENDDO
                0094         ENDDO
                0095        ENDDO
                0096       ENDDO
                0097
                0098 #endif /* ALLOW_CTRL */
                0099
                0100       RETURN
                0101       END
                0102
                0103 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0104 CBOP
                0105 C     !ROUTINE: CTRL_CPRSRL
                0106 C     !INTERFACE:
                0107       SUBROUTINE CTRL_CPRSRL(
                0108      I                   fldIn, nzIn, fldOut, nzOut,
                0109      I                   myThid )
                0110
                0111 C     !DESCRIPTION: \bv
                0112 C     copy a field to another array, switching from _RS to _RL
                0113 C     \ev
                0114
                0115 C     !USES:
                0116       IMPLICIT NONE
                0117 C     == global variables ==
                0118 #include "EEPARAMS.h"
                0119 #include "SIZE.h"
                0120
                0121 C     !INPUT/OUTPUT PARAMETERS:
                0122       INTEGER nzIn, nzOut
                0123       _RS fldIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0124       _RL fldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzOut,nSx,nSy)
                0125       INTEGER myThid
                0126
                0127 #ifdef ALLOW_CTRL
                0128 C     !LOCAL VARIABLES:
                0129       INTEGER bi,bj
                0130       INTEGER i,j,k
                0131 CEOP
                0132
                0133       DO bj = myByLo(myThid), myByHi(myThid)
                0134        DO bi = myBxLo(myThid), myBxHi(myThid)
                0135         DO k = 1,nzOut
                0136          DO j = 1-OLy,sNy+OLy
                0137           DO i = 1-OLx,sNx+OLx
                0138             fldOut(i,j,k,bi,bj) = fldIn(i,j,k,bi,bj)
                0139           ENDDO
                0140          ENDDO
                0141         ENDDO
                0142        ENDDO
                0143       ENDDO
                0144
                0145 #endif /* ALLOW_CTRL */
                0146
                0147       RETURN
                0148       END
                0149
                0150 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0151 CBOP
                0152 C     !ROUTINE: CTRL_CPRSRS
                0153 C     !INTERFACE:
                0154       SUBROUTINE CTRL_CPRSRS(
                0155      I                   fldIn, nzIn, fldOut, nzOut,
                0156      I                   myThid )
                0157
                0158 C     !DESCRIPTION: \bv
                0159 C     copy a field (RS) to another array (RS)
                0160 C     \ev
                0161
                0162 C     !USES:
                0163       IMPLICIT NONE
                0164 C     == global variables ==
                0165 #include "EEPARAMS.h"
                0166 #include "SIZE.h"
                0167
                0168 C     !INPUT/OUTPUT PARAMETERS:
                0169       INTEGER nzIn, nzOut
                0170       _RS fldIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzIn,nSx,nSy)
                0171       _RS fldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nzOut,nSx,nSy)
                0172       INTEGER myThid
                0173
                0174 #ifdef ALLOW_CTRL
                0175 C     !LOCAL VARIABLES:
                0176       INTEGER bi,bj
                0177       INTEGER i,j,k
                0178 CEOP
                0179
                0180       DO bj = myByLo(myThid), myByHi(myThid)
                0181        DO bi = myBxLo(myThid), myBxHi(myThid)
                0182         DO k = 1,nzOut
                0183          DO j = 1-OLy,sNy+OLy
                0184           DO i = 1-OLx,sNx+OLx
                0185             fldOut(i,j,k,bi,bj) = fldIn(i,j,k,bi,bj)
                0186           ENDDO
                0187          ENDDO
                0188         ENDDO
                0189        ENDDO
                0190       ENDDO
                0191
                0192 #endif /* ALLOW_CTRL */
                0193
                0194       RETURN
                0195       END