pkg/ecco/ecco_cost_final.F

8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
6805a315c1 Gael*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
5001c65f45 Patr*0005
9f85ea262e Mart*0006       SUBROUTINE ECCO_COST_FINAL( myThid )
5001c65f45 Patr*0007
                0008 c     ==================================================================
c9dc83bee0 Patr*0009 c     SUBROUTINE cost_final
5001c65f45 Patr*0010 c     ==================================================================
                0011 c
                0012 c     o Sum of all cost function contributions.
                0013 c
                0014 c     ==================================================================
c9dc83bee0 Patr*0015 c     SUBROUTINE cost_final
5001c65f45 Patr*0016 c     ==================================================================
                0017
9f85ea262e Mart*0018       IMPLICIT NONE
5001c65f45 Patr*0019
                0020 c     == global variables ==
                0021
                0022 #include "EEPARAMS.h"
                0023 #include "SIZE.h"
55d9759e14 Patr*0024 #include "PARAMS.h"
5001c65f45 Patr*0025
960ed3a8f0 Gael*0026 #ifdef ALLOW_COST
                0027 # include "cost.h"
                0028 #endif
49484c0542 Gael*0029 #ifdef ALLOW_ECCO
cf705a6c8e Mart*0030 # include "ECCO_SIZE.h"
                0031 # include "ECCO.h"
49484c0542 Gael*0032 #endif
960ed3a8f0 Gael*0033 #ifdef ALLOW_CTRL
28e42a683a Gael*0034 # include "CTRL_SIZE.h"
5cf4364659 Mart*0035 # include "CTRL.h"
28e42a683a Gael*0036 # include "CTRL_GENARR.h"
6b47d550f4 Mart*0037 # ifdef ALLOW_OBCS
                0038 #  include "CTRL_OBCS.h"
                0039 # endif /* ALLOW_OBCS */
960ed3a8f0 Gael*0040 #endif
6e4c90fea3 Patr*0041 #ifdef ALLOW_PROFILES
68ab1d598d Gael*0042 # include "PROFILES_SIZE.h"
6e4c90fea3 Patr*0043 # include "profiles.h"
                0044 #endif
5001c65f45 Patr*0045
                0046 c     == routine arguments ==
                0047
9f85ea262e Mart*0048       INTEGER myThid
5001c65f45 Patr*0049
8716d94355 Dimi*0050 C     === Functions ====
                0051       LOGICAL  MASTER_CPU_THREAD
                0052       EXTERNAL MASTER_CPU_THREAD
9f5240b52a Jean*0053       INTEGER  ILNBLNK
                0054       EXTERNAL ILNBLNK
8716d94355 Dimi*0055
5001c65f45 Patr*0056 c     == local variables ==
                0057
9f85ea262e Mart*0058       INTEGER bi,bj
                0059       INTEGER ifc
                0060       INTEGER num_var
5001c65f45 Patr*0061
960ed3a8f0 Gael*0062 #ifndef ALLOW_PROFILES
9f85ea262e Mart*0063       INTEGER NFILESPROFMAX
960ed3a8f0 Gael*0064       parameter (NFILESPROFMAX=1)
9f85ea262e Mart*0065       INTEGER NVARMAX
960ed3a8f0 Gael*0066       parameter (NVARMAX=1)
                0067 #endif
                0068
                0069 #ifndef ALLOW_COST
                0070 c This quick fix allows to compile and run fwd but, as far as
                0071 c the adjoint, pkg/autodiff most likely require cost though.
3ca8a823c3 Gael*0072       _RL fc, glofc
960ed3a8f0 Gael*0073 #endif
b16dd4be7d Gael*0074       _RL locfc
960ed3a8f0 Gael*0075
b0f9ab3790 Gael*0076       _RL f_gencost(NGENCOST)
6b47d550f4 Mart*0077 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
                0078       _RL f_obcsn, f_obcss, f_obcsw, f_obcse, f_ageos
                0079 #endif
960ed3a8f0 Gael*0080 #ifdef ALLOW_PROFILES
32e2f2e3d3 Gael*0081       _RL f_profiles(NFILESPROFMAX,NVARMAX)
6b2230d510 Ou W*0082       _RL f_profiles_mean(NVARMAX)
960ed3a8f0 Gael*0083 #endif
fa1c4e7ee9 Patr*0084 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*0085       _RL f_gentim2d(maxCtrlTim2D)
                0086 #endif
c1d030d006 Gael*0087 #ifdef ALLOW_GENARR2D_CONTROL
                0088       _RL f_genarr2d(maxCtrlArr2D)
                0089 #endif
                0090 #ifdef ALLOW_GENARR3D_CONTROL
                0091       _RL f_genarr3d(maxCtrlArr3D)
                0092 #endif
