Back to home page

MITgcm
 
 

    

File indexing completed on 2023-11-05 05:10:17 UTC

view on githubraw file Latest commit 65754df4 on 2023-11-04 17:55:24 UTC
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 
51342df11b Patr*0117 #ifndef ALLOW_OPENAD
bb18285007 Gael*0118        if (xx_gentim2d_weight(iarr).NE.' ') then
51342df11b Patr*0119 #endif
bb18285007 Gael*0120 
11c3150c71 Mart*0121         ilgen=ilnblnk( xx_gentim2d_file(iarr) )
96b006450c dngo*0122         temp_genarr_fnamA = xx_gentim2d_file(iarr)
                0123 
172933ad7e Mart*0124         call ctrl_init_rec ( temp_genarr_fnamA(1:ilgen),
bb18285007 Gael*0125      I       xx_gentim2d_startdate1(iarr),
                0126      I       xx_gentim2d_startdate2(iarr),
                0127      I       xx_gentim2d_period(iarr),
                0128      I       1,
                0129      O       xx_gentim2d_startdate(1,iarr),
                0130      O       diffrec, startrec, endrec,
                0131      I       myThid )
                0132 
b938a3c63b antn*0133 C From CTRL_INIT_REC one gets [start,end,diff]rec.
                0134 C Below, file xx_*.$iter.data is read in from records startrec to endrec,
                0135 C followed by a write to file xx_*.effective.$iter.data of record 1 to diffrec
                0136 C (see TAF-generated S/R ctrl_map_ini_gentim2dmd).
                0137 
                0138 #ifdef ALLOW_CTRL_DEBUG
                0139 C Note: In the "md" (i.e. TAF modified) version of this fwd S/R, DEBUG calls and
                0140 C print statements are removed. See "Automatic Differentiation" chap. in the doc
                0141         write(*,*) 'AA: iarr,xx_gentim2d_startdate(1,iarr): ',
                0142      &              iarr,xx_gentim2d_startdate(1,iarr)
                0143 #endif
bd00ac563a Gael*0144         dosmooth=.false.
                0145         dowc01  = .false.
f127287d37 Gael*0146         doscaling=.true.
bd00ac563a Gael*0147 
                0148         numsmo=1
bb18285007 Gael*0149         do k2 = 1, maxCtrlProc
11c3150c71 Mart*0150          if (xx_gentim2d_preproc(k2,iarr).EQ.'WC01') then
                0151           dowc01=.TRUE.
                0152           if (xx_gentim2d_preproc_i(k2,iarr).NE.0)
                0153      &         numsmo=xx_gentim2d_preproc_i(k2,iarr)
                0154          endif
                0155          if ((.NOT.dowc01).AND.
bd00ac563a Gael*0156      &        (xx_gentim2d_preproc(k2,iarr).EQ.'smooth')) then
11c3150c71 Mart*0157           dosmooth=.TRUE.
                0158           if (xx_gentim2d_preproc_i(k2,iarr).NE.0)
                0159      &         numsmo=xx_gentim2d_preproc_i(k2,iarr)
                0160          endif
                0161          if (xx_gentim2d_preproc(k2,iarr).EQ.'noscaling') then
                0162           doscaling=.FALSE.
                0163          endif
bb18285007 Gael*0164         enddo
                0165 
96b006450c dngo*0166         write(temp_genarr_fnamB,'(2a,i10.10)')
                0167      &   ctrlDir(1:ilDir)//temp_genarr_fnamA(1:ilgen),'.',optimcycle
                0168         fnamegenIn(iarr) = temp_genarr_fnamB
                0169         write(temp_genarr_fnamB,'(2a,i10.10)')
                0170      &   ctrlDir(1:ilDir)//temp_genarr_fnamA(1:ilgen)
                0171      &   ,'.effective.',optimcycle
                0172         fnamegenOut(iarr) = temp_genarr_fnamB
                0173         write(temp_genarr_fnamB,'(2a,i10.10)')
                0174      &   ctrlDir(1:ilDir)//temp_genarr_fnamA(1:ilgen),'.tmp.',optimcycle
                0175         fnamegenTmp(iarr) = temp_genarr_fnamB
