Changeset 4616
- Timestamp:
- 2014-04-06T17:28:25+02:00 (10 years ago)
- Location:
- branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 1 added
- 78 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r4596 r4616 465 465 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj) & 466 466 & - e1e2t(ji ,jj) * hdiv(ji ,jj) ) & 467 & /e1u(ji,jj) * umask(ji,jj,jk)467 & * r1_e1u(ji,jj) * umask(ji,jj,jk) 468 468 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1) & 469 469 & - e1e2t(ji,jj ) * hdiv(ji,jj ) ) & 470 & /e2v(ji,jj) * vmask(ji,jj,jk)470 & * r1_e2v(ji,jj) * vmask(ji,jj,jk) 471 471 END DO 472 472 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r4292 r4616 15 15 !! 'key_dynspg_flt' filtered free surface 16 16 !!---------------------------------------------------------------------- 17 USE timing ! Timing18 17 USE oce ! ocean dynamics and tracers 18 USE bdy_oce ! ocean open boundary conditions 19 USE sbc_oce ! ocean surface boundary conditions 19 20 USE dom_oce ! ocean space and time domain 20 21 USE phycst ! physical constants 21 USE bdy_oce ! ocean open boundary conditions 22 ! 23 USE in_out_manager ! I/O manager 22 24 USE lib_mpp ! for mppsum 23 USE in_out_manager ! I/O manager24 USE sbc_oce ! ocean surface boundary conditions25 USE timing ! Timing 26 USE lib_fortran ! Fortran routines library 25 27 26 28 IMPLICIT NONE … … 32 34 # include "domzgr_substitute.h90" 33 35 !!---------------------------------------------------------------------- 34 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)36 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 35 37 !! $Id$ 36 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 90 92 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 91 93 ! ----------------------------------------------------------------------- 92 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 93 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 94 z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 94 95 95 96 ! Transport through the unstructured open boundary -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r4313 r4616 189 189 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 190 190 191 area(:,:) = e1 t(:,:) *e2t(:,:) * tmask_i(:,:)192 193 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot)191 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 192 193 area_tot = glob_sum( area(:,:) ) 194 194 195 195 vol0 = 0._wp -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
r4147 r4616 9 9 !!---------------------------------------------------------------------- 10 10 #if ! defined key_coupled 11 12 !!---------------------------------------------------------------------- 13 !! Only for ORCA2 ORCA1 and ORCA025 11 !!---------------------------------------------------------------------- 12 !! Only for ORCA2 ORCA1 and ORCA025 and not coupled case 14 13 !!---------------------------------------------------------------------- 15 14 !!---------------------------------------------------------------------- … … 21 20 USE sbc_oce ! ??? 22 21 USE zdf_oce ! ocean vertical physics 22 ! 23 23 USE in_out_manager ! I/O manager 24 24 USE lib_mpp ! distributed memory computing library 25 USE lib_fortran ! Fortran utilities 25 26 USE timing ! preformance summary 26 27 … … 44 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 46 !!---------------------------------------------------------------------- 46 47 47 CONTAINS 48 48 … … 77 77 a_salb = 0.e0 ! valeur de sal au debut de la simulation 78 78 ! sshb used because diafwb called after tranxt (i.e. after the swap) 79 a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) ) 80 IF( lk_mpp ) CALL mpp_sum( a_sshb ) ! sum over the global domain 79 a_sshb = glob_sum( e1e2t(:,:) * sshb(:,:) ) ! sum over the global domain 81 80 82 81 DO jk = 1, jpkm1 83 82 DO jj = 2, jpjm1 84 83 DO ji = fs_2, fs_jpim1 ! vector opt. 85 zwei = e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)86 a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei84 zwei = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 85 a_salb = a_salb + zwei * ( tsb(ji,jj,jk,jp_sal) - zsm0 ) 87 86 END DO 88 87 END DO … … 91 90 ENDIF 92 91 93 a_fwf = SUM( e1t(:,:) * e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 94 IF( lk_mpp ) CALL mpp_sum( a_fwf ) ! sum over the global domain 92 a_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) ) ! sum over the global domain 95 93 96 94 IF( kt == nitend ) THEN … … 101 99 zfwfnew = 0.e0 102 100 ! Mean sea level at nitend 103 a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) ) 104 IF( lk_mpp ) CALL mpp_sum( a_sshn ) ! sum over the global domain 105 zarea = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 106 IF( lk_mpp ) CALL mpp_sum( zarea ) ! sum over the global domain 101 a_sshn = glob_sum( e1e2t(:,:) * sshn(:,:) ) ! sum over the global domain 102 zarea = glob_sum( e1e2t(:,:) ) ! sum over the global domain (tmask_i included) 107 103 108 104 DO jk = 1, jpkm1 109 105 DO jj = 2, jpjm1 110 106 DO ji = fs_2, fs_jpim1 ! vector opt. 111 zwei = e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)112 a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei113 zvol = zvol+ zwei107 zwei = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 108 a_saln = a_saln + zwei * ( tsn(ji,jj,jk,jp_sal) - zsm0 ) 109 zvol = zvol + zwei 114 110 END DO 115 111 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r4333 r4616 80 80 CALL wrk_alloc( jpi, jpj, zsurf ) 81 81 82 zsurf(:,:) = e1 t(:,:) *e2t(:,:) * tmask(:,:,1) * tmask_i(:,:) ! masked surface grid cell area82 zsurf(:,:) = e1e2t(:,:) * tmask(:,:,1) * tmask_i(:,:) ! masked surface grid cell area 83 83 84 84 ! ------------------------- ! -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4596 r4616 188 188 CALL lbc_lnk( z2d, 'T', 1. ) 189 189 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 190 !CDIR NOVERRCHK191 190 z2d(:,:) = SQRT( z2d(:,:) ) 192 191 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r4488 r4616 157 157 !! horizontal curvilinear coordinate and scale factors 158 158 !! --------------------------------------------------------------------- 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamt, glamu !: longitude of t-, u-, v- and f-points (degre) 160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamv, glamf !: 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphiv, gphif !: 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t !: horizontal scale factors at t-point (m) 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, e2u !: horizontal scale factors at u-point (m) 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v, e2v !: horizontal scale factors at v-point (m) 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factors at f-point (m) 167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t !: surface at t-point (m2) 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree] 160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree] 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m] 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m] 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m] 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m] 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point 167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor [1/s] 169 170 170 171 !!---------------------------------------------------------------------- 171 172 !! vertical coordinate and scale factors 172 173 !! --------------------------------------------------------------------- 173 ! 174 LOGICAL, PUBLIC :: ln_zco 175 LOGICAL, PUBLIC :: ln_zps 176 LOGICAL, PUBLIC :: ln_sco 174 ! !!* Namelist namzgr : vertical coordinate * 175 LOGICAL, PUBLIC :: ln_zco !: z-coordinate - full step 176 LOGICAL, PUBLIC :: ln_zps !: z-coordinate - partial step 177 LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate 177 178 178 179 !! All coordinates … … 214 215 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 !: reference depth at t- points (meters) 215 216 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: reference depth at u- and v-points (meters) 216 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: re2u_e1u !: scale factor coeffs at u points (e2u/e1u)217 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: re1v_e2v !: scale factor coeffs at v points (e1v/e2v)218 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12t , r1_e12t !: horizontal cell surface and inverse at t points219 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12u , r1_e12u !: horizontal cell surface and inverse at u points220 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12v , r1_e12v !: horizontal cell surface and inverse at v points221 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12f , r1_e12f !: horizontal cell surface and inverse at f points222 217 223 218 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) … … 334 329 & njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) , & 335 330 & nleit(jpnij) , nlejt(jpnij) , & 336 & mi0(jpidta) , mi1 (jpidta), mj0(jpjdta) , mj1 (jpjdta), & 337 & tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(2) ) 338 ! 339 ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , & 340 & glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , & 341 & glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) , & 342 & glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff (jpi,jpj) , STAT=ierr(3) ) 331 & mi0(jpidta) , mi1 (jpidta), mj0(jpjdta) , mj1 (jpjdta) , & 332 & tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(2) ) 333 ! 334 ALLOCATE( glamt(jpi,jpj) , glamu(jpi,jpj) , glamv(jpi,jpj) , glamf(jpi,jpj) , & 335 & gphit(jpi,jpj) , gphiu(jpi,jpj) , gphiv(jpi,jpj) , gphif(jpi,jpj) , & 336 & e1t (jpi,jpj) , e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) , & 337 & e1u (jpi,jpj) , e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) , & 338 & e1v (jpi,jpj) , e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) , & 339 & e1f (jpi,jpj) , e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) , & 340 & e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj) , & 341 & e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj) , & 342 & e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj) , & 343 & e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj) , & 344 & ff (jpi,jpj) , STAT=ierr(3) ) 343 345 ! 344 346 ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) , & … … 361 363 ! 362 364 ALLOCATE( hu (jpi,jpj) , hur (jpi,jpj) , hu_0(jpi,jpj) , ht_0 (jpi,jpj) , & 363 & hv (jpi,jpj) , hvr (jpi,jpj) , hv_0(jpi,jpj) , ht (jpi,jpj) , & 364 & re2u_e1u(jpi,jpj) , re1v_e2v(jpi,jpj) , & 365 & e12t (jpi,jpj) , r1_e12t (jpi,jpj) , & 366 & e12u (jpi,jpj) , r1_e12u (jpi,jpj) , & 367 & e12v (jpi,jpj) , r1_e12v (jpi,jpj) , & 368 & e12f (jpi,jpj) , r1_e12f (jpi,jpj) , STAT=ierr(6) ) 365 & hv (jpi,jpj) , hvr (jpi,jpj) , hv_0(jpi,jpj) , ht (jpi,jpj) , STAT=ierr(6) ) 369 366 ! 370 367 ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , & … … 377 374 & scosrf(jpi,jpj) , scobot(jpi,jpj) , & 378 375 & hifv (jpi,jpj) , hiff (jpi,jpj) , & 379 & hift (jpi,jpj) , hifu (jpi,jpj) , rx1 376 & hift (jpi,jpj) , hifu (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) ) 380 377 381 378 ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) , & -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r4366 r4616 14 14 !! use of parameters in par_CONFIG-Rxx.h90, not in namelist 15 15 !! - ! 2004-05 (A. Koch-Larrouy) Add Gyre configuration 16 !! 4.0 ! 2011-02 (G. Madec) add cell surface (e1e2t)16 !! 3.7 ! 2014-032 (G. Madec) add cell surface and their inverse 17 17 !!---------------------------------------------------------------------- 18 18 … … 35 35 36 36 !!---------------------------------------------------------------------- 37 !! NEMO/OPA 4.0 , NEMO Consortium (2011)37 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 38 38 !! $Id$ 39 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 120 120 WRITE(numout,*) ' meridional grid-spacing (meters) ppe2_m = ', ppe2_m 121 121 ENDIF 122 123 124 SELECT CASE( jphgr_msh ) ! type of horizontal mesh 125 126 CASE ( 0 ) ! curvilinear coordinate on the sphere read in coordinate.nc file 127 122 ! 123 SELECT CASE( jphgr_msh ) ! type of horizontal mesh 124 ! 125 CASE ( 0 ) !== read in coordinate.nc file ==! 126 ! 128 127 IF(lwp) WRITE(numout,*) 129 128 IF(lwp) WRITE(numout,*) ' curvilinear coordinate on the sphere read in "coordinate" file' 130 129 ! 131 130 CALL hgr_read ! Defaultl option : NetCDF file 132 131 ! 133 132 ! ! ===================== 134 133 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration … … 155 154 ! 156 155 ENDIF 157 158 !! =====================156 ! 157 ! ! ===================== 159 158 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 160 159 ! ! ===================== 161 160 ! 162 161 ii0 = 281 ; ii1 = 282 ! Gibraltar Strait (e2u = 20 km) 163 162 ij0 = 200 ; ij1 = 200 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3 … … 199 198 IF(lwp) WRITE(numout,*) 200 199 IF(lwp) WRITE(numout,*) ' orca_r1: E Halmahera : e1v reduced to 50 km' 201 202 ! 203 204 ! 205 ! 206 ! 207 ! 208 ENDIF 209 200 ! 201 ENDIF 202 ! 210 203 ! ! ====================== 211 204 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration … … 248 241 ! 249 242 ENDIF 250 251 243 ! 252 244 ! N.B. : General case, lat and long function of both i and j indices: 253 245 ! e1t(ji,jj) = ra * rad * SQRT( ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2 & … … 268 260 ! e2f(ji,jj) = ra * rad * SQRT( ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2 & 269 261 ! + ( fsdjph( zfi, zfj ) )**2 ) 270 271 272 CASE ( 1 ) ! geographical mesh on the sphere with regular grid-spacing273 262 ! 263 ! 264 CASE ( 1 ) !== geographical mesh on the sphere with regular (in degree) grid-spacing ==! 265 ! 274 266 IF(lwp) WRITE(numout,*) 275 267 IF(lwp) WRITE(numout,*) ' geographical mesh on the sphere with regular grid-spacing' 276 268 IF(lwp) WRITE(numout,*) ' given by ppe1_deg and ppe2_deg' 277 269 ! 278 270 DO jj = 1, jpj 279 271 DO ji = 1, jpi 280 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 )281 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = FLOAT( jj - 1 + njmpp - 1 )282 zvi = FLOAT( ji - 1 + nimpp - 1 ) ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5283 zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5272 zti = REAL( ji - 1 + nimpp - 1 ) ; ztj = REAL( jj - 1 + njmpp - 1 ) 273 zui = REAL( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = REAL( jj - 1 + njmpp - 1 ) 274 zvi = REAL( ji - 1 + nimpp - 1 ) ; zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5 275 zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5 284 276 ! Longitude 285 277 glamt(ji,jj) = ppglam0 + ppe1_deg * zti … … 304 296 END DO 305 297 END DO 306 307 308 CASE ( 2:3 ) ! f- or beta-plane with regular grid-spacing 309 298 ! 299 CASE ( 2:3 ) !== f- or beta-plane with regular grid-spacing ==! 300 ! 310 301 IF(lwp) WRITE(numout,*) 311 302 IF(lwp) WRITE(numout,*) ' f- or beta-plane with regular grid-spacing' 312 303 IF(lwp) WRITE(numout,*) ' given by ppe1_m and ppe2_m' 313 304 ! 314 305 ! Position coordinates (in kilometers) 315 306 ! ========== 316 307 glam0 = 0.e0 317 308 gphi0 = - ppe2_m * 1.e-3 318 309 ! 319 310 #if defined key_agrif 320 311 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only … … 329 320 DO jj = 1, jpj 330 321 DO ji = 1, jpi 331 glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) )332 glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) + 0.5 )322 glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) ) 323 glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 ) 333 324 glamv(ji,jj) = glamt(ji,jj) 334 325 glamf(ji,jj) = glamu(ji,jj) 335 336 gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) )326 ! 327 gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) ) 337 328 gphiu(ji,jj) = gphit(ji,jj) 338 gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 )329 gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 ) 339 330 gphif(ji,jj) = gphiv(ji,jj) 340 331 END DO 341 332 END DO 342 333 ! 343 334 ! Horizontal scale factors (in meters) 344 335 ! ====== … … 347 338 e1v(:,:) = ppe1_m ; e2v(:,:) = ppe2_m 348 339 e1f(:,:) = ppe1_m ; e2f(:,:) = ppe2_m 349 350 CASE ( 4 ) ! geographical mesh on the sphere, isotropic MERCATOR type351 340 ! 341 CASE ( 4 ) !== geographical mesh on the sphere, isotropic MERCATOR type ==! 342 ! 352 343 IF(lwp) WRITE(numout,*) 353 344 IF(lwp) WRITE(numout,*) ' geographical mesh on the sphere, MERCATOR type' 354 345 IF(lwp) WRITE(numout,*) ' longitudinal/latitudinal spacing given by ppe1_deg' 355 346 IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 356 347 ! 357 348 ! Find index corresponding to the equator, given the grid spacing e1_deg 358 349 ! and the (approximate) southern latitude ppgphi0. … … 362 353 ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 363 354 IF( ppgphi0 > 0 ) ijeq = -ijeq 364 355 ! 365 356 IF(lwp) WRITE(numout,*) ' Index of the equator on the MERCATOR grid:', ijeq 366 357 ! 367 358 DO jj = 1, jpj 368 359 DO ji = 1, jpi 369 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - ijeq + njmpp - 1 )370 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = FLOAT( jj - ijeq + njmpp - 1 )371 zvi = FLOAT( ji - 1 + nimpp - 1 ) ; zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5372 zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5360 zti = REAL( ji - 1 + nimpp - 1 ) ; ztj = REAL( jj - ijeq + njmpp - 1 ) 361 zui = REAL( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = REAL( jj - ijeq + njmpp - 1 ) 362 zvi = REAL( ji - 1 + nimpp - 1 ) ; zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 363 zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 373 364 ! Longitude 374 365 glamt(ji,jj) = ppglam0 + ppe1_deg * zti … … 393 384 END DO 394 385 END DO 395 396 CASE ( 5 ) ! beta-plane with regular grid-spacing and rotated domain(GYRE configuration)397 386 ! 387 CASE ( 5 ) !== beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration) 388 ! 398 389 IF(lwp) WRITE(numout,*) 399 390 IF(lwp) WRITE(numout,*) ' beta-plane with regular grid-spacing and rotated domain (GYRE configuration)' 400 391 IF(lwp) WRITE(numout,*) ' given by ppe1_m and ppe2_m' 401 392 ! 402 393 ! Position coordinates (in kilometers) 403 394 ! ========== 404 395 ! 405 396 ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN 406 zlam1 = -85 407 zphi1 = 29397 zlam1 = -85._wp 398 zphi1 = 29._wp 408 399 ! resolution in meters 409 ze1 = 106000. / FLOAT(jp_cfg)400 ze1 = 106000. / REAL( jp_cfg , wp ) 410 401 ! benchmark: forced the resolution to be about 100 km 411 402 IF( nbench /= 0 ) ze1 = 106000.e0 412 zsin_alpha = - SQRT( 2. ) / 2.413 zcos_alpha = SQRT( 2. ) / 2.403 zsin_alpha = - SQRT( 2._wp ) * 0.5_wp 404 zcos_alpha = SQRT( 2._wp ) * 0.5_wp 414 405 ze1deg = ze1 / (ra * rad) 415 IF( nbench /= 0 ) ze1deg = ze1deg / FLOAT(jp_cfg)! benchmark: keep the lat/+lon416 ! ! at the right jp_cfg resolution417 glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2)418 gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2)419 406 IF( nbench /= 0 ) ze1deg = ze1deg / REAL( jp_cfg , wp ) ! benchmark: keep the lat/+lon 407 ! ! at the right jp_cfg resolution 408 glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp ) 409 gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp ) 410 ! 420 411 IF( nprint==1 .AND. lwp ) THEN 421 412 WRITE(numout,*) ' ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 422 413 WRITE(numout,*) ' ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0 423 414 ENDIF 424 415 ! 425 416 DO jj = 1, jpj 426 DO ji = 1, jpi427 zim1 = FLOAT( ji + nimpp - 1 ) - 1. ; zim05 = FLOAT( ji + nimpp - 1 ) - 1.5428 zjm1 = FLOAT( jj + njmpp - 1 ) - 1. ; zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5429 430 glamf(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha431 gphif(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha432 433 glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha434 gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha435 436 glamu(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha437 gphiu(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha438 439 glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha440 gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha441 END DO442 443 417 DO ji = 1, jpi 418 zim1 = REAL( ji + nimpp - 1 ) - 1. ; zim05 = REAL( ji + nimpp - 1 ) - 1.5 419 zjm1 = REAL( jj + njmpp - 1 ) - 1. ; zjm05 = REAL( jj + njmpp - 1 ) - 1.5 420 ! 421 glamf(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha 422 gphif(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha 423 ! 424 glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 425 gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 426 ! 427 glamu(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 428 gphiu(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 429 ! 430 glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha 431 gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha 432 END DO 433 END DO 434 ! 444 435 ! Horizontal scale factors (in meters) 445 436 ! ====== … … 448 439 e1v(:,:) = ze1 ; e2v(:,:) = ze1 449 440 e1f(:,:) = ze1 ; e2f(:,:) = ze1 450 441 ! 451 442 CASE DEFAULT 452 443 WRITE(ctmp1,*) ' bad flag value for jphgr_msh = ', jphgr_msh 453 444 CALL ctl_stop( ctmp1 ) 454 445 ! 455 446 END SELECT 456 447 457 ! T-cell surface 458 ! -------------- 448 ! associated horizontal metrics 449 ! ----------------------------- 450 ! 451 r1_e1t (:,:) = 1._wp / e1t(:,:) ; r1_e2t (:,:) = 1._wp / e2t(:,:) 452 r1_e1u (:,:) = 1._wp / e1u(:,:) ; r1_e2u (:,:) = 1._wp / e2u(:,:) 453 r1_e1v (:,:) = 1._wp / e1v(:,:) ; r1_e2v (:,:) = 1._wp / e2v(:,:) 454 r1_e1f (:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 455 ! 459 456 e1e2t(:,:) = e1t(:,:) * e2t(:,:) 460 461 ! Useful shortcuts (JC: note the duplicated e2e2t array ! Need some cleaning) 462 ! --------------------------------------------------------------------------- 463 e12t (:,:) = e1t(:,:) * e2t(:,:) 464 e12u (:,:) = e1u(:,:) * e2u(:,:) 465 e12v (:,:) = e1v(:,:) * e2v(:,:) 466 e12f (:,:) = e1f(:,:) * e2f(:,:) 467 r1_e12t (:,:) = 1._wp / e12t(:,:) 468 r1_e12u (:,:) = 1._wp / e12u(:,:) 469 r1_e12v (:,:) = 1._wp / e12v(:,:) 470 r1_e12f (:,:) = 1._wp / e12f(:,:) 471 re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 472 re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 473 474 ! Control printing : Grid informations (if not restart) 475 ! ---------------- 476 477 IF( lwp .AND. .NOT.ln_rstart ) THEN 457 e1e2u(:,:) = e1u(:,:) * e2u(:,:) 458 e1e2v(:,:) = e1v(:,:) * e2v(:,:) 459 e1e2f(:,:) = e1f(:,:) * e2f(:,:) 460 ! 461 r1_e1e2t (:,:) = 1._wp / e1e2t(:,:) 462 r1_e1e2u (:,:) = 1._wp / e1e2u(:,:) 463 r1_e1e2v (:,:) = 1._wp / e1e2v(:,:) 464 r1_e1e2f (:,:) = 1._wp / e1e2f(:,:) 465 ! 466 e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 467 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 468 469 470 IF( lwp .AND. .NOT.ln_rstart ) THEN ! Control print : Grid informations (if not restart) 478 471 WRITE(numout,*) 479 472 WRITE(numout,*) ' longitude and e1 scale factors' … … 485 478 9300 FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x, & 486 479 f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 ) 487 480 ! 488 481 WRITE(numout,*) 489 482 WRITE(numout,*) ' latitude and e2 scale factors' … … 495 488 ENDIF 496 489 497 498 IF( nprint == 1 .AND. lwp ) THEN499 WRITE(numout,*) ' e1u e2u '500 CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )501 CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )502 WRITE(numout,*) ' e1v e2v '503 CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )504 CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )505 WRITE(numout,*) ' e1f e2f '506 CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )507 CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )508 ENDIF509 510 490 511 491 ! ================= ! … … 528 508 529 509 zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0 530 zphi0 = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad ) ! latitude of the first row F-points510 zphi0 = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad ) ! latitude of the first row F-points 531 511 532 512 #if defined key_agrif 533 513 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 534 514 IF( .NOT. Agrif_Root() ) THEN 535 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad)515 zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 536 516 ENDIF 537 517 ENDIF … … 584 564 585 565 IF( nperio == 2 ) THEN 586 znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi )566 znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi ) 587 567 IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 588 568 ENDIF … … 597 577 !! *** ROUTINE hgr_read *** 598 578 !! 599 !! ** Purpose : Read a coordinate file in NetCDF format 600 !! 601 !! ** Method : The mesh file has been defined trough a analytical 602 !! or semi-analytical method. It is read in a NetCDF file. 603 !! 579 !! ** Purpose : Read a coordinate file in NetCDF format using IOM 580 !! 604 581 !!---------------------------------------------------------------------- 605 582 USE iom 606 583 ! 607 584 INTEGER :: inum ! temporary logical unit 608 585 !!---------------------------------------------------------------------- 609 586 ! 610 587 IF(lwp) THEN 611 588 WRITE(numout,*) … … 613 590 WRITE(numout,*) '~~~~~~~~ jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 614 591 ENDIF 615 592 ! 616 593 CALL iom_open( 'coordinates', inum ) 617 594 ! 618 595 CALL iom_get( inum, jpdom_data, 'glamt', glamt ) 619 596 CALL iom_get( inum, jpdom_data, 'glamu', glamu ) 620 597 CALL iom_get( inum, jpdom_data, 'glamv', glamv ) 621 598 CALL iom_get( inum, jpdom_data, 'glamf', glamf ) 622 599 ! 623 600 CALL iom_get( inum, jpdom_data, 'gphit', gphit ) 624 601 CALL iom_get( inum, jpdom_data, 'gphiu', gphiu ) 625 602 CALL iom_get( inum, jpdom_data, 'gphiv', gphiv ) 626 603 CALL iom_get( inum, jpdom_data, 'gphif', gphif ) 627 604 ! 628 605 CALL iom_get( inum, jpdom_data, 'e1t', e1t ) 629 606 CALL iom_get( inum, jpdom_data, 'e1u', e1u ) 630 607 CALL iom_get( inum, jpdom_data, 'e1v', e1v ) 631 608 CALL iom_get( inum, jpdom_data, 'e1f', e1f ) 632 609 ! 633 610 CALL iom_get( inum, jpdom_data, 'e2t', e2t ) 634 611 CALL iom_get( inum, jpdom_data, 'e2u', e2u ) 635 612 CALL iom_get( inum, jpdom_data, 'e2v', e2v ) 636 613 CALL iom_get( inum, jpdom_data, 'e2f', e2f ) 637 614 ! 638 615 CALL iom_close( inum ) 639 640 616 ! 617 END SUBROUTINE hgr_read 641 618 642 619 !!====================================================================== -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r4490 r4616 9 9 !! vvl option includes z_star and z_tilde coordinates 10 10 !!---------------------------------------------------------------------- 11 !! 'key_vvl' variable volume 12 !!---------------------------------------------------------------------- 11 13 12 !!---------------------------------------------------------------------- 14 13 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness … … 18 17 !! dom_vvl_rst : read/write restart file 19 18 !! dom_vvl_ctl : Check the vvl options 20 !! dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors21 !! : to account for manual changes to e[1,2][u,v] in some Straits22 19 !!---------------------------------------------------------------------- 23 !! * Modules used24 20 USE oce ! ocean dynamics and tracers 25 21 USE dom_oce ! ocean space and time domain … … 36 32 PRIVATE 37 33 38 !! * Routine accessibility39 34 PUBLIC dom_vvl_init ! called by domain.F90 40 35 PUBLIC dom_vvl_sf_nxt ! called by step.F90 41 36 PUBLIC dom_vvl_sf_swp ! called by step.F90 42 37 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 43 PRIVATE dom_vvl_orca_fix ! called by dom_vvl_interpol 44 45 !!* Namelist nam_vvl 46 LOGICAL , PUBLIC :: ln_vvl_zstar ! zstar vertical coordinate 47 LOGICAL , PUBLIC :: ln_vvl_ztilde ! ztilde vertical coordinate 48 LOGICAL , PUBLIC :: ln_vvl_layer ! level vertical coordinate 49 LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar ! ztilde vertical coordinate 50 LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor ! ztilde vertical coordinate 51 LOGICAL , PUBLIC :: ln_vvl_kepe ! kinetic/potential energy transfer 52 ! ! conservation: not used yet 53 REAL(wp) :: rn_ahe3 ! thickness diffusion coefficient 54 REAL(wp) :: rn_rst_e3t ! ztilde to zstar restoration timescale [days] 55 REAL(wp) :: rn_lf_cutoff ! cutoff frequency for low-pass filter [days] 56 REAL(wp) :: rn_zdef_max ! maximum fractional e3t deformation 57 LOGICAL , PUBLIC :: ln_vvl_dbg ! debug control prints 58 59 !! * Module variables 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport 61 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf ! low frequency part of hz divergence 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a ! baroclinic scale factors 64 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t ! retoring period for scale factors 65 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 38 39 ! !!* Namelist nam_vvl * 40 LOGICAL , PUBLIC :: ln_vvl_zstar ! zstar vertical coordinate 41 LOGICAL , PUBLIC :: ln_vvl_ztilde ! ztilde vertical coordinate 42 LOGICAL , PUBLIC :: ln_vvl_layer ! level vertical coordinate 43 LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar ! ztilde vertical coordinate 44 LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor ! ztilde vertical coordinate 45 LOGICAL , PUBLIC :: ln_vvl_kepe ! kinetic/potential energy transfer conservation: not used yet 46 REAL(wp) :: rn_ahe3 ! thickness diffusion coefficient 47 REAL(wp) :: rn_rst_e3t ! ztilde to zstar restoration timescale [days] 48 REAL(wp) :: rn_lf_cutoff ! cutoff frequency for low-pass filter [days] 49 REAL(wp) :: rn_zdef_max ! maximum fractional e3t deformation 50 LOGICAL , PUBLIC :: ln_vvl_dbg ! debug control prints 51 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport 53 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf ! low frequency part of hz divergence 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a ! baroclinic scale factors 56 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t ! retoring period for scale factors 57 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 66 58 67 59 !! * Substitutions … … 73 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 74 66 !!---------------------------------------------------------------------- 75 76 67 CONTAINS 77 68 … … 80 71 !! *** FUNCTION dom_vvl_alloc *** 81 72 !!---------------------------------------------------------------------- 82 IF( ln_vvl_zstar ) dom_vvl_alloc = 073 IF( ln_vvl_zstar ) dom_vvl_alloc = 0 83 74 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 84 75 ALLOCATE( tilde_e3t_b(jpi,jpj,jpk) , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) , & … … 95 86 IF( dom_vvl_alloc /= 0 ) CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 96 87 ENDIF 97 88 ! 98 89 END FUNCTION dom_vvl_alloc 99 90 … … 358 349 DO jj = 1, jpjm1 359 350 DO ji = 1, fs_jpim1 ! vector opt. 360 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj)&361 &* ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) )362 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj)&363 &* ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) )351 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 352 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 353 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 354 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 364 355 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 365 356 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) … … 380 371 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 381 372 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 382 & ) * r1_e1 2t(ji,jj)373 & ) * r1_e1e2t(ji,jj) 383 374 END DO 384 375 END DO … … 671 662 !! - vertical interpolation: simple averaging 672 663 !!---------------------------------------------------------------------- 673 !! * Arguments674 664 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pe3_in ! input e3 to be interpolated 675 665 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: pe3_out ! output interpolated e3 676 666 CHARACTER(LEN=*), INTENT( in ) :: pout ! grid point of out scale factors 677 667 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW' 678 ! ! * Local declarations668 ! 679 669 INTEGER :: ji, jj, jk ! dummy loop indices 680 670 LOGICAL :: l_is_orca ! local logical … … 685 675 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) l_is_orca = .TRUE. ! ORCA R2 configuration - will need to correct some locations 686 676 687 SELECT CASE ( pout ) 688 ! ! ------------------------------------- ! 689 CASE( 'U' ) ! interpolation from T-point to U-point ! 690 ! ! ------------------------------------- ! 691 ! horizontal surface weighted interpolation 692 DO jk = 1, jpk 677 SELECT CASE ( pout ) 678 ! ! ------------------------------------- ! 679 CASE( 'U' ) ! interpolation from T-point to U-point ! 680 ! ! ------------------------------------- ! 681 DO jk = 1, jpk ! horizontal surface weighted interpolation 693 682 DO jj = 1, jpjm1 694 683 DO ji = 1, fs_jpim1 ! vector opt. 695 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1 2u(ji,jj) &696 & * ( e1 2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &697 & + e1 2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )684 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1e2u(ji,jj) & 685 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 686 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 698 687 END DO 699 688 END DO 700 689 END DO 701 ! 702 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 703 ! boundary conditions 704 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. ) 690 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. ) ! boundary conditions 705 691 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 706 ! ! ------------------------------------- !707 CASE( 'V' ) ! interpolation from T-point to V-point!708 ! ! -------------------------------------!709 ! horizontal surface weighted interpolation710 DO jk = 1, jpk 692 ! 693 ! ! ------------------------------------- ! 694 CASE( 'V' ) ! interpolation from T-point to V-point ! 695 ! ! ------------------------------------- ! 696 DO jk = 1, jpk ! horizontal surface weighted interpolation 711 697 DO jj = 1, jpjm1 712 698 DO ji = 1, fs_jpim1 ! vector opt. 713 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1 2v(ji,jj) &714 & * ( e1 2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &715 & + e1 2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )699 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1e2v(ji,jj) & 700 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 701 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 716 702 END DO 717 703 END DO 718 704 END DO 719 ! 720 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 721 ! boundary conditions 722 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. ) 705 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. ) ! boundary conditions 723 706 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 724 ! ! ------------------------------------- !725 CASE( 'F' ) ! interpolation from U-point to F-point!726 ! ! -------------------------------------!727 ! horizontal surface weighted interpolation728 DO jk = 1, jpk 707 ! 708 ! ! ------------------------------------- ! 709 CASE( 'F' ) ! interpolation from U-point to F-point ! 710 ! ! ------------------------------------- ! 711 DO jk = 1, jpk ! horizontal surface weighted interpolation 729 712 DO jj = 1, jpjm1 730 713 DO ji = 1, fs_jpim1 ! vector opt. 731 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1 2f(ji,jj) &732 & * ( e1 2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) &733 & + e1 2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )714 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1e2f(ji,jj) & 715 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 716 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 734 717 END DO 735 718 END DO 736 719 END DO 737 !738 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )739 720 ! boundary conditions 740 721 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1. ) 741 722 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 742 ! ! ------------------------------------- ! 743 CASE( 'W' ) ! interpolation from T-point to W-point ! 744 ! ! ------------------------------------- ! 745 ! vertical simple interpolation 723 ! 724 ! ! ------------------------------------- ! 725 CASE( 'W' ) ! interpolation from T-point to W-point ! 726 ! ! ------------------------------------- ! 727 ! ! vertical simple interpolation 746 728 pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 747 ! - ML - The use of mask in this formaula enables the special treatment of the last w- 729 ! - ML - The use of mask in this formaula enables the special treatment of the last w-point without indirect adressing 748 730 DO jk = 2, jpk 749 731 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 750 732 & + 0.5_wp * tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 751 733 END DO 752 ! ! -------------------------------------- !753 CASE( 'UW' ) ! interpolation from U-point to UW-point !754 ! ! -------------------------------------- !755 ! vertical simple interpolation734 ! ! -------------------------------------- ! 735 CASE( 'UW' ) ! interpolation from U-point to UW-point ! 736 ! ! -------------------------------------- ! 737 ! ! vertical simple interpolation 756 738 pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 757 739 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing … … 760 742 & + 0.5_wp * umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 761 743 END DO 762 ! ! -------------------------------------- !763 CASE( 'VW' ) ! interpolation from V-point to VW-point !764 ! ! -------------------------------------- !765 ! vertical simple interpolation744 ! ! -------------------------------------- ! 745 CASE( 'VW' ) ! interpolation from V-point to VW-point ! 746 ! ! -------------------------------------- ! 747 ! ! vertical simple interpolation 766 748 pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 767 749 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing … … 770 752 & + 0.5_wp * vmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 771 753 END DO 754 ! 772 755 END SELECT 773 756 ! 774 775 757 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_interpol') 776 758 ! 777 759 END SUBROUTINE dom_vvl_interpol 760 778 761 779 762 SUBROUTINE dom_vvl_rst( kt, cdrw ) … … 982 965 END SUBROUTINE dom_vvl_ctl 983 966 984 SUBROUTINE dom_vvl_orca_fix( pe3_in, pe3_out, pout )985 !!---------------------------------------------------------------------986 !! *** ROUTINE dom_vvl_orca_fix ***987 !!988 !! ** Purpose : Correct surface weighted, horizontally interpolated,989 !! scale factors at locations that have been individually990 !! modified in domhgr. Such modifications break the991 !! relationship between e12t and e1u*e2u etc.992 !! Recompute some scale factors ignoring the modified metric.993 !!----------------------------------------------------------------------994 !! * Arguments995 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pe3_in ! input e3 to be interpolated996 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: pe3_out ! output interpolated e3997 CHARACTER(LEN=*), INTENT( in ) :: pout ! grid point of out scale factors998 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW'999 !! * Local declarations1000 INTEGER :: ji, jj, jk ! dummy loop indices1001 INTEGER :: ij0, ij1, ii0, ii1 ! dummy loop indices1002 !! acc1003 !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for1004 !! the ORCA2 tests (by changing jp_cfg test from 2 to 3) pending further investigations1005 !!1006 ! ! =====================1007 IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN ! ORCA R2 configuration1008 ! ! =====================1009 !! acc1010 IF( nn_cla == 0 ) THEN1011 !1012 ii0 = 139 ; ii1 = 140 ! Gibraltar Strait (e2u was modified)1013 ij0 = 102 ; ij1 = 1021014 DO jk = 1, jpkm11015 DO jj = mj0(ij0), mj1(ij1)1016 DO ji = mi0(ii0), mi1(ii1)1017 SELECT CASE ( pout )1018 CASE( 'U' )1019 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1020 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1021 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1022 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1023 CASE( 'F' )1024 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1025 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1026 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1027 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1028 END SELECT1029 END DO1030 END DO1031 END DO1032 !1033 ii0 = 160 ; ii1 = 160 ! Bab el Mandeb (e2u and e1v were modified)1034 ij0 = 88 ; ij1 = 881035 DO jk = 1, jpkm11036 DO jj = mj0(ij0), mj1(ij1)1037 DO ji = mi0(ii0), mi1(ii1)1038 SELECT CASE ( pout )1039 CASE( 'U' )1040 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1041 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1042 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1043 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1044 CASE( 'V' )1045 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1046 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1047 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1048 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1049 CASE( 'F' )1050 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1051 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1052 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1053 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1054 END SELECT1055 END DO1056 END DO1057 END DO1058 ENDIF1059 1060 ii0 = 145 ; ii1 = 146 ! Danish Straits (e2u was modified)1061 ij0 = 116 ; ij1 = 1161062 DO jk = 1, jpkm11063 DO jj = mj0(ij0), mj1(ij1)1064 DO ji = mi0(ii0), mi1(ii1)1065 SELECT CASE ( pout )1066 CASE( 'U' )1067 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1068 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1069 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1070 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1071 CASE( 'F' )1072 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1073 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1074 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1075 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1076 END SELECT1077 END DO1078 END DO1079 END DO1080 ENDIF1081 !1082 ! ! =====================1083 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration1084 ! ! =====================1085 !1086 ii0 = 281 ; ii1 = 282 ! Gibraltar Strait (e2u was modified)1087 ij0 = 200 ; ij1 = 2001088 DO jk = 1, jpkm11089 DO jj = mj0(ij0), mj1(ij1)1090 DO ji = mi0(ii0), mi1(ii1)1091 SELECT CASE ( pout )1092 CASE( 'U' )1093 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1094 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1095 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1096 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1097 CASE( 'F' )1098 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1099 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1100 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1101 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1102 END SELECT1103 END DO1104 END DO1105 END DO1106 !1107 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u was modified)1108 ij0 = 208 ; ij1 = 2081109 DO jk = 1, jpkm11110 DO jj = mj0(ij0), mj1(ij1)1111 DO ji = mi0(ii0), mi1(ii1)1112 SELECT CASE ( pout )1113 CASE( 'U' )1114 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1115 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1116 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1117 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1118 CASE( 'F' )1119 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1120 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1121 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1122 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1123 END SELECT1124 END DO1125 END DO1126 END DO1127 !1128 ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v was modified)1129 ij0 = 124 ; ij1 = 1251130 DO jk = 1, jpkm11131 DO jj = mj0(ij0), mj1(ij1)1132 DO ji = mi0(ii0), mi1(ii1)1133 SELECT CASE ( pout )1134 CASE( 'V' )1135 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1136 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1137 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1138 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1139 END SELECT1140 END DO1141 END DO1142 END DO1143 !1144 ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v was modified) [closed from bathy_11 on]1145 ij0 = 124 ; ij1 = 1251146 DO jk = 1, jpkm11147 DO jj = mj0(ij0), mj1(ij1)1148 DO ji = mi0(ii0), mi1(ii1)1149 SELECT CASE ( pout )1150 CASE( 'V' )1151 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1152 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1153 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1154 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1155 END SELECT1156 END DO1157 END DO1158 END DO1159 !1160 ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v was modified)1161 ij0 = 124 ; ij1 = 1251162 DO jk = 1, jpkm11163 DO jj = mj0(ij0), mj1(ij1)1164 DO ji = mi0(ii0), mi1(ii1)1165 SELECT CASE ( pout )1166 CASE( 'V' )1167 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1168 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1169 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1170 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1171 END SELECT1172 END DO1173 END DO1174 END DO1175 !1176 ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v was modified)1177 ij0 = 124 ; ij1 = 1251178 DO jk = 1, jpkm11179 DO jj = mj0(ij0), mj1(ij1)1180 DO ji = mi0(ii0), mi1(ii1)1181 SELECT CASE ( pout )1182 CASE( 'V' )1183 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1184 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1185 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1186 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1187 END SELECT1188 END DO1189 END DO1190 END DO1191 !1192 ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v was modified)1193 ij0 = 141 ; ij1 = 1421194 DO jk = 1, jpkm11195 DO jj = mj0(ij0), mj1(ij1)1196 DO ji = mi0(ii0), mi1(ii1)1197 SELECT CASE ( pout )1198 CASE( 'V' )1199 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1200 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1201 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1202 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1203 END SELECT1204 END DO1205 END DO1206 END DO1207 !1208 ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v was modified)1209 ij0 = 141 ; ij1 = 1421210 DO jk = 1, jpkm11211 DO jj = mj0(ij0), mj1(ij1)1212 DO ji = mi0(ii0), mi1(ii1)1213 SELECT CASE ( pout )1214 CASE( 'V' )1215 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1216 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1217 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1218 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1219 END SELECT1220 END DO1221 END DO1222 END DO1223 ENDIF1224 ! ! =====================1225 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration1226 ! ! =====================1227 !1228 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u was modified)1229 ij0 = 327 ; ij1 = 3271230 DO jk = 1, jpkm11231 DO jj = mj0(ij0), mj1(ij1)1232 DO ji = mi0(ii0), mi1(ii1)1233 SELECT CASE ( pout )1234 CASE( 'U' )1235 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1236 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1237 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1238 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1239 CASE( 'F' )1240 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1241 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1242 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1243 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1244 END SELECT1245 END DO1246 END DO1247 END DO1248 !1249 ii0 = 627 ; ii1 = 628 ! Bosphorus Strait (e2u was modified)1250 ij0 = 343 ; ij1 = 3431251 DO jk = 1, jpkm11252 DO jj = mj0(ij0), mj1(ij1)1253 DO ji = mi0(ii0), mi1(ii1)1254 SELECT CASE ( pout )1255 CASE( 'U' )1256 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1257 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1258 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1259 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1260 CASE( 'F' )1261 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1262 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1263 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1264 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1265 END SELECT1266 END DO1267 END DO1268 END DO1269 !1270 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u was modified)1271 ij0 = 232 ; ij1 = 2321272 DO jk = 1, jpkm11273 DO jj = mj0(ij0), mj1(ij1)1274 DO ji = mi0(ii0), mi1(ii1)1275 SELECT CASE ( pout )1276 CASE( 'U' )1277 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1278 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1279 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1280 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1281 CASE( 'F' )1282 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1283 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1284 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1285 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1286 END SELECT1287 END DO1288 END DO1289 END DO1290 !1291 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u was modified)1292 ij0 = 232 ; ij1 = 2321293 DO jk = 1, jpkm11294 DO jj = mj0(ij0), mj1(ij1)1295 DO ji = mi0(ii0), mi1(ii1)1296 SELECT CASE ( pout )1297 CASE( 'U' )1298 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1299 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1300 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1301 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1302 CASE( 'F' )1303 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1304 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1305 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1306 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1307 END SELECT1308 END DO1309 END DO1310 END DO1311 !1312 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u was modified)1313 ij0 = 270 ; ij1 = 2701314 DO jk = 1, jpkm11315 DO jj = mj0(ij0), mj1(ij1)1316 DO ji = mi0(ii0), mi1(ii1)1317 SELECT CASE ( pout )1318 CASE( 'U' )1319 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1320 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1321 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1322 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1323 CASE( 'F' )1324 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1325 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1326 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1327 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1328 END SELECT1329 END DO1330 END DO1331 END DO1332 !1333 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v was modified)1334 ij0 = 232 ; ij1 = 2331335 DO jk = 1, jpkm11336 DO jj = mj0(ij0), mj1(ij1)1337 DO ji = mi0(ii0), mi1(ii1)1338 SELECT CASE ( pout )1339 CASE( 'V' )1340 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1341 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1342 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1343 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1344 END SELECT1345 END DO1346 END DO1347 END DO1348 !1349 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v was modified)1350 ij0 = 276 ; ij1 = 2761351 DO jk = 1, jpkm11352 DO jj = mj0(ij0), mj1(ij1)1353 DO ji = mi0(ii0), mi1(ii1)1354 SELECT CASE ( pout )1355 CASE( 'V' )1356 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1357 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1358 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1359 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1360 END SELECT1361 END DO1362 END DO1363 END DO1364 ENDIF1365 END SUBROUTINE dom_vvl_orca_fix1366 1367 967 !!====================================================================== 1368 968 END MODULE domvvl -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r4596 r4616 485 485 zmsv = 1. / MAX( umask(ji-1,jj+1,jk) + umask(ji ,jj+1,jk) & 486 486 + umask(ji-1,jj ,jk) + umask(ji ,jj ,jk) , 1. ) 487 zphv = ( zprn(ji ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) /e1u(ji-1,jj+1) &488 + ( zprn(ji+1,jj+1,jk) - zprn(ji ,jj+1,jk) ) * umask(ji ,jj+1,jk) /e1u(ji ,jj+1) &489 + ( zprn(ji ,jj ,jk) - zprn(ji-1,jj ,jk) ) * umask(ji-1,jj ,jk) /e1u(ji-1,jj ) &490 + ( zprn(ji+1,jj ,jk) - zprn(ji ,jj ,jk) ) * umask(ji ,jj ,jk) /e1u(ji ,jj )487 zphv = ( zprn(ji ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) * r1_e1u(ji-1,jj+1) & 488 + ( zprn(ji+1,jj+1,jk) - zprn(ji ,jj+1,jk) ) * umask(ji ,jj+1,jk) * r1_e1u(ji ,jj+1) & 489 + ( zprn(ji ,jj ,jk) - zprn(ji-1,jj ,jk) ) * umask(ji-1,jj ,jk) * r1_e1u(ji-1,jj ) & 490 + ( zprn(ji+1,jj ,jk) - zprn(ji ,jj ,jk) ) * umask(ji ,jj ,jk) * r1_e1u(ji ,jj ) 491 491 zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk) 492 492 493 493 zmsu = 1. / MAX( vmask(ji+1,jj ,jk) + vmask(ji ,jj ,jk) & 494 494 + vmask(ji+1,jj-1,jk) + vmask(ji ,jj-1,jk) , 1. ) 495 zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj ,jk) ) * vmask(ji+1,jj ,jk) /e2v(ji+1,jj ) &496 + ( zprn(ji ,jj+1,jk) - zprn(ji ,jj ,jk) ) * vmask(ji ,jj ,jk) /e2v(ji ,jj ) &497 + ( zprn(ji+1,jj ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) /e2v(ji+1,jj-1) &498 + ( zprn(ji ,jj ,jk) - zprn(ji ,jj-1,jk) ) * vmask(ji ,jj-1,jk) /e2v(ji ,jj-1)495 zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj ,jk) ) * vmask(ji+1,jj ,jk) * r1_e2v(ji+1,jj ) & 496 + ( zprn(ji ,jj+1,jk) - zprn(ji ,jj ,jk) ) * vmask(ji ,jj ,jk) * r1_e2v(ji ,jj ) & 497 + ( zprn(ji+1,jj ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) * r1_e2v(ji+1,jj-1) & 498 + ( zprn(ji ,jj ,jk) - zprn(ji ,jj-1,jk) ) * vmask(ji ,jj-1,jk) * r1_e2v(ji ,jj-1) 499 499 zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk) 500 500 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r4596 r4616 57 57 !! 58 58 !! ** Method : the now divergence is computed as : 59 !! hdivn = 1/(e1 t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )59 !! hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 60 60 !! and correct with runoff inflow (div_rnf) and cross land flow (div_cla) 61 61 !! -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r3294 r4616 52 52 ! 53 53 INTEGER :: ji, jj, jk ! dummy loop indices 54 REAL(wp) :: zbu, zbv ! local scalars55 54 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 56 55 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu, zfv … … 89 88 DO jj = 2, jpjm1 ! divergence of horizontal momentum fluxes 90 89 DO ji = fs_2, fs_jpim1 ! vector opt. 91 zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)92 zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)93 !94 90 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj ,jk) - zfu_t(ji ,jj ,jk) & 95 & + zfv_f(ji ,jj ,jk) - zfv_f(ji ,jj-1,jk) ) / zbu91 & + zfv_f(ji ,jj ,jk) - zfv_f(ji ,jj-1,jk) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 96 92 va(ji,jj,jk) = va(ji,jj,jk) - ( zfu_f(ji ,jj ,jk) - zfu_f(ji-1,jj ,jk) & 97 & + zfv_t(ji ,jj+1,jk) - zfv_t(ji ,jj ,jk) ) / zbv93 & + zfv_t(ji ,jj+1,jk) - zfv_t(ji ,jj ,jk) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 98 94 END DO 99 95 END DO … … 113 109 DO jk = 1, jpkm1 ! ==================== ! 114 110 ! ! Vertical volume fluxesÊ 115 zfw(:,:,jk) = 0.25 * e1 t(:,:) *e2t(:,:) * wn(:,:,jk)111 zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) 116 112 ! 117 113 IF( jk == 1 ) THEN ! surface/bottom advective fluxes … … 143 139 DO ji = fs_2, fs_jpim1 ! vector opt. 144 140 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) & 145 & / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )141 & / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 146 142 va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) & 147 & / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )143 & / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 148 144 END DO 149 145 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r4153 r4616 183 183 DO jj = 2, jpjm1 ! divergence of horizontal momentum fluxes 184 184 DO ji = fs_2, fs_jpim1 ! vector opt. 185 zbu = e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk)186 zbv = e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk)185 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 186 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 187 187 ! 188 188 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj ,jk) - zfu_t(ji ,jj ,jk) & … … 205 205 DO jk = 1, jpkm1 ! ==================== ! 206 206 ! ! Vertical volume fluxesÊ 207 zfw(:,:,jk) = 0.25 * e1 t(:,:) *e2t(:,:) * wn(:,:,jk)207 zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) 208 208 ! 209 209 IF( jk == 1 ) THEN ! surface/bottom advective fluxes … … 235 235 DO ji = fs_2, fs_jpim1 ! vector opt. 236 236 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) & 237 & / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )237 & / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 238 238 va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) & 239 & / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )239 & / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 240 240 END DO 241 241 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
r3294 r4616 33 33 # include "vectopt_loop_substitute.h90" 34 34 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)35 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 36 36 !! $Id$ 37 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 69 69 70 70 71 # if defined key_vectopt_loop72 DO jj = 1, 173 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)74 # else75 71 DO jj = 2, jpjm1 76 72 DO ji = 2, jpim1 77 # endif78 73 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 79 74 ikbv = mbkv(ji,jj) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r4596 r4616 60 60 # include "vectopt_loop_substitute.h90" 61 61 !!---------------------------------------------------------------------- 62 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)62 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 63 63 !! $Id$ 64 64 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 217 217 zcoef1 = zcoef0 * fse3w(ji,jj,1) 218 218 ! hydrostatic pressure gradient 219 zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) /e1u(ji,jj)220 zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) /e2v(ji,jj)219 zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 220 zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 221 221 ! add to the general momentum trend 222 222 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) … … 234 234 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & 235 235 & + zcoef1 * ( ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) ) & 236 & - ( rhd(ji ,jj,jk)+rhd(ji ,jj,jk-1) ) ) /e1u(ji,jj)236 & - ( rhd(ji ,jj,jk)+rhd(ji ,jj,jk-1) ) ) * r1_e1u(ji,jj) 237 237 238 238 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 239 239 & + zcoef1 * ( ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) ) & 240 & - ( rhd(ji,jj, jk)+rhd(ji,jj ,jk-1) ) ) /e2v(ji,jj)240 & - ( rhd(ji,jj, jk)+rhd(ji,jj ,jk-1) ) ) * r1_e2v(ji,jj) 241 241 ! add to the general momentum trend 242 242 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) … … 284 284 zcoef1 = zcoef0 * fse3w(ji,jj,1) 285 285 ! hydrostatic pressure gradient 286 zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj ,1) - rhd(ji,jj,1) ) /e1u(ji,jj)287 zhpj(ji,jj,1) = zcoef1 * ( rhd(ji ,jj+1,1) - rhd(ji,jj,1) ) /e2v(ji,jj)286 zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 287 zhpj(ji,jj,1) = zcoef1 * ( rhd(ji ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 288 288 ! add to the general momentum trend 289 289 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) … … 300 300 ! hydrostatic pressure gradient 301 301 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & 302 & + zcoef1 * ( ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) ) &303 & - ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) ) ) /e1u(ji,jj)302 & + zcoef1 * ( ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) ) & 303 & - ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) ) ) * r1_e1u(ji,jj) 304 304 305 305 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 306 & + zcoef1 * ( ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) ) &307 & - ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) ) ) /e2v(ji,jj)306 & + zcoef1 * ( ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) ) & 307 & - ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) ) ) * r1_e2v(ji,jj) 308 308 ! add to the general momentum trend 309 309 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) … … 315 315 316 316 ! partial steps correction at the last level (use gru & grv computed in zpshde.F90) 317 # if defined key_vectopt_loop318 jj = 1319 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)320 # else321 317 DO jj = 2, jpjm1 322 318 DO ji = 2, jpim1 323 # endif324 319 iku = mbku(ji,jj) 325 320 ikv = mbkv(ji,jj) … … 329 324 ua (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku) ! subtract old value 330 325 zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1) & ! compute the new one 331 & + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) /e1u(ji,jj)326 & + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) * r1_e1u(ji,jj) 332 327 ua (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku) ! add the new one to the general momentum trend 333 328 ENDIF … … 335 330 va (ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv) ! subtract old value 336 331 zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1) & ! compute the new one 337 & + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) /e2v(ji,jj)332 & + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) * r1_e2v(ji,jj) 338 333 va (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv) ! add the new one to the general momentum trend 339 334 ENDIF 340 # if ! defined key_vectopt_loop 341 END DO 342 # endif 335 END DO 343 336 END DO 344 337 ! … … 392 385 DO ji = fs_2, fs_jpim1 ! vector opt. 393 386 ! hydrostatic pressure gradient along s-surfaces 394 zhpi(ji,jj,1) = zcoef0 /e1u(ji,jj) * ( fse3w(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) ) &395 & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) )396 zhpj(ji,jj,1) = zcoef0 /e2v(ji,jj) * ( fse3w(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) ) &397 & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) )387 zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( fse3w(ji+1,jj ,1) * ( znad + rhd(ji+1,jj ,1) ) & 388 & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) 389 zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( fse3w(ji ,jj+1,1) * ( znad + rhd(ji ,jj+1,1) ) & 390 & - fse3w(ji ,jj ,1) * ( znad + rhd(ji ,jj ,1) ) ) 398 391 ! s-coordinate pressure gradient correction 399 392 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & 400 & * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) /e1u(ji,jj)393 & * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) * r1_e1u(ji,jj) 401 394 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 402 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) /e2v(ji,jj)395 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) * r1_e2v(ji,jj) 403 396 ! add to the general momentum trend 404 397 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap … … 406 399 END DO 407 400 END DO 401 402 !!gm 403 !!gm Idea of optimization here : only divide by e1u and e2v when apply to ua, va .... 404 !!gm 408 405 409 406 ! interior value (2=<jk=<jpkm1) … … 412 409 DO ji = fs_2, fs_jpim1 ! vector opt. 413 410 ! hydrostatic pressure gradient along s-surfaces 414 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 /e1u(ji,jj) &411 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj) & 415 412 & * ( fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) & 416 413 & - fse3w(ji ,jj,jk) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) ) 417 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 /e2v(ji,jj) &414 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj) & 418 415 & * ( fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) & 419 416 & - fse3w(ji,jj ,jk) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) ) 420 417 ! s-coordinate pressure gradient correction 421 418 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 422 & * ( fsde3w(ji+1,jj ,jk) - fsde3w(ji,jj,jk) ) /e1u(ji,jj)419 & * ( fsde3w(ji+1,jj ,jk) - fsde3w(ji,jj,jk) ) * r1_e1u(ji,jj) 423 420 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 424 & * ( fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk) ) /e2v(ji,jj)421 & * ( fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk) ) * r1_e2v(ji,jj) 425 422 ! add to the general momentum trend 426 423 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap … … 625 622 DO jj = 2, jpjm1 626 623 DO ji = fs_2, fs_jpim1 ! vector opt. 627 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) /e1u(ji,jj)628 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) /e2v(ji,jj)624 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 625 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 629 626 ! add to the general momentum trend 630 627 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) … … 642 639 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & 643 640 & + ( ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk ) ) & 644 & - ( rho_i(ji ,jj,jk) - rho_i(ji,jj,jk-1) ) ) /e1u(ji,jj)641 & - ( rho_i(ji ,jj,jk) - rho_i(ji,jj,jk-1) ) ) * r1_e1u(ji,jj) 645 642 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 646 643 & + ( ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk ) ) & 647 & -( rho_j(ji,jj ,jk) - rho_j(ji,jj,jk-1) ) ) /e2v(ji,jj)644 & -( rho_j(ji,jj ,jk) - rho_j(ji,jj,jk-1) ) ) * r1_e2v(ji,jj) 648 645 ! add to the general momentum trend 649 646 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) … … 853 850 ! update the momentum trends in u direction 854 851 855 zdpdx1 = zcoef0 /e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk))852 zdpdx1 = zcoef0 * r1_e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 856 853 IF( lk_vvl ) THEN 857 zdpdx2 = zcoef0 /e1u(ji,jj) * &854 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 858 855 ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) ) 859 856 ELSE 860 zdpdx2 = zcoef0 /e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed)857 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 861 858 ENDIF 862 859 863 860 ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * & 864 861 & umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,jj,jk) 862 !!gm above it is stupid: umask is equal to the product of the 2 tmask that follows... 865 863 ENDIF 866 864 … … 910 908 ! update the momentum trends in v direction 911 909 912 zdpdy1 = zcoef0 /e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk))910 zdpdy1 = zcoef0 * r1_e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 913 911 IF( lk_vvl ) THEN 914 zdpdy2 = zcoef0 /e2v(ji,jj) * &912 zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 915 913 ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 916 914 ELSE … … 920 918 va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2)*& 921 919 & vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,jk) 920 !!gm above it is stupid: vmask is equal to the product of the 2 tmask that follows... 922 921 ENDIF 923 922 … … 932 931 END SUBROUTINE hpg_prj 933 932 933 934 934 SUBROUTINE cspline(fsp, xsp, asp, bsp, csp, dsp, polynomial_type) 935 935 !!---------------------------------------------------------------------- … … 940 940 !! ** Method : f(x) = asp + bsp*x + csp*x^2 + dsp*x^3 941 941 !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 942 !! 943 !!---------------------------------------------------------------------- 944 IMPLICIT NONE 942 !!---------------------------------------------------------------------- 945 943 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: fsp, xsp ! value and coordinate 946 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of 947 ! the interpoated function 944 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of the interpolated function 948 945 INTEGER, INTENT(in) :: polynomial_type ! 1: cubic spline 949 ! 2: Linear 950 951 ! Local Variables 946 ! ! 2: Linear 947 ! 952 948 INTEGER :: ji, jj, jk ! dummy loop indices 953 949 INTEGER :: jpi, jpj, jpkm1 … … 1038 1034 CALL ctl_stop( 'invalid polynomial type in cspline' ) 1039 1035 ENDIF 1040 1041 1036 ! 1042 1037 END SUBROUTINE cspline 1043 1038 … … 1069 1064 END FUNCTION interp1 1070 1065 1066 1071 1067 FUNCTION interp2(x, a, b, c, d) RESULT(f) 1072 1068 !!---------------------------------------------------------------------- -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r3294 r4616 99 99 DO jj = 2, jpjm1 ! add the gradient of kinetic energy to the general momentum trends 100 100 DO ji = fs_2, fs_jpim1 ! vector opt. 101 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) /e1u(ji,jj)102 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) /e2v(ji,jj)101 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) * r1_e1u(ji,jj) 102 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) * r1_e2v(ji,jj) 103 103 END DO 104 104 END DO … … 112 112 ! & - un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 113 113 ! & - vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 114 ! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) /e1u(ji,jj)114 ! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) * r1_e1u(ji,jj) 115 115 ! ! 116 116 ! va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * ( un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk) & … … 120 120 ! & - un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 121 121 ! & - un(ji ,jj ,jk) * un(ji ,jj ,jk) & 122 ! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) /e2v(ji,jj)122 ! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) * r1_e2v(ji,jj) 123 123 ! END DO 124 124 ! END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r4596 r4616 161 161 !! =========== pu as follows (idem on pv) 162 162 !! vertical fluxes : 163 !! zftw = e1 t*e2t/e3w * (ahm*wslpi^2+ahm*wslpj^2) dk-1[ pu ]164 !! - 165 !! - 163 !! zftw = e1e2t/e3w * (ahm*wslpi^2+ahm*wslpj^2) dk-1[ pu ] 164 !! - e2t * ahm*wslpi di[ mi(mk(pu)) ] 165 !! - e1t * ahm*wslpj dj[ mj(mk(pu)) ] 166 166 !! take the vertical divergence of the fluxes add it to the hori- 167 167 !! zontal component, divide the result by the volume element : 168 !! plu = zsign / (e1 t*e2t*e3t) { plu + dk[ zftw ] }168 !! plu = zsign / (e1e2t*e3t) { plu + dk[ zftw ] } 169 169 !! where zsign=+1 if kahm =1 (laplacian or 1st pass of bilaplacian) 170 170 !! =-1 if kahm =2 (2nd pass in case of bilaplacian) … … 369 369 zuwslpj = 0.5 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 370 370 ! coef. for the vertical dirative 371 zcoef0 = e1 u(ji,jj) *e2u(ji,jj) / fse3u(ji,jj,jk) &371 zcoef0 = e1e2u(ji,jj) / fse3u(ji,jj,jk) & 372 372 & * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) 373 373 ! weights for the i-k, j-k averaging at t- and f-points, resp. … … 403 403 zvwslpj = 0.5 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) ) 404 404 ! coef. for the vertical derivative 405 zcoef0 = e1 v(ji,jj) *e2v(ji,jj) / fse3v(ji,jj,jk) &405 zcoef0 = e1e2v(ji,jj) / fse3v(ji,jj,jk) & 406 406 & * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) 407 407 !!gm caution here fmask multiplication already done in the def of ahmf... … … 439 439 zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 440 440 ! harmonic operator applied to (pu,pv) and multiply by ahm 441 plu(ji,jj,jk) = zsign * ( plu(ji,jj,jk) + zuav ) / ( e1 u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )442 plv(ji,jj,jk) = zsign * ( plv(ji,jj,jk) + zvav ) / ( e1 v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )441 plu(ji,jj,jk) = zsign * ( plu(ji,jj,jk) + zuav ) / ( e1e2u(ji,jj)*fse3u(ji,jj,jk) ) 442 plv(ji,jj,jk) = zsign * ( plv(ji,jj,jk) + zvav ) / ( e1e2v(ji,jj)*fse3v(ji,jj,jk) ) 443 443 END DO 444 444 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r4596 r4616 110 110 INTEGER :: ji, jj, jk ! dummy loop indices 111 111 REAL(wp) :: zabe1, zabe2, zcof1, zcof2 ! local scalars 112 REAL(wp) :: zmskt, zmskf , zbu, zbv, zuah, zvah! - -112 REAL(wp) :: zmskt, zmskf ! - - 113 113 REAL(wp) :: zcoef0, zcoef3, zcoef4, zmkt, zmkf ! - - 114 114 REAL(wp) :: zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - … … 135 135 DO jj = 2, jpjm1 136 136 DO ji = 2, jpim1 137 uslp (ji,jj,jk) = - 1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk)) * umask(ji,jj,jk)138 vslp (ji,jj,jk) = - 1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk)) * vmask(ji,jj,jk)139 wslpi(ji,jj,jk) = - 1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk)) * tmask(ji,jj,jk) * 0.5140 wslpj(ji,jj,jk) = - 1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk)) * tmask(ji,jj,jk) * 0.5137 uslp (ji,jj,jk) = - ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 138 vslp (ji,jj,jk) = - ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 139 wslpi(ji,jj,jk) = - ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 140 wslpj(ji,jj,jk) = - ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 141 141 END DO 142 142 END DO … … 183 183 DO jj = 2, jpjm1 184 184 DO ji = fs_2, jpi ! vector opt. 185 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) /e1t(ji,jj)185 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) * r1_e1t(ji,jj) 186 186 187 187 zmskt = 1._wp / MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & … … 198 198 DO jj = 2, jpjm1 199 199 DO ji = fs_2, jpi ! vector opt. 200 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) /e1t(ji,jj)200 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) * r1_e1t(ji,jj) 201 201 202 202 zmskt = 1._wp / MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk+1) & … … 215 215 DO jj = 1, jpjm1 216 216 DO ji = 1, fs_jpim1 ! vector opt. 217 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) /e2f(ji,jj)217 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) * r1_e2f(ji,jj) 218 218 219 219 zmskf = 1._wp / MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & … … 236 236 DO jj = 2, jpjm1 237 237 DO ji = 1, fs_jpim1 ! vector opt. 238 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) /e1f(ji,jj)238 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) * r1_e1f(ji,jj) 239 239 240 240 zmskf = 1._wp / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & … … 253 253 DO jj = 2, jpj 254 254 DO ji = 1, fs_jpim1 ! vector opt. 255 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) /e2t(ji,jj)255 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) * r1_e2t(ji,jj) 256 256 257 257 zmskt = 1._wp / MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & … … 268 268 DO jj = 2, jpj 269 269 DO ji = 1, fs_jpim1 ! vector opt. 270 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) /e2t(ji,jj)270 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) * r1_e2t(ji,jj) 271 271 272 272 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & … … 285 285 ! Second derivative (divergence) and add to the general trend 286 286 ! ----------------------------------------------------------- 287 288 287 DO jj = 2, jpjm1 289 288 DO ji = 2, jpim1 !! Question vectop possible??? !!bug 290 ! volume elements 291 zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 292 zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 293 ! horizontal component of isopycnal momentum diffusive trends 294 zuah =( ziut (ji+1,jj) - ziut (ji,jj ) + & 295 & zjuf (ji ,jj) - zjuf (ji,jj-1) ) / zbu 296 zvah =( zivf (ji,jj ) - zivf (ji-1,jj) + & 297 & zjvt (ji,jj+1) - zjvt (ji,jj ) ) / zbv 298 ! add the trends to the general trends 299 ua (ji,jj,jk) = ua (ji,jj,jk) + zuah 300 va (ji,jj,jk) = va (ji,jj,jk) + zvah 289 ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj ) & 290 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 291 va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj ) - zivf(ji-1,jj) & 292 & + zjvt(ji,jj+1) - zjvt(ji,jj ) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 301 293 END DO 302 294 END DO … … 411 403 DO jk = 1, jpkm1 412 404 DO ji = 2, jpim1 413 ! volume elements 414 zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 415 zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 416 ! part of the k-component of isopycnal momentum diffusive trends 417 zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu 418 zvav = ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / zbv 419 ! add the trends to the general trends 420 ua(ji,jj,jk) = ua(ji,jj,jk) + zuav 421 va(ji,jj,jk) = va(ji,jj,jk) + zvav 405 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 406 va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 422 407 END DO 423 408 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
r4596 r4616 89 89 DO ji = fs_2, jpi ! vector opt. 90 90 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 91 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) / ( e1f(ji-1,jj-1) * e2f(ji-1,jj-1) )&91 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & 92 92 & * ( e2v(ji ,jj-1) * pvb(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk) & 93 93 & - e1u(ji-1,jj ) * pub(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk) ) * fmask(ji-1,jj-1,jk) … … 101 101 DO jj = 2, jpjm1 ! - curl( curl) + grad( div ) 102 102 DO ji = fs_2, fs_jpim1 ! vector opt. 103 pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * ( &104 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) &105 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) /e1u(ji,jj) )103 pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * ( & 104 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 105 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 106 106 ! 107 pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * ( &108 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) &109 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) /e2v(ji,jj) )107 pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * ( & 108 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 109 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 110 110 END DO 111 111 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
r4372 r4616 349 349 !! ** Method : - Divergence: 350 350 !! - compute the divergence given by : 351 !! zhdivnep = 1/(e1 t*e2t*e3t) ( di[e2u*e3u zunep] + dj[e1v*e3v zvnep] )351 !! zhdivnep = 1/(e1e2t*e3t) ( di[e2u*e3u zunep] + dj[e1v*e3v zvnep] ) 352 352 !! - compute the curl in tensorial formalism: 353 353 !! zmrotnep = 1/(e1f*e2f) ( di[e2v zvnep] - dj[e1u zunep] ) … … 414 414 & + e1v(ji ,jj )*fse3v(ji ,jj ,jk) * zvnep(ji ,jj ) * vmask(ji ,jj ,jk) & 415 415 & - e1v(ji ,jj-1)*fse3v(ji ,jj-1,jk) * zvnep(ji ,jj-1) * vmask(ji ,jj-1,jk) ) & 416 & / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )416 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 417 417 END DO 418 418 END DO … … 435 435 & - e1u(ji ,jj+1) * zunep(ji ,jj+1) * umask(ji ,jj+1,jk) & 436 436 & + e1u(ji ,jj ) * zunep(ji ,jj ) * umask(ji ,jj ,jk) ) & 437 & * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj))437 & * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) 438 438 END DO 439 439 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r4370 r4616 53 53 # include "domzgr_substitute.h90" 54 54 !!---------------------------------------------------------------------- 55 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)55 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 56 56 !! $Id$ 57 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 335 335 ! 336 336 DO jk = 1, jpkm1 337 #if defined key_vectopt_loop338 DO jj = 1, 1 !Vector opt. => forced unrolling339 DO ji = 1, jpij340 #else341 337 DO jj = 1, jpj 342 338 DO ji = 1, jpi 343 #endif344 339 un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 345 340 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r4496 r4616 120 120 DO ji = fs_2, fs_jpim1 ! vector opt. 121 121 spgu(ji,jj) = spgu(ji,jj) + zg_2 * ( ssh_ib (ji+1,jj) - ssh_ib (ji,jj) & 122 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) /e1u(ji,jj)122 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 123 123 spgv(ji,jj) = spgv(ji,jj) + zg_2 * ( ssh_ib (ji,jj+1) - ssh_ib (ji,jj) & 124 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) /e2v(ji,jj)124 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 125 125 END DO 126 126 END DO … … 134 134 DO jj = 2, jpjm1 ! add tide potential forcing 135 135 DO ji = fs_2, fs_jpim1 ! vector opt. 136 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) /e1u(ji,jj)137 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) /e2v(ji,jj)136 spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 137 spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 138 138 END DO 139 139 END DO … … 148 148 DO jj = 2, jpjm1 149 149 DO ji = fs_2, fs_jpim1 ! vector opt. 150 spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) /e1u(ji,jj)151 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) /e2v(ji,jj)150 spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 151 spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 152 152 END DO 153 153 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r4328 r4616 25 25 USE iom ! I/O library 26 26 USE timing ! Timing 27 28 27 29 28 IMPLICIT NONE … … 80 79 DO jj = 2, jpjm1 ! now surface pressure gradient 81 80 DO ji = fs_2, fs_jpim1 ! vector opt. 82 spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) /e1u(ji,jj)83 spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) /e2v(ji,jj)81 spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 82 spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 84 83 END DO 85 84 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r4328 r4616 166 166 DO jj = 2, jpjm1 ! Surface pressure gradient (now) 167 167 DO ji = fs_2, fs_jpim1 ! vector opt. 168 spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) /e1u(ji,jj)169 spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) /e2v(ji,jj)168 spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 169 spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 170 170 END DO 171 171 END DO … … 192 192 ! compute the next vertically averaged velocity (effect of the additional force not included) 193 193 ! --------------------------------------------- 194 ! vertical sum 194 195 DO jj = 2, jpjm1 195 196 DO ji = fs_2, fs_jpim1 ! vector opt. 196 spgu(ji,jj) = 0._wp 197 spgv(ji,jj) = 0._wp 198 END DO 199 END DO 200 201 ! vertical sum 202 !CDIR NOLOOPCHG 203 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 204 DO jk = 1, jpkm1 205 DO ji = 1, jpij 206 spgu(ji,1) = spgu(ji,1) + fse3u_a(ji,1,jk) * ua(ji,1,jk) 207 spgv(ji,1) = spgv(ji,1) + fse3v_a(ji,1,jk) * va(ji,1,jk) 208 END DO 209 END DO 210 ELSE ! No vector opt. 211 DO jk = 1, jpkm1 212 DO jj = 2, jpjm1 213 DO ji = 2, jpim1 214 spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 215 spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 216 END DO 217 END DO 218 END DO 219 ENDIF 197 spgu(ji,jj) = fse3u_a(ji,jj,1) * ua(ji,jj,1) 198 spgv(ji,jj) = fse3v_a(ji,jj,1) * va(ji,jj,1) 199 END DO 200 END DO 201 DO jk = 2, jpkm1 202 DO jj = 2, jpjm1 203 DO ji = 2, jpim1 204 spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 205 spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 206 END DO 207 END DO 208 END DO 220 209 221 210 ! transport: multiplied by the horizontal scale factor … … 294 283 DO ji = fs_2, fs_jpim1 ! vector opt. 295 284 ! trend of Transport divergence gradient 296 ztdgu = z2dtg * (gcx(ji+1,jj ) - gcx(ji,jj) ) /e1u(ji,jj)297 ztdgv = z2dtg * (gcx(ji ,jj+1) - gcx(ji,jj) ) /e2v(ji,jj)285 ztdgu = z2dtg * (gcx(ji+1,jj ) - gcx(ji,jj) ) * r1_e1u(ji,jj) 286 ztdgv = z2dtg * (gcx(ji ,jj+1) - gcx(ji,jj) ) * r1_e2v(ji,jj) 298 287 ! multiplied by z2dt 299 288 #if defined key_bdy -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4496 r4616 75 75 # include "vectopt_loop_substitute.h90" 76 76 !!---------------------------------------------------------------------- 77 !! NEMO/OPA 3. 5 , NEMO Consortium (2013)77 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 78 78 !! $Id: dynspg_ts.F90 79 79 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 104 104 ! 105 105 END FUNCTION dyn_spg_ts_alloc 106 106 107 107 108 SUBROUTINE dyn_spg_ts( kt ) … … 290 291 ! 291 292 DO jk = 1, jpkm1 292 #if defined key_vectopt_loop293 DO jj = 1, 1 !Vector opt. => forced unrolling294 DO ji = 1, jpij295 #else296 293 DO jj = 1, jpj 297 294 DO ji = 1, jpi 298 #endif299 295 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 300 296 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) … … 324 320 DO jj = 2, jpjm1 325 321 DO ji = fs_2, fs_jpim1 ! vector opt. 326 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)327 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) / e1u(ji,jj)328 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)329 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) / e2v(ji,jj)322 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) 323 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) 324 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) 325 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) 330 326 ! energy conserving formulation for planetary vorticity term 331 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )332 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )327 zu_trd(ji,jj) = z1_4 * r1_e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 328 zv_trd(ji,jj) =-z1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 333 329 END DO 334 330 END DO … … 338 334 DO ji = fs_2, fs_jpim1 ! vector opt. 339 335 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 340 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)336 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 341 337 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 342 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)338 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 343 339 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 344 340 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 349 345 DO jj = 2, jpjm1 350 346 DO ji = fs_2, fs_jpim1 ! vector opt. 351 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &352 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &353 & + ftse(ji,jj ) * zwy(ji ,jj-1) &354 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )355 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &356 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &357 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &358 & + ftne(ji,jj ) * zwx(ji ,jj ) )347 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 348 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 349 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 350 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 351 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 352 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 353 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 354 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 359 355 END DO 360 356 END DO … … 367 363 DO jj = 2, jpjm1 368 364 DO ji = fs_2, fs_jpim1 ! vector opt. 369 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) /e1u(ji,jj)370 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) /e2v(ji,jj)365 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj) 366 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj) 371 367 END DO 372 368 END DO … … 417 413 DO jj = 2, jpjm1 418 414 DO ji = fs_2, fs_jpim1 ! vector opt. 419 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) /e1u(ji,jj)420 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)415 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 416 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 421 417 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 422 418 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 427 423 DO ji = fs_2, fs_jpim1 ! vector opt. 428 424 zu_spg = grav * z1_2 * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) & 429 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) /e1u(ji,jj)425 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 430 426 zv_spg = grav * z1_2 * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) & 431 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) /e2v(ji,jj)427 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 432 428 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 433 429 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 525 521 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 526 522 DO ji = 2, fs_jpim1 ! Vector opt. 527 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &528 & * ( e1 2t(ji ,jj) * zsshp2_e(ji ,jj) &529 & + e1 2t(ji+1,jj) * zsshp2_e(ji+1,jj) )530 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &531 & * ( e1 2t(ji,jj ) * zsshp2_e(ji,jj ) &532 & + e1 2t(ji,jj+1) * zsshp2_e(ji,jj+1) )523 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 524 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 525 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 526 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 527 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 528 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 533 529 END DO 534 530 END DO … … 578 574 ! Sum over sub-time-steps to compute advective velocities 579 575 za2 = wgtbtp2(jn) 580 zu_sum (:,:) = zu_sum (:,:) + za2 * zwx (:,:) /e2u (:,:)581 zv_sum (:,:) = zv_sum (:,:) + za2 * zwy (:,:) /e1v (:,:)576 zu_sum (:,:) = zu_sum (:,:) + za2 * zwx (:,:) * r1_e2u (:,:) 577 zv_sum (:,:) = zv_sum (:,:) + za2 * zwy (:,:) * r1_e1v (:,:) 582 578 ! 583 579 ! Set next sea level: … … 585 581 DO ji = fs_2, fs_jpim1 ! vector opt. 586 582 zhdiv(ji,jj) = ( zwx(ji,jj) - zwx(ji-1,jj) & 587 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1 2t(ji,jj)583 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1e2t(ji,jj) 588 584 END DO 589 585 END DO … … 603 599 DO jj = 2, jpjm1 604 600 DO ji = 2, jpim1 ! NO Vector Opt. 605 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &606 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &607 & + e1 2t(ji+1,jj ) * ssha_e(ji+1,jj ) )608 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &609 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &610 & + e1 2t(ji ,jj+1) * ssha_e(ji ,jj+1) )601 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 602 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 603 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 604 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 605 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 606 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 611 607 END DO 612 608 END DO … … 642 638 DO jj = 2, jpjm1 643 639 DO ji = 2, jpim1 644 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1 2u(ji ,jj) &645 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj) &646 & + e1 2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) )647 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1 2v(ji ,jj ) &648 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj ) &649 & + e1 2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) )640 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1e2u(ji ,jj) & 641 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj) & 642 & + e1e2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 643 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1e2v(ji ,jj ) & 644 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj ) & 645 & + e1e2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) 650 646 zhust_e(ji,jj) = hu_0(ji,jj) + zx1 651 647 zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 … … 664 660 DO jj = 2, jpjm1 665 661 DO ji = fs_2, fs_jpim1 ! vector opt. 666 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)667 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) / e1u(ji,jj)668 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) / e2v(ji,jj)669 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) / e2v(ji,jj)670 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 671 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 662 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) 663 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) 664 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) 665 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) 666 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) * r1_e1u(ji,jj) 667 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) * r1_e2v(ji,jj) 672 668 END DO 673 669 END DO … … 677 673 DO ji = fs_2, fs_jpim1 ! vector opt. 678 674 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 679 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)675 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 680 676 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 681 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)677 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 682 678 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 683 679 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 688 684 DO jj = 2, jpjm1 689 685 DO ji = fs_2, fs_jpim1 ! vector opt. 690 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &691 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &692 & + ftse(ji,jj ) * zwy(ji ,jj-1) &693 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )694 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &695 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &696 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &697 & + ftne(ji,jj ) * zwx(ji ,jj ) )686 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 687 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 688 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 689 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 690 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 691 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 692 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 693 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 698 694 END DO 699 695 END DO … … 705 701 DO jj = 2, jpjm1 706 702 DO ji = fs_2, fs_jpim1 ! vector opt. 707 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) /e1u(ji,jj)708 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) /e2v(ji,jj)703 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 704 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 709 705 zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg 710 706 zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg … … 721 717 DO ji = fs_2, fs_jpim1 ! vector opt. 722 718 ! Add surface pressure gradient 723 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) /e1u(ji,jj)724 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) /e2v(ji,jj)719 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 720 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 725 721 zwx(ji,jj) = zu_spg 726 722 zwy(ji,jj) = zv_spg … … 827 823 DO jj = 1, jpjm1 828 824 DO ji = 1, jpim1 ! NO Vector Opt. 829 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &830 & * ( e1 2t(ji ,jj) * ssha(ji ,jj) &831 & + e1 2t(ji+1,jj) * ssha(ji+1,jj) )832 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &833 & * ( e1 2t(ji,jj ) * ssha(ji,jj ) &834 & + e1 2t(ji,jj+1) * ssha(ji,jj+1) )825 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 826 & * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 827 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 828 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 829 & * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 830 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 835 831 END DO 836 832 END DO … … 1071 1067 DO jj = 1, jpj 1072 1068 DO ji =1, jpi 1073 zxr2 = 1. /(e1t(ji,jj)*e1t(ji,jj))1074 zyr2 = 1. /(e2t(ji,jj)*e2t(ji,jj))1075 zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) )1069 zxr2 = 1._wp / ( e1t(ji,jj)*e1t(ji,jj) ) 1070 zyr2 = 1._wp / ( e2t(ji,jj)*e2t(ji,jj) ) 1071 zcu(ji,jj) = SQRT( grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 1076 1072 END DO 1077 1073 END DO … … 1079 1075 DO jj = 1, jpj 1080 1076 DO ji =1, jpi 1081 zxr2 = 1. /(e1t(ji,jj)*e1t(ji,jj))1082 zyr2 = 1. /(e2t(ji,jj)*e2t(ji,jj))1083 zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) )1077 zxr2 = 1._wp / ( e1t(ji,jj)*e1t(ji,jj) ) 1078 zyr2 = 1._wp / ( e2t(ji,jj)*e2t(ji,jj) ) 1079 zcu(ji,jj) = SQRT( grav*ht(ji,jj)*(zxr2 + zyr2) ) 1084 1080 END DO 1085 1081 END DO … … 1092 1088 IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1093 1089 1094 rdtbt = rdt / FLOAT(nn_baro)1090 rdtbt = rdt / REAL( nn_baro, wp ) 1095 1091 zcmax = zcmax * rdtbt 1096 1092 ! Print results -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r4596 r4616 245 245 DO ji = 1, fs_jpim1 ! vector opt. 246 246 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 247 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 248 & / ( e1f(ji,jj) * e2f(ji,jj) ) 247 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) * r1_e1e2f(ji,jj) 249 248 END DO 250 249 END DO … … 254 253 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 255 254 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 256 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj))255 & * 0.5 * r1_e1e2f(ji,jj) 257 256 END DO 258 257 END DO … … 262 261 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 263 262 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 264 & / ( e1f(ji,jj) * e2f(ji,jj))263 & * r1_e1e2f(ji,jj) 265 264 END DO 266 265 END DO … … 271 270 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 272 271 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 273 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj))272 & * 0.5 * r1_e1e2f(ji,jj) 274 273 END DO 275 274 END DO … … 293 292 zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 294 293 zx2 = zwx(ji ,jj) + zwx(ji ,jj+1) 295 pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 /e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )296 pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 /e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )294 pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 295 pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 297 296 END DO 298 297 END DO … … 357 356 DO ji = 1, fs_jpim1 ! vector opt. 358 357 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 359 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 360 & / ( e1f(ji,jj) * e2f(ji,jj) ) 358 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) * r1_e1e2f(ji,jj) 361 359 END DO 362 360 END DO … … 366 364 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 367 365 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 368 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj))366 & * 0.5 * r1_e1e2f(ji,jj) 369 367 END DO 370 368 END DO … … 374 372 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 375 373 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 376 & / ( e1f(ji,jj) * e2f(ji,jj))374 & * r1_e1e2f(ji,jj) 377 375 END DO 378 376 END DO … … 383 381 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 384 382 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 385 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj))383 & * 0.5 * r1_e1e2f(ji,jj) 386 384 END DO 387 385 END DO … … 401 399 DO jj = 2, jpjm1 402 400 DO ji = fs_2, fs_jpim1 ! vector opt. 403 zuav = r1_8 /e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) &401 zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 404 402 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) 405 zvau =-r1_8 /e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) &403 zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 406 404 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) 407 405 pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji ,jj-1) + zwz(ji,jj) ) … … 501 499 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 502 500 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 503 & / ( e1f(ji,jj) * e2f(ji,jj)) * r1_e3f(ji,jj,jk)501 & * r1_e1e2f(ji,jj) * r1_e3f(ji,jj,jk) 504 502 END DO 505 503 END DO … … 510 508 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 511 509 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 512 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj)) * r1_e3f(ji,jj,jk)510 & * 0.5 * r1_e1e2f(ji,jj) * r1_e3f(ji,jj,jk) 513 511 END DO 514 512 END DO … … 519 517 zwz(ji,jj) = ( ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 520 518 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 521 & / ( e1f(ji,jj) * e2f(ji,jj)) ) * r1_e3f(ji,jj,jk)519 & * r1_e1e2f(ji,jj) ) * r1_e3f(ji,jj,jk) 522 520 END DO 523 521 END DO … … 529 527 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 530 528 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 531 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj)) ) * r1_e3f(ji,jj,jk)529 & * 0.5 * r1_e1e2f(ji,jj) ) * r1_e3f(ji,jj,jk) 532 530 END DO 533 531 END DO … … 560 558 DO jj = 2, jpjm1 561 559 DO ji = fs_2, fs_jpim1 ! vector opt. 562 zua = + r1_12 /e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) &563 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) )564 zva = - r1_12 /e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) &565 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) )560 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 561 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 562 zva = - r1_12 * r1_e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) & 563 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) ) 566 564 pua(ji,jj,jk) = pua(ji,jj,jk) + zua 567 565 pva(ji,jj,jk) = pva(ji,jj,jk) + zva -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r3294 r4616 47 47 !! 48 48 !! ** Method : The now vertical advection of momentum is given by: 49 !! w dz(u) = ua + 1/(e1 u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]50 !! w dz(v) = va + 1/(e1 v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]49 !! w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ] 50 !! w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ] 51 51 !! Add this trend to the general trend (ua,va): 52 52 !! (ua,va) = (ua,va) + w dz(u,v) … … 83 83 DO jj = 2, jpj ! vertical fluxes 84 84 DO ji = fs_2, jpi ! vector opt. 85 zww(ji,jj) = 0.25 * e1 t(ji,jj) *e2t(ji,jj) * wn(ji,jj,jk)85 zww(ji,jj) = 0.25 * e1e2t(ji,jj) * wn(ji,jj,jk) 86 86 END DO 87 87 END DO … … 106 106 DO ji = fs_2, fs_jpim1 ! vector opt. 107 107 ! ! vertical momentum advective trends 108 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )109 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )108 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 109 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 110 110 ! ! add the trends to the general momentum trends 111 111 ua(ji,jj,jk) = ua(ji,jj,jk) + zua -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4370 r4616 39 39 # include "vectopt_loop_substitute.h90" 40 40 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)41 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 42 42 !! $Id$ 43 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 101 101 102 102 IF( ln_bfrimp ) THEN 103 # if defined key_vectopt_loop104 DO jj = 1, 1105 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)106 # else107 103 DO jj = 2, jpjm1 108 104 DO ji = 2, jpim1 109 # endif110 105 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 111 106 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) … … 352 347 !! restore bottom layer avmu(v) 353 348 IF( ln_bfrimp ) THEN 354 # if defined key_vectopt_loop 355 DO jj = 1, 1 356 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 357 # else 358 DO jj = 2, jpjm1 359 DO ji = 2, jpim1 360 # endif 361 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 362 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 363 avmu(ji,jj,ikbu+1) = 0.e0 364 avmv(ji,jj,ikbv+1) = 0.e0 365 END DO 366 END DO 349 DO jj = 2, jpjm1 350 DO ji = 2, jpim1 351 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 352 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 353 avmu(ji,jj,ikbu+1) = 0._wp 354 avmv(ji,jj,ikbv+1) = 0._wp 355 END DO 356 END DO 367 357 ENDIF 368 358 ! -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r4596 r4616 194 194 DO jj = 2, jpjm1 195 195 DO ji = fs_2, fs_jpim1 ! vector opt. 196 zhdiv(ji,jj,jk) = r1_e1 2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )196 zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 197 197 END DO 198 198 END DO … … 232 232 CALL wrk_alloc( jpi, jpj, jpk, z3d ) 233 233 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 234 z2d(:,:) = rau0 * e1 2t(:,:)234 z2d(:,:) = rau0 * e1e2t(:,:) 235 235 DO jk = 1, jpk 236 236 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r3294 r4616 261 261 & ( tcoef1(ki) * ub(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) + & 262 262 & tcoef2(ki) * un(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) ) & 263 & /e1u(iidu(jfl,jind1),ijdu(jfl,jind2))263 & * r1_e1u(iidu(jfl,jind1),ijdu(jfl,jind2)) 264 264 END DO 265 265 END DO … … 345 345 & ( tcoef1(ki) * vb(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) + & 346 346 & tcoef2(ki) * vn(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) ) & 347 & /e2v(iidv(jfl,jind1),ijdv(jfl,jind2))347 & * r1_e2v(iidv(jfl,jind1),ijdv(jfl,jind2)) 348 348 END DO 349 349 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r4328 r4616 125 125 126 126 ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. 127 zsurfz = e1 t(iiloc(jfl),ijloc(jfl)) *e2t(iiloc(jfl),ijloc(jfl))127 zsurfz = e1e2t(iiloc(jfl),ijloc(jfl)) 128 128 zvol = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl)) 129 129 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
r4596 r4616 236 236 237 237 ! Translation of this distances (in meter) in indexes 238 zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab /e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom)239 zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad /e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom)238 zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab*r1_e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 239 zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad*r1_e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 240 240 zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl)) & 241 241 & / ( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) & -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
r3631 r4616 1 1 MODULE icbthm 2 3 2 !!====================================================================== 4 3 !! *** MODULE icbthm *** … … 11 10 !! - ! 2011-05 (Alderson) Use tmask instead of tmask_i 12 11 !!---------------------------------------------------------------------- 13 !!----------------------------------------------------------------------14 !! icb_thm : initialise15 !! reference for equations - M = Martin + Adcroft, OM 34, 201012 13 !!---------------------------------------------------------------------- 14 !! icb_thm : initialise (reference for equations - M = Martin + Adcroft, OM 34, 2010) 16 15 !!---------------------------------------------------------------------- 17 16 USE par_oce ! NEMO parameters … … 21 20 USE phycst ! NEMO physical constants 22 21 USE sbc_oce 23 22 ! 24 23 USE icb_oce ! define iceberg arrays 25 24 USE icbutl ! iceberg utility routines … … 31 30 PUBLIC icb_thm ! routine called in icbstp.F90 module 32 31 32 !!---------------------------------------------------------------------- 33 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 34 !! $Id: cla.F90 4596 2014-03-26 11:02:30Z gm $ 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 !!---------------------------------------------------------------------- 33 37 CONTAINS 34 38 … … 155 159 ! use tmask rather than tmask_i when dealing with icebergs 156 160 IF( tmask(ii,ij,1) /= 0._wp ) THEN ! Add melting to the grid and field diagnostics 157 z1_e1e2 = 1._wp /e1e2t(ii,ij) * this%mass_scaling161 z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling 158 162 z1_dt_e1e2 = z1_dt * z1_e1e2 159 163 zmelt = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt ! kg/s … … 194 198 ! 195 199 ELSE ! Diagnose mass distribution on grid 196 z1_e1e2 = 1._wp /e1e2t(ii,ij) * this%mass_scaling200 z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling 197 201 CALL icb_dia_size( ii, ij, zWn, zLn, zAbits, & 198 202 & this%mass_scaling, zMnew, znMbits, z1_e1e2) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r4292 r4616 73 73 74 74 !!---------------------------------------------------------------------- 75 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)75 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 76 76 !! $Id$ 77 77 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 812 812 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 813 813 ELSEIF( PRESENT(pv_r2d) ) THEN 814 !CDIR COLLAPSE815 814 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 816 !CDIR COLLAPSE817 815 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 818 816 ELSEIF( PRESENT(pv_r3d) ) THEN 819 !CDIR COLLAPSE820 817 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 821 !CDIR COLLAPSE822 818 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 823 819 ENDIF -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
r4596 r4616 316 316 DO ji = mi0(161), mi1(161) !------------------------------ 317 317 DO jk = 1, 8 ! surface in/out flow (Ind -> Red) (div >0) 318 hdiv_161_88(jk) = + zio_flow / ( 8. * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )318 hdiv_161_88(jk) = + zio_flow / ( 8. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 319 319 END DO 320 320 ! ! recirculation water (Ind -> Red) (div >0) 321 hdiv_161_88(20) = + zrecirc_upp / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,20) )322 hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,21) )321 hdiv_161_88(20) = + zrecirc_upp / ( e1e2t(ji,jj) * fse3t(ji,jj,20) ) 322 hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1e2t(ji,jj) * fse3t(ji,jj,21) ) 323 323 END DO 324 324 END DO … … 327 327 DO ji = mi0(161), mi1(161) !------------------------------ 328 328 ! ! deep out flow + recirculation (Red -> Ind) (div <0) 329 hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,21) )329 hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1e2t(ji,jj) * fse3t(ji,jj,21) ) 330 330 END DO 331 331 END DO … … 334 334 DO ji = mi0(160), mi1(160) !------------------------------ 335 335 DO jk = 1, 8 ! surface inflow (Ind -> Red) (div <0) 336 hdiv_160_89(jk) = - zio_flow / ( 8. * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )336 hdiv_160_89(jk) = - zio_flow / ( 8. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 337 337 END DO 338 338 ! ! deep outflow (Red -> Ind) (div >0) 339 hdiv_160_89(16) = + zio_flow / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,16) )339 hdiv_160_89(16) = + zio_flow / ( e1e2t(ji,jj) * fse3t(ji,jj,16) ) 340 340 END DO 341 341 END DO … … 347 347 DO jj = mj0(87), mj1(96) ! sum over the Red sea 348 348 DO ji = mi0(148), mi1(160) 349 zemp_red = zemp_red + emp(ji,jj) * e1 t(ji,jj) *e2t(ji,jj) * tmask_i(ji,jj)349 zemp_red = zemp_red + emp(ji,jj) * e1e2t(ji,jj) * tmask_i(ji,jj) 350 350 END DO 351 351 END DO … … 421 421 DO jj = mj0(88), mj1(88) !** (160,88) (Gulf of Aden side, north point) 422 422 DO ji = mi0(160), mi1(160) ! 160, not 161 as it is a U-point) 423 ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) & 424 & * e2u(ji,jj) * fse3u(ji,jj,:) 423 ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 425 424 END DO 426 425 END DO 427 426 DO jj = mj0(87), mj1(87) !** (160,87) (Gulf of Aden side, south point) 428 427 DO ji = mi0(160), mi1(160) ! 160, not 161 as it is a U-point) 429 ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) & 430 & * e2u(ji,jj) * fse3u(ji,jj,:) 428 ua(ji,jj,:) = - hdiv_161_87(:) / ( e1e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 431 429 END DO 432 430 END DO 433 431 DO jj = mj0(88), mj1(88) !** profile of divergence at (160,89) (Red sea side) 434 432 DO ji = mi0(160), mi1(160) ! 88, not 89 as it is a V-point) 435 va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) ) & 436 & * e1v(ji,jj) * fse3v(ji,jj,:) 433 va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1e2t(ji,jj+1) * fse3t(ji,jj+1,:) ) * e1v(ji,jj) * fse3v(ji,jj,:) 437 434 END DO 438 435 END DO … … 492 489 DO ji = mi0(139), mi1(139) !----------------------------- 493 490 DO jk = 1, 14 ! surface in/out flow (Atl -> Med) (div >0) 494 hdiv_139_101(jk) = + zio_flow / ( 14. * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )491 hdiv_139_101(jk) = + zio_flow / ( 14. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 495 492 END DO 496 493 DO jk = 15, 20 ! middle reciculation (Atl 101 -> Atl 102) (div >0) 497 hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )494 hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 498 495 END DO 499 496 ! ! upper reciculation (Atl 101 -> Atl 101) (div >0) 500 hdiv_139_101(21) = + zrecirc_upp / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )497 hdiv_139_101(21) = + zrecirc_upp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 501 498 ! 502 499 ! ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102) (div >0) 503 hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )500 hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 504 501 END DO 505 502 END DO … … 507 504 DO ji = mi0(139), mi1(139) !----------------------------- 508 505 DO jk = 15, 20 ! middle reciculation (Atl 101 -> Atl 102) (div <0) 509 hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )506 hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 510 507 END DO 511 508 ! ! outflow of Mediterranean sea + deep recirculation (div <0) 512 hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )509 hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 513 510 END DO 514 511 END DO … … 516 513 DO ji = mi0(141), mi1(141) !------------------------------ 517 514 DO jk = 1, 14 ! surface inflow in the Med (div <0) 518 hdiv_141_102(jk) = - zio_flow / ( 14. * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )515 hdiv_141_102(jk) = - zio_flow / ( 14. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 519 516 END DO 520 517 ! ! deep outflow toward the Atlantic (div >0) 521 hdiv_141_102(21) = + zio_flow / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )518 hdiv_141_102(21) = + zio_flow / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 522 519 END DO 523 520 END DO … … 529 526 DO jj = mj0(96), mj1(110) ! sum over the Med sea 530 527 DO ji = mi0(141),mi1(181) 531 zemp_med = zemp_med + emp(ji,jj) * e1 t(ji,jj) *e2t(ji,jj) * tmask_i(ji,jj)528 zemp_med = zemp_med + emp(ji,jj) * e1e2t(ji,jj) * tmask_i(ji,jj) 532 529 END DO 533 530 END DO 534 531 DO jj = mj0(96), mj1(96) ! minus 2 points in Red Sea 535 532 DO ji = mi0(148),mi1(148) 536 zemp_med = zemp_med - emp(ji,jj) * e1 t(ji,jj) *e2t(ji,jj) * tmask_i(ji,jj)533 zemp_med = zemp_med - emp(ji,jj) * e1e2t(ji,jj) * tmask_i(ji,jj) 537 534 END DO 538 535 DO ji = mi0(149),mi1(149) 539 zemp_med = zemp_med - emp(ji,jj) * e1 t(ji,jj) *e2t(ji,jj) * tmask_i(ji,jj)536 zemp_med = zemp_med - emp(ji,jj) * e1e2t(ji,jj) * tmask_i(ji,jj) 540 537 END DO 541 538 END DO … … 549 546 hdiv_139_101_kt(:) = hdiv_139_101(:) 550 547 DO jk = 1, 14 ! increase the inflow from the Atlantic (div >0) 551 hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )548 hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 552 549 END DO 553 550 hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:) … … 563 560 hdiv_141_102(:) = hdiv_141_102(:) 564 561 DO jk = 1, 14 ! increase the inflow from the Atlantic (div <0) 565 hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )562 hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 566 563 END DO 567 564 hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:) … … 616 613 DO jj = mj0(101), mj1(101) !** 139,101 (Atlantic side, south point) 617 614 DO ji = mi0(139), mi1(139) ! div >0 => ua >0, same sign 618 ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) ) & 619 & * e2u(ji,jj) * fse3u(ji,jj,:) 615 ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1e2t(ji,jj) * fse3t(ji,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 620 616 END DO 621 617 END DO 622 618 DO jj = mj0(102), mj1(102) !** 139,102 (Atlantic side, north point) 623 619 DO ji = mi0(139), mi1(139) ! div <0 => ua <0, same sign 624 ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) ) & 625 & * e2u(ji,jj) * fse3u(ji,jj,:) 620 ua(ji,jj,:) = hdiv_139_102(:) / ( e1e2t(ji,jj) * fse3t(ji,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 626 621 END DO 627 622 END DO 628 623 DO jj = mj0(102), mj1(102) !** 140,102 (Med side) (140 not 141 as it is a U-point) 629 624 DO ji = mi0(140), mi1(140) ! div >0 => ua <0, opposite sign 630 ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) & 631 & * e2u(ji,jj) * fse3u(ji,jj,:) 625 ua(ji,jj,:) = - hdiv_141_102(:) / ( e1e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 632 626 END DO 633 627 END DO … … 675 669 DO ji = mi0(172), mi1(172) 676 670 DO jk = 1, 8 ! surface inflow (Indian ocean to Persian Gulf) (div<0) 677 hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )671 hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 678 672 END DO 679 673 DO jk = 16, 18 ! deep outflow (Persian Gulf to Indian ocean) (div>0) 680 hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )674 hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 681 675 END DO 682 676 END DO … … 722 716 DO jj = mj0(94), mj1(94) !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point) 723 717 DO ji = mi0(171), mi1(171) ! div >0 => ua >0, opposite sign 724 ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) & 725 & * e2u(ji,jj) * fse3u(ji,jj,:) 718 ua(ji,jj,:) = - hdiv_172_94(:) / ( e1e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 726 719 END DO 727 720 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4596 r4616 144 144 END DO 145 145 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 146 # if defined key_vectopt_loop147 DO jj = 1, 1148 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)149 # else150 146 DO jj = 1, jpjm1 151 147 DO ji = 1, jpim1 152 # endif153 148 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 154 149 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) … … 179 174 DO ji = fs_2, fs_jpim1 ! vector opt. 180 175 ! ! horizontal and vertical density gradient at u- and v-points 181 zau = zgru(ji,jj,jk) /e1u(ji,jj)182 zav = zgrv(ji,jj,jk) /e2v(ji,jj)176 zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) 177 zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj) 183 178 zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj ,jk) ) 184 179 zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji ,jj+1,jk) ) … … 433 428 zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) ! j-gradient of T & S at v-point 434 429 zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 435 zdxrho_raw = ( - zalbet(ji+ip,jj ,jk) * zdit + zbeta0*zdis ) /e1u(ji,jj)436 zdyrho_raw = ( - zalbet(ji ,jj+jp,jk) * zdjt + zbeta0*zdjs ) /e2v(ji,jj)430 zdxrho_raw = ( - zalbet(ji+ip,jj ,jk) * zdit + zbeta0*zdis ) * r1_e1u(ji,jj) 431 zdyrho_raw = ( - zalbet(ji ,jj+jp,jk) * zdjt + zbeta0*zdjs ) * r1_e2v(ji,jj) 437 432 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 438 433 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) … … 447 442 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature 448 443 zdis = gtsu(ji,jj,jp_sal) ; zdjs = gtsv(ji,jj,jp_sal) ! i- & j-gradient of Salinity 449 zdxrho_raw = ( - zalbet(ji+ip,jj ,iku) * zdit + zbeta0*zdis ) /e1u(ji,jj)450 zdyrho_raw = ( - zalbet(ji ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) /e2v(ji,jj)444 zdxrho_raw = ( - zalbet(ji+ip,jj ,iku) * zdit + zbeta0*zdis ) * r1_e1u(ji,jj) 445 zdyrho_raw = ( - zalbet(ji ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) * r1_e2v(ji,jj) 451 446 zdxrho(ji+ip,jj ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 452 447 zdyrho(ji ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) … … 468 463 zdks = 0._wp 469 464 ENDIF 470 zdzrho_raw = ( - zalbet(ji ,jj,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)471 zdzrho(ji ,jj ,jk, kp) = - MIN( - repsln,zdzrho_raw ) ! force zdzrho >= repsln465 zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 466 zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw ) ! force zdzrho >= repsln 472 467 END DO 473 468 END DO … … 507 502 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 508 503 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 509 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) /e1u(ji,jj) ) * umask(ji,jj,jk)510 ze3_e1 = fse3w(ji+ip,jj,jk-kp) /e1u(ji,jj)504 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj) ) * umask(ji,jj,jk) 505 ze3_e1 = fse3w(ji+ip,jj,jk-kp) * r1_e1u(ji,jj) 511 506 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1 , ABS( zti_g_raw ) ), zti_g_raw ) 512 507 ENDIF … … 550 545 ! 551 546 ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 552 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) /e1u(ji,jj)553 ztj_coord = znot_thru_surface * ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)! unmasked547 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) 548 ztj_coord = znot_thru_surface * ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) ! unmasked 554 549 zti_g_raw = zti_raw - zti_coord ! ref to geopot surfaces 555 550 ztj_g_raw = ztj_raw - ztj_coord 556 551 ! additional limit required in bilaplacian case 557 ze3_e1 = fse3w(ji+ip,jj ,jk+kp) /e1u(ji,jj)558 ze3_e2 = fse3w(ji ,jj+jp,jk+kp) /e2v(ji,jj)552 ze3_e1 = fse3w(ji+ip,jj ,jk+kp) * r1_e1u(ji,jj) 553 ze3_e2 = fse3w(ji ,jj+jp,jk+kp) * r1_e2v(ji,jj) 559 554 ! NB: hard coded factor 5 (can be a namelist parameter...) 560 555 zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) … … 602 597 #endif 603 598 ! 604 zbu = e1 u(ji,jj) * e2u(ji,jj) * fse3u(ji ,jj ,jk )605 zbv = e1 v(ji,jj) * e2v(ji,jj) * fse3v(ji ,jj ,jk )606 zbti = e1e2t(ji+ip,jj ) 607 zbtj = e1e2t(ji ,jj+jp) 599 zbu = e1e2u(ji ,jj ) * fse3u(ji ,jj ,jk ) 600 zbv = e1e2v(ji ,jj ) * fse3v(ji ,jj ,jk ) 601 zbti = e1e2t(ji+ip,jj ) * fse3w(ji+ip,jj ,jk+kp) 602 zbtj = e1e2t(ji ,jj+jp) * fse3w(ji ,jj+jp,jk+kp) 608 603 ! 609 604 !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers.... ==> to be checked … … 673 668 ! !== surface mixed layer mask ! 674 669 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 675 # if defined key_vectopt_loop676 DO jj = 1, 1677 DO ji = 1, jpij ! vector opt. (forced unrolling)678 # else679 670 DO jj = 1, jpj 680 671 DO ji = 1, jpi 681 # endif682 672 ik = nmln(ji,jj) - 1 683 673 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp … … 699 689 !----------------------------------------------------------------------- 700 690 ! 701 # if defined key_vectopt_loop702 DO jj = 1, 1703 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)704 # else705 691 DO jj = 2, jpjm1 706 692 DO ji = 2, jpim1 707 # endif708 693 ! !== Slope at u- & v-points just below the Mixed Layer ==! 709 694 ! … … 714 699 zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji ,jj+1,ikv) ) 715 700 ! !- horizontal density gradient at u- & v-points 716 zau = p_gru(ji,jj,iku) /e1u(ji,jj)717 zav = p_grv(ji,jj,ikv) /e2v(ji,jj)701 zau = p_gru(ji,jj,iku) * r1_e1u(ji,jj) 702 zav = p_grv(ji,jj,ikv) * r1_e2v(ji,jj) 718 703 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 719 704 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) … … 816 801 ! DO jj = 2, jpjm1 817 802 ! DO ji = fs_2, fs_jpim1 ! vector opt. 818 ! uslp (ji,jj,jk) = - 1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk)) * umask(ji,jj,jk)819 ! vslp (ji,jj,jk) = - 1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk)) * vmask(ji,jj,jk)820 ! wslpi(ji,jj,jk) = - 1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk)) * tmask(ji,jj,jk) * 0.5821 ! wslpj(ji,jj,jk) = - 1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk)) * tmask(ji,jj,jk) * 0.5803 ! uslp (ji,jj,jk) = - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 804 ! vslp (ji,jj,jk) = - ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 805 ! wslpi(ji,jj,jk) = - ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 806 ! wslpj(ji,jj,jk) = - ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 822 807 ! END DO 823 808 ! END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
r4596 r4616 106 106 ! 107 107 DO jk = 1 , jpkm1 108 zue2(:,:) = un(:,:,jk) /e2u(:,:) !!gm for stability reason use of before instead of now here !!!!109 zve1(:,:) = vn(:,:,jk) /e1v(:,:)110 zue1(:,:) = un(:,:,jk) /e1u(:,:)111 zve2(:,:) = vn(:,:,jk) /e2v(:,:)108 zue2(:,:) = un(:,:,jk) * r1_e2u(:,:) !!gm for stability reason use of before instead of now here !!!! 109 zve1(:,:) = vn(:,:,jk) * r1_e1v(:,:) 110 zue1(:,:) = un(:,:,jk) * r1_e1u(:,:) 111 zve2(:,:) = vn(:,:,jk) * r1_e2v(:,:) 112 112 ! 113 113 DO jj = 2, jpj !!gm multiplication by tmask useless as un, vn maked field ! 114 114 DO ji= 2, jpi 115 zux(ji,jj) = ( zue2(ji,jj) - zue2(ji-1,jj ) ) /e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh116 zvy(ji,jj) = ( zve1(ji,jj) - zve1(ji ,jj-1) ) /e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh115 zux(ji,jj) = ( zue2(ji,jj) - zue2(ji-1,jj ) ) * r1_e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh 116 zvy(ji,jj) = ( zve1(ji,jj) - zve1(ji ,jj-1) ) * r1_e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh 117 117 END DO 118 118 END DO … … 120 120 DO jj = 1, jpjm1 121 121 DO ji = 1, jpim1 122 zuy(ji,jj) = ( zue1(ji ,jj+1) - zue1(ji,jj) ) /e2f(ji,jj) *e1f(ji,jj) * fmask(ji,jj,jk)123 zvx(ji,jj) = ( zve2(ji+1,jj ) - zve2(ji,jj) ) /e1f(ji,jj) *e2f(ji,jj) * fmask(ji,jj,jk)122 zuy(ji,jj) = ( zue1(ji ,jj+1) - zue1(ji,jj) ) * r1_e2f(ji,jj) *e1f(ji,jj) * fmask(ji,jj,jk) 123 zvx(ji,jj) = ( zve2(ji+1,jj ) - zve2(ji,jj) ) * r1_e1f(ji,jj) *e2f(ji,jj) * fmask(ji,jj,jk) 124 124 END DO 125 125 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r3294 r4616 23 23 USE netcdf ! NetCDF library 24 24 USE lib_mpp ! MPP library 25 USE dom_oce, ONLY : & ! Domain variables 26 & tmask, tmask_i, e1t, e2t, gphit, glamt 27 USE obs_const, ONLY : obfillflt ! Fillvalue 28 USE oce , ONLY : sshn ! Model variables 25 USE dom_oce , ONLY : tmask, tmask_i, e1e2t, gphit, glamt ! Domain variables 26 USE obs_const, ONLY : obfillflt ! Fillvalue 27 USE oce , ONLY : sshn ! Model variables 29 28 30 29 IMPLICIT NONE … … 220 219 DO jj = 1, jpj 221 220 DO ji = 1, jpi 222 zdxdy = e1 t(ji,jj) *e2t(ji,jj) * zpromsk(ji,jj)221 zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj) 223 222 zarea = zarea + zdxdy 224 223 zeta1 = zeta1 + mdt(ji,jj) * zdxdy -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r4371 r4616 281 281 ztinta = REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 282 282 ztintb = 1. - ztinta 283 !CDIR COLLAPSE284 283 sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 285 284 ELSE ! nothing to do... -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r4162 r4616 195 195 196 196 DO jj = 2, jpjm1 197 !CDIR NOVERRCHK198 197 DO ji = fs_2, jpi ! vector opt. 199 198 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r4306 r4616 168 168 !!--------------------------------------------------------------------- 169 169 zcoef = 0.5 / ( zrhoa * zcdrag ) 170 !CDIR NOVERRCHK171 170 DO jj = 2, jpjm1 172 !CDIR NOVERRCHK173 171 DO ji = fs_2, fs_jpim1 ! vect. opt. 174 172 ztx = utau(ji-1,jj ) + utau(ji,jj) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
r4147 r4616 271 271 ! module of wind stress and wind speed at T-point 272 272 zcoef = 1. / ( zrhoa * zcdrag ) 273 !CDIR NOVERRCHK274 273 DO jj = 2, jpjm1 275 !CDIR NOVERRCHK276 274 DO ji = fs_2, fs_jpim1 ! vect. opt. 277 275 ztx = utau(ji-1,jj ) + utau(ji,jj) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r4147 r4616 240 240 ! momentum fluxes (utau, vtau ) ! 241 241 !------------------------------------! 242 !CDIR COLLAPSE243 242 utau(:,:) = sf(jp_utau)%fnow(:,:,1) 244 !CDIR COLLAPSE245 243 vtau(:,:) = sf(jp_vtau)%fnow(:,:,1) 246 244 … … 248 246 ! wind stress module (taum ) ! 249 247 !------------------------------------! 250 !CDIR NOVERRCHK251 248 DO jj = 2, jpjm1 252 !CDIR NOVERRCHK253 249 DO ji = fs_2, fs_jpim1 ! vector opt. 254 250 ztx2 = utau(ji-1,jj ) + utau(ji,jj) … … 262 258 ! store the wind speed (wndm ) ! 263 259 !------------------------------------! 264 !CDIR COLLAPSE265 260 wndm(:,:) = sf(jp_wndm)%fnow(:,:,1) 266 261 … … 274 269 ! Other ocean fluxes ! 275 270 !------------------------! 276 !CDIR NOVERRCHK277 !CDIR COLLAPSE278 271 DO jj = 1, jpj 279 !CDIR NOVERRCHK280 272 DO ji = 1, jpi 281 273 ! … … 368 360 zcprec = rcp / rday ! convert prec ( mm/day ==> m/s) ==> W/m2 369 361 370 !CDIR COLLAPSE371 362 emp(:,:) = zqla(:,:) / cevap & ! freshwater flux 372 363 & - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 373 364 ! 374 !CDIR COLLAPSE375 365 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 376 366 & - zqla(:,:) * pst(:,:) * zcevap & ! remove evap. heat content at SST in Celcius … … 496 486 ! and the correction factor for taking into account the effect of clouds 497 487 !------------------------------------------------------ 498 !CDIR NOVERRCHK499 !CDIR COLLAPSE500 488 DO jj = 1, jpj 501 !CDIR NOVERRCHK502 489 DO ji = 1, jpi 503 490 ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1) ! air temperature in Kelvins … … 546 533 DO jl = 1, ijpl ! Loop over ice categories ! 547 534 ! ! ========================== ! 548 !CDIR NOVERRCHK549 !CDIR COLLAPSE550 535 DO jj = 1 , jpj 551 !CDIR NOVERRCHK552 536 DO ji = 1, jpi 553 537 !-------------------------------------------! … … 607 591 ! ----------------------------------------------------------------------------- ! 608 592 ! 609 !CDIR COLLAPSE610 593 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:) ! Downward Non Solar flux 611 !CDIR COLLAPSE612 594 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 613 595 ! … … 615 597 ! Correct the OCEAN non solar flux with the existence of solid precipitation ! 616 598 ! ---------------=====--------------------------------------------------------- ! 617 !CDIR COLLAPSE618 599 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 619 600 & - p_spr(:,:) * lfus & ! remove melting solid precip … … 716 697 ! Saturated water vapour and vapour pressure 717 698 ! ------------------------------------------ 718 !CDIR NOVERRCHK719 !CDIR COLLAPSE720 699 DO jj = 1, jpj 721 !CDIR NOVERRCHK722 700 DO ji = 1, jpi 723 701 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt … … 748 726 zdaycor = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist ) 749 727 750 !CDIR NOVERRCHK751 728 DO jj = 1, jpj 752 !CDIR NOVERRCHK753 729 DO ji = 1, jpi 754 730 ! product of sine (cosine) of latitude and sine (cosine) of solar declination … … 771 747 772 748 ! compute and sum ocean qsr over the daylight (i.e. between sunrise and sunset) 773 !CDIR NOVERRCHK774 749 DO jt = 1, jp24 775 750 zcoef = FLOAT( jt ) - 0.5 776 !CDIR NOVERRCHK777 !CDIR COLLAPSE778 751 DO jj = 1, jpj 779 !CDIR NOVERRCHK780 752 DO ji = 1, jpi 781 753 zlha = COS( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) ! local hour angle … … 796 768 ! Taking into account the ellipsity of the earth orbit, the clouds AND masked if sea-ice cover > 0% 797 769 zcoef1 = srgamma * zdaycor / ( 2. * rpi ) 798 !CDIR COLLAPSE799 770 DO jj = 1, jpj 800 771 DO ji = 1, jpi … … 854 825 ! Saturated water vapour and vapour pressure 855 826 ! ------------------------------------------ 856 !CDIR NOVERRCHK857 !CDIR COLLAPSE858 827 DO jj = 1, jpj 859 !CDIR NOVERRCHK860 828 DO ji = 1, jpi 861 829 ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt … … 886 854 zdaycor = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist ) 887 855 888 !CDIR NOVERRCHK889 856 DO jj = 1, jpj 890 !CDIR NOVERRCHK891 857 DO ji = 1, jpi 892 858 ! product of sine (cosine) of latitude and sine (cosine) of solar declination … … 913 879 DO jl = 1, ijpl ! loop over ice categories ! 914 880 ! !----------------------------! 915 !CDIR NOVERRCHK916 881 DO jt = 1, jp24 917 882 zcoef = FLOAT( jt ) - 0.5 918 !CDIR NOVERRCHK919 !CDIR COLLAPSE920 883 DO jj = 1, jpj 921 !CDIR NOVERRCHK922 884 DO ji = 1, jpi 923 885 zlha = COS( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) ! local hour angle -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4333 r4616 88 88 # include "vectopt_loop_substitute.h90" 89 89 !!---------------------------------------------------------------------- 90 !! NEMO/OPA 3. 3 , NEMO-consortium (2010)90 !! NEMO/OPA 3.7 , NEMO-consortium (2014) 91 91 !! $Id$ 92 92 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 125 125 !!---------------------------------------------------------------------- 126 126 INTEGER, INTENT(in) :: kt ! ocean time step 127 ! !127 ! 128 128 INTEGER :: ierror ! return error code 129 129 INTEGER :: ifpr ! dummy loop indice … … 141 141 & sn_tdif, rn_zqt , ln_bulk2z, rn_zu 142 142 !!--------------------------------------------------------------------- 143 143 ! 144 144 ! ! ====================== ! 145 145 IF( kt == nit000 ) THEN ! First call kt=nit000 ! … … 149 149 READ ( numnam_ref, namsbc_core, IOSTAT = ios, ERR = 901) 150 150 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in reference namelist', lwp ) 151 151 ! 152 152 REWIND( numnam_cfg ) ! Namelist namsbc_core in configuration namelist : CORE bulk parameters 153 153 READ ( numnam_cfg, namsbc_core, IOSTAT = ios, ERR = 902 ) … … 269 269 zwnd_j(:,:) = 0.e0 270 270 #if defined key_cyclone 271 # if defined key_vectopt_loop272 !CDIR COLLAPSE273 # endif274 271 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add Manu ! 275 272 DO jj = 2, jpjm1 … … 279 276 END DO 280 277 END DO 281 #endif282 #if defined key_vectopt_loop283 !CDIR COLLAPSE284 278 #endif 285 279 DO jj = 2, jpjm1 … … 292 286 CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 293 287 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 294 !CDIR NOVERRCHK295 !CDIR COLLAPSE296 288 wndm(:,:) = SQRT( zwnd_i(:,:) * zwnd_i(:,:) & 297 289 & + zwnd_j(:,:) * zwnd_j(:,:) ) * tmask(:,:,1) … … 306 298 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 307 299 ENDIF 308 !CDIR COLLAPSE309 300 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 310 301 ! ----------------------------------------------------------------------------- ! … … 313 304 314 305 ! ... specific humidity at SST and IST 315 !CDIR NOVERRCHK316 !CDIR COLLAPSE317 306 zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) ) 318 307 … … 340 329 ELSE 341 330 !! If air temp. and spec. hum. are given at same height than wind (10m) : 342 !gm bug? at the compiling phase, add a copy in temporary arrays... ==> check perf343 ! CALL TURB_CORE_1Z( 10., zst (:,:), sf(jp_tair)%fnow(:,:), &344 ! & zqsatw(:,:), sf(jp_humi)%fnow(:,:), wndm(:,:), &345 ! & Cd (:,:), Ch (:,:), Ce (:,:) )346 !gm bug347 ! ARPDBG - this won't compile with gfortran. Fix but check performance348 ! as per comment above.349 331 CALL TURB_CORE_1Z( 10., zst , sf(jp_tair)%fnow(:,:,1), & 350 332 & zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, & 351 & Cd , Ch , Ce )333 & Cd , Ch , Ce ) 352 334 ENDIF 353 335 … … 364 346 ! ... add the HF tau contribution to the wind stress module? 365 347 IF( lhftau ) THEN 366 !CDIR COLLAPSE367 348 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 368 349 ENDIF … … 387 368 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - zt_zu(:,:) ) * wndm(:,:) ! Sensible Heat 388 369 ELSE 389 !CDIR COLLAPSE390 370 zevap(:,:) = rn_efac * MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) ) ! Evaporation 391 !CDIR COLLAPSE392 371 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:) ! Sensible Heat 393 372 ENDIF 394 !CDIR COLLAPSE395 373 zqla (:,:) = Lv * zevap(:,:) ! Latent Heat 396 374 … … 409 387 ! III Total FLUXES ! 410 388 ! ----------------------------------------------------------------------------- ! 411 412 !CDIR COLLAPSE 389 ! 413 390 emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.) 414 391 & - sf(jp_prec)%fnow(:,:,1) * rn_pfac ) * tmask(:,:,1) 415 !CDIR COLLAPSE416 392 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 417 393 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip … … 579 555 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) 580 556 ! and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 581 !CDIR NOVERRCHK582 557 DO jj = 2, jpjm1 583 558 DO ji = 2, jpim1 ! B grid : NO vector opt … … 604 579 ! 605 580 CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean) 606 #if defined key_vectopt_loop607 !CDIR COLLAPSE608 #endif609 581 DO jj = 2, jpj 610 582 DO ji = fs_2, jpi ! vect. opt. … … 614 586 END DO 615 587 END DO 616 #if defined key_vectopt_loop617 !CDIR COLLAPSE618 #endif619 588 DO jj = 2, jpjm1 620 589 DO ji = fs_2, fs_jpim1 ! vect. opt. … … 635 604 DO jl = 1, ijpl ! Loop over ice categories ! 636 605 ! ! ========================== ! 637 !CDIR NOVERRCHK638 !CDIR COLLAPSE639 606 DO jj = 1 , jpj 640 !CDIR NOVERRCHK641 607 DO ji = 1, jpi 642 608 ! ----------------------------! … … 690 656 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 691 657 692 !CDIR COLLAPSE693 658 p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca ) 694 !CDIR COLLAPSE695 659 p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca ) 696 660 697 !CDIR COLLAPSE698 661 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 699 !CDIR COLLAPSE700 662 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 701 663 CALL iom_put( 'snowpre', p_spr * 86400. ) ! Snow precipitation -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r4147 r4616 248 248 ! for basin budget and cooerence 249 249 !-------------------------------------------------- 250 !CDIR COLLAPSE251 250 emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1) 252 !CDIR COLLAPSE253 251 254 252 CALL iom_put( "qlw_oce", qbw ) ! output downward longwave heat over the ocean … … 264 262 265 263 266 SUBROUTINE fluxes_mfs( alat,alon,hour,&267 sst,tnow,shnow,unow,vnow,mslnow,cldnow,qsw,qbw,ha,elat,&268 evap,taux,tauy)264 SUBROUTINE fluxes_mfs( alat, alon , hour, sst , & 265 & tnow, shnow, unow, vnow, mslnow, cldnow, & 266 & qsw , qbw , ha , elat, evap, taux, tauy ) 269 267 !!---------------------------------------------------------------------- 270 268 !! *** ROUTINE fluxes_mfs *** -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4393 r4616 752 752 ! => need to be done only when otx1 was changed 753 753 IF( llnewtx ) THEN 754 !CDIR NOVERRCHK755 754 DO jj = 2, jpjm1 756 !CDIR NOVERRCHK757 755 DO ji = fs_2, fs_jpim1 ! vect. opt. 758 756 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) … … 782 780 IF( llnewtau ) THEN 783 781 zcoef = 1. / ( zrhoa * zcdrag ) 784 !CDIR NOVERRCHK785 782 DO jj = 1, jpj 786 !CDIR NOVERRCHK787 783 DO ji = 1, jpi 788 784 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) … … 797 793 ! -> need to be reset before each call of the ice/fsbc 798 794 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 799 !800 795 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 801 796 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 802 797 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 803 798 CALL iom_put( "taum_oce", taum ) ! output wind stress module 804 !805 799 ENDIF 806 800 … … 832 826 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 833 827 !! ! remove negative runoff 834 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1 t(:,:) *e2t(:,:) * tmask_i(:,:) )835 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1 t(:,:) *e2t(:,:) * tmask_i(:,:) )828 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1e2t(:,:) * tmask_i(:,:) ) 829 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1e2t(:,:) * tmask_i(:,:) ) 836 830 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 837 831 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) … … 1183 1177 !!gm at least should be optional... 1184 1178 !! ! remove negative runoff ! sum over the global domain 1185 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1 t(:,:) *e2t(:,:) * tmask_i(:,:) )1186 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1 t(:,:) *e2t(:,:) * tmask_i(:,:) )1179 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1e2t(:,:) * tmask_i(:,:) ) 1180 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1e2t(:,:) * tmask_i(:,:) ) 1187 1181 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) 1188 1182 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r4147 r4616 131 131 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 132 132 ENDIF 133 !CDIR COLLAPSE 133 ! 134 134 DO jj = 1, jpj ! set the ocean fluxes from read fields 135 135 DO ji = 1, jpi … … 145 145 ! ! module of wind stress and wind speed at T-point 146 146 zcoef = 1. / ( zrhoa * zcdrag ) 147 !CDIR NOVERRCHK148 147 DO jj = 2, jpjm1 149 !CDIR NOVERRCHK150 148 DO ji = fs_2, fs_jpim1 ! vect. opt. 151 149 ztx = utau(ji-1,jj ) + utau(ji,jj) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r4292 r4616 55 55 PRIVATE 56 56 57 !! * Routine accessibility58 57 PUBLIC cice_sbc_init ! routine called by sbc_init 59 58 PUBLIC cice_sbc_final ! routine called by sbc_final … … 83 82 !! * Substitutions 84 83 # include "domzgr_substitute.h90" 85 84 !!---------------------------------------------------------------------- 86 85 CONTAINS 87 86 … … 225 224 DO jj = 1, jpjm1 226 225 DO ji = 1, jpim1 ! caution: use of Vector Opt. not possible 227 zcoefu = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj))228 zcoefv = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj))226 zcoefu = 0.5 * umask(ji,jj,1) * r1_e1e2u(ji,jj) 227 zcoefv = 0.5 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) 229 228 zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 230 sshu_b(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & 231 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 232 sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshb(ji,jj ) & 233 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 234 sshu_n(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshn(ji ,jj) & 235 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 236 sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj ) * e2t(ji,jj ) * sshn(ji,jj ) & 237 & + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 229 sshu_b(ji,jj) = zcoefu * ( e1e2t(ji,jj) * sshb(ji,jj) + e1e2t(ji+1,jj ) * sshb(ji+1,jj ) ) 230 sshv_b(ji,jj) = zcoefv * ( e1e2t(ji,jj) * sshb(ji,jj) + e1e2t(ji ,jj+1) * sshb(ji ,jj+1) ) 231 sshu_n(ji,jj) = zcoefu * ( e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj ) * sshn(ji+1,jj ) ) 232 sshv_n(ji,jj) = zcoefv * ( e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji ,jj+1) * sshn(ji ,jj+1) ) 238 233 END DO 239 234 END DO … … 242 237 DO jj = 1, jpjm1 243 238 DO ji = 1, jpim1 ! NO Vector Opt. 244 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 245 & / ( e1f(ji,jj ) * e2f(ji,jj ) ) & 246 & * ( e1u(ji,jj ) * e2u(ji,jj ) * sshu_n(ji,jj ) & 247 & + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 248 END DO 239 sshf_n(ji,jj) = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) & 240 & * ( e1e2u(ji,jj ) * sshu_n(ji,jj ) & 241 & + e1e2u(ji,jj+1) * sshu_n(ji,jj+1) ) * r1_e1e2f(ji,jj) 242 END DO 249 243 END DO 250 244 CALL lbc_lnk( sshf_n, 'F', 1. ) … … 266 260 INTEGER, INTENT(in ) :: kt ! ocean time step 267 261 INTEGER, INTENT(in ) :: nsbc ! surface forcing type 268 262 ! 269 263 INTEGER :: ji, jj, jl ! dummy loop indices 270 264 REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice … … 458 452 ! x comp and y comp of sea surface slope (on F points) 459 453 ! T point to F point 460 DO jj=1,jpjm1 461 DO ji=1,jpim1 462 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj ))/e1u(ji,jj ) & 463 + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & 464 * fmask(ji,jj,1) 465 ENDDO 466 ENDDO 467 CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 454 DO jj = 1, jpjm1 455 DO ji = 1, jpim1 456 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 457 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) 458 END DO 459 END DO 460 CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 468 461 469 462 ! T point to F point 470 DO jj=1,jpjm1 471 DO ji=1,jpim1 472 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj))/e2v(ji ,jj) & 473 + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 474 * fmask(ji,jj,1) 475 ENDDO 476 ENDDO 463 DO jj = 1, jpjm1 464 DO ji = 1, jpim1 465 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 466 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) 467 END DO 468 END DO 477 469 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 478 470 … … 532 524 ! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep] 533 525 534 utau(:,:) =(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)535 vtau(:,:) =(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)526 utau(:,:) = ( 1.0 - fr_iu(:,:) ) * utau(:,:) - ss_iou(:,:) 527 vtau(:,:) = ( 1.0 - fr_iv(:,:) ) * vtau(:,:) - ss_iov(:,:) 536 528 537 529 ! Freshwater fluxes … … 542 534 ! Not ideal since aice won't be the same as in the atmosphere. 543 535 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 544 emp(:,:) = emp(:,:) +fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))536 emp(:,:) = emp(:,:) + fr_i(:,:) * ( tprecip(:,:) - sprecip(:,:) ) 545 537 ELSE IF (nsbc == 4) THEN 546 emp(:,:) = ( 1.0-fr_i(:,:))*emp(:,:)538 emp(:,:) = ( 1.0 - fr_i(:,:) ) * emp(:,:) 547 539 ELSE IF (nsbc ==5) THEN 548 540 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) … … 551 543 ENDIF 552 544 553 CALL cice2nemo( fresh_gbm,ztmp1,'T', 1. )554 CALL cice2nemo( fsalt_gbm,ztmp2,'T', 1. )545 CALL cice2nemo( fresh_gbm, ztmp1,'T', 1. ) 546 CALL cice2nemo( fsalt_gbm, ztmp2,'T', 1. ) 555 547 556 548 ! Check to avoid unphysical expression when ice is forming (ztmp1 negative) … … 559 551 ! This check breaks conservation but seems reasonable until we have prognostic ice salinity 560 552 ! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU) 561 WHERE (ztmp1(:,:) .lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0)562 sfx(:,:) =ztmp2(:,:)*1000.0563 emp(:,:) =emp(:,:)-ztmp1(:,:)553 WHERE (ztmp1(:,:) < 0._wp ) ztmp2(:,:) = MAX( ztmp2(:,:) , ztmp1(:,:)*sss_m(:,:)/1000._wp ) 554 sfx(:,:) = ztmp2(:,:) * 1000.0 555 emp(:,:) = emp(:,:) - ztmp1(:,:) 564 556 565 557 CALL lbc_lnk( emp , 'T', 1. ) … … 584 576 ! Now add in ice / snow related terms 585 577 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 586 CALL cice2nemo( fswthru_gbm,ztmp1,'T', 1. )578 CALL cice2nemo( fswthru_gbm,ztmp1,'T', 1. ) 587 579 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 588 580 CALL lbc_lnk( qsr , 'T', 1. ) … … 590 582 DO jj=1,jpj 591 583 DO ji=1,jpi 592 nfrzmlt(ji,jj) =MAX(nfrzmlt(ji,jj),0.0)584 nfrzmlt(ji,jj) = MAX (nfrzmlt(ji,jj) , 0._wp ) 593 585 ENDDO 594 586 ENDDO … … 818 810 #endif 819 811 !!--------------------------------------------------------------------- 820 821 CHARACTER(len=1), INTENT( in ) :: & 822 cd_type ! nature of pn grid-point 823 ! ! = T or F gridpoints 824 REAL(wp), INTENT( in ) :: & 825 psgn ! control of the sign change 826 ! ! =-1 , the sign is modified following the type of b.c. used 827 ! ! = 1 , no sign change 828 REAL(wp), DIMENSION(jpi,jpj) :: pn 812 CHARACTER(len=1), INTENT( in ) :: cd_type ! nature of pn grid-point (= T or F) 813 REAL(wp) , INTENT( in ) :: psgn ! control of the sign change 814 ! ! =-1 , the sign is modified following the type of b.c. used 815 ! ! = 1 , no sign change 816 REAL(wp), DIMENSION(jpi,jpj) :: pn !!gm INTENT missing !!!!! 829 817 #if !defined key_nemocice_decomp 830 818 REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 831 819 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 832 820 #endif 833 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc821 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc !!gm INTENT missing !!!! 834 822 INTEGER (int_kind) :: & 835 823 field_type, &! id for type of field (scalar, vector, angle) … … 838 826 839 827 INTEGER :: ji, jj, jn ! dummy loop indices 828 !!--------------------------------------------------------------------- 840 829 841 830 ! A. Ensure all haloes are filled in NEMO field (pn) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r4161 r4616 33 33 # include "domzgr_substitute.h90" 34 34 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)35 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 36 36 !! $Id$ 37 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 107 107 108 108 ! Flux and ice fraction computation 109 !CDIR COLLAPSE110 109 DO jj = 1, jpj 111 110 DO ji = 1, jpi -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r4147 r4616 48 48 # include "domzgr_substitute.h90" 49 49 !!---------------------------------------------------------------------- 50 !! NEMO/OPA 4.0 , NEMO Consortium (2011)50 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 51 51 !! $Id$ 52 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 93 93 ! 94 94 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 95 !CDIR COLLAPSE96 95 DO jj = 1, jpj 97 96 DO ji = 1, jpi … … 106 105 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx)) 107 106 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 108 !CDIR COLLAPSE109 107 DO jj = 1, jpj 110 108 DO ji = 1, jpi … … 120 118 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 121 119 zerp_bnd = rn_sssr_bnd / rday ! - - 122 !CDIR COLLAPSE123 120 DO jj = 1, jpj 124 121 DO ji = 1, jpi -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r4328 r4616 89 89 DO ji = 2, jpim1 90 90 zcoef = z2dt * z2dt * grav * bmask(ji,jj) 91 zcoefs = -zcoef * hv(ji ,jj-1) * e1 v(ji ,jj-1) /e2v(ji ,jj-1) ! south coefficient92 zcoefw = -zcoef * hu(ji-1,jj ) * e2 u(ji-1,jj ) /e1u(ji-1,jj ) ! west coefficient93 zcoefe = -zcoef * hu(ji ,jj ) * e2 u(ji ,jj ) /e1u(ji ,jj ) ! east coefficient94 zcoefn = -zcoef * hv(ji ,jj ) * e1 v(ji ,jj ) /e2v(ji ,jj ) ! north coefficient91 zcoefs = -zcoef * hv(ji ,jj-1) * e1_e2v(ji ,jj-1) ! south coefficient 92 zcoefw = -zcoef * hu(ji-1,jj ) * e2_e1u(ji-1,jj ) ! west coefficient 93 zcoefe = -zcoef * hu(ji ,jj ) * e2_e1u(ji ,jj ) ! east coefficient 94 zcoefn = -zcoef * hv(ji ,jj ) * e1_e2v(ji ,jj ) ! north coefficient 95 95 gcp(ji,jj,1) = zcoefs 96 96 gcp(ji,jj,2) = zcoefw 97 97 gcp(ji,jj,3) = zcoefe 98 98 gcp(ji,jj,4) = zcoefn 99 gcdmat(ji,jj) = e1 t(ji,jj) *e2t(ji,jj) * bmask(ji,jj) & ! diagonal coefficient99 gcdmat(ji,jj) = e1e2t(ji,jj) * bmask(ji,jj) & ! diagonal coefficient 100 100 & - zcoefs -zcoefw -zcoefe -zcoefn 101 101 END DO … … 110 110 111 111 ! south coefficient 112 zcoefs = -zcoef * hv(ji,jj-1) * e1 v(ji,jj-1)/e2v(ji,jj-1)112 zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 113 113 zcoefs = zcoefs * bdyvmask(ji,jj-1) 114 114 gcp(ji,jj,1) = zcoefs 115 115 116 116 ! west coefficient 117 zcoefw = -zcoef * hu(ji-1,jj) * e2 u(ji-1,jj)/e1u(ji-1,jj)117 zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 118 118 zcoefw = zcoefw * bdyumask(ji-1,jj) 119 119 gcp(ji,jj,2) = zcoefw 120 120 121 121 ! east coefficient 122 zcoefe = -zcoef * hu(ji,jj) * e2 u(ji,jj)/e1u(ji,jj)122 zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 123 123 zcoefe = zcoefe * bdyumask(ji,jj) 124 124 gcp(ji,jj,3) = zcoefe 125 125 126 126 ! north coefficient 127 zcoefn = -zcoef * hv(ji,jj) * e1 v(ji,jj)/e2v(ji,jj)127 zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 128 128 zcoefn = zcoefn * bdyvmask(ji,jj) 129 129 gcp(ji,jj,4) = zcoefn 130 130 131 131 ! diagonal coefficient 132 gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 133 - zcoefs -zcoefw -zcoefe -zcoefn 132 gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn 134 133 END DO 135 134 END DO … … 149 148 ! south coefficient 150 149 IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN 151 zcoefs = -zcoef * hv(ji,jj-1) * e1 v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1))150 zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 152 151 ELSE 153 zcoefs = -zcoef * hv(ji,jj-1) * e1 v(ji,jj-1)/e2v(ji,jj-1)152 zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 154 153 END IF 155 154 gcp(ji,jj,1) = zcoefs … … 157 156 ! west coefficient 158 157 IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 ) ) THEN 159 zcoefw = -zcoef * hu(ji-1,jj) * e2 u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1))158 zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 160 159 ELSE 161 zcoefw = -zcoef * hu(ji-1,jj) * e2 u(ji-1,jj)/e1u(ji-1,jj)160 zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 162 161 END IF 163 162 gcp(ji,jj,2) = zcoefw … … 165 164 ! east coefficient 166 165 IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN 167 zcoefe = -zcoef * hu(ji,jj) * e2 u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1))166 zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1)) 168 167 ELSE 169 zcoefe = -zcoef * hu(ji,jj) * e2 u(ji,jj)/e1u(ji,jj)168 zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 170 169 END IF 171 170 gcp(ji,jj,3) = zcoefe … … 173 172 ! north coefficient 174 173 IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN 175 zcoefn = -zcoef * hv(ji,jj) * e1 v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1))174 zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1)) 176 175 ELSE 177 zcoefn = -zcoef * hv(ji,jj) * e1 v(ji,jj)/e2v(ji,jj)176 zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 178 177 END IF 179 178 gcp(ji,jj,4) = zcoefn 180 179 ! 181 180 ! diagonal coefficient 182 gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 183 & - zcoefs -zcoefw -zcoefe -zcoefn 181 gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn 184 182 END DO 185 183 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r4292 r4616 133 133 ! 134 134 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 135 !CDIR NOVERRCHK 135 ! 136 136 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 137 137 ! … … 265 265 ! 266 266 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 267 !CDIR NOVERRCHK 267 ! 268 268 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 269 269 ! … … 394 394 ! 395 395 CASE( 0 ) !== Jackett and McDougall (1994) formulation ==! 396 ! 397 !CDIR NOVERRCHK 396 ! 398 397 DO jj = 1, jpjm1 399 !CDIR NOVERRCHK400 398 DO ji = 1, fs_jpim1 ! vector opt. 401 399 zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r4596 r4616 90 90 ! !== effective transport ==! 91 91 DO jk = 1, jpkm1 92 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only93 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk)94 zwn(:,:,jk) = e1 t(:,:) * e2t(:,:)* wn(:,:,jk)92 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only 93 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 94 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 95 95 END DO 96 96 ! -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r4499 r4616 82 82 !! zwy = zcofj * zupsv + (1-zcofj) * zcenv 83 83 !! * horizontal advective trend (divergence of the fluxes) 84 !! ztra = 1/(e1 t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }84 !! ztra = 1/(e1e2t*e3t) { di-1[zwx] + dj-1[zwy] } 85 85 !! * Add this trend now to the general trend of tracer (ta,sa): 86 86 !! pta = pta + ztra … … 249 249 DO jj = 2, jpjm1 250 250 DO ji = fs_2, fs_jpim1 ! vector opt. 251 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )251 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 252 252 ! advective trends 253 253 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
r4325 r4616 184 184 DO jj = 1, jpjm1 185 185 DO ji = 1, fs_jpim1 ! vector opt. 186 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2 u(ji,jj) / e1u(ji,jj)&186 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 187 187 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 188 188 ! 189 zpsim_v(ji,jj) = rc_f * zhv(ji,jj) * zhv(ji,jj) * e1 v(ji,jj) / e2v(ji,jj)&189 zpsim_v(ji,jj) = rc_f * zhv(ji,jj) * zhv(ji,jj) * e1_e2v(ji,jj) & 190 190 & * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 191 191 END DO … … 247 247 ! divide by cross distance to give streamfunction with dimensions m^2/s 248 248 DO jk = 1, ikmax+1 249 zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) /e2u(:,:)250 zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) /e1v(:,:)249 zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) / e2u(:,:) 250 zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) / e1v(:,:) 251 251 END DO 252 252 CALL iom_put( "psiu_mle", zpsi_uw ) ! i-mle streamfunction -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r4499 r4616 191 191 z0u = SIGN( 0.5, pun(ji,jj,jk) ) 192 192 zalpha = 0.5 - z0u 193 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )193 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 194 194 zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji+1,jj,jk)) 195 195 zzwy = ptb(ji ,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji ,jj,jk)) … … 198 198 z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 199 199 zalpha = 0.5 - z0v 200 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )200 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 201 201 zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj+1,jk)) 202 202 zzwy = ptb(ji,jj ,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj ,jk)) … … 212 212 DO jj = 2, jpjm1 213 213 DO ji = fs_2, fs_jpim1 ! vector opt. 214 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )214 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 215 215 ! horizontal advective trends 216 216 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 270 270 DO jj = 2, jpjm1 271 271 DO ji = fs_2, fs_jpim1 ! vector opt. 272 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3w(ji,jj,jk+1) )272 zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 273 273 z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 274 274 zalpha = 0.5 + z0w … … 285 285 DO jj = 2, jpjm1 286 286 DO ji = fs_2, fs_jpim1 ! vector opt. 287 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )287 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 288 288 ! vertical advective trends 289 289 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r4499 r4616 146 146 z0u = SIGN( 0.5, pun(ji,jj,jk) ) 147 147 zalpha = 0.5 - z0u 148 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )148 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 149 149 zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk) 150 150 zzwy = ptb(ji ,jj,jk,jn) + zu * zslpx(ji ,jj,jk) … … 153 153 z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 154 154 zalpha = 0.5 - z0v 155 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )155 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 156 156 zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk) 157 157 zzwy = ptb(ji,jj ,jk,jn) + zv * zslpy(ji,jj ,jk) … … 190 190 DO jj = 2, jpjm1 191 191 DO ji = fs_2, fs_jpim1 ! vector opt. 192 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )192 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 193 193 ! horizontal advective trends 194 194 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 249 249 DO jj = 2, jpjm1 250 250 DO ji = fs_2, fs_jpim1 ! vector opt. 251 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3w(ji,jj,jk+1) )251 zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 252 252 z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 253 253 zalpha = 0.5 + z0w … … 275 275 DO jj = 2, jpjm1 276 276 DO ji = fs_2, fs_jpim1 ! vector opt. 277 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )277 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 278 278 ! vertical advective trends 279 279 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r4499 r4616 224 224 DO jj = 2, jpjm1 225 225 DO ji = fs_2, fs_jpim1 ! vector opt. 226 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )226 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 227 227 ! horizontal advective trends 228 228 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) … … 350 350 DO jj = 2, jpjm1 351 351 DO ji = fs_2, fs_jpim1 ! vector opt. 352 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )352 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 353 353 ! horizontal advective trends 354 354 ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) … … 413 413 DO jj = 2, jpjm1 414 414 DO ji = fs_2, fs_jpim1 ! vector opt. 415 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )415 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 416 416 ! k- vertical advective trends 417 417 ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r4499 r4616 151 151 DO jj = 2, jpjm1 152 152 DO ji = fs_2, fs_jpim1 ! vector opt. 153 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )153 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 154 154 ! total intermediate advective trends 155 155 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 211 211 DO jj = 2, jpjm1 212 212 DO ji = fs_2, fs_jpim1 ! vector opt. 213 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )213 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 214 214 ! total advective trends 215 215 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 321 321 322 322 ! up & down beta terms 323 zbt = e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt323 zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 324 324 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 325 325 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r4499 r4616 120 120 DO jj = 1, jpjm1 ! First derivative (gradient) 121 121 DO ji = 1, fs_jpim1 ! vector opt. 122 zeeu = e2 u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)123 zeev = e1 v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)122 zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk) 123 zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) 124 124 ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 125 125 ztv(ji,jj,jk) = zeev * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) … … 164 164 DO jj = 2, jpjm1 165 165 DO ji = fs_2, fs_jpim1 ! vector opt. 166 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )166 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 167 167 ! horizontal advective 168 168 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk) & … … 219 219 DO jj = 2, jpjm1 220 220 DO ji = fs_2, fs_jpim1 ! vector opt. 221 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )221 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 222 222 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr 223 223 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztak … … 245 245 DO jj = 2, jpjm1 246 246 DO ji = fs_2, fs_jpim1 ! vector opt. 247 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )247 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 248 248 ! k- vertical advective trends 249 249 ztra = - zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) … … 259 259 DO jj = 2, jpjm1 260 260 DO ji = fs_2, fs_jpim1 ! vector opt. 261 zbtr = 1.e0 / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )261 zbtr = 1.e0 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 262 262 z_hdivn = ( pwn(ji,jj,jk) - pwn(ji,jj,jk+1) ) * zbtr 263 263 zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn … … 358 358 zneg = MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) ) 359 359 ! up & down beta terms 360 zbt = e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt360 zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 361 361 zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 362 362 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r4147 r4616 84 84 ! 85 85 ! ! Add the geothermal heat flux trend on temperature 86 #if defined key_vectopt_loop87 DO jj = 1, 188 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)89 #else90 86 DO jj = 2, jpjm1 91 87 DO ji = 2, jpim1 92 #endif93 88 ik = mbkt(ji,jj) 94 89 zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r4292 r4616 37 37 USE timing ! Timing 38 38 39 40 39 IMPLICIT NONE 41 40 PRIVATE … … 47 46 PUBLIC bbl ! routine called by trcbbl.F90 and dtadyn.F90 48 47 49 LOGICAL, PUBLIC, PARAMETER :: lk_trabbl = .TRUE. !: bottom boundary layer flag 50 51 ! !!* Namelist nambbl * 52 INTEGER , PUBLIC :: nn_bbl_ldf !: =1 : diffusive bbl or not (=0) 53 INTEGER , PUBLIC :: nn_bbl_adv !: =1/2 : advective bbl or not (=0) 54 ! ! =1 : advective bbl using the bottom ocean velocity 55 ! ! =2 : - - using utr_bbl proportional to grad(rho) 56 REAL(wp), PUBLIC :: rn_ahtbbl !: along slope bbl diffusive coefficient [m2/s] 57 REAL(wp), PUBLIC :: rn_gambbl !: lateral coeff. for bottom boundary layer scheme [s] 58 59 LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 48 ! !!* Namelist nambbl * 49 LOGICAL , PUBLIC :: ln_trabbl !: bottom boundary layer flag 50 INTEGER , PUBLIC :: nn_bbl_ldf !: =1 : diffusive bbl or not (=0) 51 INTEGER , PUBLIC :: nn_bbl_adv !: =1/2 : advective bbl or not (=0) 52 ! ! =1 : advective bbl using the bottom ocean velocity 53 ! ! =2 : - - using utr_bbl proportional to grad(rho) 54 REAL(wp), PUBLIC :: rn_ahtbbl !: along slope bbl diffusive coefficient [m2/s] 55 REAL(wp), PUBLIC :: rn_gambbl !: lateral coeff. for bottom boundary layer scheme [s] 56 57 LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 60 58 61 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer … … 179 177 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 180 178 !!---------------------------------------------------------------------- 181 !182 179 INTEGER , INTENT(in ) :: kjpt ! number of tracers 183 180 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields … … 186 183 INTEGER :: ji, jj, jn ! dummy loop indices 187 184 INTEGER :: ik ! local integers 188 REAL(wp) :: zbtr ! local scalars189 185 REAL(wp), POINTER, DIMENSION(:,:) :: zptb 190 186 !!---------------------------------------------------------------------- … … 196 192 DO jn = 1, kjpt ! tracer loop 197 193 ! ! =========== 198 # if defined key_vectopt_loop199 DO jj = 1, 1 ! vector opt. (forced unrolling)200 DO ji = 1, jpij201 #else202 194 DO jj = 1, jpj 203 195 DO ji = 1, jpi 204 #endif205 196 ik = mbkt(ji,jj) ! bottom T-level index 206 197 zptb(ji,jj) = ptb(ji,jj,ik,jn) ! bottom before T and S … … 208 199 END DO 209 200 ! ! Compute the trend 210 # if defined key_vectopt_loop211 DO jj = 1, 1 ! vector opt. (forced unrolling)212 DO ji = jpi+1, jpij-jpi-1213 # else214 201 DO jj = 2, jpjm1 215 202 DO ji = 2, jpim1 216 # endif217 203 ik = mbkt(ji,jj) ! bottom T-level index 218 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,ik)219 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)&220 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) )&221 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) )&222 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) )&223 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) * zbtr204 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 205 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 206 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & 207 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 208 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 209 & / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) ) 224 210 END DO 225 211 END DO … … 264 250 DO jn = 1, kjpt ! tracer loop 265 251 ! ! =========== 266 # if defined key_vectopt_loop267 DO jj = 1, 1268 DO ji = 1, jpij-jpi-1 ! vector opt. (forced unrolling)269 # else270 252 DO jj = 1, jpjm1 271 253 DO ji = 1, jpim1 ! CAUTION start from i=1 to update i=2 when cyclic east-west 272 # endif273 254 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 274 255 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) … … 278 259 ! 279 260 ! ! up -slope T-point (shelf bottom point) 280 zbtr = r1_e1 2t(iis,jj) / fse3t(iis,jj,ikus)261 zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 281 262 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 282 263 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 283 264 ! 284 265 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 285 zbtr = r1_e1 2t(iid,jj) / fse3t(iid,jj,jk)266 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 286 267 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 287 268 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 288 269 END DO 289 270 ! 290 zbtr = r1_e1 2t(iid,jj) / fse3t(iid,jj,ikud)271 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 291 272 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 292 273 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 300 281 ! 301 282 ! up -slope T-point (shelf bottom point) 302 zbtr = r1_e1 2t(ji,ijs) / fse3t(ji,ijs,ikvs)283 zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 303 284 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 304 285 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 305 286 ! 306 287 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 307 zbtr = r1_e1 2t(ji,ijd) / fse3t(ji,ijd,jk)288 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 308 289 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 309 290 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 310 291 END DO 311 292 ! ! down-slope T-point (deep bottom point) 312 zbtr = r1_e1 2t(ji,ijd) / fse3t(ji,ijd,ikvd)293 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 313 294 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 314 295 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 353 334 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 354 335 !!---------------------------------------------------------------------- 355 !356 336 INTEGER , INTENT(in ) :: kt ! ocean time-step index 357 337 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 412 392 413 393 ! !* bottom temperature, salinity, velocity and depth 414 #if defined key_vectopt_loop415 DO jj = 1, 1 ! vector opt. (forced unrolling)416 DO ji = 1, jpij417 #else418 394 DO jj = 1, jpj 419 395 DO ji = 1, jpi 420 #endif421 396 ik = mbkt(ji,jj) ! bottom T-level index 422 397 ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1) ! bottom before T and S … … 629 604 630 605 ! !* masked diffusive flux coefficients 631 ahu_bbl_0(:,:) = rn_ahtbbl * e2 u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)* umask(:,:,1)632 ahv_bbl_0(:,:) = rn_ahtbbl * e1 v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)* vmask(:,:,1)606 ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 607 ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 633 608 634 609 -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r4596 r4616 72 72 !! - pahv e2u*vslp dk[ mj(mk(tb)) ] 73 73 !! take the horizontal divergence of the fluxes: 74 !! difft = 1/(e1 t*e2t*e3t) { di-1[ zftu ] + dj-1[ zftv ] }74 !! difft = 1/(e1e2t*e3t) { di-1[ zftu ] + dj-1[ zftv ] } 75 75 !! Add this trend to the general trend (ta,sa): 76 76 !! ta = ta + difft … … 82 82 !! + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ] } 83 83 !! take the horizontal divergence of the fluxes: 84 !! difft = 1/(e1 t*e2t*e3t) dk[ zftw ]84 !! difft = 1/(e1e2t*e3t) dk[ zftw ] 85 85 !! Add this trend to the general trend (ta,sa): 86 86 !! pta = pta + difft … … 246 246 DO jj = 1 , jpjm1 !== Horizontal fluxes 247 247 DO ji = 1, fs_jpim1 ! vector opt. 248 zabe1 = pahu(ji,jj,jk) * e2 u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)249 zabe2 = pahv(ji,jj,jk) * e1 v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)248 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u(ji,jj,jk) 249 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v(ji,jj,jk) 250 250 ! 251 251 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & … … 259 259 ! 260 260 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 261 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) &262 & + zdk1t(ji+1,jj) + zdkt (ji,jj) ) ) * umask(ji,jj,jk)261 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) & 262 & + zdk1t(ji+1,jj) + zdkt (ji,jj) ) ) * umask(ji,jj,jk) 263 263 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 264 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) &265 & + zdk1t(ji,jj+1) + zdkt (ji,jj) ) ) * vmask(ji,jj,jk)264 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) & 265 & + zdk1t(ji,jj+1) + zdkt (ji,jj) ) ) * vmask(ji,jj,jk) 266 266 END DO 267 267 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r4596 r4616 38 38 PUBLIC tra_ldf_blp ! routine called by step.F90 39 39 40 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: e1ur, e2vr ! scale factor coefficients41 42 40 !! * Substitutions 43 41 # include "domzgr_substitute.h90" … … 61 59 !! fields (forward time scheme). The horizontal diffusive trends of 62 60 !! the tracer is given by: 63 !! difft = 1/(e1 t*e2t*e3t) { di-1[ pahu e2u*e3u/e1u di(tb) ]64 !! 61 !! difft = 1/(e1e2t*e3t) { di-1[ pahu e2u*e3u/e1u di(tb) ] 62 !! + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 65 63 !! Add this trend to the general tracer trend pta : 66 64 !! pta = pta + difft … … 98 96 DO jj = 1, jpjm1 99 97 DO ji = 1, fs_jpim1 ! vector opt. 100 zaheeu(ji,jj,jk) = pahu(ji,jj,jk) * e2 u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) !!gm * umask(ji,jj,jk)101 zaheev(ji,jj,jk) = pahv(ji,jj,jk) * e1 v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) !!gm * vmask(ji,jj,jk)98 zaheeu(ji,jj,jk) = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u(ji,jj,jk) !!gm * umask(ji,jj,jk) 99 zaheev(ji,jj,jk) = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v(ji,jj,jk) !!gm * vmask(ji,jj,jk) 102 100 END DO 103 101 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r4333 r4616 62 62 # include "vectopt_loop_substitute.h90" 63 63 !!---------------------------------------------------------------------- 64 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)64 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 65 65 !! $Id$ 66 66 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 187 187 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 188 188 ! 189 !CDIR COLLAPSE190 !CDIR NOVERRCHK191 189 DO jj = 1, jpj ! Separation in R-G-B depending of the surface Chl 192 !CDIR NOVERRCHK193 190 DO ji = 1, jpi 194 191 zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) … … 215 212 ! 216 213 DO jk = 2, nksr+1 217 !CDIR NOVERRCHK218 214 DO jj = 1, jpj 219 !CDIR NOVERRCHK220 215 DO ji = 1, jpi 221 216 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r ) … … 502 497 503 498 DO jk = 2, nksr+1 504 !CDIR NOVERRCHK505 499 DO jj = 1, jpj 506 !CDIR NOVERRCHK507 500 DO ji = 1, jpi 508 501 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r4596 r4616 105 105 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 106 106 ! 107 # if defined key_vectopt_loop108 jj = 1109 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)110 # else111 107 DO jj = 1, jpjm1 112 108 DO ji = 1, jpim1 113 # endif114 109 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 115 110 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 … … 146 141 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 147 142 ENDIF 148 # if ! defined key_vectopt_loop149 143 END DO 150 # endif151 144 END DO 152 145 CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. … … 156 149 ! horizontal derivative of density anomalies (rd) 157 150 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 158 # if defined key_vectopt_loop159 jj = 1160 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)161 # else162 151 DO jj = 1, jpjm1 163 152 DO ji = 1, jpim1 164 # endif165 153 iku = mbku(ji,jj) 166 154 ikv = mbkv(ji,jj) … … 173 161 ELSE ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) ! - - case 2 174 162 ENDIF 175 # if ! defined key_vectopt_loop176 163 END DO 177 # endif178 164 END DO 179 165 … … 184 170 185 171 ! Gradient of density at the last level 186 # if defined key_vectopt_loop187 jj = 1188 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)189 # else190 172 DO jj = 1, jpjm1 191 173 DO ji = 1, jpim1 192 # endif193 174 iku = mbku(ji,jj) 194 175 ikv = mbkv(ji,jj) … … 201 182 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 202 183 ENDIF 203 # if ! defined key_vectopt_loop204 184 END DO 205 # endif206 185 END DO 207 186 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90
r4596 r4616 92 92 SELECT CASE( ktrd ) 93 93 CASE( jpdyn_trd_swf ) ! surface forcing 94 umo(ktrd) = SUM( ptrd2dx(:,:) * e1 u(:,:) *e2u(:,:) * fse3u(:,:,1) )95 vmo(ktrd) = SUM( ptrd2dy(:,:) * e1 v(:,:) *e2v(:,:) * fse3v(:,:,1) )94 umo(ktrd) = SUM( ptrd2dx(:,:) * e1e2u(:,:) * fse3u(:,:,1) ) 95 vmo(ktrd) = SUM( ptrd2dy(:,:) * e1e2v(:,:) * fse3v(:,:,1) ) 96 96 END SELECT 97 97 ! … … 104 104 ! 105 105 CASE( 'DYN' ) ! Momentum 106 hke(ktrd) = SUM( un(:,:,1) * ptrd2dx(:,:) * e1 u(:,:) *e2u(:,:) * fse3u(:,:,1) &107 & + vn(:,:,1) * ptrd2dy(:,:) * e1 v(:,:) *e2v(:,:) * fse3v(:,:,1) )106 hke(ktrd) = SUM( un(:,:,1) * ptrd2dx(:,:) * e1e2u(:,:) * fse3u(:,:,1) & 107 & + vn(:,:,1) * ptrd2dy(:,:) * e1e2v(:,:) * fse3v(:,:,1) ) 108 108 ! 109 109 CASE( 'TRA' ) ! Tracers … … 159 159 vmo(ktrd) = 0._wp 160 160 DO jk = 1, jpkm1 161 umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1 u(:,:) *e2u(:,:) * fse3u(:,:,jk) )162 vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1 v(:,:) *e2v(:,:) * fse3v(:,:,jk) )161 umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2u(:,:) * fse3u(:,:,jk) ) 162 vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2v(:,:) * fse3v(:,:,jk) ) 163 163 END DO 164 164 ! … … 178 178 hke(ktrd) = 0._wp 179 179 DO jk = 1, jpkm1 180 hke(ktrd) = hke(ktrd) + SUM( un(:,:,jk) * ptrd3dx(:,:,jk) * e1 u(:,:) *e2u(:,:) * fse3u(:,:,jk) &181 & + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1 v(:,:) *e2v(:,:) * fse3v(:,:,jk) )180 hke(ktrd) = hke(ktrd) + SUM( un(:,:,jk) * ptrd3dx(:,:,jk) * e1e2u(:,:) * fse3u(:,:,jk) & 181 & + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1e2v(:,:) * fse3v(:,:,jk) ) 182 182 END DO 183 183 ! … … 230 230 DO jj = 2, jpjm1 231 231 DO ji = fs_2, fs_jpim1 ! vector opt. 232 tvolu = tvolu + e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk)233 tvolv = tvolv + e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)232 tvolu = tvolu + e1e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 233 tvolv = tvolv + e1e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 234 234 END DO 235 235 END DO -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r3632 r4616 179 179 DO jj = 2, jpjm1 180 180 DO ji = fs_2, fs_jpim1 ! vector opt. 181 zbtr = 1. e0/ ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )181 zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 182 182 ptrd(ji,jj,jk) = - zbtr * ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 183 183 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk) ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r4381 r4616 105 105 IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient 106 106 107 # if defined key_vectopt_loop108 DO jj = 1, 1109 !CDIR NOVERRCHK110 DO ji = 1, jpij ! vector opt. (forced unrolling)111 # else112 !CDIR NOVERRCHK113 107 DO jj = 1, jpj 114 !CDIR NOVERRCHK115 108 DO ji = 1, jpi 116 # endif117 109 ikbt = mbkt(ji,jj) 118 110 ! JC: possible WAD implementation should modify line below if layers vanish … … 127 119 ENDIF 128 120 129 # if defined key_vectopt_loop130 DO jj = 1, 1131 !CDIR NOVERRCHK132 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)133 # else134 !CDIR NOVERRCHK135 121 DO jj = 2, jpjm1 136 !CDIR NOVERRCHK137 122 DO ji = 2, jpim1 138 # endif139 123 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 140 124 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) … … 265 249 ! 266 250 IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 267 # if defined key_vectopt_loop268 DO jj = 1, 1269 !CDIR NOVERRCHK270 DO ji = 1, jpij ! vector opt. (forced unrolling)271 # else272 !CDIR NOVERRCHK273 251 DO jj = 1, jpj 274 !CDIR NOVERRCHK275 252 DO ji = 1, jpi 276 # endif277 253 ikbt = mbkt(ji,jj) 278 254 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp … … 309 285 zmaxbfr = -1.e10_wp ! initialise tracker for maximum of bottom friction coefficient 310 286 ! 311 # if defined key_vectopt_loop312 DO jj = 1, 1313 !CDIR NOVERRCHK314 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)315 # else316 !CDIR NOVERRCHK317 287 DO jj = 2, jpjm1 318 !CDIR NOVERRCHK319 288 DO ji = 2, jpim1 320 # endif321 289 ikbu = mbku(ji,jj) ! deepest ocean level at u- and v-points 322 290 ikbv = mbkv(ji,jj) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r4147 r4616 44 44 # include "vectopt_loop_substitute.h90" 45 45 !!---------------------------------------------------------------------- 46 !! NEMO/OPA 4.0 , NEMO Consortium (2011)46 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 47 47 !! $Id$ 48 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 145 145 ! ------------------ 146 146 ! Constant eddy coefficient: reset to the background value 147 !CDIR NOVERRCHK148 147 DO jj = 1, jpj 149 !CDIR NOVERRCHK150 148 DO ji = 1, jpi 151 149 zinr = 1./rrau(ji,jj,jk) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r3294 r4616 78 78 ! 79 79 DO jk = 1, jpkm1 80 #if defined key_vectopt_loop81 DO jj = 1, 1 ! big loop forced82 DO ji = jpi+2, jpij83 #else84 80 DO jj = 2, jpj ! no vector opt. 85 81 DO ji = 2, jpi 86 #endif87 82 #if defined key_zdfkpp 88 83 ! no evd mixing in the boundary layer with KPP … … 110 105 DO jk = 1, jpkm1 111 106 !!! WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd ! agissant sur T SEUL! 112 #if defined key_vectopt_loop113 DO jj = 1, 1 ! big loop forced114 DO ji = 1, jpij115 #else116 107 DO jj = 1, jpj ! loop over the whole domain (no lbc_lnk call) 117 108 DO ji = 1, jpi 118 #endif119 109 #if defined key_zdfkpp 120 110 ! no evd mixing in the boundary layer with KPP -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r4147 r4616 112 112 # include "vectopt_loop_substitute.h90" 113 113 !!---------------------------------------------------------------------- 114 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)114 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 115 115 !! $Id$ 116 116 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 174 174 175 175 ! Compute surface and bottom friction at T-points 176 !CDIR NOVERRCHK177 176 DO jj = 2, jpjm1 178 !CDIR NOVERRCHK179 177 DO ji = fs_2, fs_jpim1 ! vector opt. 180 178 ! … … 387 385 ! ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin 388 386 ! ! Balance between the production and the dissipation terms 389 !CDIR NOVERRCHK 390 DO jj = 2, jpjm1 391 !CDIR NOVERRCHK 387 DO jj = 2, jpjm1 392 388 DO ji = fs_2, fs_jpim1 ! vector opt. 393 389 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 410 406 CASE ( 1 ) ! Neumman boundary condition 411 407 ! 412 !CDIR NOVERRCHK 413 DO jj = 2, jpjm1 414 !CDIR NOVERRCHK 408 DO jj = 2, jpjm1 415 409 DO ji = fs_2, fs_jpim1 ! vector opt. 416 410 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 650 644 ! ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * hbro 651 645 ! ! Balance between the production and the dissipation terms 652 !CDIR NOVERRCHK 653 DO jj = 2, jpjm1 654 !CDIR NOVERRCHK 646 DO jj = 2, jpjm1 655 647 DO ji = fs_2, fs_jpim1 ! vector opt. 656 648 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point … … 673 665 CASE ( 1 ) ! Neumman boundary condition 674 666 ! 675 !CDIR NOVERRCHK 676 DO jj = 2, jpjm1 677 !CDIR NOVERRCHK 667 DO jj = 2, jpjm1 678 668 DO ji = fs_2, fs_jpim1 ! vector opt. 679 669 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r4147 r4616 147 147 # include "zdfddm_substitute.h90" 148 148 !!---------------------------------------------------------------------- 149 !! NEMO/OPA 4.0 , NEMO Consortium (2011)149 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 150 150 !! $Id$ 151 151 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 435 435 ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) & 436 436 & + sfx(ji,jj) ) * rcs * tmask(ji,jj,1) 437 END DO438 END DO437 END DO 438 END DO 439 439 440 440 zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. ) … … 447 447 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 448 448 zustar(ji,jj) = SQRT( taum(ji,jj) / ( zrhos + epsln ) ) 449 ENDDO 450 ENDDO 451 452 !CDIR NOVERRCHK 453 ! ! =============== 449 END DO 450 END DO 451 452 ! ! =============== 454 453 DO jj = 2, jpjm1 ! Vertical slab 455 454 ! ! =============== 456 455 ! 457 456 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 458 457 ! II Compute Boundary layer mixing coef. and diagnose the new boundary layer depth -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r4147 r4616 99 99 # include "vectopt_loop_substitute.h90" 100 100 !!---------------------------------------------------------------------- 101 !! NEMO/OPA 4.0 , NEMO Consortium (2011)101 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 102 102 !! $Id$ 103 103 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 256 256 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 257 257 ! en(bot) = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 258 ! CDIR NOVERRCHK258 !!bfr - commented area 259 259 !! DO jj = 2, jpjm1 260 !CDIR NOVERRCHK261 260 !! DO ji = fs_2, fs_jpim1 ! vector opt. 262 261 !! ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + & … … 291 290 END DO 292 291 ! ! finite LC depth 293 # if defined key_vectopt_loop294 DO jj = 1, 1295 DO ji = 1, jpij ! vector opt. (forced unrolling)296 # else297 292 DO jj = 1, jpj 298 293 DO ji = 1, jpi 299 # endif300 294 zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj)) 301 295 END DO 302 296 END DO 303 297 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 304 !CDIR NOVERRCHK305 298 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 306 !CDIR NOVERRCHK 307 DO jj = 2, jpjm1 308 !CDIR NOVERRCHK 299 DO jj = 2, jpjm1 309 300 DO ji = fs_2, fs_jpim1 ! vector opt. 310 301 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift … … 425 416 END DO 426 417 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 427 !CDIR NOVERRCHK428 418 DO jk = 2, jpkm1 429 !CDIR NOVERRCHK 430 DO jj = 2, jpjm1 431 !CDIR NOVERRCHK 419 DO jj = 2, jpjm1 432 420 DO ji = fs_2, fs_jpim1 ! vector opt. 433 421 ztx2 = utau(ji-1,jj ) + utau(ji,jj) … … 513 501 zmxlm(:,:,jpk) = rmxl_min ! last level set to the interior minium value 514 502 ! 515 !CDIR NOVERRCHK516 503 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 517 !CDIR NOVERRCHK518 504 DO jj = 2, jpjm1 519 !CDIR NOVERRCHK520 505 DO ji = fs_2, fs_jpim1 ! vector opt. 521 506 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) … … 588 573 END DO 589 574 END DO 590 !CDIR NOVERRCHK591 575 DO jk = 2, jpkm1 592 !CDIR NOVERRCHK 593 DO jj = 2, jpjm1 594 !CDIR NOVERRCHK 576 DO jj = 2, jpjm1 595 577 DO ji = fs_2, fs_jpim1 ! vector opt. 596 578 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) … … 612 594 ! ! Vertical eddy viscosity and diffusivity (avmu, avmv, avt) 613 595 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 614 !CDIR NOVERRCHK615 596 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 616 !CDIR NOVERRCHK617 597 DO jj = 2, jpjm1 618 !CDIR NOVERRCHK619 598 DO ji = fs_2, fs_jpim1 ! vector opt. 620 599 zsqen = SQRT( en(ji,jj,jk) ) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r4147 r4616 54 54 # include "vectopt_loop_substitute.h90" 55 55 !!---------------------------------------------------------------------- 56 !! NEMO/OPA 4.0 , NEMO Consortium (2011)56 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 57 57 !! $Id$ 58 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 144 144 DO jj= 1, jpj 145 145 DO ji= 1, jpi 146 ztpc = ztpc + fse3w(ji,jj,jk) * e1 t(ji,jj) * e2t(ji,jj)&146 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) & 147 147 & * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 148 148 END DO … … 150 150 END DO 151 151 ztpc= rau0 / ( rn_tfe * rn_me ) * ztpc 152 IF( lk_mpp ) CALL mpp_sum( ztpc ) 152 153 IF(lwp) WRITE(numout,*) 153 154 IF(lwp) WRITE(numout,*) ' N Total power consumption by av_tide : ztpc = ', ztpc * 1.e-12 ,'TW' … … 228 229 DO jk = 1, jpkm1 229 230 zdn2dz (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1) ! Vertical profile of dN2/dz 230 !CDIR NOVERRCHK231 231 zempba_3d_1(:,:,jk) = SQRT( MAX( 0.e0, rn2(:,:,jk) ) ) ! - - of N 232 232 zempba_3d_2(:,:,jk) = MAX( 0.e0, rn2(:,:,jk) ) ! - - of N^2 … … 292 292 DO jj= 1, jpj 293 293 DO ji= 1, jpi 294 ztpc = ztpc + e1 t(ji,jj) *e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) &295 & * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)294 ztpc = ztpc + e1e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) & 295 & * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 296 296 END DO 297 297 END DO 298 298 END DO 299 IF( lk_mpp ) CALL mpp_sum( ztpc ) 299 300 ztpc= rau0 * ztpc / ( rn_me * rn_tfe_itf ) 300 301 IF(lwp) WRITE(numout,*) ' N Total power consumption by zavt_itf: ztpc = ', ztpc * 1.e-12 ,'TW' … … 446 447 DO jj = 1, jpj 447 448 DO ji = 1, jpi 448 ztpc = ztpc + fse3w(ji,jj,jk) * e1 t(ji,jj) *e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)449 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 449 450 END DO 450 451 END DO 451 452 END DO 453 IF( lk_mpp ) CALL mpp_sum( ztpc ) 452 454 ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 453 455 … … 492 494 DO jj = 1, jpj 493 495 DO ji = 1, jpi 494 ztpc = ztpc + fse3w(ji,jj,jk) * e1 t(ji,jj) *e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)496 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 495 497 END DO 496 498 END DO 497 499 END DO 500 IF( lk_mpp ) CALL mpp_sum( ztpc ) 498 501 ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 499 502 WRITE(numout,*) ' 2 Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW' 500 503 !!gm bug mpp in these diagnostics 501 504 DO jk = 1, jpk 502 ze_z = SUM( e1 t(:,:) * e2t(:,:) * zav_tide(:,:,jk)* tmask_i(:,:) ) &503 & / MAX( 1.e-20, SUM( e1 t(:,:) * e2t(:,:) * tmask(:,:,jk) * tmask_i(:,:) ) )504 ztpc = 1. E50505 ze_z = SUM( e1e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) ) & 506 & / MAX( 1.e-20, SUM( e1e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) ) 507 ztpc = 1.e50_wp 505 508 DO jj = 1, jpj 506 509 DO ji = 1, jpi 507 IF( zav_tide(ji,jj,jk) /= 0.e0 ) ztpc = Min( ztpc, zav_tide(ji,jj,jk) )510 IF( zav_tide(ji,jj,jk) /= 0.e0 ) ztpc = MIN( ztpc, zav_tide(ji,jj,jk) ) 508 511 END DO 509 512 END DO … … 512 515 END DO 513 516 514 WRITE(numout,*) ' e_tide : ', SUM( e1 t*e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW'517 WRITE(numout,*) ' e_tide : ', SUM( e1e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW' 515 518 WRITE(numout,*) 516 519 WRITE(numout,*) ' Initial profile of tidal vertical mixing' … … 521 524 END DO 522 525 END DO 523 ze_z = SUM( e1 t(:,:) * e2t(:,:) * zkz(:,:)* tmask_i(:,:) ) &524 & / MAX( 1.e-20, SUM( e1 t(:,:) *e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )526 ze_z = SUM( e1e2t(:,:) * zkz(:,:) * tmask_i(:,:) ) & 527 & / MAX( 1.e-20, SUM( e1e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) ) 525 528 WRITE(numout,*) ' jk= ', jk,' ', ze_z * 1.e4,' cm2/s' 526 529 END DO 527 530 DO jk = 1, jpk 528 531 zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 529 ze_z = SUM( e1 t(:,:) * e2t(:,:) * zkz(:,:)* tmask_i(:,:) ) &530 & / MAX( 1.e-20, SUM( e1 t(:,:) *e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )532 ze_z = SUM( e1e2t(:,:) * zkz(:,:) * tmask_i(:,:) ) & 533 & / MAX( 1.e-20, SUM( e1e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) ) 531 534 WRITE(numout,*) 532 535 WRITE(numout,*) ' N2 min - jk= ', jk,' ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4, & 533 536 & 'max= ', MAXVAL(zkz)*1.e4, ' cm2/s' 534 537 END DO 538 !!gm end bug mpp 535 539 ! 536 540 ENDIF -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/module_example
r4147 r4616 19 19 USE module_name1 ! brief description of the used module 20 20 USE module_name2 ! .... 21 ! 22 USE in_out_manager ! I/O manager 23 USE prtctl ! Print control 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 USE lib_mpp ! MPP library 26 USE wrk_nemo ! Memory Allocation 27 USE timing ! Timing 21 28 22 29 IMPLICIT NONE … … 87 94 !!---------------------------------------------------------------------- 88 95 USE toto_module ! description of the module 89 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 90 USE wrk_nemo, ONLY: zztab => wrk_2d_5 ! 2D workspace 91 USE wrk_nemo, ONLY: zwx => wrk_3d_12 , zwy => wrk_3d_13 ! 3D workspace 92 !! 96 ! 93 97 INTEGER , INTENT(in ) :: kt ! short description 94 98 INTEGER , INTENT(inout) :: pvar1 ! - - 95 99 REAL(wp), INTENT( out) :: pvar2 ! - - 96 100 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: pvar2 ! - - 97 ! !101 ! 98 102 INTEGER :: ji, jj, jk ! dummy loop arguments (DOCTOR : start with j, but not jp) 99 103 INTEGER :: itoto, itata ! temporary integers (DOCTOR : start with i 100 104 REAL(wp) :: zmlmin, zbbrau ! temporary scalars (DOCTOR : start with z) 101 105 REAL(wp) :: zfact1, zfact2 ! do not use continuation lines in declaration 106 REAL(wp), POINTER, DIMENSION(:,:,: ) :: zwrku, zwrkv ! 2D workspace as pointers 107 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zavm, zavt ! 3D workspace as pointers 102 108 !!-------------------------------------------------------------------- 103 109 104 IF( wrk_in_use(3, 12,13) .OR. wrk_in_use(2, 5 ) THEN 105 CALL ctl_stop('exa_mpl: requested workspace arrays unavailable') ; RETURN 106 ENDIF 110 IF( nn_timing == 1 ) CALL timing_start('exa_mpl') 111 112 CALL wrk_alloc( jpi, jpj, jpk, zavm , zavt ) ! assign workspace pointers to already allocated arrays 113 CALL wrk_alloc( jpi, jpj , zwrku, zwrkv ) 107 114 108 115 IF( kt == nit000 ) CALL exa_mpl_init ! Initialization (first time-step only) … … 137 144 CALL mpplnk2( avmu, 'U', 1. ) ! Lateral boundary conditions (unchanged sign) 138 145 ! 139 IF( wrk_not_released(3, 12,13) .OR. wrk_not_released(2, 5 ) THEN 140 CALL ctl_stop('exa_mpl: failed to release workspace arrays') ; RETURN 141 ENDIF 146 CALL wrk_dealloc( jpi, jpj, jpk, zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 147 CALL wrk_dealloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu ) 148 ! 149 IF( nn_timing == 1 ) CALL timing_stop('dyn_adv_ubs') 142 150 ! 143 151 END SUBROUTINE exa_mpl … … 157 165 !!---------------------------------------------------------------------- 158 166 INTEGER :: ji, jj, jk, jit ! dummy loop indices 159 INTEGER :: ios! Local integer output status for namelist read160 ! !167 INTEGER :: ios ! Local integer output status for namelist read 168 ! 161 169 NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex 162 170 !!---------------------------------------------------------------------- 163 171 ! 164 REWIND( numnam_ref ) 172 REWIND( numnam_ref ) ! Namelist namexa in reference namelist : Example 165 173 READ ( numnam_ref, namexa, IOSTAT = ios, ERR = 901) 166 174 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist', lwp ) 167 168 REWIND( numnam_cfg ) 175 ! 176 REWIND( numnam_cfg ) ! Namelist namexa in configuration namelist : Example 169 177 READ ( numnam_cfg, namexa, IOSTAT = ios, ERR = 902 ) 170 178 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist', lwp ) 171 ! Output namelist for control 172 WRITE ( numond, namexa ) 179 ! 180 WRITE ( numond, namexa ) ! Output namelist for control 181 173 182 ! 174 183 IF(lwp) THEN ! Control print -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
r4205 r4616 94 94 #endif 95 95 96 #if defined key_vectopt_loop97 LOGICAL, PUBLIC, PARAMETER :: lk_vopt_loop = .TRUE. !: vector optimization flag98 #else99 LOGICAL, PUBLIC, PARAMETER :: lk_vopt_loop = .FALSE. !: vector optimization flag100 #endif101 102 96 !!---------------------------------------------------------------------- 103 97 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/step.F90
r4596 r4616 212 212 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 213 213 214 215 214 #if defined key_top 216 215 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Note: See TracChangeset
for help on using the changeset viewer.