Back to home page

MITgcm
 
 

    

File indexing completed on 2023-11-05 05:11:20 UTC

view on githubraw file Latest commit 65754df4 on 2023-11-04 17:55:24 UTC
a235da16e6 Jean*0001 #include "CTRL_OPTIONS.h"
a78204c019 Mart*0002 #ifdef ALLOW_SHELFICE
                0003 # include "SHELFICE_OPTIONS.h"
                0004 #endif
a897a05ba0 Patr*0005 
                0006 CBOP
0601e85e79 Jean*0007 C     !ROUTINE: CTRL_MAP_INI_GENARR
a897a05ba0 Patr*0008 C     !INTERFACE:
0601e85e79 Jean*0009       SUBROUTINE CTRL_MAP_INI_GENARR( myThid )
a897a05ba0 Patr*0010 
                0011 C     !DESCRIPTION: \bv
0601e85e79 Jean*0012 C     *=================================================================
                0013 C     | SUBROUTINE CTRL_MAP_INI_GENARR
                0014 C     | Add the generic arrays of the
                0015 C     | control vector to the model state and update the tile halos.
4d72283393 Mart*0016 C     | The control vector is defined in the header file "CTRL.h".
0601e85e79 Jean*0017 C     *=================================================================
a897a05ba0 Patr*0018 C     \ev
                0019 
                0020 C     !USES:
0601e85e79 Jean*0021       IMPLICIT NONE
a897a05ba0 Patr*0022 
0601e85e79 Jean*0023 C     == global variables ==
a897a05ba0 Patr*0024 #include "SIZE.h"
9b14145662 Jean*0025 #include "EEPARAMS.h"
a897a05ba0 Patr*0026 #include "PARAMS.h"
                0027 #include "GRID.h"
                0028 #include "DYNVARS.h"
                0029 #include "FFIELDS.h"
                0030 #include "CTRL_SIZE.h"
4d72283393 Mart*0031 #include "CTRL.h"
65754df434 Mart*0032 #include "OPTIMCYCLE.h"
edcd27be69 Mart*0033 #include "CTRL_DUMMY.h"
a78204c019 Mart*0034 #include "CTRL_FIELDS.h"
                0035 #include "CTRL_GENARR.h"
a897a05ba0 Patr*0036 #ifdef ALLOW_PTRACERS
                0037 # include "PTRACERS_SIZE.h"
a78204c019 Mart*0038 # include "PTRACERS_PARAMS.h"
a897a05ba0 Patr*0039 # include "PTRACERS_FIELDS.h"
                0040 #endif
a78204c019 Mart*0041 #ifdef ALLOW_SHELFICE
                0042 # include "SHELFICE.h"
                0043 #endif
a897a05ba0 Patr*0044 
                0045 C     !INPUT/OUTPUT PARAMETERS:
0601e85e79 Jean*0046 C     == routine arguments ==
                0047       INTEGER myThid
a897a05ba0 Patr*0048 
a78204c019 Mart*0049 #if (defined (ALLOW_GENARR3D_CONTROL) && defined(ALLOW_PTRACERS))
0601e85e79 Jean*0050 C     !FUNCTIONS:
a78204c019 Mart*0051       INTEGER  ILNBLNK
0601e85e79 Jean*0052       EXTERNAL ILNBLNK
a78204c019 Mart*0053 #endif
a897a05ba0 Patr*0054 
0601e85e79 Jean*0055 C     !LOCAL VARIABLES:
                0056 C     == local variables ==
a78204c019 Mart*0057 #if (defined (ALLOW_GENARR2D_CONTROL) || defined(ALLOW_GENARR3D_CONTROL))
                0058       INTEGER iarr
7c50f07931 Mart*0059 #endif
a78204c019 Mart*0060 #ifdef ALLOW_GENARR2D_CONTROL
                0061       _RL     airTlev1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0062       _RL     airQlev1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0063       INTEGER igen_etan,igen_bdrag,igen_geoth
                0064 # ifdef ALLOW_SHELFICE
                0065       INTEGER igen_shiCoeffT, igen_shiCoeffS, igen_shiCDrag
                0066       INTEGER i, j, bi, bj, k2
                0067       LOGICAL dragThermoEqualMom
                0068 # else
                0069       INTEGER i, j, bi, bj
                0070 # endif
                0071 #endif /* ALLOW_GENARR2D_CONTROL */