b0f9ab3790 Gael*0093       _RL no_gencost(NGENCOST)
6b47d550f4 Mart*0094 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
                0095       _RL no_obcsn, no_obcss, no_obcsw, no_obcse, no_ageos
                0096 #endif
960ed3a8f0 Gael*0097 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0098       INTEGER num_file
32e2f2e3d3 Gael*0099       _RL no_profiles(NFILESPROFMAX,NVARMAX)
6b2230d510 Ou W*0100       _RL no_profiles_mean(NVARMAX)
960ed3a8f0 Gael*0101 #endif
fa1c4e7ee9 Patr*0102 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*0103       _RL no_gentim2d(maxCtrlTim2D)
                0104 #endif
c1d030d006 Gael*0105 #ifdef ALLOW_GENARR2D_CONTROL
                0106       _RL no_genarr2d(maxCtrlArr2D)
                0107 #endif
                0108 #ifdef ALLOW_GENARR3D_CONTROL
                0109       _RL no_genarr3d(maxCtrlArr3D)
                0110 #endif
69a6648502 Patr*0111
9f85ea262e Mart*0112       CHARACTER*20 cfname
                0113       CHARACTER*(MAX_LEN_MBUF) msgBuf
5001c65f45 Patr*0114
6a770e0a24 Patr*0115       INTEGER IL
                0116
5001c65f45 Patr*0117 c     == end of interface ==
                0118
                0119       ifc = 30
951926fb9b Jean*0120
b16dd4be7d Gael*0121       locfc = 0. _d 0
5cce2b5d76 Gael*0122
6b47d550f4 Mart*0123 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
5cce2b5d76 Gael*0124       f_obcsn   = 0. _d 0
                0125       f_obcss   = 0. _d 0
                0126       f_obcsw   = 0. _d 0
                0127       f_obcse   = 0. _d 0
6b47d550f4 Mart*0128       f_ageos   = 0. _d 0
                0129 #endif
6e4c90fea3 Patr*0130 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0131       DO num_file=1,NFILESPROFMAX
                0132        DO num_var=1,NVARMAX
6a770e0a24 Patr*0133         f_profiles(num_file,num_var)= 0. _d 0
9f85ea262e Mart*0134        ENDDO
                0135       ENDDO
                0136       DO num_var=1,NVARMAX
6b2230d510 Ou W*0137        f_profiles_mean(num_var)= 0. _d 0
9f85ea262e Mart*0138       ENDDO
6e4c90fea3 Patr*0139 #endif
df3aa3e753 Gael*0140 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0141       DO num_var=1,NGENCOST
                0142        f_gencost(num_var)= 0. _d 0
                0143       ENDDO
df3aa3e753 Gael*0144 #endif
fa1c4e7ee9 Patr*0145 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0146       DO num_var=1,maxCtrlTim2D
                0147        f_gentim2d(num_var)= 0. _d 0
                0148       ENDDO
28e42a683a Gael*0149 #endif
c1d030d006 Gael*0150 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0151       DO num_var=1,maxCtrlArr2D
                0152        f_genarr2d(num_var)= 0. _d 0
                0153       ENDDO
c1d030d006 Gael*0154 #endif
                0155 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0156       DO num_var=1,maxCtrlArr3D
                0157        f_genarr3d(num_var)= 0. _d 0
                0158       ENDDO
c1d030d006 Gael*0159 #endif
5001c65f45 Patr*0160
6b47d550f4 Mart*0161 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
                0162       no_obcsn   = 0. _d 0
                0163       no_obcss   = 0. _d 0
                0164       no_obcsw   = 0. _d 0
                0165       no_obcse   = 0. _d 0
                0166       no_ageos   = 0. _d 0
                0167 #endif
6e4c90fea3 Patr*0168 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0169       DO num_file=1,NFILESPROFMAX
                0170        DO num_var=1,NVARMAX
6a770e0a24 Patr*0171         no_profiles(num_file,num_var)= 0. _d 0
9f85ea262e Mart*0172        ENDDO
                0173       ENDDO
                0174       DO num_var=1,NVARMAX
6b2230d510 Ou W*0175        no_profiles_mean(num_var)= 0. _d 0
9f85ea262e Mart*0176       ENDDO
6e4c90fea3 Patr*0177 #endif
df3aa3e753 Gael*0178 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0179       DO num_var=1,NGENCOST
                0180        no_gencost(num_var)= 0. _d 0
                0181       ENDDO
df3aa3e753 Gael*0182 #endif
fa1c4e7ee9 Patr*0183 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0184       DO num_var=1,maxCtrlTim2D
                0185        no_gentim2d(num_var)= 0. _d 0
                0186       ENDDO
28e42a683a Gael*0187 #endif
c1d030d006 Gael*0188 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0189       DO num_var=1,maxCtrlArr2D
                0190        no_genarr2d(num_var)= 0. _d 0
                0191       ENDDO
