Changeset 789 for trunk/NEMO/OPA_SRC/DYN
- Timestamp:
- 2008-01-11T19:04:56+01:00 (17 years ago)
- Location:
- trunk/NEMO/OPA_SRC/DYN
- Files:
-
- 5 deleted
- 9 edited
-
dynhpg.F90 (modified) (5 diffs)
-
dynhpg_jki.F90 (deleted)
-
dynspg.F90 (modified) (5 diffs)
-
dynspg_exp.F90 (modified) (1 diff)
-
dynspg_exp_jki.F90 (deleted)
-
dynspg_flt.F90 (modified) (1 diff)
-
dynspg_flt_jki.F90 (deleted)
-
dynspg_ts.F90 (modified) (1 diff)
-
dynspg_ts_jki.F90 (deleted)
-
dynvor.F90 (modified) (4 diffs)
-
dynzad.F90 (modified) (3 diffs)
-
dynzdf.F90 (modified) (6 diffs)
-
dynzdf_imp_jki.F90 (deleted)
-
wzvmod.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DYN/dynhpg.F90
r719 r789 18 18 !! dyn_hpg : update the momentum trend with the now horizontal 19 19 !! gradient of the hydrostatic pressure 20 !! default case : k-j-i loops (vector opt. available)21 20 !! hpg_ctl : initialisation and control of options 22 21 !! hpg_zco : z-coordinate scheme … … 30 29 USE oce ! ocean dynamics and tracers 31 30 USE dom_oce ! ocean space and time domain 32 USE dynhpg_jki !33 31 USE phycst ! physical constants 34 32 USE in_out_manager ! I/O manager … … 42 40 43 41 PUBLIC dyn_hpg ! routine called by step module 44 45 #if defined key_mpp_omp46 !!----------------------------------------------------------------------47 !! 'key_mpp_omp' : j-k-i loop (j-slab)48 !!----------------------------------------------------------------------49 LOGICAL, PUBLIC, PARAMETER :: lk_dynhpg_jki = .TRUE. !: OpenMP hpg flag50 LOGICAL, PUBLIC, PARAMETER :: lk_dynhpg = .FALSE. !: vector hpg flag51 #else52 !!----------------------------------------------------------------------53 !! default case : k-j-i loop (vector opt.)54 !!----------------------------------------------------------------------55 LOGICAL, PUBLIC, PARAMETER :: lk_dynhpg_jki = .FALSE. !: OpenMP hpg flag56 LOGICAL, PUBLIC, PARAMETER :: lk_dynhpg = .TRUE. !: vector hpg flag57 #endif58 42 59 43 !!* Namelist nam_dynhpg : Choice of horizontal pressure gradient computation … … 111 95 CASE ( 5 ) ; CALL hpg_djc ( kt ) ! s-coordinate (Density Jacobian with Cubic polynomial) 112 96 CASE ( 6 ) ; CALL hpg_rot ( kt ) ! s-coordinate (ROTated axes scheme) 113 CASE ( 10 ) ; CALL hpg_zco_jki( kt ) ! z-coordinate (k-j-i)114 CASE ( 11 ) ; CALL hpg_zps_jki( kt ) ! z-coordinate plus partial steps (interpolation) (k-j-i)115 CASE ( 12 ) ; CALL hpg_sco_jki( kt ) ! s-coordinate (standard jacobian formulation) (k-j-i)116 97 END SELECT 117 98 … … 186 167 IF ( ioptio /= 1 ) CALL ctl_stop( ' NO or several hydrostatic pressure gradient options used' ) 187 168 188 IF( lk_dynhpg_jki ) THEN189 nhpg = nhpg + 10190 IF(lwp) WRITE(numout,*)191 IF(lwp) WRITE(numout,*) ' Autotasking or OPENMP: use j-k-i loops (i.e. _jki routines)'192 ENDIF193 169 ! 194 170 END SUBROUTINE hpg_ctl -
trunk/NEMO/OPA_SRC/DYN/dynspg.F90
r719 r789 20 20 USE dynspg_flt ! surface pressure gradient (dyn_spg_flt routine) 21 21 USE dynspg_rl ! surface pressure gradient (dyn_spg_rl routine) 22 USE dynspg_exp_jki ! surface pressure gradient (dyn_spg_exp_jki routine)23 USE dynspg_ts_jki ! surface pressure gradient (dyn_spg_ts_jki routine)24 USE dynspg_flt_jki ! surface pressure gradient (dyn_spg_flt_jki routine)25 22 USE trdmod ! ocean dynamics trends 26 23 USE trdmod_oce ! ocean variables trends … … 68 65 69 66 SELECT CASE ( nspg ) ! compute surf. pressure gradient trend and add it to the general trend 70 ! ! k-j-i loops67 ! 71 68 CASE ( 0 ) ; CALL dyn_spg_exp ( kt ) ! explicit 72 69 CASE ( 1 ) ; CALL dyn_spg_ts ( kt ) ! time-splitting 73 70 CASE ( 2 ) ; CALL dyn_spg_flt ( kt, kindic ) ! filtered 74 71 CASE ( 3 ) ; CALL dyn_spg_rl ( kt, kindic ) ! rigid lid 75 ! ! j-k-i loops 76 CASE ( 10 ) ; CALL dyn_spg_exp_jki( kt ) ! explicit with j-k-i loop 77 CASE ( 11 ) ; CALL dyn_spg_ts_jki ( kt ) ! time-splitting with j-k-i loop 78 CASE ( 12 ) ; CALL dyn_spg_flt_jki( kt, kindic ) ! filtered with j-k-i loop 79 ! 72 ! 80 73 CASE ( -1 ) ! esopa: test all possibility with control print 81 74 ; CALL dyn_spg_exp ( kt ) … … 87 80 ; CALL dyn_spg_flt ( kt, kindic ) 88 81 ; CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, & 89 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )90 ; CALL dyn_spg_exp_jki( kt )91 ; CALL prt_ctl( tab3d_1=ua, clinfo1=' spg10- Ua: ', mask1=umask, &92 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )93 ; CALL dyn_spg_ts_jki ( kt )94 ; CALL prt_ctl( tab3d_1=ua, clinfo1=' spg12- Ua: ', mask1=umask, &95 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )96 ; CALL dyn_spg_flt_jki( kt, kindic )97 ; CALL prt_ctl( tab3d_1=ua, clinfo1=' spg13- Ua: ', mask1=umask, &98 82 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 99 83 END SELECT … … 159 143 IF( lk_dynspg_flt) nspg = 2 160 144 IF( lk_dynspg_rl ) nspg = 3 161 IF( lk_jki ) nspg = nspg + 10162 145 IF( nspg == 13 ) nspg = 3 163 146 … … 171 154 IF( nspg == 2 ) WRITE(numout,*) ' filtered free surface' 172 155 IF( nspg == 3 ) WRITE(numout,*) ' rigid-lid' 173 IF( nspg == 10 ) WRITE(numout,*) ' explicit free surface with j-k-i loop'174 IF( nspg == 11 ) WRITE(numout,*) ' time splitting free surface with j-k-i loop'175 IF( nspg == 12 ) WRITE(numout,*) ' filtered free surface with j-k-i loop'176 156 ENDIF 177 157 -
trunk/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r746 r789 33 33 !! * Accessibility 34 34 PUBLIC dyn_spg_exp ! routine called by step.F90 35 PUBLIC exp_rst ! routine called j-k-i subroutine36 35 37 36 !! * Substitutions -
trunk/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r784 r789 51 51 52 52 PUBLIC dyn_spg_flt ! routine called by step.F90 53 PUBLIC flt_rst ! routine called by j-k-i subroutine54 53 55 54 !! * Substitutions -
trunk/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r788 r789 41 41 42 42 PUBLIC dyn_spg_ts ! routine called by step.F90 43 PUBLIC ts_rst ! routine called by j-k-i subroutine44 43 45 44 REAL(wp), DIMENSION(jpi,jpj) :: ftnw, ftne, & ! triad of coriolis parameter -
trunk/NEMO/OPA_SRC/DYN/dynvor.F90
r719 r789 226 226 227 227 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 228 !$OMP PARALLEL DO PRIVATE( zwx, zwy, zwz )229 228 ! ! =============== 230 229 DO jk = 1, jpkm1 ! Horizontal slab … … 333 332 334 333 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, zww ) 335 !$OMP PARALLEL DO PRIVATE( zwx, zwy, zwz, zww )336 334 ! ! =============== 337 335 DO jk = 1, jpkm1 ! Horizontal slab … … 444 442 445 443 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) 446 !$OMP PARALLEL DO PRIVATE( zwx, zwy, zwz )447 444 ! ! =============== 448 445 DO jk = 1, jpkm1 ! Horizontal slab … … 567 564 568 565 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 569 !$OMP PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse )570 566 ! ! =============== 571 567 DO jk = 1, jpkm1 ! Horizontal slab -
trunk/NEMO/OPA_SRC/DYN/dynzad.F90
r719 r789 38 38 CONTAINS 39 39 40 #if defined key_mpp_omp41 !!----------------------------------------------------------------------42 !! 'key_mpp_omp' OpenMP / NEC autotasking: j-k-i loops (j-slab)43 !!----------------------------------------------------------------------44 45 SUBROUTINE dyn_zad( kt )46 !!----------------------------------------------------------------------47 !! *** ROUTINE dynzad ***48 !!49 !! ** Purpose : Compute the now vertical momentum advection trend and50 !! add it to the general trend of momentum equation.51 !!52 !! ** Method : Use j-slab (j-k-i loops) for OpenMP / NEC autotasking53 !! The now vertical advection of momentum is given by:54 !! w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]55 !! w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]56 !! Add this trend to the general trend (ua,va):57 !! (ua,va) = (ua,va) + w dz(u,v)58 !!59 !! ** Action : - Update (ua,va) with the vert. momentum advection trends60 !! - Save the trends in (ztrdu,ztrdv) ('key_trddyn')61 !!----------------------------------------------------------------------62 USE oce, ONLY: zwuw => ta ! use ta as 3D workspace63 USE oce, ONLY: zwvw => sa ! use sa as 3D workspace64 !!65 INTEGER, INTENT(in) :: kt ! ocean time-step inedx66 !!67 INTEGER :: ji, jj, jk ! dummy loop indices68 REAL(wp) :: zvn, zua, zva ! temporary scalars69 REAL(wp), DIMENSION(jpi) :: zww ! 1D workspace70 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdu, ztrdv ! 3D workspace71 !!----------------------------------------------------------------------72 73 IF( kt == nit000 ) THEN74 IF(lwp) WRITE(numout,*)75 IF(lwp) WRITE(numout,*) 'dyn_zad : arakawa advection scheme'76 IF(lwp) WRITE(numout,*) '~~~~~~~ Auto-tasking case, j-slab, no vector opt.'77 ENDIF78 79 IF( l_trddyn ) THEN ! Save ua and va trends80 ztrdu(:,:,:) = ua(:,:,:)81 ztrdv(:,:,:) = va(:,:,:)82 ENDIF83 84 ! ! ===============85 DO jj = 2, jpjm1 ! Vertical slab86 ! ! ===============87 DO jk = 2, jpkm1 ! Vertical momentum advection at uw and vw-pts88 DO ji = 2, jpi ! vertical fluxes89 zww(ji) = 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)90 END DO91 DO ji = 2, jpim1 ! vertical momentum advection at w-point92 zvn = 0.25 * e1t(ji,jj+1) * e2t(ji,jj+1) * wn(ji,jj+1,jk)93 zwuw(ji,jj,jk) = ( zww(ji+1) + zww(ji) ) * ( un(ji,jj,jk-1)-un(ji,jj,jk) )94 zwvw(ji,jj,jk) = ( zvn + zww(ji) ) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) )95 END DO96 END DO97 DO ji = 2, jpim1 ! Surface and bottom values set to zero98 zwuw(ji,jj, 1 ) = 0.e099 zwvw(ji,jj, 1 ) = 0.e0100 zwuw(ji,jj,jpk) = 0.e0101 zwvw(ji,jj,jpk) = 0.e0102 END DO103 !104 DO jk = 1, jpkm1 ! Vertical momentum advection at u- and v-points105 DO ji = 2, jpim1106 ! ! vertical momentum advective trends107 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )108 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )109 ! ! add the trends to the general momentum trends110 ua(ji,jj,jk) = ua(ji,jj,jk) + zua111 va(ji,jj,jk) = va(ji,jj,jk) + zva112 END DO113 END DO114 ! ! ===============115 END DO ! End of slab116 ! ! ===============117 !118 IF( l_trddyn ) THEN ! save the vertical advection trends for diagnostic119 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)120 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)121 CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', kt )122 ENDIF123 ! ! Control print124 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' zad - Ua: ', mask1=umask, &125 & tab3d_2=va, clinfo2=' Va: ', mask2=vmask, clinfo3='dyn' )126 !127 END SUBROUTINE dyn_zad128 129 #else130 !!----------------------------------------------------------------------131 !! Default option k-j-i loop (vector opt.)132 !!----------------------------------------------------------------------133 134 40 SUBROUTINE dyn_zad ( kt ) 135 41 !!---------------------------------------------------------------------- … … 162 68 IF(lwp)WRITE(numout,*) 163 69 IF(lwp)WRITE(numout,*) 'dyn_zad : arakawa advection scheme' 164 IF(lwp)WRITE(numout,*) '~~~~~~~ vector optimization k-j-i loop'165 70 ENDIF 166 71 … … 215 120 ! 216 121 END SUBROUTINE dyn_zad 217 #endif218 122 219 123 !!====================================================================== -
trunk/NEMO/OPA_SRC/DYN/dynzdf.F90
r719 r789 17 17 USE dynzdf_exp ! vertical diffusion: explicit (dyn_zdf_exp routine) 18 18 USE dynzdf_imp ! vertical diffusion: implicit (dyn_zdf_imp routine) 19 USE dynzdf_imp_jki ! vertical diffusion implicit (dyn_zdf_imp_jki routine)20 19 21 20 USE ldfdyn_oce ! ocean dynamics: lateral physics … … 74 73 ! 75 74 CASE ( 0 ) ; CALL dyn_zdf_exp ( kt, r2dt ) ! explicit scheme 76 CASE ( 1 ) ; CALL dyn_zdf_imp ( kt, r2dt ) ! implicit scheme (k-j-i loop) 77 CASE ( 2 ) ; CALL dyn_zdf_imp_jki( kt, r2dt ) ! implicit scheme (j-k-i loop) 75 CASE ( 1 ) ; CALL dyn_zdf_imp ( kt, r2dt ) ! implicit scheme 78 76 ! 79 77 CASE ( -1 ) ! esopa: test all possibility with control print … … 83 81 CALL dyn_zdf_imp ( kt, r2dt ) 84 82 CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask, & 85 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )86 CALL dyn_zdf_imp_jki( kt, r2dt )87 CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf2 - Ua: ', mask1=umask, &88 83 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 89 84 END SELECT … … 109 104 !! ** Method : implicit (euler backward) scheme (default) 110 105 !! explicit (time-splitting) scheme if ln_zdfexp=T 111 !! OpenMP / NEC autotasking: use j-k-i loops112 106 !!---------------------------------------------------------------------- 113 107 USE zdftke … … 125 119 IF( ln_dynldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 126 120 127 ! OpenMP / NEC autotasking128 #if defined key_mpp_omp129 IF( nzdf == 1 ) nzdf = 2 ! j-k-i loop130 #endif131 132 121 IF( lk_esopa ) nzdf = -1 ! Esopa key: All schemes used 133 122 … … 139 128 IF( nzdf == 0 ) WRITE(numout,*) ' Explicit time-splitting scheme' 140 129 IF( nzdf == 1 ) WRITE(numout,*) ' Implicit (euler backward) scheme' 141 IF( nzdf == 2 ) WRITE(numout,*) ' Implicit (euler backward) scheme with j-k-i loops'142 130 ENDIF 143 131 ! -
trunk/NEMO/OPA_SRC/DYN/wzvmod.F90
r719 r789 36 36 37 37 CONTAINS 38 39 #if defined key_mpp_omp40 !!----------------------------------------------------------------------41 !! 'key_mpp_omp' j-k-i loop (j-slab)42 !!----------------------------------------------------------------------43 44 SUBROUTINE wzv( kt )45 !!----------------------------------------------------------------------46 !! *** ROUTINE wzv ***47 !!48 !! ** Purpose : Compute the now vertical velocity after the array swap49 !!50 !! ** Method : Using the incompressibility hypothesis, the vertical51 !! velocity is computed by integrating the horizontal divergence52 !! from the bottom to the surface.53 !! The boundary conditions are w=0 at the bottom (no flux) and,54 !! in rigid-lid case, w=0 at the sea surface.55 !!56 !! ** action : wn array : the now vertical velocity57 !!----------------------------------------------------------------------58 !! * Arguments59 INTEGER, INTENT( in ) :: kt ! ocean time-step index60 61 !! * Local declarations62 INTEGER :: jj, jk ! dummy loop indices63 !!----------------------------------------------------------------------64 65 IF( kt == nit000 ) THEN66 IF(lwp) WRITE(numout,*)67 IF(lwp) WRITE(numout,*) 'wzv : vertical velocity from continuity eq.'68 IF(lwp) WRITE(numout,*) '~~~~~~~ j-k-i loops'69 70 ! bottom boundary condition: w=0 (set once for all)71 wn(:,:,jpk) = 0.e072 ENDIF73 74 ! ! ===============75 DO jj = 1, jpj ! Vertical slab76 ! ! ===============77 ! Computation from the bottom78 DO jk = jpkm1, 1, -179 wn(:,jj,jk) = wn(:,jj,jk+1) - fse3t(:,jj,jk) * hdivn(:,jj,jk)80 END DO81 ! ! ===============82 END DO ! End of slab83 ! ! ===============84 85 IF(ln_ctl) CALL prt_ctl(tab3d_1=wn, clinfo1=' w**2 - : ', mask1=wn)86 87 END SUBROUTINE wzv88 89 #else90 !!----------------------------------------------------------------------91 !! Default option k-j-i loop92 !!----------------------------------------------------------------------93 38 94 39 SUBROUTINE wzv( kt ) … … 189 134 190 135 END SUBROUTINE wzv 191 #endif192 136 193 137 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
