Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA
- Timestamp:
- 2017-03-03T12:46:59+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/TRA
- Files:
-
- 16 edited
-
eosbn2.F90 (modified) (20 diffs)
-
traadv.F90 (modified) (5 diffs)
-
traadv_fct.F90 (modified) (20 diffs)
-
traadv_mle.F90 (modified) (2 diffs)
-
traadv_mus.F90 (modified) (11 diffs)
-
trabbc.F90 (modified) (5 diffs)
-
trabbl.F90 (modified) (13 diffs)
-
tradmp.F90 (modified) (5 diffs)
-
traldf.F90 (modified) (3 diffs)
-
traldf_iso.F90 (modified) (16 diffs)
-
tranxt.F90 (modified) (6 diffs)
-
traqsr.F90 (modified) (16 diffs)
-
trasbc.F90 (modified) (6 diffs)
-
trazdf.F90 (modified) (3 diffs)
-
trazdf_imp.F90 (modified) (10 diffs)
-
zpshde.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r7698 r7753 237 237 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 238 238 ! 239 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn)240 239 DO jk = 1, jpkm1 241 240 DO jj = 1, jpj … … 278 277 CASE( np_seos ) !== simplified EOS ==! 279 278 ! 280 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn)281 279 DO jk = 1, jpkm1 282 280 DO jj = 1, jpj … … 347 345 END DO 348 346 ! 349 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, jsmp, jdof, zh, zt, zstemp, zs, ztm, zn3, zn2, zn1)350 347 DO jk = 1, jpkm1 351 348 DO jj = 1, jpj … … 402 399 ! Non-stochastic equation of state 403 400 ELSE 404 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn)405 401 DO jk = 1, jpkm1 406 402 DO jj = 1, jpj … … 445 441 CASE( np_seos ) !== simplified EOS ==! 446 442 ! 447 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn)448 443 DO jk = 1, jpkm1 449 444 DO jj = 1, jpj … … 498 493 IF( nn_timing == 1 ) CALL timing_start('eos2d') 499 494 ! 500 !$OMP PARALLEL DO schedule(static) private(jj, ji) 501 DO jj = 1, jpj 502 DO ji = 1, jpi 503 prd(ji,jj) = 0._wp 504 END DO 505 END DO 495 prd(:,:) = 0._wp 506 496 ! 507 497 SELECT CASE( neos ) … … 509 499 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 510 500 ! 511 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn)512 501 DO jj = 1, jpjm1 513 502 DO ji = 1, fs_jpim1 ! vector opt. … … 549 538 CASE( np_seos ) !== simplified EOS ==! 550 539 ! 551 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn)552 540 DO jj = 1, jpjm1 553 541 DO ji = 1, fs_jpim1 ! vector opt. … … 601 589 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 602 590 ! 603 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn)604 591 DO jk = 1, jpkm1 605 592 DO jj = 1, jpj … … 659 646 CASE( np_seos ) !== simplified EOS ==! 660 647 ! 661 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn)662 648 DO jk = 1, jpkm1 663 649 DO jj = 1, jpj … … 712 698 IF( nn_timing == 1 ) CALL timing_start('rab_2d') 713 699 ! 714 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 715 DO jk = 1, jpts 716 DO jj = 1, jpj 717 DO ji = 1, jpi 718 pab(ji,jj,jk) = 0._wp 719 END DO 720 END DO 721 END DO 700 pab(:,:,:) = 0._wp 722 701 ! 723 702 SELECT CASE ( neos ) … … 725 704 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 726 705 ! 727 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn)728 706 DO jj = 1, jpjm1 729 707 DO ji = 1, fs_jpim1 ! vector opt. … … 784 762 CASE( np_seos ) !== simplified EOS ==! 785 763 ! 786 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn)787 764 DO jj = 1, jpjm1 788 765 DO ji = 1, fs_jpim1 ! vector opt. … … 940 917 IF( nn_timing == 1 ) CALL timing_start('bn2') 941 918 ! 942 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrw, zaw, zbw)943 919 DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 ) 944 920 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 … … 976 952 !! Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 977 953 !!---------------------------------------------------------------------- 978 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius]979 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]954 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius] 955 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 980 956 ! Leave result array automatic rather than making explicitly allocated 981 957 REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celsius] … … 993 969 z1_T0 = 1._wp/40._wp 994 970 ! 995 !$OMP PARALLEL DO schedule(static) private(jj, ji, zt, zs, ztm, zn,zd)996 971 DO jj = 1, jpj 997 972 DO ji = 1, jpi … … 1049 1024 ! 1050 1025 z1_S0 = 1._wp / 35.16504_wp 1051 !$OMP PARALLEL1052 !$OMP DO schedule(static) private(jj, ji, zs)1053 1026 DO jj = 1, jpj 1054 1027 DO ji = 1, jpi … … 1058 1031 END DO 1059 1032 END DO 1060 !$OMP DO schedule(static) private(jj, ji) 1061 DO jj = 1, jpj 1062 DO ji = 1, jpi 1063 ptf(ji,jj) = ptf(ji,jj) * psal(ji,jj) 1064 END DO 1065 END DO 1066 !$OMP END PARALLEL 1067 ! 1068 IF( PRESENT( pdep ) ) THEN 1069 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1070 DO jj = 1, jpj 1071 DO ji = 1, jpi 1072 ptf(ji,jj) = ptf(ji,jj) - 7.53e-4 * pdep(ji,jj) 1073 END DO 1074 END DO 1075 END IF 1033 ptf(:,:) = ptf(:,:) * psal(:,:) 1034 ! 1035 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1076 1036 ! 1077 1037 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1078 1038 ! 1079 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1080 DO jj = 1, jpj 1081 DO ji = 1, jpi 1082 ptf(ji,jj) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(ji,jj) ) & 1083 & - 2.154996e-4_wp * psal(ji,jj) ) * psal(ji,jj) 1084 END DO 1085 END DO 1039 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & 1040 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:) 1086 1041 ! 1087 IF( PRESENT( pdep ) ) THEN 1088 !$OMP PARALLEL DO schedule(static) private(jj, ji) 1089 DO jj = 1, jpj 1090 DO ji = 1, jpi 1091 ptf(ji,jj) = ptf(ji,jj) - 7.53e-4 * pdep(ji,jj) 1092 END DO 1093 END DO 1094 END IF 1042 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1095 1043 ! 1096 1044 CASE DEFAULT … … 1186 1134 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 1187 1135 ! 1188 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn2, zn1, zn0, zn)1189 1136 DO jk = 1, jpkm1 1190 1137 DO jj = 1, jpj … … 1250 1197 CASE( np_seos ) !== Vallis (2006) simplified EOS ==! 1251 1198 ! 1252 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn)1253 1199 DO jk = 1, jpkm1 1254 1200 DO jj = 1, jpj -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r7698 r7753 88 88 INTEGER, INTENT( in ) :: kt ! ocean time-step index 89 89 ! 90 INTEGER :: ji, jj,jk ! dummy loop index90 INTEGER :: jk ! dummy loop index 91 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 92 92 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace … … 98 98 ! 99 99 ! ! set time step 100 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 101 DO jk = 1, jpk 102 DO jj = 1, jpj 103 DO ji = 1, jpi 104 zun(ji,jj,jk) = 0.0 105 zvn(ji,jj,jk) = 0.0 106 zwn(ji,jj,jk) = 0.0 107 END DO 108 END DO 109 END DO 100 zun(:,:,:) = 0.0 101 zvn(:,:,:) = 0.0 102 zwn(:,:,:) = 0.0 110 103 ! 111 104 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 … … 117 110 ! !== effective transport ==! 118 111 IF( ln_wave .AND. ln_sdw ) THEN 119 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)120 112 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 121 DO jj = 1, jpj 122 DO ji = 1, jpi 123 zun(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * ( un(ji,jj,jk) + usd(ji,jj,jk) ) 124 zvn(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * ( vn(ji,jj,jk) + vsd(ji,jj,jk) ) 125 zwn(ji,jj,jk) = e1e2t(ji,jj) * ( wn(ji,jj,jk) + wsd(ji,jj,jk) ) 126 END DO 127 END DO 113 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 114 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 115 zwn(:,:,jk) = e1e2t(:,:) * ( wn(:,:,jk) + wsd(:,:,jk) ) 128 116 END DO 129 117 ELSE 130 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)131 118 DO jk = 1, jpkm1 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 zun(ji,jj,jk) = e2u (ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) ! eulerian transport only 135 zvn(ji,jj,jk) = e1v (ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 136 zwn(ji,jj,jk) = e1e2t(ji,jj) * wn(ji,jj,jk) 137 END DO 138 END DO 119 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only 120 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 121 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 139 122 END DO 140 123 ENDIF 141 124 ! 142 125 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 143 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 144 DO jk = 1, jpk 145 DO jj = 1, jpj 146 DO ji = 1, jpi 147 zun(ji,jj,jk) = zun(ji,jj,jk) + un_td(ji,jj,jk) 148 zvn(ji,jj,jk) = zvn(ji,jj,jk) + vn_td(ji,jj,jk) 149 END DO 150 END DO 151 END DO 152 ENDIF 153 ! 154 !$OMP PARALLEL DO schedule(static) private(jj, ji) 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 zun(ji,jj,jpk) = 0._wp ! no transport trough the bottom 158 zvn(ji,jj,jpk) = 0._wp 159 zwn(ji,jj,jpk) = 0._wp 160 END DO 161 END DO 126 zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 127 zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 128 ENDIF 129 ! 130 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 131 zvn(:,:,jpk) = 0._wp 132 zwn(:,:,jpk) = 0._wp 162 133 ! 163 134 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & … … 176 147 IF( l_trdtra ) THEN !* Save ta and sa trends 177 148 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 178 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 179 DO jk = 1, jpk 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 183 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 184 END DO 185 END DO 186 END DO 149 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 150 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 187 151 ENDIF 188 152 ! … … 205 169 ! 206 170 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 207 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)208 171 DO jk = 1, jpkm1 209 DO jj = 1, jpj 210 DO ji = 1, jpi 211 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 212 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 213 END DO 214 END DO 172 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 173 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 215 174 END DO 216 175 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r7698 r7753 113 113 IF( l_trd .OR. l_hst ) THEN 114 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 115 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 116 DO jk = 1, jpk 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 ztrdx(ji,jj,jk) = 0._wp 120 ztrdy(ji,jj,jk) = 0._wp 121 ztrdz(ji,jj,jk) = 0._wp 122 END DO 123 END DO 124 END DO 115 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 125 116 ENDIF 126 117 ! 127 118 IF( l_ptr ) THEN 128 119 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 129 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 130 DO jk = 1, jpk 131 DO jj = 1, jpj 132 DO ji = 1, jpi 133 zptry(ji,jj,jk) = 0._wp 134 END DO 135 END DO 136 END DO 120 zptry(:,:,:) = 0._wp 137 121 ENDIF 138 122 ! ! surface & bottom value : flux set to zero one for all 139 !$OMP PARALLEL 140 !$OMP DO schedule(static) private(jj, ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 zwz(ji,jj, 1 ) = 0._wp 144 zwx(ji,jj,jpk) = 0._wp 145 zwy(ji,jj,jpk) = 0._wp 146 zwz(ji,jj,jpk) = 0._wp 147 END DO 148 END DO 149 !$OMP END DO NOWAIT 150 !$OMP DO schedule(static) private(jk, jj, ji) 151 DO jk = 1, jpk 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 zwi(ji,jj,jk) = 0._wp 155 END DO 156 END DO 157 END DO 158 !$OMP END PARALLEL 123 zwz(:,:, 1 ) = 0._wp 124 zwx(:,:,jpk) = 0._wp ; zwy(:,:,jpk) = 0._wp ; zwz(:,:,jpk) = 0._wp 125 ! 126 zwi(:,:,:) = 0._wp 159 127 ! 160 128 DO jn = 1, kjpt !== loop over the tracers ==! … … 162 130 ! !== upstream advection with initial mass fluxes & intermediate update ==! 163 131 ! !* upstream tracer flux in the i and j direction 164 !$OMP PARALLEL165 !$OMP DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui,zfm_ui)166 132 DO jk = 1, jpkm1 167 133 DO jj = 1, jpjm1 … … 177 143 END DO 178 144 END DO 179 !$OMP END DO NOWAIT180 145 ! !* upstream tracer flux in the k direction *! 181 !$OMP DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk)182 146 DO jk = 2, jpkm1 ! Interior value ( multiplied by wmask) 183 147 DO jj = 1, jpj … … 189 153 END DO 190 154 END DO 191 !$OMP END PARALLEL192 155 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 193 156 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 194 !$OMP PARALLEL DO schedule(static) private(jj, ji)195 157 DO jj = 1, jpj 196 158 DO ji = 1, jpi … … 199 161 END DO 200 162 ELSE ! no cavities: only at the ocean surface 201 !$OMP PARALLEL DO schedule(static) private(jj, ji) 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 zwz(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 205 END DO 206 END DO 163 zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 207 164 ENDIF 208 165 ENDIF 209 166 ! 210 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztra)211 167 DO jk = 1, jpkm1 !* trend and after field with monotonic scheme 212 168 DO jj = 2, jpjm1 … … 225 181 ! 226 182 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 227 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 228 DO jk = 1, jpk 229 DO jj = 1, jpj 230 DO ji = 1, jpi 231 ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 232 ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 233 ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 234 END DO 235 END DO 236 END DO 183 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 237 184 END IF 238 185 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 239 IF( l_ptr ) THEN 240 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 241 DO jk = 1, jpk 242 DO jj = 1, jpj 243 DO ji = 1, jpi 244 zptry(ji,jj,jk) = zwy(ji,jj,jk) 245 END DO 246 END DO 247 END DO 248 END IF 186 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 249 187 ! 250 188 ! !== anti-diffusive flux : high order minus low order ==! … … 253 191 ! 254 192 CASE( 2 ) !- 2nd order centered 255 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)256 193 DO jk = 1, jpkm1 257 194 DO jj = 1, jpjm1 … … 264 201 ! 265 202 CASE( 4 ) !- 4th order centered 266 !$OMP PARALLEL 267 !$OMP DO schedule(static) private(jj, ji) 268 DO jj = 1, jpj 269 DO ji = 1, jpi 270 zltu(ji,jj,jpk) = 0._wp ! Bottom value : flux set to zero 271 zltv(ji,jj,jpk) = 0._wp 272 END DO 273 END DO 274 !$OMP DO schedule(static) private(jk, jj, ji) 203 zltu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 204 zltv(:,:,jpk) = 0._wp 275 205 DO jk = 1, jpkm1 ! Laplacian 276 206 DO jj = 1, jpjm1 ! 1st derivative (gradient) … … 287 217 END DO 288 218 END DO 289 !$OMP END PARALLEL290 219 CALL lbc_lnk( zltu, 'T', 1. ) ; CALL lbc_lnk( zltv, 'T', 1. ) ! Lateral boundary cond. (unchanged sgn) 291 220 ! 292 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v)293 221 DO jk = 1, jpkm1 ! Horizontal advective fluxes 294 222 DO jj = 1, jpjm1 … … 304 232 ! 305 233 CASE( 41 ) !- 4th order centered ==>> !!gm coding attempt need to be tested 306 !$OMP PARALLEL 307 !$OMP DO schedule(static) private(jj, ji) 308 DO jj = 1, jpj 309 DO ji = 1, jpi 310 ztu(ji,jj,jpk) = 0._wp ! Bottom value : flux set to zero 311 ztv(ji,jj,jpk) = 0._wp 312 END DO 313 END DO 314 !$OMP DO schedule(static) private(jk, jj, ji) 234 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 235 ztv(:,:,jpk) = 0._wp 315 236 DO jk = 1, jpkm1 ! 1st derivative (gradient) 316 237 DO jj = 1, jpjm1 … … 321 242 END DO 322 243 END DO 323 !$OMP END PARALLEL324 244 CALL lbc_lnk( ztu, 'U', -1. ) ; CALL lbc_lnk( ztv, 'V', -1. ) ! Lateral boundary cond. (unchanged sgn) 325 245 ! 326 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v, zC4t_u, zC4t_v)327 246 DO jk = 1, jpkm1 ! Horizontal advective fluxes 328 247 DO jj = 2, jpjm1 … … 345 264 ! 346 265 CASE( 2 ) !- 2nd order centered 347 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)348 266 DO jk = 2, jpkm1 349 267 DO jj = 2, jpjm1 … … 357 275 CASE( 4 ) !- 4th order COMPACT 358 276 CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw ) ! zwt = COMPACT interpolation of T at w-point 359 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)360 277 DO jk = 2, jpkm1 361 278 DO jj = 2, jpjm1 … … 368 285 END SELECT 369 286 IF( ln_linssh ) THEN ! top ocean value: high order = upstream ==>> zwz=0 370 !$OMP PARALLEL DO schedule(static) private(jj, ji) 371 DO jj = 1, jpj 372 DO ji = 1, jpi 373 zwz(ji,jj,1) = 0._wp ! only ocean surface as interior zwz values have been w-masked 374 END DO 375 END DO 287 zwz(:,:,1) = 0._wp ! only ocean surface as interior zwz values have been w-masked 376 288 ENDIF 377 289 ! … … 385 297 ! !== final trend with corrected fluxes ==! 386 298 ! 387 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)388 299 DO jk = 1, jpkm1 389 300 DO jj = 2, jpjm1 … … 398 309 ! 399 310 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 400 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 401 DO jk = 1, jpk 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 ztrdx(ji,jj,jk) = ztrdx(ji,jj,jk) + zwx(ji,jj,jk) ! <<< Add to previously computed 405 ztrdy(ji,jj,jk) = ztrdy(ji,jj,jk) + zwy(ji,jj,jk) ! <<< Add to previously computed 406 ztrdz(ji,jj,jk) = ztrdz(ji,jj,jk) + zwz(ji,jj,jk) ! <<< Add to previously computed 407 END DO 408 END DO 409 END DO 311 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 312 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 313 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 410 314 ENDIF 411 315 ! … … 421 325 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 422 326 IF( l_ptr ) THEN 423 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 424 DO jk = 1, jpk 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 zptry(ji,jj,jk) = zptry(ji,jj,jk) + zwy(ji,jj,jk) ! <<< Add to previously computed 428 END DO 429 END DO 430 END DO 327 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 431 328 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 432 329 ENDIF … … 765 662 zbig = 1.e+40_wp 766 663 zrtrn = 1.e-15_wp 664 zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp 767 665 768 666 ! Search local extrema … … 774 672 & paft * tmask + zbig * ( 1._wp - tmask ) ) 775 673 776 !$OMP PARALLEL777 !$OMP DO schedule(static) private(jk, jj, ji)778 DO jk = 1, jpk779 DO jj = 1, jpj780 DO ji = 1, jpi781 zbetup(ji,jj,jk) = 0._wp782 zbetdo(ji,jj,jk) = 0._wp783 END DO784 END DO785 END DO786 !$OMP DO schedule(static) private(jk, jj, ji, ikm1, zup, zdo, zpos, zneg, zbt)787 674 DO jk = 1, jpkm1 788 675 ikm1 = MAX(jk-1,1) … … 819 706 END DO 820 707 END DO 821 !$OMP END PARALLEL822 708 CALL lbc_lnk( zbetup, 'T', 1. ) ; CALL lbc_lnk( zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 823 709 824 710 ! 3. monotonic flux in the i & j direction (paa & pbb) 825 711 ! ---------------------------------------- 826 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu)827 712 DO jk = 1, jpkm1 828 713 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
r7698 r7753 327 327 IF( ierr /= 0 ) CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 328 328 z1_t2 = 1._wp / ( rn_time * rn_time ) 329 !$OMP PARALLEL DO schedule(static) private(jj, ji, zfu, zfv)330 329 DO jj = 2, jpj ! "coriolis+ time^-1" at u- & v-points 331 330 DO ji = fs_2, jpi ! vector opt. … … 348 347 ! 349 348 z1_t2 = 1._wp / ( rn_time * rn_time ) 350 !$OMP PARALLEL DO schedule(static) private(jj, ji) 351 DO jj = 1, jpj 352 DO ji = 1, jpi 353 r1_ft(ji,jj) = 1._wp / SQRT( ff_t(ji,jj) * ff_t(ji,jj) + z1_t2 ) 354 END DO 355 END DO 349 r1_ft(:,:) = 1._wp / SQRT( ff_t(:,:) * ff_t(:,:) + z1_t2 ) 356 350 ! 357 351 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r7698 r7753 108 108 ! 109 109 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 110 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 111 DO jk = 1, jpk 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 xind(ji,jj,jk) = 1._wp ! set equal to 1 where up-stream is not needed 115 END DO 116 END DO 117 END DO 110 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 118 111 ! 119 112 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 120 113 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 121 !$OMP PARALLEL 122 !$OMP DO schedule(static) private(jj, ji) 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 upsmsk(ji,jj) = 0._wp ! not upstream by default 126 END DO 127 END DO 114 upsmsk(:,:) = 0._wp ! not upstream by default 128 115 ! 129 !$OMP DO schedule(static) private(jk,jj,ji)130 116 DO jk = 1, jpkm1 131 DO jj = 1, jpj 132 DO ji = 1, jpi 133 xind(ji,jj,jk) = 1._wp & ! =>1 where up-stream is not needed 134 & - MAX ( rnfmsk(ji,jj) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 135 & upsmsk(ji,jj) ) * tmask(ji,jj,jk) ! =>0 in some user defined area 136 END DO 137 END DO 138 END DO 139 !$OMP END DO NOWAIT 140 !$OMP END PARALLEL 117 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 118 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 119 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 in some user defined area 120 END DO 141 121 ENDIF 142 122 ! … … 156 136 ! 157 137 ! !-- first guess of the slopes 158 !$OMP PARALLEL 159 !$OMP DO schedule(static) private(jj, ji) 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 zwx(ji,jj,jpk) = 0._wp ! bottom values 163 zwy(ji,jj,jpk) = 0._wp 164 END DO 165 END DO 166 !$OMP DO schedule(static) private(jk, jj, ji) 138 zwx(:,:,jpk) = 0._wp ! bottom values 139 zwy(:,:,jpk) = 0._wp 167 140 DO jk = 1, jpkm1 ! interior values 168 141 DO jj = 1, jpjm1 … … 173 146 END DO 174 147 END DO 175 !$OMP END DO NOWAIT176 !$OMP END PARALLEL177 148 CALL lbc_lnk( zwx, 'U', -1. ) ! lateral boundary conditions (changed sign) 178 149 CALL lbc_lnk( zwy, 'V', -1. ) 179 150 ! !-- Slopes of tracer 180 !$OMP PARALLEL 181 !$OMP DO schedule(static) private(jj, ji) 182 DO jj = 1, jpj 183 DO ji = 1, jpi 184 zslpx(ji,jj,jpk) = 0._wp ! bottom values 185 zslpy(ji,jj,jpk) = 0._wp 186 END DO 187 END DO 188 !$OMP DO schedule(static) private(jk, jj, ji) 151 zslpx(:,:,jpk) = 0._wp ! bottom values 152 zslpy(:,:,jpk) = 0._wp 189 153 DO jk = 1, jpkm1 ! interior values 190 154 DO jj = 2, jpj … … 198 162 END DO 199 163 ! 200 !$OMP DO schedule(static) private(jk, jj, ji)201 164 DO jk = 1, jpkm1 !-- Slopes limitation 202 165 DO jj = 2, jpj … … 212 175 END DO 213 176 ! 214 !$OMP DO schedule(static) private(jk, jj, ji, z0u, zalpha, zu, zv, zzwx, zzwy, z0v)215 177 DO jk = 1, jpkm1 !-- MUSCL horizontal advective fluxes 216 178 DO jj = 2, jpjm1 … … 233 195 END DO 234 196 END DO 235 !$OMP END DO NOWAIT236 !$OMP END PARALLEL237 197 CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 238 198 ! 239 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)240 199 DO jk = 1, jpkm1 !-- Tracer advective trend 241 200 DO jj = 2, jpjm1 … … 260 219 ! 261 220 ! !-- first guess of the slopes 262 !$OMP PARALLEL 263 !$OMP DO schedule(static) private(jj, ji) 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 zwx(ji,jj, 1 ) = 0._wp ! surface & bottom boundary conditions 267 zwx(ji,jj,jpk) = 0._wp 268 END DO 269 END DO 270 !$OMP DO schedule(static) private(jk, jj, ji) 221 zwx(:,:, 1 ) = 0._wp ! surface & bottom boundary conditions 222 zwx(:,:,jpk) = 0._wp 271 223 DO jk = 2, jpkm1 ! interior values 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 275 END DO 276 END DO 224 zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 277 225 END DO 278 226 ! !-- Slopes of tracer 279 !$OMP END DO NOWAIT 280 !$OMP DO schedule(static) private(jj, ji) 281 DO jj = 1, jpj 282 DO ji = 1, jpi 283 zslpx(ji,jj,1) = 0._wp ! surface values 284 END DO 285 END DO 286 !$OMP DO schedule(static) private(jk, jj, ji) 227 zslpx(:,:,1) = 0._wp ! surface values 287 228 DO jk = 2, jpkm1 ! interior value 288 229 DO jj = 1, jpj … … 293 234 END DO 294 235 END DO 295 !$OMP DO schedule(static) private(jk, jj, ji)296 236 DO jk = 2, jpkm1 !-- Slopes limitation 297 237 DO jj = 1, jpj ! interior values … … 303 243 END DO 304 244 END DO 305 !$OMP DO schedule(static) private(jk, jj, ji, z0w, zalpha, zw, zzwx, zzwy)306 245 DO jk = 1, jpk-2 !-- vertical advective flux 307 246 DO jj = 2, jpjm1 … … 316 255 END DO 317 256 END DO 318 !$OMP END DO NOWAIT319 !$OMP END PARALLEL320 257 IF( ln_linssh ) THEN ! top values, linear free surface only 321 258 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 322 !$OMP PARALLEL DO schedule(static) private(jj, ji)323 259 DO jj = 1, jpj 324 260 DO ji = 1, jpi … … 327 263 END DO 328 264 ELSE ! no cavities: only at the ocean surface 329 !$OMP PARALLEL DO schedule(static) private(jj, ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 zwx(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 333 END DO 334 END DO 265 zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 335 266 ENDIF 336 267 ENDIF 337 268 ! 338 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)339 269 DO jk = 1, jpkm1 !-- vertical advective trend 340 270 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r7698 r7753 76 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 77 ! 78 INTEGER :: ji, jj , jk! dummy loop indices78 INTEGER :: ji, jj ! dummy loop indices 79 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt 80 80 !!---------------------------------------------------------------------- … … 84 84 IF( l_trdtra ) THEN ! Save the input temperature trend 85 85 CALL wrk_alloc( jpi,jpj,jpk, ztrdt ) 86 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 87 DO jk = 1, jpk 88 DO jj = 1, jpj 89 DO ji = 1, jpi 90 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 91 END DO 92 END DO 93 END DO 86 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 94 87 ENDIF 95 88 ! ! Add the geothermal trend on temperature 96 !$OMP PARALLEL DO schedule(static) private(jj, ji)97 89 DO jj = 2, jpjm1 98 90 DO ji = 2, jpim1 … … 104 96 ! 105 97 IF( l_trdtra ) THEN ! Send the trend for diagnostics 106 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 107 DO jk = 1, jpk 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 111 END DO 112 END DO 113 END DO 98 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 114 99 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 115 100 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) … … 177 162 CASE ( 1 ) !* constant flux 178 163 IF(lwp) WRITE(numout,*) ' *** constant heat flux = ', rn_geoflx_cst 179 !$OMP PARALLEL DO schedule(static) private(jj, ji) 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 qgh_trd0(ji,jj) = r1_rau0_rcp * rn_geoflx_cst 183 END DO 184 END DO 164 qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 185 165 ! 186 166 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 … … 199 179 200 180 CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data 201 !$OMP PARALLEL DO schedule(static) private(jj, ji) 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 qgh_trd0(ji,jj) = r1_rau0_rcp * sf_qgh(1)%fnow(ji,jj,1) * 1.e-3 ! conversion in W/m2 205 END DO 206 END DO 181 qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 207 182 ! 208 183 CASE DEFAULT -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r7698 r7753 105 105 !!---------------------------------------------------------------------- 106 106 INTEGER, INTENT( in ) :: kt ! ocean time-step 107 INTEGER :: ji, jj, jk ! dummy loop indices108 107 ! 109 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds … … 114 113 IF( l_trdtra ) THEN !* Save the input trends 115 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 116 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 117 DO jk = 1, jpk 118 DO jj = 1, jpj 119 DO ji = 1, jpi 120 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 121 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 122 END DO 123 END DO 124 END DO 115 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 116 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 125 117 ENDIF 126 118 … … 154 146 155 147 IF( l_trdtra ) THEN ! send the trends for further diagnostics 156 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 157 DO jk = 1, jpk 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 161 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 162 END DO 163 END DO 164 END DO 148 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 149 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 165 150 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 166 151 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) … … 210 195 DO jn = 1, kjpt ! tracer loop 211 196 ! ! =========== 212 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik)213 197 DO jj = 1, jpj 214 198 DO ji = 1, jpi … … 218 202 END DO 219 203 ! 220 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik)221 204 DO jj = 2, jpjm1 ! Compute the trend 222 205 DO ji = 2, jpim1 … … 374 357 ENDIF 375 358 ! !* bottom variables (T, S, alpha, beta, depth, velocity) 376 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik)377 359 DO jj = 1, jpj 378 360 DO ji = 1, jpi … … 392 374 IF( nn_bbl_ldf == 1 ) THEN ! diffusive bbl ! 393 375 ! !-------------------! 394 !$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign)395 376 DO jj = 1, jpjm1 ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 396 377 DO ji = 1, fs_jpim1 ! vector opt. … … 425 406 ! 426 407 CASE( 1 ) != use of upper velocity 427 !$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign,zsigna)428 408 DO jj = 1, jpjm1 ! criteria: grad(rho).grad(h)<0 and grad(rho).grad(h)<0 429 409 DO ji = 1, fs_jpim1 ! vector opt. … … 457 437 CASE( 2 ) != bbl velocity = F( delta rho ) 458 438 zgbbl = grav * rn_gambbl 459 !$OMP PARALLEL DO schedule(static) private(jj,ji,iid,iis,ikud,ikus,za,zb,zgdrho,ijd,ijs,ikvd,ikvs)460 439 DO jj = 1, jpjm1 ! criteria: rho_up > rho_down 461 440 DO ji = 1, fs_jpim1 ! vector opt. … … 554 533 555 534 ! !* vertical index of "deep" bottom u- and v-points 556 !$OMP PARALLEL DO schedule(static) private(jj,ji)557 535 DO jj = 1, jpjm1 ! (the "shelf" bottom k-indices are mbku and mbkv) 558 536 DO ji = 1, jpim1 … … 569 547 ! !* sign of grad(H) at u- and v-points 570 548 mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 571 !$OMP PARALLEL DO schedule(static) private(jj,ji)572 549 DO jj = 1, jpjm1 573 550 DO ji = 1, jpim1 … … 577 554 END DO 578 555 ! 579 !$OMP PARALLEL DO schedule(static) private(jj,ji)580 556 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 581 557 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) … … 587 563 ! 588 564 ! !* masked diffusive flux coefficients 589 !$OMP PARALLEL DO schedule(static) private(jj,ji) 590 DO jj = 1, jpj 591 DO ji = 1, jpi 592 ahu_bbl_0(ji,jj) = rn_ahtbbl * e2_e1u(ji,jj) * e3u_bbl_0(ji,jj) * umask(ji,jj,1) 593 ahv_bbl_0(ji,jj) = rn_ahtbbl * e1_e2v(ji,jj) * e3v_bbl_0(ji,jj) * vmask(ji,jj,1) 594 END DO 595 END DO 565 ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 566 ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 596 567 597 568 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r7698 r7753 102 102 IF( l_trdtra ) THEN !* Save ta and sa trends 103 103 CALL wrk_alloc( jpi,jpj,jpk,jpts, ztrdts ) 104 DO jn = 1, jpts 105 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 106 DO jk = 1, jpk 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 ztrdts(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) 110 END DO 111 END DO 112 END DO 113 END DO 104 ztrdts(:,:,:,:) = tsa(:,:,:,:) 114 105 ENDIF 115 106 ! !== input T-S data at kt ==! … … 120 111 CASE( 0 ) !* newtonian damping throughout the water column *! 121 112 DO jn = 1, jpts 122 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)123 113 DO jk = 1, jpkm1 124 114 DO jj = 2, jpjm1 … … 131 121 ! 132 122 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 133 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)134 123 DO jk = 1, jpkm1 135 124 DO jj = 2, jpjm1 … … 146 135 ! 147 136 CASE ( 2 ) !* no damping in the mixed layer *! 148 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)149 137 DO jk = 1, jpkm1 150 138 DO jj = 2, jpjm1 … … 163 151 ! 164 152 IF( l_trdtra ) THEN ! trend diagnostic 165 DO jn = 1, jpts 166 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 167 DO jk = 1, jpk 168 DO jj = 1, jpj 169 DO ji = 1, jpi 170 ztrdts(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) - ztrdts(ji,jj,jk,jn) 171 END DO 172 END DO 173 END DO 174 END DO 153 ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 175 154 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 176 155 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r7698 r7753 57 57 !!---------------------------------------------------------------------- 58 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 INTEGER :: jk, jj, ji ! dummy loop indices60 59 !! 61 60 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds … … 66 65 IF( l_trdtra ) THEN !* Save ta and sa trends 67 66 CALL wrk_alloc( jpi,jpj,jpk, ztrdt, ztrds ) 68 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 69 DO jk = 1, jpk 70 DO jj = 1, jpj 71 DO ji = 1, jpi 72 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 73 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 74 END DO 75 END DO 76 END DO 67 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 68 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 77 69 ENDIF 78 70 ! … … 89 81 ! 90 82 IF( l_trdtra ) THEN !* save the horizontal diffusive trends for further diagnostics 91 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 92 DO jk = 1, jpk 93 DO jj = 1, jpj 94 DO ji = 1, jpi 95 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 96 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 97 END DO 98 END DO 99 END DO 83 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 84 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 100 85 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 101 86 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r7698 r7753 125 125 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 126 126 ! 127 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 128 DO jk = 1, jpk 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 akz (ji,jj,jk) = 0._wp 132 ah_wslp2(ji,jj,jk) = 0._wp 133 END DO 134 END DO 135 END DO 127 akz (:,:,:) = 0._wp 128 ah_wslp2(:,:,:) = 0._wp 136 129 ENDIF 137 130 ! … … 158 151 IF( kpass == 1 ) THEN !== first pass only ==! 159 152 ! 160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w)161 153 DO jk = 2, jpkm1 162 154 DO jj = 2, jpjm1 … … 180 172 ! 181 173 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 182 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)183 174 DO jk = 2, jpkm1 184 175 DO jj = 2, jpjm1 … … 194 185 ! 195 186 IF( ln_traldf_blp ) THEN ! bilaplacian operator 196 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)197 187 DO jk = 2, jpkm1 198 188 DO jj = 1, jpjm1 … … 204 194 END DO 205 195 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3w_2, zcoef0)207 196 DO jk = 2, jpkm1 208 197 DO jj = 1, jpjm1 … … 217 206 ! 218 207 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 219 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 220 DO jk = 1, jpk 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 224 END DO 225 END DO 226 END DO 208 akz(:,:,:) = ah_wslp2(:,:,:) 227 209 ENDIF 228 210 ENDIF … … 236 218 !!---------------------------------------------------------------------- 237 219 !!gm : bug.... why (x,:,:)? (1,jpj,:) and (jpi,1,:) should be sufficient.... 238 !$OMP PARALLEL 239 !$OMP DO schedule(static) private(jk, jj) 240 DO jk = 1, jpk 241 DO jj = 1, jpj 242 zdit (1,jj,jk) = 0._wp ; zdit (jpi,jj,jk) = 0._wp 243 zdjt (1,jj,jk) = 0._wp ; zdjt (jpi,jj,jk) = 0._wp 244 END DO 245 END DO 220 zdit (1,:,:) = 0._wp ; zdit (jpi,:,:) = 0._wp 221 zdjt (1,:,:) = 0._wp ; zdjt (jpi,:,:) = 0._wp 246 222 !!end 247 223 248 224 ! Horizontal tracer gradient 249 !$OMP DO schedule(static) private(jk, jj, ji)250 225 DO jk = 1, jpkm1 251 226 DO jj = 1, jpjm1 … … 256 231 END DO 257 232 END DO 258 !$OMP END PARALLEL259 233 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 260 !$OMP PARALLEL DO schedule(static) private(jj, ji)261 234 DO jj = 1, jpjm1 ! bottom correction (partial bottom cell) 262 235 DO ji = 1, fs_jpim1 ! vector opt. … … 266 239 END DO 267 240 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 268 !$OMP PARALLEL DO schedule(static) private(jj, ji)269 241 DO jj = 1, jpjm1 270 242 DO ji = 1, fs_jpim1 ! vector opt. … … 280 252 !!---------------------------------------------------------------------- 281 253 ! 282 !$OMP PARALLEL283 254 DO jk = 1, jpkm1 ! Horizontal slab 284 255 ! 285 256 ! !== Vertical tracer gradient 286 !$OMP DO schedule(static) private(jj, ji) 287 DO jj = 1 , jpj 288 DO ji = 1, jpi 289 zdk1t(ji,jj) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) ! level jk+1 290 END DO 291 END DO 292 ! 293 IF( jk == 1 ) THEN 294 !$OMP DO schedule(static) private(jj, ji) 295 DO jj = 1 , jpj 296 DO ji = 1, jpi 297 zdkt(ji,jj) = zdk1t(ji,jj) ! surface: zdkt(jk=1)=zdkt(jk=2) 298 END DO 299 END DO 300 ELSE 301 !$OMP DO schedule(static) private(jj, ji) 302 DO jj = 1 , jpj 303 DO ji = 1, jpi 304 zdkt(ji,jj) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 305 END DO 306 END DO 257 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1) ! level jk+1 258 ! 259 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) ! surface: zdkt(jk=1)=zdkt(jk=2) 260 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 307 261 ENDIF 308 !$OMP DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2)309 262 DO jj = 1 , jpjm1 !== Horizontal fluxes 310 263 DO ji = 1, fs_jpim1 ! vector opt. … … 330 283 END DO 331 284 ! 332 !$OMP DO schedule(static) private(jj, ji)333 285 DO jj = 2 , jpjm1 !== horizontal divergence and add to pta 334 286 DO ji = fs_2, fs_jpim1 ! vector opt. … … 344 296 !!---------------------------------------------------------------------- 345 297 ! 346 !$OMP DO schedule(static) private(jk, jj) 347 DO jk = 1, jpk 348 DO jj = 1, jpj 349 ztfw(1,jj,jk) = 0._wp ; ztfw(jpi,jj,jk) = 0._wp 350 END DO 351 END DO 298 ztfw(1,:,:) = 0._wp ; ztfw(jpi,:,:) = 0._wp 352 299 ! 353 300 ! Vertical fluxes 354 301 ! --------------- 355 302 ! ! Surface and bottom vertical fluxes set to zero 356 !$OMP DO schedule(static) private(jj, ji) 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 ztfw(ji,jj, 1 ) = 0._wp ; ztfw(ji,jj,jpk) = 0._wp 360 END DO 361 END DO 303 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 362 304 363 !$OMP DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w, zcoef3, zcoef4)364 305 DO jk = 2, jpkm1 ! interior (2=<jk=<jpk-1) 365 306 DO jj = 2, jpjm1 … … 386 327 END DO 387 328 END DO 388 !$OMP END PARALLEL389 329 ! !== add the vertical 33 flux ==! 390 330 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 391 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)392 331 DO jk = 2, jpkm1 393 332 DO jj = 1, jpjm1 … … 403 342 SELECT CASE( kpass ) 404 343 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 405 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)406 344 DO jk = 2, jpkm1 407 345 DO jj = 1, jpjm1 … … 414 352 END DO 415 353 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb and ptbb gradients, resp. 416 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)417 354 DO jk = 2, jpkm1 418 355 DO jj = 1, jpjm1 … … 427 364 ENDIF 428 365 ! 429 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)430 366 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to pta ==! 431 367 DO jj = 2, jpjm1 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r7698 r7753 121 121 IF( l_trdtra ) THEN 122 122 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 123 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 124 DO jk = 1, jpk 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 ztrdt(ji,jj,jk) = 0._wp 128 ztrds(ji,jj,jk) = 0._wp 129 END DO 130 END DO 131 END DO 123 ztrdt(:,:,jk) = 0._wp 124 ztrds(:,:,jk) = 0._wp 132 125 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 133 126 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) … … 136 129 ! total trend for the non-time-filtered variables. 137 130 zfact = 1.0 / rdt 138 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)139 131 DO jk = 1, jpkm1 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 ztrdt(ji,jj,jk) = ( tsa(ji,jj,jk,jp_tem) - tsn(ji,jj,jk,jp_tem) ) * zfact 143 ztrds(ji,jj,jk) = ( tsa(ji,jj,jk,jp_sal) - tsn(ji,jj,jk,jp_sal) ) * zfact 144 END DO 145 END DO 132 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 133 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 146 134 END DO 147 135 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) … … 149 137 ! Store now fields before applying the Asselin filter 150 138 ! in order to calculate Asselin filter trend later. 151 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 152 DO jk = 1, jpkm1 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 ztrdt(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) 156 ztrds(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 157 END DO 158 END DO 159 END DO 139 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 140 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 160 141 ENDIF 161 142 162 143 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap) 163 144 DO jn = 1, jpts 164 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)165 145 DO jk = 1, jpkm1 166 DO jj = 1, jpj 167 DO ji = 1, jpi 168 tsn(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) 169 END DO 170 END DO 146 tsn(:,:,jk,jn) = tsa(:,:,jk,jn) 171 147 END DO 172 148 END DO … … 187 163 ! 188 164 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 189 !$OMP PARALLEL DO schedule(static) private(jk, zfact)190 165 DO jk = 1, jpkm1 191 DO jj = 1, jpj 192 DO ji = 1, jpi 193 zfact = 1._wp / r2dt 194 ztrdt(ji,jj,jk) = ( tsb(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) ) * zfact 195 ztrds(ji,jj,jk) = ( tsb(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) ) * zfact 196 END DO 197 END DO 166 zfact = 1._wp / r2dt 167 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 168 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 198 169 END DO 199 170 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) … … 243 214 DO jn = 1, kjpt 244 215 ! 245 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztn,ztd)246 216 DO jk = 1, jpkm1 247 217 DO jj = 2, jpjm1 … … 310 280 ! 311 281 DO jn = 1, kjpt 312 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact1,zfact2,ze3t_b,ze3t_n,ze3t_a,ze3t_d,ze3t_f,ztc_b,ztc_n,ztc_a,ztc_d,ztc_f)313 282 DO jk = 1, jpkm1 314 283 zfact1 = atfp * p2dt -
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 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r7710 r7753 88 88 IF( l_trdtra ) THEN !* Save ta and sa trends 89 89 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 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 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 95 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 96 END DO 97 END DO 98 END DO 90 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 91 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 99 92 ENDIF 100 93 ! 101 94 !!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 102 95 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 103 !$OMP PARALLEL DO schedule(static) private(jj, ji) 104 DO jj = 1, jpj 105 DO ji = 1, jpi 106 qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns 107 qsr(ji,jj) = 0._wp ! qsr set to zero 108 END DO 109 END DO 96 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 97 qsr(:,:) = 0._wp ! qsr set to zero 110 98 ENDIF 111 99 … … 119 107 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file' 120 108 zfact = 0.5_wp 121 DO jn = 1, jpts 122 !$OMP PARALLEL DO schedule(static) private(jj, ji) 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 sbc_tsc(ji,jj,jn) = 0._wp ! needed just to ensure haloes are consistent across restarts 126 END DO 127 END DO 128 END DO 109 sbc_tsc(:,:,:) = 0._wp 129 110 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 130 111 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 131 112 ELSE ! No restart or restart not found: Euler forward time stepping 132 113 zfact = 1._wp 133 DO jn = 1, jpts 134 !$OMP PARALLEL DO schedule(static) private(jj, ji) 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 sbc_tsc(ji,jj,jn) = 0._wp 138 sbc_tsc_b(ji,jj,jn) = 0._wp 139 END DO 140 END DO 141 END DO 114 sbc_tsc(:,:,:) = 0._wp 115 sbc_tsc_b(:,:,:) = 0._wp 142 116 ENDIF 143 117 ELSE !* other time-steps: swap of forcing fields 144 118 zfact = 0.5_wp 145 DO jn = 1, jpts 146 !$OMP PARALLEL DO schedule(static) private(jj, ji) 147 DO jj = 1, jpj 148 DO ji = 1, jpi 149 sbc_tsc_b(ji,jj,jn) = sbc_tsc(ji,jj,jn) 150 END DO 151 END DO 152 END DO 119 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 153 120 ENDIF 154 121 ! !== Now sbc tracer content fields ==! 155 !$OMP PARALLEL DO schedule(static) private(jj, ji)156 122 DO jj = 2, jpj 157 123 DO ji = fs_2, fs_jpim1 ! vector opt. … … 161 127 END DO 162 128 IF( ln_linssh ) THEN !* linear free surface 163 !$OMP PARALLEL DO schedule(static) private(jj, ji)164 129 DO jj = 2, jpj !==>> add concentration/dilution effect due to constant volume cell 165 130 DO ji = fs_2, fs_jpim1 ! vector opt. … … 173 138 ! 174 139 DO jn = 1, jpts !== update tracer trend ==! 175 !$OMP PARALLEL DO schedule(static) private(jj, ji)176 140 DO jj = 2, jpj 177 141 DO ji = fs_2, fs_jpim1 ! vector opt. … … 255 219 ! 256 220 IF( ln_iscpl .AND. ln_hsb) THEN ! input of heat and salt due to river runoff 257 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zdep)258 221 DO jk = 1,jpk 259 222 DO jj = 2, jpj … … 270 233 271 234 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 272 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 273 DO jk = 1, jpk 274 DO jj = 1, jpj 275 DO ji = 1, jpi 276 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 277 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 278 END DO 279 END DO 280 END DO 235 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 236 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 281 237 CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 282 238 CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r7698 r7753 58 58 INTEGER, INTENT( in ) :: kt ! ocean time-step index 59 59 ! 60 INTEGER :: jk , jj, ji! Dummy loop indices60 INTEGER :: jk ! Dummy loop indices 61 61 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 62 62 !!--------------------------------------------------------------------- … … 72 72 IF( l_trdtra ) THEN !* Save ta and sa trends 73 73 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 74 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 75 DO jk = 1, jpk 76 DO jj = 1, jpj 77 DO ji = 1, jpi 78 ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 79 ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 80 END DO 81 END DO 82 END DO 74 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 75 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 83 76 ENDIF 84 77 ! … … 91 84 ! JMM avoid negative salinities near river outlet ! Ugly fix 92 85 ! JMM : restore negative salinities to small salinities: 93 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 94 DO jk = 1, jpk 95 DO jj = 1, jpj 96 DO ji = 1, jpi 97 IF( tsa(ji,jj,jk,jp_sal) < 0._wp ) tsa(ji,jj,jk,jp_sal) = 0.1_wp 98 END DO 99 END DO 100 END DO 86 WHERE( tsa(:,:,:,jp_sal) < 0._wp ) tsa(:,:,:,jp_sal) = 0.1_wp 101 87 !!gm 102 88 103 89 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)105 90 DO jk = 1, jpkm1 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 ztrdt(ji,jj,jk) = ( ( tsa(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) / r2dt ) - ztrdt(ji,jj,jk) 109 ztrds(ji,jj,jk) = ( ( tsa(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) / r2dt ) - ztrds(ji,jj,jk) 110 END DO 111 END DO 91 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk) 92 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk) 112 93 END DO 113 94 !!gm this should be moved in trdtra.F90 and done on all trends -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r7698 r7753 106 106 ! 107 107 ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 108 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 109 !$OMP PARALLEL DO schedule(static) private(jj, ji) 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 zwt(ji,jj,2:jpk) = avt (ji,jj,2:jpk) 113 END DO 114 END DO 115 ELSE 116 !$OMP PARALLEL DO schedule(static) private(jj, ji) 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 zwt(ji,jj,2:jpk) = fsavs(ji,jj,2:jpk) 120 END DO 121 END DO 108 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ; zwt(:,:,2:jpk) = avt (:,:,2:jpk) 109 ELSE ; zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 122 110 ENDIF 123 !$OMP PARALLEL DO schedule(static) private(jj, ji) 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 zwt(ji,jj,1) = 0._wp 127 END DO 128 END DO 111 zwt(:,:,1) = 0._wp 129 112 ! 130 113 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 131 114 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 132 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)133 115 DO jk = 2, jpkm1 134 116 DO jj = 2, jpjm1 … … 139 121 END DO 140 122 ELSE ! standard or triad iso-neutral operator 141 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)142 123 DO jk = 2, jpkm1 143 124 DO jj = 2, jpjm1 … … 151 132 ! 152 133 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 153 !$OMP PARALLEL154 !$OMP DO schedule(static) private(jk, jj, ji)155 134 DO jk = 1, jpkm1 156 135 DO jj = 2, jpjm1 … … 183 162 ! used as a work space array: its value is modified. 184 163 ! 185 !$OMP DO schedule(static) private(jj, ji)186 164 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 187 165 DO ji = fs_2, fs_jpim1 ! done one for all passive tracers (so included in the IF instruction) … … 189 167 END DO 190 168 END DO 191 !$OMP END DO NOWAIT192 169 DO jk = 2, jpkm1 193 !$OMP DO schedule(static) private(jj, ji)194 170 DO jj = 2, jpjm1 195 171 DO ji = fs_2, fs_jpim1 … … 198 174 END DO 199 175 END DO 200 !$OMP END PARALLEL201 176 ! 202 177 ENDIF 203 178 ! 204 !$OMP PARALLEL205 !$OMP DO schedule(static) private(jj, ji)206 179 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 207 180 DO ji = fs_2, fs_jpim1 … … 210 183 END DO 211 184 DO jk = 2, jpkm1 212 !$OMP DO schedule(static) private(jj, ji, zrhs)213 185 DO jj = 2, jpjm1 214 186 DO ji = fs_2, fs_jpim1 … … 219 191 END DO 220 192 ! 221 !$OMP DO schedule(static) private(jj, ji)222 193 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 223 194 DO ji = fs_2, fs_jpim1 … … 226 197 END DO 227 198 DO jk = jpk-2, 1, -1 228 !$OMP DO schedule(static) private(jj, ji)229 199 DO jj = 2, jpjm1 230 200 DO ji = fs_2, fs_jpim1 … … 234 204 END DO 235 205 END DO 236 !$OMP END PARALLEL237 206 ! ! ================= ! 238 207 END DO ! end tracer loop ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r7698 r7753 101 101 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde') 102 102 ! 103 DO jn = 1, kjpt 104 !$OMP PARALLEL DO schedule(static) private(jj,ji) 105 DO jj = 1, jpjm1 106 DO ji = 1, jpim1 107 pgtu(ji,jj,jn)=0._wp ; zti (ji,jj,jn)=0._wp 108 pgtv(ji,jj,jn)=0._wp ; ztj (ji,jj,jn)=0._wp 109 END DO 110 END DO 111 END DO 112 !$OMP PARALLEL DO schedule(static) private(jj,ji) 113 DO jj = 1, jpjm1 114 DO ji = 1, jpim1 115 zhi (ji,jj )=0._wp 116 zhj (ji,jj )=0._wp 117 END DO 118 END DO 103 pgtu(:,:,:)=0._wp ; zti (:,:,:)=0._wp ; zhi (:,: )=0._wp 104 pgtv(:,:,:)=0._wp ; ztj (:,:,:)=0._wp ; zhj (:,: )=0._wp 119 105 ! 120 106 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 121 107 ! 122 !$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv,zmaxu,zmaxv)123 108 DO jj = 1, jpjm1 124 109 DO ji = 1, jpim1 … … 165 150 ! 166 151 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 167 !$OMP PARALLEL 168 !$OMP DO schedule(static) private(jj,ji) 169 DO jj = 1, jpjm1 170 DO ji = 1, jpim1 171 pgru(ji,jj) = 0._wp 172 pgrv(ji,jj) = 0._wp ! depth of the partial step level 173 END DO 174 END DO 175 !$OMP END DO NOWAIT 176 !$OMP DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv) 152 pgru(:,:) = 0._wp 153 pgrv(:,:) = 0._wp ! depth of the partial step level 177 154 DO jj = 1, jpjm1 178 155 DO ji = 1, jpim1 … … 189 166 END DO 190 167 END DO 191 !$OMP END DO NOWAIT192 !$OMP END PARALLEL193 168 ! 194 169 CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj 195 170 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 196 171 ! 197 !$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv)198 172 DO jj = 1, jpjm1 ! Gradient of density at the last level 199 173 DO ji = 1, jpim1
Note: See TracChangeset
for help on using the changeset viewer.