c1d030d006 Gael*0192 #endif
                0193 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0194       DO num_var=1,maxCtrlArr3D
                0195        no_genarr3d(num_var)= 0. _d 0
                0196       ENDDO
c1d030d006 Gael*0197 #endif
69a6648502 Patr*0198
5001c65f45 Patr*0199 c--   Sum up all contributions.
9f5240b52a Jean*0200       DO bj = myByLo(myThid), myByHi(myThid)
                0201        DO bi = myBxLo(myThid), myBxHi(myThid)
951926fb9b Jean*0202
6b47d550f4 Mart*0203 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
9f85ea262e Mart*0204         tile_fc(bi,bj) = tile_fc(bi,bj)
c509d7e04a Gael*0205      &         + mult_obcsn   * objf_obcsn(bi,bj)
                0206      &         + mult_obcss   * objf_obcss(bi,bj)
                0207      &         + mult_obcsw   * objf_obcsw(bi,bj)
                0208      &         + mult_obcse   * objf_obcse(bi,bj)
6b47d550f4 Mart*0209 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
c509d7e04a Gael*0210      &         + mult_ageos   * objf_ageos(bi,bj)
f3622cd48b Matt*0211 # endif
c509d7e04a Gael*0212 #endif
987caa4f1d Gael*0213 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0214         DO num_file=1,NFILESPROFMAX
                0215          DO num_var=1,NVARMAX
987caa4f1d Gael*0216           tile_fc(bi,bj) = tile_fc(bi,bj)
                0217      &            + mult_profiles(num_file,num_var)
                0218      &            *objf_profiles(num_file,num_var,bi,bj)
9f85ea262e Mart*0219          ENDDO
                0220         ENDDO
                0221         DO num_var=1,NVARMAX
6b2230d510 Ou W*0222          tile_fc(bi,bj) = tile_fc(bi,bj)
                0223      &           + mult_profiles_mean(num_var)
                0224      &           *objf_profiles_mean(num_var,bi,bj)
9f85ea262e Mart*0225         ENDDO
987caa4f1d Gael*0226 #endif
df3aa3e753 Gael*0227 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0228         DO num_var=1,NGENCOST
                0229          tile_fc(bi,bj) = tile_fc(bi,bj)
df3aa3e753 Gael*0230      &            + mult_gencost(num_var)
8c157ed454 Patr*0231      &            *objf_gencost(bi,bj,num_var)
9f85ea262e Mart*0232         ENDDO
df3aa3e753 Gael*0233 #endif
fa1c4e7ee9 Patr*0234 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0235         DO num_var=1,maxCtrlTim2D
                0236          tile_fc(bi,bj) = tile_fc(bi,bj)
28e42a683a Gael*0237      &            + mult_gentim2d(num_var)
                0238      &            *objf_gentim2d(bi,bj,num_var)
9f85ea262e Mart*0239         ENDDO
28e42a683a Gael*0240 #endif
c1d030d006 Gael*0241 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0242         DO num_var=1,maxCtrlArr2D
                0243          tile_fc(bi,bj) = tile_fc(bi,bj)
c1d030d006 Gael*0244      &            + mult_genarr2d(num_var)
                0245      &            *objf_genarr2d(bi,bj,num_var)
9f85ea262e Mart*0246         ENDDO
c1d030d006 Gael*0247 #endif
                0248 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0249         DO num_var=1,maxCtrlArr3D
                0250          tile_fc(bi,bj) = tile_fc(bi,bj)
c1d030d006 Gael*0251      &            + mult_genarr3d(num_var)
                0252      &            *objf_genarr3d(bi,bj,num_var)
9f85ea262e Mart*0253         ENDDO
c1d030d006 Gael*0254 #endif
5cce2b5d76 Gael*0255
6b47d550f4 Mart*0256 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
9f85ea262e Mart*0257         f_obcsn  = f_obcsn + objf_obcsn(bi,bj)
                0258         f_obcss  = f_obcss + objf_obcss(bi,bj)
                0259         f_obcsw  = f_obcsw + objf_obcsw(bi,bj)
                0260         f_obcse  = f_obcse + objf_obcse(bi,bj)
6b47d550f4 Mart*0261 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
9f85ea262e Mart*0262         f_ageos  = f_ageos + objf_ageos(bi,bj)
f3622cd48b Matt*0263 # endif
c509d7e04a Gael*0264 #endif
6e4c90fea3 Patr*0265 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0266         DO num_file=1,NFILESPROFMAX
                0267          DO num_var=1,NVARMAX
6a770e0a24 Patr*0268           f_profiles(num_file,num_var)=f_profiles(num_file,num_var)
                0269      &            +objf_profiles(num_file,num_var,bi,bj)
