hs94.1x64x5/code_oad/cost_test.F

e9a88bebd8 Patr*0001 #include "COST_OPTIONS.h"
                0002
                0003       subroutine cost_test( myThid )
                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     *==========================================================*
                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
                0028       integer bi, bj
                0029       _RL thetaRef
                0030       integer i, j, k
                0031       integer ig, jg
                0032       integer itlo,ithi
                0033       integer jtlo,jthi
                0034
                0035       jtlo = mybylo(mythid)
                0036       jthi = mybyhi(mythid)
                0037       itlo = mybxlo(mythid)
                0038       ithi = mybxhi(mythid)
                0039
                0040       iLocOut =  1
                0041       jLocOut =  32
                0042       kLocOut =  1
                0043
                0044       do bj = jtlo,jthi
                0045         do bi = itlo,ithi
                0046           objf_test(bi,bj)= 0. _d 0
                0047         enddo
                0048       enddo
                0049
                0050 ce    some reference temperature
                0051       thetaRef = 24.0 _d 0
                0052 C--   Calculate mask for tracer cells  (0 => land, 1 => water)
                0053       k=1
                0054
                0055 C--   Calculate cost function on tile of this instance
                0056       do bj = jtlo,jthi
                0057         do bi = itlo,ithi
                0058 c
                0059           do j=1,sNy
                0060           jg = myYGlobalLo-1+(bj-1)*sNy+j
                0061             do i=1,sNx
                0062             ig = myXGlobalLo-1+(bi-1)*sNx+i
                0063
                0064             if ((jg .gt.30) .and. (jg .lt.40)) then
                0065                objf_test(bi,bj) = objf_test(bi,bj) +
                0066      &              theta(i,j,kLocOut,bi,bj)
                0067                write(*,'(a,F10.1,3(x,i4),a,4(x,i4))')
                0068      &              'objf_test  ', objf_test(bi,bj),
                0069      &              ig,jg,kLocOut,' TILE ',i,j,bi,bj
                0070             endif
                0071
                0072             enddo
                0073           enddo
                0074 c
                0075           objf_test(bi,bj) = objf_test(bi,bj) / 9. _d 0
                0076 c
                0077         enddo
                0078       enddo
                0079
                0080 #endif  /* ALLOW_COST_TEST */
                0081
                0082       RETURN
                0083       END