- Timestamp:
- 2014-01-23T18:13:16+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4354 r4370 14 14 #if defined key_dynspg_ts || defined key_esopa 15 15 !!---------------------------------------------------------------------- 16 !! 'key_dynspg_ts' free surface cst volume with time splitting16 !! 'key_dynspg_ts' split explicit free surface 17 17 !!---------------------------------------------------------------------- 18 18 !! dyn_spg_ts : compute surface pressure gradient trend using a time- … … 55 55 PUBLIC dyn_spg_ts_init ! " " " " 56 56 57 ! Potential namelist parameters below to be read in dyn_spg_ts_init58 LOGICAL, PUBLIC, PARAMETER :: ln_bt_fw=.TRUE. !: Forward integration of barotropic sub-stepping59 LOGICAL, PRIVATE, PARAMETER :: ln_bt_av=.TRUE. !: Time averaging of barotropic variables60 LOGICAL, PRIVATE, PARAMETER :: ln_bt_nn_auto=.FALSE. !: Set number of iterations automatically61 INTEGER, PRIVATE, PARAMETER :: nn_bt_flt=1 !: Filter choice62 REAL(wp), PRIVATE, PARAMETER :: rn_bt_cmax=0.8_wp !: Max. courant number (used if ln_bt_nn_auto=T)63 ! End namelist parameters64 65 57 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro 66 58 REAL(wp),SAVE :: rdtbt ! Barotropic time step … … 160 152 REAL(wp), POINTER, DIMENSION(:,:) :: zu_sum, zv_sum, zwx, zwy, zhdiv 161 153 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 162 REAL(wp), POINTER, DIMENSION(:,:) :: zhur_b, zhvr_b163 154 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a 164 REAL(wp), POINTER, DIMENSION(:,:) :: zh t, zhf155 REAL(wp), POINTER, DIMENSION(:,:) :: zhf 165 156 !!---------------------------------------------------------------------- 166 157 ! … … 172 163 CALL wrk_alloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc) 173 164 CALL wrk_alloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 174 CALL wrk_alloc( jpi, jpj, zhur_b, zhvr_b )175 165 CALL wrk_alloc( jpi, jpj, zsshu_a, zsshv_a ) 176 CALL wrk_alloc( jpi, jpj, zh t, zhf )166 CALL wrk_alloc( jpi, jpj, zhf ) 177 167 ! 178 168 ! !* Local constant initialization … … 228 218 IF ( kt == nit000 .OR. lk_vvl ) THEN 229 219 IF ( ln_dynvor_een ) THEN 230 ! JC: Simplification needed below: define ht_0 even when volume is fixed231 IF (lk_vvl) THEN232 zht(:,:) = (ht_0(:,:) + sshn(:,:)) * tmask(:,:,1)233 ELSE234 zht(:,:) = 0.235 DO jk = 1, jpkm1236 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)237 END DO238 ENDIF239 240 220 DO jj = 1, jpjm1 241 221 DO ji = 1, jpim1 242 zwz(ji,jj) = ( zht(ji ,jj+1) + zht(ji+1,jj+1) + &243 & zht(ji ,jj ) + zht(ji+1,jj ) ) &222 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 223 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 244 224 & / ( MAX( 1.0_wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 245 225 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) … … 261 241 ELSE 262 242 zwz(:,:) = 0._wp 263 zh t(:,:) = 0.243 zhf(:,:) = 0. 264 244 IF ( .not. ln_sco ) THEN 265 245 ! IF( rn_hmin < 0._wp ) THEN ; jk = - INT( rn_hmin ) ! from a nb of level 266 246 ! ELSE ; jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 ) ! from a depth 267 247 ! ENDIF 268 ! zh t(:,:) = gdepw_0(:,:,jk+1)248 ! zhf(:,:) = gdepw_0(:,:,jk+1) 269 249 ELSE 270 zh t(:,:) = hbatf(:,:)250 zhf(:,:) = hbatf(:,:) 271 251 END IF 272 252 273 253 DO jj = 1, jpjm1 274 zh t(:,jj) = zht(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1))254 zhf(:,jj) = zhf(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 275 255 END DO 276 256 277 257 DO jk = 1, jpkm1 278 258 DO jj = 1, jpjm1 279 zh t(:,jj) = zht(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)280 END DO 281 END DO 282 CALL lbc_lnk( zh t, 'F', 1._wp )259 zhf(:,jj) = zhf(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 260 END DO 261 END DO 262 CALL lbc_lnk( zhf, 'F', 1._wp ) 283 263 ! JC: TBC. hf should be greater than 0 284 264 DO jj = 1, jpj 285 265 DO ji = 1, jpi 286 IF( zh t(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zht(ji,jj) ! zhtis actually hf here but it saves an array266 IF( zhf(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zhf(ji,jj) ! zhf is actually hf here but it saves an array 287 267 END DO 288 268 END DO … … 296 276 ll_fw_start=.FALSE. 297 277 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) 298 ENDIF299 300 ! before inverse water column height at u- and v- points301 IF( lk_vvl ) THEN302 zhur_b(:,:) = 0.303 zhvr_b(:,:) = 0.304 DO jk = 1, jpk305 zhur_b(:,:) = zhur_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)306 zhvr_b(:,:) = zhvr_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)307 END DO308 zhur_b(:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1. - umask(:,:,1) )309 zhvr_b(:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1. - vmask(:,:,1) )310 ELSE311 zhur_b(:,:) = hur(:,:)312 zhvr_b(:,:) = hvr(:,:)313 278 ENDIF 314 279 … … 331 296 DO ji = 1, jpi 332 297 #endif 333 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u (ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk)334 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v (ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)298 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 299 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 335 300 END DO 336 301 END DO … … 492 457 ! ! Initialisations ! 493 458 ! ! ==================== ! 494 ! Initialize barotropic variables: 495 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 496 sshn_e (:,:) = sshn (:,:) 497 zun_e (:,:) = un_b (:,:) 498 zvn_e (:,:) = vn_b (:,:) 499 ELSE ! CENTRED integration: start from BEFORE fields 500 sshn_e (:,:) = sshb (:,:) 501 zun_e (:,:) = ub_b (:,:) 502 zvn_e (:,:) = vb_b (:,:) 503 ENDIF 504 ! 505 ! Initialize depths: 506 IF ( lk_vvl.AND.(.NOT.ln_bt_fw) ) THEN 507 hu_e (:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) ) 508 hv_e (:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) ) 509 hur_e (:,:) = zhur_b(:,:) 510 hvr_e (:,:) = zhvr_b(:,:) 511 ELSE 459 ! Initialize barotropic variables: 460 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 461 sshn_e(:,:) = sshn (:,:) 462 zun_e (:,:) = un_b (:,:) 463 zvn_e (:,:) = vn_b (:,:) 464 ! 512 465 hu_e (:,:) = hu (:,:) 513 466 hv_e (:,:) = hv (:,:) 514 467 hur_e (:,:) = hur (:,:) 515 468 hvr_e (:,:) = hvr (:,:) 516 ENDIF 517 ! 518 IF (.NOT.lk_vvl) THEN ! Depths at jn+0.5: 519 zhup2_e (:,:) = hu(:,:) 520 zhvp2_e (:,:) = hv(:,:) 521 ENDIF 469 ELSE ! CENTRED integration: start from BEFORE fields 470 sshn_e(:,:) = sshb (:,:) 471 zun_e (:,:) = ub_b (:,:) 472 zvn_e (:,:) = vb_b (:,:) 473 ! 474 hu_e (:,:) = hu_b (:,:) 475 hv_e (:,:) = hv_b (:,:) 476 hur_e (:,:) = hur_b(:,:) 477 hvr_e (:,:) = hvr_b(:,:) 478 ENDIF 479 ! 480 ! 522 481 ! 523 482 ! Initialize sums: … … 560 519 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 561 520 DO ji = 2, fs_jpim1 ! Vector opt. 562 zwx(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )&563 & * ( e1 t(ji ,jj) * e2t(ji ,jj) * zsshp2_e(ji ,jj) &564 & + e1 t(ji+1,jj) * e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )565 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )&566 & * ( e1 t(ji,jj ) * e2t(ji,jj ) * zsshp2_e(ji,jj ) &567 & + e1 t(ji,jj+1) * e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )521 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 522 & * ( e12t(ji ,jj) * zsshp2_e(ji ,jj) & 523 & + e12t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 524 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 525 & * ( e12t(ji,jj ) * zsshp2_e(ji,jj ) & 526 & + e12t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 568 527 END DO 569 528 END DO … … 572 531 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 573 532 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 533 ELSE 534 zhup2_e (:,:) = hu(:,:) 535 zhvp2_e (:,:) = hv(:,:) 574 536 ENDIF 575 537 ! !* after ssh … … 583 545 DO ji = fs_2, fs_jpim1 ! vector opt. 584 546 zhdiv(ji,jj) = ( zwx(ji,jj) - zwx(ji-1,jj) & 585 & + zwy(ji,jj) - zwy(ji,jj-1) & 586 & ) / ( e1t(ji,jj) * e2t(ji,jj) ) 547 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e12t(ji,jj) 587 548 END DO 588 549 END DO … … 609 570 DO jj = 2, jpjm1 610 571 DO ji = 2, jpim1 ! NO Vector Opt. 611 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) )&612 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha_e(ji ,jj) &613 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha_e(ji+1,jj) )614 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) )&615 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha_e(ji,jj ) &616 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha_e(ji,jj+1) )572 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 573 & * ( e12t(ji ,jj ) * ssha_e(ji ,jj ) & 574 & + e12t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 575 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 576 & * ( e12t(ji ,jj ) * ssha_e(ji ,jj ) & 577 & + e12t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 617 578 END DO 618 579 END DO … … 648 609 DO jj = 2, jpjm1 649 610 DO ji = 2, jpim1 650 zx1 = z1_2 * umask(ji ,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )&651 & * ( e1t(ji ,jj) * e2t(ji ,jj) * zsshp2_e(ji ,jj)&652 & + e1t(ji+1,jj) * e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )653 zy1 = z1_2 * vmask(ji ,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )&654 & * ( e1 t(ji,jj ) * e2t(ji,jj ) * zsshp2_e(ji,jj ) &655 & + e1 t(ji,jj+1) * e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )611 zx1 = z1_2 * umask(ji ,jj,1) * r1_e12u(ji ,jj) & 612 & * ( e12t(ji ,jj ) * zsshp2_e(ji ,jj) & 613 & + e12t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 614 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e12v(ji ,jj ) & 615 & * ( e12t(ji ,jj ) * zsshp2_e(ji ,jj ) & 616 & + e12t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) 656 617 zhust_e(ji,jj) = hu_0(ji,jj) + zx1 657 618 zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 … … 833 794 DO jj = 1, jpjm1 834 795 DO ji = 1, jpim1 ! NO Vector Opt. 835 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) )&836 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj)&837 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) )838 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) )&839 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj )&840 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )796 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 797 & * ( e12t(ji ,jj) * ssha_e(ji ,jj) & 798 & + e12t(ji+1,jj) * ssha_e(ji+1,jj) ) 799 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 800 & * ( e12t(ji,jj ) * ssha_e(ji,jj ) & 801 & + e12t(ji,jj+1) * ssha_e(ji,jj+1) ) 841 802 END DO 842 803 END DO … … 865 826 END DO 866 827 ELSE 867 hu_e (:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) )868 hv_e (:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) )869 828 DO jk=1,jpkm1 870 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_ e(:,:) ) * z1_2dt_b871 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_ e(:,:) ) * z1_2dt_b829 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 830 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 872 831 END DO 873 832 ! Save barotropic velocities not transport: … … 890 849 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc ) 891 850 CALL wrk_dealloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 892 CALL wrk_dealloc( jpi, jpj, zhur_b, zhvr_b )893 851 CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a ) 894 CALL wrk_dealloc( jpi, jpj, zh t, zhf )852 CALL wrk_dealloc( jpi, jpj, zhf ) 895 853 ! 896 854 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') … … 989 947 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) ) 990 948 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) ) 991 IF( .NOT.ln_bt_av .AND. iom_varid( numror, 'sshbb_e', ldstop = .FALSE. ) > 0) THEN949 IF( .NOT.ln_bt_av ) THEN 992 950 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:) ) 993 951 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:) ) … … 996 954 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:) ) 997 955 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:) ) 998 ELSE999 sshbb_e = sshn_b ! ACC GUESS WORK1000 ubb_e = ub_b1001 vbb_e = vb_b1002 sshb_e = sshn_b1003 ub_e = ub_b1004 vb_e = vb_b1005 956 ENDIF 1006 957 ! … … 1029 980 INTEGER , INTENT(in) :: kt ! ocean time-step 1030 981 ! 1031 INTEGER :: ji ,jj, jk 982 INTEGER :: ji ,jj 983 INTEGER :: ios ! Local integer output status for namelist read 1032 984 REAL(wp) :: zxr2, zyr2, zcmax 1033 REAL(wp), POINTER, DIMENSION(:,:) :: zcu , zht985 REAL(wp), POINTER, DIMENSION(:,:) :: zcu 1034 986 !! 1035 !NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, &1036 !& nn_baro, rn_bt_cmax, nn_bt_flt987 NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, & 988 & nn_baro, rn_bt_cmax, nn_bt_flt 1037 989 !!---------------------------------------------------------------------- 1038 ! REWIND( numnam ) !* Namelist namsplit: split-explicit free surface 1039 ! READ ( numnam, namsplit ) 990 ! 991 REWIND( numnam_ref ) ! Namelist namsplit in reference namelist : time splitting parameters 992 READ ( numnam_ref, namsplit, IOSTAT = ios, ERR = 901) 993 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in reference namelist', lwp ) 994 995 REWIND( numnam_cfg ) ! Namelist namsplit in configuration namelist : time splitting parameters 996 READ ( numnam_cfg, namsplit, IOSTAT = ios, ERR = 902 ) 997 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in configuration namelist', lwp ) 998 WRITE ( numond, namsplit ) 999 ! 1040 1000 ! ! Max courant number for ext. grav. waves 1041 1001 ! 1042 CALL wrk_alloc( jpi, jpj, zcu, zht ) 1043 ! 1044 ! JC: Simplification needed below: define ht_0 even when volume is fixed 1002 CALL wrk_alloc( jpi, jpj, zcu ) 1003 ! 1045 1004 IF (lk_vvl) THEN 1046 zht(:,:) = ht_0(:,:) * tmask(:,:,1) 1005 DO jj = 1, jpj 1006 DO ji =1, jpi 1007 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1008 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1009 zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 1010 END DO 1011 END DO 1047 1012 ELSE 1048 zht(:,:) = 0. 1049 DO jk = 1, jpkm1 1050 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 1051 END DO 1052 ENDIF 1053 1054 DO jj = 1, jpj 1055 DO ji =1, jpi 1056 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1057 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1058 zcu(ji,jj) = sqrt(grav*zht(ji,jj)*(zxr2 + zyr2) ) 1059 END DO 1060 END DO 1013 DO jj = 1, jpj 1014 DO ji =1, jpi 1015 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1016 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1017 zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) ) 1018 END DO 1019 END DO 1020 ENDIF 1061 1021 1062 1022 zcmax = MAXVAL(zcu(:,:)) 1063 1023 IF( lk_mpp ) CALL mpp_max( zcmax ) 1064 1024 1065 ! Estimate number of iterations to satisfy a max courant number= 0.81025 ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 1066 1026 IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1067 1027 … … 1073 1033 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 1074 1034 IF( ln_bt_nn_auto ) THEN 1075 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.true. Automatically set nn_baro '1076 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax1035 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.true. Automatically set nn_baro ' 1036 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax 1077 1037 ELSE 1078 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.false.: Use nn_baro in namelist ' 1079 ENDIF 1080 IF(lwp) WRITE(numout,*) ' nn_baro = ', nn_baro 1081 IF(lwp) WRITE(numout,*) ' Barotropic time step [s] is :', rdtbt 1082 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1038 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.false.: Use nn_baro in namelist ' 1039 ENDIF 1083 1040 1084 1041 IF(ln_bt_av) THEN 1085 IF(lwp) WRITE(numout,*) ' ln_bt_av=.true. => Time averaging over nn_baro time steps is on '1042 IF(lwp) WRITE(numout,*) ' ln_bt_av=.true. => Time averaging over nn_baro time steps is on ' 1086 1043 ELSE 1087 IF(lwp) WRITE(numout,*) ' ln_bt_av=.false. => No time averaging of barotropic variables '1044 IF(lwp) WRITE(numout,*) ' ln_bt_av=.false. => No time averaging of barotropic variables ' 1088 1045 ENDIF 1089 1046 ! 1090 1047 ! 1091 1048 IF(ln_bt_fw) THEN 1092 IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true. => Forward integration of barotropic variables '1049 IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true. => Forward integration of barotropic variables ' 1093 1050 ELSE 1094 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables '1095 ENDIF 1096 ! 1097 IF(lwp) WRITE(numout,*) 'Time filter choice, nn_bt_flt: ', nn_bt_flt1051 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables ' 1052 ENDIF 1053 ! 1054 IF(lwp) WRITE(numout,*) ' Time filter choice, nn_bt_flt: ', nn_bt_flt 1098 1055 SELECT CASE ( nn_bt_flt ) 1099 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac'1100 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro'1101 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro'1056 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac' 1057 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro' 1058 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro' 1102 1059 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' ) 1103 1060 END SELECT 1104 1061 ! 1062 IF(lwp) WRITE(numout,*) ' ' 1063 IF(lwp) WRITE(numout,*) ' nn_baro = ', nn_baro 1064 IF(lwp) WRITE(numout,*) ' Barotropic time step [s] is :', rdtbt 1065 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1066 ! 1105 1067 IF ((.NOT.ln_bt_av).AND.(.NOT.ln_bt_fw)) THEN 1106 1068 CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' ) … … 1110 1072 ENDIF 1111 1073 ! 1112 CALL wrk_dealloc( jpi, jpj, zcu , zht)1074 CALL wrk_dealloc( jpi, jpj, zcu ) 1113 1075 ! 1114 1076 END SUBROUTINE dyn_spg_ts_init … … 1116 1078 #else 1117 1079 !!--------------------------------------------------------------------------- 1118 !! Default case : Empty module No s tandard free surface constant volume1080 !! Default case : Empty module No split explicit free surface 1119 1081 !!--------------------------------------------------------------------------- 1120 1121 USE par_kind1122 LOGICAL, PUBLIC, PARAMETER :: ln_bt_fw=.FALSE. ! Forward integration of barotropic sub-stepping1123 1082 CONTAINS 1124 1083 INTEGER FUNCTION dyn_spg_ts_alloc() ! Dummy function
Note: See TracChangeset
for help on using the changeset viewer.
