Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA
- Timestamp:
- 2017-03-03T12:46:59+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 6 edited
-
dia25h.F90 (modified) (4 diffs)
-
diaar5.F90 (modified) (13 diffs)
-
diacfl.F90 (modified) (3 diffs)
-
diahsb.F90 (modified) (10 diffs)
-
diaptr.F90 (modified) (3 diffs)
-
diawri.F90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r7698 r7753 62 62 INTEGER :: ios ! Local integer output status for namelist read 63 63 INTEGER :: ierror ! Local integer for memory allocation 64 INTEGER :: ji, jj, jk65 64 ! 66 65 NAMELIST/nam_dia25h/ ln_dia25h … … 135 134 ! ------------------------- ! 136 135 cnt_25h = 1 ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible) 137 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 138 DO jk = 1, jpk 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 tn_25h(ji,jj,jk) = tsb(ji,jj,jk,jp_tem) 142 sn_25h(ji,jj,jk) = tsb(ji,jj,jk,jp_sal) 143 sshn_25h(ji,jj) = sshb(ji,jj) 144 un_25h(ji,jj,jk) = ub(ji,jj,jk) 145 vn_25h(ji,jj,jk) = vb(ji,jj,jk) 146 wn_25h(ji,jj,jk) = wn(ji,jj,jk) 147 avt_25h(ji,jj,jk) = avt(ji,jj,jk) 148 avm_25h(ji,jj,jk) = avm(ji,jj,jk) 149 # if defined key_zdfgls || defined key_zdftke 150 en_25h(ji,jj,jk) = en(ji,jj,jk) 136 tn_25h(:,:,:) = tsb(:,:,:,jp_tem) 137 sn_25h(:,:,:) = tsb(:,:,:,jp_sal) 138 sshn_25h(:,:) = sshb(:,:) 139 un_25h(:,:,:) = ub(:,:,:) 140 vn_25h(:,:,:) = vb(:,:,:) 141 wn_25h(:,:,:) = wn(:,:,:) 142 avt_25h(:,:,:) = avt(:,:,:) 143 avm_25h(:,:,:) = avm(:,:,:) 144 # if defined key_zdfgls || defined key_zdftke 145 en_25h(:,:,:) = en(:,:,:) 151 146 #endif 152 147 # if defined key_zdfgls 153 rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 154 #endif 155 END DO 156 END DO 157 END DO 148 rmxln_25h(:,:,:) = mxln(:,:,:) 149 #endif 158 150 #if defined key_lim3 || defined key_lim2 159 151 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') … … 231 223 ENDIF 232 224 233 !$OMP PARALLEL 234 !$OMP DO schedule(static) private(jj, ji) 235 DO jj = 1, jpj 236 DO ji = 1, jpi 237 sshn_25h(ji,jj) = sshn_25h(ji,jj) + sshn (ji,jj) 238 END DO 239 END DO 240 !$OMP END DO NOWAIT 241 !$OMP DO schedule(static) private(jk, jj, ji) 242 DO jk = 1, jpk 243 DO jj = 1, jpj 244 DO ji = 1, jpi 245 tn_25h(ji,jj,jk) = tn_25h(ji,jj,jk) + tsn(ji,jj,jk,jp_tem) 246 sn_25h(ji,jj,jk) = sn_25h(ji,jj,jk) + tsn(ji,jj,jk,jp_sal) 247 un_25h(ji,jj,jk) = un_25h(ji,jj,jk) + un(ji,jj,jk) 248 vn_25h(ji,jj,jk) = vn_25h(ji,jj,jk) + vn(ji,jj,jk) 249 wn_25h(ji,jj,jk) = wn_25h(ji,jj,jk) + wn(ji,jj,jk) 250 avt_25h(ji,jj,jk) = avt_25h(ji,jj,jk) + avt(ji,jj,jk) 251 avm_25h(ji,jj,jk) = avm_25h(ji,jj,jk) + avm(ji,jj,jk) 252 # if defined key_zdfgls || defined key_zdftke 253 en_25h(ji,jj,jk) = en_25h(ji,jj,jk) + en(ji,jj,jk) 225 tn_25h(:,:,:) = tn_25h(:,:,:) + tsn(:,:,:,jp_tem) 226 sn_25h(:,:,:) = sn_25h(:,:,:) + tsn(:,:,:,jp_sal) 227 sshn_25h(:,:) = sshn_25h(:,:) + sshn (:,:) 228 un_25h(:,:,:) = un_25h(:,:,:) + un(:,:,:) 229 vn_25h(:,:,:) = vn_25h(:,:,:) + vn(:,:,:) 230 wn_25h(:,:,:) = wn_25h(:,:,:) + wn(:,:,:) 231 avt_25h(:,:,:) = avt_25h(:,:,:) + avt(:,:,:) 232 avm_25h(:,:,:) = avm_25h(:,:,:) + avm(:,:,:) 233 # if defined key_zdfgls || defined key_zdftke 234 en_25h(:,:,:) = en_25h(:,:,:) + en(:,:,:) 254 235 #endif 255 236 # if defined key_zdfgls 256 rmxln_25h(ji,jj,jk) = rmxln_25h(ji,jj,jk) + mxln(ji,jj,jk) 257 #endif 258 END DO 259 END DO 260 END DO 261 !$OMP END PARALLEL 237 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 238 #endif 262 239 cnt_25h = cnt_25h + 1 263 240 … … 276 253 ENDIF 277 254 278 !$OMP PARALLEL 279 !$OMP DO schedule(static) private(jj, ji) 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 sshn_25h(ji,jj) = sshn_25h(ji,jj) / 25.0_wp 283 END DO 284 END DO 285 !$OMP END DO NOWAIT 286 !$OMP DO schedule(static) private(jk, jj, ji) 287 DO jk = 1, jpk 288 DO jj = 1, jpj 289 DO ji = 1, jpi 290 tn_25h(ji,jj,jk) = tn_25h(ji,jj,jk) / 25.0_wp 291 sn_25h(ji,jj,jk) = sn_25h(ji,jj,jk) / 25.0_wp 292 un_25h(ji,jj,jk) = un_25h(ji,jj,jk) / 25.0_wp 293 vn_25h(ji,jj,jk) = vn_25h(ji,jj,jk) / 25.0_wp 294 wn_25h(ji,jj,jk) = wn_25h(ji,jj,jk) / 25.0_wp 295 avt_25h(ji,jj,jk) = avt_25h(ji,jj,jk) / 25.0_wp 296 avm_25h(ji,jj,jk) = avm_25h(ji,jj,jk) / 25.0_wp 297 # if defined key_zdfgls || defined key_zdftke 298 en_25h(ji,jj,jk) = en_25h(ji,jj,jk) / 25.0_wp 255 tn_25h(:,:,:) = tn_25h(:,:,:) / 25.0_wp 256 sn_25h(:,:,:) = sn_25h(:,:,:) / 25.0_wp 257 sshn_25h(:,:) = sshn_25h(:,:) / 25.0_wp 258 un_25h(:,:,:) = un_25h(:,:,:) / 25.0_wp 259 vn_25h(:,:,:) = vn_25h(:,:,:) / 25.0_wp 260 wn_25h(:,:,:) = wn_25h(:,:,:) / 25.0_wp 261 avt_25h(:,:,:) = avt_25h(:,:,:) / 25.0_wp 262 avm_25h(:,:,:) = avm_25h(:,:,:) / 25.0_wp 263 # if defined key_zdfgls || defined key_zdftke 264 en_25h(:,:,:) = en_25h(:,:,:) / 25.0_wp 299 265 #endif 300 266 # if defined key_zdfgls 301 rmxln_25h(ji,jj,jk) = rmxln_25h(ji,jj,jk) / 25.0_wp 302 #endif 303 END DO 304 END DO 305 END DO 306 !$OMP END PARALLEL 267 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 268 #endif 307 269 308 270 IF (lwp) WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 309 271 zmdi=1.e+20 !missing data indicator for masking 310 272 ! write tracers (instantaneous) 311 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 312 DO jk = 1, jpk 313 DO jj = 1, jpj 314 DO ji = 1, jpi 315 zw3d(ji,jj,jk) = tn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 316 END DO 317 END DO 318 END DO 273 zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 319 274 CALL iom_put("temper25h", zw3d) ! potential temperature 320 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 321 DO jk = 1, jpk 322 DO jj = 1, jpj 323 DO ji = 1, jpi 324 zw3d(ji,jj,jk) = sn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 325 END DO 326 END DO 327 END DO 275 zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 328 276 CALL iom_put( "salin25h", zw3d ) ! salinity 329 !$OMP PARALLEL DO schedule(static) private(jj, ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 zw2d(ji,jj) = sshn_25h(ji,jj)*tmask(ji,jj,1) + zmdi*(1.0-tmask(ji,jj,1)) 333 END DO 334 END DO 277 zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 335 278 CALL iom_put( "ssh25h", zw2d ) ! sea surface 336 279 337 280 338 281 ! Write velocities (instantaneous) 339 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 340 DO jk = 1, jpk 341 DO jj = 1, jpj 342 DO ji = 1, jpi 343 zw3d(ji,jj,jk) = un_25h(ji,jj,jk)*umask(ji,jj,jk) + zmdi*(1.0-umask(ji,jj,jk)) 344 END DO 345 END DO 346 END DO 282 zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 347 283 CALL iom_put("vozocrtx25h", zw3d) ! i-current 348 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 349 DO jk = 1, jpk 350 DO jj = 1, jpj 351 DO ji = 1, jpi 352 zw3d(ji,jj,jk) = vn_25h(ji,jj,jk)*vmask(ji,jj,jk) + zmdi*(1.0-vmask(ji,jj,jk)) 353 END DO 354 END DO 355 END DO 284 zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 356 285 CALL iom_put("vomecrty25h", zw3d ) ! j-current 357 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 358 DO jk = 1, jpk 359 DO jj = 1, jpj 360 DO ji = 1, jpi 361 zw3d(ji,jj,jk) = wn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 362 END DO 363 END DO 364 END DO 286 287 zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 365 288 CALL iom_put("vomecrtz25h", zw3d ) ! k-current 366 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 367 DO jk = 1, jpk 368 DO jj = 1, jpj 369 DO ji = 1, jpi 370 zw3d(ji,jj,jk) = avt_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 371 END DO 372 END DO 373 END DO 289 zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 374 290 CALL iom_put("avt25h", zw3d ) ! diffusivity 375 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 376 DO jk = 1, jpk 377 DO jj = 1, jpj 378 DO ji = 1, jpi 379 zw3d(ji,jj,jk) = avm_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 380 END DO 381 END DO 382 END DO 291 zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 383 292 CALL iom_put("avm25h", zw3d) ! viscosity 384 293 #if defined key_zdftke || defined key_zdfgls 385 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 386 DO jk = 1, jpk 387 DO jj = 1, jpj 388 DO ji = 1, jpi 389 zw3d(ji,jj,jk) = en_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 390 END DO 391 END DO 392 END DO 294 zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 393 295 CALL iom_put("tke25h", zw3d) ! tke 394 296 #endif 395 297 #if defined key_zdfgls 396 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 397 DO jk = 1, jpk 398 DO jj = 1, jpj 399 DO ji = 1, jpi 400 zw3d(ji,jj,jk) = rmxln_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 401 END DO 402 END DO 403 END DO 298 zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 404 299 CALL iom_put( "mxln25h",zw3d) 405 300 #endif 406 301 407 302 ! After the write reset the values to cnt=1 and sum values equal current value 408 !$OMP PARALLEL 409 !$OMP DO schedule(static) private(jj, ji) 410 DO jj = 1, jpj 411 DO ji = 1, jpi 412 sshn_25h(ji,jj) = sshn (ji,jj) 413 END DO 414 END DO 415 !$OMP END DO NOWAIT 416 !$OMP DO schedule(static) private(jk, jj, ji) 417 DO jk = 1, jpk 418 DO jj = 1, jpj 419 DO ji = 1, jpi 420 tn_25h(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) 421 sn_25h(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 422 un_25h(ji,jj,jk) = un(ji,jj,jk) 423 vn_25h(ji,jj,jk) = vn(ji,jj,jk) 424 wn_25h(ji,jj,jk) = wn(ji,jj,jk) 425 avt_25h(ji,jj,jk) = avt(ji,jj,jk) 426 avm_25h(ji,jj,jk) = avm(ji,jj,jk) 427 # if defined key_zdfgls || defined key_zdftke 428 en_25h(ji,jj,jk) = en(ji,jj,jk) 303 tn_25h(:,:,:) = tsn(:,:,:,jp_tem) 304 sn_25h(:,:,:) = tsn(:,:,:,jp_sal) 305 sshn_25h(:,:) = sshn (:,:) 306 un_25h(:,:,:) = un(:,:,:) 307 vn_25h(:,:,:) = vn(:,:,:) 308 wn_25h(:,:,:) = wn(:,:,:) 309 avt_25h(:,:,:) = avt(:,:,:) 310 avm_25h(:,:,:) = avm(:,:,:) 311 # if defined key_zdfgls || defined key_zdftke 312 en_25h(:,:,:) = en(:,:,:) 429 313 #endif 430 314 # if defined key_zdfgls 431 rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 432 #endif 433 END DO 434 END DO 435 END DO 436 !$OMP END PARALLEL 315 rmxln_25h(:,:,:) = mxln(:,:,:) 316 #endif 437 317 cnt_25h = 1 438 318 IF (lwp) WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r7698 r7753 89 89 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 90 90 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 91 !$OMP PARALLEL DO schedule(static) private(jj, ji) 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 zarea_ssh(ji,jj) = area(ji,jj) * sshn(ji,jj) 95 END DO 96 END DO 91 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 97 92 ENDIF 98 93 ! … … 111 106 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 112 107 ! 113 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 114 DO jk = 1, jpk 115 DO jj = 1, jpj 116 DO ji = 1, jpi 117 ztsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) ! thermosteric ssh 118 ztsn(ji,jj,jk,jp_sal) = sn0(ji,jj,jk) 119 END DO 120 END DO 121 END DO 108 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 109 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 122 110 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 123 111 ! 124 !$OMP PARALLEL 125 !$OMP DO schedule(static) private(jj, ji) 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 zbotpres(ji,jj) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 129 END DO 130 END DO 112 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 131 113 DO jk = 1, jpkm1 132 !$OMP DO schedule(static) private(jj, ji) 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 zbotpres(ji,jj) = zbotpres(ji,jj) + e3t_n(ji,jj,jk) * zrhd(ji,jj,jk) 136 END DO 137 END DO 138 END DO 139 !$OMP END PARALLEL 114 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 115 END DO 140 116 IF( ln_linssh ) THEN 141 117 IF( ln_isfcav ) THEN 142 !$OMP PARALLEL DO schedule(static) private(jj, ji)143 118 DO ji = 1, jpi 144 119 DO jj = 1, jpj … … 147 122 END DO 148 123 ELSE 149 !$OMP PARALLEL DO schedule(static) private(jj, ji) 150 DO ji = 1, jpi 151 DO jj = 1, jpj 152 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,1) 153 END DO 154 END DO 124 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 155 125 END IF 156 126 !!gm … … 158 128 !!gm 159 129 END IF 160 !161 zarho = SUM( area(:,:) * zbotpres(:,:) )162 130 ! 131 zarho = SUM( area(:,:) * zbotpres(:,:) ) 163 132 IF( lk_mpp ) CALL mpp_sum( zarho ) 164 133 zssh_steric = - zarho / area_tot … … 167 136 ! ! steric sea surface height 168 137 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 169 !$OMP PARALLEL DO schedule(static) private(jj, ji) 170 DO jj = 1, jpj 171 DO ji = 1, jpi 172 zrhop(ji,jj,jpk) = 0._wp 173 END DO 174 END DO 138 zrhop(:,:,jpk) = 0._wp 175 139 CALL iom_put( 'rhop', zrhop ) 176 140 ! 177 !$OMP PARALLEL 178 !$OMP DO schedule(static) private(jj, ji) 179 DO jj = 1, jpj 180 DO ji = 1, jpi 181 zbotpres(ji,jj) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 182 END DO 183 END DO 141 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 184 142 DO jk = 1, jpkm1 185 !$OMP DO schedule(static) private(jj, ji) 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 zbotpres(ji,jj) = zbotpres(ji,jj) + e3t_n(ji,jj,jk) * zrhd(ji,jj,jk) 189 END DO 190 END DO 143 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 191 144 END DO 192 145 IF( ln_linssh ) THEN 193 146 IF ( ln_isfcav ) THEN 194 !$OMP DO schedule(static) private(jj, ji)195 147 DO ji = 1,jpi 196 148 DO jj = 1,jpj … … 199 151 END DO 200 152 ELSE 201 !$OMP DO schedule(static) private(jj, ji) 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,1) 205 END DO 206 END DO 153 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 207 154 END IF 208 155 END IF 209 !$OMP END PARALLEL210 156 ! 211 zarho = SUM( area(:,:) * zbotpres(:,:) ) 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 212 158 IF( lk_mpp ) CALL mpp_sum( zarho ) 213 159 zssh_steric = - zarho / area_tot … … 216 162 ! ! ocean bottom pressure 217 163 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 218 !$OMP PARALLEL DO schedule(static) private(jj, ji) 219 DO jj = 1, jpj 220 DO ji = 1, jpi 221 zbotpres(ji,jj) = zztmp * ( zbotpres(ji,jj) + sshn(ji,jj) + thick0(ji,jj) ) 222 END DO 223 END DO 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 224 165 CALL iom_put( 'botpres', zbotpres ) 225 166 ! … … 272 213 ! work is not being done against stratification 273 214 CALL wrk_alloc( jpi, jpj, zpe ) 274 !$OMP PARALLEL DO schedule(static) private(jj,ji) 275 DO jj = 1, jpj 276 DO ji = 1, jpi 277 zpe(ji,jj) = 0._wp 278 END DO 279 END DO 215 zpe(:,:) = 0._wp 280 216 IF( lk_zdfddm ) THEN 281 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk,zrw,zaw,zbw)282 217 DO ji=1,jpi 283 218 DO jj=1,jpj … … 297 232 ENDDO 298 233 ELSE 299 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk)300 234 DO ji = 1, jpi 301 235 DO jj = 1, jpj … … 389 323 INTEGER :: ik 390 324 INTEGER :: ji, jj, jk ! dummy loop indices 391 REAL(wp) :: zztmp , zsum325 REAL(wp) :: zztmp 392 326 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 393 327 ! … … 407 341 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 408 342 409 !$OMP PARALLEL DO schedule(static) private(jj, ji) 410 DO jj = 1, jpj 411 DO ji = 1, jpi 412 area(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) 413 END DO 414 END DO 343 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 415 344 416 345 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 417 346 418 347 vol0 = 0._wp 419 !$OMP PARALLEL 420 !$OMP DO schedule(static) private(jj, ji) 421 DO jj = 1, jpj 422 DO ji = 1, jpi 423 thick0(ji,jj) = 0._wp 424 END DO 425 END DO 348 thick0(:,:) = 0._wp 426 349 DO jk = 1, jpkm1 427 !$OMP DO schedule(static) private(jj, ji, zsum) 428 DO jj = 1, jpj 429 DO ji = 1, jpi 430 zsum = area (ji,jj) * tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 431 END DO 432 END DO 433 vol0 = vol0 + zsum 434 !$OMP DO schedule(static) private(jj, ji) 435 DO jj = 1, jpj 436 DO ji = 1, jpi 437 thick0(ji,jj) = thick0(ji,jj) + tmask_i(ji,jj) * tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 438 END DO 439 END DO 440 END DO 441 !$OMP END PARALLEL 350 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 351 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 352 END DO 442 353 IF( lk_mpp ) CALL mpp_sum( vol0 ) 443 354 … … 447 358 CALL iom_close( inum ) 448 359 449 !$OMP PARALLEL 450 !$OMP DO schedule(static) private(jk, jj, ji) 451 DO jk = 1, jpk 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 sn0(ji,jj,jk) = 0.5_wp * ( zsaldta(ji,jj,jk,1) + zsaldta(ji,jj,jk,2) ) 455 sn0(ji,jj,jk) = sn0(ji,jj,jk) * tmask(ji,jj,jk) 456 END DO 457 END DO 458 END DO 360 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 361 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 459 362 IF( ln_zps ) THEN ! z-coord. partial steps 460 !$OMP DO schedule(static) private(jj, ji, ik, zztmp)461 363 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 462 364 DO ji = 1, jpi … … 469 371 END DO 470 372 ENDIF 471 !$OMP END PARALLEL472 373 ! 473 374 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90
r7698 r7753 71 71 72 72 ! calculate Courant numbers 73 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)74 73 DO jk = 1, jpk 75 74 DO jj = 1, jpj … … 173 172 !!---------------------------------------------------------------------- 174 173 175 INTEGER :: ji, jj, jk ! dummy loop indices176 174 177 175 IF( nn_diacfl == 1 ) THEN … … 183 181 184 182 ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 185 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 186 DO jk = 1, jpk 187 DO jj = 1, jpj 188 DO ji = 1, jpi 189 zcu_cfl(ji,jj,jk)=0.0 190 zcv_cfl(ji,jj,jk)=0.0 191 zcw_cfl(ji,jj,jk)=0.0 192 END DO 193 END DO 194 END DO 183 184 zcu_cfl(:,:,:)=0.0 185 zcv_cfl(:,:,:)=0.0 186 zcw_cfl(:,:,:)=0.0 187 195 188 IF( lwp ) THEN 196 189 WRITE(numout,*) -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r7698 r7753 88 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 89 ! 90 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 91 DO jk = 1, jpk 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 tsn(ji,jj,jk,1) = tsn(ji,jj,jk,1) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,1) = tsb(ji,jj,jk,1) * tmask(ji,jj,jk) 95 tsn(ji,jj,jk,2) = tsn(ji,jj,jk,2) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,2) = tsb(ji,jj,jk,2) * tmask(ji,jj,jk) 96 END DO 97 END DO 98 END DO 90 tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 91 tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; 99 92 ! ------------------------- ! 100 93 ! 1 - Trends due to forcing ! … … 115 108 IF( ln_linssh ) THEN 116 109 IF( ln_isfcav ) THEN 117 !$OMP PARALLEL DO schedule(static) private(jj,ji)118 110 DO ji=1,jpi 119 111 DO jj=1,jpj … … 123 115 END DO 124 116 ELSE 125 !$OMP PARALLEL DO schedule(static) private(jj,ji) 126 DO ji=1,jpi 127 DO jj=1,jpj 128 z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_tem) 129 z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_sal) 130 END DO 131 END DO 117 z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 118 z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) 132 119 END IF 133 120 z_wn_trd_t = - glob_sum( z2d0 ) … … 158 145 IF( ln_linssh ) THEN 159 146 IF( ln_isfcav ) THEN 160 !$OMP PARALLEL DO schedule(static) private(jj,ji)161 147 DO ji = 1, jpi 162 148 DO jj = 1, jpj … … 166 152 END DO 167 153 ELSE 168 !$OMP PARALLEL DO schedule(static) private(jj,ji) 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 172 z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 173 END DO 174 END DO 154 z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 155 z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 175 156 END IF 176 157 z_ssh_hc = glob_sum_full( z2d0 ) … … 294 275 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 295 276 IF(lwp) WRITE(numout,*) '~~~~~~~' 296 !$OMP PARALLEL 297 !$OMP DO schedule(static) private(jj,ji) 298 DO j j = 1, jpj299 DO ji = 1, jpi300 surf_ini(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) ! initial ocean surface301 ssh_ini(ji,jj) = sshn(ji,jj) ! initial ssh302 END DO277 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 278 ssh_ini(:,:) = sshn(:,:) ! initial ssh 279 DO jk = 1, jpk 280 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 281 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 282 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content 283 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content 303 284 END DO 304 !$OMP DO schedule(static) private(jk,jj,ji)305 DO jk = 1, jpk306 DO jj = 1, jpj307 DO ji = 1, jpi308 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).309 e3t_ini (ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) ! initial vertical scale factors310 hc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) ! initial heat content311 sc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) ! initial salt content312 END DO313 END DO314 END DO315 !$OMP END PARALLEL316 285 frc_v = 0._wp ! volume trend due to forcing 317 286 frc_t = 0._wp ! heat content - - - - … … 319 288 IF( ln_linssh ) THEN 320 289 IF ( ln_isfcav ) THEN 321 !$OMP PARALLEL DO schedule(static) private(jj,ji)322 290 DO ji=1,jpi 323 291 DO jj=1,jpj … … 327 295 ENDDO 328 296 ELSE 329 !$OMP PARALLEL DO schedule(static) private(jj,ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_tem) * sshn(ji,jj) ! initial heat content in ssh 333 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_sal) * sshn(ji,jj) ! initial salt content in ssh 334 ENDDO 335 ENDDO 297 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 298 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 336 299 END IF 337 300 frc_wn_t = 0._wp ! initial heat content misfit due to free surface … … 382 345 INTEGER :: ierror ! local integer 383 346 INTEGER :: ios 384 INTEGER :: ji, jj, jk ! dummy loop indices385 347 !! 386 348 NAMELIST/namhsb/ ln_diahsb … … 422 384 ! 2 - Time independant variables and file opening ! 423 385 ! ----------------------------------------------- ! 424 !$OMP PARALLEL DO schedule(static) private(jj,ji) 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 surf(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) ! masked surface grid cell area 428 END DO 429 END DO 386 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 430 387 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 431 388 -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r7698 r7753 66 66 !!---------------------------------------------------------------------- 67 67 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 68 !! $Id$ 68 !! $Id$ 69 69 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 70 70 !!---------------------------------------------------------------------- … … 384 384 !! ** Purpose : Initialization, namelist read 385 385 !!---------------------------------------------------------------------- 386 INTEGER :: jn , jj, ji! local integers386 INTEGER :: jn ! local integers 387 387 INTEGER :: inum, ierr ! local integers 388 388 INTEGER :: ios ! Local integer output status for namelist read … … 434 434 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 435 435 CALL iom_close( inum ) 436 !$OMP PARALLEL DO schedule(static) private(jj,ji) 437 DO jj = 1, jpj 438 DO ji = 1, jpi 439 btmsk(ji,jj,5) = MAX ( btmsk(ji,jj,3), btmsk(ji,jj,4) ) ! Indo-Pacific basin 440 IF( gphit(ji,jj) < -30._wp) THEN ; btm30(ji,jj) = 0._wp ! mask out Southern Ocean 441 ELSE ; btm30(ji,jj) = ssmask(ji,jj) 442 END IF 443 END DO 444 END DO 436 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 437 WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean 438 ELSE WHERE ; btm30(:,:) = ssmask(:,:) 439 END WHERE 445 440 ENDIF 446 441 447 !$OMP PARALLEL 448 !$OMP DO schedule(static) private(jj,ji) 449 DO jj = 1, jpj 450 DO ji = 1, jpi 451 btmsk(ji,jj,1) = tmask_i(ji,jj) ! global ocean 452 END DO 453 END DO 442 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 454 443 455 444 DO jn = 1, nptr 456 !$OMP DO schedule(static) private(jj,ji) 457 DO jj = 1, jpj 458 DO ji = 1, jpi 459 btmsk(ji,jj,jn) = btmsk(ji,jj,jn) * tmask_i(ji,jj) ! interior domain only 460 END DO 461 END DO 445 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 462 446 END DO 463 447 464 448 ! Initialise arrays to zero because diatpr is called before they are first calculated 465 449 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 466 !$OMP DO schedule(static) private(jj,ji) 467 DO jj = 1, jpj 468 DO ji = 1, jpi 469 htr_adv(ji,jj) = 0._wp ; str_adv(ji,jj) = 0._wp 470 htr_ldf(ji,jj) = 0._wp ; str_ldf(ji,jj) = 0._wp 471 htr_eiv(ji,jj) = 0._wp ; str_eiv(ji,jj) = 0._wp 472 htr_ove(ji,jj) = 0._wp ; str_ove(ji,jj) = 0._wp 473 htr_btr(ji,jj) = 0._wp ; str_btr(ji,jj) = 0._wp 474 END DO 475 END DO 476 ! 477 !$OMP END PARALLEL 450 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 451 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 452 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 453 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 454 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 455 ! 478 456 ENDIF 479 457 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7698 r7753 161 161 CALL iom_put( "sst", tsn(:,:,1,jp_tem) ) ! surface temperature 162 162 IF ( iom_use("sbt") ) THEN 163 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot)164 163 DO jj = 1, jpj 165 164 DO ji = 1, jpi … … 174 173 CALL iom_put( "sss", tsn(:,:,1,jp_sal) ) ! surface salinity 175 174 IF ( iom_use("sbs") ) THEN 176 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot)177 175 DO jj = 1, jpj 178 176 DO ji = 1, jpi … … 185 183 186 184 IF ( iom_use("taubot") ) THEN ! bottom stress 187 !$OMP PARALLEL 188 !$OMP DO schedule(static) private(jj, ji) 189 DO jj = 1, jpj 190 DO ji = 1, jpi 191 z2d(ji,jj) = 0._wp 192 END DO 193 END DO 194 !$OMP DO schedule(static) private(jj, ji, zztmpx,zztmpy) 185 z2d(:,:) = 0._wp 195 186 DO jj = 2, jpjm1 196 187 DO ji = fs_2, fs_jpim1 ! vector opt. … … 203 194 ENDDO 204 195 ENDDO 205 !$OMP END PARALLEL206 196 CALL lbc_lnk( z2d, 'T', 1. ) 207 197 CALL iom_put( "taubot", z2d ) … … 211 201 CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current 212 202 IF ( iom_use("sbu") ) THEN 213 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot)214 203 DO jj = 1, jpj 215 204 DO ji = 1, jpi … … 224 213 CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current 225 214 IF ( iom_use("sbv") ) THEN 226 !$OMP PARALLEL DO schedule(static) private(jj, ji,jkbot)227 215 DO jj = 1, jpj 228 216 DO ji = 1, jpi … … 237 225 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 238 226 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 239 !$OMP PARALLEL 240 !$OMP DO schedule(static) private(jj, ji) 241 DO jj = 1, jpj 242 DO ji = 1, jpi 243 z2d(ji,jj) = rau0 * e1e2t(ji,jj) 244 END DO 245 END DO 246 !$OMP DO schedule(static) private(jk,jj,ji) 227 z2d(:,:) = rau0 * e1e2t(:,:) 247 228 DO jk = 1, jpk 248 DO jj = 1, jpj 249 DO ji = 1, jpi 250 z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj) 251 END DO 252 END DO 253 END DO 254 !$OMP END PARALLEL 229 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 230 END DO 255 231 CALL iom_put( "w_masstr" , z3d ) 256 232 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) … … 265 241 266 242 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 267 !$OMP PARALLEL DO schedule(static) private(jj, ji, zztmp, zztmpx, zztmpy)268 243 DO jj = 2, jpjm1 ! sst gradient 269 244 DO ji = fs_2, fs_jpim1 ! vector opt. … … 277 252 CALL lbc_lnk( z2d, 'T', 1. ) 278 253 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 279 !$OMP PARALLEL DO schedule(static) private(jj, ji) 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 z2d(ji,jj) = SQRT( z2d(ji,jj) ) 283 END DO 284 END DO 254 z2d(:,:) = SQRT( z2d(:,:) ) 285 255 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 286 256 ENDIF … … 288 258 ! clem: heat and salt content 289 259 IF( iom_use("heatc") ) THEN 290 !$OMP PARALLEL 291 !$OMP DO schedule(static) private(jj, ji) 292 DO jj = 1, jpj 293 DO ji = 1, jpi 294 z2d(ji,jj) = 0._wp 295 END DO 296 END DO 260 z2d(:,:) = 0._wp 297 261 DO jk = 1, jpkm1 298 !$OMP DO schedule(static) private(jj, ji)299 262 DO jj = 1, jpj 300 263 DO ji = 1, jpi … … 303 266 END DO 304 267 END DO 305 !$OMP END PARALLEL306 268 CALL iom_put( "heatc", (rau0 * rcp) * z2d ) ! vertically integrated heat content (J/m2) 307 269 ENDIF 308 270 309 271 IF( iom_use("saltc") ) THEN 310 !$OMP PARALLEL 311 !$OMP DO schedule(static) private(jj, ji) 312 DO jj = 1, jpj 313 DO ji = 1, jpi 314 z2d(ji,jj) = 0._wp 315 END DO 316 END DO 272 z2d(:,:) = 0._wp 317 273 DO jk = 1, jpkm1 318 !$OMP DO schedule(static) private(jj, ji)319 274 DO jj = 1, jpj 320 275 DO ji = 1, jpi … … 323 278 END DO 324 279 END DO 325 !$OMP END PARALLEL326 280 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 327 281 ENDIF 328 282 ! 329 283 IF ( iom_use("eken") ) THEN 330 !$OMP PARALLEL 331 !$OMP DO schedule(static) private(jj, ji) 332 DO jj = 1, jpj 333 DO ji = 1, jpi 334 rke(ji,jj,jk) = 0._wp ! kinetic energy 335 END DO 336 END DO 337 !$OMP DO schedule(static) private(jk, jj, ji, zztmp, zztmpx, zztmpy) 284 rke(:,:,jk) = 0._wp ! kinetic energy 338 285 DO jk = 1, jpkm1 339 286 DO jj = 2, jpjm1 … … 353 300 ENDDO 354 301 ENDDO 355 !$OMP END PARALLEL356 302 CALL lbc_lnk( rke, 'T', 1. ) 357 303 CALL iom_put( "eken", rke ) … … 361 307 ! 362 308 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 363 !$OMP PARALLEL 364 !$OMP DO schedule(static) private(jj, ji) 365 DO jj = 1, jpj 366 DO ji = 1, jpi 367 z3d(ji,jj,jpk) = 0.e0 368 z2d(ji,jj) = 0.e0 369 END DO 370 END DO 309 z3d(:,:,jpk) = 0.e0 310 z2d(:,:) = 0.e0 371 311 DO jk = 1, jpkm1 372 !$OMP DO schedule(static) private(jj, ji) 373 DO jj = 1, jpj 374 DO ji = 1, jpi 375 z3d(ji,jj,jk) = rau0 * un(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 376 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) 377 END DO 378 END DO 379 END DO 380 !$OMP END PARALLEL 312 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 313 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 314 END DO 381 315 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 382 316 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum … … 384 318 385 319 IF( iom_use("u_heattr") ) THEN 386 !$OMP PARALLEL 387 !$OMP DO schedule(static) private(jj, ji) 388 DO jj = 1, jpj 389 DO ji = 1, jpi 390 z2d(ji,jj) = 0.e0 391 END DO 392 END DO 320 z2d(:,:) = 0.e0 393 321 DO jk = 1, jpkm1 394 !$OMP DO schedule(static) private(jj, ji)395 322 DO jj = 2, jpjm1 396 323 DO ji = fs_2, fs_jpim1 ! vector opt. … … 399 326 END DO 400 327 END DO 401 !$OMP END PARALLEL402 328 CALL lbc_lnk( z2d, 'U', -1. ) 403 329 CALL iom_put( "u_heattr", (0.5 * rcp) * z2d ) ! heat transport in i-direction … … 405 331 406 332 IF( iom_use("u_salttr") ) THEN 407 !$OMP PARALLEL 408 !$OMP DO schedule(static) private(jj, ji) 409 DO jj = 1, jpj 410 DO ji = 1, jpi 411 z2d(ji,jj) = 0.e0 412 END DO 413 END DO 333 z2d(:,:) = 0.e0 414 334 DO jk = 1, jpkm1 415 !$OMP DO schedule(static) private(jj, ji)416 335 DO jj = 2, jpjm1 417 336 DO ji = fs_2, fs_jpim1 ! vector opt. … … 420 339 END DO 421 340 END DO 422 !$OMP END PARALLEL423 341 CALL lbc_lnk( z2d, 'U', -1. ) 424 342 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction … … 427 345 428 346 IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 429 !$OMP PARALLEL 430 !$OMP DO schedule(static) private(jj, ji) 431 DO jj = 1, jpj 432 DO ji = 1, jpi 433 z3d(ji,jj,jpk) = 0.e0 434 END DO 435 END DO 436 !$OMP DO schedule(static) private(jk,jj,ji) 347 z3d(:,:,jpk) = 0.e0 437 348 DO jk = 1, jpkm1 438 DO jj = 1, jpj 439 DO ji = 1, jpi 440 z3d(ji,jj,jk) = rau0 * vn(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 441 END DO 442 END DO 443 END DO 444 !$OMP END PARALLEL 349 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 350 END DO 445 351 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 446 352 ENDIF 447 353 448 354 IF( iom_use("v_heattr") ) THEN 449 !$OMP PARALLEL 450 !$OMP DO schedule(static) private(jj, ji) 451 DO jj = 1, jpj 452 DO ji = 1, jpi 453 z2d(ji,jj) = 0.e0 454 END DO 455 END DO 355 z2d(:,:) = 0.e0 456 356 DO jk = 1, jpkm1 457 !$OMP DO schedule(static) private(jj, ji)458 357 DO jj = 2, jpjm1 459 358 DO ji = fs_2, fs_jpim1 ! vector opt. … … 462 361 END DO 463 362 END DO 464 !$OMP END PARALLEL465 363 CALL lbc_lnk( z2d, 'V', -1. ) 466 364 CALL iom_put( "v_heattr", (0.5 * rcp) * z2d ) ! heat transport in j-direction … … 468 366 469 367 IF( iom_use("v_salttr") ) THEN 470 !$OMP PARALLEL 471 !$OMP DO schedule(static) private(jj, ji) 472 DO jj = 1, jpj 473 DO ji = 1, jpi 474 z2d(ji,jj) = 0.e0 475 END DO 476 END DO 368 z2d(:,:) = 0.e0 477 369 DO jk = 1, jpkm1 478 !$OMP DO schedule(static) private(jj, ji)479 370 DO jj = 2, jpjm1 480 371 DO ji = fs_2, fs_jpim1 ! vector opt. … … 483 374 END DO 484 375 END DO 485 !$OMP END PARALLEL486 376 CALL lbc_lnk( z2d, 'V', -1. ) 487 377 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction … … 490 380 ! Vertical integral of temperature 491 381 IF( iom_use("tosmint") ) THEN 492 !$OMP PARALLEL 493 !$OMP DO schedule(static) private(jj, ji) 494 DO jj = 1, jpj 495 DO ji = 1, jpi 496 z2d(ji,jj) = 0.e0 497 END DO 498 END DO 382 z2d(:,:)=0._wp 499 383 DO jk = 1, jpkm1 500 !$OMP DO schedule(static) private(jj, ji)501 384 DO jj = 2, jpjm1 502 385 DO ji = fs_2, fs_jpim1 ! vector opt. … … 505 388 END DO 506 389 END DO 507 !$OMP END PARALLEL508 390 CALL lbc_lnk( z2d, 'T', -1. ) 509 391 CALL iom_put( "tosmint", z2d ) … … 512 394 ! Vertical integral of salinity 513 395 IF( iom_use("somint") ) THEN 514 !$OMP PARALLEL 515 !$OMP DO schedule(static) private(jj, ji) 516 DO jj = 1, jpj 517 DO ji = 1, jpi 518 z2d(ji,jj) = 0.e0 519 END DO 520 END DO 396 z2d(:,:)=0._wp 521 397 DO jk = 1, jpkm1 522 !$OMP DO schedule(static) private(jj, ji)523 398 DO jj = 2, jpjm1 524 399 DO ji = fs_2, fs_jpim1 ! vector opt. … … 527 402 END DO 528 403 END DO 529 !$OMP END PARALLEL530 404 CALL lbc_lnk( z2d, 'T', -1. ) 531 405 CALL iom_put( "somint", z2d ) … … 918 792 ENDIF 919 793 IF( .NOT.ln_linssh ) THEN 920 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 921 DO jk = 1, jpk 922 DO jj = 1, jpj 923 DO ji = 1, jpi 924 zw3d(ji,jj,jk) = ( ( e3t_n(ji,jj,jk) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100 * tmask(ji,jj,jk) ) ** 2 925 END DO 926 END DO 927 END DO 794 zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 928 795 CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness 929 796 CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth … … 937 804 ! in linear free surface case) 938 805 IF( ln_linssh ) THEN 939 !$OMP PARALLEL DO schedule(static) private(jj, ji) 940 DO jj = 1, jpj 941 DO ji = 1, jpi 942 zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_tem) 943 END DO 944 END DO 806 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 945 807 CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sst 946 !$OMP PARALLEL DO schedule(static) private(jj, ji) 947 DO jj = 1, jpj 948 DO ji = 1, jpi 949 zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_sal) 950 END DO 951 END DO 808 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 952 809 CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sss 953 810 ENDIF … … 985 842 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 986 843 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 987 IF( ln_ssr ) THEN 988 !$OMP PARALLEL DO schedule(static) private(jj, ji) 989 DO jj = 1, jpj 990 DO ji = 1, jpi 991 zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 992 END DO 993 END DO 994 END IF 844 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 995 845 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 996 846 ENDIF … … 998 848 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 999 849 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 1000 IF( ln_ssr ) THEN 1001 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1002 DO jj = 1, jpj 1003 DO ji = 1, jpi 1004 zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 1005 END DO 1006 END DO 1007 END IF 850 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 1008 851 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 1009 852 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
