pkg/profiles/active_file_control_profiles.F

367ecbf006 Gael*0001 #include "PROFILES_OPTIONS.h"
6a770e0a24 Patr*0002
c9bf163375 Ivan*0003 C     ==================================================================
                0004 C     active_file_control_profiles.F: Routines that handle the I/O of
                0005 C                                     active variables for the adjoint
                0006 C                                     calculations, related to netcdf
                0007 C                                     profiles data files
                0008 C
                0009 C     Routines
                0010 C     o  active_read_profile_rl  - Read an active 1 record from file
                0011 C                                  fwd-mode only: including a mask
                0012 C     o  active_write_profile_rl - Write nn active 1D record to file.
                0013 C                                  fwd-mode only: including a mask
                0014 C
                0015 C     started: Gael Forget 15-March-2006
                0016 C     ==================================================================
                0017
                0018 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0019 CBOP
                0020 C     !ROUTINE: ACTIVE_READ_PROFILE_RL
                0021 C     !INTERFACE:
                0022       SUBROUTINE ACTIVE_READ_PROFILE_RL(
6a770e0a24 Patr*0023      I                                fid,
71a5587721 Gael*0024      I                                active_num_file,
6a770e0a24 Patr*0025      I                                nactive_var,
                0026      O                                active_var,
                0027      I                                active_varnum,
                0028      I                                lAdInit,
                0029      I                                irec,
                0030      I                                irecglob,
                0031      I                                theSimulationMode,
                0032      I                                myOptimIter,
71a5587721 Gael*0033      I                                bi,
                0034      I                                bj,
c9bf163375 Ivan*0035      I                                myThid
6a770e0a24 Patr*0036      &                              )
                0037
c9bf163375 Ivan*0038 C     !DESCRIPTION:
                0039 C
                0040 C     Read an active 1D record from file. In forward-mode
                0041 C     (theSimulationMode = FORWARD_SIMULATION) also read a mask from
                0042 C     file.
6a770e0a24 Patr*0043
c9bf163375 Ivan*0044 C     !USES:
                0045       IMPLICIT NONE
6a770e0a24 Patr*0046
                0047 #include "EEPARAMS.h"
                0048 #include "SIZE.h"
                0049 #include "PARAMS.h"
6e4c90fea3 Patr*0050 #ifdef ALLOW_PROFILES
6328b73337 Gael*0051 # include "netcdf.inc"
                0052 # include "PROFILES_SIZE.h"
                0053 # include "profiles.h"
6e4c90fea3 Patr*0054 #endif
6a770e0a24 Patr*0055
c9bf163375 Ivan*0056 C     !INPUT PARAMETERS:
                0057       INTEGER fid
                0058       INTEGER active_num_file, nactive_var, active_varnum
                0059       LOGICAL lAdInit
                0060       INTEGER irec, irecglob
                0061       INTEGER theSimulationMode
                0062       INTEGER myOptimIter
                0063       INTEGER bi, bj, myThid
                0064 C     !OUTPUT PARAMETERS:
                0065       _RL     active_var(nactive_var)
6a770e0a24 Patr*0066
6e4c90fea3 Patr*0067 #ifdef ALLOW_PROFILES
c9bf163375 Ivan*0068 C     !LOCAL VARIABLES:
                0069       INTEGER err, varId , vec_start(2), vec_count(2)
                0070       INTEGER i, ivar, jrec
                0071       _RL     active_data_t(nactive_var)
                0072       REAL*8  vec_tmp(nactive_var+1)
                0073 CEOP
                0074
                0075       IF (profilesDoNcOutput) THEN
                0076        vec_start(1)=1
                0077        vec_start(2)=irec
                0078        vec_count(1)=nactive_var
                0079        vec_count(2)=1
                0080       ELSE
                0081        jrec = 2 * ( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
                0082      &      + prof_num_var_cur(active_num_file,active_varnum,bi,bj)
                0083      &      -1 )
                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 (profilesDoNcOutput) THEN
                0095
                0096         err = NF_INQ_VARID(fid,
                0097      &       prof_names(active_num_file,active_varnum), varId )
                0098         err = NF_GET_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0099      &       active_var)
                0100
                0101         err = NF_INQ_VARID(fid,prof_namesmask(active_num_file,
                0102      &       active_varnum), varId)
                0103         err = NF_GET_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0104      &       prof_mask1D_cur(1,bi,bj))
                0105
                0106        ELSE
                0107
                0108         READ(fid,rec=jrec+1) vec_tmp
