pkg/ctrl/ctrl_map_ini_gentim2d.F

bb18285007 Gael*0001 #include "CTRL_OPTIONS.h"
c64ca7963b Gael*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
bb18285007 Gael*0005
                0006 CBOP
                0007 C     !ROUTINE: CTRL_MAP_INI_GENTIM2D
                0008 C     !INTERFACE:
                0009       SUBROUTINE CTRL_MAP_INI_GENTIM2D( myThid )
                0010
                0011 C     !DESCRIPTION: \bv
11c3150c71 Mart*0012 C     *================================================================
bb18285007 Gael*0013 C     | SUBROUTINE CTRL_MAP_INI_GENTIM2D
                0014 C     | Dimensionalize and preprocess time variable controls.
11c3150c71 Mart*0015 C     *================================================================
bb18285007 Gael*0016 C     \ev
                0017
                0018 C     !USES:
                0019       IMPLICIT NONE
                0020
                0021 C     == global variables ==
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #include "GRID.h"
                0026 #include "DYNVARS.h"
                0027 #include "FFIELDS.h"
                0028 #include "CTRL_SIZE.h"
4d72283393 Mart*0029 #include "CTRL.h"
65754df434 Mart*0030 #include "OPTIMCYCLE.h"
edcd27be69 Mart*0031 #include "CTRL_DUMMY.h"
bb18285007 Gael*0032 #include "CTRL_GENARR.h"
                0033 #ifdef ALLOW_PTRACERS
                0034 # include "PTRACERS_SIZE.h"
                0035 # include "PTRACERS_FIELDS.h"
                0036 #endif
7c50f07931 Mart*0037 #ifdef ALLOW_AUTODIFF_TAMC
4e4ad91a39 Jean*0038 # include "tamc.h"
c64ca7963b Gael*0039 #endif
bb18285007 Gael*0040
                0041 C     !INPUT/OUTPUT PARAMETERS:
                0042 C     == routine arguments ==
                0043       INTEGER myThid
                0044
                0045 #ifdef ALLOW_GENTIM2D_CONTROL
4e4ad91a39 Jean*0046 C     !FUNCTIONS:
                0047       INTEGER  ILNBLNK
                0048       EXTERNAL ILNBLNK
                0049
bb18285007 Gael*0050 C     !LOCAL VARIABLES:
                0051 C     == local variables ==
                0052       integer iarr
bd00ac563a Gael*0053       integer numsmo
b4daa24319 Shre*0054 C     Tapenade requires these 4 variables to be declared as arrays of
                0055 C     size maxCtrlTim2D. If declared as scalars, it does not store their
                0056 C     temporary values in the do loop during reverse pass.
96b006450c dngo*0057       CHARACTER*(MAX_LEN_FNAM) fnamegenIn(1:maxCtrlTim2D)
                0058       CHARACTER*(MAX_LEN_FNAM) fnamegenOut(1:maxCtrlTim2D)
                0059       CHARACTER*(MAX_LEN_FNAM) fnamegenTmp(1:maxCtrlTim2D)
                0060       CHARACTER*(MAX_LEN_FNAM) temp_genarr_fnamA
                0061       CHARACTER*(MAX_LEN_FNAM) temp_genarr_fnamB
bb18285007 Gael*0062       integer startrec
                0063       integer endrec
                0064       integer diffrec
b4daa24319 Shre*0065       integer iRec, jrec, kRec, lRec
bb18285007 Gael*0066       integer replicated_nrec
                0067       integer replicated_ntimes
                0068       logical doglobalread
                0069       logical ladinit
bd00ac563a Gael*0070       logical dowc01
                0071       logical dosmooth
