tutorial_global_oce_optim/code_oad/cost_hflux.F

0e09621e3e Patr*0001 #include "COST_OPTIONS.h"
987a76ae74 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
0e09621e3e Patr*0005
cf705a6c8e Mart*0006 CBOP
                0007 C     !ROUTINE: COST_HFLUX
                0008 C     !INTERFACE:
0e09621e3e Patr*0009       SUBROUTINE COST_HFLUX( myThid )
cf705a6c8e Mart*0010 C     !DESCRIPTION: \bv
0e09621e3e Patr*0011 C     *==========================================================*
                0012 C     | SUBROUTINE COST_HFLUX
                0013 C     | o the subroutine computes the cost function relative to
cf705a6c8e Mart*0014 C     |   mean surface hflux optimization as a simple example.
0e09621e3e Patr*0015 C     *==========================================================*
cf705a6c8e Mart*0016 C     \ev
                0017 C     !USES:
0e09621e3e Patr*0018        IMPLICIT NONE
                0019 C     == Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
                0024 #include "cost.h"
cf705a6c8e Mart*0025 #ifdef ALLOW_OPENAD
                0026 # include "FFIELDS.h"
                0027 #else
                0028 # include "cost_local.h"
                0029 # include "CTRL_SIZE.h"
                0030 # include "CTRL_GENARR.h"
                0031 #endif
0e09621e3e Patr*0032
cf705a6c8e Mart*0033 C     !INPUT/OUTPUT PARAMETERS:
0e09621e3e Patr*0034 C     myThid - Thread number for this instance of the routine.
cf705a6c8e Mart*0035       INTEGER myThid
0e09621e3e Patr*0036
2e7aec9951 dngo*0037 #ifdef ALLOW_COST_HFLUXM
cf705a6c8e Mart*0038 C     !LOCAL VARIABLES:
                0039       INTEGER i, j
                0040       INTEGER bi, bj
                0041       _RL     locfc, tmpC
                0042 #ifndef ALLOW_OPENAD
                0043       INTEGER iarr
                0044 #endif
                0045 CEOP
0e09621e3e Patr*0046
cf705a6c8e Mart*0047 #ifndef ALLOW_OPENAD
                0048 C     iarr = 1 is set in data.ctrl (xx_gentim2d_file(1) = 'xx_qnet').
                0049       iarr = 1
                0050 C     By default xx_gentim2d_period(1)=0, so that control parameter
                0051 C     xx_gentim2d(:,:,:,:,1) is the mean heat flux perturbation. Here we
                0052 C     penalize deviations from the first guess = 0.
                0053 #endif
0e09621e3e Patr*0054       tmpC = 0. _d 0
                0055       DO bj=myByLo(myThid),myByHi(myThid)
                0056        DO bi=myBxLo(myThid),myBxHi(myThid)
cf705a6c8e Mart*0057         DO j=1,sNy
                0058          DO i=1,sNx
                0059           tmpC = tmpC + maskC(i,j,1,bi,bj)
0e09621e3e Patr*0060          ENDDO
cf705a6c8e Mart*0061         ENDDO
0e09621e3e Patr*0062        ENDDO
                0063       ENDDO
                0064       _GLOBAL_SUM_RL( tmpC , myThid )
                0065       IF ( tmpC.GT.0. ) tmpC = 1. _d 0 / tmpC
                0066
                0067       DO bj=myByLo(myThid),myByHi(myThid)
                0068        DO bi=myBxLo(myThid),myBxHi(myThid)
                0069
cf705a6c8e Mart*0070         locfc = 0. _d 0
                0071         DO j=1,sNy
                0072          DO i=1,sNx
                0073           locfc = locfc + tmpC*maskC(i,j,1,bi,bj)*
                0074      &        whfluxm(i,j,bi,bj)*
                0075      &       (
                0076 #ifdef ALLOW_OPENAD
0e09621e3e Patr*0077      &         Qnetm(i,j,bi,bj)
cf705a6c8e Mart*0078 #else
                0079      &         xx_gentim2d(i,j,bi,bj,iarr)
                0080 #endif
                0081      &       )**2
0e09621e3e Patr*0082          ENDDO
cf705a6c8e Mart*0083         ENDDO
0e09621e3e Patr*0084
cf705a6c8e Mart*0085         objf_hflux_tut(bi,bj) = locfc
                0086 c       print*,'objf_hflux_tut =',locfc
0e09621e3e Patr*0087
                0088        ENDDO
                0089       ENDDO
                0090
2e7aec9951 dngo*0091 #endif /* ALLOW_COST_HFLUXM */
0e09621e3e Patr*0092       RETURN
                0093       END