/[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.3 by cheisey, Tue Dec 17 19:47:41 2002 UTC revision 1.17 by jmc, Mon Apr 16 23:27:21 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( 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
# Line 59  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_param.h"  #include "GRID.h"
54  #include "exf_constants.h"  
55  #include "exf_fields.h"  #include "EXF_PARAM.h"
56  #include "exf_clim_fields.h"  #include "EXF_CONSTANTS.h"
57    #include "EXF_FIELDS.h"
58    #include "EXF_CLIM_PARAM.h"
59    #include "EXF_CLIM_FIELDS.h"
60  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
61  # include "tamc.h"  # include "tamc.h"
62  # include "tamc_keys.h"  # include "tamc_keys.h"
# Line 73  c     == routine arguments == Line 66  c     == routine arguments ==
66  c     mythid - thread number for this instance of the routine.  c     mythid - thread number for this instance of the routine.
67    
68        integer mythid        integer mythid
69          integer myiter
70          _RL     mytime
71    
72  c     == local variables ==  c     == local variables ==
73    
74        integer bi,bj        integer bi,bj
75        integer i,j        integer i,j,k
76        integer jtlo        integer jtlo
77        integer jthi        integer jthi
78        integer itlo        integer itlo
# Line 116  c     == end of interface == Line 111  c     == end of interface ==
111    
112            do j = jmin,jmax            do j = jmin,jmax
113              do i = imin,imax              do i = imin,imax
114  c             Heat flux.  c            Heat flux.
115                qnet(i,j,bi,bj)  = scal_hfl*hflux(i,j,bi,bj)               qnet(i,j,bi,bj) = exf_outscal_hflux*hflux(i,j,bi,bj)
116                 if ( hfluxfile .EQ. ' ' )
117         &            qnet(i,j,bi,bj) = qnet(i,j,bi,bj) -
118         &            exf_outscal_hflux * ( hflux_exfremo_intercept +
119         &            hflux_exfremo_slope*(mytime-starttime) )
120              enddo              enddo
121            enddo            enddo
122    
123    
124            do j = jmin,jmax            do j = jmin,jmax
125              do i = imin,imax              do i = imin,imax
126  c             Salt flux.  c            Salt flux.
127  #if (defined (ALLOW_BULKFORMULAE)  && defined (ALLOW_ATM_TEMP))               empmr(i,j,bi,bj)= exf_outscal_sflux*sflux(i,j,bi,bj)
128                empmr(i,j,bi,bj) = scal_prc*precip(i,j,bi,bj)               if ( sfluxfile .EQ. ' ' )
129  #else       &            empmr(i,j,bi,bj) = empmr(i,j,bi,bj) -
130                empmr(i,j,bi,bj) = scal_sfl*sflux(i,j,bi,bj)       &            exf_outscal_sflux * ( sflux_exfremo_intercept +
131  #endif       &            sflux_exfremo_slope*(mytime-starttime) )
132              enddo              enddo
133            enddo            enddo
134    
# Line 139  CADJ STORE ustress(:,:,bi,bj) = comlev1_ Line 138  CADJ STORE ustress(:,:,bi,bj) = comlev1_
138            do j = jmin,jmax            do j = jmin,jmax
139              do i = imin,imax              do i = imin,imax
140  c             Zonal wind stress.  c             Zonal wind stress.
141                if (ustress(i,j,bi,bj).gt.2.0D0) then                if (ustress(i,j,bi,bj).gt.windstressmax) then
142                  ustress(i,j,bi,bj)=2.0D0                  ustress(i,j,bi,bj)=windstressmax
143                endif                endif
144              enddo              enddo
145            enddo            enddo
# Line 149  CADJ STORE ustress(:,:,bi,bj) = comlev1_ Line 148  CADJ STORE ustress(:,:,bi,bj) = comlev1_
148  #endif  #endif
149            do j = jmin,jmax            do j = jmin,jmax
150              do i = imin,imax              do i = imin,imax
151                if (ustress(i,j,bi,bj).lt.-2.0D0) then                if (ustress(i,j,bi,bj).lt.-windstressmax) then
152                  ustress(i,j,bi,bj)=-2.0D0                  ustress(i,j,bi,bj)=-windstressmax
153                endif                endif
154              enddo              enddo
155            enddo            enddo
156            do j = jmin,jmax            do j = jmin,jmax
157              do i = imin,imax              do i = imin+1,imax
158                fu(i,j,bi,bj)    = scal_ust*ustress(i,j,bi,bj)  #if (defined (ALLOW_BULKFORMULAE) || defined (USE_EXF_INTERPOLATION))
159    c     Shift wind stresses calculated at C-points 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))/2.*
162         &              maskW(i,j,1,bi,bj)
163    #else
164                  fu(i,j,bi,bj) = exf_outscal_ustress*ustress(i,j,bi,bj)
165    #endif
166              enddo              enddo
167            enddo            enddo
168    
# Line 166  CADJ STORE vstress(:,:,bi,bj) = comlev1_ Line 172  CADJ STORE vstress(:,:,bi,bj) = comlev1_
172            do j = jmin,jmax            do j = jmin,jmax
173              do i = imin,imax              do i = imin,imax
174  c             Meridional wind stress.  c             Meridional wind stress.
175                if (vstress(i,j,bi,bj).gt.2.0D0) then                if (vstress(i,j,bi,bj).gt.windstressmax) then
176                  vstress(i,j,bi,bj)=2.0D0                  vstress(i,j,bi,bj)=windstressmax
177                endif                endif
178              enddo              enddo
179            enddo            enddo
# Line 176  CADJ STORE vstress(:,:,bi,bj) = comlev1_ Line 182  CADJ STORE vstress(:,:,bi,bj) = comlev1_
182  #endif  #endif
183            do j = jmin,jmax            do j = jmin,jmax
184              do i = imin,imax              do i = imin,imax
185                if (vstress(i,j,bi,bj).lt.-2.0D0) then                if (vstress(i,j,bi,bj).lt.-windstressmax) then
186                  vstress(i,j,bi,bj)=-2.0D0                  vstress(i,j,bi,bj)=-windstressmax
187                endif                endif
188              enddo              enddo
189            enddo            enddo
190            do j = jmin,jmax            do j = jmin+1,jmax
191              do i = imin,imax              do i = imin,imax
192                fv(i,j,bi,bj)    = scal_vst*vstress(i,j,bi,bj)  #if (defined (ALLOW_BULKFORMULAE) || defined (USE_EXF_INTERPOLATION))
193    c     Shift wind stresses calculated at C-points to W/S points
194                  fv(i,j,bi,bj) = exf_outscal_vstress*
195         &              (vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))/2.*
196         &              maskS(i,j,1,bi,bj)
197    #else
198                  fv(i,j,bi,bj) = exf_outscal_vstress*vstress(i,j,bi,bj)
199    #endif
200              enddo              enddo
201            enddo            enddo
202    
203  #ifdef ALLOW_KPP || \  #ifdef SHORTWAVE_HEATING
  (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP)))  