9f85ea262e Mart*0270          ENDDO
                0271         ENDDO
                0272         DO num_var=1,NVARMAX
6b2230d510 Ou W*0273          f_profiles_mean(num_var)=f_profiles_mean(num_var)
                0274      &           +objf_profiles_mean(num_var,bi,bj)
9f85ea262e Mart*0275         ENDDO
6e4c90fea3 Patr*0276 #endif
df3aa3e753 Gael*0277 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0278         DO num_var=1,NGENCOST
                0279          f_gencost(num_var)=f_gencost(num_var)
8c157ed454 Patr*0280      &            +objf_gencost(bi,bj,num_var)
9f85ea262e Mart*0281         ENDDO
df3aa3e753 Gael*0282 #endif
fa1c4e7ee9 Patr*0283 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0284         DO num_var=1,maxCtrlTim2D
                0285          f_gentim2d(num_var) = f_gentim2d(num_var)
28e42a683a Gael*0286      &            +objf_gentim2d(bi,bj,num_var)
9f85ea262e Mart*0287         ENDDO
28e42a683a Gael*0288 #endif
c1d030d006 Gael*0289 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0290         DO num_var=1,maxCtrlArr2D
                0291          f_genarr2d(num_var) = f_genarr2d(num_var)
c1d030d006 Gael*0292      &            +objf_genarr2d(bi,bj,num_var)
9f85ea262e Mart*0293         ENDDO
c1d030d006 Gael*0294 #endif
                0295 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0296         DO num_var=1,maxCtrlArr3D
                0297          f_genarr3d(num_var) = f_genarr3d(num_var)
c1d030d006 Gael*0298      &            +objf_genarr3d(bi,bj,num_var)
9f85ea262e Mart*0299         ENDDO
c1d030d006 Gael*0300 #endif
5cce2b5d76 Gael*0301
6b47d550f4 Mart*0302 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
9f85ea262e Mart*0303         no_obcsn = no_obcsn + num_obcsn(bi,bj)
                0304         no_obcss = no_obcss + num_obcss(bi,bj)
                0305         no_obcse = no_obcse + num_obcse(bi,bj)
                0306         no_obcsw = no_obcsw + num_obcsw(bi,bj)
6b47d550f4 Mart*0307 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
9f85ea262e Mart*0308         no_ageos = no_ageos + num_ageos(bi,bj)
6b47d550f4 Mart*0309 # endif
c509d7e04a Gael*0310 #endif
6e4c90fea3 Patr*0311 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0312         DO num_file=1,NFILESPROFMAX
                0313          DO num_var=1,NVARMAX
6a770e0a24 Patr*0314           no_profiles(num_file,num_var)=no_profiles(num_file,num_var)
                0315      &            +num_profiles(num_file,num_var,bi,bj)
9f85ea262e Mart*0316          ENDDO
                0317         ENDDO
                0318         DO num_var=1,NVARMAX
6b2230d510 Ou W*0319          no_profiles_mean(num_var)=no_profiles_mean(num_var)
                0320      &           +num_profiles_mean(num_var,bi,bj)
9f85ea262e Mart*0321         ENDDO
6e4c90fea3 Patr*0322 #endif
df3aa3e753 Gael*0323 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0324         DO num_var=1,NGENCOST
                0325          no_gencost(num_var)=no_gencost(num_var)
8c157ed454 Patr*0326      &            +num_gencost(bi,bj,num_var)
9f85ea262e Mart*0327         ENDDO
951926fb9b Jean*0328 #endif
fa1c4e7ee9 Patr*0329 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0330         DO num_var=1,maxCtrlTim2D
                0331          no_gentim2d(num_var) = no_gentim2d(num_var)
28e42a683a Gael*0332      &            +num_gentim2d(bi,bj,num_var)
9f85ea262e Mart*0333         ENDDO
28e42a683a Gael*0334 #endif
c1d030d006 Gael*0335 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0336         DO num_var=1,maxCtrlArr2D
                0337          no_genarr2d(num_var) = no_genarr2d(num_var)
c1d030d006 Gael*0338      &            +num_genarr2d(bi,bj,num_var)
9f85ea262e Mart*0339         ENDDO
c1d030d006 Gael*0340 #endif
                0341 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0342         DO num_var=1,maxCtrlArr3D
                0343          no_genarr3d(num_var) = no_genarr3d(num_var)
c1d030d006 Gael*0344      &            +num_genarr3d(bi,bj,num_var)
9f85ea262e Mart*0345         ENDDO
c1d030d006 Gael*0346 #endif
69a6648502 Patr*0347
9f5240b52a Jean*0348 C-   end bi,bj loops
                0349        ENDDO
                0350       ENDDO
5001c65f45 Patr*0351
b16dd4be7d Gael*0352 c local copy used in print statements, for
                0353 c which we always want to do the global sum.
