isomip/code_ad/cost_test.F

21b3d503d8 Jean*0001 #include "COST_OPTIONS.h"
9a037d41df 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     *==========================================================*
9a037d41df 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
9a037d41df Patr*0029       _RL thetaRef
                0030       integer i, j, k
                0031       integer ig, jg
                0032       integer itlo,ithi
                0033       integer jtlo,jthi
21b3d503d8 Jean*0034 c     _RL  thetaLev(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
9a037d41df Patr*0035
                0036       jtlo = mybylo(mythid)
                0037       jthi = mybyhi(mythid)
                0038       itlo = mybxlo(mythid)
                0039       ithi = mybxhi(mythid)
                0040
                0041       if ( useCubedSphereExchange) then
                0042          iLocOut =  7
                0043          jLocOut =  28
                0044          kLocOut =  1
                0045       else
                0046          iLocOut =  80
                0047          jLocOut =  30
                0048          kLocOut =  1
                0049       endif
                0050
21b3d503d8 Jean*0051 c     CALL READ_FLD_XYZ_RL( hydrogThetaFile, ' ', thetaLev, 0, myThid )
9a037d41df Patr*0052
                0053 ce    some reference temperature
21b3d503d8 Jean*0054       thetaRef = 24.0 _d 0
9a037d41df Patr*0055
                0056 C--   Calculate mask for tracer cells  (0 => land, 1 => water)
                0057       k=1
                0058
                0059 C--   Calculate cost function on tile of this instance
                0060       do bj = jtlo,jthi
                0061         do bi = itlo,ithi
                0062           do j=1,sNy
                0063           jg = myYGlobalLo-1+(bj-1)*sNy+j
                0064             do i=1,sNx
                0065             ig = myXGlobalLo-1+(bi-1)*sNx+i
                0066
                0067 #ifndef ALLOW_COST_TSQUARED
                0068             if ((ig .eq. iLocOut) .and. (jg .eq. jLocOut)) then
                0069                write(*,'(a,3(x,i4),a,4(x,i4))')
                0070      &              'COST    ',ig,jg,kLocOut,' TILE ',i,j,bi,bj
                0071                objf_test(bi,bj) = theta(i,j,kLocOut,bi,bj)
                0072 cph(
                0073                print *, 'ph-cost ', ig, jg, kLocOut,
                0074      &              theta(i,j,kLocOut,bi,bj)
                0075 cph)
                0076             endif
                0077 #else
                0078        do k=1,nr
                0079          if (maskC(i,j,k,bi,bj).NE.0.) then
                0080            objf_test(bi,bj) = objf_test(bi,bj) +
                0081      &        ( theta(i,j,k,bi,bj) )**2
                0082          endif
                0083        enddo
                0084 #endif
                0085
21b3d503d8 Jean*0086             enddo
                0087           enddo
                0088         enddo
                0089       enddo
9a037d41df Patr*0090
21b3d503d8 Jean*0091 #endif  /* ALLOW_COST_TEST */
9a037d41df Patr*0092
21b3d503d8 Jean*0093       RETURN
9a037d41df Patr*0094       END