Back to home page

darwin3

 
 

    


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 C     obsfit_active_file_control.F:  Routines that handle the I/O of
                0003 C                                    active variables for adjoint
                0004 C                                    calculations
                0005 C
                0006 C     Routines
                0007 C     o  active_read_obs_tile_rl  - Read an active record from tiled file
                0008 C                                   fwd-mode only: including a mask
                0009 C     o  active_write_obs_tile_rl - Write an active record to tiled file
                0010 C                                   fwd-mode only: including a mask
                0011 C     o  active_read_obs_glob_rl  - Read an active record from global file
                0012 C                                   fwd-mode only: including a mask
                0013 C     o  active_write_obs_glob_rl - Write an active record to global file.
                0014 C                                   fwd-mode only: including a mask
                0015 
                0016 CBOP
                0017 C     !ROUTINE: ACTIVE_READ_OBS_TILE_RL
                0018 
                0019 C     !INTERFACE:
                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 C     !DESCRIPTION:
                0034 C     ==================================================================
                0035 C     | Read an active record from an ObsFit .equi. tiled file
                0036 C     | (can be netcdf or binary)
                0037 C     ==================================================================
                0038 
                0039 C     !USES:
                0040       IMPLICIT NONE
                0041 C     == Global variables ===
                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 C     !INPUT PARAMETERS:
                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 C     !IOUTPUT PARAMETERS:
                0060       _RL      active_var
                0061 CEOP
                0062 
                0063 #ifdef ALLOW_OBSFIT
                0064 C     !LOCAL VARIABLES:
                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 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0087 C     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
                0088 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0133 C     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
                0134 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C Add active_var from appropriate location to data
                0149         active_data_t = active_data_t + active_var
                0150 
                0151 C Store the result on disk
                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 C Set active_var to zero
                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 C Add active_var from appropriate location to data
                0170         active_data_t = active_data_t + active_var
                0171 
                0172 C Store the result on disk
                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 C Set active_var to zero
                0180         active_var = 0. _d 0
                0181 
                0182        ENDIF
                0183 
                0184        _END_MASTER( myThid )
                0185 
                0186       ENDIF
                0187 
                0188 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0189 C     >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
                0190 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C     =================================================================
                0223 
                0224 CBOP
                0225 C     !ROUTINE: ACTIVE_WRITE_OBS_TILE_RL
                0226 
                0227 C     !INTERFACE:
                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 C     !DESCRIPTION:
                0241 C     ==================================================================
                0242 C     | Write an active record to an ObsFit .equi. tiled file
                0243 C     | (can be netcdf or binary)
                0244 C     ==================================================================
                0245 
                0246 C     !USES:
                0247       IMPLICIT NONE
                0248 C     == Global variables ===
                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 C     !INPUT PARAMETERS:
                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 C     !LOCAL VARIABLES:
                0269       INTEGER  err, varID1, varID2, varID3
                0270       INTEGER  vec_start, vec_count
                0271       _RL      active_data_t
                0272       _RL      vec_tmp(2)
                0273 CEOP
                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 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0291 C     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
                0292 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0347 C     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
                0348 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C     Add active_var to data.
                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 C Add active_var from appropriate location to data.
                0381         active_var = active_var + active_data_t
                0382         active_data_t = 0. _d 0
                0383 
                0384 C Store the result on disk.
                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 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0398 C     >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
                0399 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C     ==================================================================
                0433 
                0434 CBOP
                0435 C     !ROUTINE: ACTIVE_READ_OBS_GLOB_RL
                0436 
                0437 C     !INTERFACE:
                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 C     !DESCRIPTION:
                0451 C     ==================================================================
                0452 C     | Read an active record from an ObsFit .equi. global file
                0453 C     ==================================================================
                0454 
                0455 C     !USES:
                0456       IMPLICIT NONE
                0457 C     == Global variables ===
                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 C     !INPUT PARAMETERS:
                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 C     !LOCAL VARIABLES:
                0480       INTEGER  err, varID1, varID2
                0481       INTEGER  vec_start, vec_count
                0482       _RL      active_data_t
                0483 CEOP
                0484 
                0485       vec_start = irecglob
                0486       vec_count = 1
                0487 
                0488 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0489 C     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
                0490 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0509 C     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
                0510 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C Add active_var from appropriate location to data
                0521        active_data_t = active_data_t + active_var
                0522 C Store the result on disk.
                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 C Set active_var to zero
                0528        active_var = 0. _d 0
                0529 
                0530        _END_MASTER( myThid )
                0531 
                0532       ENDIF
                0533 
                0534 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0535 C     >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
                0536 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C     =================================================================
                0556 
                0557 CBOP
                0558 C     !ROUTINE: ACTIVE_WRITE_OBS_GLOB_RL
                0559 
                0560 C     !INTERFACE:
                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 C     !DESCRIPTION:
                0573 C     ==================================================================
                0574 C     | Write an active record to an ObsFit .equi. global file
                0575 C     ==================================================================
                0576 
                0577 C     !USES:
                0578       IMPLICIT NONE
                0579 C     == Global variables ===
                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 C     !INPUT PARAMETERS:
                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 C     !LOCAL VARIABLES:
                0601       INTEGER  err, varID1, varID2
                0602       INTEGER  vec_start, vec_count
                0603       _RL      active_data_t
                0604 CEOP
                0605 
                0606       vec_start = irecglob
                0607       vec_count = 1
                0608 
                0609 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0610 C     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
                0611 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0630 C     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
                0631 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0632 
                0633       IF ( theSimulationMode .EQ. REVERSE_SIMULATION ) THEN
                0634 
                0635        _BEGIN_MASTER( myThid )
                0636 
                0637 cav       vec_start = irec
                0638 cav       vec_count = 1
                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 C Add active_var to data.
                0644        active_var = active_var + active_data_t
                0645        active_data_t = 0. _d 0
                0646 
                0647 cav       vec_start = irecglob
                0648 cav       vec_count = 1
                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 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0659 C     >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
                0660 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                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 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|