6a770e0a24 Patr*0109 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0110         call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
ef53b829d7 Jean*0111 #endif
c9bf163375 Ivan*0112         DO ivar=1,nactive_var
                0113          active_var(ivar)=vec_tmp(ivar)
                0114         ENDDO
                0115         READ(fid,rec=jrec+2) vec_tmp
6a770e0a24 Patr*0116 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0117         CALL MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0118 #endif
c9bf163375 Ivan*0119         DO ivar=1,nactive_var
                0120          prof_mask1D_cur(ivar,bi,bj)=vec_tmp(ivar)
                0121         ENDDO
6a770e0a24 Patr*0122
c9bf163375 Ivan*0123        ENDIF
6a770e0a24 Patr*0124
c9bf163375 Ivan*0125        _END_MASTER( myThid )
6a770e0a24 Patr*0126
c9bf163375 Ivan*0127       ENDIF
6a770e0a24 Patr*0128
c9bf163375 Ivan*0129 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0130 C     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
                0131 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
6a770e0a24 Patr*0132
c9bf163375 Ivan*0133       IF (theSimulationMode .EQ. REVERSE_SIMULATION) THEN
6a770e0a24 Patr*0134
c9bf163375 Ivan*0135        _BEGIN_MASTER( myThid )
6a770e0a24 Patr*0136
c9bf163375 Ivan*0137        IF (profilesDoNcOutput) THEN
6a770e0a24 Patr*0138
c9bf163375 Ivan*0139         err = NF_INQ_VARID(fid,
                0140      &       prof_names(active_num_file,active_varnum), varId )
                0141         err = NF_GET_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0142      &       active_data_t)
6a770e0a24 Patr*0143
c9bf163375 Ivan*0144 C     Add active_var from appropriate location to data.
                0145         DO i = 1,nactive_var
                0146          active_data_t(i) = active_data_t(i) + active_var(i)
                0147         ENDDO
                0148 C     Store the result on disk.
6a770e0a24 Patr*0149
c9bf163375 Ivan*0150         err = NF_INQ_VARID(fid,
                0151      &       prof_names(active_num_file,active_varnum), varId )
                0152         err = NF_PUT_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0153      &       active_data_t)
6a770e0a24 Patr*0154
c9bf163375 Ivan*0155 C     Set active_var to zero.
                0156         DO i = 1,nactive_var
                0157          active_var(i) = 0. _d 0
                0158         ENDDO
6a770e0a24 Patr*0159
c9bf163375 Ivan*0160        ELSE
6a770e0a24 Patr*0161
c9bf163375 Ivan*0162         READ(fid,rec=jrec+1) vec_tmp
6a770e0a24 Patr*0163 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0164         call MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0165 #endif
c9bf163375 Ivan*0166         DO ivar=1,nactive_var
                0167          active_data_t(ivar)=vec_tmp(ivar)
                0168         ENDDO
                0169
                0170 C     Add active_var from appropriate location to data.
                0171         DO i = 1,nactive_var
                0172          active_data_t(i) = active_data_t(i) + active_var(i)
                0173         ENDDO
                0174
                0175 C     Store the result on disk.
                0176         DO ivar=1,nactive_var
                0177          vec_tmp(ivar)=active_data_t(ivar)
                0178         ENDDO
6a770e0a24 Patr*0179 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0180         CALL MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0181 #endif
c9bf163375 Ivan*0182         WRITE(fid,rec=jrec+1) vec_tmp
6a770e0a24 Patr*0183
c9bf163375 Ivan*0184 C     Set active_var to zero.
                0185         DO i = 1,nactive_var
                0186          active_var(i) = 0. _d 0
                0187         ENDDO
