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