Back to home page

MITgcm
 
 

    

File indexing completed on 2024-10-31 05:10:29 UTC

view on githubraw file Latest commit 8b7be8db on 2024-10-30 14:20:06 UTC
7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
8b7be8db08 Mart*0002 #ifdef ALLOW_STREAMICE
                0003 # include "STREAMICE_OPTIONS.h"
                0004 #endif
2dcaa8b9a5 Patr*0005 
275ae00a84 Patr*0006 CBOP
7bd66d7dc3 Patr*0007 C     !ROUTINE: CTRL_MAP_FORCING
275ae00a84 Patr*0008 C     !INTERFACE:
5f018bd0cf Gael*0009       SUBROUTINE CTRL_MAP_FORCING( myTime, myIter, myThid )
275ae00a84 Patr*0010 
                0011 C     !DESCRIPTION: \bv
                0012 c     *=================================================================
951926fb9b Jean*0013 c     | SUBROUTINE CTRL_MAP_FORCING
275ae00a84 Patr*0014 c     | Add the surface flux anomalies of the control vector
                0015 c     | to the model flux fields and update the tile halos.
4d72283393 Mart*0016 c     | The control vector is defined in the header file "CTRL.h".
275ae00a84 Patr*0017 c     *=================================================================
                0018 C     \ev
                0019 
                0020 C     !USES:
2dcaa8b9a5 Patr*0021       IMPLICIT NONE
                0022 
                0023 C     == Global variables ===
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
                0027 #include "FFIELDS.h"
c04085ad02 Patr*0028 #include "CTRL_SIZE.h"
4d72283393 Mart*0029 #include "CTRL.h"
c04085ad02 Patr*0030 #include "CTRL_GENARR.h"
edcd27be69 Mart*0031 #include "CTRL_DUMMY.h"
16cc32c739 Mart*0032 #ifdef ALLOW_STREAMICE
                0033 # include "STREAMICE.h"
                0034 #endif
2dcaa8b9a5 Patr*0035 
275ae00a84 Patr*0036 C     !INPUT/OUTPUT PARAMETERS:
2dcaa8b9a5 Patr*0037 C     == Routine arguments ==
5f018bd0cf Gael*0038 C     myTime :: time counter for this thread
                0039 C     myIter :: iteration counter for this thread
                0040 C     myThid :: thread number for this instance of the routine.
                0041       _RL     myTime
                0042       INTEGER myIter
2dcaa8b9a5 Patr*0043       INTEGER myThid
                0044 
9f5240b52a Jean*0045 C     !FUNCTIONS:
                0046 