2e500677e3 Jean*0354       CALL GLOBAL_SUM_TILE_RL( tile_fc, locfc, myThid )
b16dd4be7d Gael*0355
960ed3a8f0 Gael*0356 #ifndef ALLOW_COST
                0357 cgf global sum is now done in cost_final if allow_cost
5001c65f45 Patr*0358 c--   Do global summation.
6637358eea Jean*0359       _GLOBAL_SUM_RL( fc , myThid )
960ed3a8f0 Gael*0360 #endif
5001c65f45 Patr*0361
                0362 c--   Do global summation for each part of the cost function
6b47d550f4 Mart*0363 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
c509d7e04a Gael*0364       _GLOBAL_SUM_RL( f_obcsn , myThid )
                0365       _GLOBAL_SUM_RL( f_obcss , myThid )
                0366       _GLOBAL_SUM_RL( f_obcsw , myThid )
                0367       _GLOBAL_SUM_RL( f_obcse , myThid )
6b47d550f4 Mart*0368 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
                0369       _GLOBAL_SUM_RL( f_ageos , myThid )
                0370 # endif
c509d7e04a Gael*0371 #endif
6e4c90fea3 Patr*0372 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0373       DO num_file=1,NFILESPROFMAX
                0374        DO num_var=1,NVARMAX
6637358eea Jean*0375         _GLOBAL_SUM_RL(f_profiles(num_file,num_var), myThid )
9f85ea262e Mart*0376        ENDDO
                0377       ENDDO
                0378       DO num_var=1,NVARMAX
6b2230d510 Ou W*0379        _GLOBAL_SUM_RL(f_profiles_mean(num_var), myThid )
9f85ea262e Mart*0380       ENDDO
6e4c90fea3 Patr*0381 #endif
df3aa3e753 Gael*0382 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0383       DO num_var=1,NGENCOST
                0384        _GLOBAL_SUM_RL(f_gencost(num_var), myThid )
                0385       ENDDO
951926fb9b Jean*0386 #endif
fa1c4e7ee9 Patr*0387 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0388       DO num_var=1,maxCtrlTim2D
                0389        _GLOBAL_SUM_RL(f_gentim2d(num_var), myThid )
                0390       ENDDO
28e42a683a Gael*0391 #endif
c1d030d006 Gael*0392 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0393       DO num_var=1,maxCtrlArr2D
                0394        _GLOBAL_SUM_RL(f_genarr2d(num_var), myThid )
                0395       ENDDO
c1d030d006 Gael*0396 #endif
                0397 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0398       DO num_var=1,maxCtrlArr3D
                0399        _GLOBAL_SUM_RL(f_genarr3d(num_var), myThid )
                0400       ENDDO
c1d030d006 Gael*0401 #endif
5cce2b5d76 Gael*0402
6b47d550f4 Mart*0403 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
c509d7e04a Gael*0404       _GLOBAL_SUM_RL( no_obcsn , myThid )
                0405       _GLOBAL_SUM_RL( no_obcss , myThid )
                0406       _GLOBAL_SUM_RL( no_obcsw , myThid )
                0407       _GLOBAL_SUM_RL( no_obcse , myThid )
6b47d550f4 Mart*0408 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
                0409       _GLOBAL_SUM_RL( no_ageos , myThid )
                0410 # endif
c509d7e04a Gael*0411 #endif
6e4c90fea3 Patr*0412 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0413       DO num_file=1,NFILESPROFMAX
                0414        DO num_var=1,NVARMAX
6637358eea Jean*0415         _GLOBAL_SUM_RL(no_profiles(num_file,num_var), myThid )
9f85ea262e Mart*0416        ENDDO
                0417       ENDDO
                0418       DO num_var=1,NVARMAX
6b2230d510 Ou W*0419        _GLOBAL_SUM_RL(no_profiles_mean(num_var), myThid )
9f85ea262e Mart*0420       ENDDO
6e4c90fea3 Patr*0421 #endif
df3aa3e753 Gael*0422 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0423       DO num_var=1,NGENCOST
                0424        _GLOBAL_SUM_RL(no_gencost(num_var), myThid )
                0425       ENDDO
951926fb9b Jean*0426 #endif
fa1c4e7ee9 Patr*0427 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0428       DO num_var=1,maxCtrlTim2D
                0429        _GLOBAL_SUM_RL(no_gentim2d(num_var), myThid )
                0430       ENDDO
2e500677e3 Jean*0431 #endif
c1d030d006 Gael*0432 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0433       DO num_var=1,maxCtrlArr2D
                0434        _GLOBAL_SUM_RL(no_genarr2d(num_var), myThid )
                0435       ENDDO
