/[MITgcm]/MITgcm/pkg/exf/exf_mapfields.F
ViewVC logotype

Diff of /MITgcm/pkg/exf/exf_mapfields.F

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

revision 1.1 by heimbach, Mon May 14 22:08:41 2001 UTC revision 1.4 by dimitri, Sat Dec 28 10:11:11 2002 UTC
# Line 3  c $Header$ Line 3  c $Header$
3  #include "EXF_CPPOPTIONS.h"  #include "EXF_CPPOPTIONS.h"
4    
5    
6        subroutine exf_MapFields(        subroutine exf_mapfields( mythid )
      I                          mythid  
      &                        )  
7    
8  c     ==================================================================  c     ==================================================================
9  c     SUBROUTINE exf_MapFields  c     SUBROUTINE exf_mapfields
10  c     ==================================================================  c     ==================================================================
11  c  c
12  c     o Map the external forcing fields on the ocean model arrays. This  c     o Map the external forcing fields on the ocean model arrays. This
# Line 51  c Line 49  c
49  c              - sign change of ustress/vstress incorporated into  c              - sign change of ustress/vstress incorporated into
50  c                scaling factors scal_ust, scal_vst  c                scaling factors scal_ust, scal_vst
51  c  c
52    c              Dimitris Menemenlis, menemenlis@jpl.nasa.gov 20-Dec-2002
53    c
54    c              - removed: empmr(i,j,bi,bj) = scal_prc*precip(i,j,bi,bj)
55    c
56  c     ==================================================================  c     ==================================================================
57  c     SUBROUTINE exf_MapFields  c     SUBROUTINE exf_mapfields
58  c     ==================================================================  c     ==================================================================
59    
60        implicit none        implicit none
# Line 62  c     == global variables == Line 64  c     == global variables ==
64  #include "EEPARAMS.h"  #include "EEPARAMS.h"
65  #include "SIZE.h"  #include "SIZE.h"
66  #include "FFIELDS.h"  #include "FFIELDS.h"
67    #include "exf_param.h"
68  #include "exf_constants.h"  #include "exf_constants.h"
69  #include "exf_fields.h"  #include "exf_fields.h"
70  #include "exf_clim_fields.h"  #include "exf_clim_fields.h"
71    #ifdef ALLOW_AUTODIFF_TAMC
72    # include "tamc.h"
73    # include "tamc_keys.h"
74    #endif
75  c     == routine arguments ==  c     == routine arguments ==
76    
77  c     mythid - thread number for this instance of the routine.  c     mythid - thread number for this instance of the routine.
# Line 84  c     == local variables == Line 90  c     == local variables ==
90        integer jmax        integer jmax
91        integer imin        integer imin
92        integer imax        integer imax
       _RL     scal_hfl  
       _RL     scal_ust  
       _RL     scal_vst  
       _RL     scal_swf  
       _RL     scal_sst  
       _RL     scal_sss  
 #if (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP))  
       _RL     scal_prc  
 #else  
       _RL     scal_sfl  
 #endif  
93    
94  c     == end of interface ==  c     == end of interface ==
95    
# Line 107  c     == end of interface == Line 102  c     == end of interface ==
102        imin = 1-olx        imin = 1-olx
103        imax = snx+olx        imax = snx+olx
104    
       scal_hfl =  1. _d 0  
       scal_ust =  -1. _d 0  
       scal_vst =  -1. _d 0  
       scal_swf =  1. _d 0  
       scal_sst =  1. _d 0  
       scal_sss =  1. _d 0  
 #if (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP))  
       scal_prc =  1. _d 0  
 #else  
       scal_sfl =  1. _d 0      
 #endif  
   
105        do bj = jtlo,jthi        do bj = jtlo,jthi
106          do bi = itlo,ithi          do bi = itlo,ithi
107    
108    #ifdef ALLOW_AUTODIFF_TAMC
109              act1 = bi - myBxLo(myThid)
110              max1 = myBxHi(myThid) - myBxLo(myThid) + 1
111              act2 = bj - myByLo(myThid)
112              max2 = myByHi(myThid) - myByLo(myThid) + 1
113              act3 = myThid - 1
114              max3 = nTx*nTy
115              act4 = ikey_dynamics - 1
116              ikey = (act1 + 1) + act2*max1
117         &                      + act3*max1*max2
118         &                      + act4*max1*max2*max3
119    #endif /* ALLOW_AUTODIFF_TAMC */
120    
121            do j = jmin,jmax            do j = jmin,jmax
122              do i = imin,imax              do i = imin,imax
   
123  c             Heat flux.  c             Heat flux.
124                qnet(i,j,bi,bj)  = scal_hfl*hflux(i,j,bi,bj)                qnet(i,j,bi,bj)  = scal_hfl*hflux(i,j,bi,bj)
125                enddo
126              enddo
127    
128    
129              do j = jmin,jmax
130                do i = imin,imax
131  c             Salt flux.  c             Salt flux.
 #if (defined (ALLOW_BULKFORMULAE)  && defined (ALLOW_ATM_TEMP))  
               empmr(i,j,bi,bj) = scal_prc*precip(i,j,bi,bj)  
 #else  
