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

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

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

revision 1.1.2.1 by heimbach, Tue Feb 5 20:23:58 2002 UTC revision 1.11 by mlosch, Mon Mar 14 17:08:00 2011 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
5  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
# Line 15  c     ================================== Line 17  c     ==================================
17  c     SUBROUTINE ctrl_getobcsw  c     SUBROUTINE ctrl_getobcsw
18  c     ==================================================================  c     ==================================================================
19  c  c
20  c     o Get norhtern obc of the control vector and add it  c     o Get western obc of the control vector and add it
21  c       to dyn. fields  c       to dyn. fields
22  c  c
23  c     started: heimbach@mit.edu, 29-Aug-2001  c     started: heimbach@mit.edu, 29-Aug-2001
24  c  c
25    c     modified: gebbie@mit.edu, 18-Mar-2003
26  c     ==================================================================  c     ==================================================================
27  c     SUBROUTINE ctrl_getobcsw  c     SUBROUTINE ctrl_getobcsw
28  c     ==================================================================  c     ==================================================================
# Line 56  c     == local variables == Line 59  c     == local variables ==
59        integer imin,imax        integer imin,imax
60        integer ilobcsw        integer ilobcsw
61        integer iobcs        integer iobcs
62          integer ip1
63    
64        _RL     dummy        _RL     dummy
65        _RL     obcswfac        _RL     obcswfac
# Line 64  c     == local variables == Line 68  c     == local variables ==
68        integer obcswcount0        integer obcswcount0
69        integer obcswcount1        integer obcswcount1
70    
71        _RL maskyz   (1-oly:sny+oly,nr,nsx,nsy)  cgg      _RL maskyz   (1-oly:sny+oly,nr,nsx,nsy)
72          _RL tmpfldyz (1-oly:sny+oly,nr,nsx,nsy)
73    
74        logical doglobalread        logical doglobalread
75        logical ladinit        logical ladinit
76    
77        character*(80) fnameobcsw        character*(80) fnameobcsw
78    
79          cgg(  Variables for splitting barotropic/baroclinic vels.
80          _RL ubaro
81          _RL utop
82    cgg)
83    
84  c     == external functions ==  c     == external functions ==
85    
# Line 89  c     == end of interface == Line 97  c     == end of interface ==
97        jmax = sny+oly        jmax = sny+oly
98        imin = 1-olx        imin = 1-olx
99        imax = snx+olx        imax = snx+olx
100          ip1  = 1
101    
102    cgg(  Initialize variables for balancing volume flux.
103          ubaro = 0.d0
104          utop = 0.d0
105    cgg)
106    
107  c--   Now, read the control vector.  c--   Now, read the control vector.
108        doglobalread = .false.        doglobalread = .false.
109        ladinit      = .false.        ladinit      = .false.
110    
111        if (optimcycle .ge. 0) then        if (optimcycle .ge. 0) then
112          ilobcsw=ilnblnk( xx_obcsw_file )         ilobcsw=ilnblnk( xx_obcsw_file )
113          write(fnameobcsw(1:80),'(2a,i10.10)')         write(fnameobcsw(1:80),'(2a,i10.10)')
114       &       xx_obcsw_file(1:ilobcsw), '.', optimcycle       &      xx_obcsw_file(1:ilobcsw), '.', optimcycle
       else  
         print*  
         print*,' ctrl_getobcsw: optimcycle not set correctly.'  
         print*,' ... stopped in ctrl_getobcsw.'  
115        endif        endif
116    
117  c--   Get the counters, flags, and the interpolation factor.  c--   Get the counters, flags, and the interpolation factor.
118        call ctrl_GetRec( 'xx_obcsw',        call ctrl_get_gen_rec(
119         I                   xx_obcswstartdate, xx_obcswperiod,
120       O                   obcswfac, obcswfirst, obcswchanged,       O                   obcswfac, obcswfirst, obcswchanged,
121       O                   obcswcount0,obcswcount1,       O                   obcswcount0,obcswcount1,
122       I                   mytime, myiter, mythid )       I                   mytime, myiter, mythid )
123    
124        do iobcs = 1,nobcs        do iobcs = 1,nobcs
125           if ( obcswfirst ) then
126          call active_read_yz( 'maskobcsw', maskyz,          call active_read_yz( fnameobcsw, tmpfldyz,
      &                       iobcs,  
      &                       doglobalread, ladinit, 0,  
      &                       mythid, dummy )  
   
         call active_read_yz( fnameobcsw, tmpfldyz,  
127       &                       (obcswcount0-1)*nobcs+iobcs,       &                       (obcswcount0-1)*nobcs+iobcs,
128       &                       doglobalread, ladinit, optimcycle,       &                       doglobalread, ladinit, optimcycle,
129       &                       mythid, xx_obcsw_dummy )       &                       mythid, xx_obcsw_dummy )
130    
131          do bj = jtlo,jthi          do bj = jtlo,jthi
132            do bi = itlo,ithi           do bi = itlo,ithi
133              do k = 1,nr            do k = 1,nr
134                do j = jmin,jmax             do j = jmin,jmax
135                  yz_obcs0(j,k,bi,bj)  = tmpfldyz (j,k,bi,bj)              xx_obcsw1(j,k,bi,bj,iobcs)  = tmpfldyz (j,k,bi,bj)
136                enddo  cgg   &                                        *   maskyz (j,k,bi,bj)
137              enddo             enddo
138            enddo            enddo
139             enddo
140          enddo          enddo
141           endif
142    
143          call active_read_yz( fnameobcsw, tmpfldyz,         if ( (obcswfirst) .or. (obcswchanged)) then
      &                       (obcswcount1-1)*nobcs+iobcs,  
      &                       doglobalread, ladinit, optimcycle,  
      &                       mythid, xx_obcsw_dummy )  
