/[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.21 by mlosch, Thu Sep 27 09:41:13 2007 UTC
# Line 1  Line 1 
1  c $Header$  C $Header$
2    C $Name$
3    
4  #include "EXF_CPPOPTIONS.h"  #include "EXF_OPTIONS.h"
5    
6          subroutine exf_mapfields( mytime, myiter, mythid )
       subroutine exf_MapFields(  
      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 external forcing fields (ustress, vstress, hflux, sflux,
13  c       routine is included to separate the ocean state estimation tool  c       swflux, apressure, climsss, climsst, etc.) onto ocean model
14  c       as much as possible from the ocean model. Unit conversion factors  c       arrays (fu, fv, Qnet, EmPmR, Qsw, pload, sss, sst, etc.).
15  c       are to be set by the user.  c       This routine is included to separate the ocean state estimation
16  c  c       tool as much as possible from the ocean model.  Unit and sign
17  c       The units have to be such that the individual forcing record has  c       conventions can be customized using variables exf_outscal_*,
18  c       units equal to [quantity/s]. See the header file *FFIELDS.h* of  c       which are set in exf_readparms.F.  See the header files
19  c       the MITgcmuv.  c       EXF_FIELDS.h and FFIELDS.h for definitions of the various input
20  c  c       and output fields and for default unit and sign convetions.
 c       Required units such that no scaling has to be applied:  
 c  
 c       heat flux:          input file W/m^2  
 c       salt flux:          input file m/s  
 c       zonal wind stress:  input file N/m^2  
 c       merid. wind stress: input file N/m^2  
 c  
 c       To allow for such unit conversions this routine contains scaling  
 c       factors scal_quantity.  
21  c  c
22  c     started: Christian Eckert eckert@mit.edu  09-Aug-1999  c     started: Christian Eckert eckert@mit.edu  09-Aug-1999
23  c  c
24  c     changed: Christian Eckert eckert@mit.edu  11-Jan-2000  c     changed: Christian Eckert eckert@mit.edu  11-Jan-2000
 c  
25  c              - Restructured the code in order to create a package  c              - Restructured the code in order to create a package
26  c                for the MITgcmUV.  c                for the MITgcmUV.
27  c  c
28  c              Christian Eckert eckert@mit.edu  12-Feb-2000  c              Christian Eckert eckert@mit.edu  12-Feb-2000
 c  
29  c              - Changed Routine names (package prefix: exf_)  c              - Changed Routine names (package prefix: exf_)
30  c  c
31  c              Patrick Heimbach, heimbach@mit.edu  06-May-2000  c              Patrick Heimbach, heimbach@mit.edu  06-May-2000
 c  
32  c              - added and changed CPP flag structure for  c              - added and changed CPP flag structure for
33  c                ALLOW_BULKFORMULAE, ALLOW_ATM_TEMP  c                ALLOW_BULKFORMULAE, ALLOW_ATM_TEMP
34  c  c
35  c              Patrick Heimbach, heimbach@mit.edu  23-May-2000  c              Patrick Heimbach, heimbach@mit.edu  23-May-2000
 c  
36  c              - sign change of ustress/vstress incorporated into  c              - sign change of ustress/vstress incorporated into
37  c                scaling factors scal_ust, scal_vst  c                scaling factors exf_outscal_ust, exf_outscal_vst
38    c
39    c     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
40  c  c
41  c     ==================================================================  c     ==================================================================
42  c     SUBROUTINE exf_MapFields  c     SUBROUTINE exf_mapfields
43  c     ==================================================================  c     ==================================================================
44    
45        implicit none        implicit none
# Line 61  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 "exf_constants.h"  #include "GRID.h"
 #include "exf_fields.h"  
 #include "exf_clim_fields.h"  
54    
55    #include "EXF_PARAM.h"
56    #include "EXF_CONSTANTS.h"
57    #include "EXF_FIELDS.h"
58    #ifdef ALLOW_AUTODIFF_TAMC
59    # include "tamc.h"
60    # include "tamc_keys.h"
61    #endif
62  c     == routine arguments ==  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        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  
       _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  
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)
83        itlo = mybxlo(mythid)  
84        ithi = mybxhi(mythid)  #ifdef ALLOW_AUTODIFF_TAMC
85        jmin = 1-oly            act1 = bi - myBxLo(myThid)
86        jmax = sny+oly            max1 = myBxHi(myThid) - myBxLo(myThid) + 1
87        imin = 1-olx            act2 = bj - myByLo(myThid)
88        imax = snx+olx            max2 = myByHi(myThid) - myByLo(myThid) + 1
89              act3 = myThid - 1
90        scal_hfl =  1. _d 0            max3 = nTx*nTy
91        scal_ust =  -1. _d 0            act4 = ikey_dynamics - 1
92        scal_vst =  -1. _d 0            ikey = (act1 + 1) + act2*max1
93        scal_swf =  1. _d 0       &                      + act3*max1*max2
94        scal_sst =  1. _d 0       &                      + act4*max1*max2*max3
95        scal_sss =  1. _d 0  #endif /* ALLOW_AUTODIFF_TAMC */
96  #if (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP))  
97        scal_prc =  1. _d 0  c     Heat flux.
 #else  
       scal_sfl =  1. _d 0      
 #endif  
   
       do bj = jtlo,jthi  
         do bi = itlo,ithi  
98            do j = jmin,jmax            do j = jmin,jmax
99              do i = imin,imax              do i = imin,imax
100                 qnet(i,j,bi,bj) = exf_outscal_hflux*hflux(i,j,bi,bj)
101                enddo
102              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             Heat flux.  c     Salt flux.
114                qnet(i,j,bi,bj)  = scal_hfl*hflux(i,j,bi,bj)            do j = jmin,jmax
115                do i = imin,imax
116  c             Salt flux.               empmr(i,j,bi,bj)= exf_outscal_sflux*sflux(i,j,bi,bj)
117  #if (defined (ALLOW_BULKFORMULAE)  && defined (ALLOW_ATM_TEMP))              enddo
118                empmr(i,j,bi,bj) = scal_prc*precip(i,j,bi,bj)            enddo
119  #else            if ( sfluxfile .EQ. ' ' ) then
120                empmr(i,j,bi,bj) = scal_sfl*sflux(i,j,bi,bj)             do j = jmin,jmax
121  #endif              do i = imin,imax
122                     empmr(i,j,bi,bj) = empmr(i,j,bi,bj) -
123         &            exf_outscal_sflux * ( sflux_exfremo_intercept +
124         &            sflux_exfremo_slope*(mytime-starttime) )
125                enddo
126               enddo
127              endif
128    
129    #ifdef ALLOW_AUTODIFF_TAMC
130    CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
131    #endif
132              do j = jmin,jmax
133                do i = imin,imax
134  c             Zonal wind stress.  c             Zonal wind stress.
135                fu(i,j,bi,bj)    = scal_ust*ustress(i,j,bi,bj)                if (ustress(i,j,bi,bj).gt.windstressmax) then
136                    ustress(i,j,bi,bj)=windstressmax
137                  endif
138                enddo
139              enddo
140    #ifdef ALLOW_AUTODIFF_TAMC
141    CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
142    #endif
143              do j = jmin,jmax
144                do i = imin,imax
145                  if (ustress(i,j,bi,bj).lt.-windstressmax) then
146                    ustress(i,j,bi,bj)=-windstressmax
147                  endif
148                enddo
149              enddo
150              IF ( stressIsOnCgrid ) THEN
151               do j = jmin,jmax
152                do i = imin+1,imax
153                  fu(i,j,bi,bj) = exf_outscal_ustress*ustress(i,j,bi,bj)
154                enddo
155               enddo
156              ELSE
157               do j = jmin,jmax
158                do i = imin+1,imax
159    c     Shift wind stresses calculated at Grid-center to W/S points
160                  fu(i,j,bi,bj) = exf_outscal_ustress*
161         &              (ustress(i,j,bi,bj)+ustress(i-1,j,bi,bj))
162         &              *exf_half*maskW(i,j,1,bi,bj)
163                enddo
164               enddo
165              ENDIF
166    
167    #ifdef ALLOW_AUTODIFF_TAMC
168    CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
169    #endif
170              do j = jmin,jmax
171                do i = imin,imax
172  c             Meridional wind stress.  c             Meridional wind stress.
173                fv(i,j,bi,bj)    = scal_vst*vstress(i,j,bi,bj)                if (vstress(i,j,bi,bj).gt.windstressmax) then
174                    vstress(i,j,bi,bj)=windstressmax
175                  endif
176                enddo
177              enddo
178    #ifdef ALLOW_AUTODIFF_TAMC
179    CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
180    #endif
181              do j = jmin,jmax
182                do i = imin,imax
183                  if (vstress(i,j,bi,bj).lt.-windstressmax) then
184                    vstress(i,j,bi,bj)=-windstressmax
185                  endif
186                enddo
187              enddo
188              IF ( stressIsOnCgrid ) THEN
189               do j = jmin+1,jmax
190                do i = imin,imax
191                  fv(i,j,bi,bj) = exf_outscal_vstress*vstress(i,j,bi,bj)
192                enddo
193               enddo
194              ELSE
195               do j = jmin+1,jmax
196                do i = imin,imax
197    c     Shift wind stresses calculated at C-points to W/S points
198                  fv(i,j,bi,bj) = exf_outscal_vstress*
199         &              (vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))
200         &              *exf_half*maskS(i,j,1,bi,bj)
201                enddo
202               enddo
203              ENDIF
204    
205  #ifdef ALLOW_KPP || (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP)))  #ifdef SHORTWAVE_HEATING
206  c             Short wave radiative flux.  c             Short wave radiative flux.
207                qsw(i,j,bi,bj)   = scal_swf*swflux(i,j,bi,bj)            do j = jmin,jmax
208                do i = imin,imax
209                 qsw(i,j,bi,bj)  = exf_outscal_swflux*swflux(i,j,bi,bj)
210                enddo
211              enddo
212  #endif  #endif
213    
214  #ifdef ALLOW_CLIMSST_RELAXATION  #ifdef ALLOW_CLIMSST_RELAXATION
215                sst(i,j,bi,bj)   = scal_sst*climsst(i,j,bi,bj)            do j = jmin,jmax
216                do i = imin,imax
217                 sst(i,j,bi,bj)  = exf_outscal_sst*climsst(i,j,bi,bj)
218                enddo
219              enddo
220  #endif  #endif
221    
222  #ifdef ALLOW_CLIMSSS_RELAXATION  #ifdef ALLOW_CLIMSSS_RELAXATION
223                sss(i,j,bi,bj)   = scal_sss*climsss(i,j,bi,bj)            do j = jmin,jmax
224                do i = imin,imax
225                 sss(i,j,bi,bj)  = exf_outscal_sss*climsss(i,j,bi,bj)
226                enddo
227              enddo
228  #endif  #endif
229    
230    #ifdef ATMOSPHERIC_LOADING
231              do j = jmin,jmax
232                do i = imin,imax
233                 pload(i,j,bi,bj)=exf_outscal_apressure*apressure(i,j,bi,bj)
234              enddo              enddo
235            enddo            enddo
236          enddo  #endif
237        enddo  
238            ENDDO
239          ENDDO
240    
241  c     Update the tile edges.  c     Update the tile edges.
242    
243        _EXCH_XY_R4(  qnet, mythid )        _EXCH_XY_R4(  qnet, mythid )
244        _EXCH_XY_R4( empmr, mythid )        _EXCH_XY_R4( empmr, mythid )
245        _EXCH_XY_R4(    fu, mythid )         CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
246        _EXCH_XY_R4(    fv, mythid )  #ifdef SHORTWAVE_HEATING
 #ifdef ALLOW_KPP  
247        _EXCH_XY_R4(   qsw, mythid )        _EXCH_XY_R4(   qsw, mythid )
248  #endif  #endif
249  #ifdef ALLOW_CLIMSST_RELAXATION  #ifdef ALLOW_CLIMSST_RELAXATION
# Line 173  c     Update the tile edges. Line 252  c     Update the tile edges.
252  #ifdef ALLOW_CLIMSSS_RELAXATION  #ifdef ALLOW_CLIMSSS_RELAXATION
253        _EXCH_XY_R4(   sss, mythid )        _EXCH_XY_R4(   sss, mythid )
254  #endif  #endif
255    #ifdef ATMOSPHERIC_LOADING
256          _EXCH_XY_R4( pload, mythid )
257    #endif
258    
259        end        RETURN
260          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22