File indexing completed on 2025-09-13 12:07:55 UTC
view on githubraw file Latest commit d4a066fa on 2025-09-10 18:05:35 UTC
13ce79fe94 Ivan*0001 #include "PROFILES_OPTIONS.h"
0002 #ifdef ALLOW_CTRL
0003 # include "CTRL_OPTIONS.h"
0004 #endif
0005
0006
0007
0008
0009
0010
0011 SUBROUTINE PROFILES_COST( myTime, myIter, myThid )
0012
0013
0014
0015
0016
0017
0018
0019
0020 IMPLICIT NONE
0021
0022 #include "SIZE.h"
0023 #include "EEPARAMS.h"
0024 #include "PARAMS.h"
0025 #include "GRID.h"
0026 #include "DYNVARS.h"
0027 #ifdef ALLOW_CAL
0028 # include "cal.h"
0029 #endif
0030 #ifdef ALLOW_PROFILES
0031 # include "PROFILES_SIZE.h"
0032 # include "profiles.h"
0033 # include "netcdf.inc"
0034 #endif
0035 #ifdef ALLOW_CTRL
0036 # include "OPTIMCYCLE.h"
0037 #endif
0038
0039
0040
0041
0042
0043 _RL myTime
0044 INTEGER myIter
0045 INTEGER myThid
0046
0047
0048 #ifdef ALLOW_PROFILES
0049
0050 INTEGER ILNBLNK
0051 EXTERNAL ILNBLNK
0052
0053
d4a066fa68 Jean*0054 INTEGER kLev, kProf
0055 INTEGER num_file, num_var, prof_num
0056 INTEGER bi, bj
13ce79fe94 Ivan*0057 INTEGER err
0058 _RL prof_traj1D(NLEVELMAX), prof_traj1D_mean(NLEVELMAX)
0059 _RL prof_data1D(NLEVELMAX), prof_weights1D(NLEVELMAX)
0060 CHARACTER*(MAX_LEN_MBUF) msgBuf
0061 #ifndef ALLOW_CTRL
0062 INTEGER optimcycle
0063 #endif
0064 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
d4a066fa68 Jean*0065 INTEGER kC, kCMax
13ce79fe94 Ivan*0066 INTEGER iL
0067 #endif
0068
0069
0070 _RL objf_prof_tile (nSx,nSy)
0071 _RL objf_prof_glo
0072 _RL num_prof_tile (nSx,nSy)
0073 _RL num_prof_glo
0074
0075 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0076 INTEGER iavgbin,ikzz
0077 INTEGER itmp
0078 INTEGER k2, ix9, iy9, ktmp
0079 INTEGER cunit
0080 CHARACTER*(MAX_LEN_FNAM) cfile
0081
0082 _RL prof_data1D_mean(NLEVELMAX)
0083 _RL prof_count1D(NLEVELMAX)
0084 _RL prof_weights1D_mean(NLEVELMAX)
0085 _RL recip_profiles_mean_indsamples(NVARMAX)
0086
0087 _RL tmpr6, tmpr7, tmpr8, tmpr9
0088 REAL*4 tmp99(NAVGBINMAX)
0089 _RL tmp11, tmp12, tmp_recip_count
0090 LOGICAL doglbsum
0091
0092 _RL objf_prof_mean_tile (nSx,nSy)
0093 _RL objf_prof_mean_glo
0094 _RL num_prof_mean_tile (nSx,nSy)
0095 _RL num_prof_mean_glo
0096 #endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0097
0098 #ifndef ALLOW_CTRL
0099 optimcycle = 0
0100 #endif
0101
0102 WRITE(msgBuf,'(A)') ' '
0103 CALL PRINT_MESSAGE( msgBuf,
0104 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0105 WRITE(msgBuf,'(A)') '== profiles_cost: begin =='
0106 CALL PRINT_MESSAGE( msgBuf,
0107 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0108
0109 _BEGIN_MASTER( myThid )
0110
0111 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0112 NAVGBIN = 0
0113
0114 DO iavgbin = 1, NAVGBINMAX
0115 avgbinglbsum(iavgbin) = 0
0116 DO kCMax = 1, NLEVELCOMBMAX
0117 DO num_var = 1, NVARMAX
0118 prof_traj1D_all_mean(iavgbin,kCMax,num_var) = 0. _d 0
0119 prof_data1D_all_mean(iavgbin,kCMax,num_var) = 0. _d 0
0120 prof_weights1D_all_mean(iavgbin,kCMax,num_var) = 0. _d 0
0121 prof_count1D_all_mean(iavgbin,kCMax,num_var) = 0. _d 0
0122 ENDDO
0123 ENDDO
0124 ENDDO
0125
0126 DO num_var = 1, NVARMAX
0127 recip_profiles_mean_indsamples(num_var) = 0. _d 0
0128 IF (profiles_mean_indsamples(num_var).GT.0. _d 0) THEN
0129 recip_profiles_mean_indsamples(num_var) = 1. _d 0 /
0130 & profiles_mean_indsamples(num_var)
0131 ENDIF
0132 ENDDO
0133
0134 DO bj = 1, nSy
0135 DO bi = 1, nSx
0136 DO num_file = 1, NFILESPROFMAX
0137 IF ( (ProfNo(num_file,bi,bj).GT.0) .AND.
0138 & (profilesDoNcOutput) ) THEN
0139
0140 err = NF_SYNC( fidforward(num_file,bi,bj) )
0141 CALL PROFILES_NF_ERROR( 'COST: NF_SYNC fidforward',
0142 & err,bi,bj,myThid )
0143
0144 ENDIF
0145
0146
0147 DO kLev = 1, NLEVELMAX
0148 prof_lev_comb(kLev,num_file,bi,bj) = -999
0149
0150 IF (kLev.LE.ProfDepthNo(num_file,bi,bj)) THEN
0151 DO kC = 1, NLEVELCOMB
0152 IF (prof_depth(num_file,kLev,bi,bj).EQ.
0153 & prof_depth_comb(kC,bi,bj) .AND.
0154 & prof_depth_comb(kC,bi,bj).GE.0. _d 0 .AND.
0155 & prof_lev_comb(kLev,num_file,bi,bj).EQ.-999) THEN
0156 prof_lev_comb(kLev,num_file,bi,bj) = kC
0157 ENDIF
0158 ENDDO
0159 ENDIF
0160
0161 ENDDO
0162
0163 DO num_var = 1, NVARMAX
0164 IF ( vec_quantities(num_file,num_var,bi,bj) ) THEN
0165 DO prof_num = 1, NOBSGLOB
0166 IF (prof_num.LE.ProfNo(num_file,bi,bj)) THEN
0167 DO kLev = 1, NLEVELMAX
0168 prof_traj1D(kLev) = 0.
0169 prof_data1D(kLev) = 0.
0170 prof_weights1D(kLev) = 0.
0171 ENDDO
0172
0173 ix9 = prof_interp_i(num_file,prof_num,1,bi,bj)
0174 iy9 = prof_interp_j(num_file,prof_num,1,bi,bj)
0175
0176 IF (prof_ind_avgbin(num_file,prof_num,bi,bj).GT.
0177 & NAVGBIN)
0178 & NAVGBIN =
0179 & prof_ind_avgbin(num_file,prof_num,bi,bj)
0180
0181 IF (ix9 .GE. 0. _d 0 .AND. iy9 .GE. 0. _d 0) THEN
0182 itmp = prof_ind_avgbin(num_file,prof_num,bi,bj)
0183 IF (avgbinglbsum(itmp).EQ.0)
0184 & avgbinglbsum(itmp) = 1
0185
0186 CALL ACTIVE_READ_PROFILE( num_file,
0187 & ProfDepthNo(num_file,bi,bj),prof_traj1D,
0188 & num_var,prof_num,.false.,optimcycle,
0189 & bi,bj,myThid,
0190 & profiles_dummy(num_file,num_var,bi,bj) )
0191
0192 CALL PROFILES_READVECTOR( num_file, num_var,
0193 & prof_ind_glob(num_file,prof_num,bi,bj),
0194 & ProfDepthNo(num_file,bi,bj),prof_data1D,
0195 & bi,bj,myThid )
0196
0197 CALL PROFILES_READVECTOR( num_file,-num_var,
0198 & prof_ind_glob(num_file,prof_num,bi,bj),
0199 & ProfDepthNo(num_file,bi,bj),prof_weights1D,
0200 & bi,bj,myThid )
0201
0202 DO kProf = 1, ProfDepthNo(num_file,bi,bj)
0203 IF ( prof_weights1D(kProf).GT.0. _d 0 .AND.
0204 & prof_mask1D_cur(kProf,bi,bj).NE.0. _d 0 )
0205 & THEN
0206 prof_traj1D_all_mean(itmp,
0207 & prof_lev_comb(kProf,num_file,bi,bj),
0208 & num_var)
0209 & = prof_traj1D_all_mean(itmp,
0210 & prof_lev_comb(kProf,num_file,bi,bj),
0211 & num_var)
0212 & + prof_traj1D(kProf)
0213
0214 prof_data1D_all_mean(itmp,
0215 & prof_lev_comb(kProf,num_file,bi,bj),
0216 & num_var)
0217 & = prof_data1D_all_mean(itmp,
0218 & prof_lev_comb(kProf,num_file,bi,bj),
0219 & num_var)
0220 & + prof_data1D(kProf)
0221
0222 prof_weights1D_all_mean(itmp,
0223 & prof_lev_comb(kProf,num_file,bi,bj),
0224 & num_var)
0225 & = prof_weights1D_all_mean(itmp,
0226 & prof_lev_comb(kProf,num_file,bi,bj),
0227 & num_var)
0228 & + 1. _d 0 / prof_weights1D(kProf)
0229
0230 prof_count1D_all_mean(itmp,
0231 & prof_lev_comb(kProf,num_file,bi,bj),
0232 & num_var)
0233 & = prof_count1D_all_mean(itmp,
0234 & prof_lev_comb(kProf,num_file,bi,bj),
0235 & num_var)
0236 & + 1. _d 0
0237
0238 ENDIF
0239 ENDDO
0240
0241 ENDIF
0242
0243 ENDIF
0244 ENDDO
0245 ENDIF
0246 ENDDO
0247
0248 ENDDO
0249 ENDDO
0250 ENDDO
0251
0252 NAVGBINRL = NAVGBIN
0253 _GLOBAL_MAX_RL( NAVGBINRL, myThid )
0254 NAVGBIN = NAVGBINRL
0255 DO iavgbin = 1, NAVGBIN
0256 tmpr6 = avgbinglbsum(iavgbin)
0257 _GLOBAL_SUM_RL(tmpr6, myThid)
0258 IF (tmpr6.GT.1.1) avgbinglbsum(iavgbin) = tmpr6
0259 ENDDO
0260
0261
0262 DO num_var = 1, NVARMAX
0263 doglbsum = .FALSE.
0264 DO bj = 1, nSy
0265 DO bi = 1, nSx
0266 DO num_file = 1, NFILESPROFMAX
0267 IF ( vec_quantities(num_file,num_var,bi,bj) )
0268 & doglbsum = .TRUE.
0269 ENDDO
0270 ENDDO
0271 ENDDO
0272
0273 IF (doglbsum) THEN
0274 DO iavgbin = 1, NAVGBIN
0275 DO kC = 1, NLEVELCOMB
0276 tmpr6 = prof_count1D_all_mean(iavgbin,kC,num_var)
0277 _GLOBAL_SUM_RL( tmpr6, myThid )
0278 prof_count1D_all_mean(iavgbin,kC,num_var) = tmpr6
0279
0280 tmpr9 = prof_weights1D_all_mean(iavgbin,kC,num_var)
0281 _GLOBAL_SUM_RL( tmpr9, myThid )
0282 prof_weights1D_all_mean(iavgbin,kC,num_var) = tmpr9
0283
0284 tmpr7 = prof_traj1D_all_mean(iavgbin,kC,num_var)
0285 _GLOBAL_SUM_RL( tmpr7, myThid )
0286 prof_traj1D_all_mean(iavgbin,kC,num_var) = tmpr7
0287
0288 tmpr8 = prof_data1D_all_mean(iavgbin,kC,num_var)
0289 _GLOBAL_SUM_RL( tmpr8, myThid )
0290 prof_data1D_all_mean(iavgbin,kC,num_var) = tmpr8
0291 ENDDO
0292 ENDDO
0293 ENDIF
0294 ENDDO
0295
0296
0297 DO iavgbin = 1, NAVGBIN
0298 DO kC = 1, NLEVELCOMB
0299 DO num_var = 1, NVARMAX
0300 tmp_recip_count = 0. _d 0
0301 IF (prof_count1D_all_mean(iavgbin,kC,num_var).GT.0) THEN
0302 tmp_recip_count = 1. _d 0 /
0303 & prof_count1D_all_mean(iavgbin,kC,num_var)
0304
0305 prof_traj1D_all_mean(iavgbin,kC,num_var)
0306 & = prof_traj1D_all_mean(iavgbin,kC,num_var)*
0307 & tmp_recip_count
0308
0309 prof_data1D_all_mean(iavgbin,kC,num_var)
0310 & = prof_data1D_all_mean(iavgbin,kC,num_var)*
0311 & tmp_recip_count
0312
0313 prof_weights1D_all_mean(iavgbin,kC,num_var)
0314 & = prof_weights1D_all_mean(iavgbin,kC,num_var)*
0315 & tmp_recip_count
0316
0317 ENDIF
0318 ENDDO
0319 ENDDO
0320 ENDDO
0321
0322 DO iavgbin = 1, NAVGBIN
0323 DO kC = 1, NLEVELCOMB
0324 DO num_var = 1, NVARMAX
0325 IF (prof_count1D_all_mean(iavgbin,kC,num_var).GT.0) THEN
0326
0327 tmp11 = prof_weights1D_all_mean(iavgbin,kC,num_var)
0328 & / prof_count1D_all_mean(iavgbin,kC,num_var)
0329
0330 tmp12 = prof_weights1D_all_mean(iavgbin,kC,num_var)
0331 & * recip_profiles_mean_indsamples(num_var)
0332
0333 prof_weights1D_all_mean(iavgbin,kC,num_var) =
0334 & MAX(tmp11, tmp12)
0335
0336
0337 IF (prof_weights1D_all_mean(iavgbin,kC,num_var)
0338 & .NE.0. _d 0)
0339 & prof_weights1D_all_mean(iavgbin,kC,num_var) =
0340 & 1. _d 0 / prof_weights1D_all_mean(iavgbin,kC,num_var)
0341 ENDIF
0342 ENDDO
0343 ENDDO
0344 ENDDO
0345
0346 IF (myProcId.EQ.0) THEN
0347 DO num_var = 1, NVARMAX
0348 iL = ILNBLNK( prof_names(1,num_var) )
0349
0350 WRITE(cfile,'(2A)') prof_names(1,num_var)(1:iL),
0351 & '_data_mean.data'
0352 CALL MDSFINDUNIT( cunit, myThid )
0353 OPEN( cunit, FILE = cfile, STATUS = 'unknown',
0354 & ACCESS = 'direct', RECL = NAVGBINMAX*4 )
0355
0356 DO kC = 1, NLEVELCOMB
0357 tmp99(1:NAVGBINMAX) =
0358 & prof_data1D_all_mean(1:NAVGBINMAX,kC,num_var)
0359 WRITE(cunit,REC = kC) tmp99
0360 ENDDO
0361 CLOSE( cunit )
0362
0363 WRITE(cfile,'(2A)') prof_names(1,num_var)(1:iL),
0364 & '_model_mean.data'
0365 CALL MDSFINDUNIT( cunit, myThid )
0366 OPEN( cunit, FILE = cfile, STATUS = 'unknown',
0367 & ACCESS = 'direct', RECL = NAVGBINMAX*4 )
0368
0369 DO kC = 1, NLEVELCOMB
0370 tmp99(1:NAVGBINMAX) =
0371 & prof_traj1D_all_mean(1:NAVGBINMAX,kC,num_var)
0372 WRITE(cunit,REC = kC) tmp99
0373 ENDDO
0374 CLOSE( cunit )
0375
0376 WRITE(cfile,'(2A)') prof_names(1,num_var)(1:iL),
0377 & '_weight_mean.data'
0378 CALL MDSFINDUNIT( cunit, myThid )
0379 OPEN( cunit, FILE = cfile, STATUS = 'unknown',
0380 & ACCESS = 'direct', RECL = NAVGBINMAX*4 )
0381
0382 DO kC = 1, NLEVELCOMB
0383 tmp99(1:NAVGBINMAX)=
0384 & prof_weights1D_all_mean(1:NAVGBINMAX,kC,num_var)
0385 WRITE(cunit,REC = kC) tmp99
0386 ENDDO
0387 CLOSE( cunit )
0388
0389 WRITE(cfile,'(2A)') prof_names(1,num_var)(1:iL),
0390 & '_count_mean.data'
0391 CALL MDSFINDUNIT( cunit, myThid )
0392 OPEN( cunit, FILE = cfile, STATUS = 'unknown',
0393 & ACCESS = 'direct', RECL = NAVGBINMAX*4 )
0394
0395 DO kC = 1, NLEVELCOMB
0396 tmp99(1:NAVGBINMAX) =
0397 & prof_count1D_all_mean(1:NAVGBINMAX,kC,num_var)
0398 WRITE(cunit,REC = kC) tmp99
0399 ENDDO
0400 CLOSE( cunit )
0401
0402 ENDDO
0403 ENDIF
0404 #endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0405
0406 DO bj = 1, nSy
0407 DO bi = 1, nSx
0408 DO num_file = 1, NFILESPROFMAX
0409 IF ( (ProfNo(num_file,bi,bj).GT.0) .AND.
0410 & (profilesDoNcOutput) ) THEN
0411
0412 err = NF_SYNC( fidforward(num_file,bi,bj) )
0413 CALL PROFILES_NF_ERROR( 'COST: NF_SYNC fidforward',
0414 & err,bi,bj,myThid )
0415
0416 ENDIF
0417
0418 DO prof_num = 1, NOBSGLOB
0419 IF (prof_num.LE.ProfNo(num_file,bi,bj)) THEN
0420 DO num_var = 1, NVARMAX
0421 DO kLev = 1, NLEVELMAX
0422 prof_traj1D(kLev) = 0.
0423 prof_traj1D_mean(kLev) = 0.
0424 prof_mask1D_cur(kLev,bi,bj) = 0.
0425 prof_data1D(kLev) = 0.
0426 prof_weights1D(kLev) = 0.
0427 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0428 prof_data1D_mean(kLev) = 0.
0429 prof_weights1D_mean(kLev) = 0.
0430 #endif
0431 ENDDO
0432
0433 IF ( vec_quantities(num_file,num_var,bi,bj) ) THEN
0434 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0435 itmp = prof_ind_avgbin(num_file,prof_num,bi,bj)
0436
0437 IF (itmp.GE. 0) THEN
0438 DO kProf = 1, ProfDepthNo(num_file,bi,bj)
0439 ktmp = prof_lev_comb(kProf,num_file,bi,bj)
0440
0441 prof_traj1D_mean(kProf) =
0442 & prof_traj1D_all_mean(itmp,ktmp,num_var)
0443
0444 prof_data1D_mean(kProf) =
0445 & prof_data1D_all_mean(itmp,ktmp,num_var)
0446
0447 prof_weights1D_mean(kProf) =
0448 & prof_weights1D_all_mean(itmp,ktmp,num_var)
0449
0450 ENDDO
0451 ENDIF
0452 #endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0453
0454 CALL ACTIVE_READ_PROFILE( num_file,
0455 & ProfDepthNo(num_file,bi,bj),prof_traj1D,
0456 & num_var,prof_num,.false.,optimcycle,
0457 & bi,bj,myThid,
0458 & profiles_dummy(num_file,num_var,bi,bj) )
0459
0460 CALL PROFILES_READVECTOR( num_file, num_var,
0461 & prof_ind_glob(num_file,prof_num,bi,bj),
0462 & ProfDepthNo(num_file,bi,bj),prof_data1D,
0463 & bi,bj,myThid )
0464
0465 CALL PROFILES_READVECTOR( num_file,-num_var,
0466 & prof_ind_glob(num_file,prof_num,bi,bj),
0467 & ProfDepthNo(num_file,bi,bj),prof_weights1D,
0468 & bi,bj,myThid )
0469
0470 DO kProf = 1, ProfDepthNo(num_file,bi,bj)
0471 IF (prof_weights1D(kProf).GT.0.
0472 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0473 & .AND. prof_data1D_mean(kProf).NE. 0. _d 0
0474 #endif
0475 & ) THEN
0476 objf_profiles(num_file,num_var,bi,bj) =
0477 & objf_profiles(num_file,num_var,bi,bj)
0478 & +prof_weights1D(kProf)
0479 & *prof_mask1D_cur(kProf,bi,bj)
0480 & *(prof_traj1D(kProf)-prof_data1D(kProf)
0481 & -prof_traj1D_mean(kProf)
0482 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0483 & +prof_data1D_mean(kProf)
0484 #endif
0485 & )
0486 & *(prof_traj1D(kProf)-prof_data1D(kProf)
0487 & -prof_traj1D_mean(kProf)
0488 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0489 & + prof_data1D_mean(kProf)
0490 #endif
0491 & )
0492
0493 num_profiles(num_file,num_var,bi,bj) =
0494 & num_profiles(num_file,num_var,bi,bj)
0495 & +prof_mask1D_cur(kProf,bi,bj)
0496
0497 ENDIF
0498 ENDDO
0499
0500 ENDIF
0501
0502 ENDDO
0503 ENDIF
0504 ENDDO
0505
0506 #ifdef ALLOW_DEBUG
0507 IF ( debugLevel .GE. debLevD ) THEN
0508 IF (ProfNo(num_file,bi,bj).GT.0) THEN
0509 DO num_var = 1, NVARMAX
0510 WRITE(msgBuf,'(A,4I9)') 'bi,bj,prof_num,num_var ',
0511 & bi,bj,ProfNo(num_file,bi,bj),num_var
0512 CALL PRINT_MESSAGE( msgBuf,
0513 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0514 WRITE(msgBuf,'(A,2D22.15)')
0515 & prof_names(num_file,num_var),
0516 & objf_profiles(num_file,num_var,bi,bj),
0517 & num_profiles(num_file,num_var,bi,bj)
0518 CALL PRINT_MESSAGE( msgBuf,
0519 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0520 ENDDO
0521 ENDIF
0522 ENDIF
0523 #endif /* ALLOW_DEBUG */
0524 ENDDO
0525
0526 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0527 DO num_var = 1, NVARMAX
0528 DO iavgbin = 1, NAVGBINMAX
0529 DO kC = 1, NLEVELCOMB
0530 prof_traj1D_mean(1) =
0531 & prof_traj1D_all_mean(iavgbin,kC,num_var)
0532 prof_data1D_mean(1) =
0533 & prof_data1D_all_mean(iavgbin,kC,num_var)
0534 prof_weights1D_mean(1) =
0535 & prof_weights1D_all_mean(iavgbin,kC,num_var)
0536
0537 IF (prof_weights1D_mean(1).GT.0. .AND.
0538 & prof_data1D_mean(1).NE. 0. _d 0 .AND.
0539 & prof_traj1D_mean(1).NE. 0. _d 0 .AND.
0540 & avgbinglbsum(iavgbin).GT.0 ) THEN
0541 IF (avgbinglbsum(iavgbin).EQ.1) THEN
0542 objf_profiles_mean(num_var,bi,bj) =
0543 & objf_profiles_mean(num_var,bi,bj)
0544 & + prof_weights1D_mean(1)
0545 & * (prof_traj1D_mean(1) - prof_data1D_mean(1))
0546 & * (prof_traj1D_mean(1) - prof_data1D_mean(1))
0547
0548 num_profiles_mean(num_var,bi,bj) =
0549 & num_profiles_mean(num_var,bi,bj) + 1. _d 0
0550
0551 ELSE
0552 objf_profiles_mean(num_var,bi,bj) =
0553 & objf_profiles_mean(num_var,bi,bj)
0554 & + prof_weights1D_mean(1)
0555 & * (prof_traj1D_mean(1) - prof_data1D_mean(1))
0556 & * (prof_traj1D_mean(1) - prof_data1D_mean(1))
0557 & / numberOfProcs
0558
0559 num_profiles_mean(num_var,bi,bj) =
0560 & num_profiles_mean(num_var,bi,bj) + 1. _d 0
0561 & /numberOfProcs
0562
0563 ENDIF
0564 ENDIF
0565
0566 ENDDO
0567 ENDDO
0568 ENDDO
0569
0570 # ifdef ALLOW_DEBUG
0571 IF ( debugLevel .GE. debLevD ) THEN
0572 DO num_var = 1, NVARMAX
0573 WRITE(msgBuf,'(A,4I9)') 'bi,bj,num_var ',bi,bj,num_var
0574 CALL PRINT_MESSAGE( msgBuf,
0575 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0576
0577 WRITE(msgBuf,'(A,A5,2D22.15)') prof_names(1,num_var),
0578 & '_mean',
0579 & objf_profiles_mean(num_var,bi,bj),
0580 & num_profiles_mean(num_var,bi,bj)
0581 CALL PRINT_MESSAGE( msgBuf,
0582 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0583
0584 ENDDO
0585 ENDIF
0586 # endif /* ALLOW_DEBUG */
0587
0588 #endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0589
0590 ENDDO
0591 ENDDO
0592
0593 _END_MASTER( myThid )
0594
0595
0596 DO num_file = 1, NFILESPROFMAX
0597 DO num_var = 1, NVARMAX
0598
0599 DO bj = myByLo(myThid), myByHi(myThid)
0600 DO bi = myBxLo(myThid), myBxHi(myThid)
0601 objf_prof_tile(bi,bj) =
0602 & objf_profiles(num_file,num_var,bi,bj)
0603
0604 num_prof_tile(bi,bj) =
0605 & num_profiles(num_file,num_var,bi,bj)
0606
0607 ENDDO
0608 ENDDO
0609
0610 CALL GLOBAL_SUM_TILE_RL( objf_prof_tile, objf_prof_glo,
0611 & myThid )
0612 CALL GLOBAL_SUM_TILE_RL( num_prof_tile, num_prof_glo,
0613 & myThid )
0614
0615 WRITE(msgBuf,'(2(A,I2),A,2D22.15)')
0616 & ' profiles_cost(',num_file,',',num_var,') = ',
0617 & objf_prof_glo,num_prof_glo
0618
0619 IF (num_prof_glo .GT. 0.)
0620 & CALL PRINT_MESSAGE( msgBuf,
0621 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0622
0623 ENDDO
0624 ENDDO
0625
0626 #ifdef ALLOW_PROFILES_SAMPLESPLIT_COST
0627 DO num_var = 1, NVARMAX
0628
0629 DO bj = myByLo(myThid), myByHi(myThid)
0630 DO bi = myBxLo(myThid), myBxHi(myThid)
0631 objf_prof_mean_tile(bi,bj) =
0632 & objf_profiles_mean(num_var,bi,bj)
0633
0634 num_prof_mean_tile(bi,bj) =
0635 & num_profiles_mean(num_var,bi,bj)
0636
0637 ENDDO
0638 ENDDO
0639
0640 CALL GLOBAL_SUM_TILE_RL( objf_prof_mean_tile,
0641 & objf_prof_mean_glo, myThid )
0642 CALL GLOBAL_SUM_TILE_RL( num_prof_mean_tile,
0643 & num_prof_mean_glo, myThid )
0644
0645 WRITE(msgBuf,'(A,I2,A,2D22.15)')
0646 & ' profiles_cost_mean(',num_var,') = ',
0647 & objf_prof_mean_glo,num_prof_mean_glo
0648
0649 IF (num_prof_mean_glo .GT. 0.)
0650 & CALL PRINT_MESSAGE( msgBuf,
0651 & standardMessageUnit, SQUEEZE_RIGHT, myThid )
0652
0653 ENDDO
0654 #endif /* ALLOW_PROFILES_SAMPLESPLIT_COST */
0655
0656 WRITE(msgBuf,'(A)') '== profiles_cost: end =='
0657 CALL PRINT_MESSAGE( msgBuf,
0658 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0659 WRITE(msgBuf,'(A)') ' '
0660 CALL PRINT_MESSAGE( msgBuf,
0661 & standardMessageUnit, SQUEEZE_RIGHT , myThid )
0662
0663 IF (prof_make_nc) THEN
0664 CALL PROFILES_MAKE_NCFILE( myThid )
0665 ENDIF
0666
0667 #endif /* ALLOW_PROFILES */
0668
0669 RETURN
0670 END
