/[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.13 by heimbach, Tue Dec 13 19:46:46 2005 UTC revision 1.23 by jmc, Tue Apr 28 18:15:33 2009 UTC
# Line 1  Line 1 
1  c $Header$  C $Header$
2    C $Name$
3    
4  #include "EXF_OPTIONS.h"  #include "EXF_OPTIONS.h"
5    
6        subroutine exf_mapfields( mythid )        subroutine exf_mapfields( mytime, myiter, mythid )
7    
8  c     ==================================================================  c     ==================================================================
9  c     SUBROUTINE exf_mapfields  c     SUBROUTINE exf_mapfields
# Line 15  c       This routine is included to sepa Line 16  c       This routine is included to sepa
16  c       tool as much as possible from the ocean model.  Unit and sign  c       tool as much as possible from the ocean model.  Unit and sign
17  c       conventions can be customized using variables exf_outscal_*,  c       conventions can be customized using variables exf_outscal_*,
18  c       which are set in exf_readparms.F.  See the header files  c       which are set in exf_readparms.F.  See the header files
19  c       exf_fields.h and FFIELDS.h for definitions of the various input  c       EXF_FIELDS.h and FFIELDS.h for definitions of the various input
20  c       and output fields and for default unit and sign convetions.  c       and output fields and for default unit and sign convetions.
21  c  c
22  c     started: Christian Eckert eckert@mit.edu  09-Aug-1999  c     started: Christian Eckert eckert@mit.edu  09-Aug-1999
# Line 47  c     == global variables == Line 48  c     == global variables ==
48    
49  #include "EEPARAMS.h"  #include "EEPARAMS.h"
50  #include "SIZE.h"  #include "SIZE.h"
51    #include "PARAMS.h"
52  #include "FFIELDS.h"  #include "FFIELDS.h"
53  #include "GRID.h"  #include "GRID.h"
54    
55  #include "exf_param.h"  #include "EXF_PARAM.h"
56  #include "exf_constants.h"  #include "EXF_CONSTANTS.h"
57  #include "exf_fields.h"  #include "EXF_FIELDS.h"
 #include "exf_clim_param.h"  
 #include "exf_clim_fields.h"  
58  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
59  # include "tamc.h"  # include "tamc.h"
60  # include "tamc_keys.h"  # include "tamc_keys.h"
# Line 63  c     == routine arguments == Line 63  c     == routine arguments ==
63    
64  c     mythid - thread number for this instance of the routine.  c     mythid - thread number for this instance of the routine.
65    
66          _RL     mytime
67          integer myiter
68        integer mythid        integer mythid
69    
70  c     == local variables ==  c     == local variables ==
71    
72        integer bi,bj        integer bi,bj
73        integer i,j,k        integer i,j,k
74        integer jtlo        INTEGER imin, imax
75        integer jthi        INTEGER jmin, jmax
76        integer itlo        PARAMETER ( imin = 1-OLx , imax = sNx+OLx )
77        integer ithi        PARAMETER ( jmin = 1-OLy , jmax = sNy+OLy )
       integer jmin  
       integer jmax  
       integer imin  
       integer imax  
78    
79  c     == end of interface ==  c     == end of interface ==
80    
81        jtlo = mybylo(mythid)        DO bj = myByLo(myThid),myByHi(myThid)
82        jthi = mybyhi(mythid)          DO bi = myBxLo(myThid),myBxHi(myThid)
       itlo = mybxlo(mythid)  
       ithi = mybxhi(mythid)  
       jmin = 1-oly  
       jmax = sny+oly  
       imin = 1-olx  
       imax = snx+olx  
   
       do bj = jtlo,jthi  
         do bi = itlo,ithi  
83    
84  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
85            act1 = bi - myBxLo(myThid)            act1 = bi - myBxLo(myThid)
# Line 105  c     == end of interface == Line 94  c     == end of interface ==
94       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
95  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
96    
97    c     Heat flux.
98            do j = jmin,jmax            do j = jmin,jmax
99              do i = imin,imax              do i = imin,imax
 c            Heat flux.  
100               qnet(i,j,bi,bj) = exf_outscal_hflux*hflux(i,j,bi,bj)               qnet(i,j,bi,bj) = exf_outscal_hflux*hflux(i,j,bi,bj)
101              enddo              enddo
102            enddo            enddo
103              if ( hfluxfile .EQ. ' ' ) then
104               do j = jmin,jmax
105                do i = imin,imax
106                      qnet(i,j,bi,bj) = qnet(i,j,bi,bj) -
107         &            exf_outscal_hflux * ( hflux_exfremo_intercept +
108         &            hflux_exfremo_slope*(mytime-starttime) )
109                enddo
110               enddo
111              endif
112    
113    c     Salt flux.
114            do j = jmin,jmax            do j = jmin,jmax
115              do i = imin,imax              do i = imin,imax
116  c            Salt flux.               EmPmR(i,j,bi,bj)= exf_outscal_sflux*sflux(i,j,bi,bj)
117               empmr(i,j,bi,bj)= exf_outscal_sflux*sflux(i,j,bi,bj)       &                                          *rhoConstFresh
118              enddo              enddo
119            enddo            enddo
120              if ( sfluxfile .EQ. ' ' ) then
121               do j = jmin,jmax
122                do i = imin,imax
123                     EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj) - rhoConstFresh*
124         &            exf_outscal_sflux * ( sflux_exfremo_intercept +
125         &            sflux_exfremo_slope*(mytime-starttime) )
126                enddo
127               enddo
128              endif
129    
130  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
131  CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
# Line 141  CADJ STORE ustress(:,:,bi,bj) = comlev1_ Line 148  CADJ STORE ustress(:,:,bi,bj) = comlev1_
148                endif                endif
149              enddo              enddo
150            enddo            enddo
151            do j = jmin,jmax            IF ( stressIsOnCgrid ) THEN
152               do j = jmin,jmax
153              do i = imin+1,imax              do i = imin+1,imax
 #if (defined (ALLOW_BULKFORMULAE) || defined (USE_EXF_INTERPOLATION))  
 c     Shift wind stresses calculated at C-points to W/S points  
               fu(i,j,bi,bj) = exf_outscal_ustress*  
      &              (ustress(i,j,bi,bj)+ustress(i-1,j,bi,bj))/2.*  
      &              maskW(i,j,1,bi,bj)  
 #else  
