- Timestamp:
- 2018-01-17T14:43:44+01:00 (6 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/VORTEX/MY_SRC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/VORTEX/MY_SRC/domvvl.F90
r9168 r9255 65 65 !!---------------------------------------------------------------------- 66 66 !! NEMO/OPA 3.7 , NEMO-Consortium (2015) 67 !! $Id: domvvl.F90 9 065 2017-12-14 17:00:50Z jchanut$67 !! $Id: domvvl.F90 9190 2018-01-06 14:18:23Z gm $ 68 68 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 69 69 !!---------------------------------------------------------------------- … … 119 119 REAL(wp):: zcoef 120 120 !!---------------------------------------------------------------------- 121 !122 IF( ln_timing ) CALL timing_start('dom_vvl_init')123 121 ! 124 122 IF(lwp) WRITE(numout,*) … … 240 238 ENDIF 241 239 ! 242 IF( ln_timing ) CALL timing_stop('dom_vvl_init')243 !244 240 END SUBROUTINE dom_vvl_init 245 241 … … 389 385 ! ! d - thickness diffusion transport: boundary conditions 390 386 ! (stored for tracer advction and continuity equation) 391 CALL lbc_lnk( un_td , 'U' , -1._wp) 392 CALL lbc_lnk( vn_td , 'V' , -1._wp) 387 CALL lbc_lnk_multi( un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 393 388 394 389 ! 4 - Time stepping of baroclinic scale factors … … 675 670 !!---------------------------------------------------------------------- 676 671 ! 677 IF( ln_timing ) CALL timing_start('dom_vvl_interpol')678 !679 672 IF(ln_wd_il) THEN 680 673 zlnwd = 1.0_wp … … 762 755 END SELECT 763 756 ! 764 IF( ln_timing ) CALL timing_stop('dom_vvl_interpol')765 !766 757 END SUBROUTINE dom_vvl_interpol 767 758 … … 785 776 INTEGER :: id1, id2, id3, id4, id5 ! local integers 786 777 !!---------------------------------------------------------------------- 787 !788 IF( ln_timing ) CALL timing_start('dom_vvl_rst')789 778 ! 790 779 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise … … 914 903 ELSE 915 904 ! 916 ! Just to read set ssh in fact, called latter once vertical grid917 ! is set up:918 CALL usr_def_istate( gdept_0, tmask, tsb, ub, vb, sshb)905 ! usr_def_istate called here only to get sshb, that is needed to initialize e3t_b and e3t_n 906 CALL usr_def_istate( gdept_0, tmask, tsb, ub, vb, sshb ) 907 ! usr_def_istate will be called again in istate_init to initialize ts(bn), ssh(bn), u(bn) and v(bn) 919 908 ! 920 909 DO jk=1,jpk 921 910 e3t_b(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshb(:,:) ) & 922 & / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 911 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 912 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) ! make sure e3t_b != 0 on land points 923 913 END DO 924 914 e3t_n(:,:,:) = e3t_b(:,:,:) 925 ! sshn(:,:)=0._wp926 ! e3t_n(:,:,:)=e3t_0(:,:,:)927 ! e3t_b(:,:,:)=e3t_0(:,:,:)915 !!$ sshn(:,:)=0._wp 916 !!$ e3t_n(:,:,:)=e3t_0(:,:,:) 917 !!$ e3t_b(:,:,:)=e3t_0(:,:,:) 928 918 ! 929 919 END IF ! end of ll_wd edits … … 958 948 ENDIF 959 949 ! 960 IF( ln_timing ) CALL timing_stop('dom_vvl_rst')961 !962 950 END SUBROUTINE dom_vvl_rst 963 951 … … 979 967 REWIND( numnam_ref ) ! Namelist nam_vvl in reference namelist : 980 968 READ ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) 981 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp ) 982 ! 969 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_vvl in reference namelist', lwp ) 983 970 REWIND( numnam_cfg ) ! Namelist nam_vvl in configuration namelist : Parameters of the run 984 971 READ ( numnam_cfg, nam_vvl, IOSTAT = ios, ERR = 902 ) … … 990 977 WRITE(numout,*) 'dom_vvl_ctl : choice/control of the variable vertical coordinate' 991 978 WRITE(numout,*) '~~~~~~~~~~~' 992 WRITE(numout,*) ' 993 WRITE(numout,*) ' 994 WRITE(numout,*) ' 995 WRITE(numout,*) ' 996 WRITE(numout,*) ' 979 WRITE(numout,*) ' Namelist nam_vvl : chose a vertical coordinate' 980 WRITE(numout,*) ' zstar ln_vvl_zstar = ', ln_vvl_zstar 981 WRITE(numout,*) ' ztilde ln_vvl_ztilde = ', ln_vvl_ztilde 982 WRITE(numout,*) ' layer ln_vvl_layer = ', ln_vvl_layer 983 WRITE(numout,*) ' ztilde as zstar ln_vvl_ztilde_as_zstar = ', ln_vvl_ztilde_as_zstar 997 984 WRITE(numout,*) ' ztilde near the equator ln_vvl_zstar_at_eqtor = ', ln_vvl_zstar_at_eqtor 998 ! WRITE(numout,*) ' Namelist nam_vvl : chose kinetic-to-potential energy conservation' 999 ! WRITE(numout,*) ' ln_vvl_kepe = ', ln_vvl_kepe 1000 WRITE(numout,*) ' Namelist nam_vvl : thickness diffusion coefficient' 1001 WRITE(numout,*) ' rn_ahe3 = ', rn_ahe3 1002 WRITE(numout,*) ' Namelist nam_vvl : maximum e3t deformation fractional change' 1003 WRITE(numout,*) ' rn_zdef_max = ', rn_zdef_max 985 WRITE(numout,*) ' !' 986 WRITE(numout,*) ' thickness diffusion coefficient rn_ahe3 = ', rn_ahe3 987 WRITE(numout,*) ' maximum e3t deformation fractional change rn_zdef_max = ', rn_zdef_max 1004 988 IF( ln_vvl_ztilde_as_zstar ) THEN 1005 WRITE(numout,*) ' ztilde running in zstar emulation mode;'1006 WRITE(numout,*) ' 1007 WRITE(numout,*) ' 1008 WRITE(numout,*) ' rn_rst_e3t = 0.0'1009 WRITE(numout,*) ' 1010 WRITE(numout,*) ' rn_lf_cutoff =1.0/rdt'989 WRITE(numout,*) ' ztilde running in zstar emulation mode (ln_vvl_ztilde_as_zstar=T) ' 990 WRITE(numout,*) ' ignoring namelist timescale parameters and using:' 991 WRITE(numout,*) ' hard-wired : z-tilde to zstar restoration timescale (days)' 992 WRITE(numout,*) ' rn_rst_e3t = 0.e0' 993 WRITE(numout,*) ' hard-wired : z-tilde cutoff frequency of low-pass filter (days)' 994 WRITE(numout,*) ' rn_lf_cutoff = 1.0/rdt' 1011 995 ELSE 1012 WRITE(numout,*) ' Namelist nam_vvl : z-tilde to zstar restoration timescale (days)' 1013 WRITE(numout,*) ' rn_rst_e3t = ', rn_rst_e3t 1014 WRITE(numout,*) ' Namelist nam_vvl : z-tilde cutoff frequency of low-pass filter (days)' 1015 WRITE(numout,*) ' rn_lf_cutoff = ', rn_lf_cutoff 996 WRITE(numout,*) ' z-tilde to zstar restoration timescale (days) rn_rst_e3t = ', rn_rst_e3t 997 WRITE(numout,*) ' z-tilde cutoff frequency of low-pass filter (days) rn_lf_cutoff = ', rn_lf_cutoff 1016 998 ENDIF 1017 WRITE(numout,*) ' Namelist nam_vvl : debug prints' 1018 WRITE(numout,*) ' ln_vvl_dbg = ', ln_vvl_dbg 999 WRITE(numout,*) ' debug prints flag ln_vvl_dbg = ', ln_vvl_dbg 1019 1000 ENDIF 1020 1001 ! … … 1030 1011 IF(lwp) THEN ! Print the choice 1031 1012 WRITE(numout,*) 1032 IF( ln_vvl_zstar ) WRITE(numout,*) ' zstar vertical coordinate is used' 1033 IF( ln_vvl_ztilde ) WRITE(numout,*) ' ztilde vertical coordinate is used' 1034 IF( ln_vvl_layer ) WRITE(numout,*) ' layer vertical coordinate is used' 1035 IF( ln_vvl_ztilde_as_zstar ) WRITE(numout,*) ' to emulate a zstar coordinate' 1036 ! - ML - Option not developed yet 1037 ! IF( ln_vvl_kepe ) WRITE(numout,*) ' kinetic to potential energy transfer : option used' 1038 ! IF( .NOT. ln_vvl_kepe ) WRITE(numout,*) ' kinetic to potential energy transfer : option not used' 1013 IF( ln_vvl_zstar ) WRITE(numout,*) ' ==>>> zstar vertical coordinate is used' 1014 IF( ln_vvl_ztilde ) WRITE(numout,*) ' ==>>> ztilde vertical coordinate is used' 1015 IF( ln_vvl_layer ) WRITE(numout,*) ' ==>>> layer vertical coordinate is used' 1016 IF( ln_vvl_ztilde_as_zstar ) WRITE(numout,*) ' ==>>> to emulate a zstar coordinate' 1039 1017 ENDIF 1040 1018 ! 1041 1019 #if defined key_agrif 1042 IF( (.NOT.Agrif_Root()).AND.(.NOT.ln_vvl_zstar) ) CALL ctl_stop( 'AGRIF is implemented with zstar coordinate only' )1020 IF( (.NOT.Agrif_Root()).AND.(.NOT.ln_vvl_zstar) ) CALL ctl_stop( 'AGRIF is implemented with zstar coordinate only' ) 1043 1021 #endif 1044 1022 ! -
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/VORTEX/MY_SRC/usrdef_istate.F90
r8703 r9255 110 110 DO jk=1, jpk 111 111 zdu = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji+1,jj,jk)) 112 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH))113 112 IF (zdu < zH) THEN 113 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 114 114 pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 115 115 ELSE … … 126 126 DO jk=1, jpk 127 127 zdv = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji,jj+1,jk)) 128 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH))129 128 IF (zdv < zH) THEN 129 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 130 130 pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 131 131 ELSE
Note: See TracChangeset
for help on using the changeset viewer.