New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 – NEMO

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

update trunk with OpenMP parallelization

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r7646 r7698  
    8888      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    8989      ! 
    90       INTEGER ::   jk   ! dummy loop index 
     90      INTEGER :: ji, jj, jk   ! dummy loop index 
    9191      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
    9292      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
     
    9898      ! 
    9999      !                                          ! 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 
    103110      !     
    104111      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
     
    110117      !                                         !==  effective transport  ==! 
    111118      IF( ln_wave .AND. ln_sdw )  THEN 
     119!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    112120         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 
    116128         END DO 
    117129      ELSE 
     130!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    118131         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 
    122139         END DO 
    123140      ENDIF 
    124141      ! 
    125142      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 
    133162      ! 
    134163      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
     
    147176      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    148177         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 
    151187      ENDIF 
    152188      ! 
     
    169205      ! 
    170206      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
     207!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    171208         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 
    174215         END DO 
    175216         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
Note: See TracChangeset for help on using the changeset viewer.