Back to home page

MITgcm
 
 

    

File indexing completed on 2024-03-02 06:10:26 UTC

view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
6805a315c1 Gael*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
5001c65f45 Patr*0005 
9f5240b52a Jean*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 
                0018       implicit none
                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 
9f5240b52a Jean*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 
                0058       integer bi,bj
                0059       integer ifc
9f5240b52a Jean*0060       integer num_var
5001c65f45 Patr*0061 
960ed3a8f0 Gael*0062 #ifndef ALLOW_PROFILES
                0063       integer NFILESPROFMAX
                0064       parameter (NFILESPROFMAX=1)
                0065       integer NVARMAX
                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
9f5240b52a Jean*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 
5001c65f45 Patr*0112       character*20 cfname
5891008914 Gael*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
6a770e0a24 Patr*0131       do num_file=1,NFILESPROFMAX
32e2f2e3d3 Gael*0132        do num_var=1,NVARMAX
6a770e0a24 Patr*0133         f_profiles(num_file,num_var)= 0. _d 0
                0134        enddo
                0135       enddo
6b2230d510 Ou W*0136       do num_var=1,NVARMAX
                0137        f_profiles_mean(num_var)= 0. _d 0
                0138       enddo
6e4c90fea3 Patr*0139 #endif
df3aa3e753 Gael*0140 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0141        do num_var=1,NGENCOST
                0142         f_gencost(num_var)= 0. _d 0
                0143        enddo
                0144 #endif
fa1c4e7ee9 Patr*0145 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*0146        do num_var=1,maxCtrlTim2D
e12363c291 Gael*0147         f_gentim2d(num_var)= 0. _d 0
28e42a683a Gael*0148        enddo
                0149 #endif
c1d030d006 Gael*0150 #ifdef ALLOW_GENARR2D_CONTROL
                0151        do num_var=1,maxCtrlArr2D
e12363c291 Gael*0152         f_genarr2d(num_var)= 0. _d 0
c1d030d006 Gael*0153        enddo
                0154 #endif
                0155 #ifdef ALLOW_GENARR3D_CONTROL
                0156        do num_var=1,maxCtrlArr3D
e12363c291 Gael*0157         f_genarr3d(num_var)= 0. _d 0
c1d030d006 Gael*0158        enddo
                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
6a770e0a24 Patr*0169       do num_file=1,NFILESPROFMAX
32e2f2e3d3 Gael*0170        do num_var=1,NVARMAX
6a770e0a24 Patr*0171         no_profiles(num_file,num_var)= 0. _d 0
                0172        enddo
                0173       enddo
6b2230d510 Ou W*0174       do num_var=1,NVARMAX
                0175        no_profiles_mean(num_var)= 0. _d 0
                0176       enddo
6e4c90fea3 Patr*0177 #endif
df3aa3e753 Gael*0178 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0179        do num_var=1,NGENCOST
                0180         no_gencost(num_var)= 0. _d 0
                0181        enddo
                0182 #endif
fa1c4e7ee9 Patr*0183 #ifdef ALLOW_GENTIM2D_CONTROL
2e500677e3 Jean*0184        do num_var=1,maxCtrlTim2D
e12363c291 Gael*0185         no_gentim2d(num_var)= 0. _d 0
28e42a683a Gael*0186        enddo
                0187 #endif
c1d030d006 Gael*0188 #ifdef ALLOW_GENARR2D_CONTROL
                0189        do num_var=1,maxCtrlArr2D
e12363c291 Gael*0190         no_genarr2d(num_var)= 0. _d 0
c1d030d006 Gael*0191        enddo
                0192 #endif
                0193 #ifdef ALLOW_GENARR3D_CONTROL
                0194        do num_var=1,maxCtrlArr3D
e12363c291 Gael*0195         no_genarr3d(num_var)= 0. _d 0
c1d030d006 Gael*0196        enddo
                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)
c509d7e04a Gael*0204           tile_fc(bi,bj) = tile_fc(bi,bj)
                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
                0214       do num_file=1,NFILESPROFMAX
                0215        do num_var=1,NVARMAX
                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)
                0219        enddo
                0220       enddo