154                fu(i,j,bi,bj) = exf_outscal_ustress*ustress(i,j,bi,bj)                fu(i,j,bi,bj) = exf_outscal_ustress*ustress(i,j,bi,bj)
 #endif  
155              enddo              enddo
156            enddo             enddo
157              ELSE
158               do j = jmin,jmax
159                do i = imin+1,imax
160    c     Shift wind stresses calculated at Grid-center to W/S points
161                  fu(i,j,bi,bj) = exf_outscal_ustress*
162         &              (ustress(i,j,bi,bj)+ustress(i-1,j,bi,bj))
163         &              *exf_half*maskW(i,j,1,bi,bj)
164                enddo
165               enddo
166              ENDIF
167    
168  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
169  CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
# Line 175  CADJ STORE vstress(:,:,bi,bj) = comlev1_ Line 186  CADJ STORE vstress(:,:,bi,bj) = comlev1_
186                endif                endif
187              enddo              enddo
188            enddo            enddo
189            do j = jmin+1,jmax            IF ( stressIsOnCgrid ) THEN
190               do j = jmin+1,jmax
191                do i = imin,imax
192                  fv(i,j,bi,bj) = exf_outscal_vstress*vstress(i,j,bi,bj)
193                enddo
194               enddo
195              ELSE
196               do j = jmin+1,jmax
197              do i = imin,imax              do i = imin,imax
 #if (defined (ALLOW_BULKFORMULAE) || defined (USE_EXF_INTERPOLATION))  
