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