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

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

Ignore:
Timestamp:
2017-03-03T12:46:59+01:00 (7 years ago)
Author:
mocavero
Message:

Reverting trunk to remove OpenMP

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/LDF
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90

    r7698 r7753  
    148148            IF(lwp) WRITE(numout,*) '              momentum laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 
    149149            za00 = pah0 / zd_max 
    150 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    151150            DO jj = 1, jpj  
    152151               DO ji = 1, jpi  
     
    160159            IF(lwp) WRITE(numout,*) '              momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 
    161160            za00 = pah0 / ( zd_max * zd_max * zd_max ) 
    162 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    163161            DO jj = 1, jpj 
    164162               DO ji = 1, jpi 
     
    173171         ENDIF 
    174172         !                                !  deeper values  (LAP and BLP cases) 
    175 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    176173         DO jk = 2, jpk 
    177             DO jj = 1, jpj 
    178                DO ji = 1, jpi 
    179                   pah1(ji,jj,jk) = pah1(ji,jj,1) * tmask(ji,jj,jk)  
    180                   pah2(ji,jj,jk) = pah2(ji,jj,1) * fmask(ji,jj,jk)  
    181                END DO 
    182             END DO 
     174            pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk)  
     175            pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk)  
    183176         END DO 
    184177         ! 
     
    187180            IF(lwp) WRITE(numout,*) '              tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 
    188181            za00 = pah0 / zd_max 
    189 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    190182            DO jj = 1, jpj  
    191183               DO ji = 1, jpi  
     
    199191            IF(lwp) WRITE(numout,*) '              tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 
    200192            za00 = pah0 / ( zd_max * zd_max * zd_max ) 
    201 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    202193            DO jj = 1, jpj 
    203194               DO ji = 1, jpi 
     
    212203         ENDIF 
    213204         !                                !  deeper values  (LAP and BLP cases) 
    214 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    215205         DO jk = 2, jpk 
    216             DO jj = 1, jpj 
    217                DO ji = 1, jpi 
    218                   pah1(ji,jj,jk) = pah1(ji,jj,1) * umask(ji,jj,jk)  
    219                   pah2(ji,jj,jk) = pah2(ji,jj,1) * vmask(ji,jj,jk)  
    220                END DO 
    221             END DO 
     206            pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk)  
     207            pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk)  
    222208         END DO 
    223209         ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r7698 r7753  
    155155      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 
    156156      ! 
    157 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    158       DO jj = 1, jpj 
    159          DO ji = 1, jpi 
    160             ahmt(ji,jj,jpk) = 0._wp                           ! last level always 0   
    161             ahmf(ji,jj,jpk) = 0._wp 
    162          END DO 
    163       END DO 
     157      ahmt(:,:,jpk) = 0._wp                           ! last level always 0   
     158      ahmf(:,:,jpk) = 0._wp 
    164159      ! 
    165160      !                                               ! value of eddy mixing coef. 
     
    178173         CASE(   0  )      !==  constant  ==! 
    179174            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant ' 
    180 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    181             DO jk = 1, jpk 
    182                DO jj = 1, jpj 
    183                   DO ji = 1, jpi 
    184                      ahmt(ji,jj,jk) = zah0 * tmask(ji,jj,jk) 
    185                      ahmf(ji,jj,jk) = zah0 * fmask(ji,jj,jk) 
    186                   END DO 
    187                END DO 
    188             END DO 
     175            ahmt(:,:,:) = zah0 * tmask(:,:,:) 
     176            ahmf(:,:,:) = zah0 * fmask(:,:,:) 
    189177            ! 
    190178         CASE(  10  )      !==  fixed profile  ==! 
    191179            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )' 
    192 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    193             DO jj = 1, jpj 
    194                DO ji = 1, jpi 
    195                   ahmt(ji,jj,1) = zah0 * tmask(ji,jj,1)            ! constant surface value 
    196                   ahmf(ji,jj,1) = zah0 * fmask(ji,jj,1) 
    197                END DO 
    198             END DO 
     180            ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value 
     181            ahmf(:,:,1) = zah0 * fmask(:,:,1) 
    199182            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 
    200183            ! 
     
    208191!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 
    209192!!              better:  check that the max is <=1  i.e. it is a shape from 0 to 1, not a coef that has physical dimension 
    210 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    211193            DO jk = 2, jpkm1 
    212                DO jj = 1, jpj 
    213                   DO ji = 1, jpi 
    214                      ahmt(ji,jj,jk) = ahmt(ji,jj,1) * tmask(ji,jj,jk) 
    215                      ahmf(ji,jj,jk) = ahmf(ji,jj,1) * fmask(ji,jj,jk) 
    216                   END DO 
    217                END DO 
     194               ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 
     195               ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 
    218196            END DO 
    219197            ! 
     
    231209!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ???? 
    232210!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 
    233 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    234211            DO jk = 1, jpkm1 
    235                DO jj = 1, jpj 
    236                   DO ji = 1, jpi 
    237                      ahmt(ji,jj,jk) = ahmt(ji,jj,jk) * tmask(ji,jj,jk) 
    238                      ahmf(ji,jj,jk) = ahmf(ji,jj,jk) * fmask(ji,jj,jk) 
    239                   END DO 
    240                END DO 
     212               ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 
     213               ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 
    241214            END DO 
    242215            ! 
     
    266239            ! 
    267240            ! Set local gridscale values 
    268 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    269241            DO jj = 2, jpjm1 
    270242               DO ji = fs_2, fs_jpim1 
     
    279251         ! 
    280252         IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN       ! bilapcian and no time variation: 
    281 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    282             DO jk = 1, jpk 
    283                DO jj = 1, jpj 
    284                   DO ji = 1, jpi 
    285                      ahmt(ji,jj,jk) = SQRT( ahmt(ji,jj,jk) )      ! take the square root of the coefficient 
    286                      ahmf(ji,jj,jk) = SQRT( ahmf(ji,jj,jk) ) 
    287                   END DO 
    288                END DO 
    289             END DO 
     253            ahmt(:,:,:) = SQRT( ahmt(:,:,:) )                     ! take the square root of the coefficient 
     254            ahmf(:,:,:) = SQRT( ahmf(:,:,:) ) 
    290255         ENDIF 
    291256         ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r7698 r7753  
    135135      z1_slpmax = 1._wp / rn_slpmax 
    136136      ! 
    137 !$OMP PARALLEL 
    138 !$OMP DO schedule(static) private(jk, jj, ji) 
    139       DO jk = 1, jpk 
    140          DO jj = 1, jpj 
    141             DO ji = 1, jpi 
    142                zww(ji,jj,jk) = 0._wp 
    143                zwz(ji,jj,jk) = 0._wp 
    144             END DO 
    145          END DO 
    146       END DO 
    147 !$OMP END DO NOWAIT 
    148       ! 
    149 !$OMP DO schedule(static) private(jk, jj, ji) 
     137      zww(:,:,:) = 0._wp 
     138      zwz(:,:,:) = 0._wp 
     139      ! 
    150140      DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
    151141         DO jj = 1, jpjm1 
     
    156146         END DO 
    157147      END DO 
    158 !$OMP END PARALLEL 
    159148      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
    160 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    161149         DO jj = 1, jpjm1 
    162150            DO ji = 1, jpim1 
     
    167155      ENDIF 
    168156      IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level 
    169 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    170157         DO jj = 1, jpjm1 
    171158            DO ji = 1, jpim1 
     
    176163      ENDIF 
    177164      ! 
    178 !$OMP PARALLEL 
    179 !$OMP DO schedule(static) private(jj, ji) 
    180          DO jj = 1, jpj 
    181             DO ji = 1, jpi 
    182                zdzr(ji,jj,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    183             END DO 
    184          END DO 
    185 !$OMP DO schedule(static) private(jk,jj,ji) 
     165      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    186166      DO jk = 2, jpkm1 
    187167         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
     
    190170         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
    191171         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
    192          DO jj = 1, jpj 
    193             DO ji = 1, jpi 
    194                zdzr(ji,jj,jk) = zm1_g * ( prd(ji,jj,jk) + 1._wp )              & 
    195                     &                 * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) ) * ( 1._wp - 0.5_wp * tmask(ji,jj,jk+1) ) 
    196             END DO 
    197          END DO 
    198       END DO 
    199 !$OMP END PARALLEL 
     172         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              & 
     173            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 
     174      END DO 
    200175      ! 
    201176      !                          !==   Slopes just below the mixed layer   ==! 
     
    207182      ! 
    208183      IF ( ln_isfcav ) THEN 
    209 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    210184         DO jj = 2, jpjm1 
    211185            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    217191         END DO 
    218192      ELSE 
    219 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    220193         DO jj = 2, jpjm1 
    221194            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    226199      END IF 
    227200 
    228 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zau, zav, zbu, zbv, zfj, zfi, zdepu, zdepv) 
    229201      DO jk = 2, jpkm1                            !* Slopes at u and v points 
    230202         DO jj = 2, jpjm1 
     
    267239      ! 
    268240      !                                            !* horizontal Shapiro filter 
    269 !$OMP PARALLEL  
    270 !$OMP DO schedule(static) private(jk, jj, ji) 
    271241      DO jk = 2, jpkm1 
    272242         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     
    313283      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
    314284      ! 
    315 !$OMP DO schedule(static) private(jk, jj, ji, zbw, zfk, zck, zbi, zbj, zai, zaj, zci, zcj) 
    316285      DO jk = 2, jpkm1 
    317286         DO jj = 2, jpjm1 
     
    349318         END DO 
    350319      END DO 
    351 !$OMP END PARALLEL 
    352320      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions 
    353321      ! 
    354322      !                                           !* horizontal Shapiro filter 
    355 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcofw, zck) 
    356323      DO jk = 2, jpkm1 
    357324         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     
    703670      z1_slpmax = 1._wp / rn_slpmax 
    704671      ! 
    705 !$OMP PARALLEL 
    706 !$OMP DO schedule(static) private(jj)        
    707       DO jj = 1, jpj 
    708          uslpml (1,jj) = 0._wp      ;      uslpml (jpi,jj) = 0._wp 
    709          vslpml (1,jj) = 0._wp      ;      vslpml (jpi,jj) = 0._wp 
    710          wslpiml(1,jj) = 0._wp      ;      wslpiml(jpi,jj) = 0._wp 
    711          wslpjml(1,jj) = 0._wp      ;      wslpjml(jpi,jj) = 0._wp 
    712       END DO 
     672      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp 
     673      vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp 
     674      wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp 
     675      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp 
    713676      ! 
    714677      !                                            !==   surface mixed layer mask   ! 
    715 !$OMP DO schedule(static) private(jk, jj, ji, ik) 
    716678      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    717679         DO jj = 1, jpj 
     
    724686         END DO 
    725687      END DO 
    726 !$OMP END DO NOWAIT 
    727688 
    728689 
     
    737698      !----------------------------------------------------------------------- 
    738699      ! 
    739 !$OMP DO schedule(static) private(jj, ji, iku, ikv, zbu, zbv, zau, zav, ik, ikm1, zbw, zci, zcj, zai, zaj, zbi, zbj)  
    740700      DO jj = 2, jpjm1 
    741701         DO ji = 2, jpim1 
     
    782742         END DO 
    783743      END DO 
    784 !$OMP END PARALLEL 
    785744      !!gm this lbc_lnk should be useless.... 
    786745      CALL lbc_lnk( uslpml , 'U', -1. )   ;   CALL lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change) 
     
    832791         ! Direction of lateral diffusion (tracers and/or momentum) 
    833792         ! ------------------------------ 
    834  
    835 !$OMP PARALLEL 
    836 !$OMP DO schedule(static) private(jk, jj, ji)    
    837         DO jk = 1, jpk 
    838            DO jj = 1, jpj 
    839               DO ji = 1, jpi 
    840                  uslp (ji,jj,jk) = 0._wp 
    841                  vslp (ji,jj,jk) = 0._wp 
    842                  wslpi(ji,jj,jk) = 0._wp 
    843                  wslpj(ji,jj,jk) = 0._wp 
    844               END DO 
    845            END DO 
    846         END DO 
    847 !$OMP END DO NOWAIT 
    848 !$OMP DO schedule(static) private(jj, ji)        
    849         DO jj = 1, jpj 
    850             DO ji = 1, jpi 
    851                uslpml (ji,jj) = 0._wp 
    852                vslpml (ji,jj) = 0._wp 
    853                wslpiml(ji,jj) = 0._wp 
    854                wslpjml(ji,jj) = 0._wp 
    855              END DO 
    856         END DO 
    857 !$OMP END PARALLEL 
     793         uslp (:,:,:) = 0._wp   ;   uslpml (:,:) = 0._wp      ! set the slope to zero (even in s-coordinates) 
     794         vslp (:,:,:) = 0._wp   ;   vslpml (:,:) = 0._wp 
     795         wslpi(:,:,:) = 0._wp   ;   wslpiml(:,:) = 0._wp 
     796         wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp 
     797 
    858798         !!gm I no longer understand this..... 
    859799!!gm         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r7698 r7753  
    116116      !!              aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 
    117117      !!---------------------------------------------------------------------- 
    118       INTEGER  ::   jk, jj, ji        ! dummy loop indices 
     118      INTEGER  ::   jk                ! dummy loop indices 
    119119      INTEGER  ::   ierr, inum, ios   ! local integer 
    120120      REAL(wp) ::   zah0              ! local scalar 
     
    184184      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 
    185185      ! 
    186 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    187       DO jj = 1, jpj 
    188          DO ji = 1, jpi 
    189             ahtu(ji,jj,jpk) = 0._wp                           ! last level always 0   
    190             ahtv(ji,jj,jpk) = 0._wp 
    191          END DO 
    192       END DO 
     186      ahtu(:,:,jpk) = 0._wp                           ! last level always 0   
     187      ahtv(:,:,jpk) = 0._wp 
    193188      ! 
    194189      !                                               ! value of eddy mixing coef. 
     
    205200         CASE(   0  )      !==  constant  ==! 
    206201            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0 
    207 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    208             DO jk = 1, jpk 
    209                DO jj = 1, jpj 
    210                   DO ji = 1, jpi 
    211                      ahtu(ji,jj,jk) = zah0 * umask(ji,jj,jk) 
    212                      ahtv(ji,jj,jk) = zah0 * vmask(ji,jj,jk) 
    213                   END DO 
    214                END DO 
    215             END DO 
     202            ahtu(:,:,:) = zah0 * umask(:,:,:) 
     203            ahtv(:,:,:) = zah0 * vmask(:,:,:) 
    216204            ! 
    217205         CASE(  10  )      !==  fixed profile  ==! 
    218206            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
    219 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    220             DO jj = 1, jpj 
    221                DO ji = 1, jpi 
    222                   ahtu(ji,jj,1) = zah0 * umask(ji,jj,1)                      ! constant surface value 
    223                   ahtv(ji,jj,1) = zah0 * vmask(ji,jj,1) 
    224                END DO 
    225             END DO 
     207            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value 
     208            ahtv(:,:,1) = zah0 * vmask(:,:,1) 
    226209            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 
    227210            ! 
     
    232215            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 
    233216            CALL iom_close( inum ) 
    234 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    235217            DO jk = 2, jpkm1 
    236                DO jj = 1, jpj 
    237                   DO ji = 1, jpi 
    238                      ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 
    239                      ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 
    240                   END DO 
    241                END DO 
     218               ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     219               ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
    242220            END DO 
    243221            ! 
     
    266244            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 
    267245            CALL iom_close( inum ) 
    268 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    269246            DO jk = 1, jpkm1 
    270                DO jj = 1, jpj 
    271                   DO ji = 1, jpi 
    272                      ahtu(ji,jj,jk) = ahtu(ji,jj,jk) * umask(ji,jj,jk) 
    273                      ahtv(ji,jj,jk) = ahtv(ji,jj,jk) * vmask(ji,jj,jk) 
    274                   END DO 
    275                END DO 
     247               ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 
     248               ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 
    276249            END DO 
    277250            ! 
     
    294267         ! 
    295268         IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 
    296 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    297             DO jk = 1, jpk 
    298                DO jj = 1, jpj 
    299                   DO ji = 1, jpi 
    300                      ahtu(ji,jj,jk) = SQRT( ahtu(ji,jj,jk) ) 
    301                      ahtv(ji,jj,jk) = SQRT( ahtv(ji,jj,jk) ) 
    302                   END DO 
    303                END DO 
    304             END DO 
     269            ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 
     270            ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 
    305271         ENDIF 
    306272         ! 
     
    347313         !                                             !   increase to rn_aht_0 within 20N-20S 
    348314         IF( ln_ldfeiv .AND. nn_aei_ijk_t == 21 ) THEN   ! use the already computed aei. 
    349 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    350             DO jj = 1, jpj 
    351                DO ji = 1, jpi 
    352                   ahtu(ji,jj,1) = aeiu(ji,jj,1) 
    353                   ahtv(ji,jj,1) = aeiv(ji,jj,1) 
    354                END DO 
    355             END DO 
     315            ahtu(:,:,1) = aeiu(:,:,1) 
     316            ahtv(:,:,1) = aeiv(:,:,1) 
    356317         ELSE                                            ! compute aht.  
    357318            CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) 
     
    360321         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )      ! 1 / ff(20 degrees)    
    361322         zaht_min = 0.2_wp * rn_aht_0                                      ! minimum value for aht 
    362 !$OMP PARALLEL 
    363 !$OMP DO schedule(static) private(jj,ji,zaht,zahf) 
    364323         DO jj = 1, jpj 
    365324            DO ji = 1, jpi 
     
    372331            END DO 
    373332         END DO 
    374 !$OMP DO schedule(static) private(jk,jj,ji) 
    375333         DO jk = 2, jpkm1                             ! deeper value = surface value 
    376             DO jj = 1, jpj 
    377                DO ji = 1, jpi 
    378                   ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 
    379                   ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 
    380                END DO 
    381             END DO 
    382          END DO 
    383 !$OMP END PARALLEL 
     334            ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     335            ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
     336         END DO 
    384337         ! 
    385338      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity ) 
    386339         IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12 
    387 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    388340            DO jk = 1, jpkm1 
    389                DO jj = 1, jpj 
    390                   DO ji = 1, jpi 
    391                      ahtu(ji,jj,jk) = ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12 
    392                      ahtv(ji,jj,jk) = ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12 
    393                   END DO 
    394                END DO 
     341               ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 
     342               ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 
    395343            END DO 
    396344         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e 
    397 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    398345            DO jk = 1, jpkm1 
    399                DO jj = 1, jpj 
    400                   DO ji = 1, jpi 
    401                      ahtu(ji,jj,jk) = SQRT(  ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12  ) * e1u(ji,jj) 
    402                      ahtv(ji,jj,jk) = SQRT(  ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12  ) * e2v(ji,jj) 
    403                   END DO 
    404                END DO 
     346               ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:) 
     347               ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:) 
    405348            END DO 
    406349         ENDIF 
     
    435378      !!               l_ldfeiv_time : =T if EIV coefficients vary with time 
    436379      !!---------------------------------------------------------------------- 
    437       INTEGER  ::   jk, jj, ji        ! dummy loop indices 
     380      INTEGER  ::   jk                ! dummy loop indices 
    438381      INTEGER  ::   ierr, inum, ios   ! local integer 
    439382      ! 
     
    476419         CASE(   0  )      !==  constant  ==! 
    477420            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0 
    478 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    479             DO jk = 1, jpk 
    480                DO jj = 1, jpj 
    481                   DO ji = 1, jpi 
    482                      aeiu(ji,jj,jk) = rn_aeiv_0 
    483                      aeiv(ji,jj,jk) = rn_aeiv_0 
    484                   END DO 
    485                END DO 
    486             END DO 
     421            aeiu(:,:,:) = rn_aeiv_0 
     422            aeiv(:,:,:) = rn_aeiv_0 
    487423            ! 
    488424         CASE(  10  )      !==  fixed profile  ==! 
    489425            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )' 
    490 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    491             DO jj = 1, jpj 
    492                DO ji = 1, jpi 
    493                   aeiu(ji,jj,1) = rn_aeiv_0                                ! constant surface value 
    494                   aeiv(ji,jj,1) = rn_aeiv_0 
    495                END DO 
    496             END DO 
     426            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value 
     427            aeiv(:,:,1) = rn_aeiv_0 
    497428            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 
    498429            ! 
     
    503434            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 
    504435            CALL iom_close( inum ) 
    505 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    506436            DO jk = 2, jpk 
    507                DO jj = 1, jpj 
    508                   DO ji = 1, jpi 
    509                      aeiu(ji,jj,jk) = aeiu(ji,jj,1) 
    510                      aeiv(ji,jj,jk) = aeiv(ji,jj,1) 
    511                   END DO 
    512                END DO 
     437               aeiu(:,:,jk) = aeiu(:,:,1) 
     438               aeiv(:,:,jk) = aeiv(:,:,1) 
    513439            END DO 
    514440            ! 
     
    572498      CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
    573499      !       
    574 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    575       DO jj = 1, jpj 
    576          DO ji = 1, jpi 
    577             zn   (ji,jj) = 0._wp      ! Local initialization 
    578             zhw  (ji,jj) = 5._wp 
    579             zah  (ji,jj) = 0._wp 
    580             zross(ji,jj) = 0._wp 
    581          END DO 
    582       END DO 
     500      zn   (:,:) = 0._wp      ! Local initialization 
     501      zhw  (:,:) = 5._wp 
     502      zah  (:,:) = 0._wp 
     503      zross(:,:) = 0._wp 
    583504      !                       ! Compute lateral diffusive coefficient at T-point 
    584505      IF( ln_traldf_triad ) THEN 
    585506         DO jk = 1, jpk 
    586 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w) 
    587507            DO jj = 2, jpjm1 
    588508               DO ji = 2, jpim1 
     
    603523      ELSE 
    604524         DO jk = 1, jpk 
    605 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w) 
    606525            DO jj = 2, jpjm1 
    607526               DO ji = 2, jpim1 
     
    623542      END IF 
    624543 
    625 !$OMP PARALLEL  
    626 !$OMP DO schedule(static) private(jj,ji,zfw) 
    627544      DO jj = 2, jpjm1 
    628545         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    637554      !                                         !==  Bound on eiv coeff.  ==! 
    638555      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
    639 !$OMP DO schedule(static) private(jj,ji,zzaei) 
    640556      DO jj = 2, jpjm1 
    641557         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    644560         END DO 
    645561      END DO 
    646 !$OMP END PARALLEL 
    647562      CALL lbc_lnk( zaeiw(:,:), 'W', 1. )       ! lateral boundary condition 
    648563      !                
    649 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    650564      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==! 
    651565         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    656570      CALL lbc_lnk( paeiu(:,:,1), 'U', 1. )   ;   CALL lbc_lnk( paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition 
    657571 
    658 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    659572      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==! 
    660          DO jj = 1, jpj 
    661             DO ji = 1, jpi 
    662                paeiu(ji,jj,jk) = paeiu(ji,jj,1) * umask(ji,jj,jk) 
    663                paeiv(ji,jj,jk) = paeiv(ji,jj,1) * vmask(ji,jj,jk) 
    664             END DO  
    665          END DO  
     573         paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 
     574         paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 
    666575      END DO 
    667576      !   
     
    715624 
    716625       
    717 !$OMP PARALLEL 
    718 !$OMP DO schedule(static) private(jj,ji) 
    719       DO jj = 1, jpj 
    720          DO ji = 1, jpi 
    721             zpsi_uw(ji,jj, 1 ) = 0._wp   ;   zpsi_vw(ji,jj, 1 ) = 0._wp 
    722             zpsi_uw(ji,jj,jpk) = 0._wp   ;   zpsi_vw(ji,jj,jpk) = 0._wp 
    723          END DO 
    724       END DO 
    725 !$OMP END DO NOWAIT 
    726       ! 
    727 !$OMP DO schedule(static) private(jk,jj,ji) 
     626      zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp 
     627      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
     628      ! 
    728629      DO jk = 2, jpkm1 
    729630         DO jj = 1, jpjm1 
     
    737638      END DO 
    738639      ! 
    739 !$OMP DO schedule(static) private(jk,jj,ji) 
    740640      DO jk = 1, jpkm1 
    741641         DO jj = 1, jpjm1 
     
    746646         END DO 
    747647      END DO 
    748 !$OMP END DO NOWAIT 
    749 !$OMP DO schedule(static) private(jk,jj,ji) 
    750648      DO jk = 1, jpkm1 
    751649         DO jj = 2, jpjm1 
     
    756654         END DO 
    757655      END DO 
    758 !$OMP END PARALLEL 
    759656      ! 
    760657      !                              ! diagnose the eddy induced velocity and associated heat transport 
     
    798695      CALL wrk_alloc( jpi,jpj,jpk,   zw3d ) 
    799696      ! 
    800 !$OMP PARALLEL 
    801 !$OMP DO schedule(static) private(jj,ji) 
    802       DO jj = 1, jpj 
    803          DO ji = 1, jpi 
    804             zw3d(ji,jj,jpk) = 0._wp                            ! bottom value always 0 
    805          END DO 
    806       END DO 
    807 !$OMP END DO NOWAIT 
    808       ! 
    809 !$OMP DO schedule(static) private(jk,jj,ji) 
     697      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
     698      ! 
    810699      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw] 
    811          DO jj = 1, jpj 
    812             DO ji = 1, jpi 
    813                zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    814             END DO 
    815          END DO 
    816       END DO 
    817 !$OMP END PARALLEL 
     700         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 
     701      END DO 
    818702      CALL iom_put( "uoce_eiv", zw3d ) 
    819703      ! 
    820 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    821704      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw] 
    822          DO jj = 1, jpj 
    823             DO ji = 1, jpi 
    824                zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 
    825             END DO 
    826          END DO 
     705         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 
    827706      END DO 
    828707      CALL iom_put( "voce_eiv", zw3d ) 
    829708      ! 
    830 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    831709      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix] 
    832710         DO jj = 2, jpjm1 
     
    846724      zztmp = 0.5_wp * rau0 * rcp  
    847725      IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
    848 !$OMP PARALLEL 
    849 !$OMP DO schedule(static) private(jj,ji) 
    850          DO jj = 1, jpj 
    851             DO ji = 1, jpi 
    852                zw2d(ji,jj) = 0._wp 
    853             END DO 
    854          END DO 
    855 !$OMP DO schedule(static) private(jk,jj,ji) 
    856          DO jk = 1, jpk 
    857             DO jj = 1, jpj 
    858                DO ji = 1, jpi 
    859                   zw3d(ji,jj,jk) = 0._wp  
    860                END DO 
    861             END DO 
    862          END DO 
    863          DO jk = 1, jpkm1 
    864 !$OMP DO schedule(static) private(jj,ji) 
    865             DO jj = 2, jpjm1 
    866                DO ji = fs_2, fs_jpim1   ! vector opt. 
    867                   zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    868                      &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
    869                   zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    870                END DO 
    871             END DO 
    872          END DO 
    873 !$OMP END PARALLEL 
    874          CALL lbc_lnk( zw2d, 'U', -1. ) 
    875          CALL lbc_lnk( zw3d, 'U', -1. ) 
    876          CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction 
    877          CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
    878       ENDIF 
    879 !$OMP PARALLEL 
    880 !$OMP DO schedule(static) private(jj,ji) 
    881       DO jj = 1, jpj 
    882          DO ji = 1, jpi 
    883             zw2d(ji,jj) = 0._wp 
    884          END DO 
    885       END DO 
    886 !$OMP DO schedule(static) private(jk,jj,ji) 
    887       DO jk = 1, jpk 
    888          DO jj = 1, jpj 
    889             DO ji = 1, jpi 
    890                zw3d(ji,jj,jk) = 0._wp 
    891             END DO 
    892          END DO 
    893       END DO 
     726        zw2d(:,:)   = 0._wp  
     727        zw3d(:,:,:) = 0._wp  
     728        DO jk = 1, jpkm1 
     729           DO jj = 2, jpjm1 
     730              DO ji = fs_2, fs_jpim1   ! vector opt. 
     731                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     732                    &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
     733                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
     734              END DO 
     735           END DO 
     736        END DO 
     737        CALL lbc_lnk( zw2d, 'U', -1. ) 
     738        CALL lbc_lnk( zw3d, 'U', -1. ) 
     739        CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction 
     740        CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
     741      ENDIF 
     742      zw2d(:,:)   = 0._wp  
     743      zw3d(:,:,:) = 0._wp  
    894744      DO jk = 1, jpkm1 
    895 !$OMP DO schedule(static) private(jj,ji) 
    896745         DO jj = 2, jpjm1 
    897746            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    902751         END DO 
    903752      END DO 
    904 !$OMP END PARALLEL 
    905753      CALL lbc_lnk( zw2d, 'V', -1. ) 
    906754      CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction 
     
    911759      zztmp = 0.5_wp * 0.5 
    912760      IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 
    913 !$OMP PARALLEL 
    914 !$OMP DO schedule(static) private(jj,ji) 
    915          DO jj = 1, jpj 
    916             DO ji = 1, jpi 
    917                zw2d(ji,jj) = 0._wp 
    918             END DO 
    919          END DO 
    920 !$OMP DO schedule(static) private(jk,jj,ji) 
    921          DO jk = 1, jpk 
    922             DO jj = 1, jpj 
    923                DO ji = 1, jpi 
    924                   zw3d(ji,jj,jk) = 0._wp  
    925                END DO 
    926             END DO 
    927          END DO 
    928          DO jk = 1, jpkm1 
    929 !$OMP DO schedule(static) private(jj,ji) 
    930             DO jj = 2, jpjm1 
    931                DO ji = fs_2, fs_jpim1   ! vector opt. 
    932                   zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    933                      &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
    934                   zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    935                END DO 
    936             END DO 
    937          END DO 
    938          CALL lbc_lnk( zw2d, 'U', -1. ) 
    939          CALL lbc_lnk( zw3d, 'U', -1. ) 
    940          CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
    941          CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
    942 !$OMP END PARALLEL 
    943       ENDIF 
    944 !$OMP PARALLEL 
    945 !$OMP DO schedule(static) private(jj,ji) 
    946       DO jj = 1, jpj 
    947          DO ji = 1, jpi 
    948             zw2d(ji,jj) = 0._wp 
    949          END DO 
    950       END DO 
    951 !$OMP DO schedule(static) private(jk,jj,ji) 
    952       DO jk = 1, jpk 
    953          DO jj = 1, jpj 
    954             DO ji = 1, jpi 
    955                zw3d(ji,jj,jk) = 0._wp 
    956             END DO 
    957          END DO 
    958       END DO 
     761        zw2d(:,:) = 0._wp  
     762        zw3d(:,:,:) = 0._wp  
     763        DO jk = 1, jpkm1 
     764           DO jj = 2, jpjm1 
     765              DO ji = fs_2, fs_jpim1   ! vector opt. 
     766                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     767                    &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
     768                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
     769              END DO 
     770           END DO 
     771        END DO 
     772        CALL lbc_lnk( zw2d, 'U', -1. ) 
     773        CALL lbc_lnk( zw3d, 'U', -1. ) 
     774        CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
     775        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
     776      ENDIF 
     777      zw2d(:,:) = 0._wp  
     778      zw3d(:,:,:) = 0._wp  
    959779      DO jk = 1, jpkm1 
    960 !$OMP DO schedule(static) private(jj,ji) 
    961780         DO jj = 2, jpjm1 
    962781            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    967786         END DO 
    968787      END DO 
    969 !$OMP END PARALLEL 
    970788      CALL lbc_lnk( zw2d, 'V', -1. ) 
    971789      CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction 
Note: See TracChangeset for help on using the changeset viewer.