204  c             Short wave radiative flux.  c             Short wave radiative flux.
205            do j = jmin,jmax            do j = jmin,jmax
206              do i = imin,imax              do i = imin,imax
207                qsw(i,j,bi,bj)   = scal_swf*swflux(i,j,bi,bj)               qsw(i,j,bi,bj)  = exf_outscal_swflux*swflux(i,j,bi,bj)
208              enddo              enddo
209            enddo            enddo
210  #endif  #endif
# Line 200  c             Short wave radiative flux. Line 212  c             Short wave radiative flux.
212  #ifdef ALLOW_CLIMSST_RELAXATION  #ifdef ALLOW_CLIMSST_RELAXATION
213            do j = jmin,jmax            do j = jmin,jmax
214              do i = imin,imax              do i = imin,imax
215                sst(i,j,bi,bj)   = scal_sst*climsst(i,j,bi,bj)               sst(i,j,bi,bj)  = exf_outscal_sst*climsst(i,j,bi,bj)
216              enddo              enddo
217            enddo            enddo
218  #endif  #endif
# Line 208  c             Short wave radiative flux. Line 220  c             Short wave radiative flux.
220  #ifdef ALLOW_CLIMSSS_RELAXATION  #ifdef ALLOW_CLIMSSS_RELAXATION
221            do j = jmin,jmax            do j = jmin,jmax
222              do i = imin,imax              do i = imin,imax
223                sss(i,j,bi,bj)   = scal_sss*climsss(i,j,bi,bj)               sss(i,j,bi,bj)  = exf_outscal_sss*climsss(i,j,bi,bj)
224              enddo              enddo
225            enddo            enddo
226  #endif  #endif
# Line 216  c             Short wave radiative flux. Line 228  c             Short wave radiative flux.
228  #ifdef ATMOSPHERIC_LOADING  #ifdef ATMOSPHERIC_LOADING
229            do j = jmin,jmax            do j = jmin,jmax
230              do i = imin,imax              do i = imin,imax
231                pload(i,j,bi,bj) = scal_apressure*apressure(i,j,bi,bj)               pload(i,j,bi,bj)=exf_outscal_apressure*apressure(i,j,bi,bj)
232              enddo              enddo
233            enddo            enddo
234  #endif  #endif
235    
   
236          enddo          enddo
237        enddo        enddo
238    
# Line 232  c     Update the tile edges. Line 243  c     Update the tile edges.
243  c      _EXCH_XY_R4(    fu, mythid )  c      _EXCH_XY_R4(    fu, mythid )
244  c      _EXCH_XY_R4(    fv, mythid )  c      _EXCH_XY_R4(    fv, mythid )
245         CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)         CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
246  #ifdef ALLOW_KPP  #ifdef SHORTWAVE_HEATING
247        _EXCH_XY_R4(   qsw, mythid )        _EXCH_XY_R4(   qsw, mythid )
248  #endif  #endif
249  #ifdef ALLOW_CLIMSST_RELAXATION  #ifdef ALLOW_CLIMSST_RELAXATION
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22