- Timestamp:
- 2016-07-01T18:02:45+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde_crs.F90
r5601 r6772 96 96 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points 97 97 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 98 !cc REAL(wp), POINTER, DIMENSION(:,: ) :: zri, zrj, zhi, zhj99 !cc REAL(wp), POINTER, DIMENSION(:,:,:) :: zti, zte ! interpolated value of tracer100 98 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zri, zrj, zhi, zhj 101 99 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zti, zte ! interpolated value of tracer … … 105 103 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde_crs') 106 104 ! 107 !! CALL wrk_alloc( jpi, jpj, zri, zrj, zhi, zhj )108 !! CALL wrk_alloc( jpi, jpj, kjpt, zti, zte )109 105 ALLOCATE( zri(jpi_crs,jpj_crs) , zrj(jpi_crs,jpj_crs), zte(jpi_crs ,jpj_crs ,kjpt), & 110 106 & zhi(jpi_crs,jpj_crs) , zhj(jpi_crs,jpj_crs), zti(jpi_crs ,jpj_crs ,kjpt)) … … 112 108 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 113 109 ! 114 # if defined key_vectopt_loop115 jj = 1116 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)117 # else118 110 DO jj = 1, jpjm1 119 111 DO ji = 1, jpim1 120 # endif 112 121 113 iku = mbku_crs(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 122 114 ikv = mbkv_crs(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 123 ! ze3wu = e3w_crs(ji+1,jj ,iku) - e3w_crs(ji,jj,iku) 124 ! ze3wv = e3w_crs(ji ,jj+1,ikv) - e3w_crs(ji,jj,ikv) 125 ze3wu = e3w_max_crs(ji+1,jj ,iku) - e3w_max_crs(ji,jj,iku) 126 ze3wv = e3w_max_crs(ji ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv) 115 ze3wu = e3w_max_0_crs(ji+1,jj ,iku) - e3w_max_0_crs(ji,jj,iku) 116 ze3wv = e3w_max_0_crs(ji ,jj+1,ikv) - e3w_max_0_crs(ji,jj,ikv) 127 117 ! 128 118 ! i- direction 129 119 IF( ze3wu >= 0._wp ) THEN ! case 1 130 zmaxu = ze3wu / e3w_max_crs(ji+1,jj,iku) 131 ! zmaxu = ze3wu / e3w_crs(ji+1,jj,iku) 120 #if defined key_vvl 121 zmaxu = ze3wu / e3w_max_n_crs(ji+1,jj,iku) 122 #else 123 zmaxu = ze3wu / e3w_max_0_crs(ji+1,jj,iku) 124 #endif 132 125 ! interpolated values of tracers 133 126 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) … … 135 128 pgtu(ji,jj,jn) = umask_crs(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 136 129 ELSE ! case 2 137 zmaxu = -ze3wu / e3w_max_crs(ji,jj,iku) 138 ! zmaxu = -ze3wu / e3w_crs(ji,jj,iku) 130 #if defined key_vvl 131 zmaxu = -ze3wu / e3w_max_n_crs(ji,jj,iku) 132 #else 133 zmaxu = -ze3wu / e3w_max_0_crs(ji,jj,iku) 134 #endif 139 135 ! interpolated values of tracers 140 136 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) … … 145 141 ! j- direction 146 142 IF( ze3wv >= 0._wp ) THEN ! case 1 147 zmaxv = ze3wv / e3w_max_crs(ji,jj+1,ikv) 148 ! zmaxv = ze3wv / e3w_crs(ji,jj+1,ikv) 143 #if defined key_vvl 144 zmaxv = ze3wv / e3w_max_n_crs(ji,jj+1,ikv) 145 #else 146 zmaxv = ze3wv / e3w_max_0_crs(ji,jj+1,ikv) 147 #endif 149 148 ! interpolated values of tracers 150 149 zte(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) … … 152 151 pgtv(ji,jj,jn) = vmask_crs(ji,jj,1) * ( zte(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 153 152 ELSE ! case 2 154 zmaxv = -ze3wv / e3w_max_crs(ji,jj,ikv) 155 ! zmaxv = -ze3wv / e3w_crs(ji,jj,ikv) 153 #if defined key_vvl 154 zmaxv = -ze3wv / e3w_max_n_crs(ji,jj,ikv) 155 #else 156 zmaxv = -ze3wv / e3w_max_0_crs(ji,jj,ikv) 157 #endif 156 158 ! interpolated values of tracers 157 159 zte(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) … … 160 162 ENDIF 161 163 162 # if ! defined key_vectopt_loop163 164 END DO 164 # endif165 165 END DO 166 166 CALL crs_lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL crs_lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 167 167 ! 168 168 END DO 169 !WRITE(numout,*) ' test24 ', e3w_max_crs 169 170 170 ! horizontal derivative of density anomalies (rd) 171 171 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 172 # if defined key_vectopt_loop173 jj = 1174 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)175 # else176 172 DO jj = 1, jpjm1 177 173 DO ji = 1, jpim1 178 # endif 174 179 175 iku = mbku_crs(ji,jj) 180 176 ikv = mbkv_crs(ji,jj) 181 !cc ze3wu = e3w_max_crs(ji+1,jj ,iku) - e3w_max_crs(ji,jj,iku) !gradiant horizontal pas de max 182 ze3wu = e3w_crs(ji+1,jj ,iku) - e3w_crs(ji,jj,iku) 183 !cc ze3wv = e3w_max_crs(ji ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv) 184 ze3wv = e3w_crs(ji ,jj+1,ikv) - e3w_crs(ji,jj,ikv) 185 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = gdept_crs(ji ,jj,iku) ! i-direction: case 1 186 ELSE ; zhi(ji,jj) = gdept_crs(ji+1,jj,iku) ! - - case 2 187 ENDIF 188 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = gdept_crs(ji,jj ,ikv) ! j-direction: case 1 189 ELSE ; zhj(ji,jj) = gdept_crs(ji,jj+1,ikv) ! - - case 2 190 ENDIF 191 # if ! defined key_vectopt_loop 177 ze3wu = e3w_0_crs(ji+1,jj ,iku) - e3w_0_crs(ji,jj,iku) 178 ze3wv = e3w_0_crs(ji ,jj+1,ikv) - e3w_0_crs(ji,jj,ikv) 179 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept_crs(ji ,jj,iku) ! i-direction: case 1 180 ELSE ; zhi(ji,jj) = fsdept_crs(ji+1,jj,iku) ! - - case 2 181 ENDIF 182 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept_crs(ji,jj ,ikv) ! j-direction: case 1 183 ELSE ; zhj(ji,jj) = fsdept_crs(ji,jj+1,ikv) ! - - case 2 184 ENDIF 185 192 186 END DO 193 # endif194 187 END DO 195 188 CALL eos_crs( zti, zhi, zri ) 196 189 CALL eos_crs( zte, zhj, zrj ) 190 197 191 ! Gradient of density at the last level 198 # if defined key_vectopt_loop199 jj = 1200 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled)201 # else202 192 DO jj = 1, jpjm1 203 193 DO ji = 1, jpim1 204 # endif205 194 iku = mbku_crs(ji,jj) 206 195 ikv = mbkv_crs(ji,jj) 207 ! ze3wu = e3w_max_crs(ji+1,jj ,iku) - e3w_max_crs(ji,jj,iku) gradient horizontal 208 ze3wu = e3w_crs(ji+1,jj ,iku) - e3w_crs(ji,jj,iku) 209 ! ze3wv = e3w_max_crs(ji ,jj+1,ikv) - e3w_max_crs(ji,jj,ikv) gradient horizontal 210 ze3wv = e3w_crs(ji ,jj+1,ikv) - e3w_crs(ji,jj,ikv) 196 ze3wu = e3w_0_crs(ji+1,jj ,iku) - e3w_0_crs(ji,jj,iku) 197 ze3wv = e3w_0_crs(ji ,jj+1,ikv) - e3w_0_crs(ji,jj,ikv) 211 198 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask_crs(ji,jj,1) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1 212 199 ELSE ; pgru(ji,jj) = umask_crs(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 … … 215 202 ELSE ; pgrv(ji,jj) = vmask_crs(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 216 203 ENDIF 217 # if ! defined key_vectopt_loop 204 218 205 END DO 219 # endif220 206 END DO 221 222 207 223 208 CALL crs_lbc_lnk( pgru , 'U', -1. ) ; CALL crs_lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions … … 225 210 END IF 226 211 ! 227 !!ccCALL wrk_dealloc( jpi, jpj, zri, zrj, zhi, zhj )228 !!ccCALL wrk_dealloc( jpi, jpj, kjpt, zti, zte )229 212 DEALLOCATE( zri , zrj, zte, zhi, zhj, zti) 230 213 !
Note: See TracChangeset
for help on using the changeset viewer.
