- Timestamp:
- 2015-10-24T15:03:08+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5737 r5829 688 688 !! - vertical interpolation: simple averaging 689 689 !!---------------------------------------------------------------------- 690 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pe3_in! input e3 to be interpolated691 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: pe3_out! output interpolated e3692 CHARACTER(LEN=*) , INTENT( in ) :: pout! grid point of out scale factors693 ! 690 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pe3_in ! input e3 to be interpolated 691 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3_out ! output interpolated e3 692 CHARACTER(LEN=*) , INTENT(in ) :: pout ! grid point of out scale factors 693 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW' 694 694 ! 695 695 INTEGER :: ji, jj, jk ! dummy loop indices 696 LOGICAL :: l_is_orca ! local logical697 ! !----------------------------------------------------------------------696 !!---------------------------------------------------------------------- 697 ! 698 698 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_interpol') 699 ! 700 l_is_orca = .FALSE. 701 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) l_is_orca = .TRUE. ! ORCA R2 configuration - will need to correct some locations 702 703 SELECT CASE ( pout ) 704 ! ! ------------------------------------- ! 705 CASE( 'U' ) ! interpolation from T-point to U-point ! 706 ! ! ------------------------------------- ! 707 ! horizontal surface weighted interpolation 699 ! 700 SELECT CASE ( pout ) !== type of interpolation ==! 701 ! 702 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 708 703 DO jk = 1, jpk 709 704 DO jj = 1, jpjm1 … … 715 710 END DO 716 711 END DO 717 !718 ! boundary conditions719 712 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 720 713 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 721 ! ! ------------------------------------- ! 722 CASE( 'V' ) ! interpolation from T-point to V-point ! 723 ! ! ------------------------------------- ! 724 ! horizontal surface weighted interpolation 714 ! 715 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 725 716 DO jk = 1, jpk 726 717 DO jj = 1, jpjm1 … … 732 723 END DO 733 724 END DO 734 !735 ! boundary conditions736 725 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 737 726 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 738 ! ! ------------------------------------- ! 739 CASE( 'F' ) ! interpolation from U-point to F-point ! 740 ! ! ------------------------------------- ! 741 ! horizontal surface weighted interpolation 727 ! 728 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 742 729 DO jk = 1, jpk 743 730 DO jj = 1, jpjm1 … … 749 736 END DO 750 737 END DO 751 !752 ! boundary conditions753 738 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 754 739 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 755 ! ! ------------------------------------- ! 756 CASE( 'W' ) ! interpolation from T-point to W-point ! 757 ! ! ------------------------------------- ! 758 ! vertical simple interpolation 740 ! 741 CASE( 'W' ) !* from T- to W-point : vertical simple mean 742 ! 759 743 pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 760 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 744 ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing 745 !!gm BUG? use here wmask in case of ISF ? to be checked 761 746 DO jk = 2, jpk 762 747 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 763 748 & + 0.5_wp * tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 764 749 END DO 765 ! ! -------------------------------------- ! 766 CASE( 'UW' ) ! interpolation from U-point to UW-point ! 767 ! ! -------------------------------------- ! 768 ! vertical simple interpolation 750 ! 751 CASE( 'UW' ) !* from U- to UW-point : vertical simple mean 752 ! 769 753 pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 770 754 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 755 !!gm BUG? use here wumask in case of ISF ? to be checked 771 756 DO jk = 2, jpk 772 757 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 773 758 & + 0.5_wp * umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 774 759 END DO 775 ! ! -------------------------------------- ! 776 CASE( 'VW' ) ! interpolation from V-point to VW-point ! 777 ! ! -------------------------------------- ! 778 ! vertical simple interpolation 760 ! 761 CASE( 'VW' ) !* from V- to VW-point : vertical simple mean 762 ! 779 763 pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 780 764 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 765 !!gm BUG? use here wvmask in case of ISF ? to be checked 781 766 DO jk = 2, jpk 782 767 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & … … 785 770 END SELECT 786 771 ! 787 788 772 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_interpol') 789 773 ! 790 774 END SUBROUTINE dom_vvl_interpol 775 791 776 792 777 SUBROUTINE dom_vvl_rst( kt, cdrw ) … … 802 787 !! they are set to 0. 803 788 !!---------------------------------------------------------------------- 804 !! * Arguments805 789 INTEGER , INTENT(in) :: kt ! ocean time-step 806 790 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 807 ! ! * Local declarations791 ! 808 792 INTEGER :: jk 809 793 INTEGER :: id1, id2, id3, id4, id5 ! local integers … … 900 884 END IF 901 885 ENDIF 902 886 ! 903 887 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 904 888 ! ! =================== … … 920 904 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) ) 921 905 ENDIF 922 923 ENDIF 906 ! 907 ENDIF 908 ! 924 909 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_rst') 925 910 ! 926 911 END SUBROUTINE dom_vvl_rst 927 912 … … 934 919 !! for vertical coordinate 935 920 !!---------------------------------------------------------------------- 936 INTEGER :: ioptio 937 INTEGER :: ios 938 921 INTEGER :: ioptio, ios 922 !! 939 923 NAMELIST/nam_vvl/ ln_vvl_zstar, ln_vvl_ztilde, ln_vvl_layer, ln_vvl_ztilde_as_zstar, & 940 &ln_vvl_zstar_at_eqtor , rn_ahe3 , rn_rst_e3t , &941 &rn_lf_cutoff , rn_zdef_max , ln_vvl_dbg ! not yet implemented: ln_vvl_kepe924 & ln_vvl_zstar_at_eqtor , rn_ahe3 , rn_rst_e3t , & 925 & rn_lf_cutoff , rn_zdef_max , ln_vvl_dbg ! not yet implemented: ln_vvl_kepe 942 926 !!---------------------------------------------------------------------- 943 927 ! 944 928 REWIND( numnam_ref ) ! Namelist nam_vvl in reference namelist : 945 929 READ ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) 946 930 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp ) 947 931 ! 948 932 REWIND( numnam_cfg ) ! Namelist nam_vvl in configuration namelist : Parameters of the run 949 933 READ ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 ) 950 934 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in configuration namelist', lwp ) 951 935 IF(lwm) WRITE ( numond, nam_vvl ) 952 936 ! 953 937 IF(lwp) THEN ! Namelist print 954 938 WRITE(numout,*) … … 983 967 WRITE(numout,*) ' ln_vvl_dbg = ', ln_vvl_dbg 984 968 ENDIF 985 969 ! 986 970 ioptio = 0 ! Parameter control 987 IF( ln_vvl_ztilde_as_zstar ) ln_vvl_ztilde = .true.988 IF( ln_vvl_zstar ) 989 IF( ln_vvl_ztilde ) 990 IF( ln_vvl_layer ) 991 971 IF( ln_vvl_ztilde_as_zstar ) ln_vvl_ztilde = .true. 972 IF( ln_vvl_zstar ) ioptio = ioptio + 1 973 IF( ln_vvl_ztilde ) ioptio = ioptio + 1 974 IF( ln_vvl_layer ) ioptio = ioptio + 1 975 ! 992 976 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' ) 993 977 IF( .NOT. ln_vvl_zstar .AND. nn_isf .NE. 0) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' ) 994 978 ! 995 979 IF(lwp) THEN ! Print the choice 996 980 WRITE(numout,*) … … 1003 987 ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) ' kinetic to potential energy transfer : option not used' 1004 988 ENDIF 1005 989 ! 1006 990 #if defined key_agrif 1007 991 IF (.NOT.Agrif_Root()) CALL ctl_stop( 'AGRIF not implemented with non-linear free surface (key_vvl)' ) 1008 992 #endif 1009 993 ! 1010 994 END SUBROUTINE dom_vvl_ctl 1011 995
Note: See TracChangeset
for help on using the changeset viewer.
