pkg/cost/cost_final.F

5ed655852f Jean*0001 #include "COST_OPTIONS.h"
eaa2114d11 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
2dcaa8b9a5 Patr*0005
7883e4f1a1 Jean*0006       SUBROUTINE COST_FINAL( myThid )
2dcaa8b9a5 Patr*0007
                0008 c     ==================================================================
720be40b89 Patr*0009 c     SUBROUTINE cost_final
2dcaa8b9a5 Patr*0010 c     ==================================================================
                0011 c
                0012 c     o Sum of all cost function contributions.
                0013 c
                0014 c     ==================================================================
720be40b89 Patr*0015 c     SUBROUTINE cost_final
2dcaa8b9a5 Patr*0016 c     ==================================================================
                0017
7883e4f1a1 Jean*0018       IMPLICIT NONE
2dcaa8b9a5 Patr*0019
                0020 c     == global variables ==
                0021 #include "EEPARAMS.h"
                0022 #include "SIZE.h"
c28cf14cd7 Patr*0023 #include "PARAMS.h"
2dcaa8b9a5 Patr*0024
                0025 #include "cost.h"
9829fd7e0c Patr*0026 #ifdef ALLOW_CTRL
5cf4364659 Mart*0027 # include "CTRL_SIZE.h"
4d72283393 Mart*0028 # include "CTRL.h"
9829fd7e0c Patr*0029 #endif
ade85a36e7 Patr*0030 #ifdef ALLOW_DIC
                0031 # include "DIC_COST.h"
                0032 #endif
64c318b5ee Patr*0033 #ifdef ALLOW_COST_SHELFICE
                0034 # include "SHELFICE_COST.h"
                0035 #endif
                0036
8f14b8ea71 Gael*0037 #ifdef ALLOW_PROFILES
                0038 # include "PROFILES_SIZE.h"
                0039 # include "profiles.h"
                0040 #endif
                0041
ad59256d7d aver*0042 #ifdef ALLOW_OBSFIT
                0043 # include "OBSFIT_SIZE.h"
                0044 # include "OBSFIT.h"
                0045 #endif
                0046
2dcaa8b9a5 Patr*0047 c     == routine arguments ==
7883e4f1a1 Jean*0048       INTEGER myThid
2dcaa8b9a5 Patr*0049
bbf42b7711 Patr*0050 #ifdef ALLOW_COST
2dcaa8b9a5 Patr*0051 c     == local variables ==
7883e4f1a1 Jean*0052       INTEGER bi,bj
                0053       _RL glob_fc, loc_fc
8f14b8ea71 Gael*0054 #ifdef ALLOW_PROFILES
3bafcf6020 Timo*0055       INTEGER num_file,num_var
8f14b8ea71 Gael*0056 #endif
ad59256d7d aver*0057 #ifdef ALLOW_OBSFIT
                0058       INTEGER num_file_obs
                0059 #endif
3bafcf6020 Timo*0060       CHARACTER*(MAX_LEN_MBUF) msgBuf
2dcaa8b9a5 Patr*0061
                0062 c     == end of interface ==
                0063
869864d4b6 Patr*0064 #ifdef ALLOW_SEAICE
2b959ba38e Mart*0065       IF (useSEAICE) CALL SEAICE_COST_FINAL( myThid )
869864d4b6 Patr*0066 #endif
                0067
1d6fceaddf Mart*0068 #ifdef ALLOW_SHELFICE
3bafcf6020 Timo*0069       IF (useShelfice) CALL SHELFICE_COST_FINAL (myThid)
96b006450c dngo*0070 #endif
                0071
                0072 #if (defined(ALLOW_STREAMICE) && defined(ALLOW_COST_STREAMICE))
                0073       IF (useStreamice) CALL STREAMICE_COST_FINAL (myThid)
1d6fceaddf Mart*0074 #endif
                0075
6c747cb1b2 Patr*0076 #ifdef ALLOW_THSICE
eaa2114d11 Jean*0077       IF (useThSIce) CALL THSICE_COST_FINAL (myThid)
6c747cb1b2 Patr*0078 #endif
                0079
