| 1 | MODULE cla_dynspg_tam |
|---|
| 2 | !!---------------------------------------------------------------------- |
|---|
| 3 | !! This software is governed by the CeCILL licence (Version 2) |
|---|
| 4 | !!---------------------------------------------------------------------- |
|---|
| 5 | #if defined key_tam |
|---|
| 6 | !!====================================================================== |
|---|
| 7 | !! *** MODULE cla_dynspg_tam : TANGENT/ADJOINT OF MODULE cla_dynspg *** |
|---|
| 8 | !! |
|---|
| 9 | !! Update the momentum trend with the cross land advection from surface |
|---|
| 10 | !! pressure gradient in the free surface constant volume case with |
|---|
| 11 | !! vector optimization. |
|---|
| 12 | !! |
|---|
| 13 | !!====================================================================== |
|---|
| 14 | !! History of the direct module: |
|---|
| 15 | !! ! (A. Bozec) Original code |
|---|
| 16 | !! 8.5 ! 02-11 (A. Bozec) F90: Free form and module |
|---|
| 17 | !! History of the TAM module: |
|---|
| 18 | !! 9.0 ! 09-03 (A. Weaver) Original version |
|---|
| 19 | !!---------------------------------------------------------------------- |
|---|
| 20 | !! dyn_spg_cla_tan : update the momentum trend with the surface pressure |
|---|
| 21 | !! gradient in the free surface constant volume case |
|---|
| 22 | !! with vector optimization (tangent routine) |
|---|
| 23 | !! dyn_spg_cla_adj : update the momentum trend with the surface pressure |
|---|
| 24 | !! gradient in the free surface constant volume case |
|---|
| 25 | !! with vector optimization (adjoint routine) |
|---|
| 26 | !!---------------------------------------------------------------------- |
|---|
| 27 | !! * Modules used |
|---|
| 28 | USE par_kind , ONLY: & ! Precision variables |
|---|
| 29 | & wp |
|---|
| 30 | USE in_out_manager, ONLY: & ! I/O manager |
|---|
| 31 | & lwp, & |
|---|
| 32 | & numout, & |
|---|
| 33 | & nit000, & |
|---|
| 34 | & nitend |
|---|
| 35 | USE dom_oce , ONLY: & ! Ocean space and time domain |
|---|
| 36 | & mi0, & |
|---|
| 37 | & mi1, & |
|---|
| 38 | & mj0, & |
|---|
| 39 | & mj1, & |
|---|
| 40 | & e1t, & |
|---|
| 41 | & e2t, & |
|---|
| 42 | & e2u, & |
|---|
| 43 | #if defined key_zco |
|---|
| 44 | & e3t_0, & |
|---|
| 45 | #else |
|---|
| 46 | & e3t, & |
|---|
| 47 | #endif |
|---|
| 48 | & tmask |
|---|
| 49 | USE oce_tam , ONLY: & ! Tangent-linear and adjoint model variables |
|---|
| 50 | & ua_tl, & |
|---|
| 51 | & va_tl, & |
|---|
| 52 | & ua_ad, & |
|---|
| 53 | & va_ad |
|---|
| 54 | USE sbc_oce_tam , ONLY: & ! Surface BCs for tangent and adjoint model |
|---|
| 55 | & emp_tl, & |
|---|
| 56 | & emp_ad |
|---|
| 57 | USE lib_mpp , ONLY: & ! Massively parallel processing library |
|---|
| 58 | & mpp_sum, & |
|---|
| 59 | & lk_mpp |
|---|
| 60 | |
|---|
| 61 | IMPLICIT NONE |
|---|
| 62 | PRIVATE |
|---|
| 63 | |
|---|
| 64 | !! * Accessibility |
|---|
| 65 | PUBLIC dyn_spg_cla_tan, & ! routine called by dyn_spg_tan |
|---|
| 66 | & dyn_spg_cla_adj ! routine called by dyn_spg_adj |
|---|
| 67 | |
|---|
| 68 | !! * Substitutions |
|---|
| 69 | # include "domzgr_substitute.h90" |
|---|
| 70 | # include "vectopt_loop_substitute.h90" |
|---|
| 71 | |
|---|
| 72 | CONTAINS |
|---|
| 73 | |
|---|
| 74 | SUBROUTINE dyn_spg_cla_tan( kt ) |
|---|
| 75 | !!---------------------------------------------------------------------- |
|---|
| 76 | !! *** routine dyn_spg_cla_tan *** |
|---|
| 77 | !! |
|---|
| 78 | !! ** Purpose of direct routine : |
|---|
| 79 | !! |
|---|
| 80 | !! ** Method of direct routine : |
|---|
| 81 | !! |
|---|
| 82 | !! ** Action : |
|---|
| 83 | !! |
|---|
| 84 | !! History |
|---|
| 85 | !! ! 09-03 (A. Weaver) Original version |
|---|
| 86 | !!--------------------------------------------------------------------- |
|---|
| 87 | !! * Arguments |
|---|
| 88 | INTEGER, INTENT( in ) :: & |
|---|
| 89 | & kt ! ocean time-step |
|---|
| 90 | |
|---|
| 91 | !! * Local declarations |
|---|
| 92 | INTEGER :: & |
|---|
| 93 | & ji, & ! dummy loop indices |
|---|
| 94 | & jj, & |
|---|
| 95 | & jk |
|---|
| 96 | INTEGER :: & |
|---|
| 97 | & ii0, & ! temporary integers |
|---|
| 98 | & ii1, & |
|---|
| 99 | & ij0, & |
|---|
| 100 | & ij1 |
|---|
| 101 | REAL(wp) :: & |
|---|
| 102 | & zempmed, & ! EMP on Med Sea ans Red Sea |
|---|
| 103 | & zempred, & |
|---|
| 104 | & zwei, & ! |
|---|
| 105 | & zisw_rs, & ! imposed transport Red sea |
|---|
| 106 | & zurw_rs, & |
|---|
| 107 | & zbrw_rs, & |
|---|
| 108 | & zisw_ms, & ! imposed transport Med Sea |
|---|
| 109 | & zurw_ms, & |
|---|
| 110 | & zbrw_ms, & |
|---|
| 111 | & zmrw_ms |
|---|
| 112 | !!---------------------------------------------------------------------- |
|---|
| 113 | |
|---|
| 114 | ! Different velocities for straits ( Gibraltar, Bab el Mandeb...) |
|---|
| 115 | |
|---|
| 116 | ! Control print |
|---|
| 117 | ! ------------- |
|---|
| 118 | IF( kt == nit000 ) THEN |
|---|
| 119 | IF(lwp) WRITE(numout,*) |
|---|
| 120 | IF(lwp) WRITE(numout,*) 'cla_dynspg_tan : cross land advection on surface ' |
|---|
| 121 | IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ pressure ' |
|---|
| 122 | IF(lwp) WRITE(numout,*) ' ' |
|---|
| 123 | ENDIF |
|---|
| 124 | |
|---|
| 125 | ! EMP on Mediterranean Sea and Red Sea |
|---|
| 126 | ! ------------------------------------ |
|---|
| 127 | ! compute the emp in Mediterranean Sea |
|---|
| 128 | zempmed = 0.0_wp |
|---|
| 129 | zwei = 0.0_wp |
|---|
| 130 | ij0 = 96 ; ij1 = 110 |
|---|
| 131 | ii0 = 141 ; ii1 = 181 |
|---|
| 132 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 133 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 134 | zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj) |
|---|
| 135 | zempmed = zempmed + emp_tl(ji,jj) * zwei |
|---|
| 136 | END DO |
|---|
| 137 | END DO |
|---|
| 138 | IF( lk_mpp ) CALL mpp_sum( zempmed ) ! sum with other processors value |
|---|
| 139 | |
|---|
| 140 | ! minus 2 points in Red Sea and 3 in Atlantic |
|---|
| 141 | ij0 = 96 ; ij1 = 96 |
|---|
| 142 | ii0 = 148 ; ii1 = 148 |
|---|
| 143 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 144 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 145 | zempmed = zempmed - emp_tl(ji ,jj) * tmask(ji ,jj,1) & |
|---|
| 146 | & * e1t(ji ,jj) * e2t(ji ,jj) & |
|---|
| 147 | & - emp_tl(ji+1,jj) * tmask(ji+1,jj,1) & |
|---|
| 148 | & * e1t(ji+1,jj) * e2t(ji+1,jj) |
|---|
| 149 | END DO |
|---|
| 150 | END DO |
|---|
| 151 | ! we convert in m3 |
|---|
| 152 | zempmed = zempmed * 1.e-3_wp |
|---|
| 153 | |
|---|
| 154 | ! compute the emp in Red Sea |
|---|
| 155 | zempred = 0.0_wp |
|---|
| 156 | zwei = 0.0_wp |
|---|
| 157 | ij0 = 87 ; ij1 = 96 |
|---|
| 158 | ii0 = 148 ; ii1 = 160 |
|---|
| 159 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 160 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 161 | zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj) |
|---|
| 162 | zempred = zempred + emp_tl(ji,jj) * zwei |
|---|
| 163 | END DO |
|---|
| 164 | END DO |
|---|
| 165 | IF( lk_mpp ) CALL mpp_sum( zempred ) ! sum with other processors value |
|---|
| 166 | |
|---|
| 167 | ! we convert in m3 |
|---|
| 168 | zempred = zempred * 1.e-3 |
|---|
| 169 | |
|---|
| 170 | ! New Transport at Bab el Mandeb and Gibraltar |
|---|
| 171 | ! -------------------------------------------- |
|---|
| 172 | |
|---|
| 173 | ! imposed transport at Bab el Mandeb |
|---|
| 174 | zisw_rs = 0.4e6_wp ! inflow surface water |
|---|
| 175 | zurw_rs = 0.2e6_wp ! upper recirculation water |
|---|
| 176 | zbrw_rs = 0.5e6_wp ! bottom recirculation water |
|---|
| 177 | |
|---|
| 178 | ! imposed transport at Gibraltar |
|---|
| 179 | zisw_ms = 0.8e6_wp ! atlantic-mediterranean water |
|---|
| 180 | zmrw_ms = 0.7e6_wp ! middle recirculation water |
|---|
| 181 | zurw_ms = 2.5e6_wp ! upper recirculation water |
|---|
| 182 | zbrw_ms = 3.5e6_wp ! bottom recirculation water |
|---|
| 183 | |
|---|
| 184 | ! Different velocities for straits ( Gibraltar, Bab el Mandeb ) |
|---|
| 185 | ! ------------------------------------------------------------- |
|---|
| 186 | |
|---|
| 187 | ! Bab el Mandeb |
|---|
| 188 | ! ------------- |
|---|
| 189 | ! 160,88 north point Bab el Mandeb |
|---|
| 190 | ij0 = 88 ; ij1 = 88 |
|---|
| 191 | ii0 = 160 ; ii1 = 160 |
|---|
| 192 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 193 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 194 | ua_tl(ji,jj ,: ) = 0.0_wp ! North East Bab el Mandeb |
|---|
| 195 | END DO |
|---|
| 196 | END DO |
|---|
| 197 | ! ! surface |
|---|
| 198 | DO jk = 1, 8 |
|---|
| 199 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 200 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 201 | ua_tl(ji, jj,jk) = - ( zempred / 8.0_wp ) & |
|---|
| 202 | & / ( e2u(ji, jj) * fse3t(ji, jj,jk) ) |
|---|
| 203 | END DO |
|---|
| 204 | END DO |
|---|
| 205 | END DO |
|---|
| 206 | ! ! deeper |
|---|
| 207 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 208 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 209 | ua_tl(ji, jj,21) = 0.0_wp |
|---|
| 210 | END DO |
|---|
| 211 | END DO |
|---|
| 212 | |
|---|
| 213 | ! 160,87 south point Bab el Mandeb |
|---|
| 214 | ij0 = 87 ; ij1 = 87 |
|---|
| 215 | ii0 = 160 ; ii1 = 160 |
|---|
| 216 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 217 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 218 | ua_tl(ji,jj ,: ) = 0.0_wp ! South East Bab el Mandeb |
|---|
| 219 | END DO |
|---|
| 220 | END DO |
|---|
| 221 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 222 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 223 | ua_tl(ji, jj,21) = 0.0_wp |
|---|
| 224 | END DO |
|---|
| 225 | END DO |
|---|
| 226 | |
|---|
| 227 | ! Gibraltar |
|---|
| 228 | ! --------- |
|---|
| 229 | |
|---|
| 230 | ! initialisation of velocity at concerned points |
|---|
| 231 | ! 139, 101 south point in Gibraltar |
|---|
| 232 | ij0 = 101 ; ij1 = 101 |
|---|
| 233 | ii0 = 139 ; ii1 = 139 |
|---|
| 234 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 235 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 236 | ua_tl(ji,jj ,: ) = 0.0_wp ! South West Gibraltar |
|---|
| 237 | ua_tl(ji,jj+1,: ) = 0.0_wp ! North West Gibraltar |
|---|
| 238 | END DO |
|---|
| 239 | END DO |
|---|
| 240 | ! ! surface |
|---|
| 241 | DO jk = 1, 14 |
|---|
| 242 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 243 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 244 | ua_tl(ji,jj,jk) = ( zempmed / 14.0_wp ) & |
|---|
| 245 | & / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) |
|---|
| 246 | END DO |
|---|
| 247 | END DO |
|---|
| 248 | END DO |
|---|
| 249 | ! ! middle circulation |
|---|
| 250 | DO jk = 15, 20 |
|---|
| 251 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 252 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 253 | ua_tl(ji,jj,jk) = 0.0_wp |
|---|
| 254 | END DO |
|---|
| 255 | END DO |
|---|
| 256 | END DO |
|---|
| 257 | ! ! deeper |
|---|
| 258 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 259 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 260 | ua_tl(ji,jj,21) = 0.0_wp |
|---|
| 261 | ua_tl(ji,jj,22) = 0.0_wp |
|---|
| 262 | END DO |
|---|
| 263 | END DO |
|---|
| 264 | |
|---|
| 265 | ! 139,102 north point in Gibraltar |
|---|
| 266 | ij0 = 102 ; ij1 = 102 |
|---|
| 267 | ii0 = 139 ; ii1 = 139 |
|---|
| 268 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 269 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 270 | ua_tl(ji,jj ,: ) = 0.0_wp ! North West Gibraltar |
|---|
| 271 | END DO |
|---|
| 272 | END DO |
|---|
| 273 | DO jk = 15, 20 |
|---|
| 274 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 275 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 276 | ua_tl(ji,jj,jk) = 0.0_wp |
|---|
| 277 | END DO |
|---|
| 278 | END DO |
|---|
| 279 | END DO |
|---|
| 280 | ! ! deeper |
|---|
| 281 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 282 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 283 | ua_tl(ji,jj,22) = 0.0_wp |
|---|
| 284 | END DO |
|---|
| 285 | END DO |
|---|
| 286 | |
|---|
| 287 | END SUBROUTINE dyn_spg_cla_tan |
|---|
| 288 | |
|---|
| 289 | SUBROUTINE dyn_spg_cla_adj( kt ) |
|---|
| 290 | !!---------------------------------------------------------------------- |
|---|
| 291 | !! *** routine dyn_spg_cla_adj *** |
|---|
| 292 | !! |
|---|
| 293 | !! ** Purpose of direct routine : |
|---|
| 294 | !! |
|---|
| 295 | !! ** Method of direct routine : |
|---|
| 296 | !! |
|---|
| 297 | !! ** Action : |
|---|
| 298 | !! |
|---|
| 299 | !! History |
|---|
| 300 | !! ! 09-03 (A. Weaver) Original version |
|---|
| 301 | !!--------------------------------------------------------------------- |
|---|
| 302 | !! * Arguments |
|---|
| 303 | INTEGER, INTENT( in ) :: & |
|---|
| 304 | & kt ! ocean time-step |
|---|
| 305 | |
|---|
| 306 | !! * Local declarations |
|---|
| 307 | INTEGER :: & |
|---|
| 308 | & ji, & ! dummy loop indices |
|---|
| 309 | & jj, & |
|---|
| 310 | & jk |
|---|
| 311 | INTEGER :: & |
|---|
| 312 | & ii0, & ! temporary integers |
|---|
| 313 | & ii1, & |
|---|
| 314 | & ij0, & |
|---|
| 315 | & ij1 |
|---|
| 316 | REAL(wp) :: & |
|---|
| 317 | & zempmed, & ! EMP on Med Sea ans Red Sea |
|---|
| 318 | & zempred, & |
|---|
| 319 | & zwei, & ! |
|---|
| 320 | & zisw_rs, & ! imposed transport Red sea |
|---|
| 321 | & zurw_rs, & |
|---|
| 322 | & zbrw_rs, & |
|---|
| 323 | & zisw_ms, & ! imposed transport Med Sea |
|---|
| 324 | & zurw_ms, & |
|---|
| 325 | & zbrw_ms, & |
|---|
| 326 | & zmrw_ms |
|---|
| 327 | !!---------------------------------------------------------------------- |
|---|
| 328 | |
|---|
| 329 | ! Different velocities for straits ( Gibraltar, Bab el Mandeb...) |
|---|
| 330 | |
|---|
| 331 | ! Control print |
|---|
| 332 | ! ------------- |
|---|
| 333 | IF( kt == nitend ) THEN |
|---|
| 334 | IF(lwp) WRITE(numout,*) |
|---|
| 335 | IF(lwp) WRITE(numout,*) 'cla_dynspg_adj : cross land advection on surface ' |
|---|
| 336 | IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ pressure ' |
|---|
| 337 | IF(lwp) WRITE(numout,*) ' ' |
|---|
| 338 | ENDIF |
|---|
| 339 | |
|---|
| 340 | ! Local initialization |
|---|
| 341 | ! -------------------- |
|---|
| 342 | zempmed = 0.0_wp |
|---|
| 343 | zempred = 0.0_wp |
|---|
| 344 | |
|---|
| 345 | ! New Transport at Bab el Mandeb and Gibraltar |
|---|
| 346 | ! -------------------------------------------- |
|---|
| 347 | |
|---|
| 348 | ! imposed transport at Bab el Mandeb |
|---|
| 349 | zisw_rs = 0.4e6_wp ! inflow surface water |
|---|
| 350 | zurw_rs = 0.2e6_wp ! upper recirculation water |
|---|
| 351 | zbrw_rs = 0.5e6_wp ! bottom recirculation water |
|---|
| 352 | |
|---|
| 353 | ! imposed transport at Gibraltar |
|---|
| 354 | zisw_ms = 0.8e6_wp ! atlantic-mediterranean water |
|---|
| 355 | zmrw_ms = 0.7e6_wp ! middle recirculation water |
|---|
| 356 | zurw_ms = 2.5e6_wp ! upper recirculation water |
|---|
| 357 | zbrw_ms = 3.5e6_wp ! bottom recirculation water |
|---|
| 358 | |
|---|
| 359 | ! Different velocities for straits ( Gibraltar, Bab el Mandeb ) |
|---|
| 360 | ! ------------------------------------------------------------- |
|---|
| 361 | |
|---|
| 362 | ! Gibraltar |
|---|
| 363 | ! --------- |
|---|
| 364 | |
|---|
| 365 | ! initialisation of velocity at concerned points |
|---|
| 366 | |
|---|
| 367 | ! 139,102 north point in Gibraltar |
|---|
| 368 | ij0 = 102 ; ij1 = 102 |
|---|
| 369 | ii0 = 139 ; ii1 = 139 |
|---|
| 370 | ! ! deeper |
|---|
| 371 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 372 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 373 | ua_ad(ji,jj,22) = 0.0_wp |
|---|
| 374 | END DO |
|---|
| 375 | END DO |
|---|
| 376 | |
|---|
| 377 | DO jk = 15, 20 |
|---|
| 378 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 379 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 380 | ua_ad(ji,jj,jk) = 0.0_wp |
|---|
| 381 | END DO |
|---|
| 382 | END DO |
|---|
| 383 | END DO |
|---|
| 384 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 385 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 386 | ua_ad(ji,jj ,: ) = 0.0_wp ! North West Gibraltar |
|---|
| 387 | END DO |
|---|
| 388 | END DO |
|---|
| 389 | |
|---|
| 390 | ! 139, 101 south point in Gibraltar |
|---|
| 391 | ij0 = 101 ; ij1 = 101 |
|---|
| 392 | ii0 = 139 ; ii1 = 139 |
|---|
| 393 | ! ! deeper |
|---|
| 394 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 395 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 396 | ua_ad(ji,jj,21) = 0.0_wp |
|---|
| 397 | ua_ad(ji,jj,22) = 0.0_wp |
|---|
| 398 | END DO |
|---|
| 399 | END DO |
|---|
| 400 | ! ! middle circulation |
|---|
| 401 | DO jk = 15, 20 |
|---|
| 402 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 403 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 404 | ua_ad(ji,jj,jk) = 0.0_wp |
|---|
| 405 | END DO |
|---|
| 406 | END DO |
|---|
| 407 | END DO |
|---|
| 408 | ! ! surface |
|---|
| 409 | DO jk = 1, 14 |
|---|
| 410 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 411 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 412 | zempmed = zempmed + ua_ad(ji,jj,jk) / 14.0_wp & |
|---|
| 413 | & / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) |
|---|
| 414 | ua_ad(ji,jj,jk) = 0.0_wp |
|---|
| 415 | END DO |
|---|
| 416 | END DO |
|---|
| 417 | END DO |
|---|
| 418 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 419 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 420 | ua_ad(ji,jj+1,: ) = 0.0_wp ! North West Gibraltar |
|---|
| 421 | ua_ad(ji,jj ,: ) = 0.0_wp ! South West Gibraltar |
|---|
| 422 | END DO |
|---|
| 423 | END DO |
|---|
| 424 | |
|---|
| 425 | ! Bab el Mandeb |
|---|
| 426 | ! ------------- |
|---|
| 427 | |
|---|
| 428 | ! 160,87 south point Bab el Mandeb |
|---|
| 429 | ij0 = 87 ; ij1 = 87 |
|---|
| 430 | ii0 = 160 ; ii1 = 160 |
|---|
| 431 | |
|---|
| 432 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 433 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 434 | ua_ad(ji, jj,21) = 0.0_wp |
|---|
| 435 | END DO |
|---|
| 436 | END DO |
|---|
| 437 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 438 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 439 | ua_ad(ji,jj ,: ) = 0.0_wp ! South East Bab el Mandeb |
|---|
| 440 | END DO |
|---|
| 441 | END DO |
|---|
| 442 | |
|---|
| 443 | ! 160,88 north point Bab el Mandeb |
|---|
| 444 | ij0 = 88 ; ij1 = 88 |
|---|
| 445 | ii0 = 160 ; ii1 = 160 |
|---|
| 446 | ! ! deeper |
|---|
| 447 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 448 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 449 | ua_ad(ji, jj,21) = 0.0_wp |
|---|
| 450 | END DO |
|---|
| 451 | END DO |
|---|
| 452 | ! ! surface |
|---|
| 453 | DO jk = 1, 8 |
|---|
| 454 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 455 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 456 | zempred = zempred - ua_ad(ji,jj,jk) / 8.0_wp & |
|---|
| 457 | & / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) |
|---|
| 458 | ua_ad(ji,jj,jk) = 0.0_wp |
|---|
| 459 | END DO |
|---|
| 460 | END DO |
|---|
| 461 | END DO |
|---|
| 462 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 463 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 464 | ua_ad(ji,jj ,: ) = 0.0_wp ! North East Bab el Mandeb |
|---|
| 465 | END DO |
|---|
| 466 | END DO |
|---|
| 467 | |
|---|
| 468 | ! EMP on Mediterranean Sea and Red Sea |
|---|
| 469 | ! ------------------------------------ |
|---|
| 470 | |
|---|
| 471 | ! we convert in m3 |
|---|
| 472 | zempred = zempred * 1.e-3_wp |
|---|
| 473 | |
|---|
| 474 | !!!! AW: Adjoint of this???? |
|---|
| 475 | IF( lk_mpp ) CALL mpp_sum( zempred ) ! sum with other processors value |
|---|
| 476 | |
|---|
| 477 | ! compute the emp in Red Sea |
|---|
| 478 | ij0 = 87 ; ij1 = 96 |
|---|
| 479 | ii0 = 148 ; ii1 = 160 |
|---|
| 480 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 481 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 482 | zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj) |
|---|
| 483 | emp_ad(ji,jj) = emp_ad(ji,jj) + zempred * zwei |
|---|
| 484 | END DO |
|---|
| 485 | END DO |
|---|
| 486 | |
|---|
| 487 | ! we convert in m3 |
|---|
| 488 | zempmed = zempmed * 1.e-3_wp |
|---|
| 489 | |
|---|
| 490 | ! minus 2 points in Red Sea and 3 in Atlantic |
|---|
| 491 | ij0 = 96 ; ij1 = 96 |
|---|
| 492 | ii0 = 148 ; ii1 = 148 |
|---|
| 493 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 494 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 495 | emp_ad(ji ,jj) = emp_ad(ji ,jj) & |
|---|
| 496 | & - zempmed * tmask(ji ,jj,1) & |
|---|
| 497 | & * e1t(ji ,jj) * e2t(ji ,jj) |
|---|
| 498 | emp_ad(ji+1,jj) = emp_ad(ji+1,jj) & |
|---|
| 499 | & - zempmed * tmask(ji+1,jj,1) & |
|---|
| 500 | & * e1t(ji+1,jj) * e2t(ji+1,jj) |
|---|
| 501 | END DO |
|---|
| 502 | END DO |
|---|
| 503 | |
|---|
| 504 | IF( lk_mpp ) CALL mpp_sum( zempmed ) ! sum with other processors value |
|---|
| 505 | |
|---|
| 506 | ! compute the emp in Mediterranean Sea |
|---|
| 507 | ij0 = 96 ; ij1 = 110 |
|---|
| 508 | ii0 = 141 ; ii1 = 181 |
|---|
| 509 | DO jj = mj0(ij0), mj1(ij1) |
|---|
| 510 | DO ji = mi0(ii0), mi1(ii1) |
|---|
| 511 | zwei = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj) |
|---|
| 512 | emp_ad(ji,jj) = emp_ad(ji,jj) + zempmed * zwei |
|---|
| 513 | END DO |
|---|
| 514 | END DO |
|---|
| 515 | |
|---|
| 516 | END SUBROUTINE dyn_spg_cla_adj |
|---|
| 517 | !!====================================================================== |
|---|
| 518 | |
|---|
| 519 | #endif |
|---|
| 520 | END MODULE cla_dynspg_tam |
|---|