7c50f07931 Mart*0072 #ifdef ALLOW_GENARR3D_CONTROL
a78204c019 Mart*0073       INTEGER igen_theta0, igen_salt0
                0074       INTEGER igen_kapgm, igen_kapredi, igen_diffkr
                0075 # if (defined (ALLOW_UVEL0_CONTROL) && defined (ALLOW_VVEL0_CONTROL))
                0076       INTEGER igen_uvel0, igen_vvel0
                0077 # endif
                0078 # ifdef ALLOW_PTRACERS
                0079       INTEGER iPtr, iLen
                0080       INTEGER igen_ptr(PTRACERS_num)
                0081 # endif
                0082 #endif /* ALLOW_GENARR3D_CONTROL */
a897a05ba0 Patr*0083 CEOP
                0084 
                0085 #ifdef ALLOW_GENARR2D_CONTROL
a78204c019 Mart*0086 C--   generic 2D control variables
                0087 
                0088       igen_etan=0
                0089       igen_bdrag=0
                0090       igen_geoth=0
                0091 #ifdef ALLOW_SHELFICE
                0092       igen_shiCoeffT=0
                0093       igen_shiCoeffS=0
                0094       igen_shiCDrag=0
                0095 #endif
0601e85e79 Jean*0096       DO iarr = 1, maxCtrlArr2D
a78204c019 Mart*0097        IF (xx_genarr2d_weight(iarr).NE.' ') THEN
                0098         IF (xx_genarr2d_file(iarr)(1:7).EQ.'xx_etan')
                0099      &     igen_etan=iarr
                0100         IF (xx_genarr2d_file(iarr)(1:13).EQ.'xx_bottomdrag')
                0101      &     igen_bdrag=iarr
                0102         IF (xx_genarr2d_file(iarr)(1:13).EQ.'xx_geothermal')
                0103      &     igen_geoth=iarr
                0104 #ifdef ALLOW_SHELFICE
                0105 # ifndef SHI_ALLOW_GAMMAFRICT
                0106         IF (xx_genarr2d_file(iarr)(1:12).EQ.'xx_shicoefft')
                0107      &     igen_shiCoeffT=iarr
                0108         IF (xx_genarr2d_file(iarr)(1:12).EQ.'xx_shicoeffs')
                0109      &     igen_shiCoeffS=iarr
                0110 # else
                0111         IF (xx_genarr2d_file(iarr)(1:11).EQ.'xx_shicdrag')
                0112      &     igen_shiCDrag=iarr
                0113 # endif
                0114 #endif
                0115        ENDIF
                0116       ENDDO
                0117 
                0118       IF (igen_etan.GT.0) THEN
                0119         CALL CTRL_MAP_GENARR2D( etaN, igen_etan, myThid )
                0120       ENDIF
                0121 #ifdef ALLOW_BOTTOMDRAG_CONTROL
                0122       IF (igen_bdrag.GT.0)
                0123      &  CALL CTRL_MAP_GENARR2D( bottomDragFld, igen_bdrag, myThid )
                0124 #endif
                0125 #ifdef ALLOW_GEOTHERMAL_FLUX
                0126       IF (igen_geoth.GT.0)
                0127      &  CALL CTRL_MAP_GENARR2D( geothermalFlux, igen_geoth, myThid )
                0128 #endif
                0129 #ifdef ALLOW_SHELFICE
                0130 # ifndef SHI_ALLOW_GAMMAFRICT
                0131       IF (igen_shiCoeffT.GT.0)
                0132      &  CALL CTRL_MAP_GENARR2D(shiTransCoeffT,igen_shiCoeffT,myThid)
                0133 
                0134       IF (igen_shiCoeffS.GT.0)
                0135      &  CALL CTRL_MAP_GENARR2D(shiTransCoeffS,igen_shiCoeffS,myThid)
0601e85e79 Jean*0136 
a78204c019 Mart*0137 C--   xx_shiCoeffS not used, but shiCoeffT is adjusted by xx_shicoefft
                0138       IF ((igen_shiCoeffS.EQ.0).AND.(igen_shiCoeffT.GT.0)) THEN
                0139        DO bj = myByLo(myThid), myByHi(myThid)
                0140         DO bi = myBxLo(myThid), myBxHi(myThid)
                0141          DO j = 1-OLy,sNy+OLy
                0142           DO i = 1-OLx,sNx+OLx
                0143            shiTransCoeffS(i,j,bi,bj) =
                0144      &       SHELFICEsaltToHeatRatio*shiTransCoeffT(i,j,bi,bj)
                0145           ENDDO
                0146          ENDDO
0601e85e79 Jean*0147         ENDDO
                0148        ENDDO