275ae00a84 Patr*0047 C     !LOCAL VARIABLES:
2dcaa8b9a5 Patr*0048 C     == Local variables ==
cf705a6c8e Mart*0049 #ifdef ALLOW_GENTIM2D_CONTROL
9f5240b52a Jean*0050       INTEGER bi,bj
                0051       INTEGER i,j
                0052       INTEGER iarr
                0053       _RL     tmpUE(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0054       _RL     tmpVN(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0055       _RL     tmpUX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0056       _RL     tmpVY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
96b006450c dngo*0057       CHARACTER*(MAX_LEN_FNAM) temp_genarr_fnam
2dcaa8b9a5 Patr*0058 
                0059 c     == end of interface ==
275ae00a84 Patr*0060 CEOP
2dcaa8b9a5 Patr*0061 
cf705a6c8e Mart*0062       DO bj = myByLo(myThid),myByHi(myThid)
                0063        DO bi = myBxLo(myThid),myBxHi(myThid)
                0064         DO j = 1-OLy,sNy+OLy
                0065          DO i = 1-OLx,sNx+OLx
                0066           tmpUE(i,j,bi,bj) = 0. _d 0
                0067           tmpVN(i,j,bi,bj) = 0. _d 0
                0068           tmpUX(i,j,bi,bj) = 0. _d 0
                0069           tmpVY(i,j,bi,bj) = 0. _d 0
5f018bd0cf Gael*0070          ENDDO
                0071         ENDDO
                0072        ENDDO
cf705a6c8e Mart*0073       ENDDO
5f018bd0cf Gael*0074 
cf705a6c8e Mart*0075       DO bj = myByLo(myThid),myByHi(myThid)
                0076        DO bi = myBxLo(myThid),myBxHi(myThid)
                0077         DO j = 1,sNy
                0078          DO i = 1,sNx
                0079           DO iarr = 1, maxCtrlTim2D
96b006450c dngo*0080            temp_genarr_fnam=xx_gentim2d_file(iarr)
                0081            IF (temp_genarr_fnam(1:5).EQ.'xx_fe') tmpUE
9f5240b52a Jean*0082      &       (i,j,bi,bj)=tmpUE(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
96b006450c dngo*0083            IF (temp_genarr_fnam(1:5).EQ.'xx_fn') tmpVN
9f5240b52a Jean*0084      &        (i,j,bi,bj)=tmpVN(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
                0085           ENDDO
                0086          ENDDO
                0087         ENDDO
                0088        ENDDO
cf705a6c8e Mart*0089       ENDDO
5f018bd0cf Gael*0090 
cf705a6c8e Mart*0091       _EXCH_XY_RL(tmpUE,myThid)
                0092       _EXCH_XY_RL(tmpVN,myThid)
96b006450c dngo*0093       CALL ROTATE_UV2EN_RL(tmpUX,tmpVY,tmpUE,tmpVN,
cf705a6c8e Mart*0094      &     .FALSE.,.TRUE.,.TRUE.,1,myThid)
9f5240b52a Jean*0095 
cf705a6c8e Mart*0096       DO bj = myByLo(myThid),myByHi(myThid)
                0097        DO bi = myBxLo(myThid),myBxHi(myThid)
                0098         DO j = 1,sNy
                0099          DO i = 1,sNx
                0100           fu(i,j,bi,bj)=fu(i,j,bi,bj)+tmpUX(i,j,bi,bj)
                0101           fv(i,j,bi,bj)=fv(i,j,bi,bj)+tmpVY(i,j,bi,bj)
                0102           DO iarr = 1, maxCtrlTim2D
96b006450c dngo*0103            temp_genarr_fnam=xx_gentim2d_file(iarr)
                0104            IF (temp_genarr_fnam(1:7).EQ.'xx_qnet') Qnet(i,j,bi,bj)
                0105      &          = Qnet(i,j,bi,bj) + xx_gentim2d(i,j,bi,bj,iarr)
                0106            IF (temp_genarr_fnam(1:8).EQ.'xx_empmr') EmPmR(i,j,bi,bj)
                0107      &          = EmPmR(i,j,bi,bj) + xx_gentim2d(i,j,bi,bj,iarr)
                0108            IF (temp_genarr_fnam(1:6).EQ.'xx_qsw') Qsw(i,j,bi,bj)
                0109      &          = Qsw(i,j,bi,bj) + xx_gentim2d(i,j,bi,bj,iarr)
                0110            IF (temp_genarr_fnam(1:6).EQ.'xx_sst') SST(i,j,bi,bj)
                0111      &          = SST(i,j,bi,bj) + xx_gentim2d(i,j,bi,bj,iarr)
                0112            IF (temp_genarr_fnam(1:6).EQ.'xx_sss') SSS(i,j,bi,bj)
                0113      &          = SSS(i,j,bi,bj) + xx_gentim2d(i,j,bi,bj,iarr)
                0114            IF (temp_genarr_fnam(1:8).EQ.'xx_pload') pLoad(i,j,bi,bj)
                0115      &          = pLoad(i,j,bi,bj) + xx_gentim2d(i,j,bi,bj,iarr)
                0116            IF (temp_genarr_fnam(1:11).EQ.'xx_saltflux')
                0117      &          saltFlux(i,j,bi,bj) = saltFlux(i,j,bi,bj)
                0118      &                             + xx_gentim2d(i,j,bi,bj,iarr)
                0119            IF (temp_genarr_fnam(1:5).EQ.'xx_fu') fu(i,j,bi,bj)
                0120      &          = fu(i,j,bi,bj) + xx_gentim2d(i,j,bi,bj,iarr)
                0121            IF (temp_genarr_fnam(1:5).EQ.'xx_fv') fv(i,j,bi,bj)
                0122      &          = fv(i,j,bi,bj) + xx_gentim2d(i,j,bi,bj,iarr)
cf705a6c8e Mart*0123           ENDDO
5f018bd0cf Gael*0124           ENDDO
                0125          ENDDO
                0126         ENDDO
                0127        ENDDO
                0128 
96b006450c dngo*0129 # ifdef ALLOW_STREAMICE
                0130        IF ( useStreamIce ) THEN
                0131         DO bj = myByLo(myThid), myByHi(myThid)
                0132          DO bi = myBxLo(myThid), myBxHi(myThid)
                0133           DO j = 1-OLy,sNy+OLy
                0134            DO i = 1-OLx,sNx+OLx
                0135             DO iarr = 1, maxCtrlTim2D
                0136              temp_genarr_fnam=xx_gentim2d_file(iarr)
                0137              IF (temp_genarr_fnam(1:8).EQ.'xx_bglen')
                0138      &        B_glen(i,j,bi,bj) =
                0139      &         xx_gentim2d(i,j,bi,bj,iarr)+
                0140      &         B_glen_init(i,j,bi,bj)
                0141              IF (temp_genarr_fnam(1:7).EQ.'xx_beta')
                0142      &        C_basal_friction(i,j,bi,bj) =
                0143      &         xx_gentim2d(i,j,bi,bj,iarr)+
                0144      &         C_basal_fric_init(i,j,bi,bj)
                0145              IF (temp_genarr_fnam(1:17).EQ.'xx_bdot_streamice')
                0146      &        Bdot_streamice(i,j,bi,bj) =
                0147      &         xx_gentim2d(i,j,bi,bj,iarr)
                0148              IF (temp_genarr_fnam(1:11).EQ.'xx_bdot_max') THEN
                0149                streamice_bdot_maxmelt_v(i,j,bi,bj) =
                0150      &          xx_gentim2d(i,j,bi,bj,iarr)
                0151              ENDIF
16cc32c739 Mart*0152             ENDDO
                0153            ENDDO
                0154           ENDDO
96b006450c dngo*0155          ENDDO
16cc32c739 Mart*0156         ENDDO
                0157        ENDIF
96b006450c dngo*0158 # endif /* ALLOW_STREAMICE */
                0159 
                0160        CALL EXCH_XY_RS( Qnet , myThid )
                0161        CALL EXCH_XY_RS( EmPmR , myThid )
                0162        CALL EXCH_XY_RS( Qsw , myThid )
                0163        CALL EXCH_XY_RS( SST , myThid )
                0164        CALL EXCH_XY_RS( SSS , myThid )
                0165        CALL EXCH_XY_RS( pLoad , myThid )
                0166        CALL EXCH_XY_RS( saltFlux , myThid )
                0167        CALL EXCH_UV_XY_RS( fu, fv, .TRUE., myThid )
                0168 
                0169 # ifdef ALLOW_STREAMICE
                0170        IF ( useStreamIce ) THEN
                0171         CALL EXCH_XY_RL( streamice_bdot_maxmelt_v, myThid )
                0172         CALL EXCH_XY_RL( C_basal_friction, myThid )
                0173         CALL EXCH_XY_RL( B_glen, myThid )
                0174         CALL EXCH_XY_RL( bdot_streamice, myThid )
                0175        ENDIF
                0176 # endif /* ALLOW_STREAMICE */
16cc32c739 Mart*0177 
11c3150c71 Mart*0178 #endif /* ALLOW_GENTIM2D_CONTROL */
5f018bd0cf Gael*0179 
                0180       RETURN
2dcaa8b9a5 Patr*0181       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!