98264b2c3d Gael*0080 #ifdef ALLOW_ECCO
8f14b8ea71 Gael*0081       IF (useECCO) CALL ECCO_COST_FINAL (myThid)
98264b2c3d Gael*0082 #endif
720be40b89 Patr*0083
98264b2c3d Gael*0084 #ifdef ALLOW_COST_STATE_FINAL
9eb96e5404 Patr*0085       CALL COST_STATE_FINAL (myThid)
5ed655852f Jean*0086 cgf : effectively using this in adjoint requires the
98264b2c3d Gael*0087 c     use of adjoint_state_final. That will activate the
                0088 c     objf_state_final vector in place of the fc scalar.
                0089 c     objf_state_final is therefore not added to fc.
                0090 #endif
720be40b89 Patr*0091
98264b2c3d Gael*0092 #ifdef ALLOW_COST_VECTOR
                0093 cgf : same idea as for ALLOW_COST_STATE_FINAL
                0094       CALL COST_VECTOR (myThid)
                0095 #endif
720be40b89 Patr*0096
2f1693fad8 Patr*0097 # ifdef ALLOW_COST_TEST
bbf42b7711 Patr*0098       CALL COST_TEST (myThid)
2f1693fad8 Patr*0099 # endif
98264b2c3d Gael*0100
2f1693fad8 Patr*0101 # ifdef ALLOW_COST_ATLANTIC_HEAT
720be40b89 Patr*0102       CALL COST_ATLANTIC_HEAT (myThid)
2f1693fad8 Patr*0103 # endif
98264b2c3d Gael*0104
913151f332 Davi*0105 #ifdef ALLOW_COST_HFLUXM
                0106       CALL COST_HFLUX (myThid)
3bafcf6020 Timo*0107 cgf : to compile previous line user is expected to provide cost_hflux.F
913151f332 Davi*0108 #endif
98264b2c3d Gael*0109
913151f332 Davi*0110 #ifdef ALLOW_COST_TEMP
                0111       CALL COST_TEMP (myThid)
98264b2c3d Gael*0112 cgf : to compile previous line user is expected to provide cost_temp.F
913151f332 Davi*0113 #endif
720be40b89 Patr*0114
11c3150c71 Mart*0115 #ifdef ALLOW_COST_DEPTH
                0116       CALL COST_DEPTH( myThid )
                0117 #endif
                0118
3bafcf6020 Timo*0119       WRITE(msgBuf,'(A,D22.15)') '  early fc = ', fc
                0120       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0121      &                    SQUEEZE_RIGHT, myThid )
7883e4f1a1 Jean*0122
2dcaa8b9a5 Patr*0123 c--   Sum up all contributions.
7883e4f1a1 Jean*0124       loc_fc = 0.
                0125       DO bj = myByLo(myThid), myByHi(myThid)
                0126        DO bi = myBxLo(myThid), myBxHi(myThid)
2dcaa8b9a5 Patr*0127
a9ded497a5 Gael*0128 #ifdef ALLOW_COST_TEST
3bafcf6020 Timo*0129          WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0130      &       ' --> objf_test(bi,bj)        = ', objf_test(bi,bj)
a9ded497a5 Gael*0131 #endif
                0132 #ifdef ALLOW_COST_TRACER
3bafcf6020 Timo*0133          WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0134      &         ' --> objf_tracer(bi,bj)    = ', objf_tracer(bi,bj)
a9ded497a5 Gael*0135 #endif
cda1c18f72 Jean*0136 #ifdef ALLOW_COST_ATLANTIC_HEAT
3bafcf6020 Timo*0137          WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0138      &         ' --> objf_atl(bi,bj)       = ', objf_atl(bi,bj)
98264b2c3d Gael*0139 #endif
913151f332 Davi*0140 #ifdef ALLOW_COST_TEMP
3bafcf6020 Timo*0141          WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0142      &         ' --> objf_temp_tut(bi,bj)  = ', objf_temp_tut(bi,bj)
913151f332 Davi*0143 #endif
                0144 #ifdef ALLOW_COST_HFLUXM
3bafcf6020 Timo*0145          WRITE(standardMessageUnit,'(A,D22.15)')
14021e1fda Davi*0146      &         ' --> objf_hflux_tut(bi,bj) = ', objf_hflux_tut(bi,bj)
913151f332 Davi*0147 #endif
11c3150c71 Mart*0148 #ifdef ALLOW_COST_DEPTH
3bafcf6020 Timo*0149          WRITE(standardMessageUnit,'(A,D22.15)')
11c3150c71 Mart*0150      &         ' --> objf_depth(bi,bj)     = ', objf_depth(bi,bj)
                0151 #endif
