/[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.5 - (show annotations) (download)
Wed Feb 18 20:47:01 2015 UTC (9 years, 4 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, HEAD
Changes since 1.4: +2 -2 lines
Update verification.

1 C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_oad/ctrl_map_gentim2d.F,v 1.3 2015/01/17 07:19:28 heimbach 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 xx_gentim2d_file(iarr),
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 wgentim2d(1-Olx,1-Oly,1,1,iarr),
105 I mytime, myiter, mythid )
106 C
107 DO bj=myByLo(myThid),myByHi(myThid)
108 DO bi=myBxLo(myThid),myBxHi(myThid)
109 do j = 1,sNy
110 do i = 1,sNx
111 if (xx_gentim2d_cumsum(iarr)) then
112 xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d(i,j,bi,bj,iarr)
113 & +xx_gentim2d_loc(i,j,bi,bj)
114 else
115 xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d_loc(i,j,bi,bj)
116 endif
117 enddo
118 enddo
119 enddo
120 enddo
121 C
122 if (xx_gentim2d_glosum(iarr)) then
123
124 LOCsumGlob=0. _d 0
125 DO bj=myByLo(myThid),myByHi(myThid)
126 DO bi=myBxLo(myThid),myBxHi(myThid)
127 LOCsumTile(bi,bj)=0. _d 0
128 do j = 1,sNy
129 do i = 1,sNx
130 LOCsumTile(bi,bj)=LOCsumTile(bi,bj)+
131 & maskC(i,j,1,bi,bj)*rA(i,j,bi,bj)
132 & *xx_gentim2d(i,j,bi,bj,iarr)
133 enddo
134 enddo
135 enddo
136 enddo
137
138 CALL GLOBAL_SUM_TILE_RL( LOCsumTile, LOCsumGlob, myThid )
139
140 DO bj = myByLo(myThid), myByHi(myThid)
141 DO bi = myBxLo(myThid), myBxHi(myThid)
142 DO J = 1-Oly,sNy+Oly
143 DO I = 1-Olx,sNx+Olx
144 xx_gentim2d(I,J,bi,bj,iarr) =
145 & LOCsumGlob/globalArea*maskC(i,j,1,bi,bj)
146 ENDDO
147 ENDDO
148 ENDDO
149 ENDDO
150
151 WRITE(msgBuf,'(A,I6,A,I6,A,1PE21.14)') ' xx_gentim2d ',
152 & iarr,' : iter=', myiter, ' ; global sum = ', LOCsumGlob
153 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
154 & SQUEEZE_RIGHT, myThid )
155
156 endif
157
158 DO bj = myByLo(myThid), myByHi(myThid)
159 DO bi = myBxLo(myThid), myBxHi(myThid)
160 DO J = 1-Oly,sNy+Oly
161 DO I = 1-Olx,sNx+Olx
162 if (iarr.EQ.1) then
163 theta(I,J,1,bi,bj) = theta(I,J,1,bi,bj)
164 & + xx_gentim2d(I,J,bi,bj,iarr)
165 endif
166 ENDDO
167 ENDDO
168 ENDDO
169 ENDDO
170
171 ENDDO
172
173 #endif /* ALLOW_GENTIM2D_CONTROL */
174
175 RETURN
176 END

  ViewVC Help
Powered by ViewVC 1.1.22