- Timestamp:
- 2015-12-16T10:25:22+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5836 r6060 34 34 35 35 !! * Substitutions 36 # include "domzgr_substitute.h90"37 36 # include "vectopt_loop_substitute.h90" 38 37 !!---------------------------------------------------------------------- … … 76 75 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 77 76 ! 77 !!gm BUG if scale factor reduction !!!! 78 78 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 79 79 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ; r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) … … 84 84 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 85 85 ! 86 hu (:,:) = 0._wp! Ocean depth at U- and V-points87 hv (:,:) = 0._wp88 DO jk = 1, jpk89 hu (:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)90 hv (:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)86 hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1) ! Ocean depth at U- and V-points 87 hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 88 DO jk = 2, jpk 89 hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 90 hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 91 91 END DO 92 92 ! ! Inverse of the local depth 93 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)94 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)93 r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 94 r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 95 95 ! 96 96 CALL dom_stp ! Time step … … 554 554 CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw ) 555 555 556 CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) ! scale factors557 CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )558 CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )559 CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) )556 CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_n(:,:,:) ) ! scale factors 557 CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_n(:,:,:) ) 558 CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_n(:,:,:) ) 559 CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_n(:,:,:) ) 560 560 561 561 CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth … … 571 571 ! 572 572 IF( nmsh <= 6 ) THEN ! 3D vertical scale factors 573 CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) )574 CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )575 CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )576 CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) )573 CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_n(:,:,:) ) 574 CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_n(:,:,:) ) 575 CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_n(:,:,:) ) 576 CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_n(:,:,:) ) 577 577 ELSE ! 2D bottom scale factors 578 578 CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp ) … … 580 580 ! ! deduces the 3D scale factors 581 581 DO jk = 1, jpk 582 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors583 fse3u_n(:,:,jk) = e3t_1d(jk)584 fse3v_n(:,:,jk) = e3t_1d(jk)585 fse3w_n(:,:,jk) = e3w_1d(jk)582 e3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors 583 e3u_n(:,:,jk) = e3t_1d(jk) 584 e3v_n(:,:,jk) = e3t_1d(jk) 585 e3w_n(:,:,jk) = e3w_1d(jk) 586 586 END DO 587 587 DO jj = 1,jpj ! adjust the deepest values 588 588 DO ji = 1,jpi 589 589 ik = mbkt(ji,jj) 590 fse3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) )591 fse3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) )590 e3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 591 e3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 592 592 END DO 593 593 END DO … … 595 595 DO jj = 1, jpjm1 596 596 DO ji = 1, jpim1 597 fse3u_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji+1,jj,jk) )598 fse3v_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji,jj+1,jk) )597 e3u_n(ji,jj,jk) = MIN( e3t_n(ji,jj,jk), e3t_n(ji+1,jj,jk) ) 598 e3v_n(ji,jj,jk) = MIN( e3t_n(ji,jj,jk), e3t_n(ji,jj+1,jk) ) 599 599 END DO 600 600 END DO 601 601 END DO 602 CALL lbc_lnk( fse3u_n(:,:,:) , 'U', 1._wp ) ; CALL lbc_lnk( fse3uw_n(:,:,:), 'U', 1._wp ) ! lateral boundary conditions603 CALL lbc_lnk( fse3v_n(:,:,:) , 'V', 1._wp ) ; CALL lbc_lnk( fse3vw_n(:,:,:), 'V', 1._wp )602 CALL lbc_lnk( e3u_n(:,:,:) , 'U', 1._wp ) ; CALL lbc_lnk( e3uw_n(:,:,:), 'U', 1._wp ) ! lateral boundary conditions 603 CALL lbc_lnk( e3v_n(:,:,:) , 'V', 1._wp ) ; CALL lbc_lnk( e3vw_n(:,:,:), 'V', 1._wp ) 604 604 ! 605 605 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) 606 WHERE( fse3u_n(:,:,jk) == 0._wp ) fse3u_n(:,:,jk) = e3t_1d(jk)607 WHERE( fse3v_n(:,:,jk) == 0._wp ) fse3v_n(:,:,jk) = e3t_1d(jk)606 WHERE( e3u_n(:,:,jk) == 0._wp ) e3u_n(:,:,jk) = e3t_1d(jk) 607 WHERE( e3v_n(:,:,jk) == 0._wp ) e3v_n(:,:,jk) = e3t_1d(jk) 608 608 END DO 609 609 END IF 610 610 611 611 IF( iom_varid( inum4, 'gdept_0', ldstop = .FALSE. ) > 0 ) THEN ! 3D depth of t- and w-level 612 CALL iom_get( inum4, jpdom_data, 'gdept_0', fsdept_n(:,:,:) )613 CALL iom_get( inum4, jpdom_data, 'gdepw_0', fsdepw_n(:,:,:) )612 CALL iom_get( inum4, jpdom_data, 'gdept_0', gdept_n(:,:,:) ) 613 CALL iom_get( inum4, jpdom_data, 'gdepw_0', gdepw_n(:,:,:) ) 614 614 ELSE ! 2D bottom depth 615 615 CALL iom_get( inum4, jpdom_data, 'hdept', zprt ) … … 617 617 ! 618 618 DO jk = 1, jpk ! deduces the 3D depth 619 fsdept_n(:,:,jk) = gdept_1d(jk)620 fsdepw_n(:,:,jk) = gdepw_1d(jk)619 gdept_n(:,:,jk) = gdept_1d(jk) 620 gdepw_n(:,:,jk) = gdepw_1d(jk) 621 621 END DO 622 622 DO jj = 1, jpj … … 624 624 ik = mbkt(ji,jj) 625 625 IF( ik > 0 ) THEN 626 fsdepw_n(ji,jj,ik+1) = zprw(ji,jj)627 fsdept_n(ji,jj,ik ) = zprt(ji,jj)628 fsdept_n(ji,jj,ik+1) = fsdept_n(ji,jj,ik) + fse3t_n(ji,jj,ik)626 gdepw_n(ji,jj,ik+1) = zprw(ji,jj) 627 gdept_n(ji,jj,ik ) = zprt(ji,jj) 628 gdept_n(ji,jj,ik+1) = gdept_n(ji,jj,ik) + e3t_n(ji,jj,ik) 629 629 ENDIF 630 630 END DO … … 640 640 CALL iom_get( inum4, jpdom_unknown, 'e3w_1d' , e3w_1d ) 641 641 DO jk = 1, jpk 642 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors643 fse3u_n(:,:,jk) = e3t_1d(jk)644 fse3v_n(:,:,jk) = e3t_1d(jk)645 fse3w_n(:,:,jk) = e3w_1d(jk)646 fsdept_n(:,:,jk) = gdept_1d(jk)647 fsdepw_n(:,:,jk) = gdepw_1d(jk)642 e3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors 643 e3u_n(:,:,jk) = e3t_1d(jk) 644 e3v_n(:,:,jk) = e3t_1d(jk) 645 e3w_n(:,:,jk) = e3w_1d(jk) 646 gdept_n(:,:,jk) = gdept_1d(jk) 647 gdepw_n(:,:,jk) = gdepw_1d(jk) 648 648 END DO 649 649 ENDIF … … 677 677 & e2t (1,jj), e2u (1,jj), & 678 678 & e2v (1,jj), jj = 1, jpj, 10 ) 679 ENDIF680 681 682 IF( nprint == 1 .AND. lwp ) THEN683 WRITE(numout,*) ' e1u e2u '684 CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )685 CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )686 WRITE(numout,*) ' e1v e2v '687 CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )688 CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )689 679 ENDIF 690 680 … … 836 826 END DO 837 827 ! 838 IF( nprint == 1 .AND. lwp ) THEN ! Control print839 imsk(:,:) = INT( tmask_i(:,:) )840 WRITE(numout,*) ' tmask_i : '841 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)842 WRITE (numout,*)843 WRITE (numout,*) ' dommsk: tmask for each level'844 WRITE (numout,*) ' ----------------------------'845 DO jk = 1, jpk846 imsk(:,:) = INT( tmask(:,:,jk) )847 WRITE(numout,*)848 WRITE(numout,*) ' level = ',jk849 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)850 END DO851 ENDIF852 !853 828 CALL wrk_dealloc( jpi, jpj, imsk ) 854 829 !
Note: See TracChangeset
for help on using the changeset viewer.