2dcaa8b9a5 Patr*0152
7883e4f1a1 Jean*0153          tile_fc(bi,bj) = tile_fc(bi,bj)
a9ded497a5 Gael*0154 #ifdef ALLOW_COST_TEST
bbf42b7711 Patr*0155      &            + mult_test   * objf_test(bi,bj)
a9ded497a5 Gael*0156 #endif
                0157 #ifdef ALLOW_COST_TRACER
bbf42b7711 Patr*0158      &            + mult_tracer * objf_tracer(bi,bj)
a9ded497a5 Gael*0159 #endif
cda1c18f72 Jean*0160 #ifdef ALLOW_COST_ATLANTIC_HEAT
720be40b89 Patr*0161      &            + mult_atl    * objf_atl(bi,bj)
616600b8d2 Patr*0162 #endif
913151f332 Davi*0163 #ifdef ALLOW_COST_TEMP
14021e1fda Davi*0164      &            + mult_temp_tut  * objf_temp_tut(bi,bj)
913151f332 Davi*0165 #endif
                0166 #ifdef ALLOW_COST_HFLUXM
14021e1fda Davi*0167      &            + mult_hflux_tut * objf_hflux_tut(bi,bj)
913151f332 Davi*0168 #endif
11c3150c71 Mart*0169 #ifdef ALLOW_COST_DEPTH
                0170      &            + mult_depth     * objf_depth(bi,bj)
                0171 #endif
8f14b8ea71 Gael*0172
                0173 #ifdef ALLOW_PROFILES
3bafcf6020 Timo*0174          IF (.NOT.useECCO) THEN
                0175           DO num_file=1,NFILESPROFMAX
                0176            DO num_var=1,NVARMAX
                0177             tile_fc(bi,bj) = tile_fc(bi,bj)
8f14b8ea71 Gael*0178      &            + mult_profiles(num_file,num_var)
                0179      &            *objf_profiles(num_file,num_var,bi,bj)
3bafcf6020 Timo*0180            ENDDO
                0181           ENDDO
                0182          ENDIF
8f14b8ea71 Gael*0183 #endif
                0184
7883e4f1a1 Jean*0185          loc_fc = loc_fc + tile_fc(bi,bj)
8f14b8ea71 Gael*0186
7883e4f1a1 Jean*0187        ENDDO
                0188       ENDDO
2dcaa8b9a5 Patr*0189
3bafcf6020 Timo*0190       WRITE(msgBuf,'(A,D22.15)') '  local fc = ', loc_fc
                0191       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0192      &                    SQUEEZE_RIGHT, myThid )
2dcaa8b9a5 Patr*0193
                0194 c--   Do global summation.
7883e4f1a1 Jean*0195       CALL GLOBAL_SUM_TILE_RL( tile_fc, glob_fc, myThid )
                0196       _BEGIN_MASTER( myThid )
                0197       fc = fc + glob_fc
                0198       _END_MASTER( myThid )
2dcaa8b9a5 Patr*0199
ad59256d7d aver*0200 #ifdef ALLOW_OBSFIT
                0201       IF (.NOT.useECCO) THEN
                0202        DO num_file_obs=1,NFILESMAX_OBS
                0203         glofc = glofc
                0204      &          +  mult_obsfit(num_file_obs)
                0205      &            *objf_obsfit(num_file_obs)
                0206        ENDDO
                0207       ENDIF
                0208 #endif
                0209
8a270036d8 Gael*0210 c--   Add contributions from global mean constraints
7883e4f1a1 Jean*0211       _BEGIN_MASTER( myThid )
                0212       fc = fc + glofc
                0213       _END_MASTER( myThid )
8a270036d8 Gael*0214
a35895498f Patr*0215 #ifdef ALLOW_DIC_COST
ade85a36e7 Patr*0216 cph-- quickly for testing
                0217       fc = totcost
                0218 #endif
                0219
3bafcf6020 Timo*0220       WRITE(msgBuf,'(A,D22.15)') ' global fc = ', fc
                0221       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0222      &                    SQUEEZE_RIGHT, myThid )
9eb96e5404 Patr*0223
2a878d427b Jean*0224 c--   to avoid re-write of output in reverse checkpointing loops,
                0225 c--   switch off output flag :
                0226       CALL TURNOFF_MODEL_IO( 0, myThid )
c28cf14cd7 Patr*0227
bbf42b7711 Patr*0228 #endif /* ALLOW_COST */
2dcaa8b9a5 Patr*0229
3bafcf6020 Timo*0230       RETURN
                0231       END