pkg/ctrl/ctrl_map_ini_gentim2d.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini_gentim2d.F,v 1.5 2015/02/17 13:54:21 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
      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 ILNBLNK
      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

#ifndef ALLOW_OPENAD
       if (xx_gentim2d_weight(iarr).NE.' ') then
#endif

        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

#ifdef ALLOW_AUTODIFF
         call active_read_xy( fnamegenIn, xx_gen, irec,
     &                       doglobalread, ladinit, optimcycle,
     &                       mythid, xx_gentim2d_dummy(iarr) )
#else
      CALL READ_REC_XY_RL( fnamegenIn, xx_gen, iRec, 1, myThid )
#endif

#ifndef ALLOW_OPENAD
        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
#endif

#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 */


#ifdef ALLOW_AUTODIFF
         call active_write_xy( fnamegenOut, xx_gen, irec, optimcycle,
     &       mythid, xx_gentim2d_dummy(iarr) )
#else
         CALL WRITE_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid )
#endif

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
#ifdef ALLOW_AUTODIFF
         call active_read_xy( fnamegenOut, xx_gen, irec,
     &                       doglobalread, ladinit, optimcycle,
     &                       mythid, xx_gentim2d_dummy(iarr) )
#else
         CALL READ_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid )
#endif
#ifdef ALLOW_AUTODIFF
         call active_write_xy( fnamegenOut, xx_gen, krec, optimcycle,
     &       mythid, xx_gentim2d_dummy(iarr) )
#else
         CALL WRITE_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid )
#endif
        ENDIF
        ENDDO
        ENDDO

#ifndef ALLOW_OPENAD
       endif
#endif

c-- end iarr loop
      ENDDO

#endif /* ALLOW_GENTIM2D_CONTROL */

      RETURN
      END

