Changeset 9176


Ignore:
Timestamp:
2018-01-04T13:30:03+01:00 (3 years ago)
Author:
andmirek
Message:

#2001: OMP directives

Location:
branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC
Files:
20 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90

    r6491 r9176  
    8888      IF( iom_use("ut") ) THEN 
    8989         z3d(:,:,:) = 0.e0  
     90!$OMP PARALLEL DO 
    9091         DO jk = 1, jpkm1 
    9192            DO jj = 2, jpjm1 
     
    100101      IF( iom_use("vt") ) THEN 
    101102         z3d(:,:,:) = 0.e0  
     103!$OMP PARALLEL DO 
    102104         DO jk = 1, jpkm1 
    103105            DO jj = 2, jpjm1 
     
    117119            END DO 
    118120         END DO 
     121!$OMP PARALLEL DO 
    119122         DO jk = 2, jpkm1 
    120123            DO jj = 2, jpjm1 
     
    129132      IF( iom_use("us") ) THEN 
    130133         z3d(:,:,:) = 0.e0  
     134!$OMP PARALLEL DO 
    131135         DO jk = 1, jpkm1 
    132136            DO jj = 2, jpjm1 
     
    141145      IF( iom_use("vs") ) THEN 
    142146         z3d(:,:,:) = 0.e0  
     147!$OMP PARALLEL DO 
    143148         DO jk = 1, jpkm1 
    144149            DO jj = 2, jpjm1 
     
    158163            END DO 
    159164         END DO 
     165!$OMP PARALLEL DO 
    160166         DO jk = 2, jpkm1 
    161167            DO jj = 2, jpjm1 
     
    170176      IF( iom_use("urhop") ) THEN 
    171177         z3d(:,:,:) = 0.e0  
     178!$OMP PARALLEL DO 
    172179         DO jk = 1, jpkm1 
    173180            DO jj = 2, jpjm1 
     
    182189      IF( iom_use("vrhop") ) THEN 
    183190         z3d(:,:,:) = 0.e0  
     191!$OMP PARALLEL DO 
    184192         DO jk = 1, jpkm1 
    185193            DO jj = 2, jpjm1 
     
    199207            END DO 
    200208         END DO 
     209!$OMP PARALLEL DO 
    201210         DO jk = 2, jpkm1 
    202211            DO jj = 2, jpjm1 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6498 r9176  
    131131      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    132132      !! 
    133       REAL(wp), POINTER, DIMENSION(:,:)  :: z2d      ! 2D workspace 
    134       REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace 
     133      REAL(wp),  DIMENSION(jpi,jpj    ) :: z2d      ! 2D workspace 
     134      REAL(wp),  DIMENSION(jpi,jpj,jpk) :: z3d      ! 3D workspace 
    135135      !!---------------------------------------------------------------------- 
    136136      !  
    137137      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    138138      !  
    139       CALL wrk_alloc( jpi , jpj      , z2d ) 
    140       CALL wrk_alloc( jpi , jpj, jpk , z3d ) 
     139!     CALL wrk_alloc( jpi , jpj      , z2d ) 
     140!     CALL wrk_alloc( jpi , jpj, jpk , z3d ) 
    141141      ! 
    142142      ! Output the initial state and forcings 
     
    176176      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
    177177      IF ( iom_use("sbs") ) THEN 
     178!$OMP PARALLEL DO PRIVATE(jkbot) 
    178179         DO jj = 1, jpj 
    179180            DO ji = 1, jpi 
     
    187188      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    188189         z2d(:,:) = 0._wp 
     190!$OMP PARALLEL DO PRIVATE(zztmpx, zztmpy) 
    189191         DO jj = 2, jpjm1 
    190192            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    204206      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current 
    205207      IF ( iom_use("sbu") ) THEN 
     208!$OMP PARALLEL DO PRIVATE(jkbot) 
    206209         DO jj = 1, jpj 
    207210            DO ji = 1, jpi 
     
    221224      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current 
    222225      IF ( iom_use("sbv") ) THEN 
     226!$OMP PARALLEL DO PRIVATE(jkbot) 
    223227         DO jj = 1, jpj 
    224228            DO ji = 1, jpi 
     
    239243         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    240244         z2d(:,:) = rau0 * e12t(:,:) 
     245!$OMP PARALLEL DO 
    241246         DO jk = 1, jpk 
    242247            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     
    258263 
    259264      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
     265!$OMP PARALLEL DO PRIVATE(zztmp, zztmpx, zztmpy) 
    260266         DO jj = 2, jpjm1                                    ! sst gradient 
    261267            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    269275         CALL lbc_lnk( z2d, 'T', 1. ) 
    270276         CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
    271          z2d(:,:) = SQRT( z2d(:,:) ) 
     277!$OMP PARALLEL DO 
     278         DO jj = 1, jpj 
     279            z2d(:,jj) = SQRT( z2d(:,jj) ) 
     280         ENDDO 
    272281         CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    273282      ENDIF 
     
    276285      IF( iom_use("heatc") ) THEN 
    277286         z2d(:,:)  = 0._wp  
     287!$OMP PARALLEL DO REDUCTION(+:z2d) 
    278288         DO jk = 1, jpkm1 
    279289            DO jj = 1, jpj 
     
    288298      IF( iom_use("saltc") ) THEN 
    289299         z2d(:,:)  = 0._wp  
     300!$OMP PARALLEL DO REDUCTION(+:z2d) 
    290301         DO jk = 1, jpkm1 
    291302            DO jj = 1, jpj 
     
    300311      IF ( iom_use("eken") ) THEN 
    301312         rke(:,:,jk) = 0._wp                               !      kinetic energy  
     313!$OMP PARALLEL DO PRIVATE(zztmp, zztmpx, zztmpy)  
    302314         DO jk = 1, jpkm1 
    303315            DO jj = 2, jpjm1 
     
    325337      IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    326338         z3d(:,:,jpk) = 0.e0 
     339!$OMP PARALLEL DO 
    327340         DO jk = 1, jpkm1 
    328341            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     
    333346      IF( iom_use("u_heattr") ) THEN 
    334347         z2d(:,:) = 0.e0  
     348!$OMP PARALLEL DO REDUCTION(+:z2d) 
    335349         DO jk = 1, jpkm1 
    336350            DO jj = 2, jpjm1 
     
    346360      IF( iom_use("u_salttr") ) THEN 
    347361         z2d(:,:) = 0.e0  
     362!$OMP PARALLEL DO REDUCTION(+:z2d) 
    348363         DO jk = 1, jpkm1 
    349364            DO jj = 2, jpjm1 
     
    360375      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
    361376         z3d(:,:,jpk) = 0.e0 
     377!$OMP PARALLEL DO 
    362378         DO jk = 1, jpkm1 
    363379            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     
    368384      IF( iom_use("v_heattr") ) THEN 
    369385         z2d(:,:) = 0.e0  
     386!$OMP PARALLEL DO REDUCTION(+:z2d) 
    370387         DO jk = 1, jpkm1 
    371388            DO jj = 2, jpjm1 
     
    381398      IF( iom_use("v_salttr") ) THEN 
    382399         z2d(:,:) = 0.e0  
     400!$OMP PARALLEL DO REDUCTION(+:z2d) 
    383401         DO jk = 1, jpkm1 
    384402            DO jj = 2, jpjm1 
     
    392410      ENDIF 
    393411      ! 
    394       CALL wrk_dealloc( jpi , jpj      , z2d ) 
    395       CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
     412!     CALL wrk_dealloc( jpi , jpj      , z2d ) 
     413!     CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
    396414      ! 
    397415      IF( nn_timing == 1 )   CALL timing_stop('dia_wri') 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r6498 r9176  
    172172      fsdept_b(:,:,1) = 0.5_wp * fse3w_b(:,:,1) 
    173173      fsdepw_b(:,:,1) = 0.0_wp 
    174  
     174!$OPM PARALLEL 
    175175      DO jk = 2, jpk 
     176!$OMP DO PRIVATE(zcoef) 
    176177         DO jj = 1,jpj 
    177178            DO ji = 1,jpi 
     
    189190            END DO 
    190191         END DO 
     192!$OMP END DO 
    191193      END DO 
     194!$OPM PARALLEL 
    192195 
    193196      ! Before depth and Inverse of the local depth of the water column at u- and v- points 
     
    214217         ENDIF 
    215218         IF ( ln_vvl_zstar_at_eqtor ) THEN 
     219!$OMP PARALLEL DO 
    216220            DO jj = 1, jpj 
    217221               DO ji = 1, jpi 
     
    273277      !!---------------------------------------------------------------------- 
    274278      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t 
    275       REAL(wp), POINTER, DIMENSION(:,:  ) :: zht, z_scale, zwu, zwv, zhdiv 
     279      REAL(wp),     DIMENSION(jpi, jpj  ) :: zht, z_scale, zwu, zwv, zhdiv 
    276280      !! * Arguments 
    277281      INTEGER, INTENT( in )                  :: kt                    ! time step 
     
    285289      !!---------------------------------------------------------------------- 
    286290      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_nxt') 
    287       CALL wrk_alloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 
     291!     CALL wrk_alloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 
    288292      CALL wrk_alloc( jpi, jpj, jpk, ze3t                     ) 
    289293 
     
    306310                                                       ! z_star coordinate and barotropic z-tilde part ! 
    307311      !                                                ! --------------------------------------------- ! 
    308  
    309       z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
     312!$OMP PARALLEL 
     313!$OMP DO 
     314      DO jj = 1, jpj  
     315         z_scale(:,jj) = ( ssha(:,jj) - sshb(:,jj) ) * ssmask(:,jj) / ( ht_0(:,jj) + sshn(:,jj) + 1. - ssmask(:,jj) ) 
     316      END DO 
     317!$OMP END DO 
     318!$OMP DO 
    310319      DO jk = 1, jpkm1 
    311320         ! formally this is the same as fse3t_a = e3t_0*(1+ssha/ht_0) 
    312321         fse3t_a(:,:,jk) = fse3t_b(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
    313322      END DO 
     323!$OMP END DO 
     324!$OMP END PARALLEL 
    314325 
    315326      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
     
    323334         zhdiv(:,:) = 0. 
    324335         zht(:,:)   = 0. 
     336!$OMP PARALLEL DO REDUCTION(+:zhdiv, zht) 
    325337         DO jk = 1, jpkm1 
    326338            zhdiv(:,:) = zhdiv(:,:) + fse3t_n(:,:,jk) * hdivn(:,:,jk) 
    327339            zht  (:,:) = zht  (:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
    328340         END DO 
    329          zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) 
     341!$OMP DO 
     342      DO jj = 1, jpj 
     343         zhdiv(:,jj) = zhdiv(:,jj) / ( zht(:,jj) + 1. - tmask_i(:,jj) ) 
     344      END DO 
     345!$OMP END DO 
    330346 
    331347         ! 2 - Low frequency baroclinic horizontal divergence  (z-tilde case only) 
     
    333349         IF( ln_vvl_ztilde ) THEN 
    334350            IF( kt .GT. nit000 ) THEN 
     351!$OMP PARALLEL DO 
    335352               DO jk = 1, jpkm1 
    336353                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   & 
     
    347364         ! ---------------------------------- 
    348365         IF( ln_vvl_ztilde ) THEN     ! z_tilde case 
     366!$OMP PARALLEL DO 
    349367            DO jk = 1, jpkm1 
    350368               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 
    351369            END DO 
    352370         ELSE                         ! layer case 
     371!$OMP PARALLEL DO 
    353372            DO jk = 1, jpkm1 
    354373               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 
     
    359378         ! ------------------ 
    360379         IF( ln_vvl_ztilde ) THEN 
     380!$OMP PARALLEL DO 
    361381            DO jk = 1, jpk 
    362382               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 
     
    369389         zwv(:,:) = 0.0_wp 
    370390         ! a - first derivative: diffusive fluxes 
     391!$OMP PARALLEL  
     392!$OMP DO 
    371393         DO jk = 1, jpkm1 
    372394            DO jj = 1, jpjm1 
     
    376398                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj) &  
    377399                                  & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
     400               END DO 
     401            END DO 
     402         END DO 
     403!$OMP END DO 
     404!$OMP DO REDUCTION(+:zwu, zwv) 
     405         DO jk = 1, jpkm1 
     406            DO jj = 1, jpjm1 
     407               DO ji = 1, fs_jpim1   ! vector opt. 
    378408                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    379409                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
     
    381411            END DO 
    382412         END DO 
     413!$OMP END DO 
     414!$OMP END PARALLEL 
    383415         ! b - correction for last oceanic u-v points 
     416!$OMP PARALLEL DO 
    384417         DO jj = 1, jpj 
    385418            DO ji = 1, jpi 
     
    389422         END DO 
    390423         ! c - second derivative: divergence of diffusive fluxes 
     424!$OMP PARALLEL DO 
    391425         DO jk = 1, jpkm1 
    392426            DO jj = 2, jpjm1 
     
    413447         ENDIF 
    414448         CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    415          tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
    416  
     449!$OMP PARALLEL DO 
     450         DO jk = 1, jpk 
     451            tilde_e3t_a(:,:,jk) = tilde_e3t_b(:,:,jk) + z2dt * tmask(:,:,jk) * tilde_e3t_a(:,:,jk) 
     452         ENDDO 
    417453         ! Maximum deformation control 
    418454         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    419455         ze3t(:,:,jpk) = 0.0_wp 
    420          DO jk = 1, jpkm1 
    421             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    422          END DO 
     456!$OMP PARALLEL DO 
     457         DO jk = 1, jpkm1 
     458            DO jj = 1, jpj 
     459!dir$ IVDEP 
     460               DO ji = 1, jpi 
     461                  ze3t(ji, jj ,jk) = tilde_e3t_a(ji, jj ,jk) / e3t_0(ji, jj ,jk) * tmask(ji, jj ,jk) * tmask_i(ji, jj) 
     462               ENDDO 
     463             ENDDO 
     464         END DO 
     465!$OMP PARALLEL 
     466!$OMP DO 
     467         DO jk = 1, jpkm1 
     468                  ze3t(:, : ,jk) = tilde_e3t_a(:, : ,jk) / e3t_0(:, : ,jk) * tmask_i(:, :) 
     469         END DO 
     470!$OMP END DO 
     471!$OMP DO 
     472         DO jk = 1, jpkm1  
     473                  ze3t(:, : ,jk) = ze3t(:, : ,jk) * tmask(:, : ,jk)  
     474         END DO 
     475!$OMP END DO 
     476!$OMP END PARALLEL 
     477 
    423478         z_tmax = MAXVAL( ze3t(:,:,:) ) 
    424479         IF( lk_mpp )   CALL mpp_max( z_tmax )                 ! max over the global domain 
     
    448503         ! - ML - end test 
    449504         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
    450          tilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:),   rn_zdef_max * e3t_0(:,:,:) ) 
    451          tilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) ) 
    452  
     505!$OMP PARALLEL DO 
     506         DO jk =1, jpk 
     507            tilde_e3t_a(:,:,jk) = MIN( tilde_e3t_a(:,:,jk),   rn_zdef_max * e3t_0(:,:,jk) ) 
     508            tilde_e3t_a(:,:,jk) = MAX( tilde_e3t_a(:,:,jk), - rn_zdef_max * e3t_0(:,:,jk) ) 
     509         ENDDO 
    453510         ! 
    454511         ! "tilda" change in the after scale factor 
    455512         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     513!$OMP PARALLEL DO 
    456514         DO jk = 1, jpkm1 
    457515            dtilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk) 
     
    464522         !        (keep in mind that the idea is to reduce Eulerian velocity as much as possible) 
    465523         zht(:,:) = 0. 
     524!$OMP PARALLEL DO REDUCTION(+:zht) 
    466525         DO jk = 1, jpkm1 
    467526            zht(:,:)  = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
    468527         END DO 
    469528         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
     529!$OMP PARALLEL DO 
    470530         DO jk = 1, jpkm1 
    471531            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
     
    476536      IF( ln_vvl_ztilde .OR. ln_vvl_layer )  THEN   ! z_tilde or layer coordinate ! 
    477537      !                                           ! ---baroclinic part--------- ! 
     538!$OMP PARALLEL DO 
    478539         DO jk = 1, jpkm1 
    479540            fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
     
    491552         ! 
    492553         zht(:,:) = 0.0_wp 
     554!$OMP PARALLEL DO REDUCTION(+:zht) 
    493555         DO jk = 1, jpkm1 
    494556            zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
     
    499561         ! 
    500562         zht(:,:) = 0.0_wp 
     563!$OMP PARALLEL DO REDUCTION(+:zht) 
    501564         DO jk = 1, jpkm1 
    502565            zht(:,:) = zht(:,:) + fse3t_a(:,:,jk) * tmask(:,:,jk) 
     
    507570         ! 
    508571         zht(:,:) = 0.0_wp 
     572!$OMP PARALLEL DO REDUCTION(+:zht) 
    509573         DO jk = 1, jpkm1 
    510574            zht(:,:) = zht(:,:) + fse3t_b(:,:,jk) * tmask(:,:,jk) 
     
    540604      hu_a(:,:) = 0._wp                        ! Ocean depth at U-points 
    541605      hv_a(:,:) = 0._wp                        ! Ocean depth at V-points 
     606 
    542607      DO jk = 1, jpkm1 
    543608         hu_a(:,:) = hu_a(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 
     
    545610      END DO 
    546611      !                                        ! Inverse of the local depth 
    547       hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
    548       hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
    549  
    550       CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 
     612!$OMP PARALLEL DO 
     613      DO jj = 1, jpj 
     614         hur_a(:,jj) = 1._wp / ( hu_a(:,jj) + 1._wp - umask_i(:,jj) ) * umask_i(:,jj) 
     615         hvr_a(:,jj) = 1._wp / ( hv_a(:,jj) + 1._wp - vmask_i(:,jj) ) * vmask_i(:,jj) 
     616      ENDDO 
     617 
     618!     CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 
    551619      CALL wrk_dealloc( jpi, jpj, jpk, ze3t                     ) 
    552620 
     
    603671            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
    604672         ELSE 
    605             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) &  
     673!$OMP PARALLEL DO 
     674            DO jk = 1,jpk 
     675               tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) &  
    606676            &         + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 
     677            ENDDO 
    607678         ENDIF 
    608679         tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 
     
    636707      fsdepw_n(:,:,1) = 0.0_wp 
    637708      fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 
    638  
     709!$OMP PARALLEL SHARED(jk) 
    639710      DO jk = 2, jpk 
     711!$OMP DO PRIVATE(zcoef) 
    640712         DO jj = 1,jpj 
    641713            DO ji = 1,jpi 
     
    649721            END DO 
    650722         END DO 
     723!$OMP END DO 
    651724      END DO 
     725!$OMP END PARALLEL 
    652726 
    653727      ! Local depth and Inverse of the local depth of the water column at u- and v- points 
     
    663737      ! -------------------------------------------- 
    664738      ht(:,:) = 0. 
     739!$OMP PARALLEL DO REDUCTION(+:ht) 
    665740      DO jk = 1, jpkm1 
    666741         ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
     
    705780         !               ! ------------------------------------- ! 
    706781         ! horizontal surface weighted interpolation 
     782!$OMP PARALLEL DO 
    707783         DO jk = 1, jpk 
    708784            DO jj = 1, jpjm1 
     
    718794         ! boundary conditions 
    719795         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 
    720          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
     796!$OMP PARALLEL DO 
     797         DO jk = 1, jpk 
     798            pe3_out(:,:,jk) = pe3_out(:,:,jk) + e3u_0(:,:,jk) 
     799         ENDDO 
    721800         !               ! ------------------------------------- ! 
    722801      CASE( 'V' )        ! interpolation from T-point to V-point ! 
    723802         !               ! ------------------------------------- ! 
    724803         ! horizontal surface weighted interpolation 
     804!$OMP PARALLEL DO 
    725805         DO jk = 1, jpk 
    726806            DO jj = 1, jpjm1 
     
    736816         ! boundary conditions 
    737817         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 
    738          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
     818!$OMP PARALLEL DO 
     819         DO jk = 1, jpk 
     820            pe3_out(:,:,jk) = pe3_out(:,:,jk) + e3v_0(:,:,jk) 
     821         ENDDO 
    739822         !               ! ------------------------------------- ! 
    740823      CASE( 'F' )        ! interpolation from U-point to F-point ! 
    741824         !               ! ------------------------------------- ! 
    742825         ! horizontal surface weighted interpolation 
     826!$OMP PARALLEL DO 
    743827         DO jk = 1, jpk 
    744828            DO jj = 1, jpjm1 
     
    754838         ! boundary conditions 
    755839         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 
    756          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
     840!$OMP PARALLEL DO 
     841         DO jk = 1, jpk 
     842            pe3_out(:,:,jk) = pe3_out(:,:,jk) + e3f_0(:,:,jk) 
     843         ENDDO 
    757844         !               ! ------------------------------------- ! 
    758845      CASE( 'W' )        ! interpolation from T-point to W-point ! 
     
    761848         pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 
    762849         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
     850!$OMP PARALLEL DO 
    763851         DO jk = 2, jpk 
    764852            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )   & 
     
    771859         pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 
    772860         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
     861!$OMP PARALLEL DO 
    773862         DO jk = 2, jpk 
    774863            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )   & 
     
    781870         pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 
    782871         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
     872!$OMP PARALLEL DO 
    783873         DO jk = 2, jpk 
    784874            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )   & 
     
    857947               IF(lwp) write(numout,*) 'Compute scale factor from sshn' 
    858948               IF(lwp) write(numout,*) 'neuler is forced to 0' 
     949!$OMP PARALLEL DO 
    859950               DO jk=1,jpk 
    860951                  fse3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r6487 r9176  
    105105         IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case' 
    106106      ENDIF 
    107  
    108       !                                                ! =============== 
     107      ! 
     108!$OMP PARALLEL DO                                       ! =============== 
    109109      DO jk = 1, jpkm1                                 ! Horizontal slab 
    110110         !                                             ! =============== 
     
    287287      ENDIF 
    288288 
    289       !                                                ! =============== 
     289!$OMP PARALLEL DO                                      ! =============== 
    290290      DO jk = 1, jpkm1                                 ! Horizontal slab 
    291291         !                                             ! =============== 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r6486 r9176  
    7777      INTEGER  ::   ji, jj, jk                  ! dummy loop indices 
    7878      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar 
    79       REAL(wp), POINTER, DIMENSION(:,:  ) :: zcu, zcv 
     79      REAL(wp),      DIMENSION(jpi,jpj  ) :: zcu, zcv 
    8080      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv 
    8181      !!---------------------------------------------------------------------- 
     
    8383      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilap') 
    8484      ! 
    85       CALL wrk_alloc( jpi, jpj,      zcu, zcv           ) 
     85!     CALL wrk_alloc( jpi, jpj,      zcu, zcv           ) 
    8686      CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv )  
    8787      ! 
     
    102102      zlv(:,:,:) = 0._wp 
    103103 
    104       !                                                ! =============== 
    105       DO jk = 1, jpkm1                                 ! Horizontal slab 
    106          !                                             ! =============== 
     104         ! 
    107105         ! Laplacian 
    108106         ! --------- 
    109107 
    110108         IF( ln_sco .OR. ln_zps ) THEN   ! s-coordinate or z-coordinate with partial steps 
    111             zuf(:,:,jk) = rotb(:,:,jk) * fse3f(:,:,jk) 
    112             DO jj = 2, jpjm1 
    113                DO ji = fs_2, fs_jpim1   ! vector opt. 
    114                   zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    115                      &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj) 
    116     
    117                   zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    118                      &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj) 
    119                END DO 
     109!$OMP PARALLEL DO 
     110            !                                                ! =============== 
     111            DO jk = 1, jpkm1                                 ! Horizontal slab 
     112               !                                             ! =============== 
     113               ! Laplacian 
     114               ! --------- 
     115                  zuf(:,:,jk) = rotb(:,:,jk) * fse3f(:,:,jk) 
     116                  DO jj = 2, jpjm1 
     117                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     118                        zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
     119                           &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj) 
     120    
     121                        zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
     122                           &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj) 
     123                     END DO 
     124                  END DO 
    120125            END DO 
    121126         ELSE                            ! z-coordinate - full step 
    122             DO jj = 2, jpjm1 
    123                DO ji = fs_2, fs_jpim1   ! vector opt. 
    124                   zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   & 
    125                      &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj) 
    126     
    127                   zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   & 
    128                      &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj) 
     127!$OMP PARALLEL DO 
     128           !                                                ! =============== 
     129            DO jk = 1, jpkm1                                 ! Horizontal slab 
     130               !                                             ! =============== 
     131               DO jj = 2, jpjm1 
     132                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     133                     zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   & 
     134                        &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj) 
     135    
     136                     zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   & 
     137                        &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj) 
     138                  END DO   
    129139               END DO   
    130             END DO   
     140            END DO 
    131141         ENDIF 
    132       END DO 
    133142      CALL lbc_lnk( zlu, 'U', -1. )   ;   CALL lbc_lnk( zlv, 'V', -1. )   ! Boundary conditions 
    134  
    135           
     143!$OMP PARALLE DO PRIVATE(zcu, zcv, zbt) 
    136144      DO jk = 1, jpkm1 
    137145    
     
    145153          
    146154         ! Contravariant "laplacian" 
    147          zcu(:,:) = e1u(:,:) * zlu(:,:,jk) 
    148          zcv(:,:) = e2v(:,:) * zlv(:,:,jk) 
     155         DO jj = 1, jpj 
     156            DO ji = 1, jpi 
     157               zcu(ji,jj) = e1u(ji,jj) * zlu(ji,jj,jk) 
     158               zcv(ji,jj) = e2v(ji,jj) * zlv(ji,jj,jk) 
     159            END DO 
     160         END DO 
    149161          
    150162         ! Laplacian curl ( * e3f if s-coordinates or z-coordinate with partial steps) 
     
    180192      CALL lbc_lnk( zuf, 'F', 1. ) 
    181193      CALL lbc_lnk( zut, 'T', 1. ) 
    182  
     194!OMP PARALLEL DO PRIVATE(ze2u, ze2v, zua, zva) 
    183195      DO jk = 1, jpkm1       
    184196    
     
    205217      END DO                                           !   End of slab 
    206218      !                                                ! =============== 
    207       CALL wrk_dealloc( jpi, jpj,      zcu, zcv           ) 
     219!     CALL wrk_dealloc( jpi, jpj,      zcu, zcv           ) 
    208220      CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv )  
    209221      ! 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r6486 r9176  
    222222      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    223223      REAL(wp) ::   zx1, zy1, zfact2, zx2, zy2   ! local scalars 
    224       REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz 
     224      REAL(wp), DIMENSION(jpi, jpj) :: zwx, zwy, zwz 
    225225      !!---------------------------------------------------------------------- 
    226226      ! 
    227227      IF( nn_timing == 1 )  CALL timing_start('vor_ene') 
    228228      ! 
    229       CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz )  
     229!     CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz )  
    230230      ! 
    231231      IF( kt == nit000 ) THEN 
     
    237237      zfact2 = 0.5 * 0.5      ! Local constant initialization 
    238238 
    239 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 
     239!$OMP PARALLEL DO PRIVATE( zwx, zwy, zwz, zy1, zy2, zx1, zx2 ) 
    240240      !                                                ! =============== 
    241241      DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    292292      END DO                                           !   End of slab 
    293293      !                                                ! =============== 
    294       CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )  
     294!     CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz )  
    295295      ! 
    296296      IF( nn_timing == 1 )  CALL timing_stop('vor_ene') 
     
    350350      zfact2 = 0.5 * 0.5 
    351351 
    352 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, zww ) 
     352!!!!$OMP PARALLEL DO PRIVATE( zwx, zwy, zwz, zww, zy1, zy2, zx1, zx2, zua, zva, zcua, zcva) 
    353353      !                                                ! =============== 
    354354      DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    466466      zfact1 = 0.5 * 0.25      ! Local constant initialization 
    467467 
    468 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 
     468!!!!$OMP PARALLEL DO PRIVATE( zwx, zwy, zwz, zuav, zvau ) 
    469469      !                                                ! =============== 
    470470      DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    599599 
    600600         IF( ln_dynvor_een_old ) THEN ! original formulation 
     601!$OMP PARALLEL DO PRIVATE(ze3) 
    601602            DO jk = 1, jpk 
    602603               DO jj = 1, jpjm1 
     
    609610            END DO 
    610611         ELSE ! new formulation from NEMO 3.6 
     612!$OMP PARALLEL DO PRIVATE(ze3, zmsk) 
    611613            DO jk = 1, jpk 
    612614               DO jj = 1, jpjm1 
     
    628630 
    629631       
    630 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 
     632!!!!!$OMP PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse, zua, zva ) 
    631633      !                                                ! =============== 
    632634      DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    637639         SELECT CASE( kvor )      ! vorticity considered 
    638640         CASE ( 1 )                                                ! planetary vorticity (Coriolis) 
    639             zwz(:,:) = ff(:,:)      * ze3f(:,:,jk) 
     641               zwz(:,:) = ff(:,:)      * ze3f(:,:,jk) 
    640642         CASE ( 2 )                                                ! relative  vorticity 
    641             zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk) 
     643               zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk) 
    642644         CASE ( 3 )                                                ! metric term 
    643645            DO jj = 1, jpjm1 
     
    650652            CALL lbc_lnk( zwz, 'F', 1. ) 
    651653        CASE ( 4 )                                                ! total (relative + planetary vorticity) 
    652             zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 
     654              zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 
    653655         CASE ( 5 )                                                ! total (coriolis + metric) 
    654656            DO jj = 1, jpjm1 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r6498 r9176  
    105105      INTEGER  ::   ii0, ii1, iku   ! temporary integer 
    106106      INTEGER  ::   ij0, ij1, ikv   ! temporary integer 
    107       REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars 
     107      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw, zcofwa ! local scalars 
    108108      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      - 
    109109      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
     
    131131         zwz(:,:,:) = 0._wp 
    132132         ! 
     133!$OMP PARALLEL DO 
    133134         DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
    134135            DO jj = 1, jpjm1 
     
    139140            END DO 
    140141         END DO 
     142 
    141143         IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
     144!$OMP PARALLEL DO 
    142145            DO jj = 1, jpjm1 
    143146               DO ji = 1, jpim1 
     
    148151         ENDIF 
    149152         IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level 
     153!$OMP PARALLEL DO 
    150154            DO jj = 1, jpjm1 
    151155               DO ji = 1, jpim1 
     
    158162         !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    159163         ! interior value 
     164!$OMP PARALLEL DO 
    160165         DO jk = 2, jpkm1 
    161166            !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
     
    171176         IF ( ln_isfcav ) THEN 
    172177            ! if isf need to overwrite the interior value at at the first ocean point 
     178!$OMP PARALLEL DO 
    173179            DO jj = 1, jpjm1 
    174180               DO ji = 1, jpim1 
     
    186192         ! 
    187193         IF ( ln_isfcav ) THEN 
     194!$OMP PARALLEL DO 
    188195            DO jj = 2, jpjm1 
    189196               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    195202            ENDDO 
    196203         ELSE 
     204!$OMP PARALLEL DO 
    197205            DO jj = 2, jpjm1 
    198206               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    202210            ENDDO 
    203211         END IF 
     212!$OMP PARALLEL DO PRIVATE(zau, zav, zbu, zbv, zbu, zbv, zfi, zfj, zdepu, zdepv) 
    204213         DO jk = 2, jpkm1                            !* Slopes at u and v points 
    205214            DO jj = 2, jpjm1 
     
    243252            END DO 
    244253         END DO 
     254!$OMP END PARALLEL DO 
    245255         CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions 
    246256         ! 
    247257         !                                            !* horizontal Shapiro filter 
     258!$OMP PARALLEL DO 
    248259         DO jk = 2, jpkm1 
    249260            DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     
    287298            END DO 
    288299         END DO 
    289  
     300!$OMP END PARALLEL DO 
    290301 
    291302         ! II.  slopes at w point           | wslpi = mij( d/di( prd ) / d/dz( prd ) 
    292303         ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
    293304         ! 
     305!$OMP PARALLEL DO PRIVATE(zbw, zci, zcj, zai, zaj, zbi, zbj, zfk, zck) 
    294306         DO jk = 2, jpkm1 
    295307            DO jj = 2, jpjm1 
     
    329341            END DO 
    330342         END DO 
     343!$OMP END PARALLEL DO 
    331344         CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions 
    332345         ! 
    333346         !                                           !* horizontal Shapiro filter 
     347!$OMP PARALLEL DO PRIVATE(zcofwa, zcofw, zck) 
    334348         DO jk = 2, jpkm1 
    335349            DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    336350               DO ji = 2, jpim1 
    337                   zcofw = tmask(ji,jj,jk) * z1_16 
     351                  zcofwa = tmask(ji,jj,jk) * z1_16 
    338352                  wslpi(ji,jj,jk) = (          zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     & 
    339353                       &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     & 
    340354                       &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     & 
    341355                       &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   & 
    342                        &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofw 
     356                       &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * zcofwa 
    343357 
    344358                  wslpj(ji,jj,jk) = (          zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     & 
     
    346360                       &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     & 
    347361                       &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   & 
    348                        &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofw 
     362                       &                + 4.*  zww(ji  ,jj  ,jk)                         ) * zcofwa 
    349363               END DO 
    350364            END DO 
     
    422436         ! set the slope of diffusion to the slope of s-surfaces  
    423437         !      ( c a u t i o n : minus sign as fsdep has positive value )  
     438!$OMP PARALLEL DO 
    424439         DO jj = 2, jpjm1  
    425440            DO ji = fs_2, fs_jpim1   ! vector opt.  
     
    430445            END DO  
    431446         END DO  
    432  
     447!$OMP PARALLEL DO 
    433448         DO jk = 2, jpk  
    434449            DO jj = 2, jpjm1  
     
    746761      ! 
    747762      !                                            !==   surface mixed layer mask   ! 
     763!$OMP PARALLEL DO PRIVATE(ik) 
    748764      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    749765         DO jj = 1, jpj 
     
    770786      !----------------------------------------------------------------------- 
    771787      ! 
     788!$OMP PARALLEL DO PRIVATE(iku, ikv, zbu, zbv, zau, zav, ik, ikm1, zbw, & 
     789!$OMP&                    zci, zcj, zai, zaj, zbi, zbj) 
    772790      DO jj = 2, jpjm1 
    773791         DO ji = 2, jpim1 
     
    872890            ! set the slope of diffusion to the slope of s-surfaces 
    873891            !      ( c a u t i o n : minus sign as fsdep has positive value ) 
     892!$OMP PARALLEL DO 
    874893            DO jk = 1, jpk 
    875894               DO jj = 2, jpjm1 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90

    r6486 r9176  
    9494      REAL(wp), DIMENSION(2) ::   zsum 
    9595      REAL(wp), POINTER, DIMENSION(:,:) ::   zgcr 
     96      REAL(wp),     DIMENSION(jpi, jpj) ::   tmp1, tmp2 
    9697      !!---------------------------------------------------------------------- 
    9798      ! 
     
    109110      ! gcr   = gcb-a.gcx 
    110111      ! gcdes = gcr 
     112!$OMP PARALLEL DO PRIVATE(zgcad) 
    111113      DO jj = 2, jpjm1 
    112114         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    120122         END DO 
    121123      END DO 
     124!$OMP END PARALLEL DO  
    122125 
    123126      ! rnorme = (gcr,gcr) 
    124       rnorme = glob_sum(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  ) 
    125  
     127      tmp1 = 0. 
     128!$OMP PARALLEL DO  
     129      DO jj = 2, jpjm1 
     130         DO ji = fs_2, fs_jpim1   ! vector opt. 
     131            tmp1(ji, jj) = gcr(ji, jj) * gcdmat(ji, jj) * gcr(ji, jj) 
     132         END DO 
     133      END DO       
     134!$OMP END PARALLEL DO 
     135      rnorme = glob_sum(  tmp1(:,:)  ) 
    126136      CALL lbc_lnk( gcdes, c_solver_pt, 1. )   ! lateral boundary condition 
    127137 
    128138      ! gccd = matrix . gcdes 
     139      gccd = 0. 
     140!$OMP PARALLEL DO  
    129141      DO jj = 2, jpjm1 
    130142         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    134146         END DO 
    135147      END DO  
    136  
     148!$OMP END PARALLEL DO 
    137149      ! alph = (gcr,gcr)/(gcdes,gccd) 
    138       radd = glob_sum(  gcdes(:,:) * gcdmat(:,:) * gccd(:,:)  ) 
     150!$OMP PARALLEL DO  
     151      DO jj = 1, jpj 
     152         DO ji = 1, jpi 
     153            tmp1(ji, jj) = gcdes(ji, jj) * gcdmat(ji, jj) * gccd(ji, jj) 
     154         END DO 
     155      END DO       
     156!$OMP END PARALLEL DO 
     157      radd = glob_sum(  tmp1  ) 
    139158      alph = rnorme /radd 
    140159 
    141160      ! gcx = gcx + alph * gcdes 
    142161      ! gcr = gcr - alph * gccd 
     162!$OMP PARALLEL DO 
    143163      DO jj = 2, jpjm1 
    144164         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    147167         END DO 
    148168      END DO 
    149  
     169!$OMP END PARALLEL DO 
    150170      ! Algorithm wtih Eijkhout rearrangement 
    151171      ! ------------------------------------- 
     
    158178 
    159179         ! zgcr = matrix . gcr 
     180!$OMP PARALLEL DO 
    160181         DO jj = 2, jpjm1 
    161182            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    168189         ! rnorme = (gcr,gcr) 
    169190         rr = rnorme 
    170  
    171          ! zgcad = (zgcr,gcr)  
    172          zsum(1) = glob_sum(gcr(:,:) * gcdmat(:,:) * gcr(:,:)) 
    173          zsum(2) = glob_sum(gcr(:,:) * gcdmat(:,:) * zgcr(:,:) * bmask(:,:)) 
     191          
     192         ! zgcad = (zgcr,gcr) 
     193      tmp2 = 0. 
     194!$OMP PARALLEL 
     195!$OMP DO  
     196      DO jj = 1, jpj 
     197         DO ji = 1, jpi 
     198            tmp2(ji, jj) = gcr(ji, jj) * gcdmat(ji, jj) 
     199            tmp1(ji, jj) = tmp2(ji, jj) * gcr(ji, jj) 
     200         END DO 
     201      END DO       
     202!$OMP END DO 
     203!$OMP DO  
     204!DIR$ IVDEP 
     205      DO jj = 1, jpj 
     206!DIR$ IVDEP 
     207         DO ji = 1, jpi 
     208            tmp2(ji, jj) = tmp2(ji, jj) * zgcr(ji, jj) * bmask(ji, jj) 
     209         END DO 
     210      END DO       
     211!$OMP END DO 
     212!$OMP END PARALLEL 
     213  
     214!        zsum(1) = glob_sum(gcr(:,:) * gcdmat(:,:) * gcr(:,:)) 
     215!        zsum(2) = glob_sum(gcr(:,:) * gcdmat(:,:) * zgcr(:,:) * bmask(:,:)) 
     216         zsum = glob_asum_2d(tmp1, tmp2) 
    174217 
    175218         !!RB we should gather the 2 glob_sum 
     
    190233         ! gcx = gcx + alph * gcdes 
    191234         ! gcr = gcr - alph * gccd 
     235!$OMP PARALLEL DO 
    192236         DO jj = 2, jpjm1 
    193237            DO ji = fs_2, fs_jpim1   ! vector opt. 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r6793 r9176  
    231231      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    232232         ! 
     233!$OMP PARALLEL DO PRIVATE(zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    233234         DO jk = 1, jpkm1 
    234235            DO jj = 1, jpj 
     
    271272      CASE( 1 )                !==  simplified EOS  ==! 
    272273         ! 
     274!$OMP PARALLEL DO PRIVATE(zt, zs, zh, ztm, zn) 
    273275         DO jk = 1, jpkm1 
    274276            DO jj = 1, jpj 
     
    393395         ! Non-stochastic equation of state 
    394396         ELSE 
     397!$OMP PARALLEL DO PRIVATE(zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn0, zn) 
    395398            DO jk = 1, jpkm1 
    396399               DO jj = 1, jpj 
     
    435438      CASE( 1 )                !==  simplified EOS  ==! 
    436439         ! 
     440!$OMP PARALLEL DO PRIVATE(zt, zs, zh, ztm, zn) 
    437441         DO jk = 1, jpkm1 
    438442            DO jj = 1, jpj 
     
    493497      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    494498         ! 
     499!$OMP PARALLEL DO PRIVATE(zh, zt, zs, zn3, zn2, zn1, zn0, zn) 
    495500         DO jj = 1, jpjm1 
    496501            DO ji = 1, fs_jpim1   ! vector opt. 
     
    532537      CASE( 1 )                !==  simplified EOS  ==! 
    533538         ! 
     539!$OMP PARALLEL DO PRIVATE(zt, zs, zh, zn) 
    534540         DO jj = 1, jpjm1 
    535541            DO ji = 1, fs_jpim1   ! vector opt. 
     
    583589      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    584590         ! 
     591!$OMP PARALLEL DO PRIVATE(zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    585592         DO jk = 1, jpkm1 
    586593            DO jj = 1, jpj 
     
    640647      CASE( 1 )                  !==  simplified EOS  ==! 
    641648         ! 
     649!$OMP PARALLEL DO PRIVATE(zt, zs, zh, ztm, zn) 
    642650         DO jk = 1, jpkm1 
    643651            DO jj = 1, jpj 
     
    697705      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    698706         ! 
     707!$OMP PARALLEL DO PRIVATE(zh, zt, zs, zn3, zn2, zn1, zn0, zn) 
    699708         DO jj = 1, jpjm1 
    700709            DO ji = 1, fs_jpim1   ! vector opt. 
     
    755764      CASE( 1 )                  !==  simplified EOS  ==! 
    756765         ! 
     766!$OMP PARALLEL DO PRIVATE(zt, zs, zh, zn) 
    757767         DO jj = 1, jpjm1 
    758768            DO ji = 1, fs_jpim1   ! vector opt. 
     
    910920      IF( nn_timing == 1 ) CALL timing_start('bn2') 
    911921      ! 
     922!$OMP PARALLEL DO PRIVATE(zrw, zaw, zbw) 
    912923      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    913924         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
     
    962973      z1_T0   = 1._wp/40._wp 
    963974      ! 
     975!$OMP PARALLEL DO PRIVATE(zt, zs,ztm, zn, zd) 
    964976      DO jj = 1, jpj 
    965977         DO ji = 1, jpi 
     
    10161028      CASE ( -1, 1 )                !==  CT,SA (TEOS-10 formulation) ==! 
    10171029         ! 
     1030!$OMP PARALLEL DO PRIVATE(zs) 
    10181031         DO jj = 1, jpj 
    10191032            DO ji = 1, jpi 
     
    10231036            END DO 
    10241037         END DO 
    1025          ptf(:,:) = ptf(:,:) * psal(:,:) 
     1038!$OMP PARALLEL DO 
     1039         DO jj = 1, jpj 
     1040            DO ji = 1, jpi 
     1041               ptf(ji,jj) = ptf(ji,jj) * psal(ji,jj) 
     1042            END DO 
     1043         END DO 
    10261044         ! 
    10271045         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     
    10291047      CASE ( 0 )                     !==  PT,SP (UNESCO formulation)  ==! 
    10301048         ! 
    1031          ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
    1032             &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
     1049!$OMP PARALLEL DO 
     1050         DO jj = 1, jpj 
     1051            DO ji = 1, jpi 
     1052               ptf(ji,jj) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(ji,jj) )   & 
     1053            &                     - 2.154996e-4_wp *       psal(ji,jj)   ) * psal(ji,jj) 
     1054            END DO 
     1055         END DO 
    10331056            ! 
    10341057         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     
    11251148      CASE( -1, 0 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    11261149         ! 
     1150!$OMP PARALLEL DO PRIVATE(zh, zt, zs, ztm, zn2, zn1, zn0, zn) 
    11271151         DO jk = 1, jpkm1 
    11281152            DO jj = 1, jpj 
     
    11881212      CASE( 1 )                !==  Vallis (2006) simplified EOS  ==! 
    11891213         ! 
     1214!$OMP PARALLEL DO PRIVATE(zt, zs, zh, ztm, zn) 
    11901215         DO jk = 1, jpkm1 
    11911216            DO jj = 1, jpj 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r6795 r9176  
    120120         ! -------------------------------------------------------------------- 
    121121         ! upstream tracer flux in the i and j direction 
     122!$OMP PARALLEL DO PRIVATE(zfp_ui, zfm_ui, zfp_vj, zfm_vj) 
    122123         DO jk = 1, jpkm1 
    123124            DO jj = 1, jpjm1 
     
    133134            END DO 
    134135         END DO 
    135  
     136!$OMP END PARALLEL DO  
    136137         ! upstream tracer flux in the k direction 
    137138         ! Interior value 
     139!$OMP PARALLEL DO PRIVATE(zfp_wk, zfm_wk) 
    138140         DO jk = 2, jpkm1 
    139141            DO jj = 1, jpj 
     
    145147            END DO 
    146148         END DO 
     149!$OMP END PARALLEL DO 
    147150         ! Surface value 
    148151         IF( lk_vvl ) THEN    
     
    158161         ELSE                 
    159162            IF ( ln_isfcav ) THEN 
     163!$OMP PARALLEL DO  
    160164               DO jj = 1, jpj 
    161165                  DO ji = 1, jpi 
    162166                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    163167                  END DO 
    164                END DO    
     168               END DO 
     169!$OMP END PARALLEL DO    
    165170            ELSE 
    166171               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
     
    169174 
    170175         ! total advective trend 
     176!$OMP PARALLEL DO PRIVATE(z2dtt, ztra) 
    171177         DO jk = 1, jpkm1 
    172178            z2dtt = p2dt(jk) 
     
    183189            END DO 
    184190         END DO 
     191!$OMP END PARALLEL DO 
    185192         !                             ! Lateral boundary conditions on zwi  (unchanged sign) 
    186193         CALL lbc_lnk( zwi, 'T', 1. )   
     
    200207         ! -------------------------------------------------- 
    201208         ! antidiffusive flux on i and j 
     209!$OMP PARALLEL DO 
    202210         DO jk = 1, jpkm1 
    203211            DO jj = 1, jpjm1 
     
    208216            END DO 
    209217         END DO 
    210        
     218!$OMP END PARALLEL DO 
    211219         ! antidiffusive flux on k 
    212220         ! Interior value 
     221!$OMP PARALLEL DO 
    213222         DO jk = 2, jpkm1                     
    214223            DO jj = 1, jpj 
     
    218227            END DO 
    219228         END DO 
     229!$OMP END PARALLEL DO 
    220230         ! surface value 
    221231         IF ( ln_isfcav ) THEN 
     
    238248         ! 5. final trend with corrected fluxes 
    239249         ! ------------------------------------ 
     250!$OMP PARALLEL DO PRIVATE(zbtr, ztra) 
    240251         DO jk = 1, jpkm1 
    241252            DO jj = 2, jpjm1 
     
    251262            END DO 
    252263         END DO 
    253  
     264!$OMP END PARALLEL DO 
    254265         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    255266         IF( l_trd )  THEN  
     
    356367         ! -------------------------------------------------------------------- 
    357368         ! upstream tracer flux in the i and j direction 
     369!$OMP PARALLEL DO PRIVATE(zfp_ui, zfm_ui, zfp_vj, zfm_vj) 
    358370         DO jk = 1, jpkm1 
    359371            DO jj = 1, jpjm1 
     
    369381            END DO 
    370382         END DO 
    371  
     383!$OMP END PARALLEL DO 
    372384         ! upstream tracer flux in the k direction 
    373385         ! Interior value 
     386!$OMP PARALLEL DO PRIVATE(zfp_wk, zfm_wk) 
    374387         DO jk = 2, jpkm1 
    375388            DO jj = 1, jpj 
     
    381394            END DO 
    382395         END DO 
     396!$OMP END PARALLEL DO 
    383397         ! Surface value 
    384398         IF( lk_vvl ) THEN 
     
    394408         ELSE 
    395409            IF ( ln_isfcav ) THEN 
     410!$OMP PARALLEL DO  
    396411               DO jj = 1, jpj 
    397412                  DO ji = 1, jpi 
     
    399414                  END DO 
    400415               END DO 
     416!$OMP END PARALLEL DO 
    401417            ELSE 
    402418               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)                                               ! linear free surface + no isf 
     
    405421 
    406422         ! total advective trend 
     423!$OMP PARALLEL DO PRIVATE(z2dtt, ztra) 
    407424         DO jk = 1, jpkm1 
    408425            z2dtt = p2dt(jk) 
     
    419436            END DO 
    420437         END DO 
     438!$OMP END PARALLEL DO 
    421439         !                             ! Lateral boundary conditions on zwi  (unchanged sign) 
    422440         CALL lbc_lnk( zwi, 'T', 1. )   
     
    437455         ! antidiffusive flux on i and j 
    438456         ! 
     457!$OMP PARALLEL DO  
    439458         DO jk = 1, jpkm1 
    440459            ! 
     
    463482            END DO 
    464483         END DO 
    465        
     484!$OMP END PARALLEL DO       
    466485         ! antidiffusive flux on k 
    467486         zwz(:,:,1) = 0._wp        ! Surface value 
     
    489508              jta = MOD(jta,3) + 1 
    490509            ENDIF 
     510!$OMP PARALLEL DO 
    491511            DO jk = 2, jpkm1          ! Interior value 
    492512               DO jj = 2, jpjm1 
     
    497517               END DO 
    498518            END DO 
    499  
     519!$OMP END PARALLEL DO 
    500520            jtaken = MOD( jtaken + 1 , 2 ) 
    501  
     521!$OMP PARALLEL DO PRIVATE (zbtr, ztra) 
    502522            DO jk = 2, jpkm1          ! Interior value 
    503523               DO jj = 2, jpjm1 
     
    510530               END DO 
    511531            END DO 
    512  
    513          END DO 
    514  
     532!$OMP END PARALLEL DO 
     533         END DO 
     534!$OMP PARALLEL DO  
    515535         DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping 
    516536            DO jj = 2, jpjm1 
     
    520540            END DO 
    521541         END DO 
     542!$OMP END PARALLEL DO 
    522543         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions 
    523544         CALL lbc_lnk( zwz, 'W',  1. ) 
     
    530551         ! 5. final trend with corrected fluxes 
    531552         ! ------------------------------------ 
     553!$OMP PARALLEL DO PRIVATE(zbtr, ztra) 
    532554         DO jk = 1, jpkm1 
    533555            DO jj = 2, jpjm1 
     
    543565            END DO 
    544566         END DO 
    545  
     567!$OMP END PARALLEL DO 
    546568         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    547569         IF( l_trd )  THEN  
     
    612634         &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    613635 
     636!$OMP PARALLEL DO PRIVATE(ikm1, z2dtt, zup, zdo, zpos, zneg, zbt) 
    614637      DO jk = 1, jpkm1 
    615638         ikm1 = MAX(jk-1,1) 
     
    647670         END DO 
    648671      END DO 
     672!$OMP END PARALLEL DO 
    649673      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
    650674 
    651675      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    652676      ! ---------------------------------------- 
     677!$OMP PARALLEL DO PRIVATE(zau, zbu, zcu, zav, zbv, zcv, za, zb, zc) 
    653678      DO jk = 1, jpkm1 
    654679         DO jj = 2, jpjm1 
     
    673698         END DO 
    674699      END DO 
     700!$OMP END PARALLEL DO 
    675701      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    676702      ! 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r6486 r9176  
    8989      ! 
    9090      !                             !  Add the geothermal heat flux trend on temperature 
     91!$OMP PARALLEL DO PRIVATE(ik, zqgh_trd) 
    9192      DO jj = 2, jpjm1 
    9293         DO ji = 2, jpim1 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r6486 r9176  
    108108      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    109109      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
    110       REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
     110      REAL(wp), DIMENSION(jpi,jpj  ) ::  z2d 
    111111      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdkt, zdk1t, zdit, zdjt, ztfw  
    112112      !!---------------------------------------------------------------------- 
     
    114114      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso') 
    115115      ! 
    116       CALL wrk_alloc( jpi, jpj,      z2d )  
     116!     CALL wrk_alloc( jpi, jpj,      z2d )  
    117117      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
    118118      ! 
     
    137137 
    138138         ! Horizontal tracer gradient  
     139!$OMP PARALLEL DO 
    139140         DO jk = 1, jpkm1 
    140141            DO jj = 1, jpjm1 
     
    145146            END DO 
    146147         END DO 
     148!$OMP END PARALLEL DO 
    147149 
    148150         ! partial cell correction 
    149151         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level  
     152!$OMP PARALLEL DO 
    150153            DO jj = 1, jpjm1 
    151154               DO ji = 1, fs_jpim1   ! vector opt. 
     
    157160         ENDIF 
    158161         IF( ln_zps .AND. ln_isfcav ) THEN      ! partial steps correction at the first wet level beneath a cavity 
     162!$OMP PARALLEL DO 
    159163            DO jj = 1, jpjm1 
    160164               DO ji = 1, fs_jpim1   ! vector opt. 
     
    173177         !  
    174178         ! interior value  
     179!$OMP PARALLEL DO 
    175180         DO jk = 2, jpkm1                
    176181            DO jj = 1, jpj 
     
    182187            END DO 
    183188         END DO 
     189!$OMP END PARALLEL DO 
    184190         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
    185191         zdk1t(:,:,1) = ( ptb(:,:,1,jn  ) - ptb(:,:,2,jn) ) * wmask(:,:,2) 
    186192         zdkt (:,:,1) = zdk1t(:,:,1) 
    187193         IF ( ln_isfcav ) THEN 
     194!$OMP PARALLEL DO PRIVATE(ikt) 
    188195            DO jj = 1, jpj 
    189196               DO ji = 1, jpi   ! vector opt. 
     
    193200               END DO 
    194201            END DO 
     202!$OMP END PARALLEL DO 
    195203         END IF 
    196204 
    197205         ! 2. Horizontal fluxes 
    198206         ! --------------------    
     207!$OMP PARALLEL DO PRIVATE(zabe1, zabe2, zmsku, zmskv, zcof1, zcof2, zbtr, ztra) 
    199208         DO jk = 1, jpkm1 
    200209            DO jj = 1 , jpjm1 
     
    233242         END DO                                        !   End of slab   
    234243         !                                             ! =============== 
     244!$OMP END PARALLEL DO 
    235245         ! 
    236246         ! "Poleward" diffusive heat or salt transports (T-S case only) 
     
    245255           IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    246256               z2d(:,:) = 0._wp  
     257!$OMP PARALLEL DO REDUCTION(+:z2d) 
    247258               DO jk = 1, jpkm1 
    248259                  DO jj = 2, jpjm1 
     
    252263                  END DO 
    253264               END DO 
     265 
    254266               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     267 
    255268               CALL lbc_lnk( z2d, 'U', -1. ) 
    256269               CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    257270               ! 
    258271               z2d(:,:) = 0._wp  
     272!$OMP PARALLEL DO REDUCTION(+:z2d) 
    259273               DO jk = 1, jpkm1 
    260274                  DO jj = 2, jpjm1 
     
    264278                  END DO 
    265279               END DO 
     280 
    266281               z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
    267282               CALL lbc_lnk( z2d, 'V', -1. ) 
     
    286301          
    287302         ! interior (2=<jk=<jpk-1) 
     303!$OMP PARALLEL DO PRIVATE(zcoef0, zmsku, zmskv, zcoef3, zcoef4 ) 
    288304         DO jk = 2, jpkm1 
    289305            DO jj = 2, jpjm1 
     
    306322            END DO 
    307323         END DO 
    308           
     324!$OMP END PARALLEL DO          
    309325          
    310326         ! I.5 Divergence of vertical fluxes added to the general tracer trend 
    311327         ! ------------------------------------------------------------------- 
     328!$OMP PARALLEL DO PRIVATE(zbtr, ztra) 
    312329         DO jk = 1, jpkm1 
    313330            DO jj = 2, jpjm1 
     
    319336            END DO 
    320337         END DO 
     338!$OMP END PARALLEL DO 
    321339         ! 
    322340      END DO 
    323341      ! 
    324       CALL wrk_dealloc( jpi, jpj, z2d )  
     342!     CALL wrk_dealloc( jpi, jpj, z2d )  
    325343      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t )  
    326344      ! 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r6487 r9176  
    153153     ! trends computation 
    154154      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
     155!$OMP PARALLEL DO PRIVATE(zfact) 
    155156         DO jk = 1, jpkm1 
    156157            zfact = 1._wp / r2dtra(jk)              
     
    304305      ! 
    305306      DO jn = 1, kjpt       
     307!$OMP PARALLEL DO PRIVATE(zfact1, zfact2, ze3t_b, ze3t_n, ze3t_a, ztc_b, ztc_n, ztc_a, ze3t_d, ztc_d, & 
     308!$OMP&                    ze3t_f, ztc_f, ze3t_d) 
    306309         DO jk = 1, jpkm1 
    307310            zfact1 = atfp * p2dt(jk) 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r6486 r9176  
    129129            ! isoneutral diffusion: add the contribution  
    130130            IF( ln_traldf_grif    ) THEN     ! Griffies isoneutral diff 
     131!$OMP PARALLEL DO 
    131132               DO jk = 2, jpkm1 
    132133                  DO jj = 2, jpjm1 
     
    137138               END DO 
    138139            ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff 
     140!$OMP PARALLEL DO 
    139141               DO jk = 2, jpkm1 
    140142                  DO jj = 2, jpjm1 
     
    149151#endif 
    150152            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
     153!$OMP PARALLEL DO PRIVATE(ze3ta, ze3tn) 
    151154            DO jk = 1, jpkm1 
    152155               DO jj = 2, jpjm1 
     
    187190               END DO 
    188191            END DO 
     192 
     193!$OMP PARALLEL 
    189194            DO jk = 2, jpkm1 
     195!$OMP DO 
    190196               DO jj = 2, jpjm1 
    191197                  DO ji = fs_2, fs_jpim1 
     
    193199                  END DO 
    194200               END DO 
    195             END DO 
     201!$OMP END DO 
     202            END DO 
     203!$OMP END PARALLEL 
    196204            ! 
    197205         END IF  
    198206         !          
    199207         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     208!$OMP PARALLEL DO PRIVATE(ze3tb, ze3tn) 
    200209         DO jj = 2, jpjm1 
    201210            DO ji = fs_2, fs_jpim1 
     
    206215            END DO 
    207216         END DO 
     217 
     218!$OMP PARALLEL 
    208219         DO jk = 2, jpkm1 
     220!$OMP DO PRIVATE(ze3tb, ze3tn, zrhs) 
    209221            DO jj = 2, jpjm1 
    210222               DO ji = fs_2, fs_jpim1 
     
    215227               END DO 
    216228            END DO 
    217          END DO 
    218  
     229!$OMP END DO 
     230         END DO 
     231!$OMP END PARALLEL 
    219232         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer) 
     233!$OMP PARALLEL  
     234!$OMP DO  
    220235         DO jj = 2, jpjm1 
    221236            DO ji = fs_2, fs_jpim1 
     
    223238            END DO 
    224239         END DO 
     240 
    225241         DO jk = jpk-2, 1, -1 
     242!$OMP DO 
    226243            DO jj = 2, jpjm1 
    227244               DO ji = fs_2, fs_jpim1 
     
    230247               END DO 
    231248            END DO 
    232          END DO 
     249!$OMP END DO 
     250         END DO 
     251!$OMP END PARALLEL 
    233252         !                                            ! ================= ! 
    234253      END DO                                          !  end tracer loop  ! 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r6486 r9176  
    127127            zwt(:,:, 1 ) = 0._wp   ;   zws(:,:, 1 ) = 0._wp            ! vertical diffusive fluxes 
    128128            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
     129!$OMP PARALLEL DO 
    129130            DO jk = 2, jpk 
    130131               zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     
    133134            ! 
    134135            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
     136!$OMP PARALLEL DO 
    135137            DO jk = 1, jpkm1 
    136138               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 
     
    142144            ! 
    143145         CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng 
    144             ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
     146!$OMP PARALLEL DO 
     147           DO jk = 1, jpk 
     148              ztrds(:,:,jk) = ptrd(:,:,jk) * tmask(:,:,jk) 
     149           ENDDO 
    145150            CALL trd_tra_mng( trdt, ztrds, ktrd, kt )   
    146151         END SELECT 
     
    200205      ptrd(:,:,jpk) = 0._wp 
    201206      ! 
     207!$OMP PARALLEL DO 
    202208      DO jk = 1, jpkm1         ! advective trend 
    203209         DO jj = 2, jpjm1 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r6486 r9176  
    7777         zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application 
    7878         ! 
     79!$OMP PARALLEL DO 
    7980         DO jk = 1, jpkm1  
    8081            DO jj = 2, jpj             ! no vector opt. 
     
    103104         ! 
    104105      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12)  
     106!$OMP PARALLEL DO 
    105107         DO jk = 1, jpkm1 
    106108!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!  
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r6498 r9176  
    227227      REAL(wp) ::   zbbrau, zesh2                   ! temporary scalars 
    228228      REAL(wp) ::   zfact1, zfact2, zfact3          !    -         - 
    229       REAL(wp) ::   ztx2  , zty2  , zcof            !    -         - 
    230       REAL(wp) ::   ztau  , zdif                    !    -         - 
     229      REAL(wp) ::   ztx2  , zty2  , zcof, zcofa     !    -         - 
     230      REAL(wp) ::   ztau  , zdif, zdifa             !    -         - 
    231231      REAL(wp) ::   zus   , zwlc  , zind            !    -         - 
    232232      REAL(wp) ::   zzd_up, zzd_lw                  !    -         - 
     
    253253      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    254254      IF ( ln_isfcav ) THEN 
     255!$OMP PARALLEL DO 
    255256         DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin 
    256257            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    259260         END DO 
    260261      END IF 
     262!$OMP PARALLEL DO 
    261263      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    262264         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    296298         !                        !* total energy produce by LC : cumulative sum over jk 
    297299         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1) 
     300!$OMP PARALLEL 
    298301         DO jk = 2, jpk 
    299             zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk) 
    300          END DO 
     302!$OMP DO 
     303            DO jj = 1, jpj 
     304                  zpelc(:,jj,jk)  = zpelc(:,jj,jk-1) + MAX( rn2b(:,jj,jk), 0._wp ) * fsdepw(:,jj,jk) * fse3w(:,jj,jk) 
     305            END DO 
     306!$OMP END DO 
     307         END DO 
     308!$OMP END PARALLEL 
    301309         !                        !* finite Langmuir Circulation depth 
    302310         zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 
     311         zcofa = 0.016 / SQRT( zrhoa * zcdrag ) 
    303312         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
     313!$OMP PARALLEL SHARED(imlc) 
    304314         DO jk = jpkm1, 2, -1 
     315!$OMP DO PRIVATE(zus) 
    305316            DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us  
    306317               DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1) 
     
    309320               END DO 
    310321            END DO 
     322!$OMP END DO 
    311323         END DO 
    312324         !                               ! finite LC depth 
     325!$OMP DO 
    313326         DO jj = 1, jpj  
    314327            DO ji = 1, jpi 
     
    316329            END DO 
    317330         END DO 
    318          zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    319 !CDIR NOVERRCHK 
     331!$OMP END DO 
     332!         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
     333!$OMP DO PRIVATE(zus, zind, zwlc) 
    320334         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    321 !CDIR NOVERRCHK 
    322             DO jj = 2, jpjm1 
    323 !CDIR NOVERRCHK 
    324                DO ji = fs_2, fs_jpim1   ! vector opt. 
    325                   zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
     335            DO jj = 2, jpjm1 
     336               DO ji = fs_2, fs_jpim1   ! vector opt. 
     337                  zus  = zcofa * SQRT( taum(ji,jj) )           ! Stokes drift 
    326338                  !                                           ! vertical velocity due to LC 
    327339                  zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) ) 
     
    333345            END DO 
    334346         END DO 
     347!$OMP END DO 
     348!$OMP END PARALLEL 
    335349         ! 
    336350      ENDIF 
     
    343357      !                     ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 
    344358      ! 
     359!$OMP PARALLEL DO 
    345360      DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
    346361         DO jj = 1, jpj                 ! here avmu, avmv used as workspace 
     
    358373      END DO 
    359374      ! 
     375!$OMP PARALLEL DO PRIVATE(zcof, zzd_up, zzd_lw, zesh2) 
    360376      DO jk = 2, jpkm1           !* Matrix and right hand side in en 
    361377         DO jj = 2, jpjm1 
     
    390406      END DO 
    391407      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
     408!$OMP PARALLEL 
    392409      DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     410!$OMP DO  
    393411         DO jj = 2, jpjm1 
    394412            DO ji = fs_2, fs_jpim1    ! vector opt. 
     
    396414            END DO 
    397415         END DO 
    398       END DO 
     416!$OMP END DO 
     417      END DO 
     418!$OMP END PARALLEL 
    399419      ! 
    400420      ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
     421!$OMP PARALLEL DO 
    401422      DO jj = 2, jpjm1 
    402423         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    404425         END DO 
    405426      END DO 
     427!$OMP PARALLEL 
    406428      DO jk = 3, jpkm1 
     429!$OMP DO 
    407430         DO jj = 2, jpjm1 
    408431            DO ji = fs_2, fs_jpim1    ! vector opt. 
     
    410433            END DO 
    411434         END DO 
    412       END DO 
     435!$OMP END DO 
     436      END DO 
     437!$OMP END PARALLEL 
    413438      ! 
    414439      ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
     440!$OMP PARALLEL DO 
    415441      DO jj = 2, jpjm1 
    416442         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    418444         END DO 
    419445      END DO 
     446!$OMP PARALLEL 
    420447      DO jk = jpk-2, 2, -1 
     448!$OMP DO 
    421449         DO jj = 2, jpjm1 
    422450            DO ji = fs_2, fs_jpim1    ! vector opt. 
     
    424452            END DO 
    425453         END DO 
    426       END DO 
     454!$OMP END DO 
     455      END DO 
     456!$OMP END PARALLEL 
     457!$OMP PARALLEL DO 
    427458      DO jk = 2, jpkm1                             ! set the minimum value of tke 
    428459         DO jj = 2, jpjm1 
     
    440471      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    441472      IF( nn_htau == 2 ) THEN           !* mixed-layer depth dependant length scale 
     473!$OMP PARALLEL DO 
    442474         DO jj = 2, jpjm1 
    443475            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    452484      ! 
    453485      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
     486!$OMP PARALLEL DO 
    454487         DO jk = 2, jpkm1 
    455488            DO jj = 2, jpjm1 
     
    461494         END DO 
    462495      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
     496!$OMP PARALLEL DO PRIVATE(jk) 
    463497         DO jj = 2, jpjm1 
    464498            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    469503         END DO 
    470504      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    471 !CDIR NOVERRCHK 
     505!$OMP PARALLEL DO PRIVATE(ztx2, zty2, ztau, zdif, zdifa) 
    472506         DO jk = 2, jpkm1 
    473 !CDIR NOVERRCHK 
    474             DO jj = 2, jpjm1 
    475 !CDIR NOVERRCHK 
     507            DO jj = 2, jpjm1 
    476508               DO ji = fs_2, fs_jpim1   ! vector opt. 
    477509                  ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
    478510                  zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
    479511                  ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress  
    480                   zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean  
    481                   zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
     512                  zdifa = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean  
     513                  zdif = rhftau_scl * MAX( 0._wp, zdifa + rhftau_add )  ! apply some modifications... 
    482514                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    483515                     &                        * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     
    487519      ELSEIF( nn_etau == 4 ) THEN       !* column integral independant of htau (rn_efr must be scaled up) 
    488520         IF( nn_htau == 2 ) THEN        ! efr dependant on time-varying htau  
     521!$OMP PARALLEL DO 
    489522            DO jj = 2, jpjm1 
    490523               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    493526            END DO 
    494527         ENDIF 
     528!$OMP PARALLEL DO 
    495529         DO jk = 2, jpkm1 
    496530            DO jj = 2, jpjm1 
     
    504538      CALL lbc_lnk( en, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
    505539      ! 
     540!$OMP PARALLEL DO 
    506541      DO jk = 2, jpkm1                             ! TKE budget: near-inertial waves term   
    507542         DO jj = 2, jpjm1   
     
    580615      ! 
    581616      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 
     617!$OMP PARALLEL DO PRIVATE(zraug) 
    582618         DO jj = 2, jpjm1 
    583619            DO ji = fs_2, fs_jpim1 
     
    590626      ENDIF 
    591627      ! 
    592 !CDIR NOVERRCHK 
     628!$OMP PARALLEL DO PRIVATE(zrn2) 
    593629      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2) 
    594 !CDIR NOVERRCHK 
    595630         DO jj = 2, jpjm1 
    596 !CDIR NOVERRCHK 
    597631            DO ji = fs_2, fs_jpim1   ! vector opt. 
    598632               zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
     
    611645      ! where wmask = 0 set zmxlm == fse3w 
    612646      CASE ( 0 )           ! bounded by the distance to surface and bottom 
     647!$OMP PARALLEL DO PRIVATE(zemxl) 
    613648         DO jk = 2, jpkm1 
    614649            DO jj = 2, jpjm1 
     
    624659         ! 
    625660      CASE ( 1 )           ! bounded by the vertical scale factor 
     661!$OMP PARALLEL DO PRIVATE(zemxl) 
    626662         DO jk = 2, jpkm1 
    627663            DO jj = 2, jpjm1 
     
    635671         ! 
    636672      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
     673!$OMP PARALLEL 
    637674         DO jk = 2, jpkm1         ! from the surface to the bottom : 
     675!$OMP DO 
    638676            DO jj = 2, jpjm1 
    639677               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    643681         END DO 
    644682         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : 
     683!$OMP DO PRIVATE(zemxl) 
    645684            DO jj = 2, jpjm1 
    646685               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    651690            END DO 
    652691         END DO 
     692!$OMP END PARALLEL 
    653693         ! 
    654694      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
     695!$OMP PARALLEL 
    655696         DO jk = 2, jpkm1         ! from the surface to the bottom : lup 
     697!$OMP DO 
    656698            DO jj = 2, jpjm1 
    657699               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    661703         END DO 
    662704         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown 
     705!$OMP DO 
    663706            DO jj = 2, jpjm1 
    664707               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    667710            END DO 
    668711         END DO 
    669 !CDIR NOVERRCHK 
     712!$OMP DO PRIVATE(zemlm, zemlp) 
    670713         DO jk = 2, jpkm1 
    671 !CDIR NOVERRCHK 
    672             DO jj = 2, jpjm1 
    673 !CDIR NOVERRCHK 
     714            DO jj = 2, jpjm1 
    674715               DO ji = fs_2, fs_jpim1   ! vector opt. 
    675716                  zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
     
    680721            END DO 
    681722         END DO 
     723!$OMP END PARALLEL 
    682724         ! 
    683725      END SELECT 
     
    691733      !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt) 
    692734      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    693 !CDIR NOVERRCHK 
    694735      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points 
    695 !CDIR NOVERRCHK 
    696736         DO jj = 2, jpjm1 
    697 !CDIR NOVERRCHK 
    698737            DO ji = fs_2, fs_jpim1   ! vector opt. 
    699738               zsqen = SQRT( en(ji,jj,jk) ) 
     
    894933      ENDIF 
    895934      !                               !* set vertical eddy coef. to the background value 
     935!$OMP PARALLEL DO 
    896936      DO jk = 1, jpk 
    897937         avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
     
    959999        ELSE                                   !* Start from rest 
    9601000           en(:,:,:) = rn_emin * tmask(:,:,:) 
     1001!$OMP PARALLEL DO 
    9611002           DO jk = 1, jpk                           ! set the Kz to the background value 
    9621003              avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r6498 r9176  
    111111      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    112112      REAL(wp) ::   ztpc         ! scalar workspace 
    113       REAL(wp), POINTER, DIMENSION(:,:) ::   zkz 
     113      REAL(wp), DIMENSION(jpi,jpj) ::   zkz 
    114114      !!---------------------------------------------------------------------- 
    115115      ! 
    116116      IF( nn_timing == 1 )  CALL timing_start('zdf_tmx') 
    117117      ! 
    118       CALL wrk_alloc( jpi,jpj, zkz ) 
     118!     CALL wrk_alloc( jpi,jpj, zkz ) 
    119119 
    120120      !                          ! ----------------------- ! 
     
    128128         zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
    129129      END DO 
    130  
    131130      DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    132131         DO ji = 1, jpi 
     
    134133         END DO 
    135134      END DO 
    136  
    137135      DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 
    138136         DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
     
    142140         END DO 
    143141      END DO 
    144  
    145142      IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide 
    146143         ztpc = 0.e0 
     
    166163      !                          !   Update  mixing coefs  !                           
    167164      !                          ! ----------------------- ! 
     165!$OMP PARALLEL DO 
    168166      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing 
    169167         DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
     
    174172         END DO 
    175173      END DO 
    176        
     174!$OMP PARALLEL DO 
    177175      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing 
    178176         DO jj = 2, jpjm1 
     
    190188      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_tide , clinfo1=' tmx - av_tide: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk) 
    191189      ! 
    192       CALL wrk_dealloc( jpi,jpj, zkz ) 
     190!     CALL wrk_dealloc( jpi,jpj, zkz ) 
    193191      ! 
    194192      IF( nn_timing == 1 )  CALL timing_stop('zdf_tmx') 
     
    222220      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    223221      REAL(wp) ::   zcoef, ztpc   ! temporary scalar 
    224       REAL(wp), DIMENSION(:,:)  , POINTER ::   zkz                        ! 2D workspace 
    225       REAL(wp), DIMENSION(:,:)  , POINTER ::   zsum1 , zsum2 , zsum       !  -      - 
     222      REAL(wp), DIMENSION(jpi, jpj) ::   zkz                        ! 2D workspace 
     223      REAL(wp), DIMENSION(jpi, jpj) ::   zsum1 , zsum2 , zsum       !  -      - 
    226224      REAL(wp), DIMENSION(:,:,:), POINTER ::   zempba_3d_1, zempba_3d_2   ! 3D workspace 
    227225      REAL(wp), DIMENSION(:,:,:), POINTER ::   zempba_3d  , zdn2dz        !  -      - 
     
    231229      IF( nn_timing == 1 )  CALL timing_start('tmx_itf') 
    232230      ! 
    233       CALL wrk_alloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum ) 
     231!     CALL wrk_alloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum ) 
    234232      CALL wrk_alloc( jpi,jpj,jpk, zempba_3d_1, zempba_3d_2, zempba_3d, zdn2dz, zavt_itf ) 
    235233 
     
    237235      zempba_3d_1(:,:,jpk) = 0.e0 
    238236      zempba_3d_2(:,:,jpk) = 0.e0 
     237!$OMP PARALLEL DO 
    239238      DO jk = 1, jpkm1              
    240239         zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz 
    241 !CDIR NOVERRCHK 
    242240         zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N 
    243241         zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2 
     
    257255         END DO 
    258256      END DO 
    259  
    260257      DO jk= 1, jpk 
    261258         DO jj = 1, jpj 
     
    313310 
    314311      !                             ! Update pav with the ITF mixing coefficient 
     312!$OMP PARALLEL DO 
    315313      DO jk = 2, jpkm1 
    316314         pav(:,:,jk) = pav     (:,:,jk) * ( 1.e0 - mask_itf(:,:) )   & 
     
    318316      END DO 
    319317      ! 
    320       CALL wrk_dealloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum ) 
     318!     CALL wrk_dealloc( jpi,jpj, zkz, zsum1 , zsum2 , zsum ) 
    321319      CALL wrk_dealloc( jpi,jpj,jpk, zempba_3d_1, zempba_3d_2, zempba_3d, zdn2dz, zavt_itf ) 
    322320      ! 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r6486 r9176  
    2727   PUBLIC   DDPDD      ! also used in closea module 
    2828   PUBLIC   glob_min, glob_max 
     29   PUBLIC   glob_asum_2d 
    2930#if defined key_nosignedzero 
    3031   PUBLIC SIGN 
     
    189190   END FUNCTION glob_sum_1d 
    190191 
    191    FUNCTION glob_sum_2d( ptab ) 
    192       !!---------------------------------------------------------------------- 
    193       !!                  ***  FUNCTION  glob_sum_2d *** 
     192   FUNCTION sum_2d_ref( ptab ) 
     193      !!---------------------------------------------------------------------- 
     194      !!                  ***  FUNCTION  sum_2d_ref *** 
    194195      !! 
    195196      !! ** Purpose : perform a sum in calling DDPDD routine 
    196197      !!---------------------------------------------------------------------- 
    197198      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
    198       REAL(wp)                             ::   glob_sum_2d   ! global masked sum 
     199      COMPLEX(wp)                          ::   sum_2d_ref   ! global masked sum 
    199200      !! 
    200201      COMPLEX(wp)::   ctmp 
    201202      REAL(wp)   ::   ztmp 
     203!$    COMPLEX(wp)::   comp 
    202204      INTEGER    ::   ji, jj   ! dummy loop indices 
    203205      !!----------------------------------------------------------------------- 
    204206      ! 
    205       ztmp = 0.e0 
    206207      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     208!$    comp = CMPLX( 0.e0, 0.e0, wp ) 
     209!$OMP PARALLEL FIRSTPRIVATE(ctmp) PRIVATE(ztmp) SHARED(comp) 
     210!$OMP DO 
    207211      DO jj = 1, jpj 
    208212         DO ji =1, jpi 
     
    211215         END DO 
    212216      END DO 
     217!$OMP ENDDO 
     218!$OMP CRITICAL 
     219!$    CALL DDPDD( ctmp, comp )  
     220!$OMP END CRITICAL 
     221!$OMP END PARALLEL 
     222!$    ctmp = comp 
     223      sum_2d_ref = ctmp 
     224      ! 
     225   END FUNCTION sum_2d_ref 
     226 
     227   FUNCTION glob_sum_2d( ptab ) 
     228      !!---------------------------------------------------------------------- 
     229      !!                  ***  FUNCTION  glob_sum_2d *** 
     230      !! 
     231      !! ** Purpose : perform a sum in calling DDPDD routine 
     232      !!---------------------------------------------------------------------- 
     233      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     234      REAL(wp)                             ::   glob_sum_2d   ! global masked sum 
     235      !! 
     236      COMPLEX(wp)::   ctmp 
     237      REAL(wp)   ::   ztmp 
     238      INTEGER    ::   ji, jj   ! dummy loop indices 
     239      !!----------------------------------------------------------------------- 
     240      ! 
     241      ctmp = sum_2d_ref(ptab) 
    213242      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    214243      glob_sum_2d = REAL(ctmp,wp) 
     
    228257      COMPLEX(wp)::   ctmp 
    229258      REAL(wp)   ::   ztmp 
     259!$    COMPLEX(wp)::   comp 
    230260      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    231261      INTEGER    ::   ijpk ! local variables: size of ptab 
     
    234264      ijpk = SIZE(ptab,3) 
    235265      ! 
    236       ztmp = 0.e0 
    237266      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     267!$    comp = CMPLX( 0.e0, 0.e0, wp ) 
     268!$OMP PARALLEL FIRSTPRIVATE(ctmp) PRIVATE(ztmp) SHARED(comp) 
     269!$OMP DO 
    238270      DO jk = 1, ijpk 
    239271         DO jj = 1, jpj 
     
    244276         END DO 
    245277      END DO 
     278!$OMP ENDDO 
     279!$OMP CRITICAL 
     280!$    CALL DDPDD( ctmp, comp )  
     281!$OMP END CRITICAL 
     282!$OMP END PARALLEL 
     283!$    ctmp = comp 
    246284      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    247285      glob_sum_3d = REAL(ctmp,wp) 
     
    261299      COMPLEX(wp)::   ctmp 
    262300      REAL(wp)   ::   ztmp 
     301!$    COMPLEX(wp)::   comp 
    263302      INTEGER    ::   ji, jj   ! dummy loop indices 
    264303      !!----------------------------------------------------------------------- 
     
    266305      ztmp = 0.e0 
    267306      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     307!$    comp = CMPLX( 0.e0, 0.e0, wp ) 
     308!$OMP PARALLEL FIRSTPRIVATE(ctmp) PRIVATE(ztmp) SHARED(comp) 
     309!$OMP DO 
    268310      DO jj = 1, jpj 
    269311         DO ji =1, jpi 
     
    274316         END DO 
    275317      END DO 
     318!$OMP ENDDO 
     319!$OMP CRITICAL 
     320!$    CALL DDPDD( ctmp, comp )  
     321!$OMP END CRITICAL 
     322!$OMP END PARALLEL 
     323!$    ctmp = comp 
    276324      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    277325      glob_sum_2d_a = REAL(ctmp,wp) 
     
    279327   END FUNCTION glob_sum_2d_a 
    280328 
     329   FUNCTION glob_asum_2d( ptab1, ptab2 ) 
     330      !!---------------------------------------------------------------------- 
     331      !!                  ***  FUNCTION  glob_sum_2d_a *** 
     332      !! 
     333      !! ** Purpose : perform a sum on two 2D arrays in calling DDPDD routine 
     334      !!---------------------------------------------------------------------- 
     335      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2 
     336      REAL(wp),             DIMENSION(2)   ::   glob_asum_2d   ! global masked sum 
     337      !! 
     338      COMPLEX(wp),          DIMENSION(2)   ::   ctmp 
     339      !!----------------------------------------------------------------------- 
     340      ! 
     341      ctmp(1) =  sum_2d_ref(ptab1) 
     342      ctmp(2) =  sum_2d_ref(ptab2) 
     343      IF( lk_mpp )   CALL mpp_sum( ctmp, 2 )   ! sum over the global domain 
     344      glob_asum_2d = REAL(ctmp,wp) 
     345      ! 
     346   END FUNCTION glob_asum_2d 
    281347 
    282348   FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 
     
    291357      COMPLEX(wp)::   ctmp 
    292358      REAL(wp)   ::   ztmp 
     359!$    COMPLEX(wp)::   comp 
    293360      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    294361      INTEGER    ::   ijpk ! local variables: size of ptab 
     
    299366      ztmp = 0.e0 
    300367      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     368!$    comp = CMPLX( 0.e0, 0.e0, wp ) 
     369!$OMP PARALLEL FIRSTPRIVATE(ctmp) PRIVATE(ztmp) SHARED(comp) 
     370!$OMP DO 
    301371      DO jk = 1, ijpk 
    302372         DO jj = 1, jpj 
     
    309379         END DO     
    310380      END DO 
     381!$OMP ENDDO 
     382!$OMP CRITICAL 
     383!$    CALL DDPDD( ctmp, comp )  
     384!$OMP END CRITICAL 
     385!$OMP END PARALLEL 
     386!$    ctmp = comp 
    311387      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
    312388      glob_sum_3d_a = REAL(ctmp,wp) 
     
    317393 
    318394   ! --- MIN --- 
     395   FUNCTION glob_min_2d_ref( ptab )  
     396      !!----------------------------------------------------------------------- 
     397      !!                  ***  FUNCTION  glob_min_2D  *** 
     398      !! 
     399      !! ** Purpose : perform a masked min on the inner global domain of a 2D array 
     400      !!----------------------------------------------------------------------- 
     401      REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab          ! input 2D array 
     402      REAL(wp)                             ::   glob_min_2d_ref   ! global masked min 
     403      INTEGER                              ::   jj, ji        ! local index 
     404      !!----------------------------------------------------------------------- 
     405      ! 
     406      glob_min_2d_ref = 1.e32 
     407!$OMP PARALLEL DO REDUCTION(MIN:glob_min_2d_ref) 
     408      DO jj = 1, jpj 
     409         DO ji =1, jpi 
     410            glob_min_2d_ref = MIN(glob_min_2d_ref, ptab(ji,jj)*tmask_i(ji,jj) ) 
     411         ENDDO 
     412      ENDDO 
     413!$OMP END PARALLEL DO 
     414      ! 
     415   END FUNCTION glob_min_2d_ref 
     416 
    319417   FUNCTION glob_min_2d( ptab )  
    320418      !!----------------------------------------------------------------------- 
     
    323421      !! ** Purpose : perform a masked min on the inner global domain of a 2D array 
    324422      !!----------------------------------------------------------------------- 
    325       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     423      REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab          ! input 2D array 
    326424      REAL(wp)                             ::   glob_min_2d   ! global masked min 
    327       !!----------------------------------------------------------------------- 
    328       ! 
    329       glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) ) 
     425      INTEGER                              ::   jj, ji        ! local index 
     426      !!----------------------------------------------------------------------- 
     427      ! 
     428      glob_min_2d = glob_min_2d_ref (ptab) 
    330429      IF( lk_mpp )   CALL mpp_min( glob_min_2d ) 
    331430      ! 
    332431   END FUNCTION glob_min_2d 
     432 
     433   FUNCTION glob_min_3d_ref( ptab )  
     434      !!----------------------------------------------------------------------- 
     435      !!                  ***  FUNCTION  glob_min_3D  *** 
     436      !! 
     437      !! ** Purpose : perform a masked min on the inner global domain of a 3D array 
     438      !!----------------------------------------------------------------------- 
     439      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
     440      REAL(wp)                               ::   glob_min_3d_ref   ! global masked min 
     441      !! 
     442      INTEGER :: jk 
     443      INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
     444      !!----------------------------------------------------------------------- 
     445      ! 
     446      ijpk = SIZE(ptab,3) 
     447      ! 
     448      glob_min_3d_ref = 1.e32 
     449!$OMP PARALLEL DO REDUCTION(MIN:glob_min_3d_ref) 
     450      DO jk = 1, ijpk 
     451         glob_min_3d_ref = MIN( glob_min_3d_ref, MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 
     452      END DO 
     453!$OMP END PARALLEL DO 
     454      ! 
     455   END FUNCTION glob_min_3d_ref 
    333456  
    334457   FUNCTION glob_min_3d( ptab )  
     
    340463      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
    341464      REAL(wp)                               ::   glob_min_3d   ! global masked min 
    342       !! 
    343       INTEGER :: jk 
    344       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    345       !!----------------------------------------------------------------------- 
    346       ! 
    347       ijpk = SIZE(ptab,3) 
    348       ! 
    349       glob_min_3d = MINVAL( ptab(:,:,1)*tmask_i(:,:) ) 
    350       DO jk = 2, ijpk 
    351          glob_min_3d = MIN( glob_min_3d, MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 
    352       END DO 
     465      !!----------------------------------------------------------------------- 
     466      ! 
     467      glob_min_3d = glob_min_3d_ref(ptab)  
    353468      IF( lk_mpp )   CALL mpp_min( glob_min_3d ) 
    354469      ! 
     
    366481      !!----------------------------------------------------------------------- 
    367482      !              
    368       glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) ) 
    369       glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) ) 
     483      glob_min_2d_a(1) = glob_min_2d_ref( ptab1 ) 
     484      glob_min_2d_a(2) = glob_min_2d_ref( ptab2 ) 
    370485      IF( lk_mpp )   CALL mpp_min( glob_min_2d_a, 2 ) 
    371486      ! 
     
    381496      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
    382497      REAL(wp)            , DIMENSION(2)     ::   glob_min_3d_a   ! global masked min 
     498      !!----------------------------------------------------------------------- 
     499      ! 
     500      glob_min_3d_a(1) = glob_min_3d_ref( ptab1 ) 
     501      glob_min_3d_a(2) = glob_min_3d_ref( ptab2 ) 
     502      IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 ) 
     503      ! 
     504   END FUNCTION glob_min_3d_a 
     505 
     506   ! --- MAX --- 
     507   FUNCTION glob_max_2d_ref( ptab )  
     508      !!----------------------------------------------------------------------- 
     509      !!                  ***  FUNCTION  glob_max_2D  *** 
     510      !! 
     511      !! ** Purpose : perform a masked max on the inner global domain of a 2D array 
     512      !!----------------------------------------------------------------------- 
     513      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     514      REAL(wp)                             ::   glob_max_2d_ref   ! global masked max 
     515      INTEGER                              ::   jj, ji        ! local index 
     516      !!----------------------------------------------------------------------- 
     517      ! 
     518      glob_max_2d_ref = -1.e32 
     519!$OMP PARALLEL DO REDUCTION(MAX:glob_max_2d_ref) 
     520      DO jj = 1, jpj 
     521         DO ji =1, jpi 
     522            glob_max_2d_ref = MAX(glob_max_2d_ref, ptab(ji,jj)*tmask_i(ji,jj) ) 
     523         ENDDO 
     524      ENDDO 
     525!$OMP END PARALLEL DO 
     526      ! 
     527   END FUNCTION glob_max_2d_ref 
     528 
     529   FUNCTION glob_max_2d( ptab )  
     530      !!----------------------------------------------------------------------- 
     531      !!                  ***  FUNCTION  glob_max_2D  *** 
     532      !! 
     533      !! ** Purpose : perform a masked max on the inner global domain of a 2D array 
     534      !!----------------------------------------------------------------------- 
     535      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
     536      REAL(wp)                             ::   glob_max_2d   ! global masked max 
     537      !!----------------------------------------------------------------------- 
     538      ! 
     539      glob_max_2d = glob_max_2d_ref( ptab ) 
     540      IF( lk_mpp )   CALL mpp_max( glob_max_2d ) 
     541      ! 
     542   END FUNCTION glob_max_2d 
     543 
     544   FUNCTION glob_max_3d_ref( ptab )  
     545      !!----------------------------------------------------------------------- 
     546      !!                  ***  FUNCTION  glob_max_3D  *** 
     547      !! 
     548      !! ** Purpose : perform a masked max on the inner global domain of a 3D array 
     549      !!----------------------------------------------------------------------- 
     550      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
     551      REAL(wp)                               ::   glob_max_3d_ref   ! global masked max 
    383552      !! 
    384553      INTEGER :: jk 
     
    386555      !!----------------------------------------------------------------------- 
    387556      ! 
    388       ijpk = SIZE(ptab1,3) 
    389       ! 
    390       glob_min_3d_a(1) = MINVAL( ptab1(:,:,1)*tmask_i(:,:) ) 
    391       glob_min_3d_a(2) = MINVAL( ptab2(:,:,1)*tmask_i(:,:) ) 
    392       DO jk = 2, ijpk 
    393          glob_min_3d_a(1) = MIN( glob_min_3d_a(1), MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) ) 
    394          glob_min_3d_a(2) = MIN( glob_min_3d_a(2), MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) ) 
     557      ijpk = SIZE(ptab,3) 
     558      ! 
     559      glob_max_3d_ref = -1e32 
     560!$OMP PARALLEL DO REDUCTION(MAX:glob_max_3d_ref) 
     561      DO jk = 1, ijpk 
     562         glob_max_3d_ref = MAX( glob_max_3d_ref, MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 
    395563      END DO 
    396       IF( lk_mpp )   CALL mpp_min( glob_min_3d_a, 2 ) 
    397       ! 
    398    END FUNCTION glob_min_3d_a 
    399  
    400    ! --- MAX --- 
    401    FUNCTION glob_max_2d( ptab )  
    402       !!----------------------------------------------------------------------- 
    403       !!                  ***  FUNCTION  glob_max_2D  *** 
    404       !! 
    405       !! ** Purpose : perform a masked max on the inner global domain of a 2D array 
    406       !!----------------------------------------------------------------------- 
    407       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
    408       REAL(wp)                             ::   glob_max_2d   ! global masked max 
    409       !!----------------------------------------------------------------------- 
    410       ! 
    411       glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) ) 
    412       IF( lk_mpp )   CALL mpp_max( glob_max_2d ) 
    413       ! 
    414    END FUNCTION glob_max_2d 
     564!$OMP END PARALLEL DO  
     565      ! 
     566   END FUNCTION glob_max_3d_ref 
    415567  
    416568   FUNCTION glob_max_3d( ptab )  
     
    422574      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
    423575      REAL(wp)                               ::   glob_max_3d   ! global masked max 
    424       !! 
    425       INTEGER :: jk 
    426       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    427       !!----------------------------------------------------------------------- 
    428       ! 
    429       ijpk = SIZE(ptab,3) 
    430       ! 
    431       glob_max_3d = MAXVAL( ptab(:,:,1)*tmask_i(:,:) ) 
    432       DO jk = 2, ijpk 
    433          glob_max_3d = MAX( glob_max_3d, MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 
    434       END DO 
     576      !!----------------------------------------------------------------------- 
     577      ! 
     578      glob_max_3d = glob_max_3d_ref( ptab ) 
    435579      IF( lk_mpp )   CALL mpp_max( glob_max_3d ) 
    436580      ! 
     
    448592      !!----------------------------------------------------------------------- 
    449593      !              
    450       glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) ) 
    451       glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) ) 
     594      glob_max_2d_a(1) = glob_max_2d_ref( ptab1 ) 
     595      glob_max_2d_a(2) = glob_max_2d_ref( ptab2 ) 
    452596      IF( lk_mpp )   CALL mpp_max( glob_max_2d_a, 2 ) 
    453597      ! 
     
    463607      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
    464608      REAL(wp)            , DIMENSION(2)     ::   glob_max_3d_a   ! global masked max 
    465       !! 
    466       INTEGER :: jk 
    467       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    468       !!----------------------------------------------------------------------- 
    469       ! 
    470       ijpk = SIZE(ptab1,3) 
    471       ! 
    472       glob_max_3d_a(1) = MAXVAL( ptab1(:,:,1)*tmask_i(:,:) ) 
    473       glob_max_3d_a(2) = MAXVAL( ptab2(:,:,1)*tmask_i(:,:) ) 
    474       DO jk = 2, ijpk 
    475          glob_max_3d_a(1) = MAX( glob_max_3d_a(1), MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) ) 
    476          glob_max_3d_a(2) = MAX( glob_max_3d_a(2), MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) ) 
    477       END DO 
     609      !!----------------------------------------------------------------------- 
     610      ! 
     611      glob_max_3d_a(1) = glob_max_3d_ref( ptab1 ) 
     612      glob_max_3d_a(2) = glob_max_3d_ref( ptab2 ) 
    478613      IF( lk_mpp )   CALL mpp_max( glob_max_3d_a, 2 ) 
    479614      ! 
  • branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r6487 r9176  
    156156         ! 
    157157         IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps       ! Solver 
     158         IF(lwp) call flush(numsol) 
    158159         ! 
    159160         IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN   ! create a abort file if problem found  
Note: See TracChangeset for help on using the changeset viewer.