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

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

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

revision 1.2 by heimbach, Fri Jul 13 13:40:17 2001 UTC revision 1.10 by heimbach, Fri Jun 27 01:54:20 2003 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    
3  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
4    #ifdef ALLOW_PTRACERS
5    # include "PTRACERS_OPTIONS.h"
6    #endif
7    
8    CBOP
9    C     !ROUTINE: ctrl_map_ini
10    C     !INTERFACE:
11          subroutine ctrl_map_ini( mythid )
12    
13    C     !DESCRIPTION: \bv
14    c     *=================================================================
15    c     | SUBROUTINE ctrl_map_ini
16    c     | Add the temperature, salinity, and diffusivity parts 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        subroutine ctrl_map_ini(  C     !USES:
      I                     mythid  
      &                   )  
   
 c     ==================================================================  
 c     SUBROUTINE ctrl_map_ini  
 c     ==================================================================  
 c  
 c     o Add the temperature and salinity parts of the control vector to  
 c       the model state and update the tile edges. The control vector is  
 c       defined in the header file "ctrl.h".  
 c  
 c     started: Christian Eckert eckert@mit.edu 30-Jun-1999  
 c  
 c     changed: Christian Eckert eckert@mit.edu 23-Feb-2000  
 c  
 c              - Restructured the code in order to create a package  
 c                for the MITgcmUV.  
 c  
 c     ==================================================================  
 c     SUBROUTINE ctrl_map_ini  
 c     ==================================================================  
   
23        implicit none        implicit none
24    
25  c     == global variables ==  c     == global variables ==
   
 #include "EEPARAMS.h"  
26  #include "SIZE.h"  #include "SIZE.h"
27    #include "EEPARAMS.h"
28    #include "PARAMS.h"
29  #include "DYNVARS.h"  #include "DYNVARS.h"
30  #include "TR1.h"  #include "GRID.h"
31    #ifdef ALLOW_PASSIVE_TRACER
32    # include "TR1.h"
33    #endif
34    #ifdef ALLOW_PTRACERS
35    # include "PTRACERS.h"
36    #endif
37    
38  #include "ctrl.h"  #include "ctrl.h"
39  #include "ctrl_dummy.h"  #include "ctrl_dummy.h"
40  #include "optim.h"  #include "optim.h"
41    
42    C     !INPUT/OUTPUT PARAMETERS:
43  c     == routine arguments ==  c     == routine arguments ==
   
44        integer mythid        integer mythid
45    
46    C     !LOCAL VARIABLES:
47  c     == local variables ==  c     == local variables ==
48    
       _RL     fac  
49        integer bi,bj        integer bi,bj
50        integer i,j,k        integer i,j,k
51        integer itlo,ithi        integer itlo,ithi
# Line 61  c     == local variables == Line 61  c     == local variables ==
61        character*( 80)   fnametheta        character*( 80)   fnametheta
62        character*( 80)   fnamesalt        character*( 80)   fnamesalt
63        character*( 80)   fnametr1        character*( 80)   fnametr1
64          character*( 80)   fnamediffkr
65          character*( 80)   fnamekapgm
66          character*( 80)   fnameefluxy
67          character*( 80)   fnameefluxp
68          character*( 80)   fnamebottomdrag
69    
70  c     == external ==        _RL     fac
71    
72    c     == external ==
73        integer  ilnblnk        integer  ilnblnk
74        external ilnblnk        external ilnblnk
75    
76  c     == end of interface ==  c     == end of interface ==
77    CEOP
78    
79        jtlo = mybylo(mythid)        jtlo = mybylo(mythid)
80        jthi = mybyhi(mythid)        jthi = mybyhi(mythid)
81        itlo = mybxlo(mythid)        itlo = mybxlo(mythid)
82        ithi = mybxhi(mythid)        ithi = mybxhi(mythid)
83        jmin = 1-oly        jmin = 1
84        jmax = sny+oly        jmax = sny
85        imin = 1-olx        imin = 1
86        imax = snx+olx        imax = snx
87    
88        doglobalread = .false.        doglobalread = .false.
89        ladinit      = .false.        ladinit      = .false.
# Line 105  c--   Temperature field. Line 112  c--   Temperature field.
112                do i = imin,imax                do i = imin,imax
113                  theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +                  theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
114       &                               fac*tmpfld3d(i,j,k,bi,bj)       &                               fac*tmpfld3d(i,j,k,bi,bj)
115                  gtNm1(i,j,k,bi,bj) = gtNm1(i,j,k,bi,bj) +                  if(theta(i,j,k,bi,bj).lt.-2.0)
116       &                               fac*tmpfld3d(i,j,k,bi,bj)       &               theta(i,j,k,bi,bj)= -2.0  
117                enddo                enddo
118              enddo              enddo
119            enddo            enddo
# Line 130  c--   Temperature field. Line 137  c--   Temperature field.
137                do i = imin,imax                do i = imin,imax
138                  salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +                  salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
139       &                               fac*tmpfld3d(i,j,k,bi,bj)       &                               fac*tmpfld3d(i,j,k,bi,bj)
                 gsNm1(i,j,k,bi,bj) = gsNm1(i,j,k,bi,bj) +  
      &                               fac*tmpfld3d(i,j,k,bi,bj)  