6b2230d510 Ou W*0221       do num_var=1,NVARMAX
                0222          tile_fc(bi,bj) = tile_fc(bi,bj)
                0223      &           + mult_profiles_mean(num_var)
                0224      &           *objf_profiles_mean(num_var,bi,bj)
                0225       enddo
987caa4f1d Gael*0226 #endif
df3aa3e753 Gael*0227 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0228        do num_var=1,NGENCOST
576de6c5e5 Jean*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)
df3aa3e753 Gael*0232        enddo
                0233 #endif
fa1c4e7ee9 Patr*0234 #ifdef ALLOW_GENTIM2D_CONTROL
2e500677e3 Jean*0235        do num_var=1,maxCtrlTim2D
576de6c5e5 Jean*0236           tile_fc(bi,bj) = tile_fc(bi,bj)
28e42a683a Gael*0237      &            + mult_gentim2d(num_var)
                0238      &            *objf_gentim2d(bi,bj,num_var)
                0239        enddo
                0240 #endif
c1d030d006 Gael*0241 #ifdef ALLOW_GENARR2D_CONTROL
                0242        do num_var=1,maxCtrlArr2D
                0243           tile_fc(bi,bj) = tile_fc(bi,bj)
                0244      &            + mult_genarr2d(num_var)
                0245      &            *objf_genarr2d(bi,bj,num_var)
                0246        enddo
                0247 #endif
                0248 #ifdef ALLOW_GENARR3D_CONTROL
                0249        do num_var=1,maxCtrlArr3D
                0250           tile_fc(bi,bj) = tile_fc(bi,bj)
                0251      &            + mult_genarr3d(num_var)
                0252      &            *objf_genarr3d(bi,bj,num_var)
                0253        enddo
                0254 #endif
5cce2b5d76 Gael*0255 
6b47d550f4 Mart*0256 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
3c2f65f67f 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
c509d7e04a Gael*0262           f_ageos  = f_ageos + objf_ageos(bi,bj)
f3622cd48b Matt*0263 # endif
c509d7e04a Gael*0264 #endif
6e4c90fea3 Patr*0265 #ifdef ALLOW_PROFILES
6a770e0a24 Patr*0266       do num_file=1,NFILESPROFMAX
32e2f2e3d3 Gael*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)
                0270        enddo
                0271       enddo
6b2230d510 Ou W*0272       do num_var=1,NVARMAX
                0273          f_profiles_mean(num_var)=f_profiles_mean(num_var)
                0274      &           +objf_profiles_mean(num_var,bi,bj)
                0275       enddo
6e4c90fea3 Patr*0276 #endif
df3aa3e753 Gael*0277 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0278        do num_var=1,NGENCOST
                0279           f_gencost(num_var)=f_gencost(num_var)
8c157ed454 Patr*0280      &            +objf_gencost(bi,bj,num_var)
df3aa3e753 Gael*0281        enddo
                0282 #endif
fa1c4e7ee9 Patr*0283 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*0284        do num_var=1,maxCtrlTim2D
                0285           f_gentim2d(num_var) = f_gentim2d(num_var)
                0286      &            +objf_gentim2d(bi,bj,num_var)
                0287        enddo
                0288 #endif
c1d030d006 Gael*0289 #ifdef ALLOW_GENARR2D_CONTROL
                0290        do num_var=1,maxCtrlArr2D
                0291           f_genarr2d(num_var) = f_genarr2d(num_var)
                0292      &            +objf_genarr2d(bi,bj,num_var)
                0293        enddo
                0294 #endif
                0295 #ifdef ALLOW_GENARR3D_CONTROL
                0296        do num_var=1,maxCtrlArr3D
                0297           f_genarr3d(num_var) = f_genarr3d(num_var)
                0298      &            +objf_genarr3d(bi,bj,num_var)
                0299        enddo
                0300 #endif
5cce2b5d76 Gael*0301 
6b47d550f4 Mart*0302 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
1d2f68b543 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
                0308           no_ageos = no_ageos + num_ageos(bi,bj)
                0309 # endif
c509d7e04a Gael*0310 #endif
6e4c90fea3 Patr*0311 #ifdef ALLOW_PROFILES
6a770e0a24 Patr*0312       do num_file=1,NFILESPROFMAX
32e2f2e3d3 Gael*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)
                0316        enddo
                0317       enddo