6a770e0a24 Patr*0188
c9bf163375 Ivan*0189        ENDIF
6a770e0a24 Patr*0190
c9bf163375 Ivan*0191        _END_MASTER( myThid )
6a770e0a24 Patr*0192
c9bf163375 Ivan*0193       ENDIF
6a770e0a24 Patr*0194
c9bf163375 Ivan*0195 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0196 C     >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
                0197 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
6a770e0a24 Patr*0198
c9bf163375 Ivan*0199       IF (theSimulationMode .EQ. TANGENT_SIMULATION) THEN
6a770e0a24 Patr*0200
c9bf163375 Ivan*0201        _BEGIN_MASTER( myThid )
6a770e0a24 Patr*0202
c9bf163375 Ivan*0203        IF (profilesDoNcOutput) THEN
6a770e0a24 Patr*0204
c9bf163375 Ivan*0205         err = NF_INQ_VARID(fid,
                0206      &       prof_names(active_num_file,active_varnum), varId )
                0207         err = NF_GET_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0208      &       active_var)
6a770e0a24 Patr*0209
c9bf163375 Ivan*0210        ELSE
6a770e0a24 Patr*0211
c9bf163375 Ivan*0212         READ(fid,rec=jrec+1) vec_tmp
6a770e0a24 Patr*0213 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0214         CALL MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0215 #endif
c9bf163375 Ivan*0216         DO ivar=1,nactive_var
                0217          active_var(ivar)=vec_tmp(ivar)
                0218         ENDDO
6a770e0a24 Patr*0219
c9bf163375 Ivan*0220        ENDIF
6a770e0a24 Patr*0221
c9bf163375 Ivan*0222        _END_MASTER( myThid )
6a770e0a24 Patr*0223
c9bf163375 Ivan*0224       ENDIF
6a770e0a24 Patr*0225
6e4c90fea3 Patr*0226 #endif /* ALLOW_PROFILES */
                0227
c9bf163375 Ivan*0228       RETURN
                0229       END
6a770e0a24 Patr*0230
c9bf163375 Ivan*0231 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0232 CBOP
                0233 C     !ROUTINE: ACTIVE_WRITE_PROFILE_RL
                0234 C     !INTERFACE:
                0235       SUBROUTINE ACTIVE_WRITE_PROFILE_RL(
71a5587721 Gael*0236      I                                 fid,
                0237      I                                 active_num_file,
6a770e0a24 Patr*0238      I                                 nactive_var,
                0239      I                                 active_var,
                0240      I                                 active_varnum,
                0241      I                                 irec,
                0242      I                                 irecglob,
                0243      I                                 theSimulationMode,
                0244      I                                 myOptimIter,
71a5587721 Gael*0245      I                                 bi,
                0246      I                                 bj,
c9bf163375 Ivan*0247      I                                 myThid
6a770e0a24 Patr*0248      &                               )
                0249
c9bf163375 Ivan*0250 C     !DESCRIPTION:
                0251 C
                0252 C     Write an active 1D record to file. In forward-mode
                0253 C     (theSimulationMode = FORWARD_SIMULATION) also write a mask to file.
6a770e0a24 Patr*0254
c9bf163375 Ivan*0255 C     !USES:
                0256       IMPLICIT NONE
6a770e0a24 Patr*0257 #include "EEPARAMS.h"
                0258 #include "SIZE.h"
                0259 #include "PARAMS.h"
6e4c90fea3 Patr*0260 #ifdef ALLOW_PROFILES
6328b73337 Gael*0261 # include "netcdf.inc"
                0262 # include "PROFILES_SIZE.h"
                0263 # include "profiles.h"
6e4c90fea3 Patr*0264 #endif
6a770e0a24 Patr*0265
c9bf163375 Ivan*0266 C     !INPUT PARAMETERS:
                0267       INTEGER fid
                0268       INTEGER active_num_file, nactive_var, active_varnum
                0269       INTEGER irec, irecglob
                0270       INTEGER theSimulationMode
                0271       INTEGER myOptimIter
                0272       INTEGER bi,bj,myThid
                0273       _RL     active_var(nactive_var)
                0274 C     !OUTPUT PARAMETERS:
