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 789 for trunk/NEMO/OPA_SRC/LDF/ldfeiv.F90 – NEMO

Ignore:
Timestamp:
2008-01-11T19:04:56+01:00 (16 years ago)
Author:
rblod
Message:

Suppress jki routines and associated key_mpp_omp

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r719 r789  
    1010   !!---------------------------------------------------------------------- 
    1111   !!   ldf_eiv      : compute the eddy induced velocity coefficients 
    12    !!                  Same results but not same routine if 'key_mpp_omp' 
    13    !!                  is defined or not 
    1412   !!---------------------------------------------------------------------- 
    1513   !! * Modules used 
     
    4038 
    4139CONTAINS 
    42  
    43 # if defined key_mpp_omp 
    44    !!---------------------------------------------------------------------- 
    45    !!   'key_mpp_omp' :                  OpenMP /  NEC autotasking (j-slab) 
    46    !!---------------------------------------------------------------------- 
    47  
    48    SUBROUTINE ldf_eiv( kt ) 
    49       !!---------------------------------------------------------------------- 
    50       !!                  ***  ROUTINE ldf_eiv  *** 
    51       !! 
    52       !! ** Purpose :   Compute the eddy induced velocity coefficient from the 
    53       !!      growth rate of baroclinic instability. 
    54       !! 
    55       !! ** Method : 
    56       !! 
    57       !! ** Action :   uslp(),   : i- and j-slopes of neutral surfaces 
    58       !!               vslp()      at u- and v-points, resp. 
    59       !!               wslpi(),  : i- and j-slopes of neutral surfaces 
    60       !!               wslpj()     at w-points.  
    61       !! 
    62       !! History : 
    63       !!   8.1  !  99-03  (G. Madec, A. Jouzeau)  Original code 
    64       !!   8.5  !  02-06  (G. Madec)  Free form, F90 
    65       !!---------------------------------------------------------------------- 
    66       !! * Arguments 
    67       INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx 
    68        
    69       !! * Local declarations 
    70       INTEGER ::   ji, jj, jk           ! dummy loop indices 
    71       REAL(wp) ::   & 
    72          zfw, ze3w, zn2, zf20,       &  ! temporary scalars 
    73          zaht, zaht_min 
    74       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    75          zn, zah, zhw, zross            ! workspace 
    76       !!---------------------------------------------------------------------- 
    77  
    78       IF( kt == nit000 ) THEN 
    79          IF(lwp) WRITE(numout,*) 
    80          IF(lwp) WRITE(numout,*) 'ldf_eiv : eddy induced velocity coefficients' 
    81          IF(lwp) WRITE(numout,*) '~~~~~~~   NEC autotasking / OpenMP : j-slab' 
    82       ENDIF 
    83        
    84       !                                                ! =============== 
    85       DO jj = 2, jpjm1                                 !  Vertical slab 
    86          !                                             ! =============== 
    87           
    88          ! 0. Local initialization 
    89          ! ----------------------- 
    90          zn   (:,jj) = 0.e0 
    91          zhw  (:,jj) = 5.e0 
    92          zah  (:,jj) = 0.e0 
    93          zross(:,jj) = 0.e0 
    94           
    95          ! 1. Compute lateral diffusive coefficient  
    96          ! ---------------------------------------- 
    97  
    98 !CDIR NOVERRCHK  
    99          DO jk = 1, jpk 
    100 !CDIR NOVERRCHK  
    101             DO ji = 2, jpim1 
    102                ! Take the max of N^2 and zero then take the vertical sum  
    103                ! of the square root of the resulting N^2 ( required to compute  
    104                ! internal Rossby radius Ro = .5 * sum_jpk(N) / f  
    105                zn2 = MAX( rn2(ji,jj,jk), 0.e0 ) 
    106                ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 
    107                zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 
    108                ! Compute elements required for the inverse time scale of baroclinic 
    109                ! eddies using the isopycnal slopes calculated in ldfslp.F :  
    110                ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 
    111                zah(ji,jj) = zah(ji,jj) + zn2   & 
    112                               * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)    & 
    113                                 + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) )   & 
    114                               * ze3w 
    115                zhw(ji,jj) = zhw(ji,jj) + ze3w 
    116             END DO  
    117          END DO  
    118   
    119 !CDIR NOVERRCHK  
    120          DO ji = 2, jpim1 
    121             zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 
    122             ! Rossby radius at w-point taken < 40km and  > 2km 
    123             zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 ) 
    124             ! Compute aeiw by multiplying Ro^2 and T^-1 
    125             aeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1) 
    126             IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R02 
    127                ! Take the minimum between aeiw and aeiv0 for depth levels 
    128                ! lower than 20 (21 in w- point) 
    129                IF( mbathy(ji,jj) <= 21. ) aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. ) 
    130             ENDIF 
    131          END DO 
    132  
    133          ! Decrease the coefficient in the tropics (20N-20S)  
    134          zf20 = 2. * omega * sin( rad * 20. ) 
    135          DO ji = 2, jpim1 
    136             aeiw(ji,jj) = MIN( 1., ABS( ff(ji,jj) / zf20 ) ) * aeiw(ji,jj) 
    137          END DO 
    138    
    139          ! ORCA R05: Take the minimum between aeiw and aeiv0 
    140          IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 
    141             DO ji = 2, jpim1 
    142                aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 ) 
    143             END DO 
    144          ENDIF 
    145          !                                             ! =============== 
    146       END DO                                           !   End of slab 
    147       !                                                ! =============== 
    148  
    149       !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    150  
    151       ! lateral boundary condition on aeiw  
    152       CALL lbc_lnk( aeiw, 'W', 1. ) 
    153  
    154       ! Average the diffusive coefficient at u- v- points  
    155       DO jj = 2, jpjm1 
    156          DO ji = fs_2, fs_jpim1   ! vector opt. 
    157             aeiu(ji,jj) = .5 * (aeiw(ji,jj) + aeiw(ji+1,jj  )) 
    158             aeiv(ji,jj) = .5 * (aeiw(ji,jj) + aeiw(ji  ,jj+1)) 
    159          END DO  
    160       END DO  
    161       !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    162  
    163       ! lateral boundary condition on aeiu, aeiv  
    164       CALL lbc_lnk( aeiu, 'U', 1. ) 
    165       CALL lbc_lnk( aeiv, 'V', 1. ) 
    166  
    167       IF(ln_ctl)   THEN 
    168          CALL prt_ctl(tab2d_1=aeiu, clinfo1=' eiv  - u: ', ovlap=1) 
    169          CALL prt_ctl(tab2d_1=aeiv, clinfo1=' eiv  - v: ', ovlap=1) 
    170       ENDIF 
    171        
    172       ! ORCA R05: add a space variation on aht (=aeiv except at the equator and river mouth) 
    173       IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN 
    174          zf20     = 2. * omega * SIN( rad * 20. ) 
    175          zaht_min = 100.                              ! minimum value for aht 
    176          DO jj = 1, jpj 
    177             DO ji = 1, jpi 
    178                zaht      = ( 1. -  MIN( 1., ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  & 
    179                   &      + aht0 * upsrnfh(ji,jj)                          ! enhanced near river mouths 
    180                ahtu(ji,jj) = MAX( MAX( zaht_min, aeiu(ji,jj) ) + zaht, aht0 ) 
    181                ahtv(ji,jj) = MAX( MAX( zaht_min, aeiv(ji,jj) ) + zaht, aht0 ) 
    182                ahtw(ji,jj) = MAX( MAX( zaht_min, aeiw(ji,jj) ) + zaht, aht0 ) 
    183             END DO 
    184          END DO 
    185          IF(ln_ctl) THEN 
    186             CALL prt_ctl(tab2d_1=ahtu, clinfo1=' aht  - u: ', ovlap=1) 
    187             CALL prt_ctl(tab2d_1=ahtv, clinfo1=' aht  - v: ', ovlap=1) 
    188             CALL prt_ctl(tab2d_1=ahtw, clinfo1=' aht  - w: ', ovlap=1) 
    189          ENDIF 
    190       ENDIF 
    191  
    192       IF( aeiv0 == 0.e0 ) THEN 
    193          aeiu(:,:) = 0.e0 
    194          aeiv(:,:) = 0.e0 
    195          aeiw(:,:) = 0.e0 
    196       ENDIF 
    197  
    198    END SUBROUTINE ldf_eiv 
    199  
    200 # else 
    201    !!---------------------------------------------------------------------- 
    202    !!   Default key                                             k-j-i loops 
    203    !!---------------------------------------------------------------------- 
    20440 
    20541   SUBROUTINE ldf_eiv( kt ) 
     
    25187 
    25288      DO jk = 1, jpk 
    253 #  if defined key_vectopt_loop  &&  ! defined key_mpp_omp 
     89#  if defined key_vectopt_loop   
    25490!CDIR NOVERRCHK  
    25591         DO ji = 1, jpij   ! vector opt. 
     
    373209   END SUBROUTINE ldf_eiv 
    374210 
    375 # endif 
    376  
    377211#else 
    378212   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.