pkg/bbl/bbl_calc_rho.F

53b68b7823 Dimi*0001 #include "BBL_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: BBL_CALC_RHO
                0005 C     !INTERFACE:
                0006       SUBROUTINE BBL_CALC_RHO(
                0007      I                tFld, sFld,
                0008      O                rhoLoc,
                0009      I                k, bi, bj, myTime, myIter, myThid )
                0010
                0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
                0013 C     | SUBROUTINE BBL_CALC_RHO
                0014 C     | o Calculates [rho(S,T,z)-rhoConst] of a 2-D slice
                0015 C     |     filling land-points with BBL density.
3831aca339 Dimi*0016 C     |   pkg/bbl requires in-situ bbl density for depths equal to
                0017 C     |     and deeper than the bbl. To reduce computation and
                0018 C     |     storage requirement, these densities are stored in the
                0019 C     |     dry grid boxes of rhoInSitu:
                0020 C     |   Top cell to kLowC computes rhoLoc at level k based on
                0021 C     |     tFld(k) and sFld(k). This is identical to FIND_RHO_2D.
                0022 C     |   kLowC+1 to Nr computes rhoLoc at level k-1 based on
                0023 C     |     bbl_theta and bbl_salt.
                0024 C     |   There is one level missing, bbl density at depth Nr,
                0025 C     |     which is intead stored in bbl_rho_nr.
53b68b7823 Dimi*0026 C     *==========================================================*
3831aca339 Dimi*0027
53b68b7823 Dimi*0028 C     \ev
                0029
                0030 C     !USES:
                0031       IMPLICIT NONE
                0032
                0033 C     === Global variables ===
                0034 #include "SIZE.h"
                0035 #include "EEPARAMS.h"
                0036 #include "PARAMS.h"
                0037 #include "GRID.h"
                0038 #include "BBL.h"
                0039
                0040 C     !INPUT/OUTPUT PARAMETERS:
                0041 C     === Routine arguments ===
                0042 C     tFld      :: Pot.Temperature (3-D array)
                0043 C     sFld      :: Salinity (3-D array)
                0044 C     rhoLoc    :: In-situ density [kg/m3] (2-D array) computed at z=rC ;
                0045 C     k         :: current vertical index
                0046 C     bi,bj     :: Tile indices
                0047 C     myTime    :: Current time in simulation
                0048 C     myIter    :: Current time-step number
                0049 C     myThid    :: my Thread Id number
                0050       _RL     tFld     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0051       _RL     sFld     (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
15338fa568 Dimi*0052       _RL     rhoLoc   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
53b68b7823 Dimi*0053       INTEGER k, bi, bj
                0054       _RL     myTime
                0055       INTEGER myIter, myThid
                0056 CEOP
                0057
                0058 C     !LOCAL VARIABLES:
                0059 C     === Local variables ===
                0060 C     msgBuf     :: Informational/error message buffer
                0061 c     CHARACTER*(MAX_LEN_MBUF) msgBuf
                0062       _RL     rBBL     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0063       INTEGER i,j,kl
                0064
                0065 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0066
                0067 C-    Compute rhoLoc at level k based on tFld(k) and sFld(k).
                0068       CALL FIND_RHO_2D(
                0069      I     1-OLx, sNx+OLx, 1-OLy, sNy+OLy, k,
                0070      I     tFld(1-OLx,1-OLy,k,bi,bj),
                0071      I     sFld(1-OLx,1-OLy,k,bi,bj),
                0072      O     rhoLoc(1-OLx,1-OLy,k,bi,bj),
                0073      I     k, bi, bj, myThid )
                0074
                0075 C-    Compute rBBL at level k-1 based on bbl_theta and bbl_salt.
                0076       kl = MAX(k-1,1)
                0077       CALL FIND_RHO_2D(
                0078      I     1-OLx, sNx+OLx, 1-OLy, sNy+OLy, kl,
b5d97f904e Jean*0079      I     bbl_theta(1-OLx,1-OLy,bi,bj),
                0080      I     bbl_salt(1-OLx,1-OLy,bi,bj),
53b68b7823 Dimi*0081      O     rBBL,
                0082      I     kl, bi, bj, myThid )
                0083
                0084 C-    For k > kLowC replace rhoLoc with rBBL
                0085       DO j=1-OLy,sNy+OLy
                0086        DO i=1-OLx,sNx+OLx
b5d97f904e Jean*0087         IF ( k .GT. kLowC(i,j,bi,bj) )
53b68b7823 Dimi*0088      &       rhoLoc(i,j,k,bi,bj) = rBBL(i,j)
                0089        ENDDO
                0090       ENDDO
                0091
15338fa568 Dimi*0092 C-    Compute bbl_rho_nr at level Nr based on bbl_theta and bbl_salt.
53b68b7823 Dimi*0093       IF ( k .EQ. Nr ) THEN
                0094        CALL FIND_RHO_2D(
                0095      I      1-OLx, sNx+OLx, 1-OLy, sNy+OLy, Nr,
b5d97f904e Jean*0096      I      bbl_theta(1-OLx,1-OLy,bi,bj),
                0097      I      bbl_salt(1-OLx,1-OLy,bi,bj),
15338fa568 Dimi*0098      O      bbl_rho_nr(1-OLx,1-OLy,bi,bj),
53b68b7823 Dimi*0099      I      Nr, bi, bj, myThid )
                0100       ENDIF
                0101
                0102 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0103
                0104       RETURN
                0105       END