tutorial_global_oce_optim/code_ad/cost_hflux.F

5ed655852f Jean*0001 #include "COST_OPTIONS.h"
ec31b3f7d5 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
f1ca098265 Davi*0005
11c3150c71 Mart*0006 CBOP
                0007 C     !ROUTINE: COST_HFLUX
                0008 C     !INTERFACE:
02969a2b22 Jean*0009       SUBROUTINE COST_HFLUX( myThid )
11c3150c71 Mart*0010 C     !DESCRIPTION: \bv
02969a2b22 Jean*0011 C     *==========================================================*
                0012 C     | SUBROUTINE COST_HFLUX
                0013 C     | o the subroutine computes the cost function relative to
11c3150c71 Mart*0014 C     |   mean surface hflux optimization as a simple example.
02969a2b22 Jean*0015 C     *==========================================================*
11c3150c71 Mart*0016 C     \ev
                0017 C     !USES:
02969a2b22 Jean*0018        IMPLICIT NONE
f1ca098265 Davi*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"
11c3150c71 Mart*0029 # include "CTRL_SIZE.h"
                0030 # include "CTRL_GENARR.h"
f1ca098265 Davi*0031 #endif
                0032
11c3150c71 Mart*0033 C     !INPUT/OUTPUT PARAMETERS:
f1ca098265 Davi*0034 C     myThid - Thread number for this instance of the routine.
11c3150c71 Mart*0035       INTEGER myThid
f1ca098265 Davi*0036
11c3150c71 Mart*0037 #ifdef ALLOW_COST_HFLUXM
                0038 C     !LOCAL VARIABLES:
                0039       INTEGER i, j
                0040       INTEGER bi, bj
cf705a6c8e Mart*0041       _RL     locfc, tmpC
                0042 #ifndef ALLOW_OPENAD
11c3150c71 Mart*0043       INTEGER iarr
cf705a6c8e Mart*0044 #endif
11c3150c71 Mart*0045 CEOP
02969a2b22 Jean*0046
cf705a6c8e Mart*0047 #ifndef ALLOW_OPENAD
11c3150c71 Mart*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.
cf705a6c8e Mart*0053 #endif
f1ca098265 Davi*0054       tmpC = 0. _d 0
                0055       DO bj=myByLo(myThid),myByHi(myThid)
02969a2b22 Jean*0056        DO bi=myBxLo(myThid),myBxHi(myThid)
11c3150c71 Mart*0057         DO j=1,sNy
                0058          DO i=1,sNx
                0059           tmpC = tmpC + maskC(i,j,1,bi,bj)
f1ca098265 Davi*0060          ENDDO
11c3150c71 Mart*0061         ENDDO
02969a2b22 Jean*0062        ENDDO
f1ca098265 Davi*0063       ENDDO
12ffad7671 Jean*0064       _GLOBAL_SUM_RL( tmpC , myThid )
02969a2b22 Jean*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
11c3150c71 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      &       (
cf705a6c8e Mart*0076 #ifdef ALLOW_OPENAD
                0077      &         Qnetm(i,j,bi,bj)
                0078 #else
                0079      &         xx_gentim2d(i,j,bi,bj,iarr)
                0080 #endif
11c3150c71 Mart*0081      &       )**2
f1ca098265 Davi*0082          ENDDO
11c3150c71 Mart*0083         ENDDO
02969a2b22 Jean*0084
11c3150c71 Mart*0085         objf_hflux_tut(bi,bj) = locfc
                0086 c       print*,'objf_hflux_tut =',locfc
02969a2b22 Jean*0087
                0088        ENDDO
                0089       ENDDO
f1ca098265 Davi*0090
11c3150c71 Mart*0091 #endif /* ALLOW_COST_HFLUXM */
02969a2b22 Jean*0092       RETURN
                0093       END