- Timestamp:
- 2014-04-06T17:28:25+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r4490 r4616 9 9 !! vvl option includes z_star and z_tilde coordinates 10 10 !!---------------------------------------------------------------------- 11 !! 'key_vvl' variable volume 12 !!---------------------------------------------------------------------- 11 13 12 !!---------------------------------------------------------------------- 14 13 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness … … 18 17 !! dom_vvl_rst : read/write restart file 19 18 !! dom_vvl_ctl : Check the vvl options 20 !! dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors21 !! : to account for manual changes to e[1,2][u,v] in some Straits22 19 !!---------------------------------------------------------------------- 23 !! * Modules used24 20 USE oce ! ocean dynamics and tracers 25 21 USE dom_oce ! ocean space and time domain … … 36 32 PRIVATE 37 33 38 !! * Routine accessibility39 34 PUBLIC dom_vvl_init ! called by domain.F90 40 35 PUBLIC dom_vvl_sf_nxt ! called by step.F90 41 36 PUBLIC dom_vvl_sf_swp ! called by step.F90 42 37 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 43 PRIVATE dom_vvl_orca_fix ! called by dom_vvl_interpol 44 45 !!* Namelist nam_vvl 46 LOGICAL , PUBLIC :: ln_vvl_zstar ! zstar vertical coordinate 47 LOGICAL , PUBLIC :: ln_vvl_ztilde ! ztilde vertical coordinate 48 LOGICAL , PUBLIC :: ln_vvl_layer ! level vertical coordinate 49 LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar ! ztilde vertical coordinate 50 LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor ! ztilde vertical coordinate 51 LOGICAL , PUBLIC :: ln_vvl_kepe ! kinetic/potential energy transfer 52 ! ! conservation: not used yet 53 REAL(wp) :: rn_ahe3 ! thickness diffusion coefficient 54 REAL(wp) :: rn_rst_e3t ! ztilde to zstar restoration timescale [days] 55 REAL(wp) :: rn_lf_cutoff ! cutoff frequency for low-pass filter [days] 56 REAL(wp) :: rn_zdef_max ! maximum fractional e3t deformation 57 LOGICAL , PUBLIC :: ln_vvl_dbg ! debug control prints 58 59 !! * Module variables 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport 61 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf ! low frequency part of hz divergence 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a ! baroclinic scale factors 64 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t ! retoring period for scale factors 65 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 38 39 ! !!* Namelist nam_vvl * 40 LOGICAL , PUBLIC :: ln_vvl_zstar ! zstar vertical coordinate 41 LOGICAL , PUBLIC :: ln_vvl_ztilde ! ztilde vertical coordinate 42 LOGICAL , PUBLIC :: ln_vvl_layer ! level vertical coordinate 43 LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar ! ztilde vertical coordinate 44 LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor ! ztilde vertical coordinate 45 LOGICAL , PUBLIC :: ln_vvl_kepe ! kinetic/potential energy transfer conservation: not used yet 46 REAL(wp) :: rn_ahe3 ! thickness diffusion coefficient 47 REAL(wp) :: rn_rst_e3t ! ztilde to zstar restoration timescale [days] 48 REAL(wp) :: rn_lf_cutoff ! cutoff frequency for low-pass filter [days] 49 REAL(wp) :: rn_zdef_max ! maximum fractional e3t deformation 50 LOGICAL , PUBLIC :: ln_vvl_dbg ! debug control prints 51 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport 53 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf ! low frequency part of hz divergence 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a ! baroclinic scale factors 56 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t ! retoring period for scale factors 57 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 66 58 67 59 !! * Substitutions … … 73 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 74 66 !!---------------------------------------------------------------------- 75 76 67 CONTAINS 77 68 … … 80 71 !! *** FUNCTION dom_vvl_alloc *** 81 72 !!---------------------------------------------------------------------- 82 IF( ln_vvl_zstar ) dom_vvl_alloc = 073 IF( ln_vvl_zstar ) dom_vvl_alloc = 0 83 74 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 84 75 ALLOCATE( tilde_e3t_b(jpi,jpj,jpk) , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) , & … … 95 86 IF( dom_vvl_alloc /= 0 ) CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 96 87 ENDIF 97 88 ! 98 89 END FUNCTION dom_vvl_alloc 99 90 … … 358 349 DO jj = 1, jpjm1 359 350 DO ji = 1, fs_jpim1 ! vector opt. 360 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj)&361 &* ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) )362 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj)&363 &* ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) )351 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 352 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 353 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 354 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 364 355 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 365 356 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) … … 380 371 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 381 372 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 382 & ) * r1_e1 2t(ji,jj)373 & ) * r1_e1e2t(ji,jj) 383 374 END DO 384 375 END DO … … 671 662 !! - vertical interpolation: simple averaging 672 663 !!---------------------------------------------------------------------- 673 !! * Arguments674 664 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pe3_in ! input e3 to be interpolated 675 665 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: pe3_out ! output interpolated e3 676 666 CHARACTER(LEN=*), INTENT( in ) :: pout ! grid point of out scale factors 677 667 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW' 678 ! ! * Local declarations668 ! 679 669 INTEGER :: ji, jj, jk ! dummy loop indices 680 670 LOGICAL :: l_is_orca ! local logical … … 685 675 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) l_is_orca = .TRUE. ! ORCA R2 configuration - will need to correct some locations 686 676 687 SELECT CASE ( pout ) 688 ! ! ------------------------------------- ! 689 CASE( 'U' ) ! interpolation from T-point to U-point ! 690 ! ! ------------------------------------- ! 691 ! horizontal surface weighted interpolation 692 DO jk = 1, jpk 677 SELECT CASE ( pout ) 678 ! ! ------------------------------------- ! 679 CASE( 'U' ) ! interpolation from T-point to U-point ! 680 ! ! ------------------------------------- ! 681 DO jk = 1, jpk ! horizontal surface weighted interpolation 693 682 DO jj = 1, jpjm1 694 683 DO ji = 1, fs_jpim1 ! vector opt. 695 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1 2u(ji,jj) &696 & * ( e1 2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &697 & + e1 2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )684 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1e2u(ji,jj) & 685 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 686 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 698 687 END DO 699 688 END DO 700 689 END DO 701 ! 702 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 703 ! boundary conditions 704 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. ) 690 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. ) ! boundary conditions 705 691 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 706 ! ! ------------------------------------- !707 CASE( 'V' ) ! interpolation from T-point to V-point!708 ! ! -------------------------------------!709 ! horizontal surface weighted interpolation710 DO jk = 1, jpk 692 ! 693 ! ! ------------------------------------- ! 694 CASE( 'V' ) ! interpolation from T-point to V-point ! 695 ! ! ------------------------------------- ! 696 DO jk = 1, jpk ! horizontal surface weighted interpolation 711 697 DO jj = 1, jpjm1 712 698 DO ji = 1, fs_jpim1 ! vector opt. 713 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1 2v(ji,jj) &714 & * ( e1 2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &715 & + e1 2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )699 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1e2v(ji,jj) & 700 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 701 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 716 702 END DO 717 703 END DO 718 704 END DO 719 ! 720 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 721 ! boundary conditions 722 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. ) 705 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. ) ! boundary conditions 723 706 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 724 ! ! ------------------------------------- !725 CASE( 'F' ) ! interpolation from U-point to F-point!726 ! ! -------------------------------------!727 ! horizontal surface weighted interpolation728 DO jk = 1, jpk 707 ! 708 ! ! ------------------------------------- ! 709 CASE( 'F' ) ! interpolation from U-point to F-point ! 710 ! ! ------------------------------------- ! 711 DO jk = 1, jpk ! horizontal surface weighted interpolation 729 712 DO jj = 1, jpjm1 730 713 DO ji = 1, fs_jpim1 ! vector opt. 731 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1 2f(ji,jj) &732 & * ( e1 2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) &733 & + e1 2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )714 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1e2f(ji,jj) & 715 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 716 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 734 717 END DO 735 718 END DO 736 719 END DO 737 !738 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )739 720 ! boundary conditions 740 721 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1. ) 741 722 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 742 ! ! ------------------------------------- ! 743 CASE( 'W' ) ! interpolation from T-point to W-point ! 744 ! ! ------------------------------------- ! 745 ! vertical simple interpolation 723 ! 724 ! ! ------------------------------------- ! 725 CASE( 'W' ) ! interpolation from T-point to W-point ! 726 ! ! ------------------------------------- ! 727 ! ! vertical simple interpolation 746 728 pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 747 ! - ML - The use of mask in this formaula enables the special treatment of the last w- 729 ! - ML - The use of mask in this formaula enables the special treatment of the last w-point without indirect adressing 748 730 DO jk = 2, jpk 749 731 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 750 732 & + 0.5_wp * tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 751 733 END DO 752 ! ! -------------------------------------- !753 CASE( 'UW' ) ! interpolation from U-point to UW-point !754 ! ! -------------------------------------- !755 ! vertical simple interpolation734 ! ! -------------------------------------- ! 735 CASE( 'UW' ) ! interpolation from U-point to UW-point ! 736 ! ! -------------------------------------- ! 737 ! ! vertical simple interpolation 756 738 pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 757 739 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing … … 760 742 & + 0.5_wp * umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 761 743 END DO 762 ! ! -------------------------------------- !763 CASE( 'VW' ) ! interpolation from V-point to VW-point !764 ! ! -------------------------------------- !765 ! vertical simple interpolation744 ! ! -------------------------------------- ! 745 CASE( 'VW' ) ! interpolation from V-point to VW-point ! 746 ! ! -------------------------------------- ! 747 ! ! vertical simple interpolation 766 748 pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 767 749 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing … … 770 752 & + 0.5_wp * vmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 771 753 END DO 754 ! 772 755 END SELECT 773 756 ! 774 775 757 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_interpol') 776 758 ! 777 759 END SUBROUTINE dom_vvl_interpol 760 778 761 779 762 SUBROUTINE dom_vvl_rst( kt, cdrw ) … … 982 965 END SUBROUTINE dom_vvl_ctl 983 966 984 SUBROUTINE dom_vvl_orca_fix( pe3_in, pe3_out, pout )985 !!---------------------------------------------------------------------986 !! *** ROUTINE dom_vvl_orca_fix ***987 !!988 !! ** Purpose : Correct surface weighted, horizontally interpolated,989 !! scale factors at locations that have been individually990 !! modified in domhgr. Such modifications break the991 !! relationship between e12t and e1u*e2u etc.992 !! Recompute some scale factors ignoring the modified metric.993 !!----------------------------------------------------------------------994 !! * Arguments995 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pe3_in ! input e3 to be interpolated996 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: pe3_out ! output interpolated e3997 CHARACTER(LEN=*), INTENT( in ) :: pout ! grid point of out scale factors998 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW'999 !! * Local declarations1000 INTEGER :: ji, jj, jk ! dummy loop indices1001 INTEGER :: ij0, ij1, ii0, ii1 ! dummy loop indices1002 !! acc1003 !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for1004 !! the ORCA2 tests (by changing jp_cfg test from 2 to 3) pending further investigations1005 !!1006 ! ! =====================1007 IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN ! ORCA R2 configuration1008 ! ! =====================1009 !! acc1010 IF( nn_cla == 0 ) THEN1011 !1012 ii0 = 139 ; ii1 = 140 ! Gibraltar Strait (e2u was modified)1013 ij0 = 102 ; ij1 = 1021014 DO jk = 1, jpkm11015 DO jj = mj0(ij0), mj1(ij1)1016 DO ji = mi0(ii0), mi1(ii1)1017 SELECT CASE ( pout )1018 CASE( 'U' )1019 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1020 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1021 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1022 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1023 CASE( 'F' )1024 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1025 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1026 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1027 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1028 END SELECT1029 END DO1030 END DO1031 END DO1032 !1033 ii0 = 160 ; ii1 = 160 ! Bab el Mandeb (e2u and e1v were modified)1034 ij0 = 88 ; ij1 = 881035 DO jk = 1, jpkm11036 DO jj = mj0(ij0), mj1(ij1)1037 DO ji = mi0(ii0), mi1(ii1)1038 SELECT CASE ( pout )1039 CASE( 'U' )1040 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1041 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1042 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1043 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1044 CASE( 'V' )1045 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1046 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1047 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1048 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1049 CASE( 'F' )1050 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1051 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1052 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1053 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1054 END SELECT1055 END DO1056 END DO1057 END DO1058 ENDIF1059 1060 ii0 = 145 ; ii1 = 146 ! Danish Straits (e2u was modified)1061 ij0 = 116 ; ij1 = 1161062 DO jk = 1, jpkm11063 DO jj = mj0(ij0), mj1(ij1)1064 DO ji = mi0(ii0), mi1(ii1)1065 SELECT CASE ( pout )1066 CASE( 'U' )1067 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1068 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1069 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1070 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1071 CASE( 'F' )1072 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1073 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1074 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1075 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1076 END SELECT1077 END DO1078 END DO1079 END DO1080 ENDIF1081 !1082 ! ! =====================1083 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration1084 ! ! =====================1085 !1086 ii0 = 281 ; ii1 = 282 ! Gibraltar Strait (e2u was modified)1087 ij0 = 200 ; ij1 = 2001088 DO jk = 1, jpkm11089 DO jj = mj0(ij0), mj1(ij1)1090 DO ji = mi0(ii0), mi1(ii1)1091 SELECT CASE ( pout )1092 CASE( 'U' )1093 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1094 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1095 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1096 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1097 CASE( 'F' )1098 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1099 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1100 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1101 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1102 END SELECT1103 END DO1104 END DO1105 END DO1106 !1107 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u was modified)1108 ij0 = 208 ; ij1 = 2081109 DO jk = 1, jpkm11110 DO jj = mj0(ij0), mj1(ij1)1111 DO ji = mi0(ii0), mi1(ii1)1112 SELECT CASE ( pout )1113 CASE( 'U' )1114 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1115 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1116 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1117 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1118 CASE( 'F' )1119 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1120 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1121 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1122 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1123 END SELECT1124 END DO1125 END DO1126 END DO1127 !1128 ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v was modified)1129 ij0 = 124 ; ij1 = 1251130 DO jk = 1, jpkm11131 DO jj = mj0(ij0), mj1(ij1)1132 DO ji = mi0(ii0), mi1(ii1)1133 SELECT CASE ( pout )1134 CASE( 'V' )1135 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1136 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1137 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1138 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1139 END SELECT1140 END DO1141 END DO1142 END DO1143 !1144 ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v was modified) [closed from bathy_11 on]1145 ij0 = 124 ; ij1 = 1251146 DO jk = 1, jpkm11147 DO jj = mj0(ij0), mj1(ij1)1148 DO ji = mi0(ii0), mi1(ii1)1149 SELECT CASE ( pout )1150 CASE( 'V' )1151 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1152 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1153 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1154 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1155 END SELECT1156 END DO1157 END DO1158 END DO1159 !1160 ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v was modified)1161 ij0 = 124 ; ij1 = 1251162 DO jk = 1, jpkm11163 DO jj = mj0(ij0), mj1(ij1)1164 DO ji = mi0(ii0), mi1(ii1)1165 SELECT CASE ( pout )1166 CASE( 'V' )1167 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1168 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1169 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1170 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1171 END SELECT1172 END DO1173 END DO1174 END DO1175 !1176 ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v was modified)1177 ij0 = 124 ; ij1 = 1251178 DO jk = 1, jpkm11179 DO jj = mj0(ij0), mj1(ij1)1180 DO ji = mi0(ii0), mi1(ii1)1181 SELECT CASE ( pout )1182 CASE( 'V' )1183 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1184 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1185 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1186 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1187 END SELECT1188 END DO1189 END DO1190 END DO1191 !1192 ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v was modified)1193 ij0 = 141 ; ij1 = 1421194 DO jk = 1, jpkm11195 DO jj = mj0(ij0), mj1(ij1)1196 DO ji = mi0(ii0), mi1(ii1)1197 SELECT CASE ( pout )1198 CASE( 'V' )1199 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1200 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1201 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1202 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1203 END SELECT1204 END DO1205 END DO1206 END DO1207 !1208 ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v was modified)1209 ij0 = 141 ; ij1 = 1421210 DO jk = 1, jpkm11211 DO jj = mj0(ij0), mj1(ij1)1212 DO ji = mi0(ii0), mi1(ii1)1213 SELECT CASE ( pout )1214 CASE( 'V' )1215 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1216 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1217 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1218 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1219 END SELECT1220 END DO1221 END DO1222 END DO1223 ENDIF1224 ! ! =====================1225 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration1226 ! ! =====================1227 !1228 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u was modified)1229 ij0 = 327 ; ij1 = 3271230 DO jk = 1, jpkm11231 DO jj = mj0(ij0), mj1(ij1)1232 DO ji = mi0(ii0), mi1(ii1)1233 SELECT CASE ( pout )1234 CASE( 'U' )1235 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1236 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1237 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1238 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1239 CASE( 'F' )1240 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1241 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1242 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1243 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1244 END SELECT1245 END DO1246 END DO1247 END DO1248 !1249 ii0 = 627 ; ii1 = 628 ! Bosphorus Strait (e2u was modified)1250 ij0 = 343 ; ij1 = 3431251 DO jk = 1, jpkm11252 DO jj = mj0(ij0), mj1(ij1)1253 DO ji = mi0(ii0), mi1(ii1)1254 SELECT CASE ( pout )1255 CASE( 'U' )1256 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1257 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1258 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1259 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1260 CASE( 'F' )1261 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1262 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1263 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1264 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1265 END SELECT1266 END DO1267 END DO1268 END DO1269 !1270 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u was modified)1271 ij0 = 232 ; ij1 = 2321272 DO jk = 1, jpkm11273 DO jj = mj0(ij0), mj1(ij1)1274 DO ji = mi0(ii0), mi1(ii1)1275 SELECT CASE ( pout )1276 CASE( 'U' )1277 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1278 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1279 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1280 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1281 CASE( 'F' )1282 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1283 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1284 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1285 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1286 END SELECT1287 END DO1288 END DO1289 END DO1290 !1291 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u was modified)1292 ij0 = 232 ; ij1 = 2321293 DO jk = 1, jpkm11294 DO jj = mj0(ij0), mj1(ij1)1295 DO ji = mi0(ii0), mi1(ii1)1296 SELECT CASE ( pout )1297 CASE( 'U' )1298 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1299 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1300 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1301 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1302 CASE( 'F' )1303 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1304 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1305 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1306 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1307 END SELECT1308 END DO1309 END DO1310 END DO1311 !1312 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u was modified)1313 ij0 = 270 ; ij1 = 2701314 DO jk = 1, jpkm11315 DO jj = mj0(ij0), mj1(ij1)1316 DO ji = mi0(ii0), mi1(ii1)1317 SELECT CASE ( pout )1318 CASE( 'U' )1319 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1320 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1321 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1322 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1323 CASE( 'F' )1324 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1325 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1326 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1327 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1328 END SELECT1329 END DO1330 END DO1331 END DO1332 !1333 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v was modified)1334 ij0 = 232 ; ij1 = 2331335 DO jk = 1, jpkm11336 DO jj = mj0(ij0), mj1(ij1)1337 DO ji = mi0(ii0), mi1(ii1)1338 SELECT CASE ( pout )1339 CASE( 'V' )1340 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1341 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1342 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1343 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1344 END SELECT1345 END DO1346 END DO1347 END DO1348 !1349 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v was modified)1350 ij0 = 276 ; ij1 = 2761351 DO jk = 1, jpkm11352 DO jj = mj0(ij0), mj1(ij1)1353 DO ji = mi0(ii0), mi1(ii1)1354 SELECT CASE ( pout )1355 CASE( 'V' )1356 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1357 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1358 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1359 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1360 END SELECT1361 END DO1362 END DO1363 END DO1364 ENDIF1365 END SUBROUTINE dom_vvl_orca_fix1366 1367 967 !!====================================================================== 1368 968 END MODULE domvvl
Note: See TracChangeset
for help on using the changeset viewer.