a78204c019 Mart*0149 C--   xx_shiCoeffT not used, but shiCoeffS is adjusted by xx_shicoeffs
                0150       ELSEIF ((igen_shiCoeffT.EQ.0).AND.(igen_shiCoeffS.GT.0)) THEN
                0151        DO bj = myByLo(myThid), myByHi(myThid)
                0152         DO bi = myBxLo(myThid), myBxHi(myThid)
                0153          DO j = 1-OLy,sNy+OLy
                0154           DO i = 1-OLx,sNx+OLx
                0155            shiTransCoeffT(i,j,bi,bj) =
                0156      &       shiTransCoeffS(i,j,bi,bj)/SHELFICEsaltToHeatRatio
                0157           ENDDO
                0158          ENDDO
                0159         ENDDO
                0160        ENDDO
                0161       ENDIF
                0162 # else
                0163       dragThermoEqualMom = .FALSE.
                0164       IF (igen_shiCDrag.GT.0)
                0165      &  CALL CTRL_MAP_GENARR2D(shiCDragFld,igen_shiCDrag,myThid)
                0166 C--     Set drag coefficient used in momentum equal to thermodynamic,
                0167 C--      u* drag coefficient
                0168       DO k2 = 1, maxCtrlProc
57b21c88e4 Patr*0169 
a78204c019 Mart*0170        IF (xx_genarr2d_preproc_c(k2,igen_shiCDrag)(1:3).EQ.'mom')
                0171      &    dragThermoEqualMom = .TRUE.
                0172       ENDDO
                0173       IF (dragThermoEqualMom) THEN
                0174        DO bj = myByLo(myThid), myByHi(myThid)
                0175         DO bi = myBxLo(myThid), myBxHi(myThid)
                0176          DO j = 1-OLy,sNy+OLy
                0177           DO i = 1-OLx,sNx+OLx
                0178            shiDragQuadFld(i,j,bi,bj) = shiCDragFld(i,j,bi,bj)
                0179           ENDDO
                0180          ENDDO
                0181         ENDDO
                0182        ENDDO
                0183       ENDIF
                0184 # endif /* SHI_ALLOW_GAMMAFRICT */
                0185 #endif /* ALLOW_SHELFICE */
                0186 C--   begin customized code for experiment hs94.1x64x5
                0187       DO bj=myByLo(myThid), myByHi(myThid)
                0188        DO bi=myBxLo(myThid), myBxHi(myThid)
                0189         DO j = 1-OLy,sNy+OLy
                0190          DO i = 1-OLx,sNx+OLx
                0191           airTlev1(i,j,bi,bj) = theta(i,j,1,bi,bj)
                0192           airQlev1(i,j,bi,bj) = salt (i,j,1,bi,bj)
                0193          ENDDO
                0194         ENDDO
                0195        ENDDO
                0196       ENDDO
                0197       iarr = 1
                0198       CALL CTRL_MAP_GENARR2D( airTlev1, iarr, myThid )
                0199       iarr = 2
                0200       CALL CTRL_MAP_GENARR2D( airQlev1, iarr, myThid )
                0201       DO bj=myByLo(myThid), myByHi(myThid)
                0202        DO bi=myBxLo(myThid), myBxHi(myThid)
                0203         DO j = 1-OLy,sNy+OLy
                0204          DO i = 1-OLx,sNx+OLx
                0205           theta(i,j,1,bi,bj) = airTlev1(i,j,bi,bj)
                0206           salt (i,j,1,bi,bj) = airQlev1(i,j,bi,bj)
                0207          ENDDO
                0208         ENDDO
                0209        ENDDO
                0210       ENDDO
                0211 C---  end customized code
0601e85e79 Jean*0212 
                0213 #endif /* ALLOW_GENARR2D_CONTROL */
a897a05ba0 Patr*0214 
                0215 #ifdef ALLOW_GENARR3D_CONTROL
a78204c019 Mart*0216 C--   generic 3D control variables
                0217 
                0218       igen_theta0=0
                0219       igen_salt0=0
                0220       igen_kapgm=0
                0221       igen_kapredi=0
                0222       igen_diffkr=0
                0223 # if (defined (ALLOW_UVEL0_CONTROL) && defined (ALLOW_VVEL0_CONTROL))
                0224       igen_uvel0=0
                0225       igen_vvel0=0
                0226 # endif
                0227 # ifdef ALLOW_PTRACERS
                0228       DO iPtr = 1, PTRACERS_num
                0229         igen_ptr(iPtr) = 0
                0230       ENDDO
                0231 # endif /* ALLOW_PTRACERS */
