Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
- Timestamp:
- 2017-03-03T12:46:59+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
r7698 r7753 128 128 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 129 129 CALL wrk_alloc( jpi,jpj,jpk, ztrdt ) 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 130 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 138 131 ENDIF 139 132 ! … … 149 142 ELSE ! No restart or restart not found: Euler forward time stepping 150 143 z1_2 = 1._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 144 qsr_hc_b(:,:,:) = 0._wp 159 145 ENDIF 160 146 ELSE !== Swap of qsr heat content ==! 161 147 z1_2 = 0.5_wp 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 148 qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 170 149 ENDIF 171 150 ! … … 176 155 CASE( np_BIO ) !== bio-model fluxes ==! 177 156 ! 178 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)179 157 DO jk = 1, nksr 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 158 qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 185 159 END DO 186 160 ! … … 192 166 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 193 167 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)195 168 DO jk = 1, nksr + 1 196 169 DO jj = 2, jpjm1 ! Separation in R-G-B depending of the surface Chl … … 217 190 END DO 218 191 ELSE !* constant chrlorophyll 219 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)220 192 DO jk = 1, nksr + 1 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 zchl3d(ji,jj,jk) = 0.05 224 ENDDO 225 ENDDO 193 zchl3d(:,:,jk) = 0.05 226 194 ENDDO 227 195 ENDIF 228 196 ! 229 197 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B 230 !$OMP PARALLEL231 !$OMP DO schedule(static) private(jj,ji)232 198 DO jj = 2, jpjm1 233 199 DO ji = fs_2, fs_jpim1 … … 239 205 END DO 240 206 END DO 241 !$OMP END DO NOWAIT242 207 ! 243 208 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)245 209 DO jj = 2, jpjm1 246 210 DO ji = fs_2, fs_jpim1 … … 253 217 END DO 254 218 255 !$OMP DO schedule(static) private(jj,ji,zc0,zc1,zc2,zc3)256 219 DO jj = 2, jpjm1 257 220 DO ji = fs_2, fs_jpim1 … … 269 232 END DO 270 233 ! 271 !$OMP DO schedule(static) private(jk,jj,ji)272 234 DO jk = 1, nksr !* now qsr induced heat content 273 235 DO jj = 2, jpjm1 … … 277 239 END DO 278 240 END DO 279 !$OMP END PARALLEL280 241 ! 281 242 CALL wrk_dealloc( jpi,jpj, zekb, zekg, zekr ) … … 286 247 zz0 = rn_abs * r1_rau0_rcp ! surface equi-partition in 2-bands 287 248 zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 288 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zc0,zc1)289 249 DO jk = 1, nksr ! solar heat absorbed at T-point in the top 400m 290 250 DO jj = 2, jpjm1 … … 300 260 ! 301 261 ! !-----------------------------! 302 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)303 262 DO jk = 1, nksr ! update to the temp. trend ! 304 263 DO jj = 2, jpjm1 !-----------------------------! … … 311 270 ! 312 271 IF( ln_qsr_ice ) THEN ! sea-ice: store the 1st ocean level attenuation coefficient 313 !$OMP PARALLEL DO schedule(static) private(jj,ji)314 272 DO jj = 2, jpjm1 315 273 DO ji = fs_2, fs_jpim1 ! vector opt. … … 326 284 CALL wrk_alloc( jpi,jpj,jpk, zetot ) 327 285 ! 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 286 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 335 287 DO jk = nksr, 1, -1 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 288 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 342 289 END DO 343 !$OMP END PARALLEL344 290 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 345 291 ! … … 353 299 ! 354 300 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 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 301 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 363 302 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 364 303 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) … … 487 426 END SELECT 488 427 ! 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 428 qsr_hc(:,:,:) = 0._wp ! now qsr heat content set to zero where it will not be computed 497 429 ! 498 430 ! 1st ocean level attenuation coefficient (used in sbcssm) … … 500 432 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 501 433 ELSE 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 434 fraqsr_1lev(:,:) = 1._wp ! default : no penetration 508 435 ENDIF 509 436 !
Note: See TracChangeset
for help on using the changeset viewer.
