Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r7646 r7698 89 89 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 90 90 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 91 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 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 92 97 ENDIF 93 98 ! … … 106 111 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 107 112 ! 108 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 109 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 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 110 122 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 111 123 ! 112 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 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 113 131 DO jk = 1, jpkm1 114 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 115 END DO 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 116 140 IF( ln_linssh ) THEN 117 141 IF( ln_isfcav ) THEN 142 !$OMP PARALLEL DO schedule(static) private(jj, ji) 118 143 DO ji = 1, jpi 119 144 DO jj = 1, jpj … … 122 147 END DO 123 148 ELSE 124 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 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 125 155 END IF 126 156 !!gm … … 128 158 !!gm 129 159 END IF 160 ! 161 zarho = SUM( area(:,:) * zbotpres(:,:) ) 130 162 ! 131 zarho = SUM( area(:,:) * zbotpres(:,:) )132 163 IF( lk_mpp ) CALL mpp_sum( zarho ) 133 164 zssh_steric = - zarho / area_tot … … 136 167 ! ! steric sea surface height 137 168 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 138 zrhop(:,:,jpk) = 0._wp 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 139 175 CALL iom_put( 'rhop', zrhop ) 140 176 ! 141 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 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 142 184 DO jk = 1, jpkm1 143 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 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 144 191 END DO 145 192 IF( ln_linssh ) THEN 146 193 IF ( ln_isfcav ) THEN 194 !$OMP DO schedule(static) private(jj, ji) 147 195 DO ji = 1,jpi 148 196 DO jj = 1,jpj … … 151 199 END DO 152 200 ELSE 153 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 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 154 207 END IF 155 208 END IF 209 !$OMP END PARALLEL 156 210 ! 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 211 zarho = SUM( area(:,:) * zbotpres(:,:) ) 158 212 IF( lk_mpp ) CALL mpp_sum( zarho ) 159 213 zssh_steric = - zarho / area_tot … … 162 216 ! ! ocean bottom pressure 163 217 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 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 165 224 CALL iom_put( 'botpres', zbotpres ) 166 225 ! … … 213 272 ! work is not being done against stratification 214 273 CALL wrk_alloc( jpi, jpj, zpe ) 215 zpe(:,:) = 0._wp 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 216 280 IF( lk_zdfddm ) THEN 281 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk,zrw,zaw,zbw) 217 282 DO ji=1,jpi 218 283 DO jj=1,jpj … … 232 297 ENDDO 233 298 ELSE 299 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk) 234 300 DO ji = 1, jpi 235 301 DO jj = 1, jpj … … 323 389 INTEGER :: ik 324 390 INTEGER :: ji, jj, jk ! dummy loop indices 325 REAL(wp) :: zztmp 391 REAL(wp) :: zztmp, zsum 326 392 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 327 393 ! … … 341 407 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 342 408 343 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 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 344 415 345 416 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 346 417 347 418 vol0 = 0._wp 348 thick0(:,:) = 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 349 426 DO jk = 1, jpkm1 350 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 351 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 352 END DO 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 353 442 IF( lk_mpp ) CALL mpp_sum( vol0 ) 354 443 … … 358 447 CALL iom_close( inum ) 359 448 360 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 361 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 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 362 459 IF( ln_zps ) THEN ! z-coord. partial steps 460 !$OMP DO schedule(static) private(jj, ji, ik, zztmp) 363 461 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 364 462 DO ji = 1, jpi … … 371 469 END DO 372 470 ENDIF 471 !$OMP END PARALLEL 373 472 ! 374 473 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )
Note: See TracChangeset
for help on using the changeset viewer.