140                enddo                enddo
141              enddo              enddo
142            enddo            enddo
# Line 153  c--   Temperature field. Line 158  c--   Temperature field.
158            do k = 1,nr            do k = 1,nr
159              do j = jmin,jmax              do j = jmin,jmax
160                do i = imin,imax                do i = imin,imax
161    #if (defined (ALLOW_PASSIVE_TRACER))
162                  tr1(i,j,k,bi,bj) = tr1(i,j,k,bi,bj) +                  tr1(i,j,k,bi,bj) = tr1(i,j,k,bi,bj) +
163       &                               fac*tmpfld3d(i,j,k,bi,bj)       &                               fac*tmpfld3d(i,j,k,bi,bj)
164                  gsNm1(i,j,k,bi,bj) = gsNm1(i,j,k,bi,bj) +  #elif (defined (ALLOW_PTRACERS))
165                    IF ( NUMBER_OF_PTRACERS .GT. 1 ) STOP
166         & 'ALLOW_TR10_CONTROL with ALLOW_PTRACERS implemented for 1 tracer'
167                    ptracer(i,j,k,bi,bj,1) = ptracer(i,j,k,bi,bj,1) +
168       &                               fac*tmpfld3d(i,j,k,bi,bj)       &                               fac*tmpfld3d(i,j,k,bi,bj)
169    #endif
170                  enddo
171                enddo
172              enddo
173           enddo
174          enddo
175    #endif
176    
177    #ifdef ALLOW_DIFFKR_CONTROL
178    c--   diffkr.
179          il=ilnblnk( xx_diffkr_file )
180          write(fnamediffkr(1:80),'(2a,i10.10)')
181         &     xx_diffkr_file(1:il),'.',optimcycle
182          call active_read_xyz( fnamediffkr, tmpfld3d, 1,
183         &                      doglobalread, ladinit, optimcycle,
184         &                      mythid, xx_diffkr_dummy )
185          do bj = jtlo,jthi
186            do bi = itlo,ithi
187              do k = 1,nr
188                do j = jmin,jmax
189                  do i = imin,imax
190                    diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
191         &                                tmpfld3d(i,j,k,bi,bj)
192                enddo                enddo
193              enddo              enddo
194            enddo            enddo
# Line 164  c--   Temperature field. Line 196  c--   Temperature field.
196        enddo        enddo
197  #endif  #endif
198    
199    #ifdef ALLOW_KAPGM_CONTROL
200    c--   kapgm.
201          il=ilnblnk( xx_kapgm_file )
202          write(fnamekapgm(1:80),'(2a,i10.10)')
203         &     xx_kapgm_file(1:il),'.',optimcycle
204          call active_read_xyz( fnamekapgm, tmpfld3d, 1,
205         &                      doglobalread, ladinit, optimcycle,
206         &                      mythid, xx_kapgm_dummy )
207          do bj = jtlo,jthi
208            do bi = itlo,ithi
209              do k = 1,nr
210                do j = jmin,jmax
211                  do i = imin,imax
212                    kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
213         &                               tmpfld3d(i,j,k,bi,bj)
214                  enddo
215                enddo
216              enddo
217           enddo
218          enddo
219    #endif
220    
221    #ifdef ALLOW_EFLUXY0_CONTROL
222    c--   y-component EP-flux field.
223          il=ilnblnk( xx_efluxy_file )
224          write(fnameefluxy(1:80),'(2a,i10.10)')
225         &     xx_efluxy_file(1:il),'.',optimcycle
226          call active_read_xyz( fnameefluxy, tmpfld3d, 1,
227         &                      doglobalread, ladinit, optimcycle,
228         &                      mythid, xx_efluxy_dummy )
229    
230          do bj = jtlo,jthi
231            do bi = itlo,ithi
232              do k = 1,nr
233                do j = jmin,jmax
234                  do i = imin,imax
235                    EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
236         &                                - fac*tmpfld3d(i,j,k,bi,bj)
237         &                                  *maskS(i,j,k,bi,bj)
238    cph                EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
239    cph     &                                - rSphere*cosFacU(J,bi,bj)
240    cph     &                                  *fac*tmpfld3d(i,j,k,bi,bj)
241                  enddo
242                enddo
243              enddo
244           enddo
245          enddo
246    #endif
247    
248    #ifdef ALLOW_EFLUXP0_CONTROL
249    c--   p-component EP-flux field.
250          il=ilnblnk( xx_efluxp_file )
251          write(fnameefluxp(1:80),'(2a,i10.10)')
252         &     xx_efluxp_file(1:il),'.',optimcycle
253          call active_read_xyz( fnameefluxp, tmpfld3d, 1,
254         &                      doglobalread, ladinit, optimcycle,
255         &                      mythid, xx_efluxp_dummy )
256    
257          do bj = jtlo,jthi
258            do bi = itlo,ithi
259              do k = 1,nr
260                do j = jmin,jmax
261                  do i = imin,imax
262                    EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
263         &                                + fCori(i,j,bi,bj)
264         &                                  *fac*tmpfld3d(i,j,k,bi,bj)
265         &                                  *hFacV(i,j,k,bi,bj)
266    cph                EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
267    cph     &                                + fCori(i,j,bi,bj)
268    cph     &                                  *rSphere*cosFacU(J,bi,bj)
269    cph     &                                  *fac*tmpfld3d(i,j,k,bi,bj)
270                  enddo
271                enddo
272              enddo
273           enddo
274          enddo
275    #endif
276    
277    #ifdef ALLOW_BOTTOMDRAG_CONTROL
278    c--   bottom drag
279          il=ilnblnk( xx_bottomdrag_file )
280          write(fnamebottomdrag(1:80),'(2a,i10.10)')
281         &     xx_bottomdrag_file(1:il),'.',optimcycle
282          call active_read_xy ( fnamebottomdrag, tmpfld2d, 1,
283         &                      doglobalread, ladinit, optimcycle,
284         &                      mythid, xx_bottomdrag_dummy )
285          do bj = jtlo,jthi
286            do bi = itlo,ithi
287              do j = jmin,jmax
288                do i = imin,imax
289                  bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
290         &                                   + tmpfld2d(i,j,bi,bj)
291                enddo
292              enddo
293            enddo
294          enddo
295    #endif
296    
297    
298  c--   Update the tile edges.  c--   Update the tile edges.
299    
300  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
301        _EXCH_XYZ_R8( theta, mythid )        _EXCH_XYZ_R8( theta, mythid )
       _EXCH_XYZ_R8( gtNm1, mythid )  
