diff --git a/components/cam/src/chemistry/mozart/wei96.F90 b/components/cam/src/chemistry/mozart/wei96.F90 index 1c911efc7468..8cd5a442a4f8 100644 --- a/components/cam/src/chemistry/mozart/wei96.F90 +++ b/components/cam/src/chemistry/mozart/wei96.F90 @@ -909,6 +909,7 @@ INTEGER FUNCTION JULDAY(MM,ID,IYYY) !----------------------------------------------------------------------- ! use shr_kind_mod, only: r8 => shr_kind_r8 + use cam_abortutils, only : endrun implicit none ! !------------------------------Arguments-------------------------------- @@ -926,7 +927,9 @@ INTEGER FUNCTION JULDAY(MM,ID,IYYY) ! !----------------------------------------------------------------------- ! - IF (IYYY.EQ.0) PAUSE 'There is no Year Zero.' + IF (IYYY.EQ.0) THEN + call endrun('There is no Year Zero.') + ENDIF IF (IYYY.LT.0) IYYY=IYYY+1 IF (MM.GT.2) THEN JY=IYYY diff --git a/components/cam/src/physics/cam/check_energy.F90 b/components/cam/src/physics/cam/check_energy.F90 index 81a805b7d1ba..68bb973e9a4c 100644 --- a/components/cam/src/physics/cam/check_energy.F90 +++ b/components/cam/src/physics/cam/check_energy.F90 @@ -590,7 +590,9 @@ subroutine check_energy_gmean(state, pbuf2d, dtime, nstep) !----------------------------------------------------------------------- ! Copy total energy out of input and output states +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do lchnk = begchunk, endchunk ncol = state(lchnk)%ncol ! input energy @@ -671,7 +673,9 @@ subroutine ieflx_gmean(state, tend, pbuf2d, cam_in, cam_out, nstep) snow = 0._r8 ienet = 0._r8 +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do lchnk = begchunk, endchunk ncol = state(lchnk)%ncol @@ -707,7 +711,9 @@ subroutine ieflx_gmean(state, tend, pbuf2d, cam_in, cam_out, nstep) call gmean(ienet, ieflx_glob) +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do lchnk = begchunk, endchunk ieflx = ieflx_glob @@ -787,7 +793,9 @@ subroutine qflx_gmean(state, tend, cam_in, dtime, nstep) qflx_glob = 0._r8 +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do lchnk = begchunk, endchunk ncol = state(lchnk)%ncol qflx(:ncol,lchnk) = cam_in(lchnk)%cflx(:ncol,1) diff --git a/components/cam/src/physics/cam/cldwat.F90 b/components/cam/src/physics/cam/cldwat.F90 index f61e7ffbdc93..14e4183843e7 100644 --- a/components/cam/src/physics/cam/cldwat.F90 +++ b/components/cam/src/physics/cam/cldwat.F90 @@ -1017,13 +1017,16 @@ subroutine findmcnew (lchnk ,ncol , & real(8) ftot ! inline statement functions - real(r8) heavy, heavym, a1, a2, heavyp, heavymp - heavy(a1,a2) = max(0._r8,sign(1._r8,a1-a2)) ! heavyside function - heavym(a1,a2) = max(0.01_r8,sign(1._r8,a1-a2)) ! modified heavyside function + real(r8) a1, a2, heavyp, heavymp + !real(r8) heavy, heavym + !heavy(a1,a2) = max(0._r8,sign(1._r8,a1-a2)) ! heavyside function + !heavym(a1,a2) = max(0.01_r8,sign(1._r8,a1-a2)) ! modified heavyside function ! ! New heavyside functions to perhaps address error growth problems ! +#ifdef PERGRO heavyp(a1,a2) = a1/(a2+a1+1.e-36_r8) +#endif heavymp(a1,a2) = (a1+0.01_r8*a2)/(a2+a1+1.e-36_r8) ! @@ -1047,7 +1050,9 @@ subroutine findmcnew (lchnk ,ncol , & end do !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do ii = 1,ncols i = ind(ii) ! @@ -1101,7 +1106,9 @@ subroutine findmcnew (lchnk ,ncol , & call get_rlat_all_p(lchnk, ncol, rlat) !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do ii = 1,ncols i = ind(ii) rhocgs = rho(i)*1.e-3_r8 ! density in cgs units diff --git a/components/cam/src/physics/cam/hk_conv.F90 b/components/cam/src/physics/cam/hk_conv.F90 index b581b5ea0ef7..b87652417c57 100644 --- a/components/cam/src/physics/cam/hk_conv.F90 +++ b/components/cam/src/physics/cam/hk_conv.F90 @@ -607,7 +607,9 @@ subroutine cmfmca(lchnk ,ncol , & ! cldwtr is temporarily equal to hlat*l (l=> liquid water) ! !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do ii=1,len1 i = indx1(ii) temp1 = vtemp4(i)/(1.0_r8 + gam(i,k)) @@ -637,7 +639,9 @@ subroutine cmfmca(lchnk ,ncol , & ! small amount of supersaturation acceptable (by ssfac factor) ! !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do ii=1,len1 i = indx1(ii) if (hb(i,k-1) < hbs(i,k-1)) then @@ -661,7 +665,9 @@ subroutine cmfmca(lchnk ,ncol , & ! so that the adjustment doesn't contribute to "kinks" in h ! !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do ii=1,len1 i = indx1(ii) g = min(0.0_r8,hb(i,k) - hb(i,k-1)) @@ -690,7 +696,9 @@ subroutine cmfmca(lchnk ,ncol , & ! physical states and adjust eta accordingly. ! !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do ii=1,len1 i = indx1(ii) beta(i) = max(0.0_r8,beta(i)) @@ -740,7 +748,9 @@ subroutine cmfmca(lchnk ,ncol , & ! Calculate cloud water, rain water, and thermodynamic changes ! !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do 30 ii=1,len1 i = indx1(ii) icwmr(i,k) = cldwtr(i)*rhlat @@ -828,7 +838,9 @@ subroutine cmfmca(lchnk ,ncol , & pm(:ncol,:) = pmid(:ncol,:) endif !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do 40 ii=1,len1 i = indx1(ii) ! @@ -924,7 +936,9 @@ subroutine cmfmca(lchnk ,ncol , & call qsat(vtemp1(:2*len1), vtemp2(:2*len1), & vtemp5(:2*len1), vtemp3(:2*len1), gam=vtemp4(:2*len1)) !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do ii=1,len1 i = indx1(ii) shbs(i,k ) = vtemp3(ii ) @@ -941,7 +955,9 @@ subroutine cmfmca(lchnk ,ncol , & ! ! Update thermodynamic information at half (i.e., interface) levels ! +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do ii=1,len1 i = indx1(ii) sbh (i,k) = 0.5_r8*(sb(i,k) + sb(i,k-1)) diff --git a/components/cam/src/physics/cam/nudging.F90 b/components/cam/src/physics/cam/nudging.F90 index 5942a5e3656a..a9c2b36e33ae 100644 --- a/components/cam/src/physics/cam/nudging.F90 +++ b/components/cam/src/physics/cam/nudging.F90 @@ -1177,8 +1177,7 @@ subroutine nudging_init call alloc_err(istat,'nudging_init','INTP_PS',2*pcols*((endchunk-begchunk)+1)) end if case default - call endrun('nudging_init error: nudge method should & - be either Step, Linear or IMT...') + call endrun('nudging_init error: nudge method should be either Step, Linear or IMT...') end select ! End Routine diff --git a/components/cam/src/physics/cam/phys_grid.F90 b/components/cam/src/physics/cam/phys_grid.F90 index bb98c53be128..25819a5a99f9 100644 --- a/components/cam/src/physics/cam/phys_grid.F90 +++ b/components/cam/src/physics/cam/phys_grid.F90 @@ -2499,8 +2499,10 @@ end subroutine update_cost_p ! ! if (numcols .gt. fdim) call endrun('buff_to_chunk') ! do m=1,mdim -!dir$ concurrent -!dir$ prefervector, preferstream +!#ifdef CPRCRAY +!!dir$ concurrent +!!dir$ prefervector, preferstream +!#endif ! do n = 1, numcols ! localchunks(columnid(n),m,chunkid(n)) = lbuff(n,m) ! end do @@ -2582,9 +2584,11 @@ subroutine scatter_field_to_chunk(fdim,mdim,ldim, & ! copy field into global (process-ordered) chunked data structure do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lid = pgcols(i)%ccol @@ -2611,9 +2615,11 @@ subroutine scatter_field_to_chunk(fdim,mdim,ldim, & ! copy into local chunked data structure +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,nlcols cid = pgcols(beglcol+i)%chunk lcid = chunks(cid)%lcid @@ -2634,9 +2640,11 @@ subroutine scatter_field_to_chunk(fdim,mdim,ldim, & ! local ordering) do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lcid = chunks(cid)%lcid @@ -2726,9 +2734,11 @@ subroutine scatter_field_to_chunk4(fdim,mdim,ldim, & if (masterproc) then ! copy field into global (process-ordered) chunked data structure do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lid = pgcols(i)%ccol @@ -2755,9 +2765,11 @@ subroutine scatter_field_to_chunk4(fdim,mdim,ldim, & ! copy into local chunked data structure +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,nlcols cid = pgcols(beglcol+i)%chunk lcid = chunks(cid)%lcid @@ -2777,9 +2789,11 @@ subroutine scatter_field_to_chunk4(fdim,mdim,ldim, & ! (pgcol ordering chosen to reflect begchunk:endchunk ! local ordering) do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lcid = chunks(cid)%lcid @@ -2870,9 +2884,11 @@ subroutine scatter_field_to_chunk_int(fdim,mdim,ldim, & ! copy field into global (process-ordered) chunked data structure do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lid = pgcols(i)%ccol @@ -2899,9 +2915,11 @@ subroutine scatter_field_to_chunk_int(fdim,mdim,ldim, & ! copy into local chunked data structure +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,nlcols cid = pgcols(beglcol+i)%chunk lcid = chunks(cid)%lcid @@ -2921,9 +2939,11 @@ subroutine scatter_field_to_chunk_int(fdim,mdim,ldim, & ! (pgcol ordering chosen to reflect begchunk:endchunk ! local ordering) do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR !DIR$ PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lcid = chunks(cid)%lcid @@ -3001,8 +3021,10 @@ end subroutine scatter_field_to_chunk_int ! ! if (numcols .gt. fdim) call endrun('chunk_to_buff') ! do m=1,mdim -!dir$ concurrent -!dir$ prefervector, preferstream +!#ifdef CPRCRAY +!!dir$ concurrent +!!dir$ prefervector, preferstream +!#endif ! do n = 1, numcols ! lbuff(n,m) = localchunks(columnid(n),m,chunkid(n)) ! end do @@ -3085,8 +3107,10 @@ subroutine gather_chunk_to_field(fdim,mdim,ldim, & ! copy into local gather data structure do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,nlcols cid = pgcols(beglcol+i)%chunk lcid = chunks(cid)%lcid @@ -3110,8 +3134,10 @@ subroutine gather_chunk_to_field(fdim,mdim,ldim, & ! copy gathered columns into lon/lat field +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lid = pgcols(i)%ccol @@ -3135,8 +3161,10 @@ subroutine gather_chunk_to_field(fdim,mdim,ldim, & ! (pgcol ordering chosen to reflect begchunk:endchunk ! local ordering) do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lcid = chunks(cid)%lcid @@ -3232,8 +3260,10 @@ subroutine gather_chunk_to_field4 (fdim,mdim,ldim, & ! copy into local gather data structure do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,nlcols cid = pgcols(beglcol+i)%chunk lcid = chunks(cid)%lcid @@ -3257,8 +3287,10 @@ subroutine gather_chunk_to_field4 (fdim,mdim,ldim, & ! copy gathered columns into lon/lat field +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lid = pgcols(i)%ccol @@ -3283,8 +3315,10 @@ subroutine gather_chunk_to_field4 (fdim,mdim,ldim, & ! local ordering) do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lcid = chunks(cid)%lcid @@ -3378,8 +3412,10 @@ subroutine gather_chunk_to_field_int (fdim,mdim,ldim, & ! copy into local gather data structure do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,nlcols cid = pgcols(beglcol+i)%chunk lcid = chunks(cid)%lcid @@ -3403,8 +3439,10 @@ subroutine gather_chunk_to_field_int (fdim,mdim,ldim, & ! copy gathered columns into lon/lat field +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lid = pgcols(i)%ccol @@ -3428,8 +3466,10 @@ subroutine gather_chunk_to_field_int (fdim,mdim,ldim, & ! (pgcol ordering chosen to reflect begchunk:endchunk ! local ordering) do l=1,ldim +#ifdef CPRCRAY !DIR$ PREFERVECTOR, PREFERSTREAM !DIR$ CONCURRENT +#endif do i=1,ngcols_p cid = pgcols(i)%chunk lcid = chunks(cid)%lcid diff --git a/components/cam/src/physics/cam/qneg3.F90 b/components/cam/src/physics/cam/qneg3.F90 index 9907f02dd78b..0a6f6b5c1f9f 100644 --- a/components/cam/src/physics/cam/qneg3.F90 +++ b/components/cam/src/physics/cam/qneg3.F90 @@ -74,10 +74,14 @@ subroutine qneg3 (subnam ,idx ,ncol ,ncold ,lver ,lconst_beg , & ! Test all field values for being less than minimum value. Set q = qmin ! for all such points. Trace offenders and identify worst one. ! +#ifdef CPRCRAY !DIR$ preferstream +#endif do k=1,lver nval(k) = 0 +#ifdef CPRCRAY !DIR$ prefervector +#endif nn = 0 do i=1,ncol if (q(i,k,m) < qmin(m)) then diff --git a/components/cam/src/physics/cam/zm_conv.F90 b/components/cam/src/physics/cam/zm_conv.F90 index 860fe3ab68e4..0843e6fb6993 100644 --- a/components/cam/src/physics/cam/zm_conv.F90 +++ b/components/cam/src/physics/cam/zm_conv.F90 @@ -924,7 +924,9 @@ subroutine zm_convr(lchnk ,ncol , & ! gather back temperature and mixing ratio. ! do k = msg + 1,pver +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do i = 1,lengath ! ! q is updated to compute net precip. @@ -948,7 +950,9 @@ subroutine zm_convr(lchnk ,ncol , & end do end do ! +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do i = 1,lengath jctop(ideep(i)) = jt(i) !++bee @@ -1412,7 +1416,9 @@ subroutine convtran(lchnk , & end do ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! +#ifdef CPRCRAY !DIR$ NOINTERCHANGE +#endif do k = kbm,pver km1 = max(1,k-1) do i = il1g,il2g @@ -1448,7 +1454,9 @@ subroutine convtran(lchnk , & dqdt(:,:,m) = 0._r8 do k = 1,pver kp1 = min(pver,k+1) +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do i = il1g,il2g dqdt(ideep(i),k,m) = dcondt(i,k) end do @@ -1773,7 +1781,9 @@ subroutine momtran(lchnk, ncol, & ! dcont for bottom layer ! +#ifdef CPRCRAY !DIR$ NOINTERCHANGE +#endif do k = kbm,pver km1 = max(1,k-1) do i = il1g,il2g @@ -3232,7 +3242,9 @@ subroutine q1q2_pjr(lchnk , & end do ! +#ifdef CPRCRAY !DIR$ NOINTERCHANGE! +#endif do k = kbm,pver do i = il1g,il2g if (k == mx(i)) then diff --git a/components/cam/src/physics/clubb/advance_clubb_core_module.F90 b/components/cam/src/physics/clubb/advance_clubb_core_module.F90 index 9560c4561df4..b13eaab53e63 100644 --- a/components/cam/src/physics/clubb/advance_clubb_core_module.F90 +++ b/components/cam/src/physics/clubb/advance_clubb_core_module.F90 @@ -1612,7 +1612,7 @@ subroutine advance_clubb_core & rtm_pert_neg_rt = pdf_params_frz%rt_2 & - Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt_2, rt_tol**2 ) ) !Lscale_weight = pdf_params%mixt_frac - else where + elsewhere rtm_pert_pos_rt = pdf_params_frz%rt_2 & + Lscale_pert_coef * sqrt( max( pdf_params_frz%varnce_rt_2, rt_tol**2 ) ) thlm_pert_pos_rt = pdf_params_frz%thl_2 + ( sign_rtpthlp * Lscale_pert_coef & @@ -1634,7 +1634,7 @@ subroutine advance_clubb_core & rtm_pert_neg_rt = pdf_params%rt_2 & - Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt_2, rt_tol**2 ) ) !Lscale_weight = pdf_params%mixt_frac - else where + elsewhere rtm_pert_pos_rt = pdf_params%rt_2 & + Lscale_pert_coef * sqrt( max( pdf_params%varnce_rt_2, rt_tol**2 ) ) thlm_pert_pos_rt = pdf_params%thl_2 + ( sign_rtpthlp * Lscale_pert_coef & diff --git a/components/cam/src/physics/rrtmg/radiation.F90 b/components/cam/src/physics/rrtmg/radiation.F90 index 01ad9b87ece9..6a6f61023963 100644 --- a/components/cam/src/physics/rrtmg/radiation.F90 +++ b/components/cam/src/physics/rrtmg/radiation.F90 @@ -1581,9 +1581,13 @@ subroutine radiation_tend(state,ptend, pbuf, & ! convert radiative heating rates from Q*dp to Q for energy conservation if (conserve_energy) then +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do k =1 , pver +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do i = 1, ncol qrs(i,k) = qrs(i,k)/state%pdel(i,k) qrl(i,k) = qrl(i,k)/state%pdel(i,k) @@ -1614,9 +1618,13 @@ subroutine radiation_tend(state,ptend, pbuf, & ! convert radiative heating rates to Q*dp for energy conservation if (conserve_energy) then +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do k =1 , pver +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif do i = 1, ncol qrs(i,k) = qrs(i,k)*state%pdel(i,k) qrl(i,k) = qrl(i,k)*state%pdel(i,k) diff --git a/components/cam/src/utils/fft99.F90 b/components/cam/src/utils/fft99.F90 index f0f832d47875..64ddd3a81b6c 100644 --- a/components/cam/src/utils/fft99.F90 +++ b/components/cam/src/utils/fft99.F90 @@ -307,7 +307,9 @@ SUBROUTINE FFT99(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 10 M=1,N WORK(J)=A(I) I=I+INC @@ -358,7 +360,9 @@ SUBROUTINE FFT99(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 90 M=1,N A(J)=WORK(I) I=I+1 @@ -373,7 +377,9 @@ SUBROUTINE FFT99(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) IA=1 IB=N*INC+1 !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 120 L=1,LOT A(IA)=A(IB) A(IB+INC)=A(IA+INC) @@ -427,7 +433,9 @@ SUBROUTINE FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) JA=1 JB=2 !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 10 L=1,LOT WORK(JA)=A(IA)+A(IB) WORK(JB)=A(IA)-A(IB) @@ -451,7 +459,9 @@ SUBROUTINE FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) C=TRIGS(N+K) S=TRIGS(N+K+1) !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 20 L=1,LOT WORK(JA)=(A(IA)+A(IB))- & (S*(A(IA)-A(IB))+C*(A(IA+INC)+A(IB+INC))) @@ -477,7 +487,9 @@ SUBROUTINE FFT99A(A,WORK,TRIGS,INC,JUMP,N,LOT) IA=IABASE JA=JABASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 40 L=1,LOT WORK(JA)=2.0_r8*A(IA) WORK(JA+1)=-2.0_r8*A(IA+INC) @@ -525,7 +537,9 @@ SUBROUTINE FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) JA=1 JB=N*INC+1 !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 10 L=1,LOT A(JA)=SCALE*(WORK(IA)+WORK(IB)) A(JB)=SCALE*(WORK(IA)-WORK(IB)) @@ -552,7 +566,9 @@ SUBROUTINE FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) C=TRIGS(N+K) S=TRIGS(N+K+1) !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 20 L=1,LOT A(JA)=SCALE*((WORK(IA)+WORK(IB)) & +(C*(WORK(IA+1)+WORK(IB+1))+S*(WORK(IA)-WORK(IB)))) @@ -579,7 +595,9 @@ SUBROUTINE FFT99B(WORK,A,TRIGS,INC,JUMP,N,LOT) JA=JABASE SCALE=2.0_r8*SCALE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 40 L=1,LOT A(JA)=SCALE*WORK(IA) A(JA+INC)=-SCALE*WORK(IA+1) @@ -670,7 +688,9 @@ SUBROUTINE FFT991(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 10 M=1,N WORK(J)=A(I) I=I+INC @@ -721,7 +741,9 @@ SUBROUTINE FFT991(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 90 M=1,N A(J)=WORK(I) I=I+1 @@ -735,7 +757,9 @@ SUBROUTINE FFT991(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) 110 CONTINUE IB=N*INC+1 !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 120 L=1,LOT A(IB)=0.0_r8 A(IB+INC)=0.0_r8 @@ -998,7 +1022,9 @@ SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 15 IJK=1,LOT C(JA+J)=A(IA+I)+A(IB+I) D(JA+J)=B(IA+I)+B(IB+I) @@ -1021,7 +1047,9 @@ SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 25 IJK=1,LOT C(JA+J)=A(IA+I)+A(IB+I) D(JA+J)=B(IA+I)+B(IB+I) @@ -1049,7 +1077,9 @@ SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 55 IJK=1,LOT C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) D(JA+J)=B(IA+I)+(B(IB+I)+B(IC+I)) @@ -1077,7 +1107,9 @@ SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 65 IJK=1,LOT C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) D(JA+J)=B(IA+I)+(B(IB+I)+B(IC+I)) @@ -1117,7 +1149,9 @@ SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 95 IJK=1,LOT C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) C(JC+J)=(A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I)) @@ -1150,7 +1184,9 @@ SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 105 IJK=1,LOT C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) D(JA+J)=(B(IA+I)+B(IC+I))+(B(IB+I)+B(ID+I)) @@ -1198,7 +1234,9 @@ SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 135 IJK=1,LOT C(JA+J)=A(IA+I)+(A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)) D(JA+J)=B(IA+I)+(B(IB+I)+B(IE+I))+(B(IC+I)+B(ID+I)) @@ -1244,7 +1282,9 @@ SUBROUTINE VPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC,LA) I=IBASE J=JBASE !cdir nodep +#ifdef CPRCRAY !DIR$ CONCURRENT +#endif DO 145 IJK=1,LOT C(JA+J)=A(IA+I)+(A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)) D(JA+J)=B(IA+I)+(B(IB+I)+B(IE+I))+(B(IC+I)+B(ID+I)) diff --git a/components/cice/src/mpi/ice_boundary.F90 b/components/cice/src/mpi/ice_boundary.F90 index bc4ef41d39d1..c899af7eeeaa 100644 --- a/components/cice/src/mpi/ice_boundary.F90 +++ b/components/cice/src/mpi/ice_boundary.F90 @@ -2925,7 +2925,7 @@ subroutine ice_HaloUpdate3DR8(array, halo, & ioffset, joffset, &! address shifts for tripole isign ! sign factor for tripole grids - integer (int_kind), dimension(:), allocatable, save :: & + integer (int_kind), dimension(:), allocatable :: & sndRequest, &! MPI request ids rcvRequest ! MPI request ids @@ -2954,10 +2954,10 @@ subroutine ice_HaloUpdate3DR8(array, halo, & logical (log_kind) :: & do_allocate ! flag used to control alloc of 3D buffers #else - real (dbl_kind), dimension(:,:), allocatable, save :: & + real (dbl_kind), dimension(:,:), allocatable :: & bufSend, bufRecv ! 3d send,recv buffers - real (dbl_kind), dimension(:,:,:), allocatable, save :: & + real (dbl_kind), dimension(:,:,:), allocatable :: & bufTripole ! 3d tripole buffer #endif diff --git a/components/cice/src/source/ice_atmo.F90 b/components/cice/src/source/ice_atmo.F90 index 2b3c9b08e6bf..65397acce1a5 100644 --- a/components/cice/src/source/ice_atmo.F90 +++ b/components/cice/src/source/ice_atmo.F90 @@ -325,7 +325,9 @@ subroutine atmo_boundary_layer (nx_block, ny_block, & enddo enddo +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -348,7 +350,9 @@ subroutine atmo_boundary_layer (nx_block, ny_block, & endif ! calc_strair +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -469,7 +473,9 @@ subroutine atmo_boundary_const (nx_block, ny_block, & enddo enddo +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -500,7 +506,9 @@ subroutine atmo_boundary_const (nx_block, ny_block, & Lheat = Lvap ! liquid to vapor endif ! sfctype +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_dyn_evp.F90 b/components/cice/src/source/ice_dyn_evp.F90 index ad71bdf3ebe6..eb73b50f21ac 100644 --- a/components/cice/src/source/ice_dyn_evp.F90 +++ b/components/cice/src/source/ice_dyn_evp.F90 @@ -1409,7 +1409,9 @@ subroutine stress (phase, ilo, ihi, jlo, jhi, & str8(:,:,:) = c0 endif +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icellt diff --git a/components/cice/src/source/ice_flux.F90 b/components/cice/src/source/ice_flux.F90 index b2470aff80c8..54da4c8a0a48 100644 --- a/components/cice/src/source/ice_flux.F90 +++ b/components/cice/src/source/ice_flux.F90 @@ -941,7 +941,9 @@ subroutine merge_fluxes (nx_block, ny_block, & ! Merge fluxes !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1093,7 +1095,9 @@ subroutine scale_fluxes (nx_block, ny_block, & i, j ! horizontal indices +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do j = 1, ny_block diff --git a/components/cice/src/source/ice_forcing.F90 b/components/cice/src/source/ice_forcing.F90 index 80d8a1427cb8..3d74c3e69811 100644 --- a/components/cice/src/source/ice_forcing.F90 +++ b/components/cice/src/source/ice_forcing.F90 @@ -3248,12 +3248,12 @@ subroutine ocn_data_ncar_init ! ! 1 sst------temperature---------------------------(C) \\ ! 2 sss------salinity------------------------------(ppt) \\ -! 3 hbl------depth---------------------------------(m) \\ +! 3 hbl------depth---------------------------------(m) \\ ! 4 u--------surface u current---------------------(m/s) \\ ! 5 v--------surface v current---------------------(m/s) \\ ! 6 dhdx-----surface tilt x direction--------------(m/m) \\ ! 7 dhdy-----surface tilt y direction--------------(m/m) \\ -! 8 qdp------ocean sub-mixed layer heat flux-------(W/m2)\\ +! 8 qdp------ocean sub-mixed layer heat flux-------(W/m2)\\ ! ! Fields 4, 5, 6, 7 are on the U-grid; 1, 2, 3, and 8 are ! on the T-grid. diff --git a/components/cice/src/source/ice_init.F90 b/components/cice/src/source/ice_init.F90 index c50be2723262..6ae1f40635dd 100644 --- a/components/cice/src/source/ice_init.F90 +++ b/components/cice/src/source/ice_init.F90 @@ -1205,7 +1205,9 @@ subroutine set_state_var (nx_block, ny_block, & do n = 1, ncat ! ice volume, snow volume +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_itd.F90 b/components/cice/src/source/ice_itd.F90 index d3a814553310..f66c10092240 100644 --- a/components/cice/src/source/ice_itd.F90 +++ b/components/cice/src/source/ice_itd.F90 @@ -390,7 +390,9 @@ subroutine aggregate (nx_block, ny_block, & do n = 1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -403,7 +405,9 @@ subroutine aggregate (nx_block, ny_block, & do it = 1, ntrcr if (trcr_depend(it) == 0) then ! ice area tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -414,7 +418,9 @@ subroutine aggregate (nx_block, ny_block, & enddo ! ij elseif (trcr_depend(it) == 1) then ! ice volume tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -426,7 +432,9 @@ subroutine aggregate (nx_block, ny_block, & elseif (trcr_depend(it) ==2) then ! snow volume tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -440,7 +448,9 @@ subroutine aggregate (nx_block, ny_block, & enddo ! ntrcr do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -451,7 +461,9 @@ subroutine aggregate (nx_block, ny_block, & enddo ! nilyr do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1209,7 +1221,9 @@ subroutine shift_ice (nx_block, ny_block, & endif ! tmask enddo +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, ishift @@ -1239,7 +1253,9 @@ subroutine shift_ice (nx_block, ny_block, & enddo ! ij do it = 1, ntrcr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, ishift @@ -1268,7 +1284,9 @@ subroutine shift_ice (nx_block, ny_block, & enddo ! ntrcr do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, ishift @@ -1292,7 +1310,9 @@ subroutine shift_ice (nx_block, ny_block, & enddo ! nilyr do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, ishift @@ -1994,7 +2014,9 @@ subroutine zap_small_areas (nx_block, ny_block, & !----------------------------------------------------------------- do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2013,7 +2035,9 @@ subroutine zap_small_areas (nx_block, ny_block, & !----------------------------------------------------------------- do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2031,7 +2055,9 @@ subroutine zap_small_areas (nx_block, ny_block, & ! Zap ice and snow volume, add water and salt to ocean !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2053,7 +2079,9 @@ subroutine zap_small_areas (nx_block, ny_block, & enddo ! ij if (tr_aero) then +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2118,7 +2146,9 @@ subroutine zap_small_areas (nx_block, ny_block, & !----------------------------------------------------------------- do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2139,7 +2169,9 @@ subroutine zap_small_areas (nx_block, ny_block, & !----------------------------------------------------------------- do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2159,7 +2191,9 @@ subroutine zap_small_areas (nx_block, ny_block, & ! Zap ice and snow volume, add water and salt to ocean !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2182,7 +2216,9 @@ subroutine zap_small_areas (nx_block, ny_block, & ! Note: Tracers are unchanged. +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu if (tr_aero) then @@ -2207,7 +2243,9 @@ subroutine zap_small_areas (nx_block, ny_block, & ! Correct aice !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_mechred.F90 b/components/cice/src/source/ice_mechred.F90 index ee8612efdb03..879990a926f1 100644 --- a/components/cice/src/source/ice_mechred.F90 +++ b/components/cice/src/source/ice_mechred.F90 @@ -623,7 +623,9 @@ subroutine asum_ridging (nx_block, ny_block, & !----------------------------------------------------------------- do n = 1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -873,7 +875,9 @@ subroutine ridge_itd (nx_block, ny_block, & ! Ignore categories with very small areas. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -887,7 +891,9 @@ subroutine ridge_itd (nx_block, ny_block, & enddo do n = 1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -907,7 +913,9 @@ subroutine ridge_itd (nx_block, ny_block, & work(ij) = c1 / Gsum(ij,ncat) enddo do n = 0, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -959,7 +967,9 @@ subroutine ridge_itd (nx_block, ny_block, & xtmp = c1 / (c1 - exp(-astari)) do n = -1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1073,7 +1083,9 @@ subroutine ridge_itd (nx_block, ny_block, & enddo do n = 1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1292,7 +1304,9 @@ subroutine ridge_shift (nx_block, ny_block, & ! NOTE: 0 < aksum <= 1 !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1322,7 +1336,9 @@ subroutine ridge_shift (nx_block, ny_block, & ! would be removed. Reduce the opening rate proportionately. !----------------------------------------------------------------- do n = 1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1345,7 +1361,9 @@ subroutine ridge_shift (nx_block, ny_block, & ! Compute change in open water area due to closing and opening. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1426,7 +1444,9 @@ subroutine ridge_shift (nx_block, ny_block, & endif enddo ! ij +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1534,7 +1554,9 @@ subroutine ridge_shift (nx_block, ny_block, & !----------------------------------------------------------------- do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1555,7 +1577,9 @@ subroutine ridge_shift (nx_block, ny_block, & !----------------------------------------------------------------- do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1577,7 +1601,9 @@ subroutine ridge_shift (nx_block, ny_block, & do it = 1, ntrcr if (trcr_depend(it) == 0) then ! ice area tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1589,7 +1615,9 @@ subroutine ridge_shift (nx_block, ny_block, & enddo elseif (trcr_depend(it) == 1) then ! ice volume tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1601,7 +1629,9 @@ subroutine ridge_shift (nx_block, ny_block, & enddo elseif (trcr_depend(it) == 2) then ! snow volume tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1697,7 +1727,9 @@ subroutine ridge_shift (nx_block, ny_block, & ! Transfer ice area, ice volume, and snow volume to category nr. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1713,7 +1745,9 @@ subroutine ridge_shift (nx_block, ny_block, & ! Transfer ice energy to category nr !----------------------------------------------------------------- do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1728,7 +1762,9 @@ subroutine ridge_shift (nx_block, ny_block, & ! Transfer snow energy to category nr !----------------------------------------------------------------- do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1749,7 +1785,9 @@ subroutine ridge_shift (nx_block, ny_block, & do it = 1, ntrcr if (trcr_depend(it) == 0) then ! ice area tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1761,7 +1799,9 @@ subroutine ridge_shift (nx_block, ny_block, & enddo elseif (trcr_depend(it) == 1) then ! ice volume tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1773,7 +1813,9 @@ subroutine ridge_shift (nx_block, ny_block, & enddo elseif (trcr_depend(it) == 2) then ! snow volume tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iridge @@ -1999,7 +2041,9 @@ subroutine ice_strength (nx_block, ny_block, & if (krdg_redist==0) then ! Hibler 1980 formulation do n = 1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2019,7 +2063,9 @@ subroutine ice_strength (nx_block, ny_block, & elseif (krdg_redist==1) then ! exponential formulation do n = 1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2039,7 +2085,9 @@ subroutine ice_strength (nx_block, ny_block, & endif ! krdg_redist +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_ocean.F90 b/components/cice/src/source/ice_ocean.F90 index e59f50b03827..6d0681578265 100644 --- a/components/cice/src/source/ice_ocean.F90 +++ b/components/cice/src/source/ice_ocean.F90 @@ -187,7 +187,9 @@ subroutine ocean_mixed_layer (dt) ! Compute ocean fluxes and update SST !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_orbital.F90 b/components/cice/src/source/ice_orbital.F90 index 86ce680c53a1..c826a04183a1 100644 --- a/components/cice/src/source/ice_orbital.F90 +++ b/components/cice/src/source/ice_orbital.F90 @@ -159,7 +159,9 @@ subroutine compute_coszen (nx_block, ny_block, & coszen(:,:) = c0 ! sun at horizon +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_shortwave.F90 b/components/cice/src/source/ice_shortwave.F90 index ac654300027f..8bd882aec412 100644 --- a/components/cice/src/source/ice_shortwave.F90 +++ b/components/cice/src/source/ice_shortwave.F90 @@ -714,7 +714,9 @@ subroutine compute_albedos (nx_block, ny_block, & ! Compute albedo for each thickness category. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -882,7 +884,9 @@ subroutine constant_albedos (nx_block, ny_block, & ! Compute albedo for each thickness category. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1103,7 +1107,9 @@ subroutine absorbed_solar (nx_block, ny_block, & !----------------------------------------------------------------- do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1122,7 +1128,9 @@ subroutine absorbed_solar (nx_block, ny_block, & enddo ! ij enddo ! nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1144,7 +1152,9 @@ subroutine absorbed_solar (nx_block, ny_block, & if (.not. heat_capacity) then +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1672,7 +1682,9 @@ subroutine shortwave_dEdd (nx_block, ny_block, & aero_mp(:,:,:) = c0 if( tr_aero ) then +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu ! assume 4 layers for each aerosol, a snow SSL, snow below SSL, @@ -1695,7 +1707,9 @@ subroutine shortwave_dEdd (nx_block, ny_block, & ! compute shortwave radiation accounting for snow/ice (both snow over ! ice and bare ice) and ponded ice (if any): +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu ! find bare ice points @@ -1734,7 +1748,9 @@ subroutine shortwave_dEdd (nx_block, ny_block, & Iswabs) if (tflag) call t_stopf('cice_swdedd_computedEdd1') +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells_DE @@ -1750,7 +1766,9 @@ subroutine shortwave_dEdd (nx_block, ny_block, & + awtvdf*avdfl(i,j) + awtidf*aidfl(i,j) enddo +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu ! find snow-covered ice points @@ -1788,7 +1806,9 @@ subroutine shortwave_dEdd (nx_block, ny_block, & Iswabs) if (tflag) call t_stopf('cice_swdedd_computedEdd2') +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells_DE @@ -1804,7 +1824,9 @@ subroutine shortwave_dEdd (nx_block, ny_block, & + awtvdf*avdfl(i,j) + awtidf*aidfl(i,j) enddo +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu ! find ponded points @@ -1842,7 +1864,9 @@ subroutine shortwave_dEdd (nx_block, ny_block, & Iswabs) if (tflag) call t_stopf('cice_swdedd_computedEdd3') +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells_DE @@ -3357,7 +3381,9 @@ subroutine compute_dEdd & enddo ! end spectral loop ns ! accumulate fluxes over bare sea ice +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells_DE @@ -3373,7 +3399,9 @@ subroutine compute_dEdd & enddo ! ij do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells_DE @@ -3384,7 +3412,9 @@ subroutine compute_dEdd & enddo ! k do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells_DE @@ -3402,7 +3432,9 @@ subroutine compute_dEdd & if (.not. heat_capacity) then +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells_DE @@ -3618,8 +3650,8 @@ subroutine solution_dEdd & real (kind=dbl_kind) :: & alpha , & ! term in direct reflectivity and transmissivity - gamma , & ! term in direct reflectivity and transmissivity - el , & ! term in alpha,gamma,n,u + gamma_fun, & ! term in direct reflectivity and transmissivity + el , & ! term in alpha,gamma_fun,n,u taus , & ! scaled extinction optical depth omgs , & ! scaled single particle scattering albedo asys , & ! scaled asymmetry parameter @@ -3640,7 +3672,7 @@ subroutine solution_dEdd & real (kind=dbl_kind) :: & alp , & ! temporary for alpha - gam , & ! temporary for gamma + gam , & ! temporary for gamma_fun ue , & ! temporary for u arg , & ! exponential argument extins , & ! extinction @@ -3679,7 +3711,7 @@ subroutine solution_dEdd & ! Delta-Eddington solution expressions alpha(w,uu,gg,e) = p75*w*uu*((c1 + gg*(c1-w))/(c1 - e*e*uu*uu)) - gamma(w,uu,gg,e) = p5*w*((c1 + c3*gg*(c1-w)*uu*uu) & + gamma_fun(w,uu,gg,e) = p5*w*((c1 + c3*gg*(c1-w)*uu*uu) & / (c1-e*e*uu*uu)) n(uu,et) = ((uu+c1)*(uu+c1)/et ) - ((uu-c1)*(uu-c1)*et) u(w,gg,e) = c1p5*(c1 - w*gg)/e @@ -3826,7 +3858,7 @@ subroutine solution_dEdd & ! evaluate rdir,tdir for direct beam trnlay(k,ij) = max(exp_min, exp(-ts/mu0n)) alp = alpha(ws,mu0n,gs,lm) - gam = gamma(ws,mu0n,gs,lm) + gam = gamma_fun(ws,mu0n,gs,lm) apg = alp + gam amg = alp - gam rdir(k,ij) = amg*(tdif_a(k,ij)*trnlay(k,ij) - c1) + & @@ -3849,7 +3881,7 @@ subroutine solution_dEdd & swt = swt + mu*gwt trn = max(exp_min, exp(-ts/mu)) alp = alpha(ws,mu,gs,lm) - gam = gamma(ws,mu,gs,lm) + gam = gamma_fun(ws,mu,gs,lm) apg = alp + gam amg = alp - gam rdr = amg*(tdif_a(k,ij)*trn-c1) + & @@ -4100,7 +4132,9 @@ subroutine shortwave_dEdd_set_snow(nx_block, ny_block, & enddo enddo +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4214,7 +4248,9 @@ subroutine shortwave_dEdd_set_pond(nx_block, ny_block, & enddo ! find pond fraction and depth for ice points +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_therm_itd.F90 b/components/cice/src/source/ice_therm_itd.F90 index 4c37cb45260c..ea9d0867ff76 100644 --- a/components/cice/src/source/ice_therm_itd.F90 +++ b/components/cice/src/source/ice_therm_itd.F90 @@ -294,7 +294,9 @@ subroutine linear_itd (nx_block, ny_block, & do n = 1, ncat-1 +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells ! aice(i,j) > puny @@ -387,7 +389,9 @@ subroutine linear_itd (nx_block, ny_block, & ! Compute hbnew(ncat) !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells ! aice(i,j) > puny @@ -443,7 +447,9 @@ subroutine linear_itd (nx_block, ny_block, & ! Find area lost due to melting of thin (category 1) ice !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iflag ! remap_flag = .true. @@ -517,7 +523,9 @@ subroutine linear_itd (nx_block, ny_block, & do n = 1, ncat-1 +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iflag ! remap_flag = .true. @@ -614,7 +622,9 @@ subroutine linear_itd (nx_block, ny_block, & ! Make sure hice(i,j,1) >= minimum ice thickness hi_min. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, iflag ! remap_flag = .true. @@ -999,7 +1009,9 @@ subroutine add_new_ice (nx_block, ny_block, & ! Compute the volume, area, and thickness of new ice. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1097,7 +1109,9 @@ subroutine add_new_ice (nx_block, ny_block, & do n = 1, ncat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, kcells @@ -1140,7 +1154,9 @@ subroutine add_new_ice (nx_block, ny_block, & enddo ! ij do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, kcells @@ -1160,7 +1176,9 @@ subroutine add_new_ice (nx_block, ny_block, & ! Assume that vsnon and esnon are unchanged. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, jcells @@ -1208,7 +1226,9 @@ subroutine add_new_ice (nx_block, ny_block, & enddo ! ij do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, jcells @@ -1364,7 +1384,9 @@ subroutine lateral_melt (nx_block, ny_block, & enddo endif +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1393,7 +1415,9 @@ subroutine lateral_melt (nx_block, ny_block, & enddo ! ij do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1412,7 +1436,9 @@ subroutine lateral_melt (nx_block, ny_block, & enddo ! nilyr do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_therm_vertical.F90 b/components/cice/src/source/ice_therm_vertical.F90 index e74664ac385a..1c85cb113598 100644 --- a/components/cice/src/source/ice_therm_vertical.F90 +++ b/components/cice/src/source/ice_therm_vertical.F90 @@ -766,7 +766,9 @@ subroutine frzmlt_bottom_lateral (nx_block, ny_block, & ! melting energy/unit area in each column, etot < 0 do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, imelt @@ -777,7 +779,9 @@ subroutine frzmlt_bottom_lateral (nx_block, ny_block, & enddo do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, imelt @@ -787,7 +791,9 @@ subroutine frzmlt_bottom_lateral (nx_block, ny_block, & enddo ! ij enddo ! nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, imelt @@ -803,7 +809,9 @@ subroutine frzmlt_bottom_lateral (nx_block, ny_block, & ! Limit bottom and lateral heat fluxes if necessary. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu @@ -949,7 +957,9 @@ subroutine init_vertical_profile(nx_block, ny_block, & !----------------------------------------------------------------- ! Load arrays for vertical thermo calculation. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -975,7 +985,9 @@ subroutine init_vertical_profile(nx_block, ny_block, & !----------------------------------------------------------------- do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1078,7 +1090,9 @@ subroutine init_vertical_profile(nx_block, ny_block, & endif ! tsno_low do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1097,7 +1111,9 @@ subroutine init_vertical_profile(nx_block, ny_block, & enddo ! nslyr do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1195,7 +1211,9 @@ subroutine init_vertical_profile(nx_block, ny_block, & ! initial energy per unit area of ice/snow, relative to 0 C !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -1646,7 +1664,9 @@ subroutine temperature_changes (nx_block, ny_block, & dflwout_dT, dfsens_dT, & dflat_dT, dfsurf_dT) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -1755,7 +1775,9 @@ subroutine temperature_changes (nx_block, ny_block, & if (calc_Tsfc) then +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -1832,7 +1854,9 @@ subroutine temperature_changes (nx_block, ny_block, & endif ! calc_Tsfc do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -1868,7 +1892,9 @@ subroutine temperature_changes (nx_block, ny_block, & enddo ! nslyr do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -1923,7 +1949,9 @@ subroutine temperature_changes (nx_block, ny_block, & if (calc_Tsfc) then +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -2045,7 +2073,9 @@ subroutine temperature_changes (nx_block, ny_block, & endif ! all_converged if (calc_Tsfc) then +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2141,7 +2171,9 @@ subroutine conductivity (nx_block, ny_block, & ! interior ice layers do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -2282,7 +2314,9 @@ subroutine surface_fluxes (nx_block, ny_block, & flwdabs , & ! downward longwave absorbed heat flx (W/m^2) tmpvar ! 1/TsfK +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -3012,7 +3046,9 @@ subroutine tridiag_solver (nx_block, ny_block, & real (kind=dbl_kind), dimension(isolve,nilyr+nslyr+1):: & wgamma ! temporary matrix variable +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -3021,7 +3057,9 @@ subroutine tridiag_solver (nx_block, ny_block, & enddo ! ij do k = 2, nmat +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -3033,7 +3071,9 @@ subroutine tridiag_solver (nx_block, ny_block, & enddo ! k do k = nmat-1, 1, -1 +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -3267,7 +3307,9 @@ subroutine zerolayer_temperature(nx_block, ny_block, & enddo ! ij +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -3328,7 +3370,9 @@ subroutine zerolayer_temperature(nx_block, ny_block, & ! initialize global convergence flag all_converged = .true. +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -3381,7 +3425,9 @@ subroutine zerolayer_temperature(nx_block, ny_block, & enddo ! ij +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, isolve @@ -3482,7 +3528,9 @@ subroutine zerolayer_temperature(nx_block, ny_block, & endif ! l_zerolayerchecks +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3672,7 +3720,9 @@ subroutine thickness_changes (nx_block, ny_block, & if (.not. l_brine) then do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3687,7 +3737,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3774,7 +3826,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo ! ij do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3810,7 +3864,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo ! nslyr do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3846,7 +3902,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo ! nilyr do k = nilyr, 1, -1 +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3869,7 +3927,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo ! nilyr do k = nslyr, 1, -1 +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3902,7 +3962,9 @@ subroutine thickness_changes (nx_block, ny_block, & !---! Add new snowfall at top surface. !---!----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3940,7 +4002,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3949,7 +4013,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo ! k do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4011,7 +4077,9 @@ subroutine thickness_changes (nx_block, ny_block, & if (heat_capacity) then do k = 1, nilyr-1 +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4056,7 +4124,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo do k = 1, nslyr-1 +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4091,7 +4161,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo do k = 1, nslyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4100,7 +4172,9 @@ subroutine thickness_changes (nx_block, ny_block, & enddo do k = 1, nilyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4219,7 +4293,9 @@ subroutine freeboard (nx_block, ny_block, & !----------------------------------------------------------------- do k = nslyr, 1, -1 +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4238,7 +4314,9 @@ subroutine freeboard (nx_block, ny_block, & ! Transfer volume and energy from snow to top ice layer. !----------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4351,7 +4429,9 @@ subroutine adjust_enthalpy (nx_block, ny_block, & enddo do k1 = 1, nlyr +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4454,7 +4534,9 @@ subroutine conservation_check_vthermo(nx_block, ny_block, & !---------------------------------------------------------------- ! If energy is not conserved, print diagnostics and exit. !---------------------------------------------------------------- +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -4577,7 +4659,9 @@ subroutine update_state_vthermo (nx_block, ny_block, & ij , & ! horizontal index, combines i and j loops k ! ice layer index +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/cice/src/source/ice_transport_remap.F90 b/components/cice/src/source/ice_transport_remap.F90 index 38ac42c66655..9468484d8274 100644 --- a/components/cice/src/source/ice_transport_remap.F90 +++ b/components/cice/src/source/ice_transport_remap.F90 @@ -1441,7 +1441,9 @@ subroutine construct_fields (nx_block, ny_block, & enddo enddo +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells ! Note: no tx or ty in ghost cells @@ -3384,7 +3386,9 @@ subroutine triangle_coordinates (nx_block, ny_block, & elseif (integral_order == 2) then ! quadratic (3-point formula) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu @@ -3415,7 +3419,9 @@ subroutine triangle_coordinates (nx_block, ny_block, & else ! cubic (4-point formula) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ng = 1, ngroups @@ -3570,7 +3576,9 @@ subroutine transport_integrals (nx_block, ny_block, & if (integral_order == 1) then ! linear (1-point formula) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells(ng) @@ -3598,7 +3606,9 @@ subroutine transport_integrals (nx_block, ny_block, & elseif (integral_order == 2) then ! quadratic (3-point formula) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells(ng) @@ -3645,7 +3655,9 @@ subroutine transport_integrals (nx_block, ny_block, & else ! cubic (4-point formula) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells(ng) @@ -3705,7 +3717,9 @@ subroutine transport_integrals (nx_block, ny_block, & do nt = 1, ntrace if (tracer_type(nt)==1) then ! does not depend on another tracer +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells(ng) @@ -3736,7 +3750,9 @@ subroutine transport_integrals (nx_block, ny_block, & elseif (tracer_type(nt)==2) then ! depends on another tracer nt1 = depend(nt) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells(ng) @@ -3758,7 +3774,9 @@ subroutine transport_integrals (nx_block, ny_block, & elseif (tracer_type(nt)==3) then ! depends on two tracers nt1 = depend(nt) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells(ng) @@ -3976,7 +3994,9 @@ subroutine update_fields (nx_block, ny_block, & elseif (tracer_type(nt)==2) then ! depends on another tracer nt1 = depend(nt) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells @@ -3995,7 +4015,9 @@ subroutine update_fields (nx_block, ny_block, & nt1 = depend(nt) nt2 = depend(nt1) +#ifdef CPRCRAY !DIR$ CONCURRENT !Cray +#endif !cdir nodep !NEC !ocl novrec !Fujitsu do ij = 1, icells diff --git a/components/clm/src/biogeophys/WaterBudgetMod.F90 b/components/clm/src/biogeophys/WaterBudgetMod.F90 index b9735cb4e30f..cc4aa030a499 100644 --- a/components/clm/src/biogeophys/WaterBudgetMod.F90 +++ b/components/clm/src/biogeophys/WaterBudgetMod.F90 @@ -105,8 +105,6 @@ module WaterBudgetMod real(r8) :: budg_stateL(s_size, p_size) real(r8), public :: budg_stateG(s_size, p_size) - logical,save :: first_time = .true. - !----- formats ----- character(*),parameter :: FA0= "(' ',12x,(3x,a10,2x),' | ',(3x,a10,2x))" character(*),parameter :: FF = "(' ',a12,f15.8,' | ',f18.2)" diff --git a/components/clm/src/main/clmfates_paraminterfaceMod.F90 b/components/clm/src/main/clmfates_paraminterfaceMod.F90 index b650bdc40a06..92967d2cf49e 100644 --- a/components/clm/src/main/clmfates_paraminterfaceMod.F90 +++ b/components/clm/src/main/clmfates_paraminterfaceMod.F90 @@ -188,7 +188,7 @@ subroutine ParametersFromNetCDF(filename, is_host_file, fates_params) logical, intent(in) :: is_host_file class(fates_parameters_type), intent(inout) :: fates_params - character(len=32) :: subname = 'clmfates_interface::ReadParameters' + character(len=40) :: subname = 'clmfates_interface::ReadParameters' character(len=256) :: locfn ! local file name type(file_desc_t) :: ncid ! pio netCDF file id integer :: dimid ! netCDF dimension id diff --git a/components/clm/src/main/initGridCellsMod.F90 b/components/clm/src/main/initGridCellsMod.F90 index 32135932d94c..8e7de3ad0570 100644 --- a/components/clm/src/main/initGridCellsMod.F90 +++ b/components/clm/src/main/initGridCellsMod.F90 @@ -1178,6 +1178,7 @@ subroutine CheckGhostSubgridHierarchy() enddo end subroutine CheckGhostSubgridHierarchy -#endif ! #ifdef USE_PETSC_LIB +#endif +!^ifdef USE_PETSC_LIB end module initGridCellsMod diff --git a/components/homme/src/share/compose_mod.F90 b/components/homme/src/share/compose_mod.F90 index 5158fb21d517..febf04f2c08f 100644 --- a/components/homme/src/share/compose_mod.F90 +++ b/components/homme/src/share/compose_mod.F90 @@ -341,6 +341,9 @@ subroutine compose_query_bufsz(sendsz, recvsz) call cedr_query_bufsz(ssz, rsz) sendsz = max(sendsz, ssz) recvsz = max(recvsz, rsz) +#else + sendsz = 0 + recvsz = 0 #endif end subroutine compose_query_bufsz