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

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

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

revision 1.3 by heimbach, Tue Nov 12 20:34:41 2002 UTC revision 1.13 by gforget, Tue Jul 13 00:02:10 2010 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_GetSurfaceFluxes(        subroutine exf_GetSurfaceFluxes(
7       I                                 mytime,       I                                 mytime,
# Line 18  c Line 19  c
19  c     started: Christian Eckert eckert@mit.edu  30-Jun-1999  c     started: Christian Eckert eckert@mit.edu  30-Jun-1999
20  c  c
21  c     changed: Christian Eckert eckert@mit.edu  14-Jan-2000  c     changed: Christian Eckert eckert@mit.edu  14-Jan-2000
 c  
22  c              - Restructured the code in order to create a package  c              - Restructured the code in order to create a package
23  c                for the MITgcmUV.  c                for the MITgcmUV.
24  c  c
25  c              Christian Eckert eckert@mit.edu  12-Feb-2000  c              Christian Eckert eckert@mit.edu  12-Feb-2000
 c  
26  c              - Changed Routine names (package prefix: exf_)  c              - Changed Routine names (package prefix: exf_)
27  c  c
28    c     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
29    c
30  c     ==================================================================  c     ==================================================================
31  c     SUBROUTINE exf_GetSurfaceFluxes  c     SUBROUTINE exf_GetSurfaceFluxes
32  c     ==================================================================  c     ==================================================================
33    
34        implicit none        implicit none
35    
36    c     == global variables ==
37    #include "EEPARAMS.h"
38    #include "SIZE.h"
39    #include "PARAMS.h"
40    #include "GRID.h"
41    
42    #include "EXF_FIELDS.h"
43    #include "EXF_PARAM.h"
44    #ifdef ALLOW_AUTODIFF
45    # include "ctrl.h"
46    # include "ctrl_dummy.h"
47    #endif
48    
49  c     == routine arguments ==  c     == routine arguments ==
50    
51        _RL mytime        _RL mytime
# Line 40  c     == routine arguments == Line 54  c     == routine arguments ==
54    
55  c     == global variables ==  c     == global variables ==
56    
57    #ifdef ALLOW_ROTATE_UV_CONTROLS
58          _RL     tmpUE(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
59          _RL     tmpVN(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
60          _RL     tmpUX(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
61          _RL     tmpVY(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
62          integer i,j,bi,bj
63    #endif
64    
65    
66  c     == end of interface ==  c     == end of interface ==
67    
68  #ifdef ALLOW_HFLUX_CONTROL  #ifdef ALLOW_HFLUX_CONTROL
69        call ctrl_getheatflux ( mytime, myiter, mythid )        call ctrl_get_gen (
70         &     xx_hflux_file, xx_hfluxstartdate, xx_hfluxperiod,
71         &     maskc, hflux, xx_hflux0, xx_hflux1, xx_hflux_dummy,
72         &     xx_hflux_remo_intercept, xx_hflux_remo_slope,
73         &     mytime, myiter, mythid )
74  #endif  #endif
75    
76  #ifdef ALLOW_SFLUX_CONTROL  #ifdef ALLOW_SFLUX_CONTROL
77        call ctrl_getsaltflux ( mytime, myiter, mythid )        call ctrl_get_gen (
78         &     xx_sflux_file, xx_sfluxstartdate, xx_sfluxperiod,
79         &     maskc, sflux, xx_sflux0, xx_sflux1, xx_sflux_dummy,
80         &     xx_sflux_remo_intercept, xx_sflux_remo_slope,
81         &     mytime, myiter, mythid )
82  #endif  #endif
83    
84    #ifndef ALLOW_ROTATE_UV_CONTROLS
85    
86  #ifdef ALLOW_USTRESS_CONTROL  #ifdef ALLOW_USTRESS_CONTROL
87        call ctrl_getzonstress ( mytime, myiter, mythid )        call ctrl_get_gen (
88         &     xx_tauu_file, xx_tauustartdate, xx_tauuperiod,
89         &     maskw, ustress, xx_tauu0, xx_tauu1, xx_tauu_dummy,
90         &     xx_tauu_remo_intercept, xx_tauu_remo_slope,
91         &     mytime, myiter, mythid )
92  #endif  #endif
93    
94  #ifdef ALLOW_VSTRESS_CONTROL  #ifdef ALLOW_VSTRESS_CONTROL
95        call ctrl_getmerstress ( mytime, myiter, mythid )        call ctrl_get_gen (
96  #endif       &     xx_tauv_file, xx_tauvstartdate, xx_tauvperiod,
97         &     masks, vstress, xx_tauv0, xx_tauv1, xx_tauv_dummy,
98         &     xx_tauv_remo_intercept, xx_tauv_remo_slope,
99         &     mytime, myiter, mythid )
100    #endif
101    
102    #else
103    
104    #if defined(ALLOW_USTRESS_CONTROL) && defined(ALLOW_VSTRESS_CONTROL)
105    
106            do bj = mybylo(mythid),mybyhi(mythid)
107             do bi = mybxlo(mythid),mybxhi(mythid)
108              do j = 1-oly,sny+oly
109               do i = 1-olx,snx+olx
110                 tmpUE(i,j,bi,bj) = 0. _d 0
111                 tmpVN(i,j,bi,bj) = 0. _d 0
112                 tmpUX(i,j,bi,bj) = 0. _d 0
113                 tmpVY(i,j,bi,bj) = 0. _d 0
114               enddo
115              enddo
116             enddo
117            enddo
118    
119          call ctrl_get_gen (
120         &     xx_tauu_file, xx_tauustartdate, xx_tauuperiod,
121         &     maskc, tmpUE, xx_tauu0, xx_tauu1, xx_tauu_dummy,
122         &     xx_tauu_remo_intercept, xx_tauu_remo_slope,
123         &     mytime, myiter, mythid )
124    
125          call ctrl_get_gen (
126         &     xx_tauv_file, xx_tauvstartdate, xx_tauvperiod,
127         &     maskc, tmpVN, xx_tauv0, xx_tauv1, xx_tauv_dummy,
128         &     xx_tauv_remo_intercept, xx_tauv_remo_slope,
129         &     mytime, myiter, mythid )
130    
131          _EXCH_XY_RL(tmpUE,myThid)
132          _EXCH_XY_RL(tmpVN,myThid)
133    
134          call rotate_uv2en_rl(tmpUX,tmpVY,tmpUE,tmpVN,
135         &     .FALSE.,stressIsOnCgrid,.TRUE.,1,mythid)
136    
137          IF ( stressIsOnCgrid ) THEN
138            CALL EXCH_UV_XY_RL( tmpUX, tmpVY, .TRUE., myThid )
139          ELSE
140            CALL EXCH_UV_AGRID_3D_RL( tmpUX, tmpVY, .TRUE., 1, myThid)
141          ENDIF  
142    
143            do bj = mybylo(mythid),mybyhi(mythid)
144             do bi = mybxlo(mythid),mybxhi(mythid)
145              do j = 1-oly,sny+oly
146               do i = 1-olx,snx+olx
147                 ustress(i,j,bi,bj)=ustress(i,j,bi,bj)+tmpUX(i,j,bi,bj)
148                 vstress(i,j,bi,bj)=vstress(i,j,bi,bj)+tmpVY(i,j,bi,bj)
149               enddo
150              enddo
151             enddo
152            enddo
153    
 #ifdef ALLOW_SWFLUX_CONTROL  
       call ctrl_getswflux ( mytime, myiter, mythid )  
154  #endif  #endif
155    #endif /* ALLOW_ROTATE_UV_CONTROLS */
156    
 #ifdef ALLOW_LWFLUX_CONTROL  
       call ctrl_getlwflux ( mytime, myiter, mythid )  
 #endif  
157    
 #ifdef ALLOW_CONTROL_NEW  
 c     Get the surface forcing control fields.  
       call exfa_GetFFields( mytime, myiter, mythid )  
 #endif  
158    
159        end        end
   
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22