pkg/exf/exf_getsurfacefluxes.F

6d54cf9ca1 Ed H*0001 #include "EXF_OPTIONS.h"
3a255f48df Gael*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
                0005 #ifdef ALLOW_ECCO
                0006 # include "ECCO_OPTIONS.h"
                0007 #endif
7f861c1808 Patr*0008
11c3150c71 Mart*0009 CBOP
                0010 C     !ROUTINE: EXF_GETSURFACEFLUXES
                0011 C     !INTERFACE:
                0012       SUBROUTINE EXF_GETSURFACEFLUXES(
7f861c1808 Patr*0013      I                                 mytime,
                0014      I                                 myiter,
                0015      I                                 mythid
                0016      &                               )
11c3150c71 Mart*0017 C     !DESCRIPTION: \bv
7f861c1808 Patr*0018 c     ==================================================================
11c3150c71 Mart*0019 c     SUBROUTINE EXF_GETSURFACEFLUXES
7f861c1808 Patr*0020 c     ==================================================================
                0021 c
                0022 c     o Mid-level routine for enabling the use of flux fields as control
                0023 c       variables.
                0024 c
                0025 c     started: Christian Eckert eckert@mit.edu  30-Jun-1999
                0026 c
                0027 c     changed: Christian Eckert eckert@mit.edu  14-Jan-2000
                0028 c              - Restructured the code in order to create a package
                0029 c                for the MITgcmUV.
                0030 c
                0031 c              Christian Eckert eckert@mit.edu  12-Feb-2000
                0032 c              - Changed Routine names (package prefix: exf_)
                0033 c
6060ec2938 Dimi*0034 c     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
                0035 c
7f861c1808 Patr*0036 c     ==================================================================
11c3150c71 Mart*0037 c     SUBROUTINE EXF_GETSURFACEFLUXES
7f861c1808 Patr*0038 c     ==================================================================
11c3150c71 Mart*0039 C     \ev
                0040 C     !USES:
                0041       IMPLICIT NONE
7f861c1808 Patr*0042
11c3150c71 Mart*0043 C     == Global variables ==
7109a141b2 Patr*0044 #include "EEPARAMS.h"
                0045 #include "SIZE.h"
                0046 #include "PARAMS.h"
                0047 #include "GRID.h"
                0048
082e18c36c Jean*0049 #include "EXF_FIELDS.h"
d7c5a72ada Gael*0050 #include "EXF_PARAM.h"
1a70de03d3 Gael*0051 #ifdef ALLOW_CTRL
                0052 # include "CTRL_SIZE.h"
4d72283393 Mart*0053 # include "CTRL.h"
edcd27be69 Mart*0054 # include "CTRL_DUMMY.h"
1a70de03d3 Gael*0055 # include "CTRL_GENARR.h"
                0056 #endif
7109a141b2 Patr*0057
11c3150c71 Mart*0058 C     !INPUT/OUTPUT PARAMETERS:
                0059 C     == Routine arguments ==
                0060 C     myTime :: Current time in simulation
                0061 C     myIter :: Current iteration number in simulation
                0062 C     myThid :: Thread number for this instance of the routine.
7f861c1808 Patr*0063       _RL mytime
11c3150c71 Mart*0064       INTEGER myiter
                0065       INTEGER mythid
7f861c1808 Patr*0066
11c3150c71 Mart*0067 C     !LOCAL VARIABLES:
                0068 C     == Local variables
