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

Diff of /MITgcm/pkg/ctrl/ctrl_map_forcing.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.13 by jmc, Tue Apr 28 18:35:45 2009 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: ctrl_map_ini
8    C     !INTERFACE:
9        SUBROUTINE CTRL_MAP_FORCING(myThid)        SUBROUTINE CTRL_MAP_FORCING(myThid)
10  C     /==========================================================\  
11  C     | SUBROUTINE CTRL_MAP_FORCING                              |  C     !DESCRIPTION: \bv
12  C     |==========================================================|  c     *=================================================================
13  C     \==========================================================/  c     | SUBROUTINE CTRL_MAP_FORCING
14    c     | Add the surface flux anomalies of the control vector
15    c     | to the model flux fields 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        IMPLICIT NONE
22    
23  C     == Global variables ===  C     == Global variables ===
# Line 13  C     == Global variables === Line 25  C     == Global variables ===
25  #include "EEPARAMS.h"  #include "EEPARAMS.h"
26  #include "PARAMS.h"  #include "PARAMS.h"
27  #include "FFIELDS.h"  #include "FFIELDS.h"
28    #include "DYNVARS.h"
29  #include "GRID.h"  #include "GRID.h"
   
30  #include "ctrl.h"  #include "ctrl.h"
31  #include "ctrl_dummy.h"  #include "ctrl_dummy.h"
32  #include "optim.h"  #include "optim.h"
33    
34    C     !INPUT/OUTPUT PARAMETERS:
35  C     == Routine arguments ==  C     == Routine arguments ==
36  C     myThid - Thread number for this instance of the routine.  C     myThid - Thread number for this instance of the routine.
37        INTEGER myThid        INTEGER myThid
38    
39    C     !LOCAL VARIABLES:
40  C     == Local variables ==  C     == Local variables ==
41        integer bi,bj        integer bi,bj
42        integer i,j,k        integer i,j,k
# Line 42  C     == Local variables == Line 56  C     == Local variables ==
56        character*( 80)   fnamehflux        character*( 80)   fnamehflux
57        character*( 80)   fnamesss        character*( 80)   fnamesss
58        character*( 80)   fnamesst        character*( 80)   fnamesst
59        character*( 80)   fnamediffkr  cHFLUXM_CONTROL
60        character*( 80)   fnamekapgm        character*( 80)   fnamehfluxm
61    cHFLUXM_CONTROL
62    
63  c     == external ==  c     == external ==
   
