- Timestamp:
- 2020-06-10T13:13:39+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_1d_bugfixes/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90
r12102 r13088 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, … … 624 624 !!---------------------------------------------------------------------- 625 625 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 626 630 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 627 639 INTEGER, INTENT( in ) :: nn_type 628 640 REAL(wp), INTENT( in ) :: rn_sd … … 634 646 INTEGER :: jklev 635 647 648 #if defined key_traldf_c2d || key_traldf_c3d 636 649 CALL wrk_alloc(jpi,jpj,gauss) 637 650 … … 658 671 gauss = gauss * rn_sd 659 672 coeff = coeff * ( 1._wp + gauss ) 673 #ifdef key_traldf_c3d || key_traldf_c2d || key_traldf_c1d 660 674 WHERE( coeff > 1._wp ) coeff = 1._wp 661 675 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 662 680 ELSEIF ( nn_type == 5 ) THEN 663 681 zsd = rn_sd … … 665 683 gauss = gauss * zsd + xme 666 684 coeff = exp(gauss) * coeff 685 #ifdef key_traldf_c3d || key_traldf_c2d || key_traldf_c1d 667 686 WHERE( coeff > 1._wp ) coeff = 1._wp 668 687 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 669 692 ELSEIF ( nn_type == 6 ) THEN 670 693 zsd = rn_sd … … 672 695 gauss = gauss * zsd + xme 673 696 coeff = exp(gauss) * coeff 697 #ifdef key_traldf_c3d || key_traldf_c2d || key_traldf_c1d 674 698 WHERE( coeff > 1._wp ) coeff = 1._wp 675 699 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 676 704 ELSE 677 705 CALL ctl_stop( 'spp dqdt wrong option') … … 687 715 jklev = klev 688 716 ELSE 689 jklev = 0 717 jklev = 0 690 718 ENDIF 691 719 CALL spp_stats(kt,kspp,jklev,coeff) … … 694 722 CALL wrk_dealloc(jpi,jpj,gauss) 695 723 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 696 730 END SUBROUTINE 697 731 … … 704 738 IMPLICIT NONE 705 739 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 707 749 REAL(wp) :: mi,ma 708 750 CHARACTER(LEN=16) :: cstr = ' ' 709 SELECT CASE ( kp ) 710 CASE( jk_spp_alb ) 751 SELECT CASE ( kp ) 752 CASE( jk_spp_alb ) 711 753 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 ) 731 773 cstr = 'VERT. DIFFUS' 732 CASE( jk_spp_avm ) 774 CASE( jk_spp_avm ) 733 775 cstr = 'VERT. VISCOS' 734 CASE( jk_spp_tkelc ) 776 CASE( jk_spp_tkelc ) 735 777 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 ) 741 783 cstr = 'TKE RN_EBB ' 742 CASE( jk_spp_tkefr ) 784 CASE( jk_spp_tkefr ) 743 785 cstr = 'TKE RN_EFR ' 744 CASE( jk_spp_ahtu ) 786 CASE( jk_spp_ahtu ) 745 787 cstr = 'TRALDF AHTU ' 746 CASE( jk_spp_ahtv ) 788 CASE( jk_spp_ahtv ) 747 789 cstr = 'TRALDF AHTV ' 748 CASE( jk_spp_ahtw ) 790 CASE( jk_spp_ahtw ) 749 791 cstr = 'TRALDF AHTW ' 750 CASE( jk_spp_ahtt ) 792 CASE( jk_spp_ahtt ) 751 793 cstr = 'TRALDF AHTT ' 752 794 CASE( jk_spp_ahubbl ) … … 765 807 CALL ctl_stop('Unrecognized SPP parameter: add it or turn off diagnostics') 766 808 END SELECT 809 #ifdef key_traldf_c3d || key_traldf_c2d || key_traldf_c1d 767 810 mi = MINVAL(rcf) 768 811 ma = MAXVAL(rcf) 812 #else 813 mi = rcf 814 ma = rcf 815 #endif 769 816 IF(lk_mpp) CALL mpp_min(mi) 770 817 IF(lk_mpp) CALL mpp_max(ma) … … 795 842 796 843 DO jp=1,jk_spp 797 SELECT CASE ( jp ) 798 CASE( jk_spp_alb ) 844 SELECT CASE ( jp ) 845 CASE( jk_spp_alb ) 799 846 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 ) 819 866 cstr = 'VERT. DIFFUS' 820 CASE( jk_spp_avm ) 867 CASE( jk_spp_avm ) 821 868 cstr = 'VERT. VISCOS' 822 CASE( jk_spp_tkelc ) 869 CASE( jk_spp_tkelc ) 823 870 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 ) 829 876 cstr = 'TKE RN_EBB ' 830 CASE( jk_spp_tkefr ) 877 CASE( jk_spp_tkefr ) 831 878 cstr = 'TKE RN_EFR ' 832 CASE( jk_spp_ahtu ) 879 CASE( jk_spp_ahtu ) 833 880 cstr = 'TRALDF AHTU ' 834 CASE( jk_spp_ahtv ) 881 CASE( jk_spp_ahtv ) 835 882 cstr = 'TRALDF AHTV ' 836 CASE( jk_spp_ahtw ) 883 CASE( jk_spp_ahtw ) 837 884 cstr = 'TRALDF AHTW ' 838 CASE( jk_spp_ahtt ) 885 CASE( jk_spp_ahtt ) 839 886 cstr = 'TRALDF AHTT ' 840 887 CASE( jk_spp_ahubbl ) … … 1195 1242 ! Note: sshn should be staggered before being used. 1196 1243 SELECT CASE ( cd_type ) 1197 CASE ( 'T' ) 1244 CASE ( 'T' ) 1198 1245 jk=1 1199 1246 zv = SUM( tmask_i(:,:)*tmask(:,:,jk)*e1t(:,:)*e2t(:,:)*sshn(:,:)*zts(:,:,1) ) … … 1285 1332 ! Random noise on 2d field 1286 1333 IF ( istep == 1 ) THEN 1287 CALL sppt_rand2d( g2d ) 1334 CALL sppt_rand2d( g2d ) 1288 1335 CALL lbc_lnk( g2d , 'T', 1._wp) 1289 1336 g2d_save = g2d … … 1297 1344 g2d = rn_skeb_stdev * g2d_save / rn_sppt_stdev 1298 1345 ENDIF 1299 1346 1300 1347 ! Laplacian filter and re-normalization 1301 1348 DO jf = 1, nk … … 1314 1361 ENDIF 1315 1362 #endif 1316 1363 1317 1364 ! AR(1) process and array swap 1318 1365 g2d = a*gb + b*g2d … … 1360 1407 ENDDO 1361 1408 ENDIF 1362 1409 1363 1410 ! Bound 1364 1411 IF( nn_sppt_step_bound .EQ. 2 ) THEN … … 1482 1529 1483 1530 #ifdef NEMO_V34 1484 REWIND( numnam ) 1531 REWIND( numnam ) 1485 1532 READ ( numnam, namstopack ) 1486 1533 #else 1487 REWIND( numnam_ref ) 1534 REWIND( numnam_ref ) 1488 1535 READ ( numnam_ref, namstopack, IOSTAT = ios, ERR = 901) 1489 1536 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in reference namelist', lwp ) 1490 1537 1491 REWIND( numnam_cfg ) 1538 REWIND( numnam_cfg ) 1492 1539 READ ( numnam_cfg, namstopack, IOSTAT = ios, ERR = 902 ) 1493 1540 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namstopack in configuration namelist', lwp ) … … 1568 1615 WRITE(numout,*) 1569 1616 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 1571 1618 WRITE(numout,*) ' Decorr. time scale (AR1 field) rn_spp_tau :', rn_spp_tau 1572 1619 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 1583 1630 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 1585 1632 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 1587 1634 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 1589 1636 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 1591 1638 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 1593 1640 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 1595 1642 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 1597 1644 WRITE(numout,*) ' SPP for relative wind factor nn_spp_relw :', nn_spp_relw 1598 1645 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 1600 1647 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 1602 1649 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 1604 1651 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 1606 1653 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 1608 1655 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 1610 1657 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 1612 1659 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 1614 1661 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 1616 1663 WRITE(numout,*) ' SPP for BBL U diffusivity nn_spp_ahubbl:', nn_spp_ahubbl 1617 1664 WRITE(numout,*) ' STDEV rn_ahubbl_sd :', rn_ahubbl_sd … … 1626 1673 WRITE(numout,*) 1627 1674 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 1630 1677 WRITE(numout,*) ' Frequency update for dissipation mask nn_dcom_freq :', nn_dcom_freq 1631 1678 WRITE(numout,*) ' Numerical dissipation factor (resolut. dependent) rn_kh :', rn_kh 1632 1679 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 1634 1681 WRITE(numout,*) ' Decorr. time scale (AR1 field) rn_skeb_tau :', rn_skeb_tau 1635 1682 WRITE(numout,*) ' Option of convection energy dissipation nn_dconv :', nn_dconv … … 1752 1799 1753 1800 ! Find filter attenuation factor 1754 1801 1755 1802 flt_fac = sppt_fltfac( sppt_filter_pass ) 1756 1803 rdt_sppt = nn_rndm_freq * rn_rdt 1757 1804 1758 1805 IF( ln_sppt_taumap ) THEN 1759 1806 CALL iom_open ( 'sppt_tau_map', inum ) … … 1798 1845 gauss_b = 0._wp 1799 1846 ! Weigths 1800 gauss_w(:) = 1.0_wp 1847 gauss_w(:) = 1.0_wp 1801 1848 IF( nn_vwei .eq. 1 ) THEN 1802 1849 gauss_w(1) = 0.0_wp … … 1861 1908 IF(lwp .and. ln_stopack_diags) & 1862 1909 CALL ctl_opn(numdiag, 'stopack.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 1863 1910 1864 1911 END SUBROUTINE stopack_init 1865 1912 ! … … 1874 1921 INTEGER :: id1, jseed 1875 1922 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) 1878 1925 REAL(wp) :: zrseed4(4) ! RNG seeds in integer type 1879 1926 REAL(wp) :: zrseed2d(jpi,jpj) … … 1983 2030 !!--------------------------------------------------------------------- 1984 2031 ! 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) , & 1987 2034 spptu(jpi,jpj,jpk) , spptv(jpi,jpj,jpk) , gauss_n_2d(jpi,jpj) ,& 1988 2035 gauss_b (jpi,jpj), sppt_tau(jpi,jpj), sppt_a(jpi,jpj), sppt_b(jpi,jpj), gauss_w(jpk),& … … 2208 2255 IF ( ln_dpsiv ) THEN 2209 2256 DO jp=1,jpni-1 2210 IF( jpri == jp ) THEN ! SEND TO EAST 2257 IF( jpri == jp ) THEN ! SEND TO EAST 2211 2258 zwrk(1:jpj) = dpsiv(jpi-1,:) 2212 2259 tag=2000+narea … … 2268 2315 REAL :: ds,dt,dtot,kh2 2269 2316 INTEGER :: ji,jj,jk 2270 2317 2271 2318 IF ( mt .eq. nit000 ) THEN 2272 2319 ALLOCATE ( dnum(jpi,jpj,jpk) ) … … 2287 2334 dt = (vn(ji,jj,jk)-vn(ji-1,jj,jk))*vmask(ji,jj,jk)*vmask(ji-1,jj,jk)/ e2v(ji,jj) + & 2288 2335 (un(ji,jj,jk)-un(ji,jj-1,jk))*umask(ji,jj,jk)*umask(ji,jj-1,jk)/ e1u(ji,jj) 2289 2336 2290 2337 dtot = sqrt( ds*ds + dt*dt ) * tmask(ji,jj,jk) 2291 2338 dnum(ji,jj,jk) = dtot*dtot*dtot*kh2*e1t(ji,jj)*e2t(ji,jj) … … 2293 2340 ENDDO 2294 2341 ENDDO 2295 2342 2296 2343 CALL lbc_lnk(dnum,'T',1._wp) 2297 2344 2298 2345 ENDIF 2299 2346 2300 END SUBROUTINE 2347 END SUBROUTINE 2301 2348 2302 2349 SUBROUTINE skeb_dcon ( mt ) … … 2329 2376 2330 2377 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) ) 2332 2379 2333 2380 dcon(ji,jj,jk) = kc2*zz*e1t(ji,jj)*e2t(ji,jj)*rau0 / fse3w(ji,jj,jk) … … 2378 2425 IF(ln_skeb_own_gauss) THEN 2379 2426 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(:,:) 2381 2428 ENDDO 2382 2429 ELSE … … 2407 2454 IF(ln_skeb_own_gauss) THEN 2408 2455 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(:,:) 2410 2457 ENDDO 2411 2458 ELSE … … 2440 2487 IF(ln_skeb_own_gauss) THEN 2441 2488 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(:,:) 2443 2490 ENDDO 2444 2491 ELSE
Note: See TracChangeset
for help on using the changeset viewer.
