- Timestamp:
- 2010-10-29T15:25:31+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r2287 r2344 9 9 !! NEMO 0.5 ! 2002-10 (G. Madec) Free form, F90 10 10 !! 1.0 ! 2005-10 (A. Beckmann) correction for s-coordinates 11 !! 3.3 ! 2006-10 (C. Harris, G. Nurser) add ldf_slp_grif (Griffies operator) 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_ldfslp || defined key_esopa … … 34 35 PUBLIC ldf_slp ! routine called by step.F90 35 36 PUBLIC ldf_slp_init ! routine called by opa.F90 36 PUBLIC ldf_slp_grif ! "37 PUBLIC ldf_slp_grif ! routine called by step.F90 37 38 38 39 LOGICAL , PUBLIC, PARAMETER :: lk_ldfslp = .TRUE. !: slopes flag … … 57 58 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 58 59 !! $Id$ 59 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)60 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 60 61 !!---------------------------------------------------------------------- 61 62 62 CONTAINS 63 63 … … 348 348 END SUBROUTINE ldf_slp 349 349 350 350 351 SUBROUTINE ldf_slp_grif ( kt ) 351 352 !!---------------------------------------------------------------------- … … 364 365 !! ** Action : - alpha, beta 365 366 !! wslp2 squared slope of neutral surfaces at w-points. 367 !!---------------------------------------------------------------------- 368 USE oce, zdit => ua ! use ua as workspace 369 USE oce, zdis => va ! use va as workspace 370 USE oce, zdjt => ta ! use ta as workspace 371 USE oce, zdjs => sa ! use sa as workspace 366 372 !! 367 !! History :368 !! 9.0 ! 06-10 (C. Harris) New subroutine369 !!----------------------------------------------------------------------370 !! * Modules used371 USE oce , zdit => ua, & ! use ua as workspace372 zdis => va, & ! use va as workspace373 zdjt => ta, & ! use ta as workspace374 zdjs => sa ! use sa as workspace375 !! * Arguments376 373 INTEGER, INTENT( in ) :: kt ! ocean time-step index 377 378 !! * Local declarations 374 !! 379 375 INTEGER :: ji, jj, jk, ip, jp, kp ! dummy loop indices 380 INTEGER :: iku, ikv ! temporary integer 381 REAL(wp) :: & 382 zt, zs, zh, zt2, zsp5, zp1t1, & ! temporary scalars 383 zdenr, zrhotmp, zdndt, zdddt, & ! " " 384 zdnds, zddds, znum, zden, & ! " " 385 zslope, za_sxe, zslopec, zdsloper,& ! " " 386 zfact, zepsln, zatempw,zatempu,zatempv, & ! " " 387 ze1ur,ze2vr,ze3wr,zdxt,zdxs,zdyt,zdys,zdzt,zdzs,zvolf,& 388 zr_slpmax,zdxrho,zdyrho,zabs_dzrho 389 REAL(wp), DIMENSION(jpi,jpj,jpk,0:1,0:1) :: & 390 zsx,zsy 391 REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) :: & 392 zsx_ml_base,zsy_ml_base 393 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 394 zdkt,zdks 395 REAL(wp), DIMENSION(jpi,jpj) :: & 396 zr_ml_basew 376 INTEGER :: iku, ikv ! local integer 377 REAL(wp) :: zt, zs, zh, zt2, zsp5, zp1t1 ! local scalars 378 REAL(wp) :: zdenr, zrhotmp, zdndt, zdddt ! - - 379 REAL(wp) :: zdnds, zddds, znum, zden ! - - 380 REAL(wp) :: zslope, za_sxe, zslopec, zdsloper ! - - 381 REAL(wp) :: zfact, zepsln, zatempw,zatempu,zatempv ! - - 382 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdxs, zdyt, zdys, zdzt, zdzs, zvolf 383 REAL(wp) :: zr_slpmax, zdxrho, zdyrho, zabs_dzrho 384 REAL(wp), DIMENSION(jpi,jpj,jpk,0:1,0:1) :: zsx,zsy 385 REAL(wp), DIMENSION(jpi,jpj ,0:1,0:1) :: zsx_ml_base, zsy_ml_base 386 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdkt, zdks 387 REAL(wp), DIMENSION(jpi,jpj) :: zr_ml_basew 397 388 !!---------------------------------------------------------------------- 398 389 … … 444 435 & + 0.380374e-04 ) * zh) 445 436 446 END DO447 END DO448 END DO437 END DO 438 END DO 439 END DO 449 440 450 441 CASE ( 1 ) … … 521 512 522 513 IF( ln_zps ) THEN ! partial steps correction at the last level 523 # if defined key_vectopt_loop && ! defined key_mpp_omp524 jj =1514 # if defined key_vectopt_loop 515 DO jj = 1, 1 525 516 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 526 517 # else … … 537 528 zdjt (ji,jj,ikv) = gtsv(ji,jj,jp_tem) 538 529 zdjs (ji,jj,ikv) = gtsv(ji,jj,jp_sal) 539 # if ! defined key_vectopt_loop || defined key_mpp_omp540 530 END DO 541 # endif542 531 END DO 543 532 ENDIF … … 733 722 DO jp=0,1 734 723 DO kp=0,1 735 736 724 DO jk = 1, jpkm1 737 738 725 DO jj = 1, jpjm1 739 740 726 DO ji = 1, fs_jpim1 ! vector opt. 741 727 ! k index of uppermost point(s) of triad is jk+kp-1 … … 744 730 zfact = 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp)) 745 731 zsy(ji,jj+jp,jk,1-jp,kp) = zfact*zsy(ji,jj+jp,jk,1-jp,kp) + & 746 732 & (1.0_wp-zfact)*(fsdepw(ji,jj+jp,jk+kp)*zr_ml_basew(ji,jj+jp))*zsy_ml_base(ji,jj+jp,1-jp,kp) 747 733 END DO 748 734 … … 756 742 DO jp=0,1 757 743 DO kp=0,1 758 759 744 DO jk = 1, jpkm1 760 761 745 DO jj = 1, jpjm1 762 763 746 DO ji = 1, fs_jpim1 ! vector opt. 764 747 … … 786 769 END DO 787 770 END DO 788 789 771 END DO 790 772 END DO 791 773 END DO 792 774 793 tfw(:,:,1)=0. 0794 sfw(:,:,1)=0. 0795 wslp2(:,:,1)=0. 0775 tfw(:,:,1)=0.e0 776 sfw(:,:,1)=0.e0 777 wslp2(:,:,1)=0.e0 796 778 797 779 CALL lbc_lnk( wslp2, 'W', 1. ) … … 808 790 CALL lbc_lnk( psix_eiv, 'U', -1. ) 809 791 CALL lbc_lnk( psiy_eiv, 'V', -1. ) 810 811 812 END SUBROUTINE ldf_slp_grif 792 ! 793 END SUBROUTINE ldf_slp_grif 813 794 814 795
Note: See TracChangeset
for help on using the changeset viewer.
