hs94.1x64x5/code_ad/cost_test_local.F90

0524b7d1ff Mart*0001 #include "PACKAGES_CONFIG.h"
                0002 ! Copied from default CPP_EEMACROS.h
                0003 ! To avoid this, we need to find a way to include CPP_EEMACROS.h
                0004 #define _RL Real*8
                0005
                0006 !BOP
                0007 !     !ROUTINE: COST_TEST_LOCAL
                0008 !     !INTERFACE:
                0009 subroutine cost_test_local ( &
                0010      sNx, sNy, nSx, nSy, OLx, OLy, Nr, &
                0011      myBxLo, myBxHi, myByLo, myByHi, &
                0012      myXGlobalLo, myYGlobalLo, &
                0013      theta, &
                0014      objf_test, &
                0015      myThid )
                0016   !     *==========================================================*
                0017   !     | SUBROUTINE COST_TEST_LOCAL
                0018   !     | o the subroutine computes the sum of temperatures
                0019   !     |   in a band 30 < j < 40
                0020   !     *==========================================================*
                0021   !
                0022   !     !USES:
                0023   implicit none
                0024
                0025   !   !INPUT/OUTPUT PARAMETERS:
                0026   ! sNx,sNy,nSx,nSy,OLx,OLy,Nr  :: array boundaries (set it SIZE.h)
                0027   ! myBxLo,myBxHi,myByLo,myByHi :: bi/bj loop boundaries for myThid
                0028   ! myXGlobalLo, myYGlobalLo    :: smallest indices of global fields
                0029   ! theta         :: temperature
                0030   ! objf_test     :: objective/cost function contribution defined in cost.h
                0031   ! myThid        :: my Thread Id number
                0032   ! This requires TAF_FORTRAN_VERS > F77
                0033   integer, intent(in) :: sNx, sNy, nSx, nSy, OLx, OLy, Nr
                0034   integer, intent(in) :: myBxLo, myBxHi, myByLo, myByHi
                0035   integer, intent(in) :: myXGlobalLo, myYGlobalLo
                0036   _RL, intent(in)     :: theta(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0037   _RL, intent(inout)  :: objf_test(nSx,nSy)
                0038   integer, intent(in) :: myThid
                0039
                0040 #ifdef ALLOW_COST
                0041   !   !LOCAL VARIABLES:
                0042   ! loop indices
                0043   integer :: i, j, k, ig, jg
                0044   integer :: bi, bj
                0045 !EOP
                0046
                0047   do bj=myByLo,myByHi
                0048    do bi=myBxLo,myBxHi
                0049     objf_test(bi,bj)= 0. _d 0
                0050    enddo
                0051   enddo
                0052
                0053   k = 1
                0054
                0055   ! Calculate cost function on tile of this instance
                0056   do bj=myByLo,myByHi
                0057    do bi=myBxLo,myBxHi
                0058     do j=1,sNy
                0059      jg = myYGlobalLo-1+(bj-1)*sNy+j
                0060      do i=1,sNx
                0061       ig = myXGlobalLo-1+(bi-1)*sNx+i
                0062       if ((jg .gt.30) .and. (jg .lt.40)) then
                0063        objf_test(bi,bj) = objf_test(bi,bj) + theta(i,j,k,bi,bj)
                0064        write(*,'(a,F10.1,3(x,i4),a,4(x,i4))') &
                0065             'objf_test  ', objf_test(bi,bj), ig, jg, k, ' TILE ', i, j, bi, bj
                0066       endif
                0067      enddo
                0068     enddo
                0069
                0070     objf_test(bi,bj) = objf_test(bi,bj) / 9. _d 0
                0071
                0072    enddo
                0073   enddo
                0074 #endif /* ALLOW_COST */
                0075
                0076   return
                0077   ! This requires TAF_FORTRAN_VERS > F77
                0078 end subroutine cost_test_local