Changeset 8708
- Timestamp:
- 2017-11-15T12:39:36+01:00 (7 years ago)
- Location:
- branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO
- Files:
-
- 7 edited
-
LIM_SRC_3/limrst.F90 (modified) (13 diffs)
-
OPA_SRC/IOM/iom.F90 (modified) (6 diffs)
-
OPA_SRC/IOM/iom_def.F90 (modified) (1 diff)
-
OPA_SRC/IOM/iom_nf90.F90 (modified) (8 diffs)
-
OPA_SRC/LBC/lbclnk.F90 (modified) (6 diffs)
-
OPA_SRC/LBC/lbcnfd.F90 (modified) (17 diffs)
-
OPA_SRC/LBC/lib_mpp.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r7813 r8708 86 86 ENDIF 87 87 ! 88 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )88 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib, ndlev = jpl ) 89 89 lrst_ice = .TRUE. 90 90 ENDIF … … 107 107 CHARACTER(len=25) :: znam 108 108 CHARACTER(len=2) :: zchar, zchar1 109 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d110 !!---------------------------------------------------------------------- 111 112 CALL wrk_alloc( jpi, jpj, z2d )109 REAL(wp), POINTER, DIMENSION(:,:, :) :: z3d 110 !!---------------------------------------------------------------------- 111 112 CALL wrk_alloc( jpi, jpj, jpl, z3d ) 113 113 114 114 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 … … 127 127 128 128 ! Prognostic variables 129 DO jl = 1, jpl 130 WRITE(zchar,'(I2.2)') jl 131 znam = 'v_i'//'_htc'//zchar 132 z2d(:,:) = v_i(:,:,jl) 133 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 134 znam = 'v_s'//'_htc'//zchar 135 z2d(:,:) = v_s(:,:,jl) 136 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 137 znam = 'smv_i'//'_htc'//zchar 138 z2d(:,:) = smv_i(:,:,jl) 139 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 140 znam = 'oa_i'//'_htc'//zchar 141 z2d(:,:) = oa_i(:,:,jl) 142 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 143 znam = 'a_i'//'_htc'//zchar 144 z2d(:,:) = a_i(:,:,jl) 145 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 146 znam = 't_su'//'_htc'//zchar 147 z2d(:,:) = t_su(:,:,jl) 148 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 149 znam = 'tempt_sl1'//'_htc'//zchar 150 z2d(:,:) = e_s(:,:,1,jl) 151 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 152 DO jk = 1, nlay_i 153 WRITE(zchar1,'(I2.2)') jk 154 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 155 z2d(:,:) = e_i(:,:,jk,jl) 156 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 157 END DO 129 znam = 'v_i' 130 CALL iom_rstput( iter, nitrst, numriw, znam , v_i ) 131 znam = 'v_s' 132 CALL iom_rstput( iter, nitrst, numriw, znam , v_s ) 133 znam = 'smv_i' 134 CALL iom_rstput( iter, nitrst, numriw, znam , smv_i ) 135 znam = 'oa_i' 136 CALL iom_rstput( iter, nitrst, numriw, znam , oa_i ) 137 znam = 'a_i' 138 CALL iom_rstput( iter, nitrst, numriw, znam , a_i ) 139 znam = 't_su' 140 CALL iom_rstput( iter, nitrst, numriw, znam , t_su ) 141 znam = 'tempt_sl1' 142 z3d = e_s(:,:,1,:) 143 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 144 DO jk = 1, nlay_i 145 WRITE(zchar1,'(I2.2)') jk 146 znam = 'tempt'//'_il'//zchar1 147 z3d(:,:,:) = e_i(:,:,jk,:) 148 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 158 149 END DO 159 150 … … 169 160 ! ------------------------------------------------------------------------ 170 161 IF( nn_limadv == -1 ) THEN 171 172 DO jl = 1, jpl 173 WRITE(zchar,'(I2.2)') jl 174 znam = 'sxice'//'_htc'//zchar 175 z2d(:,:) = sxice(:,:,jl) 176 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 177 znam = 'syice'//'_htc'//zchar 178 z2d(:,:) = syice(:,:,jl) 179 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 180 znam = 'sxxice'//'_htc'//zchar 181 z2d(:,:) = sxxice(:,:,jl) 182 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 183 znam = 'syyice'//'_htc'//zchar 184 z2d(:,:) = syyice(:,:,jl) 185 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 186 znam = 'sxyice'//'_htc'//zchar 187 z2d(:,:) = sxyice(:,:,jl) 188 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 189 znam = 'sxsn'//'_htc'//zchar 190 z2d(:,:) = sxsn(:,:,jl) 191 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 192 znam = 'sysn'//'_htc'//zchar 193 z2d(:,:) = sysn(:,:,jl) 194 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 195 znam = 'sxxsn'//'_htc'//zchar 196 z2d(:,:) = sxxsn(:,:,jl) 197 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 198 znam = 'syysn'//'_htc'//zchar 199 z2d(:,:) = syysn(:,:,jl) 200 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 201 znam = 'sxysn'//'_htc'//zchar 202 z2d(:,:) = sxysn(:,:,jl) 203 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 204 znam = 'sxa'//'_htc'//zchar 205 z2d(:,:) = sxa(:,:,jl) 206 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 207 znam = 'sya'//'_htc'//zchar 208 z2d(:,:) = sya(:,:,jl) 209 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 210 znam = 'sxxa'//'_htc'//zchar 211 z2d(:,:) = sxxa(:,:,jl) 212 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 213 znam = 'syya'//'_htc'//zchar 214 z2d(:,:) = syya(:,:,jl) 215 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 216 znam = 'sxya'//'_htc'//zchar 217 z2d(:,:) = sxya(:,:,jl) 218 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 219 znam = 'sxc0'//'_htc'//zchar 220 z2d(:,:) = sxc0(:,:,jl) 221 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 222 znam = 'syc0'//'_htc'//zchar 223 z2d(:,:) = syc0(:,:,jl) 224 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 225 znam = 'sxxc0'//'_htc'//zchar 226 z2d(:,:) = sxxc0(:,:,jl) 227 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 228 znam = 'syyc0'//'_htc'//zchar 229 z2d(:,:) = syyc0(:,:,jl) 230 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 231 znam = 'sxyc0'//'_htc'//zchar 232 z2d(:,:) = sxyc0(:,:,jl) 233 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 234 znam = 'sxsal'//'_htc'//zchar 235 z2d(:,:) = sxsal(:,:,jl) 236 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 237 znam = 'sysal'//'_htc'//zchar 238 z2d(:,:) = sysal(:,:,jl) 239 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 240 znam = 'sxxsal'//'_htc'//zchar 241 z2d(:,:) = sxxsal(:,:,jl) 242 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 243 znam = 'syysal'//'_htc'//zchar 244 z2d(:,:) = syysal(:,:,jl) 245 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 246 znam = 'sxysal'//'_htc'//zchar 247 z2d(:,:) = sxysal(:,:,jl) 248 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 249 znam = 'sxage'//'_htc'//zchar 250 z2d(:,:) = sxage(:,:,jl) 251 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 252 znam = 'syage'//'_htc'//zchar 253 z2d(:,:) = syage(:,:,jl) 254 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 255 znam = 'sxxage'//'_htc'//zchar 256 z2d(:,:) = sxxage(:,:,jl) 257 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 258 znam = 'syyage'//'_htc'//zchar 259 z2d(:,:) = syyage(:,:,jl) 260 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 261 znam = 'sxyage'//'_htc'//zchar 262 z2d(:,:) = sxyage(:,:,jl) 263 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 264 END DO 162 write(*,*) 'BACK in LIM3+1',nn_limadv 163 znam = 'sxice' 164 CALL iom_rstput( iter, nitrst, numriw, znam , sxice ) 165 znam = 'syice' 166 CALL iom_rstput( iter, nitrst, numriw, znam , syice ) 167 znam = 'sxxice' 168 CALL iom_rstput( iter, nitrst, numriw, znam , sxxice ) 169 znam = 'syyice' 170 CALL iom_rstput( iter, nitrst, numriw, znam , syyice ) 171 znam = 'sxyice' 172 CALL iom_rstput( iter, nitrst, numriw, znam , sxyice ) 173 znam = 'sxsn' 174 CALL iom_rstput( iter, nitrst, numriw, znam , sxsn ) 175 znam = 'sysn' 176 CALL iom_rstput( iter, nitrst, numriw, znam , sysn ) 177 znam = 'sxxsn' 178 CALL iom_rstput( iter, nitrst, numriw, znam , sxxsn ) 179 znam = 'syysn' 180 CALL iom_rstput( iter, nitrst, numriw, znam , syysn ) 181 znam = 'sxysn' 182 CALL iom_rstput( iter, nitrst, numriw, znam , sxysn ) 183 znam = 'sxa' 184 CALL iom_rstput( iter, nitrst, numriw, znam , sxa ) 185 znam = 'sya' 186 CALL iom_rstput( iter, nitrst, numriw, znam , sya ) 187 znam = 'sxxa' 188 CALL iom_rstput( iter, nitrst, numriw, znam , sxxa ) 189 znam = 'syya' 190 CALL iom_rstput( iter, nitrst, numriw, znam , syya ) 191 znam = 'sxya' 192 CALL iom_rstput( iter, nitrst, numriw, znam , sxya ) 193 znam = 'sxc0' 194 CALL iom_rstput( iter, nitrst, numriw, znam , sxc0 ) 195 znam = 'syc0' 196 CALL iom_rstput( iter, nitrst, numriw, znam , syc0 ) 197 znam = 'sxxc0' 198 CALL iom_rstput( iter, nitrst, numriw, znam , sxxc0 ) 199 znam = 'syyc0' 200 CALL iom_rstput( iter, nitrst, numriw, znam , syyc0 ) 201 znam = 'sxyc0' 202 CALL iom_rstput( iter, nitrst, numriw, znam , sxyc0 ) 203 znam = 'sxsal' 204 CALL iom_rstput( iter, nitrst, numriw, znam , sxsal ) 205 znam = 'sysal' 206 CALL iom_rstput( iter, nitrst, numriw, znam , sysal ) 207 znam = 'sxxsal' 208 CALL iom_rstput( iter, nitrst, numriw, znam , sxxsal ) 209 znam = 'syysal' 210 CALL iom_rstput( iter, nitrst, numriw, znam , syysal ) 211 znam = 'sxysal' 212 CALL iom_rstput( iter, nitrst, numriw, znam , sxysal ) 213 znam = 'sxage' 214 CALL iom_rstput( iter, nitrst, numriw, znam , sxage ) 215 znam = 'syage' 216 CALL iom_rstput( iter, nitrst, numriw, znam , syage ) 217 znam = 'sxxage' 218 CALL iom_rstput( iter, nitrst, numriw, znam , sxxage ) 219 znam = 'syyage' 220 CALL iom_rstput( iter, nitrst, numriw, znam , syyage ) 221 znam = 'sxyage' 222 CALL iom_rstput( iter, nitrst, numriw, znam , sxyage ) 265 223 266 224 CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' , sxopw ) … … 270 228 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' , sxyopw ) 271 229 272 DO jl = 1, jpl 273 WRITE(zchar,'(I2.2)') jl 274 DO jk = 1, nlay_i 230 DO jk = 1, nlay_i 275 231 WRITE(zchar1,'(I2.2)') jk 276 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 277 z2d(:,:) = sxe(:,:,jk,jl) 278 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 279 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 280 z2d(:,:) = sye(:,:,jk,jl) 281 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 282 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 283 z2d(:,:) = sxxe(:,:,jk,jl) 284 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 285 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 286 z2d(:,:) = syye(:,:,jk,jl) 287 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 288 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 289 z2d(:,:) = sxye(:,:,jk,jl) 290 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 291 END DO 232 znam = 'sxe'//'_il'//zchar1 233 z3d(:,:,:) = sxe(:,:,jk,:) 234 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 235 znam = 'sye'//'_il'//zchar1 236 z3d(:,:,:) = sye(:,:,jk,:) 237 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 238 znam = 'sxxe'//'_il'//zchar1 239 z3d(:,:,:) = sxxe(:,:,jk,:) 240 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 241 znam = 'syye'//'_il'//zchar1 242 z3d(:,:,:) = syye(:,:,jk,:) 243 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 244 znam = 'sxye'//'_il'//zchar1 245 z3d(:,:,:) = sxye(:,:,jk,:) 246 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 292 247 END DO 293 248 … … 301 256 ENDIF 302 257 ! 303 CALL wrk_dealloc( jpi, jpj, z2d )258 CALL wrk_dealloc( jpi, jpj, jpl, z3d ) 304 259 ! 305 260 END SUBROUTINE lim_rst_write … … 314 269 INTEGER :: ji, jj, jk, jl 315 270 REAL(wp) :: zfice, ziter 316 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d271 REAL(wp), POINTER, DIMENSION(:,:, :) :: z3d 317 272 CHARACTER(len=25) :: znam 318 273 CHARACTER(len=2) :: zchar, zchar1 … … 321 276 !!---------------------------------------------------------------------- 322 277 323 CALL wrk_alloc( jpi, jpj, z2d )278 CALL wrk_alloc( jpi, jpj, jpl, z3d ) 324 279 325 280 IF(lwp) THEN … … 329 284 ENDIF 330 285 331 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )286 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib, ndlev = jpl ) 332 287 333 288 CALL iom_get( numrir, 'nn_fsbc', zfice ) … … 348 303 349 304 ! Prognostic variables 350 DO jl = 1, jpl 351 WRITE(zchar,'(I2.2)') jl 352 znam = 'v_i'//'_htc'//zchar 353 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 354 v_i(:,:,jl) = z2d(:,:) 355 znam = 'v_s'//'_htc'//zchar 356 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 357 v_s(:,:,jl) = z2d(:,:) 358 znam = 'smv_i'//'_htc'//zchar 359 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 360 smv_i(:,:,jl) = z2d(:,:) 361 znam = 'oa_i'//'_htc'//zchar 362 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 363 oa_i(:,:,jl) = z2d(:,:) 364 znam = 'a_i'//'_htc'//zchar 365 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 366 a_i(:,:,jl) = z2d(:,:) 367 znam = 't_su'//'_htc'//zchar 368 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 369 t_su(:,:,jl) = z2d(:,:) 370 znam = 'tempt_sl1'//'_htc'//zchar 371 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 372 e_s(:,:,1,jl) = z2d(:,:) 373 DO jk = 1, nlay_i 374 WRITE(zchar1,'(I2.2)') jk 375 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 376 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 377 e_i(:,:,jk,jl) = z2d(:,:) 378 END DO 305 znam = 'v_i' 306 CALL iom_get( numrir, jpdom_autoglo, znam , v_i ) 307 znam = 'v_s' 308 CALL iom_get( numrir, jpdom_autoglo, znam , v_s ) 309 znam = 'smv_i' 310 CALL iom_get( numrir, jpdom_autoglo, znam , smv_i ) 311 znam = 'oa_i' 312 CALL iom_get( numrir, jpdom_autoglo, znam , oa_i ) 313 znam = 'a_i' 314 CALL iom_get( numrir, jpdom_autoglo, znam , a_i ) 315 znam = 't_su' 316 CALL iom_get( numrir, jpdom_autoglo, znam , t_su ) 317 znam = 'tempt_sl1' 318 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 319 e_s(:,:,1,:) = z3d 320 DO jk = 1, nlay_i 321 WRITE(zchar1,'(I2.2)') jk 322 znam = 'tempt'//'_il'//zchar1 323 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 324 e_i(:,:,jk,:) = z3d(:,:,:) 379 325 END DO 380 326 … … 391 337 IF( nn_limadv == -1 ) THEN 392 338 393 DO jl = 1, jpl 394 WRITE(zchar,'(I2.2)') jl 395 znam = 'sxice'//'_htc'//zchar 396 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 397 sxice(:,:,jl) = z2d(:,:) 398 znam = 'syice'//'_htc'//zchar 399 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 400 syice(:,:,jl) = z2d(:,:) 401 znam = 'sxxice'//'_htc'//zchar 402 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 403 sxxice(:,:,jl) = z2d(:,:) 404 znam = 'syyice'//'_htc'//zchar 405 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 406 syyice(:,:,jl) = z2d(:,:) 407 znam = 'sxyice'//'_htc'//zchar 408 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 409 sxyice(:,:,jl) = z2d(:,:) 410 znam = 'sxsn'//'_htc'//zchar 411 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 412 sxsn(:,:,jl) = z2d(:,:) 413 znam = 'sysn'//'_htc'//zchar 414 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 415 sysn(:,:,jl) = z2d(:,:) 416 znam = 'sxxsn'//'_htc'//zchar 417 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 418 sxxsn(:,:,jl) = z2d(:,:) 419 znam = 'syysn'//'_htc'//zchar 420 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 421 syysn(:,:,jl) = z2d(:,:) 422 znam = 'sxysn'//'_htc'//zchar 423 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 424 sxysn(:,:,jl) = z2d(:,:) 425 znam = 'sxa'//'_htc'//zchar 426 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 427 sxa(:,:,jl) = z2d(:,:) 428 znam = 'sya'//'_htc'//zchar 429 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 430 sya(:,:,jl) = z2d(:,:) 431 znam = 'sxxa'//'_htc'//zchar 432 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 433 sxxa(:,:,jl) = z2d(:,:) 434 znam = 'syya'//'_htc'//zchar 435 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 436 syya(:,:,jl) = z2d(:,:) 437 znam = 'sxya'//'_htc'//zchar 438 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 439 sxya(:,:,jl) = z2d(:,:) 440 znam = 'sxc0'//'_htc'//zchar 441 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 442 sxc0(:,:,jl) = z2d(:,:) 443 znam = 'syc0'//'_htc'//zchar 444 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 445 syc0(:,:,jl) = z2d(:,:) 446 znam = 'sxxc0'//'_htc'//zchar 447 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 448 sxxc0(:,:,jl) = z2d(:,:) 449 znam = 'syyc0'//'_htc'//zchar 450 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 451 syyc0(:,:,jl) = z2d(:,:) 452 znam = 'sxyc0'//'_htc'//zchar 453 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 454 sxyc0(:,:,jl) = z2d(:,:) 455 znam = 'sxsal'//'_htc'//zchar 456 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 457 sxsal(:,:,jl) = z2d(:,:) 458 znam = 'sysal'//'_htc'//zchar 459 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 460 sysal(:,:,jl) = z2d(:,:) 461 znam = 'sxxsal'//'_htc'//zchar 462 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 463 sxxsal(:,:,jl) = z2d(:,:) 464 znam = 'syysal'//'_htc'//zchar 465 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 466 syysal(:,:,jl) = z2d(:,:) 467 znam = 'sxysal'//'_htc'//zchar 468 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 469 sxysal(:,:,jl) = z2d(:,:) 470 znam = 'sxage'//'_htc'//zchar 471 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 472 sxage(:,:,jl) = z2d(:,:) 473 znam = 'syage'//'_htc'//zchar 474 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 475 syage(:,:,jl) = z2d(:,:) 476 znam = 'sxxage'//'_htc'//zchar 477 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 478 sxxage(:,:,jl) = z2d(:,:) 479 znam = 'syyage'//'_htc'//zchar 480 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 481 syyage(:,:,jl) = z2d(:,:) 482 znam = 'sxyage'//'_htc'//zchar 483 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 484 sxyage(:,:,jl)= z2d(:,:) 485 END DO 339 znam = 'sxice' 340 CALL iom_get( numrir, jpdom_autoglo, znam , sxice ) 341 znam = 'syice' 342 CALL iom_get( numrir, jpdom_autoglo, znam , syice ) 343 znam = 'sxxice' 344 CALL iom_get( numrir, jpdom_autoglo, znam , sxxice ) 345 znam = 'syyice' 346 CALL iom_get( numrir, jpdom_autoglo, znam , syyice ) 347 znam = 'sxyice' 348 CALL iom_get( numrir, jpdom_autoglo, znam , sxyice ) 349 znam = 'sxsn' 350 CALL iom_get( numrir, jpdom_autoglo, znam , sxsn ) 351 znam = 'sysn' 352 CALL iom_get( numrir, jpdom_autoglo, znam , sysn ) 353 znam = 'sxxsn' 354 CALL iom_get( numrir, jpdom_autoglo, znam , sxxsn ) 355 znam = 'syysn' 356 CALL iom_get( numrir, jpdom_autoglo, znam , syysn ) 357 znam = 'sxysn' 358 CALL iom_get( numrir, jpdom_autoglo, znam , sxysn ) 359 znam = 'sxa' 360 CALL iom_get( numrir, jpdom_autoglo, znam , sxa ) 361 znam = 'sya' 362 CALL iom_get( numrir, jpdom_autoglo, znam , sya ) 363 znam = 'sxxa' 364 CALL iom_get( numrir, jpdom_autoglo, znam , sxxa ) 365 znam = 'syya' 366 CALL iom_get( numrir, jpdom_autoglo, znam , syya ) 367 znam = 'sxya' 368 CALL iom_get( numrir, jpdom_autoglo, znam , sxya ) 369 znam = 'sxc0' 370 CALL iom_get( numrir, jpdom_autoglo, znam , sxc0 ) 371 znam = 'syc0' 372 CALL iom_get( numrir, jpdom_autoglo, znam , syc0 ) 373 znam = 'sxxc0' 374 CALL iom_get( numrir, jpdom_autoglo, znam , sxxc0 ) 375 znam = 'syyc0' 376 CALL iom_get( numrir, jpdom_autoglo, znam , syyc0 ) 377 znam = 'sxyc0' 378 CALL iom_get( numrir, jpdom_autoglo, znam , sxyc0 ) 379 znam = 'sxsal' 380 CALL iom_get( numrir, jpdom_autoglo, znam , sxsal ) 381 znam = 'sysal' 382 CALL iom_get( numrir, jpdom_autoglo, znam , sysal ) 383 znam = 'sxxsal' 384 CALL iom_get( numrir, jpdom_autoglo, znam , sxxsal ) 385 znam = 'syysal' 386 CALL iom_get( numrir, jpdom_autoglo, znam , syysal ) 387 znam = 'sxysal' 388 CALL iom_get( numrir, jpdom_autoglo, znam , sxysal ) 389 znam = 'sxage' 390 CALL iom_get( numrir, jpdom_autoglo, znam , sxage ) 391 znam = 'syage' 392 CALL iom_get( numrir, jpdom_autoglo, znam , syage ) 393 znam = 'sxxage' 394 CALL iom_get( numrir, jpdom_autoglo, znam , sxxage ) 395 znam = 'syyage' 396 CALL iom_get( numrir, jpdom_autoglo, znam , syyage ) 397 znam = 'sxyage' 398 CALL iom_get( numrir, jpdom_autoglo, znam , sxyage ) 486 399 487 400 CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' , sxopw ) … … 495 408 DO jk = 1, nlay_i 496 409 WRITE(zchar1,'(I2.2)') jk 497 znam = 'sxe'//'_il'//zchar1 //'_htc'//zchar498 CALL iom_get( numrir, jpdom_autoglo, znam , z 2d )499 sxe(:,:,jk, jl) = z2d(:,:)500 znam = 'sye'//'_il'//zchar1 //'_htc'//zchar501 CALL iom_get( numrir, jpdom_autoglo, znam , z 2d )502 sye(:,:,jk, jl) = z2d(:,:)503 znam = 'sxxe'//'_il'//zchar1 //'_htc'//zchar504 CALL iom_get( numrir, jpdom_autoglo, znam , z 2d )505 sxxe(:,:,jk, jl) = z2d(:,:)506 znam = 'syye'//'_il'//zchar1 //'_htc'//zchar507 CALL iom_get( numrir, jpdom_autoglo, znam , z 2d )508 syye(:,:,jk, jl) = z2d(:,:)509 znam = 'sxye'//'_il'//zchar1 //'_htc'//zchar510 CALL iom_get( numrir, jpdom_autoglo, znam , z 2d )511 sxye(:,:,jk, jl) = z2d(:,:)410 znam = 'sxe'//'_il'//zchar1 411 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 412 sxe(:,:,jk,:) = z3d(:,:,:) 413 znam = 'sye'//'_il'//zchar1 414 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 415 sye(:,:,jk,:) = z3d(:,:,:) 416 znam = 'sxxe'//'_il'//zchar1 417 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 418 sxxe(:,:,jk,:) = z3d(:,:,:) 419 znam = 'syye'//'_il'//zchar1 420 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 421 syye(:,:,jk,:) = z3d(:,:,:) 422 znam = 'sxye'//'_il'//zchar1 423 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 424 sxye(:,:,jk,:) = z3d(:,:,:) 512 425 END DO 513 426 END DO … … 528 441 !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 529 442 ! 530 CALL wrk_dealloc( jpi, jpj, z2d )443 CALL wrk_dealloc( jpi, jpj, jpl, z3d ) 531 444 ! 532 445 END SUBROUTINE lim_rst_read -
branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8573 r8708 239 239 240 240 241 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )241 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof, ndlev ) 242 242 !!--------------------------------------------------------------------- 243 243 !! *** SUBROUTINE iom_open *** … … 252 252 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 253 253 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 254 INTEGER , INTENT(in ), OPTIONAL :: ndlev ! number of vertical levels 254 255 255 256 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] … … 405 406 IF( istop == nstop ) THEN ! no error within this routine 406 407 SELECT CASE (iolib) 407 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar )408 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, ndlev = ndlev ) 408 409 CASE DEFAULT 409 410 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) … … 672 673 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 673 674 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 675 INTEGER :: inlev ! number of levels for 3D data 674 676 !--------------------------------------------------------------------- 675 677 ! 678 inlev = -1 679 IF(PRESENT(pv_r3d)) inlev = SIZE(pv_r3d, 3) 676 680 clname = iom_file(kiomid)%name ! esier to read 677 681 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 801 805 ENDIF 802 806 IF( PRESENT(pv_r3d) ) THEN 803 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkglo807 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 804 808 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3) 805 ELSE ; icnt(3) = jpk809 ELSE ; icnt(3) = inlev 806 810 ENDIF 807 811 ENDIF … … 886 890 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 887 891 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 888 IF( icnt(3) == jpk) THEN892 IF( icnt(3) == inlev ) THEN 889 893 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 890 894 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) -
branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r7646 r8708 64 64 REAL(kind=wp), DIMENSION(jpmax_vars) :: scf !: scale_factor of the variables 65 65 REAL(kind=wp), DIMENSION(jpmax_vars) :: ofs !: add_offset of the variables 66 INTEGER :: nlev ! number of vertical levels 66 67 END TYPE file_descriptor 67 68 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files -
branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r7646 r8708 53 53 CONTAINS 54 54 55 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )55 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, ndlev ) 56 56 !!--------------------------------------------------------------------- 57 57 !! *** SUBROUTINE iom_open *** … … 64 64 LOGICAL , INTENT(in ) :: ldok ! check the existence 65 65 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 66 INTEGER , INTENT(in ), OPTIONAL :: ndlev 66 67 67 68 CHARACTER(LEN=256) :: clinfo ! info character … … 76 77 INTEGER :: ihdf5 ! local variable for retrieval of value for NF90_HDF5 77 78 LOGICAL :: llclobber ! local definition of ln_clobber 79 INTEGER :: ilevels ! vertical levels 78 80 !--------------------------------------------------------------------- 79 81 80 82 clinfo = ' iom_nf90_open ~~~ ' 81 83 istop = nstop ! store the actual value of nstop 84 ilevels = jpk 85 IF(PRESENT(ndlev)) ilevels = ndlev ! number of vertical levels 86 ! by default jpk, but can be 87 ! different for LIM3 82 88 IF( nn_chunksz > 0 ) THEN ; ichunk = nn_chunksz 83 89 ELSE ; ichunk = NF90_SIZEHINT_DEFAULT … … 126 132 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1) , idmy ), clinfo) 127 133 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1) , idmy ), clinfo) 128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk, idmy ), clinfo)134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', ilevels , idmy ), clinfo) 129 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo) 130 136 ! global attributes … … 156 162 iom_file(kiomid)%nvars = 0 157 163 iom_file(kiomid)%irec = -1 ! useless for NetCDF files, used to know if the file is in define mode 164 iom_file(kiomid)%nlev = ilevels 158 165 CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 159 166 IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN … … 693 700 LOGICAL :: lchunk ! logical switch to activate chunking and compression 694 701 ! when appropriate (currently chunking is applied to 4d fields only) 702 INTEGER :: i ! local variable 695 703 !--------------------------------------------------------------------- 696 704 ! … … 706 714 ENDIF 707 715 ! define the dimension variables if it is not already done 708 cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter' /) 716 IF(iom_file(kiomid)%nlev == jpk ) THEN 717 cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter' /) 718 ELSE 719 cltmp = (/ 'nav_lon ', 'nav_lat ', 'numcat ', 'time_counter' /) 720 ENDIF 709 721 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 710 722 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) … … 819 831 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat' , idmy ), clinfo) 820 832 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo) 821 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo) 822 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d ), clinfo) 833 IF(iom_file(kiomid)%nlev == jpk ) THEN 834 !NEMO 835 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo) 836 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d ), clinfo) 837 ELSE 838 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'numcat' , idmy ), clinfo) 839 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, (/ (i, i = 1,iom_file(kiomid)%nlev) /)), clinfo) 840 ENDIF 823 841 ! +++ WRONG VALUE: to be improved but not really useful... 824 842 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo) -
branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r8114 r8708 135 135 !!---------------------------------------------------------------------- 136 136 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! nature of pt3d grid-points 137 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied137 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied 138 138 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 139 139 !!---------------------------------------------------------------------- … … 154 154 !!---------------------------------------------------------------------- 155 155 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 156 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied156 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 157 157 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 158 158 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 159 159 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 160 160 ! 161 INTEGER :: jk ! dummy loop index 162 REAL(wp) :: ztab ! local scalar 163 !!---------------------------------------------------------------------- 164 ! 165 DO jk = 1, jpk 161 INTEGER :: jk, ilev ! dummy loop index 162 REAL(wp) :: ztab ! local scalar 163 !!---------------------------------------------------------------------- 164 ! 165 ilev = SIZE(pt3d, 3) 166 DO jk = 1, ilev 166 167 ztab = pt3d(2,2,jk) 167 168 pt3d(:,:,jk) = ztab … … 268 269 !!---------------------------------------------------------------------- 269 270 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! nature of pt3d grid-points 270 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied271 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied 271 272 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 272 273 !!---------------------------------------------------------------------- … … 291 292 !!---------------------------------------------------------------------- 292 293 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 293 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied294 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 294 295 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 295 296 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) … … 567 568 !!---------------------------------------------------------------------- 568 569 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 569 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied570 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 570 571 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 571 572 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) … … 623 624 !!---------------------------------------------------------------------- 624 625 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 625 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied626 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 626 627 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 627 628 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set -
branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r7646 r8708 62 62 ! 63 63 INTEGER :: ji, jk 64 INTEGER :: ijt, iju, ijpj, ijpjm1 64 INTEGER :: ijt, iju, ijpj, ijpjm1, ilev 65 65 !!---------------------------------------------------------------------- 66 66 … … 71 71 ijpjm1 = ijpj-1 72 72 73 DO jk = 1, jpk 73 ilev = SIZE(pt3d, 3) 74 DO jk = 1, ilev 74 75 ! 75 76 SELECT CASE ( npolj ) … … 393 394 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pt3dr ! 3D array on which the boundary condition is applied 394 395 ! 395 INTEGER :: ji, jk 396 INTEGER :: ji, jk, ilev 396 397 INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 397 398 !!---------------------------------------------------------------------- … … 402 403 END SELECT 403 404 ijpjm1 = ijpj-1 404 405 ilev = SIZE(pt3dl,3) 405 406 ! 406 407 SELECT CASE ( npolj ) … … 416 417 ENDIF 417 418 418 DO jk = 1, jpk419 DO jk = 1, ilev 419 420 DO ji = startloop, nlci 420 421 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 … … 434 435 ENDIF 435 436 IF(startloop .le. nlci) THEN 436 DO jk = 1, jpk437 DO jk = 1, ilev 437 438 DO ji = startloop, nlci 438 439 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 … … 455 456 endloop = nlci - 1 456 457 ENDIF 457 DO jk = 1, jpk458 DO jk = 1, ilev 458 459 DO ji = 1, endloop 459 460 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 481 482 ENDIF 482 483 IF (startloop .le. endloop) THEN 483 DO jk = 1, jpk484 DO jk = 1, ilev 484 485 DO ji = startloop, endloop 485 486 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 501 502 startloop = 2 502 503 ENDIF 503 DO jk = 1, jpk504 DO jk = 1, ilev 504 505 DO ji = startloop, nlci 505 506 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 … … 517 518 endloop = nlci - 1 518 519 ENDIF 519 DO jk = 1, jpk520 DO jk = 1, ilev 520 521 DO ji = 1, endloop 521 522 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 537 538 SELECT CASE ( cd_type ) 538 539 CASE ( 'T' , 'W' ) ! T-, W-point 539 DO jk = 1, jpk540 DO jk = 1, ilev 540 541 DO ji = 1, nlci 541 542 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 550 551 endloop = nlci - 1 551 552 ENDIF 552 DO jk = 1, jpk553 DO jk = 1, ilev 553 554 DO ji = 1, endloop 554 555 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 … … 561 562 562 563 CASE ( 'V' ) ! V-point 563 DO jk = 1, jpk564 DO jk = 1, ilev 564 565 DO ji = 1, nlci 565 566 ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 576 577 ENDIF 577 578 IF(startloop .le. nlci) THEN 578 DO jk = 1, jpk579 DO jk = 1, ilev 579 580 DO ji = startloop, nlci 580 581 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 590 591 endloop = nlci - 1 591 592 ENDIF 592 DO jk = 1, jpk593 DO jk = 1, ilev 593 594 DO ji = 1, endloop 594 595 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 … … 613 614 ENDIF 614 615 IF (startloop .le. endloop) THEN 615 DO jk = 1, jpk616 DO jk = 1, ilev 616 617 DO ji = startloop, endloop 617 618 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 … … 627 628 SELECT CASE ( cd_type) 628 629 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 629 pt3dl(:, 1 , jk) = 0.e0630 pt3dl(:,ijpj, jk) = 0.e0630 pt3dl(:, 1 ,:) = 0.e0 631 pt3dl(:,ijpj,:) = 0.e0 631 632 CASE ( 'F' ) ! F-point 632 pt3dl(:,ijpj, jk) = 0.e0633 pt3dl(:,ijpj,:) = 0.e0 633 634 END SELECT 634 635 ! -
branches/2017/dev_rev8689_LIM3_RST/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7753 r8708 351 351 !! 352 352 !!---------------------------------------------------------------------- 353 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied353 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied 354 354 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 355 355 ! ! = T , U , V , F , W points … … 359 359 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 360 360 ! 361 INTEGER :: ji, jj, jk, jl 361 INTEGER :: ji, jj, jk, jl, ilev ! dummy loop indices 362 362 INTEGER :: imigr, iihom, ijhom ! temporary integers 363 363 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend … … 367 367 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 368 368 !!---------------------------------------------------------------------- 369 370 ALLOCATE( zt3ns(jpi,jprecj, jpk,2), zt3sn(jpi,jprecj,jpk,2), &371 & zt3ew(jpj,jpreci, jpk,2), zt3we(jpj,jpreci,jpk,2) )369 ilev = SIZE(ptab, 3) 370 ALLOCATE( zt3ns(jpi,jprecj,ilev,2), zt3sn(jpi,jprecj,ilev,2), & 371 & zt3ew(jpj,jpreci,ilev,2), zt3we(jpj,jpreci,ilev,2) ) 372 372 373 373 ! … … 381 381 ! 382 382 ! WARNING ptab is defined only between nld and nle 383 DO jk = 1, jpk383 DO jk = 1, ilev 384 384 DO jj = nlcj+1, jpj ! added line(s) (inner only) 385 385 ptab(nldi :nlei , jj ,jk) = ptab(nldi:nlei, nlej,jk) … … 430 430 ! 431 431 ! ! Migrations 432 imigr = jpreci * jpj * jpk432 imigr = jpreci * jpj * ilev 433 433 ! 434 434 SELECT CASE ( nbondi ) … … 482 482 ! 483 483 ! ! Migrations 484 imigr = jprecj * jpi * jpk484 imigr = jprecj * jpi * ilev 485 485 ! 486 486 SELECT CASE ( nbondj ) … … 1055 1055 !! 1056 1056 !!---------------------------------------------------------------------- 1057 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: ptab1 ! first and second 3D array on which1058 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: ptab2 ! the boundary condition is applied1057 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: ptab1 ! first and second 3D array on which 1058 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: ptab2 ! the boundary condition is applied 1059 1059 CHARACTER(len=1) , INTENT(in ) :: cd_type1 ! nature of ptab1 and ptab2 arrays 1060 1060 CHARACTER(len=1) , INTENT(in ) :: cd_type2 ! i.e. grid-points = T , U , V , F or W points 1061 1061 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 1062 1062 !! ! = 1. , the sign is kept 1063 INTEGER :: jl ! dummy loop indices1063 INTEGER :: jl, ilev ! dummy loop indices 1064 1064 INTEGER :: imigr, iihom, ijhom ! temporary integers 1065 1065 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend … … 1069 1069 !!---------------------------------------------------------------------- 1070 1070 ! 1071 ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) , & 1072 & zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 1071 ilev = SIZE(ptab1, 3) 1072 ALLOCATE( zt4ns(jpi,jprecj,ilev,2,2), zt4sn(jpi,jprecj,ilev,2,2) , & 1073 & zt4ew(jpj,jpreci,ilev,2,2), zt4we(jpj,jpreci,ilev,2,2) ) 1073 1074 ! 1074 1075 ! 1. standard boundary treatment … … 1117 1118 ! 1118 1119 ! ! Migrations 1119 imigr = jpreci * jpj * jpk*21120 imigr = jpreci * jpj * ilev *2 1120 1121 ! 1121 1122 SELECT CASE ( nbondi ) … … 1176 1177 ! 1177 1178 ! ! Migrations 1178 imigr = jprecj * jpi * jpk* 21179 imigr = jprecj * jpi * ilev * 2 1179 1180 ! 1180 1181 SELECT CASE ( nbondj ) … … 1451 1452 !! 1452 1453 !!---------------------------------------------------------------------- 1453 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied1454 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied 1454 1455 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 1455 1456 ! ! = T , U , V , F , W points … … 1459 1460 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 1460 1461 !! 1461 INTEGER :: ji, jj, jk, jl 1462 INTEGER :: ji, jj, jk, jl,ilev ! dummy loop indices 1462 1463 INTEGER :: imigr, iihom, ijhom ! temporary integers 1463 1464 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend … … 1469 1470 1470 1471 !!---------------------------------------------------------------------- 1471 1472 ALLOCATE( zt3ns(jpi,jprecj, jpk,2), zt3sn(jpi,jprecj,jpk,2), &1473 & zt3ew(jpj,jpreci, jpk,2), zt3we(jpj,jpreci,jpk,2) )1472 ilev = SIZE(ptab, 3) 1473 ALLOCATE( zt3ns(jpi,jprecj,ilev,2), zt3sn(jpi,jprecj,ilev,2), & 1474 & zt3ew(jpj,jpreci,ilev,2), zt3we(jpj,jpreci,ilev,2) ) 1474 1475 1475 1476 ! … … 1494 1495 ! 1495 1496 ! ! Migrations 1496 imigr = jpreci * jpj * jpk1497 imigr = jpreci * jpj * ilev 1497 1498 ! 1498 1499 SELECT CASE ( nbondi ) … … 1547 1548 ! 1548 1549 ! ! Migrations 1549 imigr = jprecj * jpi * jpk1550 imigr = jprecj * jpi * ilev 1550 1551 ! 1551 1552 SELECT CASE ( nbondj )
Note: See TracChangeset
for help on using the changeset viewer.