6b2230d510 Ou W*0318       do num_var=1,NVARMAX
                0319          no_profiles_mean(num_var)=no_profiles_mean(num_var)
                0320      &           +num_profiles_mean(num_var,bi,bj)
                0321       enddo
6e4c90fea3 Patr*0322 #endif
df3aa3e753 Gael*0323 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0324        do num_var=1,NGENCOST
                0325           no_gencost(num_var)=no_gencost(num_var)
8c157ed454 Patr*0326      &            +num_gencost(bi,bj,num_var)
df3aa3e753 Gael*0327        enddo
951926fb9b Jean*0328 #endif
fa1c4e7ee9 Patr*0329 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*0330        do num_var=1,maxCtrlTim2D
                0331           no_gentim2d(num_var) = no_gentim2d(num_var)
                0332      &            +num_gentim2d(bi,bj,num_var)
                0333        enddo
                0334 #endif
c1d030d006 Gael*0335 #ifdef ALLOW_GENARR2D_CONTROL
                0336        do num_var=1,maxCtrlArr2D
                0337           no_genarr2d(num_var) = no_genarr2d(num_var)
                0338      &            +num_genarr2d(bi,bj,num_var)
                0339        enddo
                0340 #endif
                0341 #ifdef ALLOW_GENARR3D_CONTROL
                0342        do num_var=1,maxCtrlArr3D
                0343           no_genarr3d(num_var) = no_genarr3d(num_var)
                0344      &            +num_genarr3d(bi,bj,num_var)
                0345        enddo
                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
6a770e0a24 Patr*0373       do num_file=1,NFILESPROFMAX
32e2f2e3d3 Gael*0374        do num_var=1,NVARMAX
6637358eea Jean*0375         _GLOBAL_SUM_RL(f_profiles(num_file,num_var), myThid )
6a770e0a24 Patr*0376        enddo
                0377       enddo
6b2230d510 Ou W*0378       do num_var=1,NVARMAX
                0379        _GLOBAL_SUM_RL(f_profiles_mean(num_var), myThid )
                0380       enddo
6e4c90fea3 Patr*0381 #endif
df3aa3e753 Gael*0382 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0383        do num_var=1,NGENCOST
6637358eea Jean*0384         _GLOBAL_SUM_RL(f_gencost(num_var), myThid )
df3aa3e753 Gael*0385        enddo
951926fb9b Jean*0386 #endif
fa1c4e7ee9 Patr*0387 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*0388        do num_var=1,maxCtrlTim2D
                0389         _GLOBAL_SUM_RL(f_gentim2d(num_var), myThid )
                0390        enddo
                0391 #endif
c1d030d006 Gael*0392 #ifdef ALLOW_GENARR2D_CONTROL
                0393        do num_var=1,maxCtrlArr2D
                0394         _GLOBAL_SUM_RL(f_genarr2d(num_var), myThid )
                0395        enddo
                0396 #endif
                0397 #ifdef ALLOW_GENARR3D_CONTROL
                0398        do num_var=1,maxCtrlArr3D
                0399         _GLOBAL_SUM_RL(f_genarr3d(num_var), myThid )
                0400        enddo
                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
6a770e0a24 Patr*0413       do num_file=1,NFILESPROFMAX
32e2f2e3d3 Gael*0414        do num_var=1,NVARMAX
6637358eea Jean*0415         _GLOBAL_SUM_RL(no_profiles(num_file,num_var), myThid )
6a770e0a24 Patr*0416        enddo
                0417       enddo
6b2230d510 Ou W*0418       do num_var=1,NVARMAX
                0419        _GLOBAL_SUM_RL(no_profiles_mean(num_var), myThid )
                0420       enddo
6e4c90fea3 Patr*0421 #endif
df3aa3e753 Gael*0422 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0423        do num_var=1,NGENCOST
6637358eea Jean*0424         _GLOBAL_SUM_RL(no_gencost(num_var), myThid )
df3aa3e753 Gael*0425        enddo
951926fb9b Jean*0426 #endif
fa1c4e7ee9 Patr*0427 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*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
                0433        do num_var=1,maxCtrlArr2D
                0434         _GLOBAL_SUM_RL(no_genarr2d(num_var), myThid )
                0435        enddo
                0436 #endif
                0437 #ifdef ALLOW_GENARR3D_CONTROL
                0438        do num_var=1,maxCtrlArr3D
                0439         _GLOBAL_SUM_RL(no_genarr3d(num_var), myThid )
                0440        enddo
                0441 #endif
