Changeset 3896
- Timestamp:
- 2013-05-02T14:40:43+02:00 (11 years ago)
- Location:
- branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO
- Files:
-
- 5 edited
-
LIM_SRC_2/limsbc_2.F90 (modified) (4 diffs)
-
OPA_SRC/DOM/domvvl.F90 (modified) (21 diffs)
-
OPA_SRC/DYN/dynvor.F90 (modified) (3 diffs)
-
OPA_SRC/DYN/sshwzv.F90 (modified) (1 diff)
-
OPA_SRC/IOM/restart.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r3625 r3896 24 24 USE phycst ! physical constants 25 25 USE dom_oce ! ocean domain 26 USE domvvl ! ocean vertical scale factors 26 27 USE dom_ice_2 ! LIM-2: ice domain 27 28 USE ice_2 ! LIM-2: ice variables … … 59 60 !! * Substitutions 60 61 # include "vectopt_loop_substitute.h90" 62 # include "domzgr_substitute.h90" 61 63 !!---------------------------------------------------------------------- 62 64 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) … … 444 446 !!------------------------------------------------------------------- 445 447 ! 448 INTEGER :: jk ! local integer 449 ! 446 450 IF(lwp) WRITE(numout,*) 447 451 IF(lwp) WRITE(numout,*) 'lim_sbc_init_2 : LIM-2 sea-ice - surface boundary condition' … … 475 479 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 476 480 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 481 do jk = 1,jpkm1 ! adjust initial vertical scale factors 482 fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 483 fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 484 end do 485 fse3t_a(:,:,:) = fse3t_b(:,:,:) 486 ! Reconstruction of all vertical scale factors at now and before time steps 487 ! ============================================================================= 488 ! Horizontal scale factor interpolations 489 ! -------------------------------------- 490 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 491 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 492 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 493 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 494 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 495 ! Vertical scale factor interpolations 496 ! ------------------------------------ 497 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' ) 498 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 499 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 500 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 501 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 502 ! t- and w- points depth 503 ! ---------------------- 504 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 505 fsdepw_n(:,:,1) = 0.0_wp 506 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 507 DO jk = 2, jpk 508 fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 509 fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 510 fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:) 511 END DO 477 512 ENDIF 478 513 ! -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r3890 r3896 85 85 IF( lk_mpp ) CALL mpp_sum ( dom_vvl_alloc ) 86 86 IF( dom_vvl_alloc /= 0 ) CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 87 un_td = 0.0_wp 88 vn_td = 0.0_wp 87 89 ENDIF 88 90 IF( ln_vvl_ztilde ) THEN … … 158 160 ! t- and w- points depth 159 161 ! ---------------------- 160 fsdept_n(:,:,1) = 0.5 * fse3w_n(:,:,1)161 fsdepw_n(:,:,1) = 0. e0162 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 163 fsdepw_n(:,:,1) = 0.0_wp 162 164 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 163 165 DO jk = 2, jpk … … 168 170 ! Reference water column height at t-, u- and v- point 169 171 ! ---------------------------------------------------- 170 ht_0(:,:) = 0. e0171 hu_0(:,:) = 0. e0172 hv_0(:,:) = 0. e0172 ht_0(:,:) = 0.0_wp 173 hu_0(:,:) = 0.0_wp 174 hv_0(:,:) = 0.0_wp 173 175 DO jk = 1, jpk 174 176 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) … … 181 183 IF( ln_vvl_ztilde ) THEN 182 184 ! Values in days provided via the namelist; use rsmall to avoid possible division by zero errors with faulty settings 183 frq_rst_e3t(:,:) = 2. e0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp )184 frq_rst_hdv(:,:) = 2. e0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp )185 frq_rst_e3t(:,:) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.0_wp ) 186 frq_rst_hdv(:,:) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 185 187 IF( ln_vvl_ztilde_as_zstar ) THEN 186 188 ! Ignore namelist settings and use these next two to emulate z-star using z-tilde 187 frq_rst_e3t(:,:) = 0. e0_wp188 frq_rst_hdv(:,:) = 1. e0_wp / rdt189 frq_rst_e3t(:,:) = 0.0_wp 190 frq_rst_hdv(:,:) = 1.0_wp / rdt 189 191 ENDIF 190 192 ENDIF … … 304 306 ! 3 - Thickness diffusion term 305 307 ! ---------------------------- 306 zwu(:,:) = 0. e0307 zwv(:,:) = 0. e0308 zwu(:,:) = 0.0_wp 309 zwv(:,:) = 0.0_wp 308 310 ! a - first derivative: diffusive fluxes 309 311 DO jk = 1, jpkm1 … … 346 348 z2dt = rdt 347 349 ELSE 348 z2dt = 2. e0* rdt350 z2dt = 2.0_wp * rdt 349 351 ENDIF 350 352 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1. ) … … 353 355 ! Maximum deformation control 354 356 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 355 ze3t(:,:,jpk) = 0. e0357 ze3t(:,:,jpk) = 0.0_wp 356 358 DO jk = 1, jpkm1 357 359 ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) … … 421 423 END IF 422 424 ! 423 zht(:,:) = 0. e0425 zht(:,:) = 0.0_wp 424 426 DO jk = 1, jpkm1 425 427 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) … … 427 429 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 428 430 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 429 IF( lwp ) WRITE(numout, *) 'MAXVAL(abs(ht_0+sshn-SUM(fse3t_n))) =', z_tmax430 ! 431 zht(:,:) = 0. e0431 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(fse3t_n))) =', z_tmax 432 ! 433 zht(:,:) = 0.0_wp 432 434 DO jk = 1, jpkm1 433 435 zht(:,:) = zht(:,:) + fse3t_a(:,:,jk) * tmask(:,:,jk) … … 435 437 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 436 438 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 437 IF( lwp ) WRITE(numout, *) 'MAXVAL(abs(ht_0+ssha-SUM(fse3t_a))) =', z_tmax 438 ! 439 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(fse3t_a))) =', z_tmax 440 ! 441 zht(:,:) = 0.0_wp 442 DO jk = 1, jpkm1 443 zht(:,:) = zht(:,:) + fse3t_b(:,:,jk) * tmask(:,:,jk) 444 END DO 445 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 446 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 447 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(fse3t_b))) =', z_tmax 448 ! 449 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshb(:,:) ) ) 450 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 451 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax 452 ! 453 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshn(:,:) ) ) 454 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 455 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax 456 ! 457 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssha(:,:) ) ) 458 IF( lk_mpp ) CALL mpp_max( z_tmax ) ! max over the global domain 459 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax 439 460 END IF 440 461 … … 502 523 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 503 524 ELSE 504 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) + atfp * ( tilde_e3t_b(:,:,:) - 2. e0* tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) )525 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 505 526 ENDIF 506 527 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) … … 525 546 ! t- and w- points depth 526 547 ! ---------------------- 527 fsdept_n(:,:,1) = 0.5 * fse3w_n(:,:,1)528 fsdepw_n(:,:,1) = 0. e0548 fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1) 549 fsdepw_n(:,:,1) = 0.0_wp 529 550 fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 530 551 DO jk = 2, jpk … … 595 616 DO jj = 1, jpjm1 596 617 DO ji = 1, fs_jpim1 ! vector opt. 597 pe3_out(ji,jj,jk) = 0.5 * umask(ji,jj,jk) * r1_e12u(ji,jj) &598 & * ( e12t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &599 & + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )618 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj) & 619 & * ( e12t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 620 & + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 600 621 END DO 601 622 END DO … … 613 634 DO jj = 1, jpjm1 614 635 DO ji = 1, fs_jpim1 ! vector opt. 615 pe3_out(ji,jj,jk) = 0.5 * vmask(ji,jj,jk) * r1_e12v(ji,jj) &616 & * ( e12t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &617 & + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )636 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj) & 637 & * ( e12t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 638 & + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 618 639 END DO 619 640 END DO … … 631 652 DO jj = 1, jpjm1 632 653 DO ji = 1, fs_jpim1 ! vector opt. 633 pe3_out(ji,jj,jk) = 0.5 * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj) &634 & * ( e12u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) &635 & + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )654 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj) & 655 & * ( e12u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 656 & + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 636 657 END DO 637 658 END DO … … 649 670 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 650 671 DO jk = 2, jpk 651 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1. - 0.5* tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) &652 & + 0.5* tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) )672 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 673 & + 0.5_wp * tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 653 674 END DO 654 675 ! ! -------------------------------------- ! … … 659 680 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 660 681 DO jk = 2, jpk 661 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1. - 0.5* umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) &662 & + 0.5* umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) )682 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 683 & + 0.5_wp * umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 663 684 END DO 664 685 ! ! -------------------------------------- ! … … 669 690 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 670 691 DO jk = 2, jpk 671 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1. - 0.5* vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) &672 & + 0.5* vmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) )692 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & 693 & + 0.5_wp * vmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 673 694 END DO 674 695 END SELECT … … 733 754 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 734 755 ELSE ! one at least array is missing 735 tilde_e3t_b(:,:,:) = 0. e0736 tilde_e3t_n(:,:,:) = 0. e0756 tilde_e3t_b(:,:,:) = 0.0_wp 757 tilde_e3t_n(:,:,:) = 0.0_wp 737 758 ENDIF 738 759 ! ! ------------ ! … … 742 763 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) ) 743 764 ELSE ! array is missing 744 hdiv_lf(:,:,:) = 0. e0765 hdiv_lf(:,:,:) = 0.0_wp 745 766 ENDIF 746 767 ENDIF … … 751 772 fse3t_n(:,:,:) = e3t_0(:,:,:) 752 773 IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 753 tilde_e3t_b(:,:,:) = 0. e0754 tilde_e3t_n(:,:,:) = 0. e0755 IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0. e0774 tilde_e3t_b(:,:,:) = 0.0_wp 775 tilde_e3t_n(:,:,:) = 0.0_wp 776 IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0.0_wp 756 777 END IF 757 778 ENDIF -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r3802 r3896 572 572 INTEGER :: ierr ! local integer 573 573 REAL(wp) :: zfac12, zua, zva ! local scalars 574 REAL(wp) :: zmsk, ze3 ! local scalars 574 575 ! ! 3D workspace 575 576 REAL(wp), POINTER , DIMENSION(:,: ) :: zwx, zwy, zwz … … 577 578 #if defined key_vvl 578 579 REAL(wp), POINTER , DIMENSION(:,:,:) :: ze3f ! 3D workspace (lk_vvl=T) 579 #endif 580 #if ! defined key_vvl 580 #else 581 581 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ze3f ! lk_vvl=F, ze3f=1/e3f saved one for all 582 582 #endif … … 604 604 ENDIF 605 605 606 IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t )606 IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points) 607 607 DO jk = 1, jpk 608 608 DO jj = 1, jpjm1 609 609 DO ji = 1, jpim1 610 ze3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 611 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) * 0.25 612 IF( ze3f(ji,jj,jk) /= 0._wp ) ze3f(ji,jj,jk) = 1._wp / ze3f(ji,jj,jk) 610 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 611 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 612 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 613 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 614 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3 613 615 END DO 614 616 END DO -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r3865 r3896 110 110 ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used 111 111 ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp 112 z1_rau0 = 0.5 /rau0112 z1_rau0 = 0.5_wp * r1_rau0 113 113 ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask(:,:,1) 114 114 -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r3890 r3896 23 23 USE eosbn2 ! equation of state (eos bn2 routine) 24 24 USE trdmld_oce ! ocean active mixed layer tracers trends variables 25 USE domvvl ! variable volume26 25 USE divcur ! hor. divergence and curl (div & cur routines) 27 26
Note: See TracChangeset
for help on using the changeset viewer.
