C $Header: /u/gcmpack/MITgcm/verification/halfpipe_streamice/code_ad/ctrl_map_ini_gentim2d.F,v 1.1 2015/02/19 16:52:03 heimbach Exp $ C $Name: $ #include "CTRL_OPTIONS.h" #ifdef ALLOW_AUTODIFF # include "AUTODIFF_OPTIONS.h" #endif CBOP C !ROUTINE: CTRL_MAP_INI_GENTIM2D C !INTERFACE: SUBROUTINE CTRL_MAP_INI_GENTIM2D( myThid ) C !DESCRIPTION: \bv C *================================================================= C | SUBROUTINE CTRL_MAP_INI_GENTIM2D C | Dimensionalize and preprocess time variable controls. C *================================================================= C \ev C !USES: IMPLICIT NONE C == global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "GRID.h" #include "DYNVARS.h" #include "FFIELDS.h" #include "CTRL_SIZE.h" #include "ctrl.h" #include "optim.h" #include "ctrl_dummy.h" #include "CTRL_GENARR.h" #ifdef ALLOW_PTRACERS # include "PTRACERS_SIZE.h" # include "PTRACERS_FIELDS.h" #endif #ifdef ALLOW_AUTODIFF #include "tamc.h" #endif C !INPUT/OUTPUT PARAMETERS: C == routine arguments == INTEGER myThid #ifdef ALLOW_GENTIM2D_CONTROL C !LOCAL VARIABLES: C == local variables == integer iarr integer smoothOpNb character*(80) fnamegenIn character*(80) fnamegenOut character*(80) fnamebase character*(80) fnamegeneric integer startrec integer endrec integer diffrec integer irec, jrec, krec integer replicated_nrec integer replicated_ntimes logical doglobalread logical ladinit _RL xx_gen(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) integer bi,bj integer i,j,k2 INTEGER ILNBLNK EXTERNAL integer ilgen CEOP c-- Now, read the control vector. doglobalread = .false. ladinit = .false. C-- generic 2D control variables DO iarr = 1, maxCtrlTim2D diffrec=0 startrec=0 endrec=0 cph if (xx_gentim2d_weight(iarr).NE.' ') then fnamebase = xx_gentim2d_file(iarr) call CTRL_INIT_REC ( fnamebase, I xx_gentim2d_startdate1(iarr), I xx_gentim2d_startdate2(iarr), I xx_gentim2d_period(iarr), I 1, O xx_gentim2d_startdate(1,iarr), O diffrec, startrec, endrec, I myThid ) fnamebase = xx_gentim2d_file(iarr) ilgen=ilnblnk( fnamebase ) write(fnamegenIn(1:80),'(2a,i10.10)') & fnamebase(1:ilgen),'.',optimcycle write(fnamegenOut(1:80),'(2a,i10.10)') & fnamebase(1:ilgen),'.effective.',optimcycle smoothOpNb=1 do k2 = 1, maxCtrlProc if (xx_gentim2d_preproc(k2,iarr).EQ.'smooth') then if (xx_gentim2d_preproc_i(k2,iarr).NE.0) & smoothOpNb=xx_gentim2d_preproc_i(k2,iarr) endif enddo replicated_nrec=endrec replicated_ntimes=0 do k2 = 1, maxCtrlProc if (xx_gentim2d_preproc(k2,iarr).EQ.'replicate') then if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then replicated_nrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr)) replicated_ntimes= & int(float(endrec)/float(replicated_nrec)) if (replicated_ntimes*replicated_nrec.LT.endrec) & replicated_ntimes=replicated_ntimes+1 if (replicated_ntimes*replicated_nrec.GT.endrec) & replicated_ntimes=replicated_ntimes-1 endif endif enddo DO irec = 1, replicated_nrec #ifdef ALLOW_AUTODIFF CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte #endif call ACTIVE_READ_XY( fnamegenIn, xx_gen, irec, & doglobalread, ladinit, optimcycle, & mythid, xx_gentim2d_dummy(iarr) ) do k2 = 1, maxCtrlProc if (xx_gentim2d_preproc(k2,iarr).EQ.'variaweight') & call MDSREADFIELD( xx_gentim2d_weight(iarr), ctrlprec, 'RL', & 1, wgentim2d(1-Olx,1-Oly,1,1,iarr), irec, myThid ) enddo #ifdef ALLOW_SMOOTH IF ( ctrlSmoothCorrel2D ) THEN IF ( useSMOOTH ) THEN call SMOOTH_CORREL2D(xx_gen,maskC,smoothOpNb,mythid) DO bj=myByLo(myThid), myByHi(myThid) DO bi=myBxLo(myThid), myBxHi(myThid) DO j = 1,sNy DO i = 1,sNx if ((maskC(i,j,1,bi,bj).NE.0.).AND. & (wgentim2d(i,j,bi,bj,iarr).GT.0.)) then xx_gen(i,j,bi,bj)=xx_gen(i,j,bi,bj) & /sqrt(wgentim2d(i,j,bi,bj,iarr)) else xx_gen(i,j,bi,bj)=0. _d 0 endif ENDDO ENDDO ENDDO ENDDO CALL EXCH_XY_RL ( xx_gen , myThid ) ENDIF ENDIF #endif /* ALLOW_SMOOTH */ call ACTIVE_WRITE_XY( fnamegenOut, xx_gen, irec, optimcycle, & mythid, xx_gentim2d_dummy(iarr) ) c-- end irec loop ENDDO DO jrec = 1, replicated_ntimes DO irec = 1, replicated_nrec #ifdef ALLOW_AUTODIFF CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte #endif krec=replicated_nrec*(jrec-1)+irec IF (krec.LE.endrec) THEN call ACTIVE_READ_XY( fnamegenOut, xx_gen, irec, & doglobalread, ladinit, optimcycle, & mythid, xx_gentim2d_dummy(iarr) ) call ACTIVE_WRITE_XY( fnamegenOut, xx_gen, krec, optimcycle, & mythid, xx_gentim2d_dummy(iarr) ) ENDIF ENDDO ENDDO cph endif c-- end iarr loop ENDDO #endif /* ALLOW_GENTIM2D_CONTROL */ RETURN END