2fa7b4a87c Gael*0176 
b4daa24319 Shre*0177 C--   docycle
2fa7b4a87c Gael*0178 
32ce3e9e96 Mart*0179         replicated_nrec=diffrec
bb18285007 Gael*0180         replicated_ntimes=0
                0181         do k2 = 1, maxCtrlProc
4d1f3cfa6a Gael*0182          if (xx_gentim2d_preproc(k2,iarr).EQ.'docycle') then
11c3150c71 Mart*0183           if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
                0184            replicated_nrec=min(diffrec,xx_gentim2d_preproc_i(k2,iarr))
                0185            replicated_ntimes=
                0186      &          int(float(diffrec)/float(replicated_nrec))
                0187            if (replicated_ntimes*replicated_nrec.LT.diffrec)
                0188      &          replicated_ntimes=replicated_ntimes+1
                0189            if (replicated_ntimes*replicated_nrec.GT.diffrec)
                0190      &          replicated_ntimes=replicated_ntimes-1
                0191           endif
bb18285007 Gael*0192          endif
                0193         enddo
                0194 
b938a3c63b antn*0195 #ifdef ALLOW_CTRL_DEBUG
                0196         write(*,'(A,1x,5I6)')
                0197      &   'AD:[start,end,diff]rec, replicated_[nrec,ntimes]: ',
                0198      &              startrec, endrec, diffrec,
                0199      &              replicated_nrec,replicated_ntimes
                0200 #endif
                0201         DO jrec = 1, replicated_ntimes+1
b4daa24319 Shre*0202          DO iRec = 1, replicated_nrec
4e4ad91a39 Jean*0203 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0204 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
c64ca7963b Gael*0205 #endif
b4daa24319 Shre*0206           kRec=replicated_nrec*(jrec-1)+iRec
                0207           lRec=startrec+iRec-1
                0208           IF (kRec.LE.endrec) THEN
b938a3c63b antn*0209 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0210            ilgen=ilnblnk( fnamegenIn(iarr) )
96b006450c dngo*0211            temp_genarr_fnamA = fnamegenIn(iarr)
b4daa24319 Shre*0212            write(*,*) 'AE: iarr,[i,j,k,l]rec: ',iarr,iRec,jrec,lRec
96b006450c dngo*0213            write(*,*) 'AF: fnamegenIn: ', temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0214 #endif
                0215 C fnamegenIn is xx_*.$iter.data, so the required access records starts at
b4daa24319 Shre*0216 C startrec+iRec-1 instead of iRec in the read call below. In adjoint mode, S/R
b938a3c63b antn*0217 C ADACTIVE_READ_XY reads adxx_*.$iter.data in reverse order, with required
                0218 C access from endrec back to startrec. This requires creating adxx_*.$iter.data
                0219 C file of size endrec, with valid gradients from records startrec to endrec
                0220 C but all zeros from 1 to startrec-1. See documentation:
                0221 C https://mitgcm.readthedocs.io/en/latest/ocean_state_est/ocean_state_est.html#ctrl-model-parameter-adjustment-capability
cbef0e5bf3 Gael*0222 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0223            CALL ACTIVE_READ_XY( fnamegenIn(iarr), xx_gen, lRec,
11c3150c71 Mart*0224      &          doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0225      &          myThid, xx_gentim2d_dummy(iarr) )
cbef0e5bf3 Gael*0226 #else
b4daa24319 Shre*0227            CALL READ_REC_XY_RL( fnamegenIn(iarr), xx_gen, lRec,
                0228      &                          1, myThid )
cbef0e5bf3 Gael*0229 #endif
b4daa24319 Shre*0230 C Here, we write record kRec (from 1 to diffrec) to file xx_*.effective.$iter
cbef0e5bf3 Gael*0231 #ifdef ALLOW_AUTODIFF
b938a3c63b antn*0232 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0233            ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0234            temp_genarr_fnamA = fnamegenOut(iarr)
b4daa24319 Shre*0235            write(*,*) 'AG: iarr,[i,j,k]rec: ',iarr,iRec,jrec,kRec
96b006450c dngo*0236            write(*,*) 'AH: fnamegenOut: ', temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0237 #endif
b4daa24319 Shre*0238            CALL ACTIVE_WRITE_XY( fnamegenOut(iarr), xx_gen, kRec,
                0239      &          optimcycle, myThid, xx_gentim2d_dummy(iarr) )
