pkg/cost/cost_test.F

5ed655852f Jean*0001 #include "COST_OPTIONS.h"
2dcaa8b9a5 Patr*0002
                0003       subroutine cost_test( myThid )
c957b3de31 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     *==========================================================*
2dcaa8b9a5 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
c957b3de31 Jean*0028       integer bi, bj
2dcaa8b9a5 Patr*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
a2ec27d9bb Patr*0040       if ( useCubedSphereExchange) then
                0041          iLocOut =  7
                0042          jLocOut =  28
                0043          kLocOut =  1
                0044       else
                0045          iLocOut =  80
                0046          jLocOut =  30
                0047          kLocOut =  1
                0048       endif
2dcaa8b9a5 Patr*0049
                0050 ce    some reference temperature
c957b3de31 Jean*0051       thetaRef = 24.0 _d 0
2dcaa8b9a5 Patr*0052
                0053 C--   Calculate mask for tracer cells  (0 => land, 1 => water)
                0054       k=1
                0055
                0056 C--   Calculate cost function on tile of this instance
                0057       do bj = jtlo,jthi
                0058         do bi = itlo,ithi
                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
10a6637adf Patr*0064 #ifndef ALLOW_COST_TSQUARED
2dcaa8b9a5 Patr*0065             if ((ig .eq. iLocOut) .and. (jg .eq. jLocOut)) then
2cfc9d59a2 Patr*0066                write(*,'(a,3(x,i4),a,4(x,i4))')
                0067      &              'COST    ',ig,jg,kLocOut,' TILE ',i,j,bi,bj
2dcaa8b9a5 Patr*0068                objf_test(bi,bj) = theta(i,j,kLocOut,bi,bj)
8347a61619 Patr*0069 cph(
                0070                print *, 'ph-cost ', ig, jg, kLocOut,
                0071      &              theta(i,j,kLocOut,bi,bj)
                0072 cph)
2dcaa8b9a5 Patr*0073             endif
10a6637adf Patr*0074 #else
                0075             objf_test(bi,bj) = objf_test(bi,bj) +
                0076      &                         theta(i,j,kLocOut,bi,bj)**2
                0077 #endif
2dcaa8b9a5 Patr*0078
c957b3de31 Jean*0079             enddo
                0080           enddo
                0081         enddo
                0082       enddo
2dcaa8b9a5 Patr*0083
c957b3de31 Jean*0084 #endif  /* ALLOW_COST_TEST */
2dcaa8b9a5 Patr*0085
de62b6d2c5 Jean*0086       RETURN
2dcaa8b9a5 Patr*0087       END