Ignore:
Timestamp:
2018-12-19T22:54:16+01:00 (2 years ago)
Author:
smasson
Message:

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

Location:
NEMO/trunk/src/OCE/ZDF
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/ZDF/zdf_oce.F90

    r10364 r10425  
    6969         &      avmb(jpk)         , avtb(jpk)          , avtb_2d(jpi,jpj) , STAT = zdf_oce_alloc ) 
    7070         ! 
    71       IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') 
     71      IF( zdf_oce_alloc /= 0 )   CALL ctl_stop( 'STOP', 'zdf_oce_alloc: failed to allocate arrays' ) 
    7272      ! 
    7373   END FUNCTION zdf_oce_alloc 
  • NEMO/trunk/src/OCE/ZDF/zdfgls.F90

    r10342 r10425  
    119119         &      zwall (jpi,jpj,jpk) , ustar2_top (jpi,jpj) , ustar2_bot(jpi,jpj) , STAT= zdf_gls_alloc ) 
    120120         ! 
    121       IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc ) 
    122       IF( zdf_gls_alloc /= 0 )   CALL ctl_warn('zdf_gls_alloc: failed to allocate arrays') 
     121      CALL mpp_sum ( 'zdfgls', zdf_gls_alloc ) 
     122      IF( zdf_gls_alloc /= 0 )   CALL ctl_stop( 'STOP', 'zdf_gls_alloc: failed to allocate arrays' ) 
    123123   END FUNCTION zdf_gls_alloc 
    124124 
  • NEMO/trunk/src/OCE/ZDF/zdfiwm.F90

    r10069 r10425  
    6464      &         hbot_iwm(jpi,jpj),  hcri_iwm(jpi,jpj)                     , STAT=zdf_iwm_alloc ) 
    6565      ! 
    66       IF( lk_mpp             )   CALL mpp_sum ( zdf_iwm_alloc ) 
    67       IF( zdf_iwm_alloc /= 0 )   CALL ctl_warn('zdf_iwm_alloc: failed to allocate arrays') 
     66      CALL mpp_sum ( 'zdfiwm', zdf_iwm_alloc ) 
     67      IF( zdf_iwm_alloc /= 0 )   CALL ctl_stop( 'STOP', 'zdf_iwm_alloc: failed to allocate arrays' ) 
    6868   END FUNCTION zdf_iwm_alloc 
    6969 
     
    122122      ! 
    123123      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    124       REAL(wp) ::   zztmp        ! scalar workspace 
     124      REAL(wp) ::   zztmp, ztmp1, ztmp2        ! scalar workspace 
    125125      REAL(wp), DIMENSION(jpi,jpj)     ::   zfact       ! Used for vertical structure 
    126126      REAL(wp), DIMENSION(jpi,jpj)     ::   zhdep       ! Ocean depth 
     
    157157!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept_n - sshn 
    158158      DO jk = 2, jpkm1              ! complete with the level-dependent part 
    159          zemx_iwm(:,:,jk) = zfact(:,:) * (  EXP( ( gde3w_n(:,:,jk  ) - zhdep(:,:) ) / hcri_iwm(:,:) )                      & 
    160             &                             - EXP( ( gde3w_n(:,:,jk-1) - zhdep(:,:) ) / hcri_iwm(:,:) )  ) * wmask(:,:,jk)   & 
    161             &                          / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 
    162  
     159         DO jj = 1, jpj              
     160            DO ji = 1, jpi 
     161               IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
     162                  zemx_iwm(ji,jj,jk) = 0._wp 
     163               ELSE 
     164                  zemx_iwm(ji,jj,jk) = zfact(ji,jj) * (  EXP( ( gde3w_n(ji,jj,jk  ) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) )     & 
     165                       &                               - EXP( ( gde3w_n(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) )   & 
     166                       &                            / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 
     167               ENDIF 
     168            END DO 
     169         END DO 
    163170!!gm delta(gde3w_n) = e3t_n  !!  Please verify the grid-point position w versus t-point 
    164171!!gm it seems to me that only 1/hcri_iwm  is used ==>  compute it one for all 
     
    234241      zwkb(:,:,1) = zhdep(:,:) * wmask(:,:,1) 
    235242      ! 
    236       zweight(:,:,:) = 0._wp 
    237       DO jk = 2, jpkm1 
    238          zweight(:,:,jk) = MAX( 0._wp, rn2(:,:,jk) ) * hbot_iwm(:,:) * wmask(:,:,jk)                    & 
    239             &   * (  EXP( -zwkb(:,:,jk) / hbot_iwm(:,:) ) - EXP( -zwkb(:,:,jk-1) / hbot_iwm(:,:) )  ) 
     243      DO jk = 2, jpkm1 
     244         DO jj = 1, jpj 
     245            DO ji = 1, jpi 
     246               IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
     247                  zweight(ji,jj,jk) = 0._wp 
     248               ELSE 
     249                  zweight(ji,jj,jk) = rn2(ji,jj,jk) * hbot_iwm(ji,jj)    & 
     250                     &   * (  EXP( -zwkb(ji,jj,jk) / hbot_iwm(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_iwm(ji,jj) )  ) 
     251               ENDIF 
     252            END DO 
     253         END DO 
    240254      END DO 
    241255      ! 
     
    305319            END DO 
    306320         END DO 
    307          IF( lk_mpp )   CALL mpp_sum( zztmp ) 
     321         CALL mpp_sum( 'zdfiwm', zztmp ) 
    308322         zztmp = rau0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing  
    309323         ! 
     
    322336      !       
    323337      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature 
     338         ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 
    324339         DO jk = 2, jpkm1              ! Calculate S/T diffusivity ratio as a function of Reb 
    325340            DO jj = 1, jpj 
    326341               DO ji = 1, jpi 
    327                   zav_ratio(ji,jj,jk) = ( 0.505_wp + 0.495_wp *                                                                  & 
    328                       &   TANH(    0.92_wp * (   LOG10(  MAX( 1.e-20_wp, zReb(ji,jj,jk) * 5._wp * r1_6 )  ) - 0.60_wp   )    )   & 
    329                       &                 ) * wmask(ji,jj,jk) 
     342                  ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
     343                  IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 
     344                     zav_ratio(ji,jj,jk) = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10(ztmp2) - 0.60_wp ) ) 
     345                  ELSE 
     346                     zav_ratio(ji,jj,jk) = ztmp1 * wmask(ji,jj,jk) 
     347                  ENDIF 
    330348               END DO 
    331349            END DO 
     
    463481      ecri_iwm(:,:) = ecri_iwm(:,:) * ssmask(:,:) 
    464482 
    465       zbot = glob_sum( e1e2t(:,:) * ebot_iwm(:,:) ) 
    466       zpyc = glob_sum( e1e2t(:,:) * epyc_iwm(:,:) ) 
    467       zcri = glob_sum( e1e2t(:,:) * ecri_iwm(:,:) ) 
     483      zbot = glob_sum( 'zdfiwm', e1e2t(:,:) * ebot_iwm(:,:) ) 
     484      zpyc = glob_sum( 'zdfiwm', e1e2t(:,:) * epyc_iwm(:,:) ) 
     485      zcri = glob_sum( 'zdfiwm', e1e2t(:,:) * ecri_iwm(:,:) ) 
    468486      IF(lwp) THEN 
    469487         WRITE(numout,*) '      High-mode wave-breaking energy:             ', zbot * 1.e-12_wp, 'TW' 
  • NEMO/trunk/src/OCE/ZDF/zdfmxl.F90

    r10351 r10425  
    5050         ALLOCATE( nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), STAT= zdf_mxl_alloc ) 
    5151         ! 
    52          IF( lk_mpp             )   CALL mpp_sum ( zdf_mxl_alloc ) 
    53          IF( zdf_mxl_alloc /= 0 )   CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.') 
     52         CALL mpp_sum ( 'zdfmxl', zdf_mxl_alloc ) 
     53         IF( zdf_mxl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl_alloc: failed to allocate arrays.' ) 
    5454         ! 
    5555      ENDIF 
  • NEMO/trunk/src/OCE/ZDF/zdfosm.F90

    r10364 r10425  
    118118          &   etmean(jpi,jpj,jpk),  STAT= zdf_osm_alloc ) 
    119119     IF( zdf_osm_alloc /= 0 )   CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 
    120      IF( lk_mpp             )   CALL mpp_sum ( zdf_osm_alloc ) 
     120     CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 
    121121   END FUNCTION zdf_osm_alloc 
    122122 
     
    12871287 
    12881288       ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 
    1289        CALL lbc_lnk( zviscos(:,:,:), 'W', 1. ) 
     1289       CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1. ) 
    12901290 
    12911291       ! GN 25/8: need to change tmask --> wmask 
     
    13001300     END DO 
    13011301      ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids 
    1302      CALL lbc_lnk_multi( p_avt, 'W', 1. , p_avm, 'W', 1.,   & 
     1302     CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1.,   & 
    13031303      &                  ghamu, 'W', 1. , ghamv, 'W', 1. ) 
    13041304       DO jk = 2, jpkm1 
     
    13181318        ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    13191319        ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign unchanged) 
    1320         CALL lbc_lnk_multi( ghamt, 'W', 1. , ghams, 'W', 1.,   & 
     1320        CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1. , ghams, 'W', 1.,   & 
    13211321         &                  ghamu, 'U', 1. , ghamv, 'V', 1. ) 
    13221322 
     
    13591359      END IF 
    13601360      ! Lateral boundary conditions on p_avt  (sign unchanged) 
    1361       CALL lbc_lnk( p_avt(:,:,:), 'W', 1. ) 
     1361      CALL lbc_lnk( 'zdfosm', p_avt(:,:,:), 'W', 1. ) 
    13621362      ! 
    13631363   END SUBROUTINE zdf_osm 
  • NEMO/trunk/src/OCE/ZDF/zdfphy.F90

    r10364 r10425  
    300300      !                                         !* Lateral boundary conditions (sign unchanged) 
    301301      IF( l_zdfsh2 ) THEN 
    302          CALL lbc_lnk_multi( avm_k, 'W', 1. , avt_k, 'W', 1.,   & 
     302         CALL lbc_lnk_multi( 'zdfphy', avm_k, 'W', 1. , avt_k, 'W', 1.,   & 
    303303            &                avm  , 'W', 1. , avt  , 'W', 1. , avs , 'W', 1. ) 
    304304      ELSE 
    305          CALL lbc_lnk_multi( avm  , 'W', 1. , avt  , 'W', 1. , avs , 'W', 1. ) 
     305         CALL lbc_lnk_multi( 'zdfphy', avm  , 'W', 1. , avt  , 'W', 1. , avs , 'W', 1. ) 
    306306      ENDIF 
    307307      ! 
    308308      IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
    309          IF( ln_isfcav ) THEN   ;  CALL lbc_lnk_multi( rCdU_top, 'T', 1. , rCdU_bot, 'T', 1. )   ! top & bot drag 
    310          ELSE                   ;  CALL lbc_lnk      ( rCdU_bot, 'T', 1. )                       ! bottom drag only 
     309         IF( ln_isfcav ) THEN   ;  CALL lbc_lnk_multi( 'zdfphy', rCdU_top, 'T', 1. , rCdU_bot, 'T', 1. )   ! top & bot drag 
     310         ELSE                   ;  CALL lbc_lnk      ( 'zdfphy', rCdU_bot, 'T', 1. )                       ! bottom drag only 
    311311         ENDIF 
    312312      ENDIF 
     
    331331     ALLOCATE(     wi(jpi,jpj,jpk), Cu_adv(jpi,jpj,jpk),  STAT= zdf_phy_alloc ) 
    332332     IF( zdf_phy_alloc /= 0 )   CALL ctl_warn('zdf_phy_alloc: failed to allocate ln_zad_Aimp=T required arrays') 
    333      IF( lk_mpp             )   CALL mpp_sum ( zdf_phy_alloc ) 
     333     CALL mpp_sum ( 'zdfphy', zdf_phy_alloc ) 
    334334   END FUNCTION zdf_phy_alloc 
    335335 
  • NEMO/trunk/src/OCE/ZDF/zdftke.F90

    r10068 r10425  
    103103      ALLOCATE( htau(jpi,jpj) , dissl(jpi,jpj,jpk) , apdlr(jpi,jpj,jpk) ,   STAT= zdf_tke_alloc ) 
    104104      ! 
    105       IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
    106       IF( zdf_tke_alloc /= 0 )   CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') 
     105      CALL mpp_sum ( 'zdftke', zdf_tke_alloc ) 
     106      IF( zdf_tke_alloc /= 0 )   CALL ctl_stop( 'STOP', 'zdf_tke_alloc: failed to allocate arrays' ) 
    107107      ! 
    108108   END FUNCTION zdf_tke_alloc 
     
    202202      REAL(wp) ::   zzd_up, zzd_lw             !   -         - 
    203203      INTEGER , DIMENSION(jpi,jpj)     ::   imlc 
    204       REAL(wp), DIMENSION(jpi,jpj)     ::   zhlc 
     204      REAL(wp), DIMENSION(jpi,jpj)     ::   zhlc, zfr_i 
    205205      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc, zdiag, zd_up, zd_lw 
    206206      !!-------------------------------------------------------------------- 
     
    290290         END DO 
    291291         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
     292         DO jj = 2, jpjm1 
     293            DO ji = fs_2, fs_jpim1   ! vector opt. 
     294               zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
     295               zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
     296               IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 
     297            END DO 
     298         END DO          
    292299         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    293300            DO jj = 2, jpjm1 
    294301               DO ji = fs_2, fs_jpim1   ! vector opt. 
    295                   zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
    296                   !                                           ! vertical velocity due to LC 
    297                   zind = 0.5 - SIGN( 0.5, pdepw(ji,jj,jk) - zhlc(ji,jj) ) 
    298                   zwlc = zind * rn_lc * zus * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    299                   !                                           ! TKE Langmuir circulation source term 
    300                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 4.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
    301                      &                              / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     302                  IF ( zfr_i(ji,jj) /= 0. ) THEN                
     303                     ! vertical velocity due to LC    
     304                     IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 
     305                        !                                           ! vertical velocity due to LC 
     306                        zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) )   ! warning: optimization: zus^3 is in zfr_i 
     307                        !                                           ! TKE Langmuir circulation source term 
     308                        en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 
     309                     ENDIF 
     310                  ENDIF 
    302311               END DO 
    303312            END DO 
Note: See TracChangeset for help on using the changeset viewer.