cbef0e5bf3 Gael*0240 #else
b4daa24319 Shre*0241            CALL WRITE_REC_XY_RL( fnamegenOut(iarr), xx_gen, kRec,
                0242      &          1 , myThid )
cbef0e5bf3 Gael*0243 #endif
11c3150c71 Mart*0244           ENDIF
                0245          ENDDO
cbef0e5bf3 Gael*0246         ENDDO
                0247 
b4daa24319 Shre*0248 C--   rmcycle
2fa7b4a87c Gael*0249 #ifdef ALLOW_ECCO
b938a3c63b antn*0250         replicated_nrec=diffrec
2fa7b4a87c Gael*0251         replicated_ntimes=0
                0252         do k2 = 1, maxCtrlProc
                0253          if (xx_gentim2d_preproc(k2,iarr).EQ.'rmcycle') then
11c3150c71 Mart*0254           if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
b938a3c63b antn*0255            replicated_nrec=min(diffrec,xx_gentim2d_preproc_i(k2,iarr))
11c3150c71 Mart*0256            replicated_ntimes=
b938a3c63b antn*0257      &          int(float(diffrec)/float(replicated_nrec))
                0258            if (replicated_ntimes*replicated_nrec.LT.diffrec)
11c3150c71 Mart*0259      &          replicated_ntimes=replicated_ntimes+1
b938a3c63b antn*0260            if (replicated_ntimes*replicated_nrec.GT.diffrec)
11c3150c71 Mart*0261      &          replicated_ntimes=replicated_ntimes-1
                0262           endif
2fa7b4a87c Gael*0263          endif
                0264         enddo
                0265 
b938a3c63b antn*0266 #ifdef ALLOW_CTRL_DEBUG
                0267         write(*,'(A,1x,5I6)')
                0268      &  'AI:[start,end,diff]rec, replicated_[nrec,ntimes]: ',
                0269      &      startrec,endrec,diffrec,replicated_nrec,replicated_ntimes
                0270 #endif
2fa7b4a87c Gael*0271 
                0272         IF (replicated_ntimes.GT.0) THEN
                0273 
b4daa24319 Shre*0274 C     create cyclic average
2fa7b4a87c Gael*0275 
b938a3c63b antn*0276          nyearsINT=1+int((diffrec-replicated_nrec)/replicated_nrec)
11c3150c71 Mart*0277          recip_nyearsRL=1. _d 0/float(nyearsINT)
2fa7b4a87c Gael*0278 
b938a3c63b antn*0279 #ifdef ALLOW_CTRL_DEBUG
                0280          write(*,*) 'AJ: nyears[INT,RL]: ',nyearsINT,recip_nyearsRL
                0281 #endif
2fa7b4a87c Gael*0282 
b4daa24319 Shre*0283          DO iRec = 1, replicated_nrec
2fa7b4a87c Gael*0284 
11c3150c71 Mart*0285           DO bj=myByLo(myThid),myByHi(myThid)
                0286            DO bi=myBxLo(myThid),myBxHi(myThid)
                0287             DO j = 1-OLy,sNy+OLy
                0288              DO i = 1-OLx,sNx+OLx
                0289               xx_gen(i,j,bi,bj) = zeroRL
                0290              ENDDO
                0291             ENDDO
                0292            ENDDO
                0293           ENDDO
2fa7b4a87c Gael*0294 
11c3150c71 Mart*0295           DO jrec=1,nyearsINT
4e4ad91a39 Jean*0296 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0297 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
2fa7b4a87c Gael*0298 #endif
b4daa24319 Shre*0299            kRec=iRec+(jrec-1)*replicated_nrec
b938a3c63b antn*0300 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0301            write(*,*) 'AK: iarr,[i,j,k]rec: ',iarr,iRec,jrec,kRec
                0302            ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0303            temp_genarr_fnamA = fnamegenOut(iarr)
                0304            write(*,*) 'AL: fnamegenOut: ',temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0305 #endif
