Ignore:
Timestamp:
2017-02-18T10:02:03+01:00 (5 years ago)
Author:
mocavero
Message:

update trunk with OpenMP parallelization

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/USR
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_closea.F90

    r7427 r7698  
    388388      ! 
    389389      DO jc = 1, jpncs 
     390!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    390391         DO jj = ncsj1(jc), ncsj2(jc) 
    391392            DO ji = ncsi1(jc), ncsi2(jc) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90

    r6960 r7698  
    103103      ENDIF 
    104104      !    
     105!$OMP PARALLEL 
     106!$OMP DO schedule(static) private(jj, ji, zim1, zjm1) 
    105107      DO jj = 1, jpj  
    106108         DO ji = 1, jpi  
     
    129131         END DO 
    130132      END DO 
     133!$OMP END DO NOWAIT 
    131134      ! 
    132135      !                       !== Horizontal scale factors ==! (in meters) 
    133136      !                      
    134137      !                                         ! constant grid spacing 
    135       pe1t(:,:) =  ze1     ;      pe2t(:,:) = ze1 
    136       pe1u(:,:) =  ze1     ;      pe2u(:,:) = ze1 
    137       pe1v(:,:) =  ze1     ;      pe2v(:,:) = ze1 
    138       pe1f(:,:) =  ze1     ;      pe2f(:,:) = ze1 
    139       ! 
    140       !                                         ! NO reduction of grid size in some straits  
     138!$OMP DO schedule(static) private(jj, ji) 
     139      DO jj = 1, jpj 
     140         DO ji = 1, jpi 
     141            pe1t(ji,jj) =  ze1     ;      pe2t(ji,jj) = ze1 
     142            pe1u(ji,jj) =  ze1     ;      pe2u(ji,jj) = ze1 
     143            pe1v(ji,jj) =  ze1     ;      pe2v(ji,jj) = ze1 
     144            pe1f(ji,jj) =  ze1     ;      pe2f(ji,jj) = ze1 
     145            ! 
     146            !                                         ! NO reduction of grid size in some straits  
     147            pe1e2u(ji,jj) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that 
     148            pe1e2v(ji,jj) = 0._wp                       !             require an initialization of INTENT(out) arguments 
     149         END DO 
     150      END DO 
     151!$OMP END PARALLEL 
    141152      ke1e2u_v = 0                              !    ==>> u_ & v_surfaces will be computed in dom_ghr routine 
    142       pe1e2u(:,:) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that 
    143       pe1e2v(:,:) = 0._wp                       !             require an initialization of INTENT(out) arguments 
    144153      ! 
    145154      ! 
     
    153162      zf0   = 2. * omega * SIN( rad * zphi0 )            !  compute f0 1st point south 
    154163      ! 
    155       pff_f(:,:) = ( zf0 + zbeta * ABS( pphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
    156       pff_t(:,:) = ( zf0 + zbeta * ABS( pphit(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
     164!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     165      DO jj = 1, jpj 
     166         DO ji = 1, jpi 
     167            pff_f(ji,jj) = ( zf0 + zbeta * ABS( pphif(ji,jj) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
     168            pff_t(ji,jj) = ( zf0 + zbeta * ABS( pphit(ji,jj) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
     169         END DO 
     170      END DO 
    157171      ! 
    158172      IF(lwp) WRITE(numout,*) '                           beta-plane used. beta = ', zbeta, ' 1/(s.m)' 
  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_istate.F90

    r6923 r7698  
    5555      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with an horizontally uniform T and S profiles' 
    5656      ! 
    57       pu  (:,:,:) = 0._wp        ! ocean at rest 
    58       pv  (:,:,:) = 0._wp 
    59       pssh(:,:)   = 0._wp 
     57!$OMP PARALLEL 
     58!$OMP DO schedule(static) private(jk,jj,ji) 
     59      DO jk = 1, jpk 
     60         DO jj = 1, jpj 
     61            DO ji = 1, jpi 
     62               pu  (ji,jj,jk) = 0._wp        ! ocean at rest 
     63               pv  (ji,jj,jk) = 0._wp 
     64            END DO 
     65         END DO 
     66      END DO 
     67!$OMP END DO NOWAIT 
     68!$OMP DO schedule(static) private(jj,ji) 
     69      DO jj = 1, jpj 
     70         DO ji = 1, jpi 
     71            pssh(ji,jj)   = 0._wp 
     72         END DO 
     73      END DO 
     74!$OMP END DO NOWAIT 
    6075      ! 
     76!$OMP DO schedule(static) private(jk,jj,ji) 
    6177      DO jk = 1, jpk             ! horizontally uniform T & S profiles 
    6278         DO jj = 1, jpj 
     
    7995         END DO 
    8096      END DO 
     97!$OMP END PARALLEL 
    8198      !    
    8299   END SUBROUTINE usr_def_istate 
  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90

    r7426 r7698  
    109109      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K) 
    110110      zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s 
     111!$OMP PARALLEL DO schedule(static) private(jj, ji, t_star) 
    111112      DO jj = 1, jpj 
    112113         DO ji = 1, jpi 
     
    137138 
    138139      ! freshwater (mass flux) and update of qns with heat content of emp 
    139       emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average) 
    140       sfx (:,:) = 0.0_wp                                   ! no salt flux 
    141       qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST 
     140!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     141      DO jj = 1, jpj 
     142         DO ji = 1, jpi 
     143            emp (ji,jj) = emp(ji,jj) - zsumemp * tmask(ji,jj,1)          ! freshwater flux (=0 in domain average) 
     144            sfx (ji,jj) = 0.0_wp                                         ! no salt flux 
     145            qns (ji,jj) = qns(ji,jj) - emp(ji,jj) * sst_m(ji,jj) * rcp   ! evap and precip are at SST 
     146         END DO 
     147      END DO 
    142148 
    143149 
     
    166172      ztau_sais = 0.015 
    167173      ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 
     174!$OMP PARALLEL 
     175!$OMP DO schedule(static) private(jj, ji) 
    168176      DO jj = 1, jpj 
    169177         DO ji = 1, jpi 
     
    177185      ! module of wind stress and wind speed at T-point 
    178186      zcoef = 1. / ( zrhoa * zcdrag )  
     187!$OMP DO schedule(static) private(jj, ji, ztx, zty, zmod) 
    179188      DO jj = 2, jpjm1 
    180189         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     
    186195         END DO 
    187196      END DO 
     197!$OMP END PARALLEL 
    188198      CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
    189199 
  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90

    r7200 r7698  
    199199      ! 
    200200      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D local workspace 
     201 
     202      INTEGER  ::   ji, jj 
    201203      !!---------------------------------------------------------------------- 
    202204      ! 
     
    206208      IF(lwp) WRITE(numout,*) '       GYRE case : closed flat box ocean without ocean cavities' 
    207209      ! 
    208       z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom 
     210!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     211      DO jj = 1, jpj 
     212         DO ji = 1, jpi 
     213            z2d(ji,jj) = REAL( jpkm1 , wp )          ! flat bottom 
     214         END DO 
     215      END DO 
    209216      ! 
    210217      CALL lbc_lnk( z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    211218      ! 
    212       k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
    213       ! 
    214       k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 
     219!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     220      DO jj = 1, jpj 
     221         DO ji = 1, jpi 
     222            k_bot(ji,jj) = INT( z2d(ji,jj) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     223            ! 
     224            k_top(ji,jj) = MIN( 1 , k_bot(ji,jj) )     ! = 1    over the ocean point, =0 elsewhere 
     225         END DO 
     226      END DO 
    215227      ! 
    216228   END SUBROUTINE zgr_msk_top_bot 
     
    234246      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      - 
    235247      ! 
    236       INTEGER  ::   jk 
     248      INTEGER  ::   ji, jj, jk 
    237249      !!---------------------------------------------------------------------- 
    238250      ! 
    239251      IF( nn_timing == 1 )  CALL timing_start('zgr_zco') 
    240252      ! 
     253!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    241254      DO jk = 1, jpk 
    242          pdept(:,:,jk) = pdept_1d(jk) 
    243          pdepw(:,:,jk) = pdepw_1d(jk) 
    244          pe3t (:,:,jk) = pe3t_1d (jk) 
    245          pe3u (:,:,jk) = pe3t_1d (jk) 
    246          pe3v (:,:,jk) = pe3t_1d (jk) 
    247          pe3f (:,:,jk) = pe3t_1d (jk) 
    248          pe3w (:,:,jk) = pe3w_1d (jk) 
    249          pe3uw(:,:,jk) = pe3w_1d (jk) 
    250          pe3vw(:,:,jk) = pe3w_1d (jk) 
     255         DO jj = 1, jpj 
     256            DO ji = 1, jpi 
     257               pdept(ji,jj,jk) = pdept_1d(jk) 
     258               pdepw(ji,jj,jk) = pdepw_1d(jk) 
     259               pe3t (ji,jj,jk) = pe3t_1d (jk) 
     260               pe3u (ji,jj,jk) = pe3t_1d (jk) 
     261               pe3v (ji,jj,jk) = pe3t_1d (jk) 
     262               pe3f (ji,jj,jk) = pe3t_1d (jk) 
     263               pe3w (ji,jj,jk) = pe3w_1d (jk) 
     264               pe3uw(ji,jj,jk) = pe3w_1d (jk) 
     265               pe3vw(ji,jj,jk) = pe3w_1d (jk) 
     266            END DO 
     267         END DO 
    251268      END DO 
    252269      ! 
Note: See TracChangeset for help on using the changeset viewer.