69a6648502 Patr*0442 
6b47d550f4 Mart*0443 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
c509d7e04a Gael*0444       write(standardmessageunit,'(A,D22.15)')
                0445      &     ' --> f_obcsn   =',f_obcsn
                0446       write(standardmessageunit,'(A,D22.15)')
                0447      &     ' --> f_obcss   =',f_obcss
                0448       write(standardmessageunit,'(A,D22.15)')
                0449      &     ' --> f_obcsw   =',f_obcsw
                0450       write(standardmessageunit,'(A,D22.15)')
                0451      &     ' --> f_obcse   =',f_obcse
6b47d550f4 Mart*0452 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
c509d7e04a Gael*0453       write(standardmessageunit,'(A,D22.15)')
                0454      &     ' --> f_ageos   =',f_ageos
f3622cd48b Matt*0455 # endif
c509d7e04a Gael*0456 #endif
6e4c90fea3 Patr*0457 #ifdef ALLOW_PROFILES
aa7751ee3b Gael*0458       if (usePROFILES) then
6a770e0a24 Patr*0459       do num_file=1,NFILESPROFMAX
32e2f2e3d3 Gael*0460        do num_var=1,NVARMAX
aa7751ee3b Gael*0461         if ( no_profiles(num_file,num_var).GT.zeroRL ) then
5891008914 Gael*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
5891008914 Gael*0465          call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0466      &                       SQUEEZE_RIGHT, myThid )
6a770e0a24 Patr*0467         endif
                0468        enddo
                0469       enddo
6b2230d510 Ou W*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)')
                0473      &     ' --> f_profiles_mean =',f_profiles_mean(num_var),
                0474      &      num_var
                0475          call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0476      &                       SQUEEZE_RIGHT, myThid )
6b2230d510 Ou W*0477         endif
                0478       enddo
aa7751ee3b Gael*0479       endif
6e4c90fea3 Patr*0480 #endif
df3aa3e753 Gael*0481 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0482        do num_var=1,NGENCOST
                0483         if (no_gencost(num_var).GT.0) then
5891008914 Gael*0484          write(msgBuf,'(A,D22.15,i2.0)')
df3aa3e753 Gael*0485      &     ' --> f_gencost =',f_gencost(num_var),
                0486      &      num_var
5891008914 Gael*0487          call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0488      &                       SQUEEZE_RIGHT, myThid )
df3aa3e753 Gael*0489         endif
                0490        enddo
951926fb9b Jean*0491 #endif
fa1c4e7ee9 Patr*0492 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*0493        do num_var=1,maxCtrlTim2D
5cce2b5d76 Gael*0494         if (no_gentim2d(num_var).GT.0. _d 0) then
5891008914 Gael*0495          write(msgBuf,'(A,D22.15,i2.0)')
28e42a683a Gael*0496      &     ' --> f_gentim2d =',f_gentim2d(num_var),
                0497      &      num_var
5891008914 Gael*0498          call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0499      &                       SQUEEZE_RIGHT, myThid )
28e42a683a Gael*0500         endif
                0501        enddo
2e500677e3 Jean*0502 #endif
c1d030d006 Gael*0503 #ifdef ALLOW_GENARR2D_CONTROL
                0504        do num_var=1,maxCtrlArr2D
5cce2b5d76 Gael*0505         if (no_genarr2d(num_var).GT.0. _d 0) then
5891008914 Gael*0506          write(msgBuf,'(A,D22.15,i2.0)')
c1d030d006 Gael*0507      &     ' --> f_genarr2d =',f_genarr2d(num_var),
                0508      &      num_var
5891008914 Gael*0509          call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0510      &                       SQUEEZE_RIGHT, myThid )
c1d030d006 Gael*0511         endif
                0512        enddo
                0513 #endif