f127287d37 Gael*0072       logical doscaling
9f5240b52a Jean*0073       _RL     xx_gen(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0074       _RS     mask2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
2fa7b4a87c Gael*0075 #ifdef ALLOW_ECCO
9f5240b52a Jean*0076       _RL     xx_gen_tmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
2fa7b4a87c Gael*0077       integer nyearsINT
11c3150c71 Mart*0078       _RL     recip_nyearsRL
2fa7b4a87c Gael*0079 #endif
bb18285007 Gael*0080       integer bi,bj
                0081       integer i,j,k2
                0082       integer ilgen
f9d7cbfb72 Ou W*0083       integer ilDir
bb18285007 Gael*0084 CEOP
                0085
b938a3c63b antn*0086 #ifdef ALLOW_DEBUG
                0087       IF (debugMode) CALL DEBUG_ENTER('CTRL_MAP_INI_GENTIM2D',myThid)
                0088 #endif /* ALLOW_DEBUG */
                0089
b4daa24319 Shre*0090 C--   Now, read the control vector.
bb18285007 Gael*0091       doglobalread = .false.
                0092       ladinit      = .false.
                0093
b4daa24319 Shre*0094 C     Find ctrlDir (w/o trailing blanks) length
f9d7cbfb72 Ou W*0095       ilDir = ilnblnk(ctrlDir)
                0096
7f445b4ca7 Gael*0097       DO bj=myByLo(myThid), myByHi(myThid)
                0098        DO bi=myBxLo(myThid), myBxHi(myThid)
                0099         DO j = 1-OLy,sNy+OLy
                0100          DO i = 1-OLx,sNx+OLx
                0101           xx_gen(i,j,bi,bj)=0. _d 0
11c3150c71 Mart*0102 #ifdef ALLOW_ECCO
                0103           xx_gen_tmp(i,j,bi,bj)=0. _d 0
                0104 #endif
7f445b4ca7 Gael*0105          ENDDO
                0106         ENDDO
                0107        ENDDO
                0108       ENDDO
                0109
bb18285007 Gael*0110 C--   generic 2D control variables
                0111       DO iarr = 1, maxCtrlTim2D
                0112
c64ca7963b Gael*0113        diffrec=0
                0114        startrec=0
                0115        endrec=0
                0116
bb18285007 Gael*0117        if (xx_gentim2d_weight(iarr).NE.' ') then
                0118
11c3150c71 Mart*0119         ilgen=ilnblnk( xx_gentim2d_file(iarr) )
96b006450c dngo*0120         temp_genarr_fnamA = xx_gentim2d_file(iarr)
                0121
172933ad7e Mart*0122         call ctrl_init_rec ( temp_genarr_fnamA(1:ilgen),
bb18285007 Gael*0123      I       xx_gentim2d_startdate1(iarr),
                0124      I       xx_gentim2d_startdate2(iarr),
                0125      I       xx_gentim2d_period(iarr),
                0126      I       1,
                0127      O       xx_gentim2d_startdate(1,iarr),
                0128      O       diffrec, startrec, endrec,
                0129      I       myThid )
                0130
b938a3c63b antn*0131 C From CTRL_INIT_REC one gets [start,end,diff]rec.
                0132 C Below, file xx_*.$iter.data is read in from records startrec to endrec,
                0133 C followed by a write to file xx_*.effective.$iter.data of record 1 to diffrec
                0134 C (see TAF-generated S/R ctrl_map_ini_gentim2dmd).
                0135
                0136 #ifdef ALLOW_CTRL_DEBUG
                0137 C Note: In the "md" (i.e. TAF modified) version of this fwd S/R, DEBUG calls and
                0138 C print statements are removed. See "Automatic Differentiation" chap. in the doc
                0139         write(*,*) 'AA: iarr,xx_gentim2d_startdate(1,iarr): ',
                0140      &              iarr,xx_gentim2d_startdate(1,iarr)
                0141 #endif
bd00ac563a Gael*0142         dosmooth=.false.
                0143         dowc01  = .false.
f127287d37 Gael*0144         doscaling=.true.
bd00ac563a Gael*0145
                0146         numsmo=1
bb18285007 Gael*0147         do k2 = 1, maxCtrlProc
11c3150c71 Mart*0148          if (xx_gentim2d_preproc(k2,iarr).EQ.'WC01') then
                0149           dowc01=.TRUE.
                0150           if (xx_gentim2d_preproc_i(k2,iarr).NE.0)
                0151      &         numsmo=xx_gentim2d_preproc_i(k2,iarr)
                0152          endif
                0153          if ((.NOT.dowc01).AND.
bd00ac563a Gael*0154      &        (xx_gentim2d_preproc(k2,iarr).EQ.'smooth')) then
11c3150c71 Mart*0155           dosmooth=.TRUE.
                0156           if (xx_gentim2d_preproc_i(k2,iarr).NE.0)
                0157      &         numsmo=xx_gentim2d_preproc_i(k2,iarr)
                0158          endif
                0159          if (xx_gentim2d_preproc(k2,iarr).EQ.'noscaling') then
                0160           doscaling=.FALSE.
                0161          endif
bb18285007 Gael*0162         enddo
                0163
96b006450c dngo*0164         write(temp_genarr_fnamB,'(2a,i10.10)')
                0165      &   ctrlDir(1:ilDir)//temp_genarr_fnamA(1:ilgen),'.',optimcycle
                0166         fnamegenIn(iarr) = temp_genarr_fnamB
                0167         write(temp_genarr_fnamB,'(2a,i10.10)')
                0168      &   ctrlDir(1:ilDir)//temp_genarr_fnamA(1:ilgen)
                0169      &   ,'.effective.',optimcycle
                0170         fnamegenOut(iarr) = temp_genarr_fnamB
                0171         write(temp_genarr_fnamB,'(2a,i10.10)')
                0172      &   ctrlDir(1:ilDir)//temp_genarr_fnamA(1:ilgen),'.tmp.',optimcycle
                0173         fnamegenTmp(iarr) = temp_genarr_fnamB
2fa7b4a87c Gael*0174
b4daa24319 Shre*0175 C--   docycle
2fa7b4a87c Gael*0176
32ce3e9e96 Mart*0177         replicated_nrec=diffrec
bb18285007 Gael*0178         replicated_ntimes=0
                0179         do k2 = 1, maxCtrlProc
4d1f3cfa6a Gael*0180          if (xx_gentim2d_preproc(k2,iarr).EQ.'docycle') then
11c3150c71 Mart*0181           if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
                0182            replicated_nrec=min(diffrec,xx_gentim2d_preproc_i(k2,iarr))
                0183            replicated_ntimes=
                0184      &          int(float(diffrec)/float(replicated_nrec))
                0185            if (replicated_ntimes*replicated_nrec.LT.diffrec)
                0186      &          replicated_ntimes=replicated_ntimes+1
                0187            if (replicated_ntimes*replicated_nrec.GT.diffrec)
                0188      &          replicated_ntimes=replicated_ntimes-1
                0189           endif
bb18285007 Gael*0190          endif
                0191         enddo
                0192
b938a3c63b antn*0193 #ifdef ALLOW_CTRL_DEBUG
                0194         write(*,'(A,1x,5I6)')
                0195      &   'AD:[start,end,diff]rec, replicated_[nrec,ntimes]: ',
                0196      &              startrec, endrec, diffrec,
                0197      &              replicated_nrec,replicated_ntimes
                0198 #endif
                0199         DO jrec = 1, replicated_ntimes+1
b4daa24319 Shre*0200          DO iRec = 1, replicated_nrec
4e4ad91a39 Jean*0201 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0202 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
c64ca7963b Gael*0203 #endif
b4daa24319 Shre*0204           kRec=replicated_nrec*(jrec-1)+iRec
                0205           lRec=startrec+iRec-1
                0206           IF (kRec.LE.endrec) THEN
b938a3c63b antn*0207 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0208            ilgen=ilnblnk( fnamegenIn(iarr) )
96b006450c dngo*0209            temp_genarr_fnamA = fnamegenIn(iarr)
b4daa24319 Shre*0210            write(*,*) 'AE: iarr,[i,j,k,l]rec: ',iarr,iRec,jrec,lRec
96b006450c dngo*0211            write(*,*) 'AF: fnamegenIn: ', temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0212 #endif
                0213 C fnamegenIn is xx_*.$iter.data, so the required access records starts at
b4daa24319 Shre*0214 C startrec+iRec-1 instead of iRec in the read call below. In adjoint mode, S/R
b938a3c63b antn*0215 C ADACTIVE_READ_XY reads adxx_*.$iter.data in reverse order, with required
                0216 C access from endrec back to startrec. This requires creating adxx_*.$iter.data
                0217 C file of size endrec, with valid gradients from records startrec to endrec
                0218 C but all zeros from 1 to startrec-1. See documentation:
                0219 C https://mitgcm.readthedocs.io/en/latest/ocean_state_est/ocean_state_est.html#ctrl-model-parameter-adjustment-capability
cbef0e5bf3 Gael*0220 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0221            CALL ACTIVE_READ_XY( fnamegenIn(iarr), xx_gen, lRec,
11c3150c71 Mart*0222      &          doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0223      &          myThid, xx_gentim2d_dummy(iarr) )
cbef0e5bf3 Gael*0224 #else
b4daa24319 Shre*0225            CALL READ_REC_XY_RL( fnamegenIn(iarr), xx_gen, lRec,
                0226      &                          1, myThid )
cbef0e5bf3 Gael*0227 #endif
b4daa24319 Shre*0228 C Here, we write record kRec (from 1 to diffrec) to file xx_*.effective.$iter
cbef0e5bf3 Gael*0229 #ifdef ALLOW_AUTODIFF
b938a3c63b antn*0230 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0231            ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0232            temp_genarr_fnamA = fnamegenOut(iarr)
b4daa24319 Shre*0233            write(*,*) 'AG: iarr,[i,j,k]rec: ',iarr,iRec,jrec,kRec
96b006450c dngo*0234            write(*,*) 'AH: fnamegenOut: ', temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0235 #endif
b4daa24319 Shre*0236            CALL ACTIVE_WRITE_XY( fnamegenOut(iarr), xx_gen, kRec,
                0237      &          optimcycle, myThid, xx_gentim2d_dummy(iarr) )
cbef0e5bf3 Gael*0238 #else
b4daa24319 Shre*0239            CALL WRITE_REC_XY_RL( fnamegenOut(iarr), xx_gen, kRec,
                0240      &          1 , myThid )
cbef0e5bf3 Gael*0241 #endif
11c3150c71 Mart*0242           ENDIF
                0243          ENDDO
cbef0e5bf3 Gael*0244         ENDDO
                0245
b4daa24319 Shre*0246 C--   rmcycle
2fa7b4a87c Gael*0247 #ifdef ALLOW_ECCO
b938a3c63b antn*0248         replicated_nrec=diffrec
2fa7b4a87c Gael*0249         replicated_ntimes=0
                0250         do k2 = 1, maxCtrlProc
                0251          if (xx_gentim2d_preproc(k2,iarr).EQ.'rmcycle') then
11c3150c71 Mart*0252           if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
b938a3c63b antn*0253            replicated_nrec=min(diffrec,xx_gentim2d_preproc_i(k2,iarr))
11c3150c71 Mart*0254            replicated_ntimes=
b938a3c63b antn*0255      &          int(float(diffrec)/float(replicated_nrec))
                0256            if (replicated_ntimes*replicated_nrec.LT.diffrec)
11c3150c71 Mart*0257      &          replicated_ntimes=replicated_ntimes+1
b938a3c63b antn*0258            if (replicated_ntimes*replicated_nrec.GT.diffrec)
11c3150c71 Mart*0259      &          replicated_ntimes=replicated_ntimes-1
                0260           endif
2fa7b4a87c Gael*0261          endif
                0262         enddo
                0263
b938a3c63b antn*0264 #ifdef ALLOW_CTRL_DEBUG
                0265         write(*,'(A,1x,5I6)')
                0266      &  'AI:[start,end,diff]rec, replicated_[nrec,ntimes]: ',
                0267      &      startrec,endrec,diffrec,replicated_nrec,replicated_ntimes
                0268 #endif
2fa7b4a87c Gael*0269
                0270         IF (replicated_ntimes.GT.0) THEN
                0271
b4daa24319 Shre*0272 C     create cyclic average
2fa7b4a87c Gael*0273
b938a3c63b antn*0274          nyearsINT=1+int((diffrec-replicated_nrec)/replicated_nrec)
11c3150c71 Mart*0275          recip_nyearsRL=1. _d 0/float(nyearsINT)
2fa7b4a87c Gael*0276
b938a3c63b antn*0277 #ifdef ALLOW_CTRL_DEBUG
                0278          write(*,*) 'AJ: nyears[INT,RL]: ',nyearsINT,recip_nyearsRL
                0279 #endif
2fa7b4a87c Gael*0280
b4daa24319 Shre*0281          DO iRec = 1, replicated_nrec
2fa7b4a87c Gael*0282
11c3150c71 Mart*0283           DO bj=myByLo(myThid),myByHi(myThid)
                0284            DO bi=myBxLo(myThid),myBxHi(myThid)
                0285             DO j = 1-OLy,sNy+OLy
                0286              DO i = 1-OLx,sNx+OLx
                0287               xx_gen(i,j,bi,bj) = zeroRL
                0288              ENDDO
                0289             ENDDO
                0290            ENDDO
                0291           ENDDO
2fa7b4a87c Gael*0292
11c3150c71 Mart*0293           DO jrec=1,nyearsINT
4e4ad91a39 Jean*0294 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0295 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
2fa7b4a87c Gael*0296 #endif
b4daa24319 Shre*0297            kRec=iRec+(jrec-1)*replicated_nrec
b938a3c63b antn*0298 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0299            write(*,*) 'AK: iarr,[i,j,k]rec: ',iarr,iRec,jrec,kRec
                0300            ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0301            temp_genarr_fnamA = fnamegenOut(iarr)
                0302            write(*,*) 'AL: fnamegenOut: ',temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0303 #endif
2fa7b4a87c Gael*0304 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0305            CALL ACTIVE_READ_XY( fnamegenOut(iarr), xx_gen_tmp, kRec,
11c3150c71 Mart*0306      &          doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0307      &          myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0308 #else
b4daa24319 Shre*0309            CALL READ_REC_XY_RL( fnamegenOut(iarr), xx_gen_tmp, kRec,
11c3150c71 Mart*0310      &          1, myThid )
2fa7b4a87c Gael*0311 #endif
11c3150c71 Mart*0312            DO bj=myByLo(myThid),myByHi(myThid)
                0313             DO bi=myBxLo(myThid),myBxHi(myThid)
                0314              DO j = 1,sNy
                0315               DO i = 1,sNx
                0316                xx_gen(i,j,bi,bj) = xx_gen(i,j,bi,bj)
                0317      &              +xx_gen_tmp(i,j,bi,bj)
                0318               ENDDO
                0319              ENDDO
                0320             ENDDO
                0321            ENDDO
                0322 C     end jrec
                0323           ENDDO
2fa7b4a87c Gael*0324
11c3150c71 Mart*0325           DO bj=myByLo(myThid),myByHi(myThid)
                0326            DO bi=myBxLo(myThid),myBxHi(myThid)
                0327             DO j = 1,sNy
                0328              DO i = 1,sNx
                0329               xx_gen(i,j,bi,bj) = xx_gen(i,j,bi,bj) * recip_nyearsRL
                0330              ENDDO
                0331             ENDDO
                0332            ENDDO
                0333           ENDDO
2fa7b4a87c Gael*0334
4e4ad91a39 Jean*0335 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0336 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
2fa7b4a87c Gael*0337 #endif
                0338
                0339 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0340           CALL ACTIVE_WRITE_XY( fnamegenTmp(iarr), xx_gen, iRec,
                0341      &         optimcycle, myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0342 #else
b4daa24319 Shre*0343           CALL WRITE_REC_XY_RL( fnamegenTmp(iarr), xx_gen, iRec,
                0344      &         1, myThid )
2fa7b4a87c Gael*0345 #endif
                0346
11c3150c71 Mart*0347          ENDDO
2fa7b4a87c Gael*0348
b4daa24319 Shre*0349 C     subtract cyclic average
11c3150c71 Mart*0350          DO jrec = 1, replicated_ntimes+1
b4daa24319 Shre*0351           DO iRec = 1, replicated_nrec
4e4ad91a39 Jean*0352 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0353 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
2fa7b4a87c Gael*0354 #endif
b4daa24319 Shre*0355            kRec=replicated_nrec*(jrec-1)+iRec
b938a3c63b antn*0356 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0357            write(*,*) 'AM: iarr,[i,j,k]rec: ',iarr,iRec,jrec,kRec
                0358            ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0359            temp_genarr_fnamA = fnamegenOut(iarr)
                0360            write(*,*) 'AN: fnamegenOut: ',temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0361 #endif
b4daa24319 Shre*0362            IF (kRec.LE.diffrec) THEN
2fa7b4a87c Gael*0363 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0364             CALL ACTIVE_READ_XY( fnamegenOut(iarr), xx_gen, kRec,
11c3150c71 Mart*0365      &           doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0366      &           myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0367 #else
b4daa24319 Shre*0368             CALL READ_REC_XY_RL( fnamegenOut(iarr), xx_gen, kRec,
                0369      &           1, myThid )
2fa7b4a87c Gael*0370 #endif
                0371 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0372             CALL ACTIVE_READ_XY( fnamegenTmp(iarr), xx_gen_tmp, iRec,
11c3150c71 Mart*0373      &           doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0374      &           myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0375 #else
b4daa24319 Shre*0376             CALL READ_REC_XY_RL( fnamegenTmp(iarr), xx_gen_tmp, iRec,
                0377      &           1, myThid )
2fa7b4a87c Gael*0378 #endif
11c3150c71 Mart*0379             DO bj=myByLo(myThid),myByHi(myThid)
                0380              DO bi=myBxLo(myThid),myBxHi(myThid)
                0381               DO j = 1,sNy
                0382                DO i = 1,sNx
                0383                 xx_gen(i,j,bi,bj)=xx_gen(i,j,bi,bj)
                0384      &              -xx_gen_tmp(i,j,bi,bj)
                0385                ENDDO
                0386               ENDDO
                0387              ENDDO
                0388             ENDDO
2fa7b4a87c Gael*0389 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0390             CALL ACTIVE_WRITE_XY( fnamegenOut(iarr), xx_gen, kRec,
9f5240b52a Jean*0391      &           optimcycle, myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0392 #else
b4daa24319 Shre*0393             CALL WRITE_REC_XY_RL( fnamegenOut(iarr), xx_gen, kRec,
                0394      &           1, myThid )
2fa7b4a87c Gael*0395 #endif
11c3150c71 Mart*0396            ENDIF
                0397           ENDDO
                0398          ENDDO
2fa7b4a87c Gael*0399
                0400         ENDIF
                0401 #endif /* ifdef ALLOW_ECCO */
                0402
b4daa24319 Shre*0403 C--   scaling and smoothing
cbef0e5bf3 Gael*0404
b938a3c63b antn*0405 C The access of records startrec to endrec in  xx_*.*iter was already
                0406 C done correctly above. From here, we read in xx_*.effective.$iter.data
                0407 C of size diffrec, so no more fix of record is needed from here on out.
b4daa24319 Shre*0408         DO iRec = 1, diffrec
4e4ad91a39 Jean*0409 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0410 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
cbef0e5bf3 Gael*0411 #endif
bb18285007 Gael*0412
b938a3c63b antn*0413 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0414          ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0415          temp_genarr_fnamA = fnamegenOut(iarr)
b4daa24319 Shre*0416          lRec=startrec+iRec-1
                0417          write(*,'(A,1x,A,1x,2I6)') 'AO: fnamegenOut, iRec,lRec ',
96b006450c dngo*0418      &       temp_genarr_fnamA(1:ilgen),iRec,lRec
b938a3c63b antn*0419 #endif
1c8d09be4c Gael*0420 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0421          CALL ACTIVE_READ_XY( fnamegenOut(iarr), xx_gen, iRec,
11c3150c71 Mart*0422      &        doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0423      &        myThid, xx_gentim2d_dummy(iarr) )
1c8d09be4c Gael*0424 #else
b4daa24319 Shre*0425          CALL READ_REC_XY_RL( fnamegenOut(iarr), xx_gen, iRec,
                0426      &        1, myThid )
1c8d09be4c Gael*0427 #endif
bb18285007 Gael*0428
bd00ac563a Gael*0429          jrec=1
b938a3c63b antn*0430 C Not clear which record to use for timevariable weights ;
                0431 C For now, just assumes records from startrec to endrec are available in file
bd00ac563a Gael*0432          do k2 = 1, maxCtrlProc
b938a3c63b antn*0433           if (xx_gentim2d_preproc(k2,iarr).EQ.'variaweight') then
b4daa24319 Shre*0434             jrec=startrec+iRec-1
b938a3c63b antn*0435           endif
bd00ac563a Gael*0436          enddo
c7de4e3cb2 antn*0437          CALL READ_REC_3D_RL( xx_gentim2d_weight(iarr), ctrlprec, 1,
9f5240b52a Jean*0438      &             wgentim2d(1-OLx,1-OLy,1,1,iarr), jrec, 1, myThid )
bb18285007 Gael*0439
11c3150c71 Mart*0440 C--   Get appropriate mask
                0441          call ctrl_get_mask2D(xx_gentim2d_file(iarr), mask2D, myThid)
7b8b86ab99 Timo*0442
bb18285007 Gael*0443 #ifdef ALLOW_SMOOTH
bd00ac563a Gael*0444          IF (useSMOOTH) THEN
9f5240b52a Jean*0445           IF (dowc01) call smooth_correl2d(xx_gen,mask2D,numsmo,myThid)
                0446           IF (dosmooth) call smooth2d(xx_gen,mask2D,numsmo,myThid)
bd00ac563a Gael*0447          ENDIF
                0448 #endif /* ALLOW_SMOOTH */
                0449
                0450          DO bj=myByLo(myThid), myByHi(myThid)
                0451           DO bi=myBxLo(myThid), myBxHi(myThid)
                0452            DO j = 1,sNy
                0453             DO i = 1,sNx
7b8b86ab99 Timo*0454              if ((mask2D(i,j,bi,bj).NE.0.).AND.
11c3150c71 Mart*0455      &            (wgentim2d(i,j,bi,bj,iarr).GT.0.)) then
                0456               IF (doscaling) then
                0457                xx_gen(i,j,bi,bj)=xx_gen(i,j,bi,bj)
                0458      &              /sqrt(wgentim2d(i,j,bi,bj,iarr))
                0459               ENDIF             ! IF (doscaling) then
f307bb5bdf An T*0460              else
11c3150c71 Mart*0461               xx_gen(i,j,bi,bj)=0. _d 0
f307bb5bdf An T*0462              endif
bb18285007 Gael*0463             ENDDO
                0464            ENDDO
bd00ac563a Gael*0465           ENDDO
                0466          ENDDO
bb18285007 Gael*0467
7b8b86ab99 Timo*0468          CALL CTRL_BOUND_2D(xx_gen,mask2D,
bd00ac563a Gael*0469      &        xx_gentim2d_bounds(1,iarr),myThid)
bb18285007 Gael*0470
bd00ac563a Gael*0471          CALL EXCH_XY_RL ( xx_gen , myThid )
1c8d09be4c Gael*0472
b938a3c63b antn*0473 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0474          ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0475          temp_genarr_fnamA = fnamegenOut(iarr)
b938a3c63b antn*0476          write(*,'(A,1x,I6,1x,A)')
96b006450c dngo*0477      &      'AQ: iRec,fnamegenOut: ',iRec,temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0478 #endif
1c8d09be4c Gael*0479 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0480          CALL ACTIVE_WRITE_XY( fnamegenOut(iarr), xx_gen, iRec,
                0481      &        optimcycle, myThid, xx_gentim2d_dummy(iarr) )
1c8d09be4c Gael*0482 #else
b4daa24319 Shre*0483          CALL WRITE_REC_XY_RL( fnamegenOut(iarr), xx_gen, iRec,
                0484      &        1, myThid )
1c8d09be4c Gael*0485 #endif
b4daa24319 Shre*0486 C--   end iRec loop
bb18285007 Gael*0487         ENDDO
                0488
                0489        endif
                0490
b4daa24319 Shre*0491 C--   end iarr loop
bb18285007 Gael*0492       ENDDO
                0493
b938a3c63b antn*0494 #ifdef ALLOW_DEBUG
                0495       IF (debugMode) CALL DEBUG_LEAVE('CTRL_MAP_INI_GENTIM2D',myThid)
                0496 #endif /* ALLOW_DEBUG */
bb18285007 Gael*0497 #endif /* ALLOW_GENTIM2D_CONTROL */
                0498
                0499       RETURN
                0500       END