144    
145          do bj = jtlo,jthi          do bj = jtlo,jthi
146            do bi = itlo,ithi           do bi = itlo,ithi
147              do k = 1,nr            do k = 1,nr
148                do j = jmin,jmax             do j = jmin,jmax
149                  yz_obcs1 (j,k,bi,bj) = tmpfldyz (j,k,bi,bj)              xx_obcsw0(j,k,bi,bj,iobcs) = xx_obcsw1(j,k,bi,bj,iobcs)
150                enddo              tmpfldyz (j,k,bi,bj)       = 0. _d 0
151              enddo             enddo
152            enddo            enddo
153             enddo
154          enddo          enddo
155    
156  c--     Add control to model variable.          call active_read_yz( fnameobcsw, tmpfldyz,
157         &                       (obcswcount1-1)*nobcs+iobcs,
158         &                       doglobalread, ladinit, optimcycle,
159         &                       mythid, xx_obcsw_dummy )
160    
161          do bj = jtlo,jthi          do bj = jtlo,jthi
162             do bi = itlo,ithi           do bi = itlo,ithi
163  c--        Calculate mask for tracer cells (0 => land, 1 => water).            do k = 1,nr
164                do k = 1,nr             do j = jmin,jmax
165                   do j = 1,sny              xx_obcsw1 (j,k,bi,bj,iobcs) = tmpfldyz (j,k,bi,bj)
166                      if (iobcs .EQ. 1) then  cgg   &                                        *   maskyz (j,k,bi,bj)
                        OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj)  
      &                      + obcswfac            *yz_obcs0(j,k,bi,bj)  
      &                      + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj)  
                        OBWt(j,k,bi,bj) = OBWt(j,k,bi,bj)  
      &                      *maskyz(j,k,bi,bj)  
                     else if (iobcs .EQ. 2) then  
                        OBWs(j,k,bi,bj) = OBWs (j,k,bi,bj)  
      &                      + obcswfac            *yz_obcs0(j,k,bi,bj)  
      &                      + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj)  
                        OBWs(j,k,bi,bj) = OBWs(j,k,bi,bj)  
      &                      *maskyz(j,k,bi,bj)  
                     else if (iobcs .EQ. 3) then  
                        OBWu(j,k,bi,bj) = OBWu (j,k,bi,bj)  
      &                      + obcswfac            *yz_obcs0(j,k,bi,bj)  
      &                      + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj)  
                        OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj)  
      &                      *maskyz(j,k,bi,bj)  
                     else if (iobcs .EQ. 4) then  
                        OBWv(j,k,bi,bj) = OBWv (j,k,bi,bj)  
      &                      + obcswfac            *yz_obcs0(j,k,bi,bj)  
      &                      + (1. _d 0 - obcswfac)*yz_obcs1(j,k,bi,bj)  
                        OBWv(j,k,bi,bj) = OBWv(j,k,bi,bj)  
      &                      *maskyz(j,k,bi,bj)  
                     endif  
                  enddo  
               enddo  
167             enddo             enddo
168              enddo
169             enddo
170          enddo          enddo
171           endif
172    
173    c--   Add control to model variable.
174           do bj = jtlo, jthi
175            do bi = itlo, ithi
176    c--   Calculate mask for tracer cells (0 => land, 1 => water).
177             do k = 1,nr
178              do j = 1,sny
179               i = OB_Iw(j,bi,bj)
180               if (iobcs .EQ. 1) then
181                OBWt(j,k,bi,bj) = OBWt (j,k,bi,bj)
182         &           + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
183         &           + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)
184                OBWt(j,k,bi,bj) = OBWt(j,k,bi,bj)
185         &           *maskW(i+ip1,j,k,bi,bj)
186               else if (iobcs .EQ. 2) then
187                OBWs(j,k,bi,bj) = OBWs (j,k,bi,bj)
188         &           + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
189         &           + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)
190                OBWs(j,k,bi,bj) = OBWs(j,k,bi,bj)
191         &           *maskW(i+ip1,j,k,bi,bj)
192               else if (iobcs .EQ. 3) then
193                OBWu(j,k,bi,bj) = OBWu (j,k,bi,bj)
194         &           + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
195         &           + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)
196                OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj)
197         &           *maskW(i+ip1,j,k,bi,bj)
198               else if (iobcs .EQ. 4) then
199                OBWv(j,k,bi,bj) = OBWv (j,k,bi,bj)
200         &           + obcswfac            *xx_obcsw0(j,k,bi,bj,iobcs)
201         &           + (1. _d 0 - obcswfac)*xx_obcsw1(j,k,bi,bj,iobcs)
202                OBWv(j,k,bi,bj) = OBWv(j,k,bi,bj)
203         &           *maskS(i,j,k,bi,bj)
204               endif
205              enddo
206             enddo
207            enddo
208           enddo
209          
210  C--   End over iobcs loop  C--   End over iobcs loop
211        enddo        enddo
212    
Legend:
Removed from v.1.1.2.1  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22