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

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

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


Revision 1.4 - (show annotations) (download)
Sun Aug 12 19:59:03 2012 UTC (11 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64a, checkpoint63r, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64c, checkpoint64g, checkpoint64f, checkpoint64h, checkpoint63s, checkpoint64
Changes since 1.3: +81 -95 lines
import changes made to standard version in pkg/ctrl

1 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini_genarr.F,v 1.3 2012/08/10 19:38:57 jmc Exp $
2 C $Name: $
3
4 #include "CTRL_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: CTRL_MAP_INI_GENARR
8 C !INTERFACE:
9 SUBROUTINE CTRL_MAP_INI_GENARR( myThid )
10
11 C !DESCRIPTION: \bv
12 C *=================================================================
13 C | SUBROUTINE CTRL_MAP_INI_GENARR
14 C | Add the generic arrays of the
15 C | control vector to the model state and update the tile halos.
16 C | The control vector is defined in the header file "ctrl.h".
17 C *=================================================================
18 C \ev
19
20 C !USES:
21 IMPLICIT NONE
22
23 C == global variables ==
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27 #include "GRID.h"
28 #include "DYNVARS.h"
29 #include "FFIELDS.h"
30 #include "CTRL_SIZE.h"
31 #include "ctrl.h"
32 #include "CTRL_GENARR.h"
33 #include "ctrl_dummy.h"
34 #include "optim.h"
35 #ifdef ALLOW_PTRACERS
36 # include "PTRACERS_SIZE.h"
37 c#include "PTRACERS_PARAMS.h"
38 # include "PTRACERS_FIELDS.h"
39 #endif
40
41 C !INPUT/OUTPUT PARAMETERS:
42 C == routine arguments ==
43 INTEGER myThid
44
45 C !FUNCTIONS:
46 INTEGER ILNBLNk
47 EXTERNAL ILNBLNK
48
49 C !LOCAL VARIABLES:
50 C == local variables ==
51 integer bi,bj
52 integer i,j,k
53 integer jmin,jmax
54 integer imin,imax
55 integer il
56 integer iarr
57
58 logical doglobalread
59 logical ladinit
60 character*( 80) fnamegeneric
61 _RL fac
62 CEOP
63
64 jmin = 1
65 jmax = sNy
66 imin = 1
67 imax = sNx
68
69 doglobalread = .false.
70 ladinit = .false.
71 fac = 1. _d 0
72
73 #ifdef ALLOW_GENARR2D_CONTROL
74 C-- An example of connecting specific fields
75 C-- to 3 generic 2D control arrays
76 cc--->>>
77 cc--->>> COMPILE FAILURE IS DELIBERATE
78 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
79 cc--->>>
80 C-- generic - user-defined control vars
81 DO iarr = 1, maxCtrlArr2D
82
83 il=ILNBLNK( xx_genarr2d_file(iarr) )
84 write(fnamegeneric(1:80),'(2a,i10.10)')
85 & xx_genarr2d_file(iarr)(1:il),'.',optimcycle
86 CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
87 & doglobalread, ladinit, optimcycle,
88 & myThid, xx_genarr2d_dummy(iarr) )
89 DO bj=myByLo(myThid), myByHi(myThid)
90 DO bi=myBxLo(myThid), myBxHi(myThid)
91 do j = jmin,jmax
92 do i = imin,imax
93 if ( iarr .eq. 1 ) then
94 #ifdef ALLOW_BOTTOMDRAG_CONTROL
95 bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
96 & + tmpfld2d(i,j,bi,bj)
97 #endif
98 elseif ( iarr. eq. 2 ) then
99 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
100 & + tmpfld2d(i,j,bi,bj)
101 elseif ( iarr .eq. 3 ) then
102 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
103 & + tmpfld2d(i,j,bi,bj)
104 endif
105 enddo
106 enddo
107 ENDDO
108 ENDDO
109 C-- end iarr loop
110 ENDDO
111 #ifdef ALLOW_BOTTOMDRAG_CONTROL
112 _EXCH_XY_RL( bottomdragfld, myThid )
113 #endif
114 _EXCH_XYZ_RL( theta, myThid )
115 _EXCH_XYZ_RL( salt, myThid )
116
117 #endif /* ALLOW_GENARR2D_CONTROL */
118
119 #ifdef ALLOW_GENARR3D_CONTROL
120 C-- An example of connecting specific fields
121 C-- to 3 generic 3D control arrays
122 cc--->>>
123 cc--->>> COMPILE FAILURE IS DELIBERATE
124 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
125 cc--->>>
126 C-- generic - user-defined control vars
127 DO iarr = 1, maxCtrlArr3D
128
129 il=ILNBLNK( xx_genarr3d_file(iarr) )
130 write(fnamegeneric(1:80),'(2a,i10.10)')
131 & xx_genarr3d_file(iarr)(1:il),'.',optimcycle
132 CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
133 & doglobalread, ladinit, optimcycle,
134 & myThid, xx_genarr3d_dummy(iarr) )
135 DO bj=myByLo(myThid), myByHi(myThid)
136 DO bi=myBxLo(myThid), myBxHi(myThid)
137 do k = 1,Nr
138 do j = jmin,jmax
139 do i = imin,imax
140 if ( iarr .eq. 1 ) then
141 theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
142 & + fac*tmpfld3d(i,j,k,bi,bj)
143 elseif ( iarr .eq. 2 ) then
144 salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
145 & + fac*tmpfld3d(i,j,k,bi,bj)
146 endif
147 enddo
148 enddo
149 enddo
150 ENDDO
151 ENDDO
152 C-- end iarr loop
153 ENDDO
154 _EXCH_XYZ_RL( theta, myThid )
155 _EXCH_XYZ_RL( salt, myThid )
156
157 #endif /* ALLOW_GENARR3D_CONTROL */
158
159 RETURN
160 END

  ViewVC Help
Powered by ViewVC 1.1.22