pkg/cost/cost_vector.F

5ed655852f Jean*0001 #include "COST_OPTIONS.h"
720be40b89 Patr*0002
                0003       subroutine cost_vector( myThid )
                0004 C     /==========================================================\
                0005 C     | subroutine cost_vector                                   |
                0006 C     | o This routine computes the meridional heat transport.   |
                0007 C     |   The current indices are for North Atlantic 29N         |
                0008 C     |   2x2 global setup.                                      |
                0009 C     \==========================================================/
                0010        implicit none
                0011
                0012 C     == Global variables ===
                0013 #include "SIZE.h"
                0014 #include "EEPARAMS.h"
                0015 #include "PARAMS.h"
                0016 #include "GRID.h"
                0017 #include "DYNVARS.h"
                0018
                0019 #include "cost.h"
                0020
                0021 C     ======== Routine arguments ======================
                0022 C     myThid - Thread number for this instance of the routine.
                0023       integer myThid
                0024
                0025 #ifdef ALLOW_COST_VECTOR
                0026 C     ========= Local variables =========================
                0027       integer    isecbeg      , isecend      , jsec
                0028       integer    kmaxdepth
                0029       integer i, j, k
                0030       integer ig, jg
                0031       integer bi, bj
                0032       _RL     locfc
                0033       _RL        vVel_bar(Nr), theta_bar(Nr), count(Nr)
                0034       _RL     petawatt
                0035       _RL     sum
                0036       parameter( petawatt = 1.e+15 )
                0037
                0038 C     80W - 0W at 24N
                0039       parameter( isecbeg = 70, isecend = 90, jsec = 27 )
                0040       parameter ( kmaxdepth = 15 )
                0041 C     80W - 0W at 48N
                0042 C      parameter( isecbeg = 70, isecend = 90, jsec = 33 )
                0043 C      parameter ( kmaxdepth = 14 )
                0044
                0045
                0046
                0047 C------------------------------------------------------
                0048 C     Accumulate meridionally integrated transports
                0049 C     Note bar(V)*bar(T) not bar(VT)
e305438401 Mart*0050 C     Attention pYFaceA [m^2*gravity*rhoConst]
720be40b89 Patr*0051 C------------------------------------------------------
                0052
                0053       DO bj=myByLo(myThid),myByHi(myThid)
                0054        DO bi=myBxLo(myThid),myBxHi(myThid)
                0055
                0056         locfc = 0.0
                0057         do j=1,sNy
                0058          jg = myYGlobalLo-1+(bj-1)*sNy+j
                0059          if (jg .eq. jsec) then
                0060
                0061           do i=1,sNx
                0062            ig = myXGlobalLo-1+(bi-1)*sNx+i
                0063            if ((ig .ge. isecbeg) .and. (ig .le. isecend)) then
                0064             sum = 0. _d 0
                0065             do k = 1, kmaxdepth
                0066              sum = sum
                0067      &             + vVel(i,j,k,bi,bj) * maskS(i,j,k,bi,bj)
                0068      &             * drF(k)
                0069 C     &             * 0.5*(theta(i,j,k,bi,bj)+theta(i,j-1,k,bi,bj))
                0070             end do
                0071             objf_vector(i,bi,bj) = sum*dxG(i,j,bi,bj)
                0072            end if
                0073           end do
                0074
                0075          end if
                0076         end do
                0077
9eb96e5404 Patr*0078         do i = 1,sNx
                0079            print*,' --> objf_vector(i,bi,bj)  = ',
                0080      &          objf_vector(i,bi,bj)
                0081         end do
                0082
720be40b89 Patr*0083        END DO
                0084       END DO
                0085
                0086 #endif
951926fb9b Jean*0087
720be40b89 Patr*0088       end