** Warning **
Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.
Last-Modified: Sun, 7 Sep 2024 05:11:39 GMT
Content-Type: text/html; charset=utf-8
MITgcm/MITgcm/verification/tutorial_global_oce_biogeo/code_oad/ctrl_map_ini_genarr.F
File indexing completed on 2023-11-05 05:11:25 UTC
view on github raw file Latest commit 65754df4 on 2023-11-04 17:55:24 UTC
e85a34039f Oliv* 0001 #include "CTRL_OPTIONS.h "
2e7aec9951 dngo* 0002 #define PREVENT_TOO_COLD_TEMP
e85a34039f Oliv* 0003
0004
0005
0006
0007 SUBROUTINE CTRL_MAP_INI_GENARR ( myThid )
0008
0009
0010
0011
0012
0013
4d72283393 Mart* 0014
e85a34039f Oliv* 0015
2e7aec9951 dngo* 0016
0017
0018
e85a34039f Oliv* 0019
0020
0021
0022 IMPLICIT NONE
0023
0024
0025 #include "SIZE.h "
0026 #include "EEPARAMS.h "
0027 #include "PARAMS.h "
0028 #include "GRID.h "
0029 #include "DYNVARS.h "
0030 #include "FFIELDS.h "
0031 #include "CTRL_SIZE.h "
4d72283393 Mart* 0032 #include "CTRL.h "
e85a34039f Oliv* 0033 #include "CTRL_GENARR.h "
edcd27be69 Mart* 0034 #include "CTRL_DUMMY.h "
65754df434 Mart* 0035 #include "OPTIMCYCLE.h "
e85a34039f Oliv* 0036 #ifdef ALLOW_PTRACERS
0037 # include "PTRACERS_SIZE.h "
0038
0039 # include "PTRACERS_FIELDS.h "
0040 #endif
0041
0042
0043
0044 INTEGER myThid
0045
0046
0047 INTEGER ILNBLNk
0048 EXTERNAL ILNBLNK
0049
0050
0051
2e7aec9951 dngo* 0052 INTEGER bi ,bj
0053 INTEGER i ,j ,k
0054 INTEGER il
0055 INTEGER iarr , iptr
0056
0057 LOGICAL doglobalread
0058 LOGICAL ladinit
0059 CHARACTER *(MAX_LEN_FNAM ) fnamebase
de57a2ec4b Mart* 0060 CHARACTER *(MAX_LEN_FNAM ) fnamegeneric
2e7aec9951 dngo* 0061 CHARACTER *(MAX_LEN_MBUF ) msgBuf
e85a34039f Oliv* 0062 _RL fac
7c50f07931 Mart* 0063 #ifdef ALLOW_GENARR2D_CONTROL
2e7aec9951 dngo* 0064 _RL tmpfld2d (1-OLx :sNx +OLx ,1-OLy :sNy +OLy , nSx ,nSy )
7c50f07931 Mart* 0065 #endif
0066 #ifdef ALLOW_GENARR3D_CONTROL
2e7aec9951 dngo* 0067 _RL tmpfld3d (1-OLx :sNx +OLx ,1-OLy :sNy +OLy ,Nr ,nSx ,nSy )
7c50f07931 Mart* 0068 #endif
e85a34039f Oliv* 0069
0070
2e7aec9951 dngo* 0071 doglobalread = .FALSE.
0072 ladinit = .FALSE.
e85a34039f Oliv* 0073 fac = 1. _d 0
0074
0075 #ifdef ALLOW_GENARR2D_CONTROL
0076
0077
0078
0079
0080
0081
0082
0083 DO iarr = 1, maxCtrlArr2D
0084
2e7aec9951 dngo* 0085
0086
0087
0088
0089 DO bj =myByLo (myThid ), myByHi (myThid )
0090 DO bi =myBxLo (myThid ), myBxHi (myThid )
0091 DO j = 1,sNy
0092 DO i = 1,sNx
0093 tmpfld2d (i ,j ,bi ,bj ) = 0. _d 0
0094 ENDDO
0095 ENDDO
0096 ENDDO
0097 ENDDO
e85a34039f Oliv* 0098 fnamebase = xx_genarr2d_file (iarr )
0099 il =ILNBLNK ( fnamebase )
de57a2ec4b Mart* 0100 WRITE (fnamegeneric ,'(2A,I10.10)' )
e85a34039f Oliv* 0101 & fnamebase (1:il ),'.' ,optimcycle
0102 CALL ACTIVE_READ_XY ( fnamegeneric , tmpfld2d , 1,
0103 & doglobalread , ladinit , optimcycle ,
0104 & myThid , xx_genarr2d_dummy (iarr ) )
2e7aec9951 dngo* 0105 IF ( iarr .EQ. 1 ) THEN
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 qnet (i ,j ,bi ,bj ) = qnet (i ,j ,bi ,bj )
0111 & + fac *tmpfld2d (i ,j ,bi ,bj )
0112 ENDDO
0113 ENDDO
0114 ENDDO
e85a34039f Oliv* 0115 ENDDO
2e7aec9951 dngo* 0116 ELSEIF ( iarr .EQ. 2 ) THEN
0117 DO bj =myByLo (myThid ), myByHi (myThid )
0118 DO bi =myBxLo (myThid ), myBxHi (myThid )
0119 DO j = 1,sNy
0120 DO i = 1,sNx
0121 empmr (i ,j ,bi ,bj ) = empmr (i ,j ,bi ,bj )
0122 & + fac *tmpfld2d (i ,j ,bi ,bj )
0123 ENDDO
0124 ENDDO
0125 ENDDO
0126 ENDDO
0127 ELSEIF ( iarr .EQ. 3 ) THEN
0128 DO bj =myByLo (myThid ), myByHi (myThid )
0129 DO bi =myBxLo (myThid ), myBxHi (myThid )
0130 DO j = 1,sNy
0131 DO i = 1,sNx
0132 fu (i ,j ,bi ,bj ) = fu (i ,j ,bi ,bj )
0133 & + fac *tmpfld2d (i ,j ,bi ,bj )
0134 ENDDO
0135 ENDDO
0136 ENDDO
0137 ENDDO
0138 ELSEIF ( iarr .EQ. 4 ) THEN
0139 DO bj =myByLo (myThid ), myByHi (myThid )
0140 DO bi =myBxLo (myThid ), myBxHi (myThid )
0141 DO j = 1,sNy
0142 DO i = 1,sNx
0143 fv (i ,j ,bi ,bj ) = fv (i ,j ,bi ,bj )
0144 & + fac *tmpfld2d (i ,j ,bi ,bj )
0145 ENDDO
0146 ENDDO
0147 ENDDO
0148 ENDDO
0149 ENDIF
e85a34039f Oliv* 0150
0151 ENDDO
2e7aec9951 dngo* 0152 _EXCH_XY_RS ( qnet , myThid )
0153 _EXCH_XY_RS ( empmr , myThid )
0154 CALL EXCH_UV_XY_RS(fu ,fv ,.TRUE. ,myThid )
e85a34039f Oliv* 0155
0156 #endif /* ALLOW_GENARR2D_CONTROL */
0157
0158 #ifdef ALLOW_GENARR3D_CONTROL
0159
0160
0161
0162
0163
0164
0165
0166
2e7aec9951 dngo* 0167
e85a34039f Oliv* 0168
2e7aec9951 dngo* 0169 IF ( maxCtrlArr3D -3 .GT. PTRACERS_num ) THEN
699e96b1ba Jean* 0170 WRITE (msgBuf ,'(A)' )
2e7aec9951 dngo* 0171 & 'CTRL_MAP_INI_GENARR: need maxCtrlArr3D-3 <= PTRACERS_num'
e85a34039f Oliv* 0172 CALL PRINT_ERROR ( msgBuf , myThid )
0173 STOP 'ABNORMAL END: S/R CTRL_MAP_INI_GENARR'
0174 ENDIF
0175
0176
0177 DO iarr = 1, maxCtrlArr3D
0178
2e7aec9951 dngo* 0179 DO bj =myByLo (myThid ), myByHi (myThid )
0180 DO bi =myBxLo (myThid ), myBxHi (myThid )
0181 DO k = 1,Nr
0182 DO j = 1,sNy
0183 DO i = 1,sNx
0184 tmpfld3d (i ,j ,k ,bi ,bj ) = 0. _d 0
0185 ENDDO
0186 ENDDO
0187 ENDDO
0188 ENDDO
0189 ENDDO
e85a34039f Oliv* 0190 fnamebase = xx_genarr3d_file (iarr )
0191 il =ILNBLNK ( fnamebase )
de57a2ec4b Mart* 0192 WRITE (fnamegeneric ,'(2A,I10.10)' )
e85a34039f Oliv* 0193 & fnamebase (1:il ),'.' ,optimcycle
0194 CALL ACTIVE_READ_XYZ ( fnamegeneric , tmpfld3d , 1,
0195 & doglobalread , ladinit , optimcycle ,
0196 & myThid , xx_genarr3d_dummy (iarr ) )
2e7aec9951 dngo* 0197 IF ( iarr .EQ. 1 ) THEN
0198 DO bj =myByLo (myThid ), myByHi (myThid )
0199 DO bi =myBxLo (myThid ), myBxHi (myThid )
0200 DO k = 1,Nr
0201 DO j = 1,sNy
0202 DO i = 1,sNx
0203 theta (i ,j ,k ,bi ,bj ) = theta (i ,j ,k ,bi ,bj )
e85a34039f Oliv* 0204 & + fac *tmpfld3d (i ,j ,k ,bi ,bj )
2e7aec9951 dngo* 0205 #ifdef PREVENT_TOO_COLD_TEMP
0206
0207 IF ( theta (i ,j ,k ,bi ,bj ).LT. -2.0 _d 0 )
0208 & theta (i ,j ,k ,bi ,bj ) = -2.0 _d 0
0209 #endif
0210 ENDDO
0211 ENDDO
0212 ENDDO
0213 ENDDO
e85a34039f Oliv* 0214 ENDDO
2e7aec9951 dngo* 0215 CALL EXCH_3D_RL( theta , Nr , myThid )
0216 ELSEIF ( iarr .EQ. 2 ) THEN
0217 DO bj =myByLo (myThid ), myByHi (myThid )
0218 DO bi =myBxLo (myThid ), myBxHi (myThid )
0219 DO k = 1,Nr
0220 DO j = 1,sNy
0221 DO i = 1,sNx
0222 salt (i ,j ,k ,bi ,bj ) = salt (i ,j ,k ,bi ,bj )
0223 & + fac *tmpfld3d (i ,j ,k ,bi ,bj )
0224 ENDDO
0225 ENDDO
0226 ENDDO
0227 ENDDO
0228 ENDDO
0229 CALL EXCH_3D_RL( salt , Nr , myThid )
0230 ELSEIF ( iarr .EQ. 3 ) THEN
0231 DO bj =myByLo (myThid ), myByHi (myThid )
0232 DO bi =myBxLo (myThid ), myBxHi (myThid )
0233 DO k = 1,Nr
0234 DO j = 1,sNy
0235 DO i = 1,sNx
0236 diffKr (i ,j ,k ,bi ,bj ) = diffKr (i ,j ,k ,bi ,bj )
0237 & + fac *tmpfld3d (i ,j ,k ,bi ,bj )
0238 ENDDO
0239 ENDDO
0240 ENDDO
0241 ENDDO
0242 ENDDO
0243 CALL EXCH_3D_RL( diffKr , Nr , myThid )
0244 ELSEIF ( iarr .EQ. 4 ) THEN
0245 iptr = iarr -3
0246 DO bj =myByLo (myThid ), myByHi (myThid )
0247 DO bi =myBxLo (myThid ), myBxHi (myThid )
0248 DO k = 1,Nr
0249 DO j = 1,sNy
0250 DO i = 1,sNx
0251 pTracer (i ,j ,k ,bi ,bj ,iptr ) = pTracer (i ,j ,k ,bi ,bj ,iptr )
0252 & + fac *tmpfld3d (i ,j ,k ,bi ,bj )
0253 ENDDO
0254 ENDDO
0255 ENDDO
0256 ENDDO
0257 ENDDO
0258 CALL EXCH_3D_RL( pTracer (1-OLx ,1-OLy ,1,1,1,iptr ),
e85a34039f Oliv* 0259 & Nr , myThid )
2e7aec9951 dngo* 0260 ENDIF
0261
e85a34039f Oliv* 0262
0263 ENDDO
0264
0265 #endif /* ALLOW_GENARR3D_CONTROL */
0266
0267 RETURN
0268 END