b67c96a546 Gael*0514 #ifdef ALLOW_GENARR3D_CONTROL
                0515        do num_var=1,maxCtrlArr3D
5cce2b5d76 Gael*0516         if (no_genarr3d(num_var).GT.0. _d 0) then
5891008914 Gael*0517          write(msgBuf,'(A,D22.15,i2.0)')
b67c96a546 Gael*0518      &     ' --> f_genarr3d =',f_genarr3d(num_var),
                0519      &      num_var
5891008914 Gael*0520          call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0521      &                       SQUEEZE_RIGHT, myThid )
b67c96a546 Gael*0522         endif
                0523        enddo
                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
                0530         fc = fc + glofc
                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 
516b7f051d Gael*0538         write(msgBuf,'(A,D22.15)')
b16dd4be7d Gael*0539      &           ' --> fc               =', locfc
516b7f051d Gael*0540         call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0541      &                      SQUEEZE_RIGHT, myThid )
951926fb9b Jean*0542 
101f75e5cd Gael*0543         write(cfname,'(A,i4.4)') 'costfunction',eccoiter
5001c65f45 Patr*0544         open(unit=ifc,file=cfname)
951926fb9b Jean*0545 
1fa8e77fb9 Gael*0546 #ifdef ALLOW_ECCO_OLD_FC_PRINT
                0547         write(ifc,*)
                0548 #else
951926fb9b Jean*0549         write(ifc,'(A,2D22.15)')
1fa8e77fb9 Gael*0550 #endif
b16dd4be7d Gael*0551      &       'fc =', locfc, 0.
6b47d550f4 Mart*0552 #if (defined ALLOW_CTRL && defined ALLOW_OBCS)
c509d7e04a Gael*0553         write(ifc,'(A,2D22.15)')
                0554      &       'f_obcsn =', f_obcsn, no_obcsn
                0555         write(ifc,'(A,2D22.15)')
                0556      &       'f_obcss =', f_obcss, no_obcss
                0557         write(ifc,'(A,2D22.15)')
                0558      &       'f_obcsw =', f_obcsw, no_obcsw
                0559         write(ifc,'(A,2D22.15)')
                0560      &       'f_obcse =', f_obcse, no_obcse
6b47d550f4 Mart*0561 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
c509d7e04a Gael*0562         write(ifc,'(A,2D22.15)')
                0563      &       'f_ageos =', f_ageos, no_ageos
f3622cd48b Matt*0564 # endif
c509d7e04a Gael*0565 #endif
6e4c90fea3 Patr*0566 #ifdef ALLOW_PROFILES
aa7751ee3b Gael*0567       if (usePROFILES) then
6a770e0a24 Patr*0568       do num_file=1,NFILESPROFMAX
32e2f2e3d3 Gael*0569        do num_var=1,NVARMAX
aa7751ee3b Gael*0570         if ( no_profiles(num_file,num_var).GT.zeroRL ) then
6a770e0a24 Patr*0571          IL  = ILNBLNK( profilesfiles(num_file) )
179c62061b Gael*0572          IL  = max (IL,30)
                0573          write(ifc,'(4A,2D22.15)')
419d01728d Gael*0574      &    profilesfiles(num_file)(1:IL),' ',
                0575      &    prof_names(num_file,num_var), ' = ',
951926fb9b Jean*0576      &    f_profiles(num_file,num_var),
6a770e0a24 Patr*0577      &    no_profiles(num_file,num_var)
                0578         endif
                0579        enddo
                0580       enddo
6b2230d510 Ou W*0581       do num_var=1,NVARMAX
                0582         if ( no_profiles_mean(num_var).GT.zeroRL ) then
                0583          write(ifc,'(3A,2D22.15)')
                0584      &    'profile_mean ',
                0585      &    prof_names(1,num_var), ' = ',
                0586      &    f_profiles_mean(num_var),
                0587      &    no_profiles_mean(num_var)
                0588         endif
                0589       enddo
aa7751ee3b Gael*0590       endif
6e4c90fea3 Patr*0591 #endif
df3aa3e753 Gael*0592 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0593        do num_var=1,NGENCOST
                0594         if (no_gencost(num_var).GT.0) then
