Ignore:
Timestamp:
2020-07-01T15:01:22+02:00 (7 months ago)
Author:
jwhile
Message:

Updates for 1d runnig

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_1d_bugfixes_tocommit/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90

    r12102 r13191  
    4646#define numnam_ref numnam 
    4747#define numnam_cfg numnam 
    48 #define lwm        lwp    
     48#define lwm        lwp 
    4949#define numond     numout 
    5050 
    51 #define wmask      tmask   
     51#define wmask      tmask 
    5252 
    5353#endif 
     
    6363   !!                                          (SPP, SKEB and sea-ice) 
    6464   !!---------------------------------------------------------------------- 
    65    !!    
     65   !! 
    6666   !!   stopack       : Generate stochastic physics perturbations 
    67    !!    
     67   !! 
    6868   !!                   Method 
    6969   !!                   ====== 
     
    7171   !!       - SPPT (Stochastically perturbed parameterization 
    7272   !!         tendencies )scheme for user-selected trends for 
    73    !!            tracers, momentum and sea-ice  
     73   !!            tracers, momentum and sea-ice 
    7474   !!       - SPP (Schastically perturbed parameters) scheme 
    7575   !!         for some (namelist) parameters 
     
    7777   !!         backscatter energy dissipated numerically or 
    7878   !!            through deep convection. 
    79    !!    
    80    !!    
     79   !! 
     80   !! 
    8181   !!                   Acknowledgements: C3S funded ERGO project 
    82    !!    
     82   !! 
    8383   !!---------------------------------------------------------------------- 
    8484   USE par_kind 
    8585   USE timing          ! Timing 
    8686   USE oce             ! ocean dynamics and tracers variables 
    87    USE dom_oce         ! ocean space and time domain variables  
     87   USE dom_oce         ! ocean space and time domain variables 
    8888   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    8989   USE in_out_manager  ! I/O manager 
     
    104104   USE wrk_nemo 
    105105   USE diaptr 
    106    USE zdf_oce          
     106   USE zdf_oce 
    107107   USE phycst 
    108108 
     
    113113   PUBLIC tra_sppt_collect 
    114114   PUBLIC dyn_sppt_collect 
    115    PUBLIC tra_sppt_apply  
    116    PUBLIC dyn_sppt_apply  
     115   PUBLIC tra_sppt_apply 
     116   PUBLIC dyn_sppt_apply 
    117117   PUBLIC stopack_rst 
    118118   PUBLIC stopack_init 
     
    140140   REAL(wp), SAVE :: rn_spp_tau, rn_spp_stdev 
    141141   INTEGER :: skeb_filter_pass, spp_filter_pass 
    142   
     142 
    143143   ! SPPT Logical switches for individual tendencies 
    144144   LOGICAL :: ln_sppt_taumap, ln_stopack_restart, ln_distcoast, & 
    145145   ln_sppt_traxad, ln_sppt_trayad, ln_sppt_trazad, ln_sppt_trasad, ln_sppt_traldf, & 
    146146   ln_sppt_trazdf, ln_sppt_trazdfp,ln_sppt_traevd, ln_sppt_trabbc, ln_sppt_trabbl, & 
    147    ln_sppt_tranpc, ln_sppt_tradmp, ln_sppt_traqsr, ln_sppt_transr, ln_sppt_traatf     
     147   ln_sppt_tranpc, ln_sppt_tradmp, ln_sppt_traqsr, ln_sppt_transr, ln_sppt_traatf 
    148148   LOGICAL :: & 
    149149   ln_sppt_dynhpg, ln_sppt_dynspg, ln_sppt_dynkeg, ln_sppt_dynrvo, ln_sppt_dynpvo, ln_sppt_dynzad,& 
     
    181181   INTEGER, PARAMETER, PUBLIC :: jk_spp_qsi0   = 8 
    182182   INTEGER, PARAMETER, PUBLIC :: jk_spp_bfr    = 9 
    183    INTEGER, PARAMETER, PUBLIC :: jk_spp_aevd   = 10  
     183   INTEGER, PARAMETER, PUBLIC :: jk_spp_aevd   = 10 
    184184   INTEGER, PARAMETER, PUBLIC :: jk_spp_avt    = 11 
    185185   INTEGER, PARAMETER, PUBLIC :: jk_spp_avm    = 12 
     
    219219   INTEGER, SAVE :: numrep        = 602 
    220220   INTEGER, SAVE :: lkt 
    221     
     221 
    222222   ! Randome generator seed 
    223223   INTEGER, SAVE   :: nn_stopack_seed(4) 
     
    275275   !!---------------------------------------------------------------------- 
    276276   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    277    !! $Id: bdytra.F90 4292 2013-11-20 16:28:04Z cetlod $  
     277   !! $Id: bdytra.F90 4292 2013-11-20 16:28:04Z cetlod $ 
    278278   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    279279   !!---------------------------------------------------------------------- 
     
    289289      !! 
    290290      !! ** Purpose :   Collect tracer tendencies (additive) 
    291       !!                This function is called by the tendency diagnostics  
     291      !!                This function is called by the tendency diagnostics 
    292292      !!                module 
    293293      !!---------------------------------------------------------------------- 
    294294      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
    295295#endif 
    296       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdx   ! Temperature  
     296      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdx   ! Temperature 
    297297      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdy   ! Salinity 
    298298      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
     
    354354      !! 
    355355      !! ** Purpose :   Collect momentum tendencies (additive) 
    356       !!                This function is called by the tendency diagnostics  
     356      !!                This function is called by the tendency diagnostics 
    357357      !!                module 
    358358      !!---------------------------------------------------------------------- 
    359359      INTEGER                   , INTENT(in   ) ::   kt      ! time step 
    360360#endif 
    361       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdx   ! Temperature  
     361      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdx   ! Temperature 
    362362      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptrdy   ! Salinity 
    363363      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
     
    469469      !! 
    470470      !! ** Purpose :   Apply collinear perturbation to ice fields 
    471       !!                For specific processes coded in LIM2/LIM3  
     471      !!                For specific processes coded in LIM2/LIM3 
    472472      !!---------------------------------------------------------------------- 
    473473      ! 
     
    529529         zicewrk(:,:,jm) = z5     ; jm=jm+1 
    530530         zicewrk(:,:,jm) = z6     ; jm=jm+1 
    531          zicewrk(:,:,jm) = z7    
     531         zicewrk(:,:,jm) = z7 
    532532       ENDIF 
    533533       IF( kopt .EQ. 3 ) THEN 
     
    601601            CALL lbc_lnk( u_ice, 'U', -1. ) 
    602602            CALL lbc_lnk( v_ice, 'V', -1. ) 
    603 #endif          
     603#endif 
    604604#if defined key_lim2   &&   defined key_lim2_vp 
    605605            CALL lbc_lnk( u_ice(:,1:jpj), 'I', -1. ) 
    606606            CALL lbc_lnk( v_ice(:,1:jpj), 'I', -1. ) 
    607 #endif          
     607#endif 
    608608          ENDIF 
    609609          DEALLOCATE ( zicewrk ) 
     
    616616      !!                  ***  ROUTINE spp_gen *** 
    617617      !! 
    618       !! ** Purpose :   Perturbing parameters (generic function)   
     618      !! ** Purpose :   Perturbing parameters (generic function) 
    619619      !!                Given a value of standard deviation, the 2D parameter 
    620620      !!                coeff is perturbed following an additive Normal, 
     
    624624      !!---------------------------------------------------------------------- 
    625625   INTEGER, INTENT( in ) :: kt 
     626#if defined key_traldf_c3d 
     627   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj,jpk) :: coeff 
     628   REAL(wp), POINTER, DIMENSION(:,:,:) ::   gauss 
     629#elif defined key_traldf_c2d 
    626630   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj) :: coeff 
     631   REAL(wp), POINTER, DIMENSION(:,:) ::   gauss 
     632#elif defined key_traldf_c1d 
     633   REAL(wp), INTENT( inout ), DIMENSION(jpk) :: coeff 
     634   REAL(wp), POINTER, DIMENSION(:) ::   gauss 
     635#else 
     636   REAL(wp), INTENT( inout ) :: coeff 
     637   REAL(wp), POINTER ::   gauss 
     638#endif 
    627639   INTEGER, INTENT( in ) ::  nn_type 
    628640   REAL(wp), INTENT( in ) :: rn_sd 
     
    634646   INTEGER :: jklev 
    635647 
     648#if defined key_traldf_c2d || key_traldf_c3d 
    636649   CALL wrk_alloc(jpi,jpj,gauss) 
    637650 
     
    658671       gauss = gauss * rn_sd 
    659672       coeff = coeff * ( 1._wp + gauss ) 
     673#if defined key_traldf_c3d || key_traldf_c2d || key_traldf_c1d 
    660674       WHERE( coeff > 1._wp ) coeff = 1._wp 
    661675       WHERE( coeff < 0._wp ) coeff = 0._wp 
     676#else 
     677       IF( coeff > 1._wp ) coeff = 1._wp 
     678       IF( coeff < 0._wp ) coeff = 0._wp 
     679#endif 
    662680   ELSEIF ( nn_type  == 5 ) THEN 
    663681       zsd = rn_sd 
     
    665683       gauss = gauss * zsd + xme 
    666684       coeff = exp(gauss) * coeff 
     685#if defined key_traldf_c3d || key_traldf_c2d || key_traldf_c1d 
    667686       WHERE( coeff > 1._wp ) coeff = 1._wp 
    668687       WHERE( coeff < 0._wp ) coeff = 0._wp 
     688#else 
     689       IF( coeff > 1._wp ) coeff = 1._wp 
     690       IF( coeff < 0._wp ) coeff = 0._wp 
     691#endif 
    669692   ELSEIF ( nn_type == 6 ) THEN 
    670693       zsd = rn_sd 
     
    672695       gauss = gauss * zsd + xme 
    673696       coeff = exp(gauss) * coeff 
     697#if defined key_traldf_c3d || key_traldf_c2d || key_traldf_c1d 
    674698       WHERE( coeff > 1._wp ) coeff = 1._wp 
    675699       WHERE( coeff < 0._wp ) coeff = 0._wp 
     700#else 
     701       IF( coeff > 1._wp ) coeff = 1._wp 
     702       IF( coeff < 0._wp ) coeff = 0._wp 
     703#endif 
    676704   ELSE 
    677705       CALL ctl_stop( 'spp dqdt wrong option') 
     
    687715       jklev = klev 
    688716     ELSE 
    689        jklev = 0  
     717       jklev = 0 
    690718     ENDIF 
    691719     CALL spp_stats(kt,kspp,jklev,coeff) 
     
    694722   CALL wrk_dealloc(jpi,jpj,gauss) 
    695723 
     724#else 
     725   CALL ctl_stop( 'spp_gen: parameter perturbation will only work with '// & 
     726                  'key_traldf_c2d or key_traldf_c3d') 
     727#endif 
     728 
     729 
    696730   END SUBROUTINE 
    697731 
     
    704738   IMPLICIT NONE 
    705739   INTEGER, INTENT(IN) :: mt,kp,kl 
    706    REAL(wp), INTENT(IN) :: rcf(jpi,jpj) 
     740#if defined key_traldf_c3d 
     741   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj,jpk) :: rcf 
     742#elif defined key_traldf_c2d 
     743   REAL(wp), INTENT( inout ), DIMENSION(jpi,jpj) :: rcf 
     744#elif defined key_traldf_c1d 
     745   REAL(wp), INTENT( inout ), DIMENSION(jpk) :: rcf 
     746#else 
     747   REAL(wp), INTENT( inout ) :: rcf 
     748#endif 
    707749   REAL(wp) :: mi,ma 
    708750   CHARACTER(LEN=16) :: cstr = '                ' 
    709    SELECT CASE ( kp )  
    710      CASE( jk_spp_alb   )  
     751   SELECT CASE ( kp ) 
     752     CASE( jk_spp_alb   ) 
    711753       cstr = 'ALBEDO      ' 
    712      CASE( jk_spp_rhg   )  
    713        cstr = 'ICE RHEOLOGY'  
    714      CASE( jk_spp_relw  )  
    715        cstr = 'RELATIVE WND'  
    716      CASE( jk_spp_dqdt  )  
    717        cstr = 'SST RELAXAT.'  
    718      CASE( jk_spp_deds  )  
    719        cstr = 'SSS RELAXAT.'  
    720      CASE( jk_spp_arnf  )  
    721        cstr = 'RIVER MIXING'  
    722      CASE( jk_spp_geot  )  
    723        cstr = 'GEOTHERM.FLX'  
    724      CASE( jk_spp_qsi0  )  
    725        cstr = 'SOLAR EXTIN.'  
    726      CASE( jk_spp_bfr   )  
    727        cstr = 'BOTTOM FRICT'  
    728      CASE( jk_spp_aevd  )  
    729        cstr = 'EDDY VISCDIF'  
    730      CASE( jk_spp_avt   )  
     754     CASE( jk_spp_rhg   ) 
     755       cstr = 'ICE RHEOLOGY' 
     756     CASE( jk_spp_relw  ) 
     757       cstr = 'RELATIVE WND' 
     758     CASE( jk_spp_dqdt  ) 
     759       cstr = 'SST RELAXAT.' 
     760     CASE( jk_spp_deds  ) 
     761       cstr = 'SSS RELAXAT.' 
     762     CASE( jk_spp_arnf  ) 
     763       cstr = 'RIVER MIXING' 
     764     CASE( jk_spp_geot  ) 
     765       cstr = 'GEOTHERM.FLX' 
     766     CASE( jk_spp_qsi0  ) 
     767       cstr = 'SOLAR EXTIN.' 
     768     CASE( jk_spp_bfr   ) 
     769       cstr = 'BOTTOM FRICT' 
     770     CASE( jk_spp_aevd  ) 
     771       cstr = 'EDDY VISCDIF' 
     772     CASE( jk_spp_avt   ) 
    731773       cstr = 'VERT. DIFFUS' 
    732      CASE( jk_spp_avm   )  
     774     CASE( jk_spp_avm   ) 
    733775       cstr = 'VERT. VISCOS' 
    734      CASE( jk_spp_tkelc )  
     776     CASE( jk_spp_tkelc ) 
    735777       cstr = 'TKE LANGMUIR' 
    736      CASE( jk_spp_tkedf )  
    737        cstr = 'TKE RN_EDIFF'  
    738      CASE( jk_spp_tkeds )  
    739        cstr = 'TKE RN_EDISS'  
    740      CASE( jk_spp_tkebb )  
     778     CASE( jk_spp_tkedf ) 
     779       cstr = 'TKE RN_EDIFF' 
     780     CASE( jk_spp_tkeds ) 
     781       cstr = 'TKE RN_EDISS' 
     782     CASE( jk_spp_tkebb ) 
    741783       cstr = 'TKE RN_EBB  ' 
    742      CASE( jk_spp_tkefr )  
     784     CASE( jk_spp_tkefr ) 
    743785       cstr = 'TKE RN_EFR  ' 
    744      CASE( jk_spp_ahtu  )  
     786     CASE( jk_spp_ahtu  ) 
    745787       cstr = 'TRALDF AHTU ' 
    746      CASE( jk_spp_ahtv  )  
     788     CASE( jk_spp_ahtv  ) 
    747789       cstr = 'TRALDF AHTV ' 
    748      CASE( jk_spp_ahtw  )  
     790     CASE( jk_spp_ahtw  ) 
    749791       cstr = 'TRALDF AHTW ' 
    750      CASE( jk_spp_ahtt  )  
     792     CASE( jk_spp_ahtt  ) 
    751793       cstr = 'TRALDF AHTT ' 
    752794     CASE( jk_spp_ahubbl ) 
     
    765807       CALL ctl_stop('Unrecognized SPP parameter: add it or turn off diagnostics') 
    766808   END SELECT 
     809#if defined key_traldf_c3d || key_traldf_c2d || key_traldf_c1d 
    767810   mi = MINVAL(rcf) 
    768811   ma = MAXVAL(rcf) 
     812#else 
     813   mi = rcf 
     814   ma = rcf 
     815#endif 
    769816   IF(lk_mpp) CALL mpp_min(mi) 
    770817   IF(lk_mpp) CALL mpp_max(ma) 
     
    795842 
    796843   DO jp=1,jk_spp 
    797      SELECT CASE ( jp )  
    798        CASE( jk_spp_alb   )  
     844     SELECT CASE ( jp ) 
     845       CASE( jk_spp_alb   ) 
    799846         cstr = 'ALBEDO      ' 
    800        CASE( jk_spp_rhg   )  
    801          cstr = 'ICE RHEOLOGY'  
    802        CASE( jk_spp_relw  )  
    803          cstr = 'RELATIVE WND'  
    804        CASE( jk_spp_dqdt  )  
    805          cstr = 'SST RELAXAT.'  
    806        CASE( jk_spp_deds  )  
    807          cstr = 'SSS RELAXAT.'  
    808        CASE( jk_spp_arnf  )  
    809          cstr = 'RIVER MIXING'  
    810        CASE( jk_spp_geot  )  
    811          cstr = 'GEOTHERM.FLX'  
    812        CASE( jk_spp_qsi0  )  
    813          cstr = 'SOLAR EXTIN.'  
    814        CASE( jk_spp_bfr   )  
    815          cstr = 'BOTTOM FRICT'  
    816        CASE( jk_spp_aevd  )  
    817          cstr = 'EDDY VISCDIF'  
    818        CASE( jk_spp_avt   )  
     847       CASE( jk_spp_rhg   ) 
     848         cstr = 'ICE RHEOLOGY' 
     849       CASE( jk_spp_relw  ) 
     850         cstr = 'RELATIVE WND' 
     851       CASE( jk_spp_dqdt  ) 
     852         cstr = 'SST RELAXAT.' 
     853       CASE( jk_spp_deds  ) 
     854         cstr = 'SSS RELAXAT.' 
     855       CASE( jk_spp_arnf  ) 
     856         cstr = 'RIVER MIXING' 
     857       CASE( jk_spp_geot  ) 
     858         cstr = 'GEOTHERM.FLX' 
     859       CASE( jk_spp_qsi0  ) 
     860         cstr = 'SOLAR EXTIN.' 
     861       CASE( jk_spp_bfr   ) 
     862         cstr = 'BOTTOM FRICT' 
     863       CASE( jk_spp_aevd  ) 
     864         cstr = 'EDDY VISCDIF' 
     865       CASE( jk_spp_avt   ) 
    819866         cstr = 'VERT. DIFFUS' 
    820        CASE( jk_spp_avm   )  
     867       CASE( jk_spp_avm   ) 
    821868         cstr = 'VERT. VISCOS' 
    822        CASE( jk_spp_tkelc )  
     869       CASE( jk_spp_tkelc ) 
    823870         cstr = 'TKE LANGMUIR' 
    824        CASE( jk_spp_tkedf )  
    825          cstr = 'TKE RN_EDIFF'  
    826        CASE( jk_spp_tkeds )  
    827          cstr = 'TKE RN_EDISS'  
    828        CASE( jk_spp_tkebb )  
     871       CASE( jk_spp_tkedf ) 
     872         cstr = 'TKE RN_EDIFF' 
     873       CASE( jk_spp_tkeds ) 
     874         cstr = 'TKE RN_EDISS' 
     875       CASE( jk_spp_tkebb ) 
    829876         cstr = 'TKE RN_EBB  ' 
    830        CASE( jk_spp_tkefr )  
     877       CASE( jk_spp_tkefr ) 
    831878         cstr = 'TKE RN_EFR  ' 
    832        CASE( jk_spp_ahtu  )  
     879       CASE( jk_spp_ahtu  ) 
    833880         cstr = 'TRALDF AHTU ' 
    834        CASE( jk_spp_ahtv  )  
     881       CASE( jk_spp_ahtv  ) 
    835882         cstr = 'TRALDF AHTV ' 
    836        CASE( jk_spp_ahtw  )  
     883       CASE( jk_spp_ahtw  ) 
    837884         cstr = 'TRALDF AHTW ' 
    838        CASE( jk_spp_ahtt  )  
     885       CASE( jk_spp_ahtt  ) 
    839886         cstr = 'TRALDF AHTT ' 
    840887       CASE( jk_spp_ahubbl ) 
     
    11951242      ! Note: sshn should be staggered before being used. 
    11961243      SELECT CASE ( cd_type ) 
    1197                CASE ( 'T' )   
     1244               CASE ( 'T' ) 
    11981245                jk=1 
    11991246                zv = SUM( tmask_i(:,:)*tmask(:,:,jk)*e1t(:,:)*e2t(:,:)*sshn(:,:)*zts(:,:,1) ) 
     
    12851332      ! Random noise on 2d field 
    12861333      IF ( istep == 1 ) THEN 
    1287          CALL sppt_rand2d( g2d )  
     1334         CALL sppt_rand2d( g2d ) 
    12881335         CALL lbc_lnk( g2d , 'T', 1._wp) 
    12891336         g2d_save = g2d 
     
    12971344         g2d = rn_skeb_stdev * g2d_save / rn_sppt_stdev 
    12981345      ENDIF 
    1299     
     1346 
    13001347      ! Laplacian filter and re-normalization 
    13011348      DO jf = 1, nk 
     
    13141361      ENDIF 
    13151362#endif 
    1316     
     1363 
    13171364      ! AR(1) process and array swap 
    13181365      g2d = a*gb + b*g2d 
     
    13601407        ENDDO 
    13611408      ENDIF 
    1362        
     1409 
    13631410      ! Bound 
    13641411      IF( nn_sppt_step_bound .EQ. 2 ) THEN 
     
    14821529 
    14831530#ifdef NEMO_V34 
    1484       REWIND( numnam )             
     1531      REWIND( numnam ) 
    14851532      READ  ( numnam, namstopack ) 
    14861533#else 
    1487       REWIND( numnam_ref )  
     1534      REWIND( numnam_ref ) 
    14881535      READ  ( numnam_ref, namstopack, IOSTAT = ios, ERR = 901) 
    14891536901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in reference namelist', lwp ) 
    14901537 
    1491       REWIND( numnam_cfg )   
     1538      REWIND( numnam_cfg ) 
    14921539      READ  ( numnam_cfg, namstopack, IOSTAT = ios, ERR = 902 ) 
    14931540902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in configuration namelist', lwp ) 
     
    15681615         WRITE(numout,*) 
    15691616         WRITE(numout,*) '       Number of passes for spatial filter (AR1 field)     spp_filter_pass:', spp_filter_pass 
    1570          WRITE(numout,*) '       Standard deviation of random generator (AR1 field)  rn_spp_stdev :', rn_spp_stdev       
     1617         WRITE(numout,*) '       Standard deviation of random generator (AR1 field)  rn_spp_stdev :', rn_spp_stdev 
    15711618         WRITE(numout,*) '       Decorr. time scale                     (AR1 field)  rn_spp_tau   :', rn_spp_tau 
    15721619         WRITE(numout,*) 
    1573          WRITE(numout,*) '       SPP for bottom friction coeff                       nn_spp_bfr   :', nn_spp_bfr   
    1574          WRITE(numout,*) '                                            STDEV          rn_bfr_sd    :', rn_bfr_sd    
    1575          WRITE(numout,*) '       SPP for SST relaxation  coeff                       nn_spp_dqdt  :', nn_spp_dqdt  
    1576          WRITE(numout,*) '                                            STDEV          rn_dqdt_sd   :', rn_dqdt_sd    
    1577          WRITE(numout,*) '       SPP for SSS relaxation  coeff                       nn_spp_dedt  :', nn_spp_dedt  
    1578          WRITE(numout,*) '                                            STDEV          rn_dedt_sd   :', rn_dedt_sd    
    1579          WRITE(numout,*) '       SPP for vertical tra mixing coeff (only TKE, GLS)   nn_spp_avt   :', nn_spp_avt   
    1580          WRITE(numout,*) '                                            STDEV          rn_avt_sd    :', rn_avt_sd    
    1581          WRITE(numout,*) '       SPP for vertical dyn mixing coeff (only TKE, GLS)   nn_spp_avm   :', nn_spp_avm   
    1582          WRITE(numout,*) '                                            STDEV          rn_avm_sd    :', rn_avm_sd    
     1620         WRITE(numout,*) '       SPP for bottom friction coeff                       nn_spp_bfr   :', nn_spp_bfr 
     1621         WRITE(numout,*) '                                            STDEV          rn_bfr_sd    :', rn_bfr_sd 
     1622         WRITE(numout,*) '       SPP for SST relaxation  coeff                       nn_spp_dqdt  :', nn_spp_dqdt 
     1623         WRITE(numout,*) '                                            STDEV          rn_dqdt_sd   :', rn_dqdt_sd 
     1624         WRITE(numout,*) '       SPP for SSS relaxation  coeff                       nn_spp_dedt  :', nn_spp_dedt 
     1625         WRITE(numout,*) '                                            STDEV          rn_dedt_sd   :', rn_dedt_sd 
     1626         WRITE(numout,*) '       SPP for vertical tra mixing coeff (only TKE, GLS)   nn_spp_avt   :', nn_spp_avt 
     1627         WRITE(numout,*) '                                            STDEV          rn_avt_sd    :', rn_avt_sd 
     1628         WRITE(numout,*) '       SPP for vertical dyn mixing coeff (only TKE, GLS)   nn_spp_avm   :', nn_spp_avm 
     1629         WRITE(numout,*) '                                            STDEV          rn_avm_sd    :', rn_avm_sd 
    15831630         WRITE(numout,*) '       SPP for solar penetration scheme  (only RGB)        nn_spp_qsi0  :', nn_spp_qsi0 
    1584          WRITE(numout,*) '                                            STDEV          rn_qsi0_sd   :', rn_qsi0_sd    
     1631         WRITE(numout,*) '                                            STDEV          rn_qsi0_sd   :', rn_qsi0_sd 
    15851632         WRITE(numout,*) '       SPP for horiz. diffusivity  U                       nn_spp_ahtu  :', nn_spp_ahtu 
    1586          WRITE(numout,*) '                                            STDEV          rn_ahtu_sd   :', rn_ahtu_sd    
     1633         WRITE(numout,*) '                                            STDEV          rn_ahtu_sd   :', rn_ahtu_sd 
    15871634         WRITE(numout,*) '       SPP for horiz. diffusivity  V                       nn_spp_ahtv  :', nn_spp_ahtv 
    1588          WRITE(numout,*) '                                            STDEV          rn_ahtv_sd   :', rn_ahtv_sd    
     1635         WRITE(numout,*) '                                            STDEV          rn_ahtv_sd   :', rn_ahtv_sd 
    15891636         WRITE(numout,*) '       SPP for horiz. diffusivity  W                       nn_spp_ahtw  :', nn_spp_ahtw 
    1590          WRITE(numout,*) '                                            STDEV          rn_ahtw_sd   :', rn_ahtw_sd    
     1637         WRITE(numout,*) '                                            STDEV          rn_ahtw_sd   :', rn_ahtw_sd 
    15911638         WRITE(numout,*) '       SPP for horiz. diffusivity  T                       nn_spp_ahtt  :', nn_spp_ahtt 
    1592          WRITE(numout,*) '                                            STDEV          rn_ahtt_sd   :', rn_ahtt_sd    
     1639         WRITE(numout,*) '                                            STDEV          rn_ahtt_sd   :', rn_ahtt_sd 
    15931640         WRITE(numout,*) '       SPP for horiz. viscosity (1/3)                      nn_spp_ahm1  :', nn_spp_ahm1 
    1594          WRITE(numout,*) '                                            STDEV          rn_ahm1_sd   :', rn_ahm1_sd    
     1641         WRITE(numout,*) '                                            STDEV          rn_ahm1_sd   :', rn_ahm1_sd 
    15951642         WRITE(numout,*) '       SPP for horiz. viscosity (2/4)                      nn_spp_ahm2  :', nn_spp_ahm2 
    1596          WRITE(numout,*) '                                            STDEV          rn_ahm2_sd   :', rn_ahm2_sd    
     1643         WRITE(numout,*) '                                            STDEV          rn_ahm2_sd   :', rn_ahm2_sd 
    15971644         WRITE(numout,*) '       SPP for relative wind factor                        nn_spp_relw  :', nn_spp_relw 
    15981645         WRITE(numout,*) '       (use 4, 5, 6 for nn_spp_relw to have options 1, 2, 3 with limits bounded to [0,1]' 
    1599          WRITE(numout,*) '                                            STDEV          rn_relw_sd   :', rn_relw_sd    
     1646         WRITE(numout,*) '                                            STDEV          rn_relw_sd   :', rn_relw_sd 
    16001647         WRITE(numout,*) '       SPP for mixing close to river mouth                 nn_spp_arnf  :', nn_spp_arnf 
    1601          WRITE(numout,*) '                                            STDEV          rn_arnf_sd   :', rn_arnf_sd    
     1648         WRITE(numout,*) '                                            STDEV          rn_arnf_sd   :', rn_arnf_sd 
    16021649         WRITE(numout,*) '       SPP for geothermal heating                          nn_spp_geot  :', nn_spp_geot 
    1603          WRITE(numout,*) '                                            STDEV          rn_geot_sd   :', rn_geot_sd    
     1650         WRITE(numout,*) '                                            STDEV          rn_geot_sd   :', rn_geot_sd 
    16041651         WRITE(numout,*) '       SPP for enhanced vertical diffusion                 nn_spp_aevd  :', nn_spp_aevd 
    1605          WRITE(numout,*) '                                            STDEV          rn_aevd_sd   :', rn_aevd_sd    
     1652         WRITE(numout,*) '                                            STDEV          rn_aevd_sd   :', rn_aevd_sd 
    16061653         WRITE(numout,*) '       SPP for TKE rn_lc    Langmuir cell coefficient      nn_spp_tkelc :', nn_spp_tkelc 
    1607          WRITE(numout,*) '                                            STDEV          rn_tkelc_sd  :', rn_tkelc_sd    
     1654         WRITE(numout,*) '                                            STDEV          rn_tkelc_sd  :', rn_tkelc_sd 
    16081655         WRITE(numout,*) '       SPP for TKE rn_ediff Eddy diff. coefficient         nn_spp_tkedf :', nn_spp_tkedf 
    1609          WRITE(numout,*) '                                            STDEV          rn_tkedf_sd  :', rn_tkedf_sd    
     1656         WRITE(numout,*) '                                            STDEV          rn_tkedf_sd  :', rn_tkedf_sd 
    16101657         WRITE(numout,*) '       SPP for TKE rn_ediss Kolmogoroff dissipation coeff. nn_spp_tkeds :', nn_spp_tkeds 
    1611          WRITE(numout,*) '                                            STDEV          rn_tkeds_sd  :', rn_tkeds_sd    
     1658         WRITE(numout,*) '                                            STDEV          rn_tkeds_sd  :', rn_tkeds_sd 
    16121659         WRITE(numout,*) '       SPP for TKE rn_ebb   Surface input of tke           nn_spp_tkebb :', nn_spp_tkebb 
    1613          WRITE(numout,*) '                                            STDEV          rn_tkebb_sd  :', rn_tkebb_sd    
     1660         WRITE(numout,*) '                                            STDEV          rn_tkebb_sd  :', rn_tkebb_sd 
    16141661         WRITE(numout,*) '       SPP for TKE rn_efr   Fraction of srf TKE below ML   nn_spp_tkefr :', nn_spp_tkefr 
    1615          WRITE(numout,*) '                                            STDEV          rn_tkefr_sd  :', rn_tkefr_sd    
     1662         WRITE(numout,*) '                                            STDEV          rn_tkefr_sd  :', rn_tkefr_sd 
    16161663         WRITE(numout,*) '       SPP for BBL U  diffusivity                          nn_spp_ahubbl:', nn_spp_ahubbl 
    16171664         WRITE(numout,*) '                                            STDEV          rn_ahubbl_sd :', rn_ahubbl_sd 
     
    16261673         WRITE(numout,*) 
    16271674         WRITE(numout,*) ' SKEB Perturbation scheme ' 
    1628          WRITE(numout,*) '       SKEB switch                                         ln_skeb      :', ln_skeb     
    1629          WRITE(numout,*) '       SKEB ratio of backscattered energy                  rn_skeb      :', rn_skeb     
     1675         WRITE(numout,*) '       SKEB switch                                         ln_skeb      :', ln_skeb 
     1676         WRITE(numout,*) '       SKEB ratio of backscattered energy                  rn_skeb      :', rn_skeb 
    16301677         WRITE(numout,*) '       Frequency update for dissipation mask               nn_dcom_freq :', nn_dcom_freq 
    16311678         WRITE(numout,*) '       Numerical dissipation factor (resolut. dependent)   rn_kh        :', rn_kh 
    16321679         WRITE(numout,*) '       Number of passes for spatial filter (AR1 field)     skeb_filter_pass:', skeb_filter_pass 
    1633          WRITE(numout,*) '       Standard deviation of random generator (AR1 field)  rn_skeb_stdev:', rn_skeb_stdev       
     1680         WRITE(numout,*) '       Standard deviation of random generator (AR1 field)  rn_skeb_stdev:', rn_skeb_stdev 
    16341681         WRITE(numout,*) '       Decorr. time scale                     (AR1 field)  rn_skeb_tau  :', rn_skeb_tau 
    16351682         WRITE(numout,*) '       Option of convection energy dissipation             nn_dconv     :', nn_dconv 
     
    17521799 
    17531800      ! Find filter attenuation factor 
    1754     
     1801 
    17551802      flt_fac = sppt_fltfac( sppt_filter_pass ) 
    17561803      rdt_sppt = nn_rndm_freq * rn_rdt 
    1757     
     1804 
    17581805      IF( ln_sppt_taumap ) THEN 
    17591806         CALL iom_open ( 'sppt_tau_map', inum ) 
     
    17981845      gauss_b = 0._wp 
    17991846      ! Weigths 
    1800       gauss_w(:)    = 1.0_wp  
     1847      gauss_w(:)    = 1.0_wp 
    18011848      IF( nn_vwei .eq. 1 ) THEN 
    18021849        gauss_w(1)    = 0.0_wp 
     
    18611908      IF(lwp .and. ln_stopack_diags) & 
    18621909      CALL ctl_opn(numdiag, 'stopack.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    1863     
     1910 
    18641911   END SUBROUTINE stopack_init 
    18651912   ! 
     
    18741921      INTEGER :: id1, jseed 
    18751922      CHARACTER(LEN=10)   ::   clseed='spsd0_0000' 
    1876       INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type  
    1877       INTEGER(KIND=8)     ::   ivals(8)  
     1923      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type 
     1924      INTEGER(KIND=8)     ::   ivals(8) 
    18781925      REAL(wp)            ::   zrseed4(4)           ! RNG seeds in integer type 
    18791926      REAL(wp)            ::   zrseed2d(jpi,jpj) 
     
    19832030      !!--------------------------------------------------------------------- 
    19842031      ! 
    1985       ALLOCATE( spptt(jpi,jpj,jpk) , sppts(jpi,jpj,jpk) , gauss_n(jpi,jpj,jpk) ,&  
    1986       gauss_nu(jpi,jpj,jpk) , gauss_nv(jpi,jpj,jpk) , &  
     2032      ALLOCATE( spptt(jpi,jpj,jpk) , sppts(jpi,jpj,jpk) , gauss_n(jpi,jpj,jpk) ,& 
     2033      gauss_nu(jpi,jpj,jpk) , gauss_nv(jpi,jpj,jpk) , & 
    19872034      spptu(jpi,jpj,jpk) , spptv(jpi,jpj,jpk) , gauss_n_2d(jpi,jpj) ,& 
    19882035      gauss_b (jpi,jpj), sppt_tau(jpi,jpj), sppt_a(jpi,jpj), sppt_b(jpi,jpj), gauss_w(jpk),& 
     
    22082255      IF ( ln_dpsiv ) THEN 
    22092256       DO jp=1,jpni-1 
    2210          IF( jpri == jp ) THEN ! SEND TO EAST  
     2257         IF( jpri == jp ) THEN ! SEND TO EAST 
    22112258          zwrk(1:jpj) = dpsiv(jpi-1,:) 
    22122259          tag=2000+narea 
     
    22682315   REAL :: ds,dt,dtot,kh2 
    22692316   INTEGER :: ji,jj,jk 
    2270     
     2317 
    22712318   IF ( mt .eq. nit000 ) THEN 
    22722319        ALLOCATE ( dnum(jpi,jpj,jpk) ) 
     
    22872334          dt = (vn(ji,jj,jk)-vn(ji-1,jj,jk))*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e2v(ji,jj) + & 
    22882335               (un(ji,jj,jk)-un(ji,jj-1,jk))*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e1u(ji,jj) 
    2289    
     2336 
    22902337          dtot = sqrt( ds*ds + dt*dt ) * tmask(ji,jj,jk) 
    22912338          dnum(ji,jj,jk) = dtot*dtot*dtot*kh2*e1t(ji,jj)*e2t(ji,jj) 
     
    22932340      ENDDO 
    22942341     ENDDO 
    2295     
     2342 
    22962343     CALL lbc_lnk(dnum,'T',1._wp) 
    22972344 
    22982345   ENDIF 
    22992346 
    2300    END SUBROUTINE  
     2347   END SUBROUTINE 
    23012348 
    23022349   SUBROUTINE skeb_dcon ( mt ) 
     
    23292376 
    23302377           zz = - grav*avt(ji,jj,jk) * ( rhd(ji,jj,jk)-rhd(ji,jj,jk-1) ) * wmask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) & 
    2331               & / ( rau0 * fse3w(ji,jj,jk) )  
     2378              & / ( rau0 * fse3w(ji,jj,jk) ) 
    23322379 
    23332380           dcon(ji,jj,jk) = kc2*zz*e1t(ji,jj)*e2t(ji,jj)*rau0 / fse3w(ji,jj,jk) 
     
    23782425     IF(ln_skeb_own_gauss) THEN 
    23792426       DO jk=1,jpkm1 
    2380          psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk) ) * gauss_n_2d_k(:,:)  
     2427         psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk) ) * gauss_n_2d_k(:,:) 
    23812428       ENDDO 
    23822429     ELSE 
     
    24072454     IF(ln_skeb_own_gauss) THEN 
    24082455       DO jk=1,jpkm1 
    2409          psi(:,:,jk) = rn_skeb * sqrt( rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:)  
     2456         psi(:,:,jk) = rn_skeb * sqrt( rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:) 
    24102457       ENDDO 
    24112458     ELSE 
     
    24402487   IF(ln_skeb_own_gauss) THEN 
    24412488     DO jk=1,jpkm1 
    2442        psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk)+ rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:)  
     2489       psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk)+ rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:) 
    24432490     ENDDO 
    24442491   ELSE 
Note: See TracChangeset for help on using the changeset viewer.