/[MITgcm]/MITgcm/verification/halfpipe_streamice/code_ad/ctrl_map_ini_genarr.F
ViewVC logotype

Annotation of /MITgcm/verification/halfpipe_streamice/code_ad/ctrl_map_ini_genarr.F

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


Revision 1.1 - (hide annotations) (download)
Mon Jun 24 21:33:19 2013 UTC (10 years, 10 months ago) by dgoldberg
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64o, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64n, checkpoint65h, checkpoint65i, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64k, checkpoint65, checkpoint64j, checkpoint64m, checkpoint64l
code_ad folder for halfpipe_streamice

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

  ViewVC Help
Powered by ViewVC 1.1.22