File indexing completed on 2025-12-21 17:50:54 UTC
view on githubraw file Latest commit ad59256d on 2025-12-15 00:05:36 UTC
ad59256d7d aver*0001 #include "OBSFIT_OPTIONS.h"
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020 SUBROUTINE ACTIVE_READ_OBS_TILE_RL(
0021 I fid,
0022 I active_num_file,
0023 O active_var,
0024 I lAdInit,
0025 I irec,
0026 I irecglob,
0027 I theSimulationMode,
0028 I myOptimIter,
0029 I bi,
0030 I bj,
0031 I myThid )
0032
0033
0034
0035
0036
0037
0038
0039
0040 IMPLICIT NONE
0041
0042 #include "EEPARAMS.h"
0043 #include "SIZE.h"
0044 #include "PARAMS.h"
0045 #ifdef ALLOW_OBSFIT
0046 # include "netcdf.inc"
0047 # include "OBSFIT_SIZE.h"
0048 # include "OBSFIT.h"
0049 #endif
0050
0051
0052 INTEGER fid
0053 INTEGER active_num_file
0054 LOGICAL lAdInit
0055 INTEGER irec, irecglob, jrec
0056 INTEGER theSimulationMode
0057 INTEGER myOptimIter
0058 INTEGER bi, bj, myThid
0059
0060 _RL active_var
0061
0062
0063 #ifdef ALLOW_OBSFIT
0064
0065 INTEGER err, varID1, varID2
0066 INTEGER vec_start, vec_count
0067 _RL active_data_t
0068 _RL vec_tmp(2)
0069
0070 IF ( obsfitDoNcOutput ) THEN
0071
0072 vec_start = irec
0073 vec_count = 1
0074
0075 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0076 CALL OBSFIT_NF_ERROR(
0077 & 'ACTIVE_READ: NF_INQ_VARID obsfit_nameequi',
0078 & err,bi,bj,myThid )
0079
0080 ELSE
0081
0082 jrec = (irec-1)*2
0083
0084 ENDIF
0085
0086
0087
0088
0089
0090 IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0091
0092 _BEGIN_MASTER( myThid )
0093
0094 IF ( obsfitDoNcOutput ) THEN
0095
0096 err = NF_GET_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0097 & active_var )
0098 CALL OBSFIT_NF_ERROR(
0099 & 'ACTIVE_READ: NF_GET_VARA_DOUBLE active_var',
0100 & err,bi,bj,myThid )
0101
0102 err = NF_INQ_VARID( fid, obsfit_namemask, varID2 )
0103 CALL OBSFIT_NF_ERROR(
0104 & 'ACTIVE_READ: NF_INQ_VARID obsfit_namemask',
0105 & err,bi,bj,myThid )
0106
0107 err = NF_GET_VARA_DOUBLE( fid, varID2, vec_start, vec_count,
0108 & sample_modmask(bi,bj) )
0109 CALL OBSFIT_NF_ERROR(
0110 & 'ACTIVE_READ: NF_GET_VARA_DOUBLE sample_modmask',
0111 & err,bi,bj,myThid )
0112
0113 ELSE
0114
0115 READ( fid, rec=jrec+1 ) vec_tmp
0116 #ifdef _BYTESWAPIO
0117 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0118 #endif
0119 active_var = vec_tmp(1)
0120 READ( fid, rec=jrec+2 ) vec_tmp
0121 #ifdef _BYTESWAPIO
0122 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0123 #endif
0124 sample_modmask(bi,bj) = vec_tmp(1)
0125
0126 ENDIF
0127
0128 _END_MASTER( myThid )
0129
0130 ENDIF
0131
0132
0133
0134
0135
0136 IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0137
0138 _BEGIN_MASTER( myThid )
0139
0140 IF ( obsfitDoNcOutput) THEN
0141
0142 err = NF_GET_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0143 & active_data_t )
0144 CALL OBSFIT_NF_ERROR(
0145 & 'ACTIVE_READ: NF_GET_VARA_DOUBLE AD active_data_t',
0146 & err,bi,bj,myThid )
0147
0148
0149 active_data_t = active_data_t + active_var
0150
0151
0152 err = NF_PUT_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0153 & active_data_t )
0154 CALL OBSFIT_NF_ERROR(
0155 & 'ACTIVE_READ: NF_PUT_VARA_DOUBLE AD active_data_t',
0156 & err,bi,bj,myThid )
0157
0158
0159 active_var = 0. _d 0
0160
0161 ELSE
0162
0163 READ( fid, rec=jrec+1 ) vec_tmp
0164 #ifdef _BYTESWAPIO
0165 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0166 #endif
0167 active_data_t = vec_tmp(1)
0168
0169
0170 active_data_t = active_data_t + active_var
0171
0172
0173 vec_tmp(1) = active_data_t
0174 #ifdef _BYTESWAPIO
0175 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0176 #endif
0177 WRITE( fid, rec=jrec+1 ) vec_tmp
0178
0179
0180 active_var = 0. _d 0
0181
0182 ENDIF
0183
0184 _END_MASTER( myThid )
0185
0186 ENDIF
0187
0188
0189
0190
0191
0192 IF ( theSimulationMode .EQ. TANGENT_SIMULATION ) THEN
0193
0194 _BEGIN_MASTER( myThid )
0195
0196 IF ( obsfitDoNcOutput ) THEN
0197
0198 err = NF_GET_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0199 & active_var )
0200 CALL OBSFIT_NF_ERROR(
0201 & 'ACTIVE_READ: NF_GET_VARA_DOUBLE TL active_var',
0202 & err,bi,bj,myThid )
0203 ELSE
0204
0205 READ( fid, rec=jrec+1 ) vec_tmp
0206 #ifdef _BYTESWAPIO
0207 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0208 #endif
0209 active_var = vec_tmp(1)
0210
0211 ENDIF
0212
0213 _END_MASTER( myThid )
0214
0215 ENDIF
0216
0217 #endif /* ALLOW_OBSFIT */
0218
0219 RETURN
0220 END
0221
0222
0223
0224
0225
0226
0227
0228 SUBROUTINE ACTIVE_WRITE_OBS_TILE_RL(
0229 I fid,
0230 I active_num_file,
0231 I active_var,
0232 I irec,
0233 I irecglob,
0234 I theSimulationMode,
0235 I myOptimIter,
0236 I bi,
0237 I bj,
0238 I myThid )
0239
0240
0241
0242
0243
0244
0245
0246
0247 IMPLICIT NONE
0248
0249 #include "EEPARAMS.h"
0250 #include "SIZE.h"
0251 #include "PARAMS.h"
0252 #ifdef ALLOW_OBSFIT
0253 # include "netcdf.inc"
0254 # include "OBSFIT_SIZE.h"
0255 # include "OBSFIT.h"
0256 #endif
0257
0258
0259 INTEGER fid
0260 INTEGER active_num_file
0261 INTEGER irec, irecglob, jrec
0262 INTEGER theSimulationMode
0263 INTEGER myOptimIter
0264 INTEGER bi, bj, myThid
0265 _RL active_var
0266
0267 #ifdef ALLOW_OBSFIT
0268
0269 INTEGER err, varID1, varID2, varID3
0270 INTEGER vec_start, vec_count
0271 _RL active_data_t
0272 _RL vec_tmp(2)
0273
0274
0275 IF ( obsfitDoNcOutput ) THEN
0276
0277 vec_start = irec
0278 vec_count = 1
0279
0280 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0281 CALL OBSFIT_NF_ERROR(
0282 & 'ACTIVE_WRITE: NF_INQ_VARID obsfit_nameequi',
0283 & err,bi,bj,myThid )
0284 ELSE
0285
0286 jrec = (irec-1)*2
0287
0288 ENDIF
0289
0290
0291
0292
0293
0294 IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0295
0296 _BEGIN_MASTER( myThid )
0297
0298 IF ( obsfitDoNcOutput ) THEN
0299
0300 err = NF_PUT_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0301 & active_var )
0302 CALL OBSFIT_NF_ERROR(
0303 & 'ACTIVE_WRITE: NF_PUT_VARA_DOUBLE active_var',
0304 & err,bi,bj,myThid )
0305
0306 err = NF_INQ_VARID( fid, obsfit_namemask, varID2 )
0307 CALL OBSFIT_NF_ERROR(
0308 & 'ACTIVE_WRITE: NF_INQ_VARID obsfit_namemask',
0309 & err,bi,bj,myThid )
0310 err = NF_PUT_VARA_DOUBLE( fid, varID2, vec_start, vec_count,
0311 & sample_modmask(bi,bj) )
0312 CALL OBSFIT_NF_ERROR(
0313 & 'ACTIVE_WRITE: NF_PUT_VARA_DOUBLE sample_modmask',
0314 & err,bi,bj,myThid )
0315
0316 err = NF_INQ_VARID( fid, 'sample_ind_glob', varID3 )
0317 CALL OBSFIT_NF_ERROR(
0318 & 'ACTIVE_WRITE: NF_INQ_VARID sample_ind_glob',
0319 & err,bi,bj,myThid )
0320 err = NF_PUT_VAR1_INT( fid, varID3, vec_start, irecglob )
0321 CALL OBSFIT_NF_ERROR(
0322 & 'ACTIVE_WRITE: NF_PUT_VAR1_INT irecglob',
0323 & err,bi,bj,myThid )
0324
0325 ELSE
0326
0327 vec_tmp(1) = active_var
0328 vec_tmp(2) = irecglob
0329 #ifdef _BYTESWAPIO
0330 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0331 #endif
0332 WRITE( fid, rec= jrec+1 ) vec_tmp
0333 vec_tmp(1) = sample_modmask(bi,bj)
0334 vec_tmp(2) = irecglob
0335 #ifdef _BYTESWAPIO
0336 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0337 #endif
0338 WRITE( fid, rec= jrec+2 ) vec_tmp
0339
0340 ENDIF
0341
0342 _END_MASTER( myThid )
0343
0344 ENDIF
0345
0346
0347
0348
0349
0350 IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0351
0352 _BEGIN_MASTER( myThid )
0353
0354 IF ( obsfitDoNcOutput ) THEN
0355
0356 err = NF_GET_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0357 & active_data_t )
0358 CALL OBSFIT_NF_ERROR(
0359 & 'ACTIVE_WRITE: NF_GET_VARA_DOUBLE active_data_t',
0360 & err,bi,bj,myThid )
0361
0362
0363 active_var = active_var + active_data_t
0364 active_data_t = 0. _d 0
0365
0366 err = NF_PUT_VARA_DOUBLE(fid, varID1, vec_start, vec_count,
0367 & active_data_t )
0368 CALL OBSFIT_NF_ERROR(
0369 & 'ACTIVE_WRITE: NF_PUT_VARA_DOUBLE active_data_t',
0370 & err,bi,bj,myThid )
0371
0372 ELSE
0373
0374 READ( fid, rec=jrec+1 ) vec_tmp
0375 #ifdef _BYTESWAPIO
0376 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0377 #endif
0378 active_data_t = vec_tmp(1)
0379
0380
0381 active_var = active_var + active_data_t
0382 active_data_t = 0. _d 0
0383
0384
0385 vec_tmp(1) = active_data_t
0386 #ifdef _BYTESWAPIO
0387 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0388 #endif
0389 WRITE( fid, rec=jrec+1 ) vec_tmp
0390
0391 ENDIF
0392
0393 _END_MASTER( myThid )
0394
0395 ENDIF
0396
0397
0398
0399
0400
0401 IF ( theSimulationMode .EQ. TANGENT_SIMULATION ) THEN
0402
0403 _BEGIN_MASTER( myThid )
0404
0405 IF ( obsfitDoNcOutput ) THEN
0406
0407 err = NF_PUT_VARA_DOUBLE(fid, varID1, vec_start, vec_count,
0408 & active_var )
0409 CALL OBSFIT_NF_ERROR(
0410 & 'ACTIVE_WRITE: NF_PUT_VARA_DOUBLE TL active_var',
0411 & err,bi,bj,myThid )
0412 ELSE
0413
0414 vec_tmp(1) = active_var
0415 vec_tmp(2) = irec
0416 #ifdef _BYTESWAPIO
0417 CALL MDS_BYTESWAPR8( 2, vec_tmp )
0418 #endif
0419 WRITE( fid, rec=jrec+1 ) vec_tmp
0420
0421 ENDIF
0422
0423 _END_MASTER( myThid )
0424
0425 ENDIF
0426
0427 #endif /* ALLOW_OBSFIT */
0428
0429 RETURN
0430 END
0431
0432
0433
0434
0435
0436
0437
0438 SUBROUTINE ACTIVE_READ_OBS_GLOB_RL(
0439 I fid,
0440 I active_num_file,
0441 O active_var,
0442 O active_mask,
0443 I lAdInit,
0444 I irec,
0445 I irecglob,
0446 I theSimulationMode,
0447 I myOptimIter,
0448 I myThid )
0449
0450
0451
0452
0453
0454
0455
0456 IMPLICIT NONE
0457
0458 #include "EEPARAMS.h"
0459 #include "SIZE.h"
0460 #include "PARAMS.h"
0461 #ifdef ALLOW_OBSFIT
0462 # include "netcdf.inc"
0463 # include "OBSFIT_SIZE.h"
0464 # include "OBSFIT.h"
0465 #endif
0466
0467
0468 INTEGER fid
0469 INTEGER active_num_file
0470 INTEGER irec, irecglob
0471 INTEGER theSimulationMode
0472 INTEGER myOptimIter
0473 INTEGER myThid
0474 _RL active_var
0475 _RL active_mask
0476 logical lAdInit
0477
0478 #ifdef ALLOW_OBSFIT
0479
0480 INTEGER err, varID1, varID2
0481 INTEGER vec_start, vec_count
0482 _RL active_data_t
0483
0484
0485 vec_start = irecglob
0486 vec_count = 1
0487
0488
0489
0490
0491
0492 IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0493
0494 _BEGIN_MASTER( myThid )
0495
0496 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0497 err = NF_GET_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0498 & active_var )
0499
0500 err = NF_INQ_VARID( fid, obsfit_namemask, varID2 )
0501 err = NF_GET_VARA_DOUBLE( fid, varID2, vec_start, vec_count,
0502 & active_mask )
0503
0504 _END_MASTER( myThid )
0505
0506 ENDIF
0507
0508
0509
0510
0511
0512 IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0513
0514 _BEGIN_MASTER( myThid )
0515
0516 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0517 err = NF_GET_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0518 & active_data_t )
0519
0520
0521 active_data_t = active_data_t + active_var
0522
0523 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0524 err = NF_PUT_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0525 & active_data_t )
0526
0527
0528 active_var = 0. _d 0
0529
0530 _END_MASTER( myThid )
0531
0532 ENDIF
0533
0534
0535
0536
0537
0538 IF ( theSimulationMode .EQ. TANGENT_SIMULATION ) THEN
0539
0540 _BEGIN_MASTER( myThid )
0541
0542 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0543 err = NF_GET_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0544 & active_var )
0545
0546 _END_MASTER( myThid )
0547
0548 ENDIF
0549
0550 #endif /* ALLOW_OBSFIT */
0551
0552 RETURN
0553 END
0554
0555
0556
0557
0558
0559
0560
0561 SUBROUTINE ACTIVE_WRITE_OBS_GLOB_RL(
0562 I fid,
0563 I active_num_file,
0564 I active_var,
0565 I active_mask,
0566 I irec,
0567 I irecglob,
0568 I theSimulationMode,
0569 I myOptimIter,
0570 I myThid )
0571
0572
0573
0574
0575
0576
0577
0578 IMPLICIT NONE
0579
0580 #include "EEPARAMS.h"
0581 #include "SIZE.h"
0582 #include "PARAMS.h"
0583 #ifdef ALLOW_OBSFIT
0584 # include "netcdf.inc"
0585 # include "OBSFIT_SIZE.h"
0586 # include "OBSFIT.h"
0587 #endif
0588
0589
0590 INTEGER fid
0591 INTEGER active_num_file
0592 INTEGER irec, irecglob
0593 INTEGER theSimulationMode
0594 INTEGER myOptimIter
0595 INTEGER myThid
0596 _RL active_var
0597 _RL active_mask
0598
0599 #ifdef ALLOW_OBSFIT
0600
0601 INTEGER err, varID1, varID2
0602 INTEGER vec_start, vec_count
0603 _RL active_data_t
0604
0605
0606 vec_start = irecglob
0607 vec_count = 1
0608
0609
0610
0611
0612
0613 IF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
0614
0615 _BEGIN_MASTER( myThid )
0616
0617 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0618 err = NF_PUT_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0619 & active_var )
0620
0621 err = NF_INQ_VARID( fid, obsfit_namemask, varID2 )
0622 err = NF_PUT_VARA_DOUBLE( fid, varID2, vec_start, vec_count,
0623 & active_mask )
0624
0625 _END_MASTER( myThid )
0626
0627 ENDIF
0628
0629
0630
0631
0632
0633 IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
0634
0635 _BEGIN_MASTER( myThid )
0636
0637
0638
0639 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0640 err = NF_GET_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0641 & active_data_t )
0642
0643
0644 active_var = active_var + active_data_t
0645 active_data_t = 0. _d 0
0646
0647
0648
0649
0650 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0651 err = NF_PUT_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0652 & active_data_t )
0653
0654 _END_MASTER( myThid )
0655
0656 ENDIF
0657
0658
0659
0660
0661
0662 IF ( theSimulationMode .EQ. TANGENT_SIMULATION ) THEN
0663
0664 _BEGIN_MASTER( myThid )
0665
0666 err = NF_INQ_VARID( fid, obsfit_nameequi, varID1 )
0667 err = NF_PUT_VARA_DOUBLE( fid, varID1, vec_start, vec_count,
0668 & active_var )
0669
0670 _END_MASTER( myThid )
0671
0672 ENDIF
0673
0674 #endif /* ALLOW_OBSFIT */
0675
0676 RETURN
0677 END
0678
0679