/[MITgcm]/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_gentim2d.F
ViewVC logotype

Contents of /MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_gentim2d.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download)
Fri Jun 21 16:24:39 2013 UTC (11 years, 1 month ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64o, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64n, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65d, checkpoint64k, checkpoint65, checkpoint64j, checkpoint64m, checkpoint64l
Changes since 1.2: +4 -2 lines
OpenAD-compliant modifs

1 C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_gentim2d.F,v 1.2 2013/03/27 00:11:02 gforget Exp $
2 C $Name: $
3
4 #include "CTRL_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: CTRL_MAP_GENTIM2D
8 C !INTERFACE:
9 SUBROUTINE CTRL_MAP_GENTIM2D(
10 I myTime, myIter, myThid )
11 C !DESCRIPTION: \bv
12 C *=============================================================*
13 C | S/R CTRL_MAP_GENTIM2D
14 C *=============================================================*
15
16 C !USES:
17 IMPLICIT NONE
18
19 C === Global variables ===
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #include "PARAMS.h"
23 #include "FFIELDS.h"
24 #include "DYNVARS.h"
25 #include "GRID.h"
26 #include "CTRL_SIZE.h"
27 #include "ctrl.h"
28 #include "CTRL_GENARR.h"
29 #include "ctrl_dummy.h"
30 #include "optim.h"
31 #ifdef ALLOW_AUTODIFF
32 #include "AUTODIFF_MYFIELDS.h"
33 #endif
34
35 C !INPUT/OUTPUT PARAMETERS:
36 C === Routine arguments ===
37 C myIter :: iteration counter for this thread
38 C myTime :: time counter for this thread
39 C myThid :: thread number for this instance of the routine.
40 _RL myTime
41 INTEGER myIter
42 INTEGER myThid
43
44 C !LOCAL VARIABLES:
45 C == Local variables ==
46 integer bi,bj
47 integer i,j,k
48 integer itlo,ithi
49 integer jtlo,jthi
50 integer jmin,jmax
51 integer imin,imax
52 integer il
53 integer iarr
54
55 logical equal
56 logical doglobalread
57 logical ladinit
58 character*(MAX_LEN_FNAM) fnamebase
59 character*( 80) fnamegeneric
60
61 _RL fac
62 _RL xx_gentim2d_loc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
63 CHARACTER*(MAX_LEN_MBUF) msgBuf
64 _RL LOCsumTile(nSx,nSy), LOCsumGlob
65
66 c == external ==
67 integer ilnblnk
68 external ilnblnk
69 CEOP
70
71 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
72
73 #ifdef ALLOW_GENTIM2D_CONTROL
74 C-- An example of connecting specific fields
75 C-- to generic time-varying 2D control arrays
76 cph--->>>
77 cph--->>> COMPILE FAILURE IS DELIBERATE
78 cph--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
79 cph--->>>
80 C-- generic - user-defined control vars
81 DO iarr = 1, maxCtrlTim2D
82
83 DO bj = myByLo(myThid), myByHi(myThid)
84 DO bi = myBxLo(myThid), myBxHi(myThid)
85 DO J = 1-Oly,sNy+Oly
86 DO I = 1-Olx,sNx+Olx
87 xx_gentim2d_loc(I,J,bi,bj) = 0. _d 0
88 ENDDO
89 ENDDO
90 ENDDO
91 ENDDO
92 C
93 fnamebase = xx_gentim2d_file(iarr)
94 CALL CTRL_GET_GEN (
95 I fnamebase(1:MAX_LEN_FNAM),
96 I xx_gentim2d_startdate(1,iarr),
97 I xx_gentim2d_period(iarr),
98 I maskC,
99 O xx_gentim2d_loc,
100 I xx_gentim2d0(1-Olx,1-Oly,1,1,iarr),
101 I xx_gentim2d1(1-Olx,1-Oly,1,1,iarr),
102 I xx_gentim2d_dummy(iarr),
103 I zeroRL, zeroRL,
104 I mytime, myiter, mythid )
105 C
106 DO bj=myByLo(myThid),myByHi(myThid)
107 DO bi=myBxLo(myThid),myBxHi(myThid)
108 do j = 1,sNy
109 do i = 1,sNx
110 if (xx_gentim2d_cumsum(iarr)) then
111 xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d(i,j,bi,bj,iarr)
112 & +xx_gentim2d_loc(i,j,bi,bj)
113 else
114 xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d_loc(i,j,bi,bj)
115 endif
116 enddo
117 enddo
118 enddo
119 enddo
120 C
121 if (xx_gentim2d_glosum(iarr)) then
122
123 LOCsumGlob=0. _d 0
124 DO bj=myByLo(myThid),myByHi(myThid)
125 DO bi=myBxLo(myThid),myBxHi(myThid)
126 LOCsumTile(bi,bj)=0. _d 0
127 do j = 1,sNy
128 do i = 1,sNx
129 LOCsumTile(bi,bj)=LOCsumTile(bi,bj)+
130 & maskC(i,j,1,bi,bj)*rA(i,j,bi,bj)
131 & *xx_gentim2d(i,j,bi,bj,iarr)
132 enddo
133 enddo
134 enddo
135 enddo
136
137 CALL GLOBAL_SUM_TILE_RL( LOCsumTile, LOCsumGlob, myThid )
138
139 DO bj = myByLo(myThid), myByHi(myThid)
140 DO bi = myBxLo(myThid), myBxHi(myThid)
141 DO J = 1-Oly,sNy+Oly
142 DO I = 1-Olx,sNx+Olx
143 xx_gentim2d(I,J,bi,bj,iarr) =
144 & LOCsumGlob/globalArea*maskC(i,j,1,bi,bj)
145 ENDDO
146 ENDDO
147 ENDDO
148 ENDDO
149
150 WRITE(msgBuf,'(A,I6,A,I6,A,1PE21.14)') ' xx_gentim2d ',
151 & iarr,' : iter=', myiter, ' ; global sum = ', LOCsumGlob
152 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
153 & SQUEEZE_RIGHT, myThid )
154
155 endif
156
157 DO bj = myByLo(myThid), myByHi(myThid)
158 DO bi = myBxLo(myThid), myBxHi(myThid)
159 DO J = 1-Oly,sNy+Oly
160 DO I = 1-Olx,sNx+Olx
161 if (iarr.EQ.1) then
162 theta(I,J,1,bi,bj) = theta(I,J,1,bi,bj)
163 & + xx_gentim2d(I,J,bi,bj,iarr)
164 endif
165 ENDDO
166 ENDDO
167 ENDDO
168 ENDDO
169
170 ENDDO
171
172 #endif /* ALLOW_GENTIM2D_CONTROL */
173
174 RETURN
175 END

  ViewVC Help
Powered by ViewVC 1.1.22