halfpipe_streamice/code_ad/cost_test.F

16cc32c739 Mart*0001 #include "COST_OPTIONS.h"
                0002 #ifdef ALLOW_STREAMICE
                0003 # include "STREAMICE_OPTIONS.h"
                0004 #endif
fb1e8c9704 Dani*0005
                0006       subroutine cost_test( myThid )
16cc32c739 Mart*0007 C     *==========================================================*
fb1e8c9704 Dani*0008 C     | subroutine cost_test                                     |
                0009 C     | o this routine computes the cost function for the tiles  |
                0010 C     |   of this processor                                      |
16cc32c739 Mart*0011 C     *==========================================================*
fb1e8c9704 Dani*0012 C     | Notes                                                    |
16cc32c739 Mart*0013 C     *==========================================================*
fb1e8c9704 Dani*0014       IMPLICIT NONE
                0015
                0016 C     == Global variables ===
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
                0020 #include "DYNVARS.h"
                0021 #include "GRID.h"
16cc32c739 Mart*0022 #include "cost.h"
fb1e8c9704 Dani*0023 #ifdef ALLOW_STREAMICE
                0024 # include "STREAMICE.h"
                0025 #endif
                0026
                0027 C     == Routine arguments ==
                0028 C     myThid - Thread number for this instance of the routine.
                0029       integer bi, bj
                0030       integer myThid
                0031
                0032 #ifdef ALLOW_COST_TEST
                0033 C     == Local variables
16cc32c739 Mart*0034       integer i, j
                0035 c      _RL i_numcells
fb1e8c9704 Dani*0036       INTEGER  ILNBLNK
                0037       EXTERNAL ILNBLNK
16cc32c739 Mart*0038 c      CHARACTER*(MAX_LEN_FNAM) STREAMICExvelOptimFile
                0039 c      CHARACTER*(MAX_LEN_FNAM) STREAMICEyvelOptimFile
                0040 c      _RL U_obs (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0041 c      _RL V_obs (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
fb1e8c9704 Dani*0042
16cc32c739 Mart*0043 c      i_numcells = 1.0/(Nx*Ny)
fb1e8c9704 Dani*0044
16cc32c739 Mart*0045 c      STREAMICExvelOptimFile=
                0046 c     & STREAMICEvelOptimFile(1:
                0047 c     & ILNBLNK(STREAMICEvelOptimFile))//"u.bin"
                0048 c      STREAMICEyvelOptimFile=
                0049 c     & STREAMICEvelOptimFile(1:
                0050 c     & ILNBLNK(STREAMICEvelOptimFile))//"v.bin"
fb1e8c9704 Dani*0051
16cc32c739 Mart*0052 c      _BARRIER
fb1e8c9704 Dani*0053
16cc32c739 Mart*0054 c      CALL READ_FLD_XY_RS( STREAMICExvelOptimFile, ' ',
                0055 c     &      U_obs, 0, myThid )
                0056 c      CALL READ_FLD_XY_RS( STREAMICEyvelOptimFile, ' ',
                0057 c     &      V_obs, 0, myThid )
fb1e8c9704 Dani*0058
                0059 C--   Calculate mask for tracer cells  (0 => land, 1 => water)
16cc32c739 Mart*0060 c       k=1
fb1e8c9704 Dani*0061
                0062 C--   Calculate cost function on tile of this instance
16cc32c739 Mart*0063       do bj = myByLo(myThid),myByHi(myThid)
                0064         do bi = myBxLo(myThid),myBxHi(myThid)
fb1e8c9704 Dani*0065           do j=1,sNy
                0066             do i=1,sNx
                0067
                0068             if (streamice_hmask(i,j,bi,bj).eq.1.0) then
                0069              objf_test (bi,bj) = objf_test (bi,bj) +
58ae2ae163 Patr*0070      &       u_streamice(i,j,bi,bj)**2+v_streamice(i,j,bi,bj)**2+
                0071      &       h_streamice(i,j,bi,bj)**2
fb1e8c9704 Dani*0072             endif
                0073
16cc32c739 Mart*0074             enddo
                0075           enddo
                0076         enddo
                0077       enddo
fb1e8c9704 Dani*0078
16cc32c739 Mart*0079 #endif /* ALLOW_COST_TEST */
fb1e8c9704 Dani*0080
                0081       RETURN
                0082       END