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

update trunk with OpenMP parallelization

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r7646 r7698  
    115115         ! Ensure below that barotropic velocities match time splitting estimate 
    116116         ! Compute actual transport and replace it with ts estimate at "after" time step 
    117          zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
    118          zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
     117!$OMP PARALLEL 
     118!$OMP DO schedule(static) private(jj, ji) 
     119         DO jj = 1, jpj 
     120            DO ji = 1, jpi 
     121               zue(ji,jj) = e3u_a(ji,jj,1) * ua(ji,jj,1) * umask(ji,jj,1) 
     122               zve(ji,jj) = e3v_a(ji,jj,1) * va(ji,jj,1) * vmask(ji,jj,1) 
     123            END DO 
     124         END DO 
    119125         DO jk = 2, jpkm1 
    120             zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    121             zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
    122          END DO 
     126!$OMP DO schedule(static) private(jj,ji) 
     127            DO jj = 1, jpj 
     128               DO ji = 1, jpi 
     129                  zue(ji,jj) = zue(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
     130                  zve(ji,jj) = zve(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
     131               END DO 
     132            END DO 
     133         END DO 
     134!$OMP DO schedule(static) private(jk,jj,ji) 
    123135         DO jk = 1, jpkm1 
    124             ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
    125             va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
    126          END DO 
     136            DO jj = 1, jpj 
     137               DO ji = 1, jpi 
     138                  ua(ji,jj,jk) = ( ua(ji,jj,jk) - zue(ji,jj) * r1_hu_a(ji,jj) + ua_b(ji,jj) ) * umask(ji,jj,jk) 
     139                  va(ji,jj,jk) = ( va(ji,jj,jk) - zve(ji,jj) * r1_hv_a(ji,jj) + va_b(ji,jj) ) * vmask(ji,jj,jk) 
     140               END DO 
     141            END DO 
     142         END DO 
     143!$OMP END PARALLEL 
    127144         ! 
    128145         IF( .NOT.ln_bt_fw ) THEN 
     
    131148            ! In the forward case, this is done below after asselin filtering    
    132149            ! so that asselin contribution is removed at the same time  
     150!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    133151            DO jk = 1, jpkm1 
    134                un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 
    135                vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
    136             END DO   
     152               DO jj = 1, jpj 
     153                  DO ji = 1, jpi 
     154                     un(ji,jj,jk) = ( un(ji,jj,jk) - un_adv(ji,jj) + un_b(ji,jj) )*umask(ji,jj,jk) 
     155                     vn(ji,jj,jk) = ( vn(ji,jj,jk) - vn_adv(ji,jj) + vn_b(ji,jj) )*vmask(ji,jj,jk) 
     156                  END DO 
     157               END DO 
     158            END DO 
     159 
    137160         ENDIF 
    138161      ENDIF 
     
    161184         ! 
    162185         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends 
    163             zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 
    164             zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 
     186!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     187            DO jk = 1, jpk 
     188               DO jj = 1, jpj 
     189                  DO ji = 1, jpi 
     190                     zua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_2dt 
     191                     zva(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_2dt 
     192                  END DO 
     193               END DO 
     194            END DO 
    165195            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter 
    166196            CALL iom_put( "vtrd_tot", zva ) 
    167197         ENDIF 
    168198         ! 
    169          zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter 
    170          zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the 
    171          !                                  !  computation of the asselin filter trends) 
     199!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     200         DO jk = 1, jpk 
     201            DO jj = 1, jpj 
     202               DO ji = 1, jpi 
     203                  zua(ji,jj,jk) = un(ji,jj,jk)             ! save the now velocity before the asselin filter 
     204                  zva(ji,jj,jk) = vn(ji,jj,jk)             ! (caution: there will be a shift by 1 timestep in the 
     205                        !                                  !  computation of the asselin filter trends) 
     206               END DO 
     207            END DO 
     208         END DO 
    172209      ENDIF 
    173210 
     
    175212      ! ------------------------------------------ 
    176213      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap 
     214!$OMP PARALLEL 
     215!$OMP DO schedule(static) private(jk,jj,ji) 
    177216         DO jk = 1, jpkm1 
    178             un(:,:,jk) = ua(:,:,jk)                          ! un <-- ua 
    179             vn(:,:,jk) = va(:,:,jk) 
    180          END DO 
     217            DO jj = 1, jpj 
     218               DO ji = 1, jpi 
     219                  un(ji,jj,jk) = ua(ji,jj,jk)                          ! un <-- ua 
     220                  vn(ji,jj,jk) = va(ji,jj,jk) 
     221               END DO 
     222            END DO 
     223         END DO 
     224!$OMP END DO NOWAIT 
    181225         IF(.NOT.ln_linssh ) THEN 
     226!$OMP DO schedule(static) private(jk,jj,ji) 
    182227            DO jk = 1, jpkm1 
    183                e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    184                e3u_b(:,:,jk) = e3u_n(:,:,jk) 
    185                e3v_b(:,:,jk) = e3v_n(:,:,jk) 
     228               DO jj = 1, jpj 
     229                  DO ji = 1, jpi 
     230                     e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) 
     231                     e3u_b(ji,jj,jk) = e3u_n(ji,jj,jk) 
     232                     e3v_b(ji,jj,jk) = e3v_n(ji,jj,jk) 
     233                  END DO 
     234               END DO 
    186235            END DO 
    187236         ENDIF 
     237!$OMP END PARALLEL 
    188238      ELSE                                             !* Leap-Frog : Asselin filter and swap 
    189239         !                                ! =============! 
    190240         IF( ln_linssh ) THEN             ! Fixed volume ! 
    191241            !                             ! =============! 
     242!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 
    192243            DO jk = 1, jpkm1                               
    193244               DO jj = 1, jpj 
     
    210261            ! ---------------------------------------------------- 
    211262            IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN    ! No asselin filtering on thicknesses if forward time splitting 
    212                e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 
     263!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     264               DO jj = 1, jpj 
     265                  DO ji = 1, jpi 
     266                     e3t_b(ji,jj,1:jpkm1) = e3t_n(ji,jj,1:jpkm1) 
     267                  END DO 
     268               END DO 
    213269            ELSE 
     270!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    214271               DO jk = 1, jpkm1 
    215                   e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
     272                  DO jj = 1, jpj 
     273                     DO ji = 1, jpi 
     274                        e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) + atfp * ( e3t_b(ji,jj,jk) - 2._wp * e3t_n(ji,jj,jk) + e3t_a(ji,jj,jk) ) 
     275                     END DO 
     276                  END DO 
    216277               END DO 
    217278               ! Add volume filter correction: compatibility with tracer advection scheme 
     
    219280               zcoef = atfp * rdt * r1_rau0 
    220281               IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting 
    221                   e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 
    222                                  &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
     282!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     283                  DO jj = 1, jpj 
     284                     DO ji = 1, jpi 
     285                        e3t_b(ji,jj,1) = e3t_b(ji,jj,1) - zcoef * ( emp_b(ji,jj) - emp(ji,jj) & 
     286                                 &                      - rnf_b(ji,jj) + rnf(ji,jj) ) * tmask(ji,jj,1) 
     287                     END DO 
     288                  END DO 
    223289               ELSE                     ! if ice shelf melting 
     290!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt) 
    224291                  DO jj = 1, jpj 
    225292                     DO ji = 1, jpi 
     
    237304               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
    238305               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
     306!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 
    239307               DO jk = 1, jpkm1 
    240308                  DO jj = 1, jpj 
     
    257325               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
    258326               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 
     327!$OMP PARALLEL  
     328!$OMP DO schedule(static) private(jk, jj, ji, zue3a, zve3a, zue3n, zve3n, zue3b, zve3b, zuf, zvf) 
    259329               DO jk = 1, jpkm1 
    260330                  DO jj = 1, jpj 
     
    277347                  END DO 
    278348               END DO 
    279                e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor 
    280                e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
     349!$OMP DO schedule(static) private(jj, ji) 
     350                  DO jj = 1, jpj 
     351                     DO ji = 1, jpi 
     352                        e3u_b(ji,jj,1:jpkm1) = ze3u_f(ji,jj,1:jpkm1)        ! e3u_b <-- filtered scale factor 
     353                        e3v_b(ji,jj,1:jpkm1) = ze3v_f(ji,jj,1:jpkm1) 
     354                     END DO 
     355                  END DO 
     356!$OMP END PARALLEL 
    281357               ! 
    282358               CALL wrk_dealloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
     
    288364            ! Revert "before" velocities to time split estimate 
    289365            ! Doing it here also means that asselin filter contribution is removed   
    290             zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
    291             zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)     
     366!$OMP PARALLEL  
     367!$OMP DO schedule(static) private(jj, ji) 
     368            DO jj = 1, jpj 
     369               DO ji = 1, jpi 
     370                  zue(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 
     371                  zve(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 
     372               END DO 
     373            END DO 
    292374            DO jk = 2, jpkm1 
    293                zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
    294                zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
    295             END DO 
     375!$OMP DO schedule(static) private(jj, ji) 
     376               DO jj = 1, jpj 
     377                  DO ji = 1, jpi 
     378                     zue(ji,jj) = zue(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
     379                     zve(ji,jj) = zve(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
     380                  END DO 
     381               END DO 
     382            END DO 
     383!$OMP DO schedule(static) private(jk,jj,ji) 
    296384            DO jk = 1, jpkm1 
    297                ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 
    298                vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk) 
    299             END DO 
     385               DO jj = 1, jpj 
     386                  DO ji = 1, jpi 
     387                     ub(ji,jj,jk) = ub(ji,jj,jk) - (zue(ji,jj) * r1_hu_n(ji,jj) - un_b(ji,jj)) * umask(ji,jj,jk) 
     388                     vb(ji,jj,jk) = vb(ji,jj,jk) - (zve(ji,jj) * r1_hv_n(ji,jj) - vn_b(ji,jj)) * vmask(ji,jj,jk) 
     389                  END DO 
     390               END DO 
     391            END DO 
     392!$OMP END PARALLEL 
    300393         ENDIF 
    301394         ! 
     
    308401      ! 
    309402      IF(.NOT.ln_linssh ) THEN 
    310          hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 
    311          hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 
     403!$OMP PARALLEL  
     404!$OMP DO schedule(static) private(jj, ji) 
     405         DO jj = 1, jpj 
     406            DO ji = 1, jpi 
     407               hu_b(ji,jj) = e3u_b(ji,jj,1) * umask(ji,jj,1) 
     408               hv_b(ji,jj) = e3v_b(ji,jj,1) * vmask(ji,jj,1) 
     409            END DO 
     410         END DO 
    312411         DO jk = 2, jpkm1 
    313             hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
    314             hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
    315          END DO 
    316          r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 
    317          r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
    318       ENDIF 
    319       ! 
    320       un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1) 
    321       ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
    322       vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1) 
    323       vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 
     412!$OMP DO schedule(static) private(jj, ji) 
     413            DO jj = 1, jpj 
     414               DO ji = 1, jpi 
     415                  hu_b(ji,jj) = hu_b(ji,jj) + e3u_b(ji,jj,jk) * umask(ji,jj,jk) 
     416                  hv_b(ji,jj) = hv_b(ji,jj) + e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 
     417               END DO 
     418            END DO 
     419         END DO 
     420!$OMP DO schedule(static) private(jj, ji) 
     421         DO jj = 1, jpj 
     422            DO ji = 1, jpi 
     423               r1_hu_b(ji,jj) = ssumask(ji,jj) / ( hu_b(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     424               r1_hv_b(ji,jj) = ssvmask(ji,jj) / ( hv_b(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     425            END DO 
     426         END DO 
     427!$OMP END PARALLEL 
     428      ENDIF 
     429      ! 
     430!$OMP PARALLEL 
     431!$OMP DO schedule(static) private(jj, ji) 
     432      DO jj = 1, jpj 
     433         DO ji = 1, jpi 
     434            un_b(ji,jj) = e3u_a(ji,jj,1) * un(ji,jj,1) * umask(ji,jj,1) 
     435            ub_b(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 
     436            vn_b(ji,jj) = e3v_a(ji,jj,1) * vn(ji,jj,1) * vmask(ji,jj,1) 
     437            vb_b(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 
     438         END DO 
     439      END DO 
    324440      DO jk = 2, jpkm1 
    325          un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 
    326          ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
    327          vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk) 
    328          vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 
     441!$OMP DO schedule(static) private(jj, ji) 
     442         DO jj = 1, jpj 
     443            DO ji = 1, jpi 
     444               un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     445               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
     446               vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     447               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
     448            END DO 
     449         END DO 
    329450      END DO 
    330       un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 
    331       vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 
    332       ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    333       vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     451!$OMP DO schedule(static) private(jj, ji) 
     452      DO jj = 1, jpj 
     453         DO ji = 1, jpi 
     454            un_b(ji,jj) = un_b(ji,jj) * r1_hu_a(ji,jj) 
     455            vn_b(ji,jj) = vn_b(ji,jj) * r1_hv_a(ji,jj) 
     456            ub_b(ji,jj) = ub_b(ji,jj) * r1_hu_b(ji,jj) 
     457            vb_b(ji,jj) = vb_b(ji,jj) * r1_hv_b(ji,jj) 
     458         END DO 
     459      END DO 
     460!$OMP END PARALLEL 
    334461      ! 
    335462      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents 
     
    338465      ENDIF 
    339466      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
    340          zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
    341          zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 
     467!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     468         DO jk = 1, jpkm1 
     469            DO jj = 1, jpj 
     470               DO ji = 1, jpi 
     471                  zua(ji,jj,jk) = ( ub(ji,jj,jk) - zua(ji,jj,jk) ) * z1_2dt 
     472                  zva(ji,jj,jk) = ( vb(ji,jj,jk) - zva(ji,jj,jk) ) * z1_2dt 
     473               END DO 
     474            END DO 
     475         END DO 
    342476         CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 
    343477      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.