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 13355 for branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90 – NEMO

Ignore:
Timestamp:
2020-07-30T12:12:41+02:00 (4 years ago)
Author:
jwhile
Message:

Merged in changes to fix 1d running - documented in UKMO ocean utils ticket 367

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90

    r12102 r13355  
    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, 
    … …  
    633633   CHARACTER (LEN=99) :: cstrng 
    634634   INTEGER :: jklev 
     635 
     636#if defined key_traldf_c3d || key_traldf_c2d 
    635637 
    636638   CALL wrk_alloc(jpi,jpj,gauss) 
    … …  
    687689       jklev = klev 
    688690     ELSE 
    689        jklev = 0  
     691       jklev = 0 
    690692     ENDIF 
    691693     CALL spp_stats(kt,kspp,jklev,coeff) 
    … …  
    693695 
    694696   CALL wrk_dealloc(jpi,jpj,gauss) 
     697 
     698#else 
     699   CALL ctl_stop('key_traldf_c1d is not a valid key for STO') 
     700#endif 
    695701 
    696702   END SUBROUTINE 
    … …  
    707713   REAL(wp) :: mi,ma 
    708714   CHARACTER(LEN=16) :: cstr = '                ' 
    709    SELECT CASE ( kp )  
    710      CASE( jk_spp_alb   )  
     715   SELECT CASE ( kp ) 
     716     CASE( jk_spp_alb   ) 
    711717       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   )  
     718     CASE( jk_spp_rhg   ) 
     719       cstr = 'ICE RHEOLOGY' 
     720     CASE( jk_spp_relw  ) 
     721       cstr = 'RELATIVE WND' 
     722     CASE( jk_spp_dqdt  ) 
     723       cstr = 'SST RELAXAT.' 
     724     CASE( jk_spp_deds  ) 
     725       cstr = 'SSS RELAXAT.' 
     726     CASE( jk_spp_arnf  ) 
     727       cstr = 'RIVER MIXING' 
     728     CASE( jk_spp_geot  ) 
     729       cstr = 'GEOTHERM.FLX' 
     730     CASE( jk_spp_qsi0  ) 
     731       cstr = 'SOLAR EXTIN.' 
     732     CASE( jk_spp_bfr   ) 
     733       cstr = 'BOTTOM FRICT' 
     734     CASE( jk_spp_aevd  ) 
     735       cstr = 'EDDY VISCDIF' 
     736     CASE( jk_spp_avt   ) 
    731737       cstr = 'VERT. DIFFUS' 
    732      CASE( jk_spp_avm   )  
     738     CASE( jk_spp_avm   ) 
    733739       cstr = 'VERT. VISCOS' 
    734      CASE( jk_spp_tkelc )  
     740     CASE( jk_spp_tkelc ) 
    735741       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 )  
     742     CASE( jk_spp_tkedf ) 
     743       cstr = 'TKE RN_EDIFF' 
     744     CASE( jk_spp_tkeds ) 
     745       cstr = 'TKE RN_EDISS' 
     746     CASE( jk_spp_tkebb ) 
    741747       cstr = 'TKE RN_EBB  ' 
    742      CASE( jk_spp_tkefr )  
     748     CASE( jk_spp_tkefr ) 
    743749       cstr = 'TKE RN_EFR  ' 
    744      CASE( jk_spp_ahtu  )  
     750     CASE( jk_spp_ahtu  ) 
    745751       cstr = 'TRALDF AHTU ' 
    746      CASE( jk_spp_ahtv  )  
     752     CASE( jk_spp_ahtv  ) 
    747753       cstr = 'TRALDF AHTV ' 
    748      CASE( jk_spp_ahtw  )  
     754     CASE( jk_spp_ahtw  ) 
    749755       cstr = 'TRALDF AHTW ' 
    750      CASE( jk_spp_ahtt  )  
     756     CASE( jk_spp_ahtt  ) 
    751757       cstr = 'TRALDF AHTT ' 
    752758     CASE( jk_spp_ahubbl ) 
    … …  
    795801 
    796802   DO jp=1,jk_spp 
    797      SELECT CASE ( jp )  
    798        CASE( jk_spp_alb   )  
     803     SELECT CASE ( jp ) 
     804       CASE( jk_spp_alb   ) 
    799805         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   )  
     806       CASE( jk_spp_rhg   ) 
     807         cstr = 'ICE RHEOLOGY' 
     808       CASE( jk_spp_relw  ) 
     809         cstr = 'RELATIVE WND' 
     810       CASE( jk_spp_dqdt  ) 
     811         cstr = 'SST RELAXAT.' 
     812       CASE( jk_spp_deds  ) 
     813         cstr = 'SSS RELAXAT.' 
     814       CASE( jk_spp_arnf  ) 
     815         cstr = 'RIVER MIXING' 
     816       CASE( jk_spp_geot  ) 
     817         cstr = 'GEOTHERM.FLX' 
     818       CASE( jk_spp_qsi0  ) 
     819         cstr = 'SOLAR EXTIN.' 
     820       CASE( jk_spp_bfr   ) 
     821         cstr = 'BOTTOM FRICT' 
     822       CASE( jk_spp_aevd  ) 
     823         cstr = 'EDDY VISCDIF' 
     824       CASE( jk_spp_avt   ) 
    819825         cstr = 'VERT. DIFFUS' 
    820        CASE( jk_spp_avm   )  
     826       CASE( jk_spp_avm   ) 
    821827         cstr = 'VERT. VISCOS' 
    822        CASE( jk_spp_tkelc )  
     828       CASE( jk_spp_tkelc ) 
    823829         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 )  
     830       CASE( jk_spp_tkedf ) 
     831         cstr = 'TKE RN_EDIFF' 
     832       CASE( jk_spp_tkeds ) 
     833         cstr = 'TKE RN_EDISS' 
     834       CASE( jk_spp_tkebb ) 
    829835         cstr = 'TKE RN_EBB  ' 
    830        CASE( jk_spp_tkefr )  
     836       CASE( jk_spp_tkefr ) 
    831837         cstr = 'TKE RN_EFR  ' 
    832        CASE( jk_spp_ahtu  )  
     838       CASE( jk_spp_ahtu  ) 
    833839         cstr = 'TRALDF AHTU ' 
    834        CASE( jk_spp_ahtv  )  
     840       CASE( jk_spp_ahtv  ) 
    835841         cstr = 'TRALDF AHTV ' 
    836        CASE( jk_spp_ahtw  )  
     842       CASE( jk_spp_ahtw  ) 
    837843         cstr = 'TRALDF AHTW ' 
    838        CASE( jk_spp_ahtt  )  
     844       CASE( jk_spp_ahtt  ) 
    839845         cstr = 'TRALDF AHTT ' 
    840846       CASE( jk_spp_ahubbl ) 
    … …  
    922928   INTEGER :: jk 
    923929 
     930#if defined key_traldf_c3d || key_traldf_c2d 
     931 
    924932   CALL wrk_alloc(jpi,jpj,gauss) 
    925933 
    … …  
    969977   ENDIF 
    970978 
     979#else 
     980   CALL ctl_stop('key_traldf_c1d is not a valid key for STO') 
     981 
     982#endif 
     983 
    971984   CALL wrk_dealloc(jpi,jpj,gauss) 
    972985 
    … …  
    9971010   REAL(wp) :: zsd,xme 
    9981011   INTEGER :: jk 
     1012 
     1013#if defined key_dynldf_c3d || key_dynldf_c2d 
    9991014 
    10001015   CALL wrk_alloc(jpi,jpj,gauss) 
    … …  
    10461061 
    10471062   CALL wrk_dealloc(jpi,jpj,gauss) 
     1063 
     1064#else 
     1065   CALL ctl_stop('key_traldf_c1d is not a valid key for STO') 
     1066#endif 
    10481067 
    10491068   END SUBROUTINE 
    … …  
    11951214      ! Note: sshn should be staggered before being used. 
    11961215      SELECT CASE ( cd_type ) 
    1197                CASE ( 'T' )   
     1216               CASE ( 'T' ) 
    11981217                jk=1 
    11991218                zv = SUM( tmask_i(:,:)*tmask(:,:,jk)*e1t(:,:)*e2t(:,:)*sshn(:,:)*zts(:,:,1) ) 
    … …  
    12851304      ! Random noise on 2d field 
    12861305      IF ( istep == 1 ) THEN 
    1287          CALL sppt_rand2d( g2d )  
     1306         CALL sppt_rand2d( g2d ) 
    12881307         CALL lbc_lnk( g2d , 'T', 1._wp) 
    12891308         g2d_save = g2d 
    … …  
    12971316         g2d = rn_skeb_stdev * g2d_save / rn_sppt_stdev 
    12981317      ENDIF 
    1299     
     1318 
    13001319      ! Laplacian filter and re-normalization 
    13011320      DO jf = 1, nk 
    … …  
    13141333      ENDIF 
    13151334#endif 
    1316     
     1335 
    13171336      ! AR(1) process and array swap 
    13181337      g2d = a*gb + b*g2d 
    … …  
    13601379        ENDDO 
    13611380      ENDIF 
    1362        
     1381 
    13631382      ! Bound 
    13641383      IF( nn_sppt_step_bound .EQ. 2 ) THEN 
    … …  
    14821501 
    14831502#ifdef NEMO_V34 
    1484       REWIND( numnam )             
     1503      REWIND( numnam ) 
    14851504      READ  ( numnam, namstopack ) 
    14861505#else 
    1487       REWIND( numnam_ref )  
     1506      REWIND( numnam_ref ) 
    14881507      READ  ( numnam_ref, namstopack, IOSTAT = ios, ERR = 901) 
    14891508901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in reference namelist', lwp ) 
    14901509 
    1491       REWIND( numnam_cfg )   
     1510      REWIND( numnam_cfg ) 
    14921511      READ  ( numnam_cfg, namstopack, IOSTAT = ios, ERR = 902 ) 
    14931512902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in configuration namelist', lwp ) 
    … …  
    15681587         WRITE(numout,*) 
    15691588         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       
     1589         WRITE(numout,*) '       Standard deviation of random generator (AR1 field)  rn_spp_stdev :', rn_spp_stdev 
    15711590         WRITE(numout,*) '       Decorr. time scale                     (AR1 field)  rn_spp_tau   :', rn_spp_tau 
    15721591         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    
     1592         WRITE(numout,*) '       SPP for bottom friction coeff                       nn_spp_bfr   :', nn_spp_bfr 
     1593         WRITE(numout,*) '                                            STDEV          rn_bfr_sd    :', rn_bfr_sd 
     1594         WRITE(numout,*) '       SPP for SST relaxation  coeff                       nn_spp_dqdt  :', nn_spp_dqdt 
     1595         WRITE(numout,*) '                                            STDEV          rn_dqdt_sd   :', rn_dqdt_sd 
     1596         WRITE(numout,*) '       SPP for SSS relaxation  coeff                       nn_spp_dedt  :', nn_spp_dedt 
     1597         WRITE(numout,*) '                                            STDEV          rn_dedt_sd   :', rn_dedt_sd 
     1598         WRITE(numout,*) '       SPP for vertical tra mixing coeff (only TKE, GLS)   nn_spp_avt   :', nn_spp_avt 
     1599         WRITE(numout,*) '                                            STDEV          rn_avt_sd    :', rn_avt_sd 
     1600         WRITE(numout,*) '       SPP for vertical dyn mixing coeff (only TKE, GLS)   nn_spp_avm   :', nn_spp_avm 
     1601         WRITE(numout,*) '                                            STDEV          rn_avm_sd    :', rn_avm_sd 
    15831602         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    
     1603         WRITE(numout,*) '                                            STDEV          rn_qsi0_sd   :', rn_qsi0_sd 
    15851604         WRITE(numout,*) '       SPP for horiz. diffusivity  U                       nn_spp_ahtu  :', nn_spp_ahtu 
    1586          WRITE(numout,*) '                                            STDEV          rn_ahtu_sd   :', rn_ahtu_sd    
     1605         WRITE(numout,*) '                                            STDEV          rn_ahtu_sd   :', rn_ahtu_sd 
    15871606         WRITE(numout,*) '       SPP for horiz. diffusivity  V                       nn_spp_ahtv  :', nn_spp_ahtv 
    1588          WRITE(numout,*) '                                            STDEV          rn_ahtv_sd   :', rn_ahtv_sd    
     1607         WRITE(numout,*) '                                            STDEV          rn_ahtv_sd   :', rn_ahtv_sd 
    15891608         WRITE(numout,*) '       SPP for horiz. diffusivity  W                       nn_spp_ahtw  :', nn_spp_ahtw 
    1590          WRITE(numout,*) '                                            STDEV          rn_ahtw_sd   :', rn_ahtw_sd    
     1609         WRITE(numout,*) '                                            STDEV          rn_ahtw_sd   :', rn_ahtw_sd 
    15911610         WRITE(numout,*) '       SPP for horiz. diffusivity  T                       nn_spp_ahtt  :', nn_spp_ahtt 
    1592          WRITE(numout,*) '                                            STDEV          rn_ahtt_sd   :', rn_ahtt_sd    
     1611         WRITE(numout,*) '                                            STDEV          rn_ahtt_sd   :', rn_ahtt_sd 
    15931612         WRITE(numout,*) '       SPP for horiz. viscosity (1/3)                      nn_spp_ahm1  :', nn_spp_ahm1 
    1594          WRITE(numout,*) '                                            STDEV          rn_ahm1_sd   :', rn_ahm1_sd    
     1613         WRITE(numout,*) '                                            STDEV          rn_ahm1_sd   :', rn_ahm1_sd 
    15951614         WRITE(numout,*) '       SPP for horiz. viscosity (2/4)                      nn_spp_ahm2  :', nn_spp_ahm2 
    1596          WRITE(numout,*) '                                            STDEV          rn_ahm2_sd   :', rn_ahm2_sd    
     1615         WRITE(numout,*) '                                            STDEV          rn_ahm2_sd   :', rn_ahm2_sd 
    15971616         WRITE(numout,*) '       SPP for relative wind factor                        nn_spp_relw  :', nn_spp_relw 
    15981617         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    
     1618         WRITE(numout,*) '                                            STDEV          rn_relw_sd   :', rn_relw_sd 
    16001619         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    
     1620         WRITE(numout,*) '                                            STDEV          rn_arnf_sd   :', rn_arnf_sd 
    16021621         WRITE(numout,*) '       SPP for geothermal heating                          nn_spp_geot  :', nn_spp_geot 
    1603          WRITE(numout,*) '                                            STDEV          rn_geot_sd   :', rn_geot_sd    
     1622         WRITE(numout,*) '                                            STDEV          rn_geot_sd   :', rn_geot_sd 
    16041623         WRITE(numout,*) '       SPP for enhanced vertical diffusion                 nn_spp_aevd  :', nn_spp_aevd 
    1605          WRITE(numout,*) '                                            STDEV          rn_aevd_sd   :', rn_aevd_sd    
     1624         WRITE(numout,*) '                                            STDEV          rn_aevd_sd   :', rn_aevd_sd 
    16061625         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    
     1626         WRITE(numout,*) '                                            STDEV          rn_tkelc_sd  :', rn_tkelc_sd 
    16081627         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    
     1628         WRITE(numout,*) '                                            STDEV          rn_tkedf_sd  :', rn_tkedf_sd 
    16101629         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    
     1630         WRITE(numout,*) '                                            STDEV          rn_tkeds_sd  :', rn_tkeds_sd 
    16121631         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    
     1632         WRITE(numout,*) '                                            STDEV          rn_tkebb_sd  :', rn_tkebb_sd 
    16141633         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    
     1634         WRITE(numout,*) '                                            STDEV          rn_tkefr_sd  :', rn_tkefr_sd 
    16161635         WRITE(numout,*) '       SPP for BBL U  diffusivity                          nn_spp_ahubbl:', nn_spp_ahubbl 
    16171636         WRITE(numout,*) '                                            STDEV          rn_ahubbl_sd :', rn_ahubbl_sd 
    … …  
    16261645         WRITE(numout,*) 
    16271646         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     
     1647         WRITE(numout,*) '       SKEB switch                                         ln_skeb      :', ln_skeb 
     1648         WRITE(numout,*) '       SKEB ratio of backscattered energy                  rn_skeb      :', rn_skeb 
    16301649         WRITE(numout,*) '       Frequency update for dissipation mask               nn_dcom_freq :', nn_dcom_freq 
    16311650         WRITE(numout,*) '       Numerical dissipation factor (resolut. dependent)   rn_kh        :', rn_kh 
    16321651         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       
     1652         WRITE(numout,*) '       Standard deviation of random generator (AR1 field)  rn_skeb_stdev:', rn_skeb_stdev 
    16341653         WRITE(numout,*) '       Decorr. time scale                     (AR1 field)  rn_skeb_tau  :', rn_skeb_tau 
    16351654         WRITE(numout,*) '       Option of convection energy dissipation             nn_dconv     :', nn_dconv 
    … …  
    17521771 
    17531772      ! Find filter attenuation factor 
    1754     
     1773 
    17551774      flt_fac = sppt_fltfac( sppt_filter_pass ) 
    17561775      rdt_sppt = nn_rndm_freq * rn_rdt 
    1757     
     1776 
    17581777      IF( ln_sppt_taumap ) THEN 
    17591778         CALL iom_open ( 'sppt_tau_map', inum ) 
    … …  
    17981817      gauss_b = 0._wp 
    17991818      ! Weigths 
    1800       gauss_w(:)    = 1.0_wp  
     1819      gauss_w(:)    = 1.0_wp 
    18011820      IF( nn_vwei .eq. 1 ) THEN 
    18021821        gauss_w(1)    = 0.0_wp 
    … …  
    18611880      IF(lwp .and. ln_stopack_diags) & 
    18621881      CALL ctl_opn(numdiag, 'stopack.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    1863     
     1882 
    18641883   END SUBROUTINE stopack_init 
    18651884   ! 
    … …  
    18741893      INTEGER :: id1, jseed 
    18751894      CHARACTER(LEN=10)   ::   clseed='spsd0_0000' 
    1876       INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type  
    1877       INTEGER(KIND=8)     ::   ivals(8)  
     1895      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type 
     1896      INTEGER(KIND=8)     ::   ivals(8) 
    18781897      REAL(wp)            ::   zrseed4(4)           ! RNG seeds in integer type 
    18791898      REAL(wp)            ::   zrseed2d(jpi,jpj) 
    … …  
    19832002      !!--------------------------------------------------------------------- 
    19842003      ! 
    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) , &  
     2004      ALLOCATE( spptt(jpi,jpj,jpk) , sppts(jpi,jpj,jpk) , gauss_n(jpi,jpj,jpk) ,& 
     2005      gauss_nu(jpi,jpj,jpk) , gauss_nv(jpi,jpj,jpk) , & 
    19872006      spptu(jpi,jpj,jpk) , spptv(jpi,jpj,jpk) , gauss_n_2d(jpi,jpj) ,& 
    19882007      gauss_b (jpi,jpj), sppt_tau(jpi,jpj), sppt_a(jpi,jpj), sppt_b(jpi,jpj), gauss_w(jpk),& 
    … …  
    22082227      IF ( ln_dpsiv ) THEN 
    22092228       DO jp=1,jpni-1 
    2210          IF( jpri == jp ) THEN ! SEND TO EAST  
     2229         IF( jpri == jp ) THEN ! SEND TO EAST 
    22112230          zwrk(1:jpj) = dpsiv(jpi-1,:) 
    22122231          tag=2000+narea 
    … …  
    22682287   REAL :: ds,dt,dtot,kh2 
    22692288   INTEGER :: ji,jj,jk 
    2270     
     2289 
    22712290   IF ( mt .eq. nit000 ) THEN 
    22722291        ALLOCATE ( dnum(jpi,jpj,jpk) ) 
    … …  
    22872306          dt = (vn(ji,jj,jk)-vn(ji-1,jj,jk))*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e2v(ji,jj) + & 
    22882307               (un(ji,jj,jk)-un(ji,jj-1,jk))*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e1u(ji,jj) 
    2289    
     2308 
    22902309          dtot = sqrt( ds*ds + dt*dt ) * tmask(ji,jj,jk) 
    22912310          dnum(ji,jj,jk) = dtot*dtot*dtot*kh2*e1t(ji,jj)*e2t(ji,jj) 
    … …  
    22932312      ENDDO 
    22942313     ENDDO 
    2295     
     2314 
    22962315     CALL lbc_lnk(dnum,'T',1._wp) 
    22972316 
    22982317   ENDIF 
    22992318 
    2300    END SUBROUTINE  
     2319   END SUBROUTINE 
    23012320 
    23022321   SUBROUTINE skeb_dcon ( mt ) 
    … …  
    23292348 
    23302349           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) )  
     2350              & / ( rau0 * fse3w(ji,jj,jk) ) 
    23322351 
    23332352           dcon(ji,jj,jk) = kc2*zz*e1t(ji,jj)*e2t(ji,jj)*rau0 / fse3w(ji,jj,jk) 
    … …  
    23782397     IF(ln_skeb_own_gauss) THEN 
    23792398       DO jk=1,jpkm1 
    2380          psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk) ) * gauss_n_2d_k(:,:)  
     2399         psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk) ) * gauss_n_2d_k(:,:) 
    23812400       ENDDO 
    23822401     ELSE 
    … …  
    24072426     IF(ln_skeb_own_gauss) THEN 
    24082427       DO jk=1,jpkm1 
    2409          psi(:,:,jk) = rn_skeb * sqrt( rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:)  
     2428         psi(:,:,jk) = rn_skeb * sqrt( rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:) 
    24102429       ENDDO 
    24112430     ELSE 
    … …  
    24402459   IF(ln_skeb_own_gauss) THEN 
    24412460     DO jk=1,jpkm1 
    2442        psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk)+ rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:)  
     2461       psi(:,:,jk) = rn_skeb * sqrt( rn_beta_num * dnum(:,:,jk)+ rn_beta_con * dcon(:,:,jk) ) * gauss_n_2d_k(:,:) 
    24432462     ENDDO 
    24442463   ELSE 
Note: See TracChangeset for help on using the changeset viewer.