c1d030d006 Gael*0436 #endif
                0437 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0438       DO num_var=1,maxCtrlArr3D
                0439        _GLOBAL_SUM_RL(no_genarr3d(num_var), myThid )
                0440       ENDDO
c1d030d006 Gael*0441 #endif
69a6648502 Patr*0442
6b47d550f4 Mart*0443 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
9f85ea262e Mart*0444       WRITE(standardMessageUnit,'(A,D22.15)')
c509d7e04a Gael*0445      &     ' --> f_obcsn   =',f_obcsn
9f85ea262e Mart*0446       WRITE(standardMessageUnit,'(A,D22.15)')
c509d7e04a Gael*0447      &     ' --> f_obcss   =',f_obcss
9f85ea262e Mart*0448       WRITE(standardMessageUnit,'(A,D22.15)')
c509d7e04a Gael*0449      &     ' --> f_obcsw   =',f_obcsw
9f85ea262e Mart*0450       WRITE(standardMessageUnit,'(A,D22.15)')
c509d7e04a Gael*0451      &     ' --> f_obcse   =',f_obcse
6b47d550f4 Mart*0452 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
9f85ea262e Mart*0453       WRITE(standardMessageUnit,'(A,D22.15)')
c509d7e04a Gael*0454      &     ' --> f_ageos   =',f_ageos
f3622cd48b Matt*0455 # endif
c509d7e04a Gael*0456 #endif
6e4c90fea3 Patr*0457 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0458       IF (usePROFILES) THEN
                0459        DO num_file=1,NFILESPROFMAX
                0460         DO num_var=1,NVARMAX
                0461          IF ( no_profiles(num_file,num_var).GT.zeroRL ) THEN
                0462           WRITE(msgBuf,'(A,D22.15,i2.0,i2.0)')
6a770e0a24 Patr*0463      &     ' --> f_profiles =',f_profiles(num_file,num_var),
                0464      &      num_file, num_var
9f85ea262e Mart*0465           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0466      &                        SQUEEZE_RIGHT, myThid )
                0467          ENDIF
                0468         ENDDO
                0469        ENDDO
                0470        DO num_var=1,NVARMAX
                0471         IF ( no_profiles_mean(num_var).GT.zeroRL ) THEN
                0472          WRITE(msgBuf,'(A,D22.15,i2.0,i2.0)')
6b2230d510 Ou W*0473      &     ' --> f_profiles_mean =',f_profiles_mean(num_var),
                0474      &      num_var
9f85ea262e Mart*0475          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0476      &                       SQUEEZE_RIGHT, myThid )
9f85ea262e Mart*0477         ENDIF
                0478        ENDDO
                0479       ENDIF
6e4c90fea3 Patr*0480 #endif
df3aa3e753 Gael*0481 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0482       DO num_var=1,NGENCOST
                0483        IF (no_gencost(num_var).GT.0) THEN
                0484         WRITE(msgBuf,'(A,D22.15,i2.0)')
df3aa3e753 Gael*0485      &     ' --> f_gencost =',f_gencost(num_var),
                0486      &      num_var
9f85ea262e Mart*0487         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0488      &                      SQUEEZE_RIGHT, myThid )
                0489        ENDIF
                0490       ENDDO
951926fb9b Jean*0491 #endif
fa1c4e7ee9 Patr*0492 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0493       DO num_var=1,maxCtrlTim2D
                0494        IF (no_gentim2d(num_var).GT.0. _d 0) THEN
                0495         WRITE(msgBuf,'(A,D22.15,i2.0)')
28e42a683a Gael*0496      &     ' --> f_gentim2d =',f_gentim2d(num_var),
                0497      &      num_var
9f85ea262e Mart*0498         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0499      &                      SQUEEZE_RIGHT, myThid )
                0500        ENDIF
                0501       ENDDO
2e500677e3 Jean*0502 #endif
c1d030d006 Gael*0503 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0504       DO num_var=1,maxCtrlArr2D
                0505        IF (no_genarr2d(num_var).GT.0. _d 0) THEN
                0506         WRITE(msgBuf,'(A,D22.15,i2.0)')
c1d030d006 Gael*0507      &     ' --> f_genarr2d =',f_genarr2d(num_var),
                0508      &      num_var
9f85ea262e Mart*0509         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0510      &                      SQUEEZE_RIGHT, myThid )
                0511        ENDIF
                0512       ENDDO
c1d030d006 Gael*0513 #endif
b67c96a546 Gael*0514 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0515       DO num_var=1,maxCtrlArr3D
                0516        IF (no_genarr3d(num_var).GT.0. _d 0) THEN
                0517         WRITE(msgBuf,'(A,D22.15,i2.0)')
b67c96a546 Gael*0518      &     ' --> f_genarr3d =',f_genarr3d(num_var),
                0519      &      num_var
