bottom_ctrl_5x5/code_ad/cost_test.F

21b3d503d8 Jean*0001 #include "COST_OPTIONS.h"
f0aa841546 Patr*0002
                0003       subroutine cost_test( myThid )
21b3d503d8 Jean*0004 C     *==========================================================*
                0005 C     | subroutine cost_test
                0006 C     | o this routine computes the cost function for the tiles
                0007 C     |   of this processor
                0008 C     *==========================================================*
                0009 C     | Notes
                0010 C     *==========================================================*
f0aa841546 Patr*0011       IMPLICIT NONE
                0012
                0013 C     == Global variables ===
                0014 #include "SIZE.h"
                0015 #include "EEPARAMS.h"
                0016 #include "PARAMS.h"
                0017 #include "DYNVARS.h"
                0018 #include "GRID.h"
                0019
                0020 #include "cost.h"
                0021
                0022 C     == Routine arguments ==
                0023 C     myThid - Thread number for this instance of the routine.
                0024       integer myThid
                0025
                0026 #ifdef ALLOW_COST_TEST
                0027 C     == Local variables
21b3d503d8 Jean*0028       integer bi, bj
f0aa841546 Patr*0029       integer i, j, k
                0030       integer ig, jg
                0031       integer itlo,ithi
                0032       integer jtlo,jthi
                0033       _RL vol_trans
                0034 C--   index values at which the transport is to be calculated
                0035       INTEGER iysecmin, iysecmax, ixsec
                0036       PARAMETER (ixsec = 4, iysecmin = 3, iysecmax = 3)
                0037
                0038       jtlo = mybylo(mythid)
                0039       jthi = mybyhi(mythid)
                0040       itlo = mybxlo(mythid)
                0041       ithi = mybxhi(mythid)
                0042
                0043       DO bj=jtlo,jthi
                0044        DO bi=itlo,ithi
                0045         vol_trans = 0.
                0046         DO J=1,sNy
                0047          jg = myYGlobalLo-1+(bj-1)*sNy+J
                0048          IF ( jg .ge. iysecmin .and. jg .le. iysecmax ) THEN
                0049           DO I=1,sNx
                0050            ig = myXGlobalLo-1+(bi-1)*sNx+I
                0051            IF ( ig .eq. ixsec ) THEN
                0052             DO K=1,Nr
                0053              IF ( maskW(I,J,K,BI,BJ) .NE. 0. ) THEN
                0054               vol_trans = vol_trans
                0055      &             + uVel(I,J,K,BI,BJ)
                0056      &             *_hFacW(I,J,K,BI,BJ)
                0057      &             *dyG(I,J,BI,BJ)*drF(K)
                0058              ENDIF
                0059             ENDDO
                0060            ENDIF
                0061           ENDDO
21b3d503d8 Jean*0062          ENDIF
f0aa841546 Patr*0063         ENDDO
                0064         objf_test(bi,bj) = vol_trans*1.0e-06
                0065        END DO
                0066       END DO
                0067 CML      objf_test(1,1) = vVel(3,3,1,1,1)* _hFacS(3,3,1,1,1)
                0068 Cml      iLocOut =  6
                0069 Cml      jLocOut =  35
                0070 Cml      kLocOut =  1
                0071 Cml
                0072 Cmlce    some reference temperature
21b3d503d8 Jean*0073 Cml      thetaRef = 24.0 _d 0
f0aa841546 Patr*0074 Cml
                0075 CmlC--   Calculate cost function on tile of this instance
                0076 Cml      do bj = jtlo,jthi
                0077 Cml        do bi = itlo,ithi
                0078 Cml          do j=1,sNy
                0079 Cml          jg = myYGlobalLo-1+(bj-1)*sNy+j
                0080 Cml            do i=1,sNx
                0081 Cml            ig = myXGlobalLo-1+(bi-1)*sNx+i
                0082 Cml
                0083 Cml            if ((ig .eq. iLocOut) .and. (jg .eq. jLocOut)) then
                0084 Cml               write(*,'(a,3(x,i4),a,4(x,i4))')
                0085 Cml     &              'COST    ',ig,jg,kLocOut,' TILE ',i,j,bi,bj
                0086 Cml               objf_test(bi,bj) = theta(i,j,kLocOut,bi,bj)
                0087 Cml            endif
                0088 Cml
21b3d503d8 Jean*0089 Cml            enddo
                0090 Cml          enddo
                0091 Cml        enddo
                0092 Cml      enddo
f0aa841546 Patr*0093
21b3d503d8 Jean*0094 #endif /* ALLOW_COST_TEST */
f0aa841546 Patr*0095
21b3d503d8 Jean*0096       RETURN
f0aa841546 Patr*0097       END