/[MITgcm]/MITgcm/pkg/ctrl/ctrl_getmerstress.F
ViewVC logotype

Diff of /MITgcm/pkg/ctrl/ctrl_getmerstress.F

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

revision 1.1 by heimbach, Tue Feb 5 20:23:58 2002 UTC revision 1.1.2.1 by heimbach, Tue Feb 5 20:23:58 2002 UTC
# Line 0  Line 1 
1    C $Header$
2    
3    #include "CTRL_CPPOPTIONS.h"
4    
5    
6          subroutine ctrl_GetMerStress(
7         I                              mytime,
8         I                              myiter,
9         I                              mythid
10         &                            )
11    
12    c     ==================================================================
13    c     SUBROUTINE ctrl_GetMerStress
14    c     ==================================================================
15    c
16    c     o Get the meridional wind stress contribution of the control vector
17    c       and add it to the surface heat flux.
18    c
19    c     started: Christian Eckert eckert@mit.edu 24-Feb-2000
20    c
21    c              - Introduced in order to create a package for the
22    c                MITgcmUV.
23    c
24    c     changed: Ralf.Giering@FastOpt.de 31-Mai-2000
25    c
26    c              - set ladinit to .false.
27    c
28    c     ==================================================================
29    c     SUBROUTINE ctrl_GetMerStress
30    c     ==================================================================
31    
32          implicit none
33    
34    #ifdef ALLOW_VSTRESS_CONTROL
35    
36    c     == global variables ==
37    
38    #include "EEPARAMS.h"
39    #include "SIZE.h"
40    #include "PARAMS.h"
41    #include "GRID.h"
42    
43    #include "ctrl.h"
44    #include "ctrl_dummy.h"
45    #include "exf_fields.h"
46    #include "optim.h"
47    
48    c     == routine arguments ==
49    
50          _RL     mytime
51          integer myiter
52          integer mythid
53    
54    c     == local variables ==
55    
56          integer bi,bj
57          integer i,j,k
58          integer itlo,ithi
59          integer jtlo,jthi
60          integer jmin,jmax
61          integer imin,imax
62          integer ilvst
63    
64          _RL     vstfac
65          logical vstfirst
66          logical vstchanged
67          integer vstcount0
68          integer vstcount1
69    
70          logical doglobalread
71          logical ladinit
72    
73          character*(80) fnamevst
74    
75    c     == external functions ==
76    
77          integer  ilnblnk
78          external ilnblnk
79    
80    c     == end of interface ==
81    
82          jtlo = mybylo(mythid)
83          jthi = mybyhi(mythid)
84          itlo = mybxlo(mythid)
85          ithi = mybxhi(mythid)
86          jmin = 1-oly
87          jmax = sny+oly
88          imin = 1-olx
89          imax = snx+olx
90    
91    c--   Now, read the control vector.
92          doglobalread = .false.
93          ladinit      = .false.
94    
95          if (optimcycle .ge. 0) then
96            ilvst=ilnblnk( xx_tauv_file )
97            write(fnamevst(1:80),'(2a,i10.10)') xx_tauv_file(1:ilvst),'.',
98         &                                      optimcycle
99          else
100            print*
101            print*,' ctrl_GetMerStress: optimcycle not set correctly.'
102            print*,' ... stopped in ctrl_GetMerStress.'
103          endif
104    
105    c--   Get the counters, flags, and the interpolation factor.
106          call ctrl_GetRec( 'xx_tauv',
107         O                  vstfac, vstfirst, vstchanged,
108         O                  vstcount0,vstcount1,
109         I                  mytime, myiter, mythid )
110    
111            call active_read_xy( fnamevst, tmpfld2d, vstcount0,
112         &                       doglobalread, ladinit, optimcycle,
113         &                       mythid, xx_tauv_dummy )
114    
115    ce      myiter, mytime )
116    
117            do bj = jtlo,jthi
118              do bi = itlo,ithi
119                do j = jmin,jmax
120                  do i = imin,imax
121                    xx_tauv0(i,j,bi,bj)  = tmpfld2d (i,j,bi,bj)
122                  enddo
123                enddo
124              enddo
125            enddo
126    
127            call active_read_xy( fnamevst, tmpfld2d, vstcount1,
128         &                       doglobalread, ladinit, optimcycle,
129         &                       mythid, xx_tauv_dummy )
130    
131    ce      myiter, mytime )
132    
133            do bj = jtlo,jthi
134              do bi = itlo,ithi
135                do j = jmin,jmax
136                  do i = imin,imax
137                    xx_tauv1 (i,j,bi,bj) = tmpfld2d (i,j,bi,bj)
138                  enddo
139                enddo
140              enddo
141            enddo
142    
143    c--   Add control to model variable.
144            do bj = jtlo,jthi
145              do bi = itlo,ithi
146              k = 1
147              do j = 1,sny
148                do i = 1,snx
149                  vstress(i,j,bi,bj) = vstress(i,j,bi,bj) +
150         &                        vstfac            *xx_tauv0(i,j,bi,bj)+
151         &                        (1. _d 0 - vstfac)*xx_tauv1(i,j,bi,bj)
152                  vstress(i,j,bi,bj) = vstress(i,j,bi,bj)*masks(i,j,k,bi,bj)
153                enddo
154              enddo
155            enddo
156          enddo
157    
158    #else /* ALLOW_VSTRESS_CONTROL undefined */
159    
160    c     == routine arguments ==
161    
162          _RL     mytime
163          integer myiter
164          integer mythid
165    
166    c--   CPP flag ALLOW_VSTRESS_CONTROL undefined.
167    
168    #endif /* ALLOW_VSTRESS_CONTROL */
169    
170          end
171    
172    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.2.1
  ViewVC Help
Powered by ViewVC 1.1.22