0601e85e79 Jean*0232       DO iarr = 1, maxCtrlArr3D
a78204c019 Mart*0233        IF (xx_genarr3d_weight(iarr).NE.' ') THEN
                0234         IF (xx_genarr3d_file(iarr)(1:8).EQ.'xx_theta')
                0235      &     igen_theta0=iarr
                0236         IF (xx_genarr3d_file(iarr)(1:7).EQ.'xx_salt')
                0237      &     igen_salt0=iarr
                0238         IF (xx_genarr3d_file(iarr)(1:8).EQ.'xx_kapgm')
                0239      &     igen_kapgm=iarr
                0240         IF (xx_genarr3d_file(iarr)(1:10).EQ.'xx_kapredi')
                0241      &     igen_kapredi=iarr
                0242         IF (xx_genarr3d_file(iarr)(1:9).EQ.'xx_diffkr')
                0243      &     igen_diffkr=iarr
                0244 # if (defined (ALLOW_UVEL0_CONTROL) && defined (ALLOW_VVEL0_CONTROL))
                0245         IF (xx_genarr3d_file(iarr)(1:7).EQ.'xx_uvel')
                0246      &     igen_uvel0=iarr
                0247         IF (xx_genarr3d_file(iarr)(1:7).EQ.'xx_vvel')
                0248      &     igen_vvel0=iarr
                0249 # endif
                0250 # ifdef ALLOW_PTRACERS
                0251         IF ( usePTRACERS ) THEN
                0252           iLen = ILNBLNK(xx_genarr3d_file(iarr))
                0253           IF ( iLen.EQ.7 .AND.
                0254      &         xx_genarr3d_file(iarr)(1:6).EQ.'xx_ptr' ) THEN
                0255             READ(xx_genarr3d_file(iarr)(7:7),*) iPtr
                0256             IF ( iPtr.GE.1 .AND. iPtr.LE.PTRACERS_numInUse )
                0257      &                  igen_ptr(iPtr) = iarr
                0258           ENDIF
                0259         ENDIF
                0260 # endif /* ALLOW_PTRACERS */
                0261        ENDIF
                0262       ENDDO
0601e85e79 Jean*0263 
a78204c019 Mart*0264 C--   begin customized code for experiment hs94.1x64x5
                0265 C     This is commented out to not interfer with the customized
                0266 C     for the genarr2d part. Alternatively, one could use
                0267 C     store directives to avoid additional recomputation warnings.
                0268 C     IF (igen_theta0.GT.0)
                0269 C    &  CALL CTRL_MAP_GENARR3D( theta, igen_theta0, myThid )
                0270 C     IF (igen_salt0.GT.0)
                0271 C    &  CALL CTRL_MAP_GENARR3D( salt, igen_salt0, myThid )
                0272 C---  end customized code
                0273 # ifdef ALLOW_KAPGM_CONTROL
                0274       IF (igen_kapgm.GT.0)
                0275      &  CALL CTRL_MAP_GENARR3D( kapGM, igen_kapgm, myThid )
                0276 # endif
                0277 # ifdef ALLOW_KAPREDI_CONTROL
                0278       IF (igen_kapredi.GT.0)
                0279      &  CALL CTRL_MAP_GENARR3D( kapRedi, igen_kapredi, myThid )
                0280 # endif
                0281 # if ( defined ALLOW_DIFFKR_CONTROL && defined ALLOW_3D_DIFFKR )
                0282       IF (igen_diffkr.GT.0)
                0283      &  CALL CTRL_MAP_GENARR3D( diffKr, igen_diffkr, myThid )
                0284 # endif
                0285 
                0286 # ifdef ALLOW_PTRACERS
                0287 CADJ loop = parallel
                0288       DO iPtr = 1, PTRACERS_num
                0289         IF ( igen_ptr(iPtr).GT.0 ) THEN
                0290           CALL CTRL_MAP_GENARR3D( pTracer(1-OLx,1-OLy,1,1,1,iPtr),
                0291      &                            igen_ptr(iPtr), myThid )
                0292         ENDIF
0601e85e79 Jean*0293       ENDDO
a78204c019 Mart*0294 # endif /* ALLOW_PTRACERS */
57b21c88e4 Patr*0295 
a78204c019 Mart*0296 # if (defined (ALLOW_UVEL0_CONTROL) && defined (ALLOW_VVEL0_CONTROL))
                0297       IF (igen_uvel0.GT.0 .AND. igen_vvel0.GT.0) THEN
                0298         CALL CTRL_MAP_GENARR3D( uVel, igen_uvel0, myThid )
                0299         CALL CTRL_MAP_GENARR3D( vVel, igen_vvel0, myThid )
                0300         CALL EXCH_UV_XYZ_RL( uVel, vVel, .TRUE., myThid )
                0301       ENDIF
                0302 # endif
0601e85e79 Jean*0303 
                0304 #endif /* ALLOW_GENARR3D_CONTROL */
a897a05ba0 Patr*0305 
0601e85e79 Jean*0306       RETURN
                0307       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!