File indexing completed on 2024-10-09 05:10:44 UTC
view on githubraw file Latest commit 4c91ca28 on 2024-10-08 14:20:22 UTC
8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
27f56e97bb Gael*0002 #ifdef ALLOW_SEAICE
0003 # include "SEAICE_OPTIONS.h"
0004 #endif
9aeddbf372 Gael*0005 #ifdef ALLOW_EXF
0006 # include "EXF_OPTIONS.h"
0007 #endif
0008 #ifdef ALLOW_CTRL
0009 # include "CTRL_OPTIONS.h"
0010 #endif
37a2578dc5 Gael*0011 #ifdef ALLOW_GMREDI
0012 # include "GMREDI_OPTIONS.h"
0013 #endif
8c157ed454 Patr*0014
4c91ca28d5 Ou W*0015
0016
0017
8f7d13d0c9 Jean*0018
4c91ca28d5 Ou W*0019
0020 SUBROUTINE COST_GENCOST_CUSTOMIZE( myThid )
8c157ed454 Patr*0021
4c91ca28d5 Ou W*0022
0023
8c157ed454 Patr*0024
4c91ca28d5 Ou W*0025
0026 IMPLICIT NONE
0027
8c157ed454 Patr*0028 #include "EEPARAMS.h"
0029 #include "SIZE.h"
27f56e97bb Gael*0030 #include "GRID.h"
8c157ed454 Patr*0031 #include "PARAMS.h"
0032 #include "DYNVARS.h"
0033 #include "FFIELDS.h"
f09238ab8f Gael*0034 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0035 # include "ECCO_SIZE.h"
0036 # include "ECCO.h"
f09238ab8f Gael*0037 #endif
27f56e97bb Gael*0038 #ifdef ALLOW_SEAICE
0039 # include "SEAICE_SIZE.h"
0040 # include "SEAICE.h"
0041 #endif
f09238ab8f Gael*0042 #ifdef ALLOW_EXF
0043 # include "EXF_FIELDS.h"
0044 #endif
9aeddbf372 Gael*0045 #ifdef ALLOW_CTRL
0046 # include "CTRL_FIELDS.h"
0047 #endif
94a8024bbe Jean*0048 #ifdef ALLOW_GMREDI
0049 # include "GMREDI.h"
0050 #endif
81e05fa829 Gael*0051 #ifdef ALLOW_PTRACERS
0052 # include "PTRACERS_SIZE.h"
0053 # include "PTRACERS_FIELDS.h"
0054 #endif
8c157ed454 Patr*0055
4c91ca28d5 Ou W*0056
0057
0058 INTEGER myThid
8c157ed454 Patr*0059
4c91ca28d5 Ou W*0060
8c157ed454 Patr*0061
0062 #ifdef ALLOW_GENCOST_CONTRIBUTION
4c91ca28d5 Ou W*0063
0064 INTEGER bi,bj
0065 INTEGER i,j,k
5cce2b5d76 Gael*0066 #ifdef ALLOW_GENCOST3D
4c91ca28d5 Ou W*0067 INTEGER k2,kk
0068 INTEGER itr
5cce2b5d76 Gael*0069 #endif
4c91ca28d5 Ou W*0070 INTEGER kLev
5efdcaef73 Gael*0071 #ifdef ALLOW_EXF
0072 _RL uBarC, vBarC
4c91ca28d5 Ou W*0073 _RL zontau (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0074 _RL mertau (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0075 _RL zonwind (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0076 _RL merwind (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
5efdcaef73 Gael*0077 #endif
4c91ca28d5 Ou W*0078 INTEGER jMin,jMax
0079 INTEGER iMin,iMax
0080
8c157ed454 Patr*0081
4c91ca28d5 Ou W*0082 jMin = 1
0083 jMax = sNy
0084 iMin = 1
0085 iMax = sNx
69f8f4c84c Patr*0086
5efdcaef73 Gael*0087 #ifdef ALLOW_EXF
0088
4c91ca28d5 Ou W*0089 do bj = myByLo(myThid),myByHi(myThid)
0090 do bi = myBxLo(myThid),myBxHi(myThid)
0091 do j = jMin,jMax
0092 do i = iMin,iMax
5efdcaef73 Gael*0093 uBarC = 0.5 _d 0
0094 & *(ustress(i,j,bi,bj)+ustress(i+1,j,bi,bj))
0095 vBarC = 0.5 _d 0
0096 & *(vstress(i,j,bi,bj)+vstress(i,j+1,bi,bj))
9aeddbf372 Gael*0097 zontau(i,j,bi,bj) = angleCosC(i,j,bi,bj)*uBarC
5efdcaef73 Gael*0098 & -angleSinC(i,j,bi,bj)*vBarC
9aeddbf372 Gael*0099 mertau(i,j,bi,bj) = angleSinC(i,j,bi,bj)*uBarC
5efdcaef73 Gael*0100 & +angleCosC(i,j,bi,bj)*vBarC
0101 enddo
0102 enddo
0103 enddo
0104 enddo
0105
9aeddbf372 Gael*0106
0107
0108
5efdcaef73 Gael*0109
9aeddbf372 Gael*0110 CALL ROTATE_UV2EN_RL(uwind,vwind,zonwind,merwind,
0111 & .TRUE.,.FALSE.,.TRUE.,1,myThid)
0112 #endif
5efdcaef73 Gael*0113
f09238ab8f Gael*0114 do k=1,NGENCOST
81e05fa829 Gael*0115 itr=gencost_itracer(k)
13d362b8c1 Ou W*0116 kLev = MAX( 1, MIN( Nr, gencost_kLev_select(k) ) )
4c91ca28d5 Ou W*0117 do bj = myByLo(myThid),myByHi(myThid)
0118 do bi = myBxLo(myThid),myBxHi(myThid)
0119 do j = jMin,jMax
0120 do i = iMin,iMax
f09238ab8f Gael*0121
13d362b8c1 Ou W*0122 if (gencost_barfile(k)(1:5).EQ.'m_eta' .and.
0123 & gencost_barfile(k)(1:9).NE.'m_eta_dyn') then
0124 gencost_modfld(i,j,bi,bj,k) =
556841ad42 Gael*0125 & m_eta(i,j,bi,bj)*maskC(i,j,1,bi,bj)
bdae1843b8 Gael*0126 elseif (gencost_barfile(k)(1:9).EQ.'m_boxmean') then
13d362b8c1 Ou W*0127 gencost_modfld(i,j,bi,bj,k) =
bdae1843b8 Gael*0128 & gencost_storefld(i,j,bi,bj,k)
447bdc4b79 Gael*0129 elseif (gencost_barfile(k)(1:9).EQ.'m_horflux') then
13d362b8c1 Ou W*0130 gencost_modfld(i,j,bi,bj,k) =
447bdc4b79 Gael*0131 & gencost_storefld(i,j,bi,bj,k)
985662a3b3 Gael*0132 elseif (gencost_barfile(k)(1:5).EQ.'m_sst') then
13d362b8c1 Ou W*0133 gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0134 & THETA(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
985662a3b3 Gael*0135 elseif (gencost_barfile(k)(1:5).EQ.'m_sss') then
13d362b8c1 Ou W*0136 gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0137 & SALT(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
13d362b8c1 Ou W*0138 elseif (gencost_barfile(k)(1:11).EQ.'m_drifterUE') then
0139 gencost_modfld(i,j,bi,bj,k) =
0140 & m_UE(i,j,kLev,bi,bj)*maskC(i,j,kLev,bi,bj)
0141 elseif (gencost_barfile(k)(1:11).EQ.'m_drifterVN') then
0142 gencost_modfld(i,j,bi,bj,k) =
0143 & m_VN(i,j,kLev,bi,bj)*maskC(i,j,kLev,bi,bj)
0144 elseif (gencost_barfile(k)(1:4).EQ.'m_bp' .and.
0145 & gencost_barfile(k)(1:12).NE.'m_bp_nopabar') then
0146 gencost_modfld(i,j,bi,bj,k) =
0147 & m_bp(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0148 #ifdef ATMOSPHERIC_LOADING
0149 #ifdef ALLOW_IB_CORR
0150 elseif (gencost_barfile(k)(1:9).EQ.'m_eta_dyn') then
0151 gencost_modfld(i,j,bi,bj,k) =
0152 & m_eta_dyn(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0153 elseif (gencost_barfile(k)(1:12).EQ.'m_bp_nopabar') then
0154 gencost_modfld(i,j,bi,bj,k) =
0155 & m_bp_nopabar(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0156 #endif
6b2230d510 Ou W*0157 #endif
9aeddbf372 Gael*0158 #ifdef ALLOW_GEOTHERMAL_FLUX
0159 elseif (gencost_barfile(k)(1:16).EQ.'m_geothermalflux') then
0160 gencost_modfld(i,j,bi,bj,k) =
0161 & geothermalFlux(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0162 #endif
0163 #ifdef ALLOW_EXF
0164 elseif (gencost_barfile(k)(1:9).EQ.'m_ustress') then
13d362b8c1 Ou W*0165 gencost_modfld(i,j,bi,bj,k) =
9aeddbf372 Gael*0166 & zontau(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0167 elseif (gencost_barfile(k)(1:9).EQ.'m_vstress') then
13d362b8c1 Ou W*0168 gencost_modfld(i,j,bi,bj,k) =
9aeddbf372 Gael*0169 & mertau(i,j,bi,bj)*maskC(i,j,1,bi,bj)
c2222c60b2 An T*0170 elseif (gencost_barfile(k)(1:7).EQ.'m_uwind') then
9aeddbf372 Gael*0171 gencost_modfld(i,j,bi,bj,k) =
0172 & zonwind(i,j,bi,bj)*maskC(i,j,1,bi,bj)
c2222c60b2 An T*0173 elseif (gencost_barfile(k)(1:7).EQ.'m_vwind') then
9aeddbf372 Gael*0174 gencost_modfld(i,j,bi,bj,k) =
0175 & merwind(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0176 #ifdef ALLOW_ATM_TEMP
9aeddbf372 Gael*0177 elseif (gencost_barfile(k)(1:7).EQ.'m_atemp') then
0178 gencost_modfld(i,j,bi,bj,k) =
0179 & atemp(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0180 elseif (gencost_barfile(k)(1:5).EQ.'m_aqh') then
0181 gencost_modfld(i,j,bi,bj,k) =
0182 & aqh(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0183 elseif (gencost_barfile(k)(1:8).EQ.'m_precip') then
0184 gencost_modfld(i,j,bi,bj,k) =
0185 & precip(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0186 #endif
0187 #ifdef ALLOW_DOWNWARD_RADIATION
9aeddbf372 Gael*0188 elseif (gencost_barfile(k)(1:8).EQ.'m_swdown') then
0189 gencost_modfld(i,j,bi,bj,k) =
0190 & swdown(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0191 elseif (gencost_barfile(k)(1:8).EQ.'m_lwdown') then
0192 gencost_modfld(i,j,bi,bj,k) =
0193 & lwdown(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0194 #endif
9aeddbf372 Gael*0195 elseif (gencost_barfile(k)(1:8).EQ.'m_wspeed') then
0196 gencost_modfld(i,j,bi,bj,k) =
0197 & wspeed(i,j,bi,bj)*maskC(i,j,1,bi,bj)
94a8024bbe Jean*0198 #endif /* ALLOW_EXF */
9aeddbf372 Gael*0199 #ifdef ALLOW_CTRL
0200 #ifdef ALLOW_BOTTOMDRAG_CONTROL
c2222c60b2 An T*0201 elseif (gencost_barfile(k)(1:12).EQ.'m_bottomdrag') then
9aeddbf372 Gael*0202 gencost_modfld(i,j,bi,bj,k) =
0203 & bottomDragFld(i,j,bi,bj)*maskC(i,j,1,bi,bj)
0204 #endif
0205 #endif
f09238ab8f Gael*0206 #ifdef ALLOW_SEAICE
9aeddbf372 Gael*0207 elseif ( (gencost_name(k).EQ.'siv4-conc').OR.
f172f192aa Gael*0208 & (gencost_barfile(k)(1:8).EQ.'m_siarea') ) then
13d362b8c1 Ou W*0209 gencost_modfld(i,j,bi,bj,k) =
0210 & area(i,j,bi,bj)*maskC(i,j,1,bi,bj)
f09238ab8f Gael*0211 elseif (gencost_name(k).EQ.'siv4-deconc') then
13d362b8c1 Ou W*0212 gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0213 & theta(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
9aeddbf372 Gael*0214 elseif ( (gencost_name(k).EQ.'siv4-exconc').OR.
13d362b8c1 Ou W*0215 & (gencost_barfile(k)(1:8).EQ.'m_siheff') ) then
0216 gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0217 & heff(i,j,bi,bj)*maskC(i,j,1,bi,bj)
f172f192aa Gael*0218 elseif (gencost_barfile(k)(1:9).EQ.'m_sihsnow') then
9aeddbf372 Gael*0219 gencost_modfld(i,j,bi,bj,k) =
0220 & hsnow(i,j,bi,bj)*maskC(i,j,1,bi,bj)
4c91ca28d5 Ou W*0221 elseif (gencost_barfile(k)(1:11).EQ.'m_freeboard') then
0222 gencost_modfld(i,j,bi,bj,k) =
0223 & gencost_storefld(i,j,bi,bj,k)*maskC(i,j,1,bi,bj)
f09238ab8f Gael*0224 #endif
5cce2b5d76 Gael*0225 #ifdef ALLOW_GENCOST3D
985662a3b3 Gael*0226 elseif (gencost_barfile(k)(1:7).EQ.'m_theta') then
5cce2b5d76 Gael*0227 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0228 do k2=1,Nr
5cce2b5d76 Gael*0229 gencost_mod3d(i,j,k2,bi,bj,kk) =
0230 & theta(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
0231 enddo
985662a3b3 Gael*0232 elseif (gencost_barfile(k)(1:6).EQ.'m_salt') then
5cce2b5d76 Gael*0233 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0234 do k2=1,Nr
5cce2b5d76 Gael*0235 gencost_mod3d(i,j,k2,bi,bj,kk) =
0236 & salt(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
0237 enddo
81e05fa829 Gael*0238 #ifdef ALLOW_PTRACERS
0239 elseif (gencost_barfile(k)(1:9).EQ.'m_ptracer') then
0240 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0241 do k2=1,Nr
81e05fa829 Gael*0242 gencost_mod3d(i,j,k2,bi,bj,kk) =
0243 & pTracer(i,j,k2,bi,bj,itr)*maskC(i,j,k2,bi,bj)
0244 enddo
0245 #endif
c2222c60b2 An T*0246 elseif (gencost_barfile(k)(1:4).EQ.'m_UE') then
556841ad42 Gael*0247 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0248 do k2=1,Nr
556841ad42 Gael*0249 gencost_mod3d(i,j,k2,bi,bj,kk) =
0250 & m_UE(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
0251 enddo
c2222c60b2 An T*0252 elseif (gencost_barfile(k)(1:4).EQ.'m_VN') then
556841ad42 Gael*0253 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0254 do k2=1,Nr
556841ad42 Gael*0255 gencost_mod3d(i,j,k2,bi,bj,kk) =
0256 & m_VN(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
0257 enddo
0761692d75 An T*0258 elseif (gencost_barfile(k)(1:7).EQ.'m_trVol') then
0259 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0260 do k2=1,Nr
fce41e6d01 An T*0261 gencost_mod3d(i,j,k2,bi,bj,kk) = trVol(i,j,k2,bi,bj)
0761692d75 An T*0262 enddo
0263 elseif (gencost_barfile(k)(1:8).EQ.'m_trHeat') then
0264 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0265 do k2=1,Nr
fce41e6d01 An T*0266 gencost_mod3d(i,j,k2,bi,bj,kk) = trHeat(i,j,k2,bi,bj)
0761692d75 An T*0267 enddo
0268 elseif (gencost_barfile(k)(1:8).EQ.'m_trSalt') then
0269 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0270 do k2=1,Nr
ba67a799b1 An T*0271 gencost_mod3d(i,j,k2,bi,bj,kk) = trSalt(i,j,k2,bi,bj)
0761692d75 An T*0272 enddo
9aeddbf372 Gael*0273 #if (defined (ALLOW_3D_DIFFKR) || defined (ALLOW_DIFFKR_CONTROL))
0274 elseif (gencost_barfile(k)(1:8).EQ.'m_diffkr') then
0275 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0276 do k2=1,Nr
9aeddbf372 Gael*0277 gencost_mod3d(i,j,k2,bi,bj,kk) =
0278 & diffkr(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
0279 enddo
0280 #endif
0281 #ifdef ALLOW_CTRL
94a8024bbe Jean*0282 #if ( defined ALLOW_KAPGM_CONTROL && defined GM_READ_K3D_GM )
9aeddbf372 Gael*0283 elseif (gencost_barfile(k)(1:7).EQ.'m_kapgm') then
0284 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0285 do k2=1,Nr
9aeddbf372 Gael*0286 gencost_mod3d(i,j,k2,bi,bj,kk) =
94a8024bbe Jean*0287 & GM_inpK3dGM(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
9aeddbf372 Gael*0288 enddo
0289 #endif
94a8024bbe Jean*0290 #if ( defined ALLOW_KAPREDI_CONTROL && defined GM_READ_K3D_REDI )
9aeddbf372 Gael*0291 elseif (gencost_barfile(k)(1:9).EQ.'m_kapredi') then
0292 kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0293 do k2=1,Nr
9aeddbf372 Gael*0294 gencost_mod3d(i,j,k2,bi,bj,kk) =
94a8024bbe Jean*0295 & GM_inpK3dRedi(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
9aeddbf372 Gael*0296 enddo
0297 #endif
0298 #endif
94a8024bbe Jean*0299 #endif /* ALLOW_GENCOST3D */
5cce2b5d76 Gael*0300 endif
27f56e97bb Gael*0301
8c157ed454 Patr*0302 enddo
0303 enddo
0304 enddo
0305 enddo
f09238ab8f Gael*0306 enddo
8c157ed454 Patr*0307
0308 #endif /* ALLOW_GENCOST_CONTRIBUTION */
0309
13d362b8c1 Ou W*0310 RETURN
0311 END