302  #endif  #endif
303  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
304        _EXCH_XYZ_R8(  salt, mythid )        _EXCH_XYZ_R8(  salt, mythid )
       _EXCH_XYZ_R8( gsNm1, mythid )  
305  #endif  #endif
306  #ifdef ALLOW_TR10_CONTROL  #ifdef ALLOW_TR10_CONTROL
307        _EXCH_XYZ_R8(  tr1, mythid )  # if (defined (ALLOW_PASSIVE_TRACER))
308        _EXCH_XYZ_R8( gTr1Nm1, mythid )        _EXCH_XYZ_R8(     tr1, mythid )
309    # elif (defined (ALLOW_PTRACERS))
310          _EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,1),myThid)
311    # endif
312    #endif
313    #ifdef ALLOW_DIFFKR_CONTROL
314          _EXCH_XYZ_R8( diffkr, mythid)
315  #endif  #endif
316    #ifdef ALLOW_KAPGM_CONTROL
317          _EXCH_XYZ_R8( kapgm, mythid)
318    #endif
319    #ifdef ALLOW_EFLUXY0_CONTROL
320          _EXCH_XYZ_R8( EfluxY, mythid )
321    #endif
322    #ifdef ALLOW_EFLUXP0_CONTROL
323          _EXCH_XYZ_R8( EfluxP, mythid )
324    #endif
325    #ifdef ALLOW_BOTTOMDRAG_CONTROL
326          _EXCH_XY_R8( bottomdragfld, mythid )
327    #endif
328    
329    
330        return        return
331        end        end
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22