/[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.2 - (show annotations) (download)
Wed Aug 1 13:24:38 2012 UTC (11 years, 11 months ago) by jmc
Branch: MAIN
Changes since 1.1: +2 -3 lines
fix CPP syntax

1 C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F,v 1.1 2012/07/31 17:49:25 heimbach Exp $
2 C $Name: $
3
4 #include "CTRL_CPPOPTIONS.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 !LOCAL VARIABLES:
46 c == local variables ==
47
48 integer bi,bj
49 integer i,j,k
50 integer itlo,ithi
51 integer jtlo,jthi
52 integer jmin,jmax
53 integer imin,imax
54 integer il
55 integer iarr
56
57 logical equal
58 logical doglobalread
59 logical ladinit
60
61 character*( 80) fnamegeneric
62
63 _RL fac
64 _RL tmptest
65
66 c == external ==
67 integer ilnblnk
68 external ilnblnk
69
70 c == end of interface ==
71 CEOP
72
73 jtlo = mybylo(mythid)
74 jthi = mybyhi(mythid)
75 itlo = mybxlo(mythid)
76 ithi = mybxhi(mythid)
77 jmin = 1
78 jmax = sny
79 imin = 1
80 imax = snx
81
82 doglobalread = .false.
83 ladinit = .false.
84
85 equal = .true.
86
87 if ( equal ) then
88 fac = 1. _d 0
89 else
90 fac = 0. _d 0
91 endif
92
93 #ifdef ALLOW_GENARR2D_CONTROL
94 c-- An example of connecting specific fields
95 c-- to 3 generic 2D control arrays
96 cc--->>>
97 cc--->>> COMPILE FAILURE IS DELIBERATE
98 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
99 cc--->>>
100 c-- generic - user-defined control vars
101 do iarr = 1, maxCtrlArr2D
102 il=ilnblnk( xx_genarr2d_file(iarr) )
103 write(fnamegeneric(1:80),'(2a,i10.10)')
104 & xx_genarr2d_file(iarr)(1:il),'.',optimcycle
105 call active_read_xy ( fnamegeneric, tmpfld2d, 1,
106 & doglobalread, ladinit, optimcycle,
107 & mythid, xx_genarr2d_dummy(iarr) )
108 do bj = jtlo,jthi
109 do bi = itlo,ithi
110 do j = jmin,jmax
111 do i = imin,imax
112 if ( iarr .eq. 1 ) then
113 bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
114 & + tmpfld2d(i,j,bi,bj)
115 elseif ( iarr. eq. 2 ) then
116 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
117 & + tmpfld2d(i,j,bi,bj)
118 elseif ( iarr .eq. 3 ) then
119 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
120 & + tmpfld2d(i,j,bi,bj)
121 endif
122 enddo
123 enddo
124 enddo
125 enddo
126 c--
127 _EXCH_XY_RL( bottomdragfld, mythid )
128 _EXCH_XYZ_RL( theta, mythid )
129 _EXCH_XYZ_RL( salt, mythid )
130 c--
131 enddo
132 #endif
133
134 #ifdef ALLOW_GENARR3D_CONTROL
135 c-- An example of connecting specific fields
136 c-- to 3 generic 3D control arrays
137 cc--->>>
138 cc--->>> COMPILE FAILURE IS DELIBERATE
139 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
140 cc--->>>
141 c-- generic - user-defined control vars
142 do iarr = 1, maxCtrlArr3D
143 il=ilnblnk( xx_genarr3d_file(iarr) )
144 write(fnamegeneric(1:80),'(2a,i10.10)')
145 & xx_genarr3d_file(iarr)(1:il),'.',optimcycle
146 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
147 & doglobalread, ladinit, optimcycle,
148 & mythid, xx_genarr3d_dummy(iarr) )
149 do bj = jtlo,jthi
150 do bi = itlo,ithi
151 do k = 1,nr
152 do j = jmin,jmax
153 do i = imin,imax
154 if ( iarr .eq. 1 ) then
155 theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
156 & fac*tmpfld3d(i,j,k,bi,bj)
157 elseif ( iarr .eq. 2 ) then
158 salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
159 & fac*tmpfld3d(i,j,k,bi,bj)
160 endif
161 enddo
162 enddo
163 enddo
164 enddo
165 enddo
166 _EXCH_XYZ_RL( theta, mythid )
167 _EXCH_XYZ_RL( salt, mythid )
168 _EXCH_XYZ_RL( diffkr, mythid )
169 c--
170 enddo
171 #endif
172
173 return
174 end

  ViewVC Help
Powered by ViewVC 1.1.22