Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r7646 r7698 128 128 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 129 129 CALL wrk_alloc( jpi,jpj,jpk, ztrdt ) 130 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 130 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 131 DO jk = 1, jpk 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 135 END DO 136 END DO 137 END DO 131 138 ENDIF 132 139 ! … … 142 149 ELSE ! No restart or restart not found: Euler forward time stepping 143 150 z1_2 = 1._wp 144 qsr_hc_b(:,:,:) = 0._wp 151 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 152 DO jk = 1, jpk 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 qsr_hc_b(ji,jj,jk) = 0._wp 156 END DO 157 END DO 158 END DO 145 159 ENDIF 146 160 ELSE !== Swap of qsr heat content ==! 147 161 z1_2 = 0.5_wp 148 qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 162 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 163 DO jk = 1, jpk 164 DO jj = 1, jpj 165 DO ji = 1, jpi 166 qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 167 END DO 168 END DO 169 END DO 149 170 ENDIF 150 171 ! … … 155 176 CASE( np_BIO ) !== bio-model fluxes ==! 156 177 ! 178 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 157 179 DO jk = 1, nksr 158 qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 183 END DO 184 END DO 159 185 END DO 160 186 ! … … 166 192 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 167 193 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 194 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,zCtot,zze,zpsi,zlogc,zlogc2,zlogc3,zCb,zCmax,zpsimax,zdelpsi,zCze) 168 195 DO jk = 1, nksr + 1 169 196 DO jj = 2, jpjm1 ! Separation in R-G-B depending of the surface Chl … … 190 217 END DO 191 218 ELSE !* constant chrlorophyll 219 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 192 220 DO jk = 1, nksr + 1 193 zchl3d(:,:,jk) = 0.05 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 zchl3d(ji,jj,jk) = 0.05 224 ENDDO 225 ENDDO 194 226 ENDDO 195 227 ENDIF 196 228 ! 197 229 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B 230 !$OMP PARALLEL 231 !$OMP DO schedule(static) private(jj,ji) 198 232 DO jj = 2, jpjm1 199 233 DO ji = fs_2, fs_jpim1 … … 205 239 END DO 206 240 END DO 241 !$OMP END DO NOWAIT 207 242 ! 208 243 DO jk = 2, nksr+1 !* interior equi-partition in R-G-B depending of vertical profile of Chl 244 !$OMP DO schedule(static) private(jj,ji,zchl,irgb) 209 245 DO jj = 2, jpjm1 210 246 DO ji = fs_2, fs_jpim1 … … 217 253 END DO 218 254 255 !$OMP DO schedule(static) private(jj,ji,zc0,zc1,zc2,zc3) 219 256 DO jj = 2, jpjm1 220 257 DO ji = fs_2, fs_jpim1 … … 232 269 END DO 233 270 ! 271 !$OMP DO schedule(static) private(jk,jj,ji) 234 272 DO jk = 1, nksr !* now qsr induced heat content 235 273 DO jj = 2, jpjm1 … … 239 277 END DO 240 278 END DO 279 !$OMP END PARALLEL 241 280 ! 242 281 CALL wrk_dealloc( jpi,jpj, zekb, zekg, zekr ) … … 247 286 zz0 = rn_abs * r1_rau0_rcp ! surface equi-partition in 2-bands 248 287 zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 288 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zc0,zc1) 249 289 DO jk = 1, nksr ! solar heat absorbed at T-point in the top 400m 250 290 DO jj = 2, jpjm1 … … 260 300 ! 261 301 ! !-----------------------------! 302 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 262 303 DO jk = 1, nksr ! update to the temp. trend ! 263 304 DO jj = 2, jpjm1 !-----------------------------! … … 270 311 ! 271 312 IF( ln_qsr_ice ) THEN ! sea-ice: store the 1st ocean level attenuation coefficient 313 !$OMP PARALLEL DO schedule(static) private(jj,ji) 272 314 DO jj = 2, jpjm1 273 315 DO ji = fs_2, fs_jpim1 ! vector opt. … … 284 326 CALL wrk_alloc( jpi,jpj,jpk, zetot ) 285 327 ! 286 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 328 !$OMP PARALLEL 329 !$OMP DO schedule(static) private(jj,ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi ! vector opt. 332 zetot(ji,jj,nksr+1:jpk) = 0._wp ! below ~400m set to zero 333 END DO 334 END DO 287 335 DO jk = nksr, 1, -1 288 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 336 !$OMP DO schedule(static) private(jj,ji) 337 DO jj = 1, jpj 338 DO ji = 1, jpi ! vector opt. 339 zetot(ji,jj,jk) = zetot(ji,jj,jk+1) + qsr_hc(ji,jj,jk) / r1_rau0_rcp 340 END DO 341 END DO 289 342 END DO 343 !$OMP END PARALLEL 290 344 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 291 345 ! … … 299 353 ! 300 354 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 301 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 355 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 356 DO jk = 1, jpk 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 360 END DO 361 END DO 362 END DO 302 363 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 303 364 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) … … 426 487 END SELECT 427 488 ! 428 qsr_hc(:,:,:) = 0._wp ! now qsr heat content set to zero where it will not be computed 489 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 490 DO jk = 1, jpk 491 DO jj = 1, jpj 492 DO ji = 1, jpi 493 qsr_hc(ji,jj,jk) = 0._wp ! now qsr heat content set to zero where it will not be computed 494 END DO 495 END DO 496 END DO 429 497 ! 430 498 ! 1st ocean level attenuation coefficient (used in sbcssm) … … 432 500 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 433 501 ELSE 434 fraqsr_1lev(:,:) = 1._wp ! default : no penetration 502 !$OMP PARALLEL DO schedule(static) private(jj,ji) 503 DO jj = 1, jpj 504 DO ji = 1, jpi 505 fraqsr_1lev(ji,jj) = 1._wp ! default : no penetration 506 END DO 507 END DO 435 508 ENDIF 436 509 !
Note: See TracChangeset
for help on using the changeset viewer.
