Back to home page

MITgcm
 
 

    

File indexing completed on 2023-11-05 05:10:16 UTC

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