9f85ea262e Mart*0520         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0521      &                      SQUEEZE_RIGHT, myThid )
                0522        ENDIF
                0523       ENDDO
b67c96a546 Gael*0524 #endif
69a6648502 Patr*0525
5001c65f45 Patr*0526 c--   Each process has calculated the global part for itself.
                0527
3ca8a823c3 Gael*0528 #ifndef ALLOW_COST
                0529 cgf this sum is now done in cost_final if allow_cost
9f85ea262e Mart*0530       fc = fc + glofc
3ca8a823c3 Gael*0531 #endif
                0532
b16dd4be7d Gael*0533       locfc=locfc+glofc
                0534
40f0054c49 Jean*0535 C     only master thread of master CPU open and write to file
                0536       IF ( MASTER_CPU_THREAD(myThid) ) THEN
                0537
9f85ea262e Mart*0538        WRITE(msgBuf,'(A,D22.15)')
b16dd4be7d Gael*0539      &           ' --> fc               =', locfc
9f85ea262e Mart*0540        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0541      &                     SQUEEZE_RIGHT, myThid )
                0542
                0543        WRITE(cfname,'(A,i4.4)') 'costfunction',eccoiter
                0544        IF ( eccoWriteCostFunction ) THEN
                0545         WRITE(msgBuf,'(A,A)')
                0546      &           'Writing cost function info to ', cfname(1:16)
                0547         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0548      &                      SQUEEZE_RIGHT, myThid )
5001c65f45 Patr*0549         open(unit=ifc,file=cfname)
951926fb9b Jean*0550
1fa8e77fb9 Gael*0551 #ifdef ALLOW_ECCO_OLD_FC_PRINT
9f85ea262e Mart*0552         WRITE(ifc,*)
1fa8e77fb9 Gael*0553 #else
9f85ea262e Mart*0554         WRITE(ifc,'(A,2D22.15)')
1fa8e77fb9 Gael*0555 #endif
b16dd4be7d Gael*0556      &       'fc =', locfc, 0.
6b47d550f4 Mart*0557 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
9f85ea262e Mart*0558         WRITE(ifc,'(A,2D22.15)')
c509d7e04a Gael*0559      &       'f_obcsn =', f_obcsn, no_obcsn
9f85ea262e Mart*0560         WRITE(ifc,'(A,2D22.15)')
c509d7e04a Gael*0561      &       'f_obcss =', f_obcss, no_obcss
9f85ea262e Mart*0562         WRITE(ifc,'(A,2D22.15)')
c509d7e04a Gael*0563      &       'f_obcsw =', f_obcsw, no_obcsw
9f85ea262e Mart*0564         WRITE(ifc,'(A,2D22.15)')
c509d7e04a Gael*0565      &       'f_obcse =', f_obcse, no_obcse
6b47d550f4 Mart*0566 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
9f85ea262e Mart*0567         WRITE(ifc,'(A,2D22.15)')
c509d7e04a Gael*0568      &       'f_ageos =', f_ageos, no_ageos
f3622cd48b Matt*0569 # endif
c509d7e04a Gael*0570 #endif
6e4c90fea3 Patr*0571 #ifdef ALLOW_PROFILES
9f85ea262e Mart*0572         IF (usePROFILES) THEN
                0573          DO num_file=1,NFILESPROFMAX
                0574           DO num_var=1,NVARMAX
                0575            IF ( no_profiles(num_file,num_var).GT.zeroRL ) THEN
                0576             IL  = ILNBLNK( profilesfiles(num_file) )
                0577             IL  = max (IL,30)
                0578             WRITE(ifc,'(4A,2D22.15)')
419d01728d Gael*0579      &    profilesfiles(num_file)(1:IL),' ',
                0580      &    prof_names(num_file,num_var), ' = ',
951926fb9b Jean*0581      &    f_profiles(num_file,num_var),
6a770e0a24 Patr*0582      &    no_profiles(num_file,num_var)
9f85ea262e Mart*0583            ENDIF
                0584           ENDDO
                0585          ENDDO
                0586          DO num_var=1,NVARMAX
                0587           IF ( no_profiles_mean(num_var).GT.zeroRL ) THEN
                0588            WRITE(ifc,'(3A,2D22.15)')
6b2230d510 Ou W*0589      &    'profile_mean ',
                0590      &    prof_names(1,num_var), ' = ',
                0591      &    f_profiles_mean(num_var),
                0592      &    no_profiles_mean(num_var)
9f85ea262e Mart*0593           ENDIF
                0594          ENDDO
                0595         ENDIF
6e4c90fea3 Patr*0596 #endif
df3aa3e753 Gael*0597 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0598         DO num_var=1,NGENCOST
                0599          IF (no_gencost(num_var).GT.0) THEN
                0600           IL  = ILNBLNK( gencost_name(num_var) )
                0601           IL  = max (IL,15)
                0602           WRITE(ifc,'(2A,i2.0,A,2D22.15)')
