/[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.25 by heimbach, Thu Apr 19 16:06:43 2012 UTC revision 1.26 by jmc, Thu Jan 10 22:59:24 2013 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "EXF_OPTIONS.h"  #include "EXF_OPTIONS.h"
5    
6        subroutine exf_mapfields( mytime, myiter, mythid )  CBOP 0
7    C     !ROUTINE: EXF_MAPFIELDS
8    
9  c     ==================================================================  C     !INTERFACE:
10  c     SUBROUTINE exf_mapfields        SUBROUTINE EXF_MAPFIELDS( myTime, myIter, myThid )
 c     ==================================================================  
 c  
 c     o Map external forcing fields (ustress, vstress, hflux, sflux,  
 c       swflux, apressure, climsss, climsst, etc.) onto ocean model  
 c       arrays (fu, fv, Qnet, EmPmR, Qsw, pload, sss, sst, etc.).  
 c       This routine is included to separate the ocean state estimation  
 c       tool as much as possible from the ocean model.  Unit and sign  
 c       conventions can be customized using variables exf_outscal_*,  
 c       which are set in exf_readparms.F.  See the header files  
 c       EXF_FIELDS.h and FFIELDS.h for definitions of the various input  
 c       and output fields and for default unit and sign convetions.  
 c  
 c     started: Christian Eckert eckert@mit.edu  09-Aug-1999  
 c  
 c     changed: Christian Eckert eckert@mit.edu  11-Jan-2000  
 c              - Restructured the code in order to create a package  
 c                for the MITgcmUV.  
 c  
 c              Christian Eckert eckert@mit.edu  12-Feb-2000  
 c              - Changed Routine names (package prefix: exf_)  
 c  
 c              Patrick Heimbach, heimbach@mit.edu  06-May-2000  
 c              - added and changed CPP flag structure for  
 c                ALLOW_BULKFORMULAE, ALLOW_ATM_TEMP  
 c  
 c              Patrick Heimbach, heimbach@mit.edu  23-May-2000  
 c              - sign change of ustress/vstress incorporated into  
 c                scaling factors exf_outscal_ust, exf_outscal_vst  
 c  
 c     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002  
 c  
 c     ==================================================================  
 c     SUBROUTINE exf_mapfields  
 c     ==================================================================  
11    
12        implicit none  C     !DESCRIPTION:
13    C     ==================================================================
14    C     SUBROUTINE EXF_MAPFIELDS
15    C     ==================================================================
16    C
17    C     o Map external forcing fields (ustress, vstress, hflux, sflux,
18    C       swflux, apressure, climsss, climsst, etc.) onto ocean model
19    C       arrays (fu, fv, Qnet, EmPmR, Qsw, pLoad, SSS, SST, etc.).
20    C       This routine is included to separate the ocean state estimation
21    C       tool as much as possible from the ocean model.  Unit and sign
22    C       conventions can be customized using variables exf_outscal_*,
23    C       which are set in exf_readparms.F.  See the header files
24    C       EXF_FIELDS.h and FFIELDS.h for definitions of the various input
25    C       and output fields and for default unit and sign convetions.
26    C
27    C     started: Christian Eckert eckert@mit.edu  09-Aug-1999
28    C
29    C     changed: Christian Eckert eckert@mit.edu  11-Jan-2000
30    C              - Restructured the code in order to create a package
31    C                for the MITgcmUV.
32    C
33    C              Christian Eckert eckert@mit.edu  12-Feb-2000
34    C              - Changed Routine names (package prefix: exf_)
35    C
36    C              Patrick Heimbach, heimbach@mit.edu  06-May-2000
37    C              - added and changed CPP flag structure for
38    C                ALLOW_BULKFORMULAE, ALLOW_ATM_TEMP
39    C
40    C              Patrick Heimbach, heimbach@mit.edu  23-May-2000
41    C              - sign change of ustress/vstress incorporated into
42    C                scaling factors exf_outscal_ust, exf_outscal_vst
43    C
44    C     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
45    C
46    C     ==================================================================
47    C     SUBROUTINE EXF_MAPFIELDS
48    C     ==================================================================
49    
50  c     == global variables ==  C     !USES:
51          IMPLICIT NONE
52    
53    C     == global variables ==
54  #include "EEPARAMS.h"  #include "EEPARAMS.h"
55  #include "SIZE.h"  #include "SIZE.h"
56  #include "PARAMS.h"  #include "PARAMS.h"
# Line 59  c     == global variables == Line 64  c     == global variables ==
64  # include "tamc.h"  # include "tamc.h"
65  # include "tamc_keys.h"  # include "tamc_keys.h"
66  #endif  #endif
 c     == routine arguments ==  
67    
68  c     mythid - thread number for this instance of the routine.  C     !INPUT/OUTPUT PARAMETERS:
69    C     myTime  :: Current time in simulation
70        _RL     mytime  C     myIter  :: Current iteration number
71        integer myiter  C     myThid  :: my Thread Id number
72        integer mythid        _RL     myTime
73          INTEGER myIter
74  c     == local variables ==        INTEGER myThid
75    
76    C     !LOCAL VARIABLES:
77        INTEGER bi,bj        INTEGER bi,bj
78        INTEGER i,j,ks        INTEGER i,j,ks
79        INTEGER imin, imax        INTEGER imin, imax
80        INTEGER jmin, jmax        INTEGER jmin, jmax
81        PARAMETER ( imin = 1-OLx , imax = sNx+OLx )        PARAMETER ( imin = 1-OLx , imax = sNx+OLx )
82        PARAMETER ( jmin = 1-OLy , jmax = sNy+OLy )        PARAMETER ( jmin = 1-OLy , jmax = sNy+OLy )
83    CEOP
 c     == end of interface ==  
84    
85  C--   set surface level index:  C--   set surface level index:
86        ks = 1        ks = 1
87    
88        DO bj = myByLo(myThid),myByHi(myThid)        DO bj = myByLo(myThid),myByHi(myThid)
89          DO bi = myBxLo(myThid),myBxHi(myThid)         DO bi = myBxLo(myThid),myBxHi(myThid)
90    
91  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
92            act1 = bi - myBxLo(myThid)            act1 = bi - myBxLo(myThid)
# Line 97  C--   set surface level index: Line 101  C--   set surface level index:
101       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
102  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
103    
104  c     Heat flux.  C     Heat flux.
105            do j = jmin,jmax            DO j = jmin,jmax
106              do i = imin,imax              DO i = imin,imax
107               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)
108              enddo              ENDDO
109            enddo            ENDDO
110            if ( hfluxfile .EQ. ' ' ) then            IF ( hfluxfile .EQ. ' ' ) THEN
111             do j = jmin,jmax             DO j = jmin,jmax
112              do i = imin,imax              DO i = imin,imax
113                    qnet(i,j,bi,bj) = qnet(i,j,bi,bj) -               Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) -
114       &            exf_outscal_hflux * ( hflux_exfremo_intercept +       &            exf_outscal_hflux * ( hflux_exfremo_intercept +
115       &            hflux_exfremo_slope*(mytime-starttime) )       &            hflux_exfremo_slope*(myTime-startTime) )
116              enddo              ENDDO
117             enddo             ENDDO
118            endif            ENDIF
119    
120  c     Salt flux.  C     Salt flux.
121            do j = jmin,jmax            DO j = jmin,jmax
122              do i = imin,imax              DO i = imin,imax
123               EmPmR(i,j,bi,bj)= exf_outscal_sflux*sflux(i,j,bi,bj)               EmPmR(i,j,bi,bj)= exf_outscal_sflux*sflux(i,j,bi,bj)
124       &                                          *rhoConstFresh       &                                          *rhoConstFresh
125              enddo              ENDDO
126            enddo            ENDDO
127            if ( sfluxfile .EQ. ' ' ) then            IF ( sfluxfile .EQ. ' ' ) THEN
128             do j = jmin,jmax             DO j = jmin,jmax
129              do i = imin,imax              DO i = imin,imax
130                   EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj) - rhoConstFresh*               EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj) - rhoConstFresh*
131       &            exf_outscal_sflux * ( sflux_exfremo_intercept +       &            exf_outscal_sflux * ( sflux_exfremo_intercept +
132       &            sflux_exfremo_slope*(mytime-starttime) )       &            sflux_exfremo_slope*(myTime-startTime) )
133              enddo              ENDDO
134             enddo             ENDDO
135            endif            ENDIF
136    
137  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
138  CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
139  #endif  #endif
140            do j = jmin,jmax            DO j = jmin,jmax
141              do i = imin,imax              DO i = imin,imax
142  c             Zonal wind stress.  C             Zonal wind stress.
143                if (ustress(i,j,bi,bj).gt.windstressmax) then                IF (ustress(i,j,bi,bj).GT.windstressmax) THEN
144                  ustress(i,j,bi,bj)=windstressmax                  ustress(i,j,bi,bj)=windstressmax
145                endif                ENDIF
146              enddo              ENDDO
147            enddo            ENDDO
148  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
149  CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
150  #endif  #endif
151            do j = jmin,jmax            DO j = jmin,jmax
152              do i = imin,imax              DO i = imin,imax
153                if (ustress(i,j,bi,bj).lt.-windstressmax) then                IF (ustress(i,j,bi,bj).LT.-windstressmax) THEN
154                  ustress(i,j,bi,bj)=-windstressmax                  ustress(i,j,bi,bj)=-windstressmax
155                endif                ENDIF
156              enddo              ENDDO
157            enddo            ENDDO
158            IF ( stressIsOnCgrid ) THEN            IF ( stressIsOnCgrid ) THEN
159             do j = jmin,jmax             DO j = jmin,jmax
160              do i = imin+1,imax              DO i = imin+1,imax
161                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)
162              enddo              ENDDO
163             enddo             ENDDO
164            ELSE            ELSE
165             do j = jmin,jmax             DO j = jmin,jmax
166              do i = imin+1,imax              DO i = imin+1,imax
167  c     Shift wind stresses calculated at Grid-center to W/S points  C     Shift wind stresses calculated at Grid-center to W/S points
168                fu(i,j,bi,bj) = exf_outscal_ustress*                fu(i,j,bi,bj) = exf_outscal_ustress*
169       &              (ustress(i,j,bi,bj)+ustress(i-1,j,bi,bj))       &              (ustress(i,j,bi,bj)+ustress(i-1,j,bi,bj))
170       &              *exf_half*maskW(i,j,ks,bi,bj)       &              *exf_half*maskW(i,j,ks,bi,bj)
171              enddo              ENDDO
172             enddo             ENDDO
173            ENDIF            ENDIF
174    
175  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
176  CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
177  #endif  #endif
178            do j = jmin,jmax            DO j = jmin,jmax
179              do i = imin,imax              DO i = imin,imax
180  c             Meridional wind stress.  C             Meridional wind stress.
181                if (vstress(i,j,bi,bj).gt.windstressmax) then                IF (vstress(i,j,bi,bj).GT.windstressmax) THEN
182                  vstress(i,j,bi,bj)=windstressmax                  vstress(i,j,bi,bj)=windstressmax
183                endif                ENDIF
184              enddo              ENDDO
185            enddo            ENDDO
186  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
187  CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
188  #endif  #endif
189            do j = jmin,jmax            DO j = jmin,jmax
190              do i = imin,imax              DO i = imin,imax
191                if (vstress(i,j,bi,bj).lt.-windstressmax) then                IF (vstress(i,j,bi,bj).LT.-windstressmax) THEN
192                  vstress(i,j,bi,bj)=-windstressmax                  vstress(i,j,bi,bj)=-windstressmax
193                endif                ENDIF
194              enddo              ENDDO
195            enddo            ENDDO
196            IF ( stressIsOnCgrid ) THEN            IF ( stressIsOnCgrid ) THEN
197             do j = jmin+1,jmax             DO j = jmin+1,jmax
198              do i = imin,imax              DO i = imin,imax
199                fv(i,j,bi,bj) = exf_outscal_vstress*vstress(i,j,bi,bj)                fv(i,j,bi,bj) = exf_outscal_vstress*vstress(i,j,bi,bj)
200              enddo              ENDDO
201             enddo             ENDDO
202            ELSE            ELSE
203             do j = jmin+1,jmax             DO j = jmin+1,jmax
204              do i = imin,imax              DO i = imin,imax
205  c     Shift wind stresses calculated at C-points to W/S points  C     Shift wind stresses calculated at C-points to W/S points
206                fv(i,j,bi,bj) = exf_outscal_vstress*                fv(i,j,bi,bj) = exf_outscal_vstress*
207       &              (vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))       &              (vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))
208       &              *exf_half*maskS(i,j,ks,bi,bj)       &              *exf_half*maskS(i,j,ks,bi,bj)
209              enddo              ENDDO
210             enddo             ENDDO
211            ENDIF            ENDIF
212    
213  #ifdef SHORTWAVE_HEATING  #if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
214  c             Short wave radiative flux.  C             Short wave radiative flux.
215            do j = jmin,jmax            DO j = jmin,jmax
216              do i = imin,imax              DO i = imin,imax
217               qsw(i,j,bi,bj)  = exf_outscal_swflux*swflux(i,j,bi,bj)               Qsw(i,j,bi,bj)  = exf_outscal_swflux*swflux(i,j,bi,bj)
218              enddo              ENDDO
219            enddo            ENDDO
220  #endif  #endif
221    
222  #ifdef ALLOW_CLIMSST_RELAXATION  #ifdef ALLOW_CLIMSST_RELAXATION
223            do j = jmin,jmax            DO j = jmin,jmax
224              do i = imin,imax              DO i = imin,imax
225               sst(i,j,bi,bj)  = exf_outscal_sst*climsst(i,j,bi,bj)               SST(i,j,bi,bj)  = exf_outscal_sst*climsst(i,j,bi,bj)
226              enddo              ENDDO
227            enddo            ENDDO
228  #endif  #endif
229    
230  #ifdef ALLOW_CLIMSSS_RELAXATION  #ifdef ALLOW_CLIMSSS_RELAXATION
231            do j = jmin,jmax            DO j = jmin,jmax
232              do i = imin,imax              DO i = imin,imax
233               sss(i,j,bi,bj)  = exf_outscal_sss*climsss(i,j,bi,bj)               SSS(i,j,bi,bj)  = exf_outscal_sss*climsss(i,j,bi,bj)
234              enddo              ENDDO
235            enddo            ENDDO
236  #endif  #endif
237    
238  #ifdef ATMOSPHERIC_LOADING  #ifdef ATMOSPHERIC_LOADING
239            do j = jmin,jmax            DO j = jmin,jmax
240              do i = imin,imax              DO i = imin,imax
241               pload(i,j,bi,bj)=exf_outscal_apressure*apressure(i,j,bi,bj)               pLoad(i,j,bi,bj)=exf_outscal_apressure*apressure(i,j,bi,bj)
242              enddo              ENDDO
243            enddo            ENDDO
244  #endif  #endif
245    
246  #ifdef EXF_ALLOW_SEAICE_RELAX  #ifdef EXF_ALLOW_SEAICE_RELAX
247            do j = jmin,jmax            DO j = jmin,jmax
248              do i = imin,imax              DO i = imin,imax
249                 obsSIce(i,j,bi,bj) =                obsSIce(i,j,bi,bj) =
250       &           exf_outscal_areamask*areamask(i,j,bi,bj)       &           exf_outscal_areamask*areamask(i,j,bi,bj)
251                obsSIce(I,J,bi,bj) =                obsSIce(I,J,bi,bj) =
252       &           MIN(MAX(obsSIce(I,J,bi,bj), 0.d0 ), 1.d0)       &           MIN(MAX(obsSIce(I,J,bi,bj), 0.d0 ), 1.d0)
253              enddo              ENDDO
254            enddo            ENDDO
255  #endif  #endif
256    
257          ENDDO         ENDDO
258        ENDDO        ENDDO
259    
260  c     Update the tile edges.  C--   Update the tile edges.
261          _EXCH_XY_RS(  Qnet, myThid )
262        _EXCH_XY_RS(  qnet, mythid )        _EXCH_XY_RS( EmPmR, myThid )
       _EXCH_XY_RS( empmr, mythid )  