2fa7b4a87c Gael*0306 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0307            CALL ACTIVE_READ_XY( fnamegenOut(iarr), xx_gen_tmp, kRec,
11c3150c71 Mart*0308      &          doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0309      &          myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0310 #else
b4daa24319 Shre*0311            CALL READ_REC_XY_RL( fnamegenOut(iarr), xx_gen_tmp, kRec,
11c3150c71 Mart*0312      &          1, myThid )
2fa7b4a87c Gael*0313 #endif
11c3150c71 Mart*0314            DO bj=myByLo(myThid),myByHi(myThid)
                0315             DO bi=myBxLo(myThid),myBxHi(myThid)
                0316              DO j = 1,sNy
                0317               DO i = 1,sNx
                0318                xx_gen(i,j,bi,bj) = xx_gen(i,j,bi,bj)
                0319      &              +xx_gen_tmp(i,j,bi,bj)
                0320               ENDDO
                0321              ENDDO
                0322             ENDDO
                0323            ENDDO
                0324 C     end jrec
                0325           ENDDO
2fa7b4a87c Gael*0326 
11c3150c71 Mart*0327           DO bj=myByLo(myThid),myByHi(myThid)
                0328            DO bi=myBxLo(myThid),myBxHi(myThid)
                0329             DO j = 1,sNy
                0330              DO i = 1,sNx
                0331               xx_gen(i,j,bi,bj) = xx_gen(i,j,bi,bj) * recip_nyearsRL
                0332              ENDDO
                0333             ENDDO
                0334            ENDDO
                0335           ENDDO
2fa7b4a87c Gael*0336 
4e4ad91a39 Jean*0337 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0338 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
2fa7b4a87c Gael*0339 #endif
                0340 
                0341 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0342           CALL ACTIVE_WRITE_XY( fnamegenTmp(iarr), xx_gen, iRec,
                0343      &         optimcycle, myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0344 #else
b4daa24319 Shre*0345           CALL WRITE_REC_XY_RL( fnamegenTmp(iarr), xx_gen, iRec,
                0346      &         1, myThid )
2fa7b4a87c Gael*0347 #endif
                0348 
11c3150c71 Mart*0349          ENDDO
2fa7b4a87c Gael*0350 
b4daa24319 Shre*0351 C     subtract cyclic average
11c3150c71 Mart*0352          DO jrec = 1, replicated_ntimes+1
b4daa24319 Shre*0353           DO iRec = 1, replicated_nrec
4e4ad91a39 Jean*0354 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0355 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
2fa7b4a87c Gael*0356 #endif
b4daa24319 Shre*0357            kRec=replicated_nrec*(jrec-1)+iRec
b938a3c63b antn*0358 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0359            write(*,*) 'AM: iarr,[i,j,k]rec: ',iarr,iRec,jrec,kRec
                0360            ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0361            temp_genarr_fnamA = fnamegenOut(iarr)
                0362            write(*,*) 'AN: fnamegenOut: ',temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0363 #endif
b4daa24319 Shre*0364            IF (kRec.LE.diffrec) THEN
2fa7b4a87c Gael*0365 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0366             CALL ACTIVE_READ_XY( fnamegenOut(iarr), xx_gen, kRec,
11c3150c71 Mart*0367      &           doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0368      &           myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0369 #else
b4daa24319 Shre*0370             CALL READ_REC_XY_RL( fnamegenOut(iarr), xx_gen, kRec,
                0371      &           1, myThid )
2fa7b4a87c Gael*0372 #endif
                0373 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0374             CALL ACTIVE_READ_XY( fnamegenTmp(iarr), xx_gen_tmp, iRec,
11c3150c71 Mart*0375      &           doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0376      &           myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0377 #else
b4daa24319 Shre*0378             CALL READ_REC_XY_RL( fnamegenTmp(iarr), xx_gen_tmp, iRec,
                0379      &           1, myThid )
2fa7b4a87c Gael*0380 #endif
11c3150c71 Mart*0381             DO bj=myByLo(myThid),myByHi(myThid)
                0382              DO bi=myBxLo(myThid),myBxHi(myThid)
                0383               DO j = 1,sNy
                0384                DO i = 1,sNx
                0385                 xx_gen(i,j,bi,bj)=xx_gen(i,j,bi,bj)
                0386      &              -xx_gen_tmp(i,j,bi,bj)
                0387                ENDDO
                0388               ENDDO
                0389              ENDDO
                0390             ENDDO
2fa7b4a87c Gael*0391 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0392             CALL ACTIVE_WRITE_XY( fnamegenOut(iarr), xx_gen, kRec,
9f5240b52a Jean*0393      &           optimcycle, myThid, xx_gentim2d_dummy(iarr) )
2fa7b4a87c Gael*0394 #else
b4daa24319 Shre*0395             CALL WRITE_REC_XY_RL( fnamegenOut(iarr), xx_gen, kRec,
                0396      &           1, myThid )
2fa7b4a87c Gael*0397 #endif
11c3150c71 Mart*0398            ENDIF
                0399           ENDDO
                0400          ENDDO
2fa7b4a87c Gael*0401 
                0402         ENDIF
                0403 #endif /* ifdef ALLOW_ECCO */
                0404 
b4daa24319 Shre*0405 C--   scaling and smoothing
cbef0e5bf3 Gael*0406 
b938a3c63b antn*0407 C The access of records startrec to endrec in  xx_*.*iter was already
                0408 C done correctly above. From here, we read in xx_*.effective.$iter.data
                0409 C of size diffrec, so no more fix of record is needed from here on out.
b4daa24319 Shre*0410         DO iRec = 1, diffrec
4e4ad91a39 Jean*0411 #ifdef ALLOW_AUTODIFF_TAMC
7855a13227 Mart*0412 CADJ STORE xx_gentim2d_dummy = dummytape, key = 1 , kind = isbyte
cbef0e5bf3 Gael*0413 #endif
bb18285007 Gael*0414 
b938a3c63b antn*0415 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0416          ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0417          temp_genarr_fnamA = fnamegenOut(iarr)
b4daa24319 Shre*0418          lRec=startrec+iRec-1
                0419          write(*,'(A,1x,A,1x,2I6)') 'AO: fnamegenOut, iRec,lRec ',
96b006450c dngo*0420      &       temp_genarr_fnamA(1:ilgen),iRec,lRec
b938a3c63b antn*0421 #endif
1c8d09be4c Gael*0422 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0423          CALL ACTIVE_READ_XY( fnamegenOut(iarr), xx_gen, iRec,
11c3150c71 Mart*0424      &        doglobalread, ladinit, optimcycle,
9f5240b52a Jean*0425      &        myThid, xx_gentim2d_dummy(iarr) )
1c8d09be4c Gael*0426 #else
b4daa24319 Shre*0427          CALL READ_REC_XY_RL( fnamegenOut(iarr), xx_gen, iRec,
                0428      &        1, myThid )
1c8d09be4c Gael*0429 #endif
bb18285007 Gael*0430 
51342df11b Patr*0431 #ifndef ALLOW_OPENAD
bd00ac563a Gael*0432          jrec=1
b938a3c63b antn*0433 C Not clear which record to use for timevariable weights ;
                0434 C For now, just assumes records from startrec to endrec are available in file
bd00ac563a Gael*0435          do k2 = 1, maxCtrlProc
b938a3c63b antn*0436           if (xx_gentim2d_preproc(k2,iarr).EQ.'variaweight') then
b4daa24319 Shre*0437             jrec=startrec+iRec-1
b938a3c63b antn*0438           endif
bd00ac563a Gael*0439          enddo
c7de4e3cb2 antn*0440          CALL READ_REC_3D_RL( xx_gentim2d_weight(iarr), ctrlprec, 1,
9f5240b52a Jean*0441      &             wgentim2d(1-OLx,1-OLy,1,1,iarr), jrec, 1, myThid )
bb18285007 Gael*0442 
11c3150c71 Mart*0443 C--   Get appropriate mask
                0444          call ctrl_get_mask2D(xx_gentim2d_file(iarr), mask2D, myThid)
7b8b86ab99 Timo*0445 
bb18285007 Gael*0446 #ifdef ALLOW_SMOOTH
bd00ac563a Gael*0447          IF (useSMOOTH) THEN
9f5240b52a Jean*0448           IF (dowc01) call smooth_correl2d(xx_gen,mask2D,numsmo,myThid)
                0449           IF (dosmooth) call smooth2d(xx_gen,mask2D,numsmo,myThid)
bd00ac563a Gael*0450          ENDIF
                0451 #endif /* ALLOW_SMOOTH */
                0452 
                0453          DO bj=myByLo(myThid), myByHi(myThid)
                0454           DO bi=myBxLo(myThid), myBxHi(myThid)
                0455            DO j = 1,sNy
                0456             DO i = 1,sNx
7b8b86ab99 Timo*0457              if ((mask2D(i,j,bi,bj).NE.0.).AND.
11c3150c71 Mart*0458      &            (wgentim2d(i,j,bi,bj,iarr).GT.0.)) then
                0459               IF (doscaling) then
                0460                xx_gen(i,j,bi,bj)=xx_gen(i,j,bi,bj)
                0461      &              /sqrt(wgentim2d(i,j,bi,bj,iarr))
                0462               ENDIF             ! IF (doscaling) then
f307bb5bdf An T*0463              else
11c3150c71 Mart*0464               xx_gen(i,j,bi,bj)=0. _d 0
f307bb5bdf An T*0465              endif
bb18285007 Gael*0466             ENDDO
                0467            ENDDO
bd00ac563a Gael*0468           ENDDO
                0469          ENDDO
                0470 #endif /* ALLOW_OPENAD */
bb18285007 Gael*0471 
7b8b86ab99 Timo*0472          CALL CTRL_BOUND_2D(xx_gen,mask2D,
bd00ac563a Gael*0473      &        xx_gentim2d_bounds(1,iarr),myThid)
bb18285007 Gael*0474 
bd00ac563a Gael*0475          CALL EXCH_XY_RL ( xx_gen , myThid )
1c8d09be4c Gael*0476 
b938a3c63b antn*0477 #ifdef ALLOW_CTRL_DEBUG
b4daa24319 Shre*0478          ilgen=ilnblnk( fnamegenOut(iarr) )
96b006450c dngo*0479          temp_genarr_fnamA = fnamegenOut(iarr)
b938a3c63b antn*0480          write(*,'(A,1x,I6,1x,A)')
96b006450c dngo*0481      &      'AQ: iRec,fnamegenOut: ',iRec,temp_genarr_fnamA(1:ilgen)
b938a3c63b antn*0482 #endif
1c8d09be4c Gael*0483 #ifdef ALLOW_AUTODIFF
b4daa24319 Shre*0484          CALL ACTIVE_WRITE_XY( fnamegenOut(iarr), xx_gen, iRec,
                0485      &        optimcycle, myThid, xx_gentim2d_dummy(iarr) )
1c8d09be4c Gael*0486 #else
b4daa24319 Shre*0487          CALL WRITE_REC_XY_RL( fnamegenOut(iarr), xx_gen, iRec,
                0488      &        1, myThid )
1c8d09be4c Gael*0489 #endif
b4daa24319 Shre*0490 C--   end iRec loop
bb18285007 Gael*0491         ENDDO
                0492 
51342df11b Patr*0493 #ifndef ALLOW_OPENAD
bb18285007 Gael*0494        endif
51342df11b Patr*0495 #endif
bb18285007 Gael*0496 
b4daa24319 Shre*0497 C--   end iarr loop
bb18285007 Gael*0498       ENDDO
                0499 
b938a3c63b antn*0500 #ifdef ALLOW_DEBUG
                0501       IF (debugMode) CALL DEBUG_LEAVE('CTRL_MAP_INI_GENTIM2D',myThid)
                0502 #endif /* ALLOW_DEBUG */
bb18285007 Gael*0503 #endif /* ALLOW_GENTIM2D_CONTROL */
                0504 
                0505       RETURN
                0506       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!