Changeset 5208 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
- Timestamp:
- 2015-04-13T15:08:59+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r4624 r5208 44 44 45 45 !!* Namelist nam_vvl 46 LOGICAL , PUBLIC :: ln_vvl_zstar ! zstar vertical coordinate47 LOGICAL , PUBLIC :: ln_vvl_ztilde ! ztilde vertical coordinate48 LOGICAL , PUBLIC :: ln_vvl_layer ! level vertical coordinate49 LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar ! ztilde vertical coordinate50 LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor ! ztilde vertical coordinate51 LOGICAL , PUBLIC :: ln_vvl_kepe ! kinetic/potential energy transfer52 ! ! conservation: not used yet46 LOGICAL , PUBLIC :: ln_vvl_zstar = .FALSE. ! zstar vertical coordinate 47 LOGICAL , PUBLIC :: ln_vvl_ztilde = .FALSE. ! ztilde vertical coordinate 48 LOGICAL , PUBLIC :: ln_vvl_layer = .FALSE. ! level vertical coordinate 49 LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE. ! ztilde vertical coordinate 50 LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor = .FALSE. ! ztilde vertical coordinate 51 LOGICAL , PUBLIC :: ln_vvl_kepe = .FALSE. ! kinetic/potential energy transfer 52 ! ! conservation: not used yet 53 53 REAL(wp) :: rn_ahe3 ! thickness diffusion coefficient 54 54 REAL(wp) :: rn_rst_e3t ! ztilde to zstar restoration timescale [days] 55 55 REAL(wp) :: rn_lf_cutoff ! cutoff frequency for low-pass filter [days] 56 56 REAL(wp) :: rn_zdef_max ! maximum fractional e3t deformation 57 LOGICAL , PUBLIC :: ln_vvl_dbg 57 LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE. ! debug control prints 58 58 59 59 !! * Module variables … … 169 169 fsdept_b(:,:,1) = 0.5_wp * fse3w_b(:,:,1) 170 170 fsdepw_b(:,:,1) = 0.0_wp 171 DO jk = 2, jpk 172 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 173 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 174 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 175 fsdept_b(:,:,jk) = fsdept_b(:,:,jk-1) + fse3w_b(:,:,jk) 176 fsdepw_b(:,:,jk) = fsdepw_b(:,:,jk-1) + fse3t_b(:,:,jk-1) 171 DO jj = 1,jpj 172 DO ji = 1,jpi 173 DO jk = 2,mikt(ji,jj)-1 174 fsdept_n(ji,jj,jk) = gdept_0(ji,jj,jk) 175 fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 176 fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj) 177 fsdept_b(ji,jj,jk) = gdept_0(ji,jj,jk) 178 fsdepw_b(ji,jj,jk) = gdepw_0(ji,jj,jk) 179 END DO 180 IF (mikt(ji,jj) .GT. 1) THEN 181 jk = mikt(ji,jj) 182 fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk) 183 fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 184 fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk ) - sshn (ji,jj) 185 fsdept_b(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_b(ji,jj,jk) 186 fsdepw_b(ji,jj,jk) = gdepw_0(ji,jj,jk) 187 END IF 188 DO jk = mikt(ji,jj)+1, jpk 189 fsdept_n(ji,jj,jk) = fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk) 190 fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 191 fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk ) - sshn (ji,jj) 192 fsdept_b(ji,jj,jk) = fsdept_b(ji,jj,jk-1) + fse3w_b(ji,jj,jk) 193 fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1) 194 END DO 195 END DO 177 196 END DO 178 197 … … 185 204 hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 186 205 END DO 187 hur_b(:,:) = umask (:,:,1) / ( hu_b(:,:) + 1. - umask(:,:,1) )188 hvr_b(:,:) = vmask (:,:,1) / ( hv_b(:,:) + 1. - vmask(:,:,1) )206 hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1. - umask_i(:,:) ) 207 hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1. - vmask_i(:,:) ) 189 208 190 209 ! Restoring frequencies for z_tilde coordinate … … 293 312 ! ! --------------------------------------------- ! 294 313 295 z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * tmask(:,:,1) / ( ht_0(:,:) + sshn(:,:) + 1. - tmask(:,:,1) )314 z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 296 315 DO jk = 1, jpkm1 297 316 ! formally this is the same as fse3t_a = e3t_0*(1+ssha/ht_0) … … 313 332 zht (:,:) = zht (:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 314 333 END DO 315 zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask (:,:,1) )334 zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) 316 335 317 336 ! 2 - Low frequency baroclinic horizontal divergence (z-tilde case only) … … 338 357 ELSE ! layer case 339 358 DO jk = 1, jpkm1 340 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) 359 tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 341 360 END DO 342 361 END IF … … 386 405 ! d - thickness diffusion transport: boundary conditions 387 406 ! (stored for tracer advction and continuity equation) 388 CALL lbc_lnk( un_td , 'U' , -1. )389 CALL lbc_lnk( vn_td , 'V' , -1. )407 CALL lbc_lnk( un_td , 'U' , -1._wp) 408 CALL lbc_lnk( vn_td , 'V' , -1._wp) 390 409 391 410 ! 4 - Time stepping of baroclinic scale factors … … 398 417 z2dt = 2.0_wp * rdt 399 418 ENDIF 400 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1. )419 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 401 420 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 402 421 … … 453 472 zht(:,:) = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 454 473 END DO 455 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - tmask(:,:,1) )474 z_scale(:,:) = - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 456 475 DO jk = 1, jpkm1 457 476 dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) … … 463 482 ! ! ---baroclinic part--------- ! 464 483 DO jk = 1, jpkm1 465 fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) 484 fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 466 485 END DO 467 486 ENDIF … … 531 550 END DO 532 551 ! ! Inverse of the local depth 533 hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask (:,:,1) ) * umask(:,:,1)534 hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask (:,:,1) ) * vmask(:,:,1)552 hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 553 hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 535 554 536 555 CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) … … 570 589 !! * Local declarations 571 590 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_e3t_def 572 INTEGER :: j k ! dummy loop indices591 INTEGER :: ji,jj,jk ! dummy loop indices 573 592 !!---------------------------------------------------------------------- 574 593 … … 622 641 fsdepw_n(:,:,1) = 0.0_wp 623 642 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 624 DO jk = 2, jpk 625 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 626 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 627 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 643 DO jj = 1,jpj 644 DO ji = 1,jpi 645 DO jk = 2,mikt(ji,jj)-1 646 fsdept_n(ji,jj,jk) = gdept_0(ji,jj,jk) 647 fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 648 fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj) 649 END DO 650 IF (mikt(ji,jj) .GT. 1) THEN 651 jk = mikt(ji,jj) 652 fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk) 653 fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 654 fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk ) - sshn (ji,jj) 655 END IF 656 DO jk = mikt(ji,jj)+1, jpk 657 fsdept_n(ji,jj,jk) = fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk) 658 fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 659 fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk ) - sshn (ji,jj) 660 END DO 661 END DO 628 662 END DO 629 663 ! Local depth and Inverse of the local depth of the water column at u- and v- points … … 702 736 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 703 737 ! boundary conditions 704 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. )738 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 705 739 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 706 740 ! ! ------------------------------------- ! … … 720 754 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 721 755 ! boundary conditions 722 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. )756 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 723 757 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 724 758 ! ! ------------------------------------- ! … … 738 772 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 739 773 ! boundary conditions 740 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1. )774 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 741 775 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 742 776 ! ! ------------------------------------- ! … … 808 842 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 809 843 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 810 id5 = iom_varid( numror, 'hdi f_lf', ldstop = .FALSE. )844 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 811 845 ! ! --------- ! 812 846 ! ! all cases ! … … 815 849 CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 816 850 CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) ) 851 ! needed to restart if land processor not computed 852 IF(lwp) write(numout,*) 'dom_vvl_rst : fse3t_b and fse3t_n found in restart files' 853 WHERE ( tmask(:,:,:) == 0.0_wp ) 854 fse3t_n(:,:,:) = e3t_0(:,:,:) 855 fse3t_b(:,:,:) = e3t_0(:,:,:) 856 END WHERE 817 857 IF( neuler == 0 ) THEN 818 858 fse3t_b(:,:,:) = fse3t_n(:,:,:) 819 859 ENDIF 820 860 ELSE IF( id1 > 0 ) THEN 861 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_n not found in restart files' 862 IF(lwp) write(numout,*) 'fse3t_n set equal to fse3t_b.' 863 IF(lwp) write(numout,*) 'neuler is forced to 0' 864 CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 865 fse3t_n(:,:,:) = fse3t_b(:,:,:) 866 neuler = 0 867 ELSE IF( id2 > 0 ) THEN 821 868 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_b not found in restart files' 822 869 IF(lwp) write(numout,*) 'fse3t_b set equal to fse3t_n.' 823 870 IF(lwp) write(numout,*) 'neuler is forced to 0' 871 CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) ) 824 872 fse3t_b(:,:,:) = fse3t_n(:,:,:) 825 873 neuler = 0 … … 830 878 DO jk=1,jpk 831 879 fse3t_n(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & 832 & / ( ht_0(:,:) + 1._wp - tmask(:,:,1) ) * tmask(:,:,jk) &880 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 833 881 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 834 882 END DO … … 964 1012 965 1013 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' ) 1014 IF( .NOT. ln_vvl_zstar .AND. nn_isf .NE. 0) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' ) 966 1015 967 1016 IF(lwp) THEN ! Print the choice
Note: See TracChangeset
for help on using the changeset viewer.