7559d67f30 Gael*0069 #ifdef ALLOW_CTRL
11c3150c71 Mart*0070 # ifdef ALLOW_ROTATE_UV_CONTROLS
d7c5a72ada Gael*0071       _RL     tmpUE(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
                0072       _RL     tmpVN(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
                0073       _RL     tmpUX(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
                0074       _RL     tmpVY(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
11c3150c71 Mart*0075 # endif
d7c5a72ada Gael*0076
fb5f024718 Gael*0077 #ifdef ALLOW_GENTIM2D_CONTROL
11c3150c71 Mart*0078       INTEGER iarr
fb5f024718 Gael*0079 #endif
                0080
                0081 #if (defined (ALLOW_ROTATE_UV_CONTROLS) || defined (ALLOW_GENTIM2D_CONTROL))
11c3150c71 Mart*0082       INTEGER i,j,bi,bj
fb5f024718 Gael*0083 #endif
11c3150c71 Mart*0084 CEOP
7f861c1808 Patr*0085
fb5f024718 Gael*0086 #ifdef ALLOW_ROTATE_UV_CONTROLS
1a70de03d3 Gael*0087       if ( useCTRL ) then
11c3150c71 Mart*0088         DO bj = mybylo(mythid),mybyhi(mythid)
                0089          DO bi = mybxlo(mythid),mybxhi(mythid)
                0090           DO j = 1-oly,sny+oly
                0091            DO i = 1-olx,snx+olx
fb5f024718 Gael*0092              tmpUE(i,j,bi,bj) = 0. _d 0
                0093              tmpVN(i,j,bi,bj) = 0. _d 0
                0094              tmpUX(i,j,bi,bj) = 0. _d 0
                0095              tmpVY(i,j,bi,bj) = 0. _d 0
11c3150c71 Mart*0096            ENDDO
                0097           ENDDO
                0098          ENDDO
                0099         ENDDO
1a70de03d3 Gael*0100       endif
fb5f024718 Gael*0101 #endif
                0102
                0103 #if (defined (ALLOW_CTRL) && \
                0104      defined (ALLOW_GENTIM2D_CONTROL))
cf705a6c8e Mart*0105       IF ( useCTRL) THEN
11c3150c71 Mart*0106        DO bj = myByLo(myThid),myByHi(myThid)
                0107         DO bi = myBxLo(myThid),mybxhi(myThid)
                0108          DO j = 1,sNy
                0109           DO i = 1,sNx
                0110            DO iarr = 1, maxCtrlTim2D
fb5f024718 Gael*0111 #ifndef ALLOW_ROTATE_UV_CONTROLS
8276a29d45 Gael*0112            if (xx_gentim2d_file(iarr)(1:7).EQ.'xx_tauu')
fb5f024718 Gael*0113      &       ustress(i,j,bi,bj)=ustress(i,j,bi,bj)+
                0114      &                         xx_gentim2d(i,j,bi,bj,iarr)
8276a29d45 Gael*0115            if (xx_gentim2d_file(iarr)(1:7).EQ.'xx_tauv')
fb5f024718 Gael*0116      &       vstress(i,j,bi,bj)=vstress(i,j,bi,bj)+
                0117      &                         xx_gentim2d(i,j,bi,bj,iarr)
                0118 #else
8276a29d45 Gael*0119            if (xx_gentim2d_file(iarr)(1:7).EQ.'xx_tauu')
0811cabed0 Gael*0120      &       tmpUE(i,j,bi,bj)=tmpUE(i,j,bi,bj)
                0121      &          +xx_gentim2d(i,j,bi,bj,iarr)
8276a29d45 Gael*0122            if (xx_gentim2d_file(iarr)(1:7).EQ.'xx_tauv')
0811cabed0 Gael*0123      &       tmpVN(i,j,bi,bj)=tmpVN(i,j,bi,bj)
                0124      &          +xx_gentim2d(i,j,bi,bj,iarr)
fb5f024718 Gael*0125 #endif
df462307fb Timo*0126            if (xx_gentim2d_file(iarr)(1:8).EQ.'xx_hflux')
                0127      &       hflux(i,j,bi,bj)=hflux(i,j,bi,bj)+
                0128      &                         xx_gentim2d(i,j,bi,bj,iarr)
                0129            if (xx_gentim2d_file(iarr)(1:8).EQ.'xx_sflux')
                0130      &       sflux(i,j,bi,bj)=sflux(i,j,bi,bj)+
                0131      &                         xx_gentim2d(i,j,bi,bj,iarr)
11c3150c71 Mart*0132            ENDDO
                0133           ENDDO
fb5f024718 Gael*0134          ENDDO
                0135         ENDDO
                0136        ENDDO
cf705a6c8e Mart*0137       ENDIF !if (useCTRL) then
7f861c1808 Patr*0138 #endif
                0139
1a70de03d3 Gael*0140       IF ( (useCTRL).AND.(.NOT.useAtmWind) ) THEN
1ba8087aa5 Gael*0141
                0142 #ifdef ALLOW_ROTATE_UV_CONTROLS
d7c5a72ada Gael*0143       _EXCH_XY_RL(tmpUE,myThid)
                0144       _EXCH_XY_RL(tmpVN,myThid)
                0145
11c3150c71 Mart*0146       CALL ROTATE_UV2EN_RL(tmpUX,tmpVY,tmpUE,tmpVN,
d7c5a72ada Gael*0147      &     .FALSE.,stressIsOnCgrid,.TRUE.,1,mythid)
                0148
                0149       IF ( stressIsOnCgrid ) THEN
                0150         CALL EXCH_UV_XY_RL( tmpUX, tmpVY, .TRUE., myThid )
                0151       ELSE
                0152         CALL EXCH_UV_AGRID_3D_RL( tmpUX, tmpVY, .TRUE., 1, myThid)
df462307fb Timo*0153       ENDIF
d7c5a72ada Gael*0154
11c3150c71 Mart*0155         DO bj = mybylo(mythid),mybyhi(mythid)
                0156          DO bi = mybxlo(mythid),mybxhi(mythid)
                0157           DO j = 1-oly,sny+oly
                0158            DO i = 1-olx,snx+olx
d7c5a72ada Gael*0159              ustress(i,j,bi,bj)=ustress(i,j,bi,bj)+tmpUX(i,j,bi,bj)
                0160              vstress(i,j,bi,bj)=vstress(i,j,bi,bj)+tmpVY(i,j,bi,bj)
11c3150c71 Mart*0161            ENDDO
                0162           ENDDO
                0163          ENDDO
                0164         ENDDO
d7c5a72ada Gael*0165 #endif /* ALLOW_ROTATE_UV_CONTROLS */
                0166
1ba8087aa5 Gael*0167       ENDIF !( .NOT.useAtmWind )
b533b6175f Gael*0168
7559d67f30 Gael*0169 #endif /* ALLOW_CTRL */
d7c5a72ada Gael*0170
11c3150c71 Mart*0171       END