1fa8e77fb9 Gael*0595          IL  = ILNBLNK( gencost_name(num_var) )
179c62061b Gael*0596          IL  = max (IL,15)
d181f9168b Gael*0597          write(ifc,'(2A,i2.0,A,2D22.15)')
1fa8e77fb9 Gael*0598      &    gencost_name(num_var)(1:IL),' (gencost ', num_var, ') = ',
df3aa3e753 Gael*0599      &    f_gencost(num_var),
                0600      &    no_gencost(num_var)
                0601          endif
                0602        enddo
951926fb9b Jean*0603 #endif
c9dc83bee0 Patr*0604 
255851fc5e Gael*0605 #ifdef ALLOW_GENTIM2D_CONTROL
28e42a683a Gael*0606        do num_var=1,maxCtrlTim2D
5cce2b5d76 Gael*0607         if (no_gentim2d(num_var).GT.0. _d 0) then
28e42a683a Gael*0608          IL  = ILNBLNK( xx_gentim2d_file(num_var) )
                0609          IL  = max (IL,15)
                0610          write(ifc,'(2A,i2.0,A,2D22.15)')
                0611      &    xx_gentim2d_file(num_var)(1:IL),
                0612      &    ' (gentim2d ', num_var, ') = ',
                0613      &    f_gentim2d(num_var),
                0614      &    no_gentim2d(num_var)
                0615          endif
                0616        enddo
255851fc5e Gael*0617 #endif
28e42a683a Gael*0618 
c1d030d006 Gael*0619 #ifdef ALLOW_GENARR2D_CONTROL
                0620        do num_var=1,maxCtrlArr2D
5cce2b5d76 Gael*0621         if (no_genarr2d(num_var).GT.0. _d 0) then
c1d030d006 Gael*0622          IL  = ILNBLNK( xx_genarr2d_file(num_var) )
                0623          IL  = max (IL,15)
                0624          write(ifc,'(2A,i2.0,A,2D22.15)')
                0625      &    xx_genarr2d_file(num_var)(1:IL),
                0626      &    ' (genarr2d ', num_var, ') = ',
                0627      &    f_genarr2d(num_var),
                0628      &    no_genarr2d(num_var)
                0629          endif
                0630        enddo
                0631 #endif
                0632 
                0633 #ifdef ALLOW_GENARR3D_CONTROL
                0634        do num_var=1,maxCtrlArr3D
5cce2b5d76 Gael*0635         if (no_genarr3d(num_var).GT.0. _d 0) then
c1d030d006 Gael*0636          IL  = ILNBLNK( xx_genarr3d_file(num_var) )
                0637          IL  = max (IL,15)
                0638          write(ifc,'(2A,i2.0,A,2D22.15)')
                0639      &    xx_genarr3d_file(num_var)(1:IL),
                0640      &    ' (genarr3d ', num_var, ') = ',
                0641      &    f_genarr3d(num_var),
                0642      &    no_genarr3d(num_var)
                0643          endif
                0644        enddo
                0645 #endif
                0646 
5001c65f45 Patr*0647         close(ifc)
951926fb9b Jean*0648 
8716d94355 Dimi*0649       ENDIF
5001c65f45 Patr*0650 
                0651 #ifdef ECCO_VERBOSE
5891008914 Gael*0652       write(msgBuf,'(a,D22.15)')
b16dd4be7d Gael*0653      &  ' cost_Final: final cost function = ',locfc
5891008914 Gael*0654       call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0655      &                    SQUEEZE_RIGHT, myThid )
5891008914 Gael*0656       write(msgBuf,'(a)') ' '
                0657       call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0658      &                    SQUEEZE_RIGHT, myThid )
5891008914 Gael*0659       write(msgBuf,'(a)')
5001c65f45 Patr*0660      &  '             cost function evaluation finished.'
5891008914 Gael*0661       call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0662      &                    SQUEEZE_RIGHT, myThid )
5891008914 Gael*0663       write(msgBuf,'(a)') ' '
                0664       call print_message( msgBuf, standardmessageunit,
9f5240b52a Jean*0665      &                    SQUEEZE_RIGHT, myThid )
5001c65f45 Patr*0666 #endif
                0667 
2bf57b69ce Jean*0668       return
5001c65f45 Patr*0669       end
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!