198  c     Shift wind stresses calculated at C-points to W/S points  c     Shift wind stresses calculated at C-points to W/S points
199                fv(i,j,bi,bj) = exf_outscal_vstress*                fv(i,j,bi,bj) = exf_outscal_vstress*
200       &              (vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))/2.*       &              (vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))
201       &              maskS(i,j,1,bi,bj)       &              *exf_half*maskS(i,j,1,bi,bj)
 #else  
               fv(i,j,bi,bj) = exf_outscal_vstress*vstress(i,j,bi,bj)  
 #endif  
202              enddo              enddo
203            enddo             enddo
204              ENDIF
205    
206  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
207  c             Short wave radiative flux.  c             Short wave radiative flux.
# Line 213  c             Short wave radiative flux. Line 228  c             Short wave radiative flux.
228            enddo            enddo
229  #endif  #endif
230    
 #ifdef ALLOW_CLIMTEMP_RELAXATION  
           if ( climtempfile .NE. ' ' ) then  
              do k = 1, Nr  
                 do j = jmin,jmax  
                    do i = imin,imax  
                       thetaStar(i,j,k,bi,bj)  = climtemp(i,j,k,bi,bj)  
                    enddo  
                 enddo  
              enddo  
           endif  
 #endif  
   
 #ifdef ALLOW_CLIMSALT_RELAXATION  
           if ( climsaltfile .NE. ' ' ) then  
              do k = 1, Nr  
                 do j = jmin,jmax  
                    do i = imin,imax  
                       saltStar(i,j,k,bi,bj)  = climsalt(i,j,k,bi,bj)  
                    enddo  
                 enddo  
              enddo  
           endif  
 #endif  
   
231  #ifdef ATMOSPHERIC_LOADING  #ifdef ATMOSPHERIC_LOADING
232            do j = jmin,jmax            do j = jmin,jmax
233              do i = imin,imax              do i = imin,imax
# Line 245  c             Short wave radiative flux. Line 236  c             Short wave radiative flux.
236            enddo            enddo
237  #endif  #endif
238    
239          enddo          ENDDO
240        enddo        ENDDO
241    
242  c     Update the tile edges.  c     Update the tile edges.
243    
244        _EXCH_XY_R4(  qnet, mythid )        _EXCH_XY_RS(  qnet, mythid )
245        _EXCH_XY_R4( empmr, mythid )        _EXCH_XY_RS( empmr, mythid )
 c      _EXCH_XY_R4(    fu, mythid )  
 c      _EXCH_XY_R4(    fv, mythid )  
246         CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)         CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
247  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
248        _EXCH_XY_R4(   qsw, mythid )        _EXCH_XY_RS(   qsw, mythid )
249  #endif  #endif
250  #ifdef ALLOW_CLIMSST_RELAXATION  #ifdef ALLOW_CLIMSST_RELAXATION
251        _EXCH_XY_R4(   sst, mythid )        _EXCH_XY_RS(   sst, mythid )
252  #endif  #endif
253  #ifdef ALLOW_CLIMSSS_RELAXATION  #ifdef ALLOW_CLIMSSS_RELAXATION
254        _EXCH_XY_R4(   sss, mythid )        _EXCH_XY_RS(   sss, mythid )
 #endif  
 #ifdef ALLOW_CLIMTEMP_RELAXATION  
       _EXCH_XYZ_R4( thetaStar, mythid )  
 #endif  
 #ifdef ALLOW_CLIMSALT_RELAXATION  
       _EXCH_XYZ_R4( saltStar, mythid )  
255  #endif  #endif
256  #ifdef ATMOSPHERIC_LOADING  #ifdef ATMOSPHERIC_LOADING
257        _EXCH_XY_R4( pload, mythid )        _EXCH_XY_RS( pload, mythid )
258  #endif  #endif
259    
260        end        RETURN
261          END
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22