1	gforget	1.6	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini_gentim2d.F,v 1.5 2015/02/17 13:54:21 heimbach Exp $
2	gforget	1.1	C $Name: $
3
4			#include "CTRL_OPTIONS.h"
5	gforget	1.3	#ifdef ALLOW_AUTODIFF
6			# include "AUTODIFF_OPTIONS.h"
7			#endif
8	gforget	1.1
9			CBOP
10			C !ROUTINE: CTRL_MAP_INI_GENTIM2D
11			C !INTERFACE:
12			SUBROUTINE CTRL_MAP_INI_GENTIM2D( myThid )
13
14			C !DESCRIPTION: \bv
15			C *=================================================================
16			C \| SUBROUTINE CTRL_MAP_INI_GENTIM2D
17			C \| Dimensionalize and preprocess time variable controls.
18			C *=================================================================
19			C \ev
20
21			C !USES:
22			IMPLICIT NONE
23
24			C == global variables ==
25			#include "SIZE.h"
26			#include "EEPARAMS.h"
27			#include "PARAMS.h"
28			#include "GRID.h"
29			#include "DYNVARS.h"
30			#include "FFIELDS.h"
31			#include "CTRL_SIZE.h"
32			#include "ctrl.h"
33			#include "optim.h"
34			#include "ctrl_dummy.h"
35			#include "CTRL_GENARR.h"
36			#ifdef ALLOW_PTRACERS
37			# include "PTRACERS_SIZE.h"
38			# include "PTRACERS_FIELDS.h"
39			#endif
40	gforget	1.3	#ifdef ALLOW_AUTODIFF
41			#include "tamc.h"
42			#endif
43	gforget	1.1
44			C !INPUT/OUTPUT PARAMETERS:
45			C == routine arguments ==
46			INTEGER myThid
47
48			#ifdef ALLOW_GENTIM2D_CONTROL
49			C !LOCAL VARIABLES:
50			C == local variables ==
51			integer iarr
52			integer smoothOpNb
53			character*(80) fnamegenIn
54			character*(80) fnamegenOut
55	heimbach	1.5	character*(80) fnamebase
56	gforget	1.1	integer startrec
57			integer endrec
58			integer diffrec
59			integer irec, jrec, krec
60			integer replicated_nrec
61			integer replicated_ntimes
62			logical doglobalread
63			logical ladinit
64			_RL xx_gen(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
65			integer bi,bj
66			integer i,j,k2
67			INTEGER ILNBLNK
68			EXTERNAL ILNBLNK
69			integer ilgen
70			CEOP
71
72			c-- Now, read the control vector.
73			doglobalread = .false.
74			ladinit = .false.
75
76			C-- generic 2D control variables
77			DO iarr = 1, maxCtrlTim2D
78
79	gforget	1.3	diffrec=0
80			startrec=0
81			endrec=0
82
83	heimbach	1.5	#ifndef ALLOW_OPENAD
84	gforget	1.1	if (xx_gentim2d_weight(iarr).NE.' ') then
85	heimbach	1.5	#endif
86	gforget	1.1
87	heimbach	1.5	fnamebase = xx_gentim2d_file(iarr)
88			call ctrl_init_rec ( fnamebase,
89	gforget	1.1	I xx_gentim2d_startdate1(iarr),
90			I xx_gentim2d_startdate2(iarr),
91			I xx_gentim2d_period(iarr),
92			I 1,
93			O xx_gentim2d_startdate(1,iarr),
94			O diffrec, startrec, endrec,
95			I myThid )
96
97	heimbach	1.5	fnamebase = xx_gentim2d_file(iarr)
98			ilgen=ilnblnk( fnamebase )
99	gforget	1.1	write(fnamegenIn(1:80),'(2a,i10.10)')
100	heimbach	1.5	& fnamebase(1:ilgen),'.',optimcycle
101	gforget	1.1	write(fnamegenOut(1:80),'(2a,i10.10)')
102	heimbach	1.5	& fnamebase(1:ilgen),'.effective.',optimcycle
103	gforget	1.1
104			smoothOpNb=1
105			do k2 = 1, maxCtrlProc
106			if (xx_gentim2d_preproc(k2,iarr).EQ.'smooth') then
107			if (xx_gentim2d_preproc_i(k2,iarr).NE.0)
108			& smoothOpNb=xx_gentim2d_preproc_i(k2,iarr)
109			endif
110			enddo
111
112			replicated_nrec=endrec
113			replicated_ntimes=0
114			do k2 = 1, maxCtrlProc
115			if (xx_gentim2d_preproc(k2,iarr).EQ.'replicate') then
116			if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
117			replicated_nrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr))
118			replicated_ntimes=
119			& int(float(endrec)/float(replicated_nrec))
120			if (replicated_ntimes*replicated_nrec.LT.endrec)
121			& replicated_ntimes=replicated_ntimes+1
122			if (replicated_ntimes*replicated_nrec.GT.endrec)
123			& replicated_ntimes=replicated_ntimes-1
124			endif
125			endif
126			enddo
127
128			DO irec = 1, replicated_nrec
129	gforget	1.3	#ifdef ALLOW_AUTODIFF
130			CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte
131			#endif
132	gforget	1.1
133	gforget	1.6	#ifdef ALLOW_AUTODIFF
134	gforget	1.1	call active_read_xy( fnamegenIn, xx_gen, irec,
135			& doglobalread, ladinit, optimcycle,
136			& mythid, xx_gentim2d_dummy(iarr) )
137	gforget	1.6	#else
138			CALL READ_REC_XY_RL( fnamegenIn, xx_gen, iRec, 1, myThid )
139			#endif
140	gforget	1.1
141	heimbach	1.5	#ifndef ALLOW_OPENAD
142	gforget	1.1	do k2 = 1, maxCtrlProc
143			if (xx_gentim2d_preproc(k2,iarr).EQ.'variaweight')
144			& call mdsreadfield( xx_gentim2d_weight(iarr), ctrlprec, 'RL',
145			& 1, wgentim2d(1-Olx,1-Oly,1,1,iarr), irec, myThid )
146			enddo
147	heimbach	1.5	#endif
148	gforget	1.1
149			#ifdef ALLOW_SMOOTH
150			IF ( ctrlSmoothCorrel2D ) THEN
151			IF ( useSMOOTH ) THEN
152			call smooth_correl2D(xx_gen,maskC,smoothOpNb,mythid)
153
154			DO bj=myByLo(myThid), myByHi(myThid)
155			DO bi=myBxLo(myThid), myBxHi(myThid)
156			DO j = 1,sNy
157			DO i = 1,sNx
158			if ((maskC(i,j,1,bi,bj).NE.0.).AND.
159			& (wgentim2d(i,j,bi,bj,iarr).GT.0.)) then
160			xx_gen(i,j,bi,bj)=xx_gen(i,j,bi,bj)
161			& /sqrt(wgentim2d(i,j,bi,bj,iarr))
162			else
163			xx_gen(i,j,bi,bj)=0. _d 0
164			endif
165			ENDDO
166			ENDDO
167			ENDDO
168			ENDDO
169
170	gforget	1.4	CALL EXCH_XY_RL ( xx_gen , myThid )
171	gforget	1.1	ENDIF
172			ENDIF
173			#endif /* ALLOW_SMOOTH */
174
175	gforget	1.6
176			#ifdef ALLOW_AUTODIFF
177	gforget	1.1	call active_write_xy( fnamegenOut, xx_gen, irec, optimcycle,
178			& mythid, xx_gentim2d_dummy(iarr) )
179	gforget	1.6	#else
180			CALL WRITE_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid )
181			#endif
182	gforget	1.1
183			c-- end irec loop
184			ENDDO
185
186			DO jrec = 1, replicated_ntimes
187			DO irec = 1, replicated_nrec
188	gforget	1.3	#ifdef ALLOW_AUTODIFF
189			CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte
190			#endif
191	gforget	1.1	krec=replicated_nrec*(jrec-1)+irec
192			IF (krec.LE.endrec) THEN
193	gforget	1.6	#ifdef ALLOW_AUTODIFF
194	gforget	1.1	call active_read_xy( fnamegenOut, xx_gen, irec,
195			& doglobalread, ladinit, optimcycle,
196			& mythid, xx_gentim2d_dummy(iarr) )
197	gforget	1.6	#else
198			CALL READ_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid )
199			#endif
200			#ifdef ALLOW_AUTODIFF
201	gforget	1.1	call active_write_xy( fnamegenOut, xx_gen, krec, optimcycle,
202			& mythid, xx_gentim2d_dummy(iarr) )
203	gforget	1.6	#else
204			CALL WRITE_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid )
205			#endif
206	gforget	1.1	ENDIF
207			ENDDO
208			ENDDO
209
210	heimbach	1.5	#ifndef ALLOW_OPENAD
211	gforget	1.1	endif
212	heimbach	1.5	#endif
213	gforget	1.1
214			c-- end iarr loop
215			ENDDO
216
217			#endif /* ALLOW_GENTIM2D_CONTROL */
218
219			RETURN
220			END
221