Changeset 592 for trunk/NEMO/OPA_SRC/DYN/dynnxt.F90
- Timestamp:
- 2007-02-09T10:15:25+01:00 (17 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DYN/dynnxt.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DYN/dynnxt.F90
r392 r592 21 21 USE agrif_opa_update 22 22 USE agrif_opa_interp 23 USE domvvl ! variable volume 23 24 24 25 IMPLICIT NONE … … 27 28 !! * Accessibility 28 29 PUBLIC dyn_nxt ! routine called by step.F90 30 !! * Substitutions 31 # include "domzgr_substitute.h90" 29 32 !!---------------------------------------------------------------------- 30 33 … … 70 73 INTEGER :: ji, jj, jk ! dummy loop indices 71 74 REAL(wp) :: z2dt ! temporary scalar 75 !! Variable volume 76 REAL(wp) :: zsshun, zsshvn ! temporary scalars 77 REAL(wp), DIMENSION(jpi,jpj) :: & 78 zsshub, zsshua, zsshvb, zsshva ! 2D workspace 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 80 zfse3ub, zfse3un, zfse3ua, & ! 3D workspace 81 zfse3vb, zfse3vn, zfse3va 72 82 !!---------------------------------------------------------------------- 73 83 !! OPA 9.0 , LOCEAN-IPSL (2005) … … 85 95 z2dt = 2. * rdt 86 96 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 97 98 !! Explicit physics with thickness weighted updates 99 IF( lk_vvl .AND. .NOT. lk_dynspg_flt ) THEN 100 101 ! Sea surface elevation time stepping 102 ! ----------------------------------- 103 ! 104 DO jj = 1, jpjm1 105 DO ji = 1,jpim1 106 107 ! Sea Surface Height at u-point before 108 zsshub(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) & 109 & * ( e1t(ji ,jj ) * e2t(ji ,jj ) * sshbb(ji ,jj ) & 110 & + e1t(ji+1,jj ) * e2t(ji+1,jj ) * sshbb(ji+1,jj ) ) 111 112 ! Sea Surface Height at v-point before 113 zsshvb(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) & 114 & * ( e1t(ji ,jj ) * e2t(ji ,jj ) * sshbb(ji ,jj ) & 115 & + e1t(ji ,jj+1) * e2t(ji ,jj+1) * sshbb(ji ,jj+1) ) 116 117 ! Sea Surface Height at u-point after 118 zsshua(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) & 119 & * ( e1t(ji ,jj ) * e2t(ji ,jj ) * ssha(ji ,jj ) & 120 & + e1t(ji+1,jj ) * e2t(ji+1,jj ) * ssha(ji+1,jj ) ) 121 122 ! Sea Surface Height at v-point after 123 zsshva(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) & 124 & * ( e1t(ji ,jj ) * e2t(ji ,jj ) * ssha(ji ,jj ) & 125 & + e1t(ji ,jj+1) * e2t(ji ,jj+1) * ssha(ji ,jj+1) ) 126 127 END DO 128 END DO 129 130 ! Boundaries conditions 131 CALL lbc_lnk( zsshua, 'U', 1. ) ; CALL lbc_lnk( zsshva, 'V', 1. ) 132 CALL lbc_lnk( zsshub, 'U', 1. ) ; CALL lbc_lnk( zsshvb, 'V', 1. ) 133 134 ! Scale factors at before and after time step 135 ! ------------------------------------------- 136 DO jk = 1, jpkm1 137 zfse3ub(:,:,jk) = fsve3u(:,:,jk) * ( 1 + zsshub(:,:) * muu(:,:,jk) ) 138 zfse3ua(:,:,jk) = fsve3u(:,:,jk) * ( 1 + zsshua(:,:) * muu(:,:,jk) ) 139 zfse3vb(:,:,jk) = fsve3v(:,:,jk) * ( 1 + zsshvb(:,:) * muv(:,:,jk) ) 140 zfse3va(:,:,jk) = fsve3v(:,:,jk) * ( 1 + zsshva(:,:) * muv(:,:,jk) ) 141 END DO 142 143 ! Asselin filtered scale factor at now time step 144 ! ---------------------------------------------- 145 IF( (neuler == 0 .AND. kt == nit000) .OR. lk_dynspg_ts ) THEN 146 zfse3un(:,:,:) = fse3u(:,:,:) 147 zfse3vn(:,:,:) = fse3v(:,:,:) 148 ELSE 149 DO jk = 1, jpkm1 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 zsshun = atfp * ( zsshub(ji,jj) + zsshua(ji,jj) ) + atfp1 * sshu(ji,jj) 153 zsshvn = atfp * ( zsshvb(ji,jj) + zsshva(ji,jj) ) + atfp1 * sshv(ji,jj) 154 zfse3un(ji,jj,jk) = fsve3u(ji,jj,jk) * ( 1 + zsshun * muu(ji,jj,jk) ) 155 zfse3vn(ji,jj,jk) = fsve3v(ji,jj,jk) * ( 1 + zsshvn * muv(ji,jj,jk) ) 156 END DO 157 END DO 158 END DO 159 ENDIF 160 161 ! Thickness weighting 162 ! ------------------- 163 ua(:,:,1:jpkm1) = ua(:,:,1:jpkm1) * fse3u (:,:,1:jpkm1) 164 va(:,:,1:jpkm1) = va(:,:,1:jpkm1) * fse3v (:,:,1:jpkm1) 165 166 un(:,:,1:jpkm1) = un(:,:,1:jpkm1) * fse3u (:,:,1:jpkm1) 167 vn(:,:,1:jpkm1) = vn(:,:,1:jpkm1) * fse3v (:,:,1:jpkm1) 168 169 ub(:,:,1:jpkm1) = ub(:,:,1:jpkm1) * zfse3ub(:,:,1:jpkm1) 170 vb(:,:,1:jpkm1) = vb(:,:,1:jpkm1) * zfse3vb(:,:,1:jpkm1) 171 172 ENDIF 87 173 88 174 ! Lateral boundary conditions on ( ua, va ) … … 146 232 # endif 147 233 #endif 234 148 235 ! Time filter and swap of dynamics arrays 149 236 ! ------------------------------------------ 150 237 IF( neuler == 0 .AND. kt == nit000 ) THEN 151 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 152 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 153 ! Euler (forward) time stepping 154 ub(ji,jj,jk) = un(ji,jj,jk) 155 vb(ji,jj,jk) = vn(ji,jj,jk) 156 un(ji,jj,jk) = ua(ji,jj,jk) 157 vn(ji,jj,jk) = va(ji,jj,jk) 158 END DO 159 END DO 238 IF( (lk_vvl .AND. .NOT. lk_dynspg_flt) ) THEN ! Varying levels 239 ! caution: don't use (:,:) for this loop 240 ! it causes optimization problems on NEC in auto-tasking 241 DO jj = 1, jpj 242 DO ji = 1, jpi 243 zsshun = umask(ji,jj,jk) / fse3u(ji,jj,jk) 244 zsshvn = vmask(ji,jj,jk) / fse3v(ji,jj,jk) 245 ub(ji,jj,jk) = un(ji,jj,jk) * zsshun * umask(ji,jj,jk) 246 vb(ji,jj,jk) = vn(ji,jj,jk) * zsshvn * vmask(ji,jj,jk) 247 zsshun = umask(ji,jj,jk) / zfse3ua(ji,jj,jk) 248 zsshvn = vmask(ji,jj,jk) / zfse3va(ji,jj,jk) 249 un(ji,jj,jk) = ua(ji,jj,jk) * zsshun * umask(ji,jj,jk) 250 vn(ji,jj,jk) = va(ji,jj,jk) * zsshvn * vmask(ji,jj,jk) 251 END DO 252 END DO 253 ELSE ! Fixed levels 254 DO jj = 1, jpj 255 DO ji = 1, jpi 256 ! Euler (forward) time stepping 257 ub(ji,jj,jk) = un(ji,jj,jk) 258 vb(ji,jj,jk) = vn(ji,jj,jk) 259 un(ji,jj,jk) = ua(ji,jj,jk) 260 vn(ji,jj,jk) = va(ji,jj,jk) 261 END DO 262 END DO 263 ENDIF 160 264 ELSE 161 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 162 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 163 ! Leap-frog time stepping 164 ub(ji,jj,jk) = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk) 165 vb(ji,jj,jk) = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk) 166 un(ji,jj,jk) = ua(ji,jj,jk) 167 vn(ji,jj,jk) = va(ji,jj,jk) 168 END DO 169 END DO 265 IF( (lk_vvl .AND. .NOT. lk_dynspg_flt) ) THEN ! Varying levels 266 ! caution: don't use (:,:) for this loop 267 ! it causes optimization problems on NEC in auto-tasking 268 DO jj = 1, jpj 269 DO ji = 1, jpi 270 zsshun = umask(ji,jj,jk) / zfse3un(ji,jj,jk) 271 zsshvn = vmask(ji,jj,jk) / zfse3vn(ji,jj,jk) 272 ub(ji,jj,jk) = ( atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) & 273 & + atfp1 * un(ji,jj,jk) ) * zsshun 274 vb(ji,jj,jk) = ( atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) & 275 & + atfp1 * vn(ji,jj,jk) ) * zsshvn 276 zsshun = umask(ji,jj,jk) / zfse3ua(ji,jj,jk) 277 zsshvn = vmask(ji,jj,jk) / zfse3va(ji,jj,jk) 278 un(ji,jj,jk) = ua(ji,jj,jk) * zsshun 279 vn(ji,jj,jk) = va(ji,jj,jk) * zsshvn 280 END DO 281 END DO 282 ELSE ! Fixed levels 283 DO jj = 1, jpj 284 DO ji = 1, jpi 285 ! Leap-frog time stepping 286 ub(ji,jj,jk) = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk) 287 vb(ji,jj,jk) = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk) 288 un(ji,jj,jk) = ua(ji,jj,jk) 289 vn(ji,jj,jk) = va(ji,jj,jk) 290 END DO 291 END DO 292 ENDIF 170 293 ENDIF 171 294 ! ! ===============
Note: See TracChangeset
for help on using the changeset viewer.