1fa8e77fb9 Gael*0603      &    gencost_name(num_var)(1:IL),' (gencost ', num_var, ') = ',
df3aa3e753 Gael*0604      &    f_gencost(num_var),
                0605      &    no_gencost(num_var)
9f85ea262e Mart*0606          ENDIF
                0607         ENDDO
951926fb9b Jean*0608 #endif
c9dc83bee0 Patr*0609
255851fc5e Gael*0610 #ifdef ALLOW_GENTIM2D_CONTROL
9f85ea262e Mart*0611         DO num_var=1,maxCtrlTim2D
                0612          IF (no_gentim2d(num_var).GT.0. _d 0) THEN
                0613           IL  = ILNBLNK( xx_gentim2d_file(num_var) )
                0614           IL  = max (IL,15)
                0615           WRITE(ifc,'(2A,i2.0,A,2D22.15)')
28e42a683a Gael*0616      &    xx_gentim2d_file(num_var)(1:IL),
                0617      &    ' (gentim2d ', num_var, ') = ',
                0618      &    f_gentim2d(num_var),
                0619      &    no_gentim2d(num_var)
9f85ea262e Mart*0620          ENDIF
                0621         ENDDO
255851fc5e Gael*0622 #endif
28e42a683a Gael*0623
c1d030d006 Gael*0624 #ifdef ALLOW_GENARR2D_CONTROL
9f85ea262e Mart*0625         DO num_var=1,maxCtrlArr2D
                0626          IF (no_genarr2d(num_var).GT.0. _d 0) THEN
                0627           IL  = ILNBLNK( xx_genarr2d_file(num_var) )
                0628           IL  = max (IL,15)
                0629           WRITE(ifc,'(2A,i2.0,A,2D22.15)')
c1d030d006 Gael*0630      &    xx_genarr2d_file(num_var)(1:IL),
                0631      &    ' (genarr2d ', num_var, ') = ',
                0632      &    f_genarr2d(num_var),
                0633      &    no_genarr2d(num_var)
9f85ea262e Mart*0634          ENDIF
                0635         ENDDO
c1d030d006 Gael*0636 #endif
                0637
                0638 #ifdef ALLOW_GENARR3D_CONTROL
9f85ea262e Mart*0639         DO num_var=1,maxCtrlArr3D
                0640          IF (no_genarr3d(num_var).GT.0. _d 0) THEN
                0641           IL  = ILNBLNK( xx_genarr3d_file(num_var) )
                0642           IL  = max (IL,15)
                0643           WRITE(ifc,'(2A,i2.0,A,2D22.15)')
c1d030d006 Gael*0644      &    xx_genarr3d_file(num_var)(1:IL),
                0645      &    ' (genarr3d ', num_var, ') = ',
                0646      &    f_genarr3d(num_var),
                0647      &    no_genarr3d(num_var)
9f85ea262e Mart*0648          ENDIF
                0649         ENDDO
c1d030d006 Gael*0650 #endif
                0651
5001c65f45 Patr*0652         close(ifc)
9f85ea262e Mart*0653 C     Do not ever write this cost function again to cfname
                0654         eccoWriteCostFunction = .FALSE.
951926fb9b Jean*0655
9f85ea262e Mart*0656        ELSE
                0657         WRITE(msgBuf,'(A,A)')
                0658      &           'Not writing cost function info to ', cfname(1:16)
                0659         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0660      &                      SQUEEZE_RIGHT, myThid )
                0661 C     eccoWriteCostFunction
                0662        ENDIF
                0663 C     MASTER_CPU_THREAD
8716d94355 Dimi*0664       ENDIF
5001c65f45 Patr*0665
                0666 #ifdef ECCO_VERBOSE
9f85ea262e Mart*0667       WRITE(msgBuf,'(a,D22.15)')
b16dd4be7d Gael*0668      &  ' cost_Final: final cost function = ',locfc
9f85ea262e Mart*0669       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0670      &                    SQUEEZE_RIGHT, myThid )
9f85ea262e Mart*0671       WRITE(msgBuf,'(a)') ' '
                0672       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0673      &                    SQUEEZE_RIGHT, myThid )
9f85ea262e Mart*0674       WRITE(msgBuf,'(a)')
5001c65f45 Patr*0675      &  '             cost function evaluation finished.'
9f85ea262e Mart*0676       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0677      &                    SQUEEZE_RIGHT, myThid )
9f85ea262e Mart*0678       WRITE(msgBuf,'(a)') ' '
                0679       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0680      &                    SQUEEZE_RIGHT, myThid )
5001c65f45 Patr*0681 #endif
                0682
9f85ea262e Mart*0683       RETURN
                0684       END