263         CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)         CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
264    c#if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
265  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
266        _EXCH_XY_RS(   qsw, mythid )  C     Qsw used in SHORTWAVE_HEATING code & for diagnostics (<- EXCH not needed)
267          _EXCH_XY_RS(   Qsw, myThid )
268  #endif  #endif
269  #ifdef ALLOW_CLIMSST_RELAXATION  #ifdef ALLOW_CLIMSST_RELAXATION
270        _EXCH_XY_RS(   sst, mythid )        _EXCH_XY_RS(   SST, myThid )
271  #endif  #endif
272  #ifdef ALLOW_CLIMSSS_RELAXATION  #ifdef ALLOW_CLIMSSS_RELAXATION
273        _EXCH_XY_RS(   sss, mythid )        _EXCH_XY_RS(   SSS, myThid )
274  #endif  #endif
275  #ifdef ATMOSPHERIC_LOADING  #ifdef ATMOSPHERIC_LOADING
276        _EXCH_XY_RS( pload, mythid )        _EXCH_XY_RS( pLoad, myThid )
277  #endif  #endif
278  #ifdef EXF_ALLOW_SEAICE_RELAX  #ifdef EXF_ALLOW_SEAICE_RELAX
279        _EXCH_XY_RS( obsSIce, mythid)        _EXCH_XY_RS( obsSIce, myThid )
280  #endif  #endif
281    
282        RETURN        RETURN
Legend:
Removed from v.1.25  
changed lines
  Added in v.1.26
  ViewVC Help
Powered by ViewVC 1.1.22