Changeset 2634
- Timestamp:
- 2011-03-01T12:37:26+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
r2633 r2634 200 200 !! 201 201 !! ** Purpose : Request a set of KIND(wp) workspaces to use. Returns 202 !! .TRUE. if all those requested are available, .FALSE. otherwise. 203 !! 204 !! ** Method : Sets internal flags to signal that requested workspaces are in use. 202 !! .TRUE. if any of those requested are already in use, 203 !! .FALSE. otherwise. 204 !! 205 !! ** Method : Sets internal flags to signal that requested workspaces 206 !! are in use. 205 207 !!---------------------------------------------------------------------- 206 208 INTEGER, INTENT(in) :: kdim ! Dimensionality of requested workspace(s) … … 214 216 !!---------------------------------------------------------------------- 215 217 216 wrk_in_use = . TRUE.218 wrk_in_use = .FALSE. 217 219 iptr = index1 218 220 iarg = 1 … … 223 225 IF( iptr > num_1d_wrkspaces ) THEN 224 226 CALL wrk_stop('wrk_in_use - more 1D workspace arrays requested than defined in wrk_nemo module') 225 wrk_in_use = . FALSE.227 wrk_in_use = .TRUE. 226 228 EXIT 227 229 ELSEIF( in_use_1d(iptr) ) THEN 228 wrk_in_use = . FALSE.230 wrk_in_use = .TRUE. 229 231 CALL print_in_use_list(1, REAL_TYPE, in_use_1d) 230 232 ENDIF … … 234 236 IF( iptr > num_2d_wrkspaces ) THEN 235 237 CALL wrk_stop('wrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module') 236 wrk_in_use = . FALSE.238 wrk_in_use = .TRUE. 237 239 EXIT 238 240 ELSEIF( in_use_2d(iptr) ) THEN 239 wrk_in_use = . FALSE.241 wrk_in_use = .TRUE. 240 242 CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 241 243 ENDIF … … 245 247 IF( iptr > num_3d_wrkspaces ) THEN 246 248 CALL wrk_stop( 'wrk_in_use - more 3D workspace arrays requested than defined in wrk_nemo module' ) 247 wrk_in_use = . FALSE.249 wrk_in_use = .TRUE. 248 250 EXIT 249 251 ELSEIF( in_use_3d(iptr) ) THEN 250 wrk_in_use = . FALSE.252 wrk_in_use = .TRUE. 251 253 CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 252 254 ENDIF … … 256 258 IF(iptr > num_4d_wrkspaces)THEN 257 259 CALL wrk_stop( 'wrk_in_use - more 4D workspace arrays requested than defined in wrk_nemo module' ) 258 wrk_in_use = . FALSE.260 wrk_in_use = .TRUE. 259 261 EXIT 260 262 ELSEIF( in_use_4d(iptr) ) THEN 261 wrk_in_use = . FALSE.263 wrk_in_use = .TRUE. 262 264 CALL print_in_use_list( 4, REAL_TYPE, in_use_4d ) 263 265 ENDIF … … 295 297 !! 296 298 !! ** Purpose : Request a set of LOGICAL workspaces to use. Returns 297 !! .TRUE. if all those requested are available, .FALSE. otherwise. 298 !! 299 !! ** Method : Sets internal flags to signal that requested workspaces are in use. 299 !! .TRUE. if any of those requested are already in use, 300 !! .FALSE. otherwise. 301 !! 302 !! ** Method : Sets internal flags to signal that requested workspaces 303 !! are in use. 300 304 !!---------------------------------------------------------------------- 301 305 INTEGER, INTENT(in) :: kdim ! Dimensionality of requested workspace(s) … … 307 311 !!---------------------------------------------------------------------- 308 312 ! 309 llwrk_in_use = . TRUE.313 llwrk_in_use = .FALSE. 310 314 iptr = index1 311 315 iarg = 1 … … 316 320 IF(iptr > num_2d_lwrkspaces)THEN 317 321 CALL wrk_stop('llwrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module') 318 llwrk_in_use = . FALSE.322 llwrk_in_use = .TRUE. 319 323 EXIT 320 324 ELSE IF( in_use_2dll(iptr) )THEN 321 llwrk_in_use = . FALSE.325 llwrk_in_use = .TRUE. 322 326 CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 323 327 END IF … … 328 332 IF(iptr > num_3d_lwrkspaces)THEN 329 333 CALL wrk_stop('llwrk_in_use - more 3D workspace arrays requested than defined in wrk_nemo module') 330 llwrk_in_use = . FALSE.334 llwrk_in_use = .TRUE. 331 335 EXIT 332 336 ELSE IF( in_use_3dll(iptr) )THEN 333 llwrk_in_use = . FALSE.337 llwrk_in_use = .TRUE. 334 338 CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 335 339 END IF … … 362 366 !! 363 367 !! ** Purpose : Request a set of INTEGER workspaces to use. Returns 364 !! .TRUE. if all those requested are available, .FALSE. otherwise. 365 !! 366 !! ** Method : Sets internal flags to signal that requested workspaces are in use. 368 !! .TRUE. if any of those requested are already in use, 369 !! .FALSE. otherwise. 370 !! 371 !! ** Method : Sets internal flags to signal that requested workspaces 372 !! are in use. 367 373 !!---------------------------------------------------------------------- 368 374 INTEGER , INTENT(in) :: kdim ! Dimensionality of requested workspace(s) … … 374 380 !!---------------------------------------------------------------------- 375 381 376 iwrk_in_use = . TRUE.382 iwrk_in_use = .FALSE. 377 383 iptr = index1 378 384 iarg = 1 … … 383 389 IF( iptr > num_2d_wrkspaces ) THEN 384 390 CALL wrk_stop( 'wrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module' ) 385 iwrk_in_use = . FALSE.391 iwrk_in_use = .TRUE. 386 392 ELSEIF( in_use_2di(iptr) ) THEN 387 iwrk_in_use = . FALSE.393 iwrk_in_use = .TRUE. 388 394 CALL print_in_use_list( 2, INTEGER_TYPE, in_use_2di ) 389 395 END IF … … 439 445 !! 440 446 !! ** Purpose : Request a set of 2D, xz (jpi,jpk) workspaces to use. 441 !! Returns .TRUE. if all those requested are available, 442 !! .FALSE. otherwise. 443 !! 444 !! ** Method : Sets internal flags to signal that requested workspaces are in use. 447 !! Returns .TRUE. if any of those requested are already in 448 !! use, .FALSE. otherwise. 449 !! 450 !! ** Method : Sets internal flags to signal that requested workspaces 451 !! are in use. 445 452 !!---------------------------------------------------------------------- 446 453 INTEGER , INTENT(in) :: index1 ! Index of first requested workspace 447 INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 454 INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, & 455 index6, index7, index8, index9 448 456 ! Local variables 449 457 LOGICAL :: wrk_in_use_xz ! Return value … … 451 459 !!---------------------------------------------------------------------- 452 460 453 wrk_in_use_xz = . TRUE.461 wrk_in_use_xz = .FALSE. 454 462 iptr = index1 455 463 iarg = 1 … … 459 467 IF(iptr > num_xz_wrkspaces)THEN 460 468 CALL wrk_stop('wrk_in_use_xz - more 2D xz workspace arrays requested than defined in wrk_nemo module') 461 wrk_in_use_xz = . FALSE.469 wrk_in_use_xz = .TRUE. 462 470 EXIT 463 471 ELSE IF( in_use_xz(iptr) )THEN 464 wrk_in_use_xz = . FALSE.472 wrk_in_use_xz = .TRUE. 465 473 CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug 466 474 END IF … … 491 499 !! *** FUNCTION wrk_not_released *** 492 500 !! 493 !! ** Purpose : Flag that the specified workspace arrays are no-longer in use. 501 !! ** Purpose : Flag that the specified workspace arrays are no-longer 502 !! in use. 494 503 !!---------------------------------------------------------------------- 495 504 LOGICAL :: wrk_not_released ! Return value … … 503 512 !!---------------------------------------------------------------------- 504 513 505 wrk_not_released = . TRUE.514 wrk_not_released = .FALSE. 506 515 iptr = index1 507 516 iarg = 1 … … 512 521 IF( iptr > num_1d_wrkspaces ) THEN 513 522 CALL wrk_stop( 'wrk_not_released : attempt to release a non-existent 1D workspace array' ) 514 wrk_not_released = . FALSE.523 wrk_not_released = .TRUE. 515 524 ELSE 516 525 in_use_1d(iptr) = .FALSE. … … 520 529 IF( iptr > num_2d_wrkspaces ) THEN 521 530 CALL wrk_stop( 'wrk_not_released : attempt to release a non-existent 2D workspace array' ) 522 wrk_not_released = . FALSE.531 wrk_not_released = .TRUE. 523 532 ENDIF 524 533 in_use_2d(iptr) = .FALSE. … … 527 536 IF( iptr > num_3d_wrkspaces ) THEN 528 537 CALL wrk_stop('wrk_not_released : attempt to release a non-existent 3D workspace array') 529 wrk_not_released = . FALSE.538 wrk_not_released = .TRUE. 530 539 END IF 531 540 in_use_3d(iptr) = .FALSE. … … 533 542 ELSEIF( kdim == 4 ) THEN 534 543 IF(iptr > num_4d_wrkspaces)THEN 535 CALL wrk_stop('wrk_not_released - ERROR -attempt to release a non-existent 4D workspace array')536 wrk_not_released = . FALSE.544 CALL wrk_stop('wrk_not_released : attempt to release a non-existent 4D workspace array') 545 wrk_not_released = .TRUE. 537 546 END IF 538 547 in_use_4d(iptr) = .FALSE. … … 576 585 !!---------------------------------------------------------------------- 577 586 ! 578 llwrk_not_released = . TRUE.587 llwrk_not_released = .FALSE. 579 588 iptr = index1 580 589 iarg = 1 … … 586 595 IF( iptr > num_2d_lwrkspaces ) THEN 587 596 CALL wrk_stop( 'llwrk_not_released : attempt to release a non-existent 2D workspace array' ) 588 llwrk_not_released = . FALSE.597 llwrk_not_released = .TRUE. 589 598 EXIT 590 599 ENDIF … … 594 603 IF( iptr > num_3d_lwrkspaces ) THEN 595 604 CALL wrk_stop('llwrk_not_released : attempt to release a non-existent 3D workspace array') 596 llwrk_not_released = . FALSE.605 llwrk_not_released = .TRUE. 597 606 EXIT 598 607 ENDIF … … 635 644 !!---------------------------------------------------------------------- 636 645 ! 637 iwrk_not_released = . TRUE.646 iwrk_not_released = .FALSE. 638 647 iptr = index1 639 648 iarg = 1 … … 644 653 IF( iptr > num_2d_iwrkspaces ) THEN 645 654 CALL wrk_stop('iwrk_not_released : attempt to release a non-existant 2D workspace array') 646 iwrk_not_released = . FALSE.655 iwrk_not_released = .TRUE. 647 656 ENDIF 648 657 in_use_2di(iptr) = .FALSE. … … 703 712 !!---------------------------------------------------------------------- 704 713 ! 705 wrk_not_released_xz = . TRUE.714 wrk_not_released_xz = .FALSE. 706 715 iptr = index1 707 716 iarg = 1 … … 711 720 IF( iptr > num_xz_wrkspaces ) THEN 712 721 CALL wrk_stop('wrk_not_released_xz : attempt to release a non-existant 2D xz workspace array') 713 wrk_not_released_xz = . FALSE.722 wrk_not_released_xz = .TRUE. 714 723 EXIT 715 724 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.