6a770e0a24 Patr*0275
6e4c90fea3 Patr*0276 #ifdef ALLOW_PROFILES
c9bf163375 Ivan*0277 C     !LOCAL VARIABLES:
                0278       INTEGER err, varId , vec_start(2), vec_count(2)
                0279       INTEGER i, ivar, jrec
                0280       _RL     active_data_t(nactive_var)
                0281       real*8 vec_tmp(nactive_var+1)
                0282 CEOP
6a770e0a24 Patr*0283
c9bf163375 Ivan*0284       IF (profilesDoNcOutput) THEN
                0285        vec_start(1)=1
                0286        vec_start(2)=irec
                0287        vec_count(1)=nactive_var
                0288        vec_count(2)=1
                0289       ELSE
                0290        jrec = 2 * ( (irec-1)*prof_num_var_tot(active_num_file,bi,bj)
                0291      &      + prof_num_var_cur(active_num_file,active_varnum,bi,bj)
                0292      &      -1 )
                0293       ENDIF
6a770e0a24 Patr*0294
c9bf163375 Ivan*0295 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0296 C     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
                0297 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
6a770e0a24 Patr*0298
c9bf163375 Ivan*0299       IF (theSimulationMode .EQ. FORWARD_SIMULATION) THEN
6a770e0a24 Patr*0300
c9bf163375 Ivan*0301        _BEGIN_MASTER( myThid )
6a770e0a24 Patr*0302
c9bf163375 Ivan*0303        IF (profilesDoNcOutput) THEN
6a770e0a24 Patr*0304
c9bf163375 Ivan*0305         err = NF_INQ_VARID(fid,
                0306      &       prof_names(active_num_file,active_varnum), varId )
                0307         err = NF_PUT_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0308      &       active_var)
6a770e0a24 Patr*0309
c9bf163375 Ivan*0310         err = NF_INQ_VARID(fid,prof_namesmask(active_num_file,
                0311      &       active_varnum), varId )
                0312         err = NF_PUT_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0313      &       prof_mask1D_cur(1,bi,bj))
6a770e0a24 Patr*0314
c9bf163375 Ivan*0315         err = NF_INQ_VARID(fid,'prof_ind_glob', varId )
                0316         err = NF_PUT_VAR1_INT(fid, varId , vec_start(2),
                0317      &       irecglob)
6a770e0a24 Patr*0318
c9bf163375 Ivan*0319        ELSE
6a770e0a24 Patr*0320
c9bf163375 Ivan*0321         DO ivar=1,nactive_var
                0322          vec_tmp(ivar)=active_var(ivar)
                0323         ENDDO
                0324         vec_tmp(nactive_var+1)=irecglob
6a770e0a24 Patr*0325 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0326         CALL MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0327 #endif
c9bf163375 Ivan*0328         WRITE(fid,rec=jrec+1) vec_tmp
                0329         DO ivar=1,nactive_var
                0330          vec_tmp(ivar)=prof_mask1D_cur(ivar,bi,bj)
                0331         ENDDO
                0332         vec_tmp(nactive_var+1)=irecglob
6a770e0a24 Patr*0333 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0334         CALL MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0335 #endif
c9bf163375 Ivan*0336         WRITE(fid,rec=jrec+2) vec_tmp
6a770e0a24 Patr*0337
c9bf163375 Ivan*0338        ENDIF
6a770e0a24 Patr*0339
c9bf163375 Ivan*0340        _END_MASTER( myThid )
6a770e0a24 Patr*0341
c9bf163375 Ivan*0342       ENDIF
6a770e0a24 Patr*0343
c9bf163375 Ivan*0344 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0345 C     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
                0346 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
6a770e0a24 Patr*0347
c9bf163375 Ivan*0348       IF (theSimulationMode .EQ. REVERSE_SIMULATION) THEN
6a770e0a24 Patr*0349
c9bf163375 Ivan*0350        _BEGIN_MASTER( myThid )
6a770e0a24 Patr*0351
c9bf163375 Ivan*0352        IF (profilesDoNcOutput) THEN
6a770e0a24 Patr*0353
c9bf163375 Ivan*0354         err = NF_INQ_VARID(fid,
                0355      &       prof_names(active_num_file,active_varnum), varId )
                0356         err = NF_GET_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0357      &       active_data_t)