132                empmr(i,j,bi,bj) = scal_sfl*sflux(i,j,bi,bj)                empmr(i,j,bi,bj) = scal_sfl*sflux(i,j,bi,bj)
133  #endif              enddo
134              enddo
135    
136    #ifdef ALLOW_AUTODIFF_TAMC
137    CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
138    #endif
139              do j = jmin,jmax
140                do i = imin,imax
141  c             Zonal wind stress.  c             Zonal wind stress.
142                  if (ustress(i,j,bi,bj).gt.2.0D0) then
143                    ustress(i,j,bi,bj)=2.0D0
144                  endif
145                enddo
146              enddo
147    #ifdef ALLOW_AUTODIFF_TAMC
148    CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
149    #endif
150              do j = jmin,jmax
151                do i = imin,imax
152                  if (ustress(i,j,bi,bj).lt.-2.0D0) then
153                    ustress(i,j,bi,bj)=-2.0D0
154                  endif
155                enddo
156              enddo
157              do j = jmin,jmax
158                do i = imin,imax
159                fu(i,j,bi,bj)    = scal_ust*ustress(i,j,bi,bj)                fu(i,j,bi,bj)    = scal_ust*ustress(i,j,bi,bj)
160                enddo
161              enddo
162    
163    #ifdef ALLOW_AUTODIFF_TAMC
164    CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
165    #endif
166              do j = jmin,jmax
167                do i = imin,imax
168  c             Meridional wind stress.  c             Meridional wind stress.
169                  if (vstress(i,j,bi,bj).gt.2.0D0) then
170                    vstress(i,j,bi,bj)=2.0D0
171                  endif
172                enddo
173              enddo
174    #ifdef ALLOW_AUTODIFF_TAMC
175    CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
176    #endif
177              do j = jmin,jmax
178                do i = imin,imax
179                  if (vstress(i,j,bi,bj).lt.-2.0D0) then
180                    vstress(i,j,bi,bj)=-2.0D0
181                  endif
182                enddo
183              enddo
184              do j = jmin,jmax
185                do i = imin,imax
186                fv(i,j,bi,bj)    = scal_vst*vstress(i,j,bi,bj)                fv(i,j,bi,bj)    = scal_vst*vstress(i,j,bi,bj)
187                enddo
188              enddo
189    
190  #ifdef ALLOW_KPP || (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP)))  #ifdef ALLOW_KPP || \
191     (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP)))
192  c             Short wave radiative flux.  c             Short wave radiative flux.
193              do j = jmin,jmax
194                do i = imin,imax
195                qsw(i,j,bi,bj)   = scal_swf*swflux(i,j,bi,bj)                qsw(i,j,bi,bj)   = scal_swf*swflux(i,j,bi,bj)
196                enddo
197              enddo
198  #endif  #endif
199    
200  #ifdef ALLOW_CLIMSST_RELAXATION  #ifdef ALLOW_CLIMSST_RELAXATION
201              do j = jmin,jmax
202                do i = imin,imax
203                sst(i,j,bi,bj)   = scal_sst*climsst(i,j,bi,bj)                sst(i,j,bi,bj)   = scal_sst*climsst(i,j,bi,bj)
204                enddo
205              enddo
206  #endif  #endif
207    
208  #ifdef ALLOW_CLIMSSS_RELAXATION  #ifdef ALLOW_CLIMSSS_RELAXATION
209              do j = jmin,jmax
210                do i = imin,imax
211                sss(i,j,bi,bj)   = scal_sss*climsss(i,j,bi,bj)                sss(i,j,bi,bj)   = scal_sss*climsss(i,j,bi,bj)
212                enddo
213              enddo
214  #endif  #endif
215    
216    #ifdef ATMOSPHERIC_LOADING
217              do j = jmin,jmax
218                do i = imin,imax
219                  pload(i,j,bi,bj) = scal_apressure*apressure(i,j,bi,bj)
220              enddo              enddo
221            enddo            enddo
222    #endif
223    
224    
225          enddo          enddo
226        enddo        enddo
227    
# Line 162  c     Update the tile edges. Line 229  c     Update the tile edges.
229    
230        _EXCH_XY_R4(  qnet, mythid )        _EXCH_XY_R4(  qnet, mythid )
231        _EXCH_XY_R4( empmr, mythid )        _EXCH_XY_R4( empmr, mythid )
232        _EXCH_XY_R4(    fu, mythid )  c      _EXCH_XY_R4(    fu, mythid )
233        _EXCH_XY_R4(    fv, mythid )  c      _EXCH_XY_R4(    fv, mythid )
234           CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
235  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
236        _EXCH_XY_R4(   qsw, mythid )        _EXCH_XY_R4(   qsw, mythid )
237  #endif  #endif
# Line 173  c     Update the tile edges. Line 241  c     Update the tile edges.
241  #ifdef ALLOW_CLIMSSS_RELAXATION  #ifdef ALLOW_CLIMSSS_RELAXATION
242        _EXCH_XY_R4(   sss, mythid )        _EXCH_XY_R4(   sss, mythid )
243  #endif  #endif
244    #ifdef ATMOSPHERIC_LOADING
245          _EXCH_XY_R4( pload, mythid )
246    #endif
247    
248        end        end
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22