- Timestamp:
- 2020-07-30T12:12:41+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90
r12102 r13355 46 46 #define numnam_ref numnam 47 47 #define numnam_cfg numnam 48 #define lwm lwp 48 #define lwm lwp 49 49 #define numond numout 50 50 51 #define wmask tmask 51 #define wmask tmask 52 52 53 53 #endif … … 63 63 !! (SPP, SKEB and sea-ice) 64 64 !!---------------------------------------------------------------------- 65 !! 65 !! 66 66 !! stopack : Generate stochastic physics perturbations 67 !! 67 !! 68 68 !! Method 69 69 !! ====== … … 71 71 !! - SPPT (Stochastically perturbed parameterization 72 72 !! tendencies )scheme for user-selected trends for 73 !! tracers, momentum and sea-ice 73 !! tracers, momentum and sea-ice 74 74 !! - SPP (Schastically perturbed parameters) scheme 75 75 !! for some (namelist) parameters … … 77 77 !! backscatter energy dissipated numerically or 78 78 !! through deep convection. 79 !! 80 !! 79 !! 80 !! 81 81 !! Acknowledgements: C3S funded ERGO project 82 !! 82 !! 83 83 !!---------------------------------------------------------------------- 84 84 USE par_kind 85 85 USE timing ! Timing 86 86 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 88 88 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 89 89 USE in_out_manager ! I/O manager … … 104 104 USE wrk_nemo 105 105 USE diaptr 106 USE zdf_oce 106 USE zdf_oce 107 107 USE phycst 108 108 … … 113 113 PUBLIC tra_sppt_collect 114 114 PUBLIC dyn_sppt_collect 115 PUBLIC tra_sppt_apply 116 PUBLIC dyn_sppt_apply 115 PUBLIC tra_sppt_apply 116 PUBLIC dyn_sppt_apply 117 117 PUBLIC stopack_rst 118 118 PUBLIC stopack_init … … 140 140 REAL(wp), SAVE :: rn_spp_tau, rn_spp_stdev 141 141 INTEGER :: skeb_filter_pass, spp_filter_pass 142 142 143 143 ! SPPT Logical switches for individual tendencies 144 144 LOGICAL :: ln_sppt_taumap, ln_stopack_restart, ln_distcoast, & 145 145 ln_sppt_traxad, ln_sppt_trayad, ln_sppt_trazad, ln_sppt_trasad, ln_sppt_traldf, & 146 146 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 148 148 LOGICAL :: & 149 149 ln_sppt_dynhpg, ln_sppt_dynspg, ln_sppt_dynkeg, ln_sppt_dynrvo, ln_sppt_dynpvo, ln_sppt_dynzad,& … … 181 181 INTEGER, PARAMETER, PUBLIC :: jk_spp_qsi0 = 8 182 182 INTEGER, PARAMETER, PUBLIC :: jk_spp_bfr = 9 183 INTEGER, PARAMETER, PUBLIC :: jk_spp_aevd = 10 183 INTEGER, PARAMETER, PUBLIC :: jk_spp_aevd = 10 184 184 INTEGER, PARAMETER, PUBLIC :: jk_spp_avt = 11 185 185 INTEGER, PARAMETER, PUBLIC :: jk_spp_avm = 12 … … 219 219 INTEGER, SAVE :: numrep = 602 220 220 INTEGER, SAVE :: lkt 221 221 222 222 ! Randome generator seed 223 223 INTEGER, SAVE :: nn_stopack_seed(4) … … 275 275 !!---------------------------------------------------------------------- 276 276 !! 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 $ 278 278 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 279 279 !!---------------------------------------------------------------------- … … 289 289 !! 290 290 !! ** Purpose : Collect tracer tendencies (additive) 291 !! This function is called by the tendency diagnostics 291 !! This function is called by the tendency diagnostics 292 292 !! module 293 293 !!---------------------------------------------------------------------- 294 294 INTEGER , INTENT(in ) :: kt ! time step 295 295 #endif 296 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptrdx ! Temperature 296 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptrdx ! Temperature 297 297 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptrdy ! Salinity 298 298 INTEGER , INTENT(in ) :: ktrd ! tracer trend index … … 354 354 !! 355 355 !! ** Purpose : Collect momentum tendencies (additive) 356 !! This function is called by the tendency diagnostics 356 !! This function is called by the tendency diagnostics 357 357 !! module 358 358 !!---------------------------------------------------------------------- 359 359 INTEGER , INTENT(in ) :: kt ! time step 360 360 #endif 361 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptrdx ! Temperature 361 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptrdx ! Temperature 362 362 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptrdy ! Salinity 363 363 INTEGER , INTENT(in ) :: ktrd ! tracer trend index … … 469 469 !! 470 470 !! ** Purpose : Apply collinear perturbation to ice fields 471 !! For specific processes coded in LIM2/LIM3 471 !! For specific processes coded in LIM2/LIM3 472 472 !!---------------------------------------------------------------------- 473 473 ! … … 529 529 zicewrk(:,:,jm) = z5 ; jm=jm+1 530 530 zicewrk(:,:,jm) = z6 ; jm=jm+1 531 zicewrk(:,:,jm) = z7 531 zicewrk(:,:,jm) = z7 532 532 ENDIF 533 533 IF( kopt .EQ. 3 ) THEN … … 601 601 CALL lbc_lnk( u_ice, 'U', -1. ) 602 602 CALL lbc_lnk( v_ice, 'V', -1. ) 603 #endif 603 #endif 604 604 #if defined key_lim2 && defined key_lim2_vp 605 605 CALL lbc_lnk( u_ice(:,1:jpj), 'I', -1. ) 606 606 CALL lbc_lnk( v_ice(:,1:jpj), 'I', -1. ) 607 #endif 607 #endif 608 608 ENDIF 609 609 DEALLOCATE ( zicewrk ) … … 616 616 !! *** ROUTINE spp_gen *** 617 617 !! 618 !! ** Purpose : Perturbing parameters (generic function) 618 !! ** Purpose : Perturbing parameters (generic function) 619 619 !! Given a value of standard deviation, the 2D parameter 620 620 !! coeff is perturbed following an additive Normal, … … 633 633 CHARACTER (LEN=99) :: cstrng 634 634 INTEGER :: jklev 635 636 #if defined key_traldf_c3d || key_traldf_c2d 635 637 636 638 CALL wrk_alloc(jpi,jpj,gauss) … … 687 689 jklev = klev 688 690 ELSE 689 jklev = 0 691 jklev = 0 690 692 ENDIF 691 693 CALL spp_stats(kt,kspp,jklev,coeff) … … 693 695 694 696 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 695 701 696 702 END SUBROUTINE … … 707 713 REAL(wp) :: mi,ma 708 714 CHARACTER(LEN=16) :: cstr = ' ' 709 SELECT CASE ( kp ) 710 CASE( jk_spp_alb ) 715 SELECT CASE ( kp ) 716 CASE( jk_spp_alb ) 711 717 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 ) 731 737 cstr = 'VERT. DIFFUS' 732 CASE( jk_spp_avm ) 738 CASE( jk_spp_avm ) 733 739 cstr = 'VERT. VISCOS' 734 CASE( jk_spp_tkelc ) 740 CASE( jk_spp_tkelc ) 735 741 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 ) 741 747 cstr = 'TKE RN_EBB ' 742 CASE( jk_spp_tkefr ) 748 CASE( jk_spp_tkefr ) 743 749 cstr = 'TKE RN_EFR ' 744 CASE( jk_spp_ahtu ) 750 CASE( jk_spp_ahtu ) 745 751 cstr = 'TRALDF AHTU ' 746 CASE( jk_spp_ahtv ) 752 CASE( jk_spp_ahtv ) 747 753 cstr = 'TRALDF AHTV ' 748 CASE( jk_spp_ahtw ) 754 CASE( jk_spp_ahtw ) 749 755 cstr = 'TRALDF AHTW ' 750 CASE( jk_spp_ahtt ) 756 CASE( jk_spp_ahtt ) 751 757 cstr = 'TRALDF AHTT ' 752 758 CASE( jk_spp_ahubbl ) … … 795 801 796 802 DO jp=1,jk_spp 797 SELECT CASE ( jp ) 798 CASE( jk_spp_alb ) 803 SELECT CASE ( jp ) 804 CASE( jk_spp_alb ) 799 805 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 ) 819 825 cstr = 'VERT. DIFFUS' 820 CASE( jk_spp_avm ) 826 CASE( jk_spp_avm ) 821 827 cstr = 'VERT. VISCOS' 822 CASE( jk_spp_tkelc ) 828 CASE( jk_spp_tkelc ) 823 829 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 ) 829 835 cstr = 'TKE RN_EBB ' 830 CASE( jk_spp_tkefr ) 836 CASE( jk_spp_tkefr ) 831 837 cstr = 'TKE RN_EFR ' 832 CASE( jk_spp_ahtu ) 838 CASE( jk_spp_ahtu ) 833 839 cstr = 'TRALDF AHTU ' 834 CASE( jk_spp_ahtv ) 840 CASE( jk_spp_ahtv ) 835 841 cstr = 'TRALDF AHTV ' 836 CASE( jk_spp_ahtw ) 842 CASE( jk_spp_ahtw ) 837 843 cstr = 'TRALDF AHTW ' 838 CASE( jk_spp_ahtt ) 844 CASE( jk_spp_ahtt ) 839 845 cstr = 'TRALDF AHTT ' 840 846 CASE( jk_spp_ahubbl ) … … 922 928 INTEGER :: jk 923 929 930 #if defined key_traldf_c3d || key_traldf_c2d 931 924 932 CALL wrk_alloc(jpi,jpj,gauss) 925 933 … … 969 977 ENDIF 970 978 979 #else 980 CALL ctl_stop('key_traldf_c1d is not a valid key for STO') 981 982 #endif 983 971 984 CALL wrk_dealloc(jpi,jpj,gauss) 972 985 … … 997 1010 REAL(wp) :: zsd,xme 998 1011 INTEGER :: jk 1012 1013 #if defined key_dynldf_c3d || key_dynldf_c2d 999 1014 1000 1015 CALL wrk_alloc(jpi,jpj,gauss) … … 1046 1061 1047 1062 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 1048 1067 1049 1068 END SUBROUTINE … … 1195 1214 ! Note: sshn should be staggered before being used. 1196 1215 SELECT CASE ( cd_type ) 1197 CASE ( 'T' ) 1216 CASE ( 'T' ) 1198 1217 jk=1 1199 1218 zv = SUM( tmask_i(:,:)*tmask(:,:,jk)*e1t(:,:)*e2t(:,:)*sshn(:,:)*zts(:,:,1) ) … … 1285 1304 ! Random noise on 2d field 1286 1305 IF ( istep == 1 ) THEN 1287 CALL sppt_rand2d( g2d ) 1306 CALL sppt_rand2d( g2d ) 1288 1307 CALL lbc_lnk( g2d , 'T', 1._wp) 1289 1308 g2d_save = g2d … … 1297 1316 g2d = rn_skeb_stdev * g2d_save / rn_sppt_stdev 1298 1317 ENDIF 1299 1318 1300 1319 ! Laplacian filter and re-normalization 1301 1320 DO jf = 1, nk … … 1314 1333 ENDIF 1315 1334 #endif 1316 1335 1317 1336 ! AR(1) process and array swap 1318 1337 g2d = a*gb + b*g2d … … 1360 1379 ENDDO 1361 1380 ENDIF 1362 1381 1363 1382 ! Bound 1364 1383 IF( nn_sppt_step_bound .EQ. 2 ) THEN … … 1482 1501 1483 1502 #ifdef NEMO_V34 1484 REWIND( numnam ) 1503 REWIND( numnam ) 1485 1504 READ ( numnam, namstopack ) 1486 1505 #else 1487 REWIND( numnam_ref ) 1506 REWIND( numnam_ref ) 1488 1507 READ ( numnam_ref, namstopack, IOSTAT = ios, ERR = 901) 1489 1508 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in reference namelist', lwp ) 1490 1509 1491 REWIND( numnam_cfg ) 1510 REWIND( numnam_cfg ) 1492 1511 READ ( numnam_cfg, namstopack, IOSTAT = ios, ERR = 902 ) 1493 1512 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in configuration namelist', lwp ) … … 1568 1587 WRITE(numout,*) 1569 1588 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 1571 1590 WRITE(numout,*) ' Decorr. time scale (AR1 field) rn_spp_tau :', rn_spp_tau 1572 1591 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 1583 1602 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 1585 1604 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 1587 1606 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 1589 1608 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 1591 1610 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 1593 1612 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 1595 1614 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 1597 1616 WRITE(numout,*) ' SPP for relative wind factor nn_spp_relw :', nn_spp_relw 1598 1617 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 1600 1619 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 1602 1621 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 1604 1623 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 1606 1625 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 1608 1627 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 1610 1629 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 1612 1631 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 1614 1633 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 1616 1635 WRITE(numout,*) ' SPP for BBL U diffusivity nn_spp_ahubbl:', nn_spp_ahubbl 1617 1636 WRITE(numout,*) ' STDEV rn_ahubbl_sd :', rn_ahubbl_sd … … 1626 1645 WRITE(numout,*) 1627 1646 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 1630 1649 WRITE(numout,*) ' Frequency update for dissipation mask nn_dcom_freq :', nn_dcom_freq 1631 1650 WRITE(numout,*) ' Numerical dissipation factor (resolut. dependent) rn_kh :', rn_kh 1632 1651 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 1634 1653 WRITE(numout,*) ' Decorr. time scale (AR1 field) rn_skeb_tau :', rn_skeb_tau 1635 1654 WRITE(numout,*) ' Option of convection energy dissipation nn_dconv :', nn_dconv … … 1752 1771 1753 1772 ! Find filter attenuation factor 1754 1773 1755 1774 flt_fac = sppt_fltfac( sppt_filter_pass ) 1756 1775 rdt_sppt = nn_rndm_freq * rn_rdt 1757 1776 1758 1777 IF( ln_sppt_taumap ) THEN 1759 1778 CALL iom_open ( 'sppt_tau_map', inum ) … … 1798 1817 gauss_b = 0._wp 1799 1818 ! Weigths 1800 gauss_w(:) = 1.0_wp 1819 gauss_w(:) = 1.0_wp 1801 1820 IF( nn_vwei .eq. 1 ) THEN 1802 1821 gauss_w(1) = 0.0_wp … … 1861 1880 IF(lwp .and. ln_stopack_diags) & 1862 1881 CALL ctl_opn(numdiag, 'stopack.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 1863 1882 1864 1883 END SUBROUTINE stopack_init 1865 1884 ! … … 1874 1893 INTEGER :: id1, jseed 1875 1894 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) 1878 1897 REAL(wp) :: zrseed4(4) ! RNG seeds in integer type 1879 1898 REAL(wp) :: zrseed2d(jpi,jpj) … … 1983 2002 !!--------------------------------------------------------------------- 1984 2003 ! 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) , & 1987 2006 spptu(jpi,jpj,jpk) , spptv(jpi,jpj,jpk) , gauss_n_2d(jpi,jpj) ,& 1988 2007 gauss_b (jpi,jpj), sppt_tau(jpi,jpj), sppt_a(jpi,jpj), sppt_b(jpi,jpj), gauss_w(jpk),& … … 2208 2227 IF ( ln_dpsiv ) THEN 2209 2228 DO jp=1,jpni-1 2210 IF( jpri == jp ) THEN ! SEND TO EAST 2229 IF( jpri == jp ) THEN ! SEND TO EAST 2211 2230 zwrk(1:jpj) = dpsiv(jpi-1,:) 2212 2231 tag=2000+narea … … 2268 2287 REAL :: ds,dt,dtot,kh2 2269 2288 INTEGER :: ji,jj,jk 2270 2289 2271 2290 IF ( mt .eq. nit000 ) THEN 2272 2291 ALLOCATE ( dnum(jpi,jpj,jpk) ) … … 2287 2306 dt = (vn(ji,jj,jk)-vn(ji-1,jj,jk))*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e2v(ji,jj) + & 2288 2307 (un(ji,jj,jk)-un(ji,jj-1,jk))*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e1u(ji,jj) 2289 2308 2290 2309 dtot = sqrt( ds*ds + dt*dt ) * tmask(ji,jj,jk) 2291 2310 dnum(ji,jj,jk) = dtot*dtot*dtot*kh2*e1t(ji,jj)*e2t(ji,jj) … … 2293 2312 ENDDO 2294 2313 ENDDO 2295 2314 2296 2315 CALL lbc_lnk(dnum,'T',1._wp) 2297 2316 2298 2317 ENDIF 2299 2318 2300 END SUBROUTINE 2319 END SUBROUTINE 2301 2320 2302 2321 SUBROUTINE skeb_dcon ( mt ) … … 2329 2348 2330 2349 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) ) 2332 2351 2333 2352 dcon(ji,jj,jk) = kc2*zz*e1t(ji,jj)*e2t(ji,jj)*rau0 / fse3w(ji,jj,jk) … … 2378 2397 IF(ln_skeb_own_gauss) THEN 2379 2398 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(:,:) 2381 2400 ENDDO 2382 2401 ELSE … … 2407 2426 IF(ln_skeb_own_gauss) THEN 2408 2427 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(:,:) 2410 2429 ENDDO 2411 2430 ELSE … … 2440 2459 IF(ln_skeb_own_gauss) THEN 2441 2460 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(:,:) 2443 2462 ENDDO 2444 2463 ELSE
Note: See TracChangeset
for help on using the changeset viewer.