6a770e0a24 Patr*0358
c9bf163375 Ivan*0359 C     Add active_var to data.
                0360         DO i = 1,nactive_var
                0361          active_var(i) = active_var(i) + active_data_t(i)
                0362          active_data_t(i) = 0. _d 0
                0363         ENDDO
6a770e0a24 Patr*0364
c9bf163375 Ivan*0365         err = NF_INQ_VARID(fid,
                0366      &       prof_names(active_num_file,active_varnum), varId )
                0367         err = NF_PUT_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0368      &       active_data_t)
6a770e0a24 Patr*0369
c9bf163375 Ivan*0370        ELSE
6a770e0a24 Patr*0371
c9bf163375 Ivan*0372         READ(fid,rec=jrec+1) vec_tmp
6a770e0a24 Patr*0373 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0374         CALL MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0375 #endif
c9bf163375 Ivan*0376         DO ivar=1,nactive_var
                0377          active_data_t(ivar)=vec_tmp(ivar)
                0378         ENDDO
                0379
                0380 C       Add active_var from appropriate location to data.
                0381         DO i = 1,nactive_var
                0382          active_var(i) = active_var(i) + active_data_t(i)
                0383          active_data_t(i) = 0. _d 0
                0384         ENDDO
                0385
                0386 C       Store the result on disk.
                0387         DO ivar=1,nactive_var
                0388          vec_tmp(ivar)=active_data_t(ivar)
                0389         ENDDO
6a770e0a24 Patr*0390 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0391         CALL MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0392 #endif
c9bf163375 Ivan*0393         WRITE(fid,rec=jrec+1) vec_tmp
6a770e0a24 Patr*0394
c9bf163375 Ivan*0395        ENDIF
6a770e0a24 Patr*0396
c9bf163375 Ivan*0397        _END_MASTER( myThid )
6a770e0a24 Patr*0398
c9bf163375 Ivan*0399       ENDIF
6a770e0a24 Patr*0400
c9bf163375 Ivan*0401 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
                0402 C     >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
                0403 C     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
6a770e0a24 Patr*0404
c9bf163375 Ivan*0405       IF (theSimulationMode .EQ. TANGENT_SIMULATION) THEN
6a770e0a24 Patr*0406
c9bf163375 Ivan*0407        _BEGIN_MASTER( myThid )
6a770e0a24 Patr*0408
c9bf163375 Ivan*0409        IF (profilesDoNcOutput) THEN
6a770e0a24 Patr*0410
c9bf163375 Ivan*0411         err = NF_INQ_VARID(fid,
                0412      &       prof_names(active_num_file,active_varnum), varId )
                0413         err = NF_PUT_VARA_DOUBLE(fid, varId , vec_start, vec_count,
                0414      &       active_var)
6a770e0a24 Patr*0415
c9bf163375 Ivan*0416        ELSE
6a770e0a24 Patr*0417
c9bf163375 Ivan*0418         DO ivar=1,nactive_var
                0419          vec_tmp(ivar)=active_var(ivar)
                0420         ENDDO
                0421         vec_tmp(nactive_var+1)=irecglob
6a770e0a24 Patr*0422 #ifdef _BYTESWAPIO
c9bf163375 Ivan*0423         CALL MDS_BYTESWAPR8(nactive_var+1,vec_tmp)
6a770e0a24 Patr*0424 #endif
c9bf163375 Ivan*0425         WRITE(fid,rec=jrec+1) vec_tmp
6a770e0a24 Patr*0426
c9bf163375 Ivan*0427        ENDIF
6a770e0a24 Patr*0428
c9bf163375 Ivan*0429        _END_MASTER( myThid )
6a770e0a24 Patr*0430
c9bf163375 Ivan*0431       ENDIF
6a770e0a24 Patr*0432
6e4c90fea3 Patr*0433 #endif /* ALLOW_PROFILES */
                0434
c9bf163375 Ivan*0435       RETURN
                0436       END