64        integer  ilnblnk        integer  ilnblnk
65        external ilnblnk        external ilnblnk
66    
67  c     == end of interface ==  c     == end of interface ==
68    CEOP
69    
70        jtlo = mybylo(mythid)        jtlo = mybylo(mythid)
71        jthi = mybyhi(mythid)        jthi = mybyhi(mythid)
72        itlo = mybxlo(mythid)        itlo = mybxlo(mythid)
73        ithi = mybxhi(mythid)        ithi = mybxhi(mythid)
74        jmin = 1-oly        jmin = 1
75        jmax = sny+oly        jmax = sny
76        imin = 1-olx        imin = 1
77        imax = snx+olx        imax = snx
78    
79        doglobalread = .false.        doglobalread = .false.
80        ladinit      = .false.        ladinit      = .false.
# Line 76  c--   tauu0. Line 91  c--   tauu0.
91          do bi = itlo,ithi          do bi = itlo,ithi
92            do j = jmin,jmax            do j = jmin,jmax
93              do i = imin,imax              do i = imin,imax
94    # ifdef ALLOW_AUTODIFF_OPENAD
95                  fu(i,j,bi,bj) = fu(i,j,bi,bj) +
96         &                        xx_tauu0(i,j,bi,bj) +
97         &                        tmpfld2d(i,j,bi,bj)
98    #else
99                fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)                fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
100    #endif
101              enddo              enddo
102            enddo            enddo
103          enddo          enddo
# Line 95  c--   tauv0. Line 116  c--   tauv0.
116          do bi = itlo,ithi          do bi = itlo,ithi
117            do j = jmin,jmax            do j = jmin,jmax
118              do i = imin,imax              do i = imin,imax
119    # ifdef ALLOW_AUTODIFF_OPENAD
120                  fv(i,j,bi,bj) = fv(i,j,bi,bj) +
121         &                        xx_tauv0(i,j,bi,bj) +
122         &                        tmpfld2d(i,j,bi,bj)
123    #else
124                fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)                fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
125    #endif
126              enddo              enddo
127            enddo            enddo
128          enddo          enddo
# Line 114  c--   sflux0. Line 141  c--   sflux0.
141          do bi = itlo,ithi          do bi = itlo,ithi
142            do j = jmin,jmax            do j = jmin,jmax
143              do i = imin,imax              do i = imin,imax
144    # ifdef ALLOW_AUTODIFF_OPENAD
145                  empmr(i,j,bi,bj) = empmr(i,j,bi,bj) +
146         &                           xx_sflux0(i,j,bi,bj) +
147         &                           tmpfld2d(i,j,bi,bj)
148    #else
149                empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)                empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
150    #endif
151              enddo              enddo
152            enddo            enddo
153          enddo          enddo
# Line 133  c--   hflux0. Line 166  c--   hflux0.
166          do bi = itlo,ithi          do bi = itlo,ithi
167            do j = jmin,jmax            do j = jmin,jmax
168              do i = imin,imax              do i = imin,imax
169    # ifdef ALLOW_AUTODIFF_OPENAD
170                  qnet(i,j,bi,bj) = qnet(i,j,bi,bj) +
171         &                          xx_hflux0(i,j,bi,bj) +
172         &                          tmpfld2d(i,j,bi,bj)
173    #else
174                qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)                qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
175    #endif
176              enddo              enddo
177            enddo            enddo
178          enddo          enddo
179        enddo        enddo
180  #endif  #endif
181    
182  #ifdef ALLOW_SSS0_CONTROL  #ifdef ALLOW_SSS_CONTROL
183  c--   sss0.  c--   sss0.
184        il=ilnblnk( xx_sss_file )        il=ilnblnk( xx_sss_file )
185        write(fnamesss(1:80),'(2a,i10.10)')        write(fnamesss(1:80),'(2a,i10.10)')
# Line 159  c--   sss0. Line 198  c--   sss0.
198        enddo        enddo
199  #endif  #endif
200    
201  #ifdef ALLOW_SST0_CONTROL  #ifdef ALLOW_SST_CONTROL
202  c--   sst0.  c--   sst0.
203        il=ilnblnk( xx_sst_file )        il=ilnblnk( xx_sst_file )
204        write(fnamesst(1:80),'(2a,i10.10)')        write(fnamesst(1:80),'(2a,i10.10)')
# Line 178  c--   sst0. Line 217  c--   sst0.
217        enddo        enddo
218  #endif  #endif
219    
220  #ifdef ALLOW_DIFFKR_CONTROL  #ifdef ALLOW_HFLUXM_CONTROL
221  c--   diffkr.  c--   hfluxm.
222        il=ilnblnk( xx_diffkr_file )        il=ilnblnk( xx_hfluxm_file )
223        write(fnamediffkr(1:80),'(2a,i10.10)')        write(fnamehfluxm(1:80),'(2a,i10.10)')
224       &     xx_diffkr_file(1:il),'.',optimcycle       &     xx_hfluxm_file(1:il),'.',optimcycle
225        call active_read_xyz( fnamediffkr, tmpfld3d, 1,        call active_read_xy ( fnamehfluxm, tmpfld2d, 1,
226       &                      doglobalread, ladinit, optimcycle,       &                      doglobalread, ladinit, optimcycle,
227       &                      mythid, xx_diffkr_dummy )       &                      mythid, xx_hfluxm_dummy )
228        do bj = jtlo,jthi        do bj = jtlo,jthi
229          do bi = itlo,ithi          do bi = itlo,ithi
230            do k = 1,nr            do j = jmin,jmax
231              do j = jmin,jmax              do i = imin,imax
232                do i = imin,imax                Qnetm(i,j,bi,bj) = Qnetm(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
                 diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +  
      &                                tmpfld3d(i,j,k,bi,bj)  
               enddo  
233              enddo              enddo
234            enddo            enddo
235         enddo          enddo
236        enddo        enddo
237  #endif  #endif
238    
239  #ifdef ALLOW_KAPGM_CONTROL  #if (defined (ALLOW_TAUU0_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
240  c--   kapgm.         CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
241        il=ilnblnk( xx_kapgm_file )  #endif
242        write(fnamekapgm(1:80),'(2a,i10.10)')  #ifdef ALLOW_SFLUX0_CONTROL
243       &     xx_kapgm_file(1:il),'.',optimcycle         _EXCH_XY_RS(EmPmR, myThid )
244        call active_read_xyz( fnamekapgm, tmpfld3d, 1,  #endif
245       &                      doglobalread, ladinit, optimcycle,  #ifdef ALLOW_HFLUX0_CONTROL
246       &                      mythid, xx_kapgm_dummy )         _EXCH_XY_RS(Qnet,  myThid )
247        do bj = jtlo,jthi  #endif
248          do bi = itlo,ithi  #ifdef ALLOW_SST_CONTROL
249            do k = 1,nr         _EXCH_XY_RS(SST,   myThid )
250              do j = jmin,jmax  #endif
251                do i = imin,imax  #ifdef ALLOW_SSS_CONTROL
252                  kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +         _EXCH_XY_RS(SSS,   myThid )
253       &                               tmpfld3d(i,j,k,bi,bj)  #endif
254                enddo  #ifdef ALLOW_HFLUXM_CONTROL
255              enddo         _EXCH_XY_RS(Qnetm, myThid )
           enddo  
        enddo  
       enddo  
256  #endif  #endif
257    
258        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22