- Timestamp:
- 2011-02-28T18:23:23+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
r2632 r2633 13 13 14 14 PUBLIC wrk_alloc ! routine called in nemogcm module (nemo_init routine) 15 PUBLIC wrk_ use, llwrk_use, iwrk_use, wrk_use_xz16 PUBLIC wrk_ release, llwrk_release, iwrk_release, wrk_release_xz15 PUBLIC wrk_in_use, llwrk_in_use, iwrk_in_use, wrk_in_use_xz 16 PUBLIC wrk_not_released, llwrk_not_released, iwrk_not_released, wrk_not_released_xz 17 17 18 18 INTEGER, PARAMETER :: num_1d_wrkspaces = 27 ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) ) … … 190 190 191 191 192 FUNCTION wrk_ use( kdim, index1, index2, index3, index4, &193 & index5, index6, index7, index8, index9, &194 & index10, index11, index12, index13, index14, &195 & index15, index16, index17, index18, index19, &196 & index20, index21, index22, index23, index24, &197 & index25, index26, index27)198 !!---------------------------------------------------------------------- 199 !! *** FUNCTION wrk_ use ***192 FUNCTION wrk_in_use( kdim, index1, index2, index3, index4, & 193 & index5, index6, index7, index8, index9, & 194 & index10, index11, index12, index13, index14, & 195 & index15, index16, index17, index18, index19, & 196 & index20, index21, index22, index23, index24, & 197 & index25, index26, index27) 198 !!---------------------------------------------------------------------- 199 !! *** FUNCTION wrk_in_use *** 200 200 !! 201 201 !! ** Purpose : Request a set of KIND(wp) workspaces to use. Returns … … 210 210 INTEGER, OPTIONAL, INTENT(in) :: index21, index22, index23, index24, index25, index26, index27 211 211 ! 212 LOGICAL :: wrk_ use ! Return value212 LOGICAL :: wrk_in_use ! Return value 213 213 INTEGER :: iarg, iptr ! local integer 214 214 !!---------------------------------------------------------------------- 215 215 216 wrk_ use = .TRUE.216 wrk_in_use = .TRUE. 217 217 iptr = index1 218 218 iarg = 1 219 219 220 DO WHILE( wrk_ use .AND. iarg <= max_num_wrkspaces )220 DO WHILE( wrk_in_use .AND. iarg <= max_num_wrkspaces ) 221 221 ! 222 222 IF( kdim == 1 ) THEN 223 223 IF( iptr > num_1d_wrkspaces ) THEN 224 CALL wrk_stop('wrk_ use - more 1D workspace arrays requested than defined in wrk_nemo module')225 wrk_ use = .FALSE.224 CALL wrk_stop('wrk_in_use - more 1D workspace arrays requested than defined in wrk_nemo module') 225 wrk_in_use = .FALSE. 226 226 EXIT 227 227 ELSEIF( in_use_1d(iptr) ) THEN 228 wrk_ use = .FALSE.228 wrk_in_use = .FALSE. 229 229 CALL print_in_use_list(1, REAL_TYPE, in_use_1d) 230 230 ENDIF … … 233 233 ELSEIF( kdim == 2 ) THEN 234 234 IF( iptr > num_2d_wrkspaces ) THEN 235 CALL wrk_stop('wrk_ use - more 2D workspace arrays requested than defined in wrk_nemo module')236 wrk_ use = .FALSE.235 CALL wrk_stop('wrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module') 236 wrk_in_use = .FALSE. 237 237 EXIT 238 238 ELSEIF( in_use_2d(iptr) ) THEN 239 wrk_ use = .FALSE.239 wrk_in_use = .FALSE. 240 240 CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 241 241 ENDIF … … 244 244 ELSEIF( kdim == 3 ) THEN 245 245 IF( iptr > num_3d_wrkspaces ) THEN 246 CALL wrk_stop( 'wrk_ use - more 3D workspace arrays requested than defined in wrk_nemo module' )247 wrk_ use = .FALSE.246 CALL wrk_stop( 'wrk_in_use - more 3D workspace arrays requested than defined in wrk_nemo module' ) 247 wrk_in_use = .FALSE. 248 248 EXIT 249 249 ELSEIF( in_use_3d(iptr) ) THEN 250 wrk_ use = .FALSE.250 wrk_in_use = .FALSE. 251 251 CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 252 252 ENDIF … … 255 255 ELSEIF( kdim == 4 ) THEN 256 256 IF(iptr > num_4d_wrkspaces)THEN 257 CALL wrk_stop( 'wrk_ use - more 4D workspace arrays requested than defined in wrk_nemo module' )258 wrk_ use = .FALSE.257 CALL wrk_stop( 'wrk_in_use - more 4D workspace arrays requested than defined in wrk_nemo module' ) 258 wrk_in_use = .FALSE. 259 259 EXIT 260 260 ELSEIF( in_use_4d(iptr) ) THEN 261 wrk_ use = .FALSE.261 wrk_in_use = .FALSE. 262 262 CALL print_in_use_list( 4, REAL_TYPE, in_use_4d ) 263 263 ENDIF … … 266 266 ! 267 267 ELSE 268 IF(llwp) WRITE(kumout,*) 'wrk_ use: unsupported value of kdim = ',kdim269 CALL wrk_stop( 'wrk_ use: unrecognised value for number of dimensions' )268 IF(llwp) WRITE(kumout,*) 'wrk_in_use: unsupported value of kdim = ',kdim 269 CALL wrk_stop( 'wrk_in_use: unrecognised value for number of dimensions' ) 270 270 END IF 271 271 … … 280 280 EXIT 281 281 ELSEIF( iarg == -99 ) THEN 282 CALL wrk_stop( 'wrk_ use : caught unexpected argument count - BUG' )282 CALL wrk_stop( 'wrk_in_use : caught unexpected argument count - BUG' ) 283 283 EXIT 284 284 END IF … … 286 286 END DO ! end of DO WHILE() 287 287 ! 288 END FUNCTION wrk_ use289 290 291 FUNCTION llwrk_ use( kdim, index1, index2, index3, index4, &292 & index5, index6, index7, index8, index9)293 !!---------------------------------------------------------------------- 294 !! *** FUNCTION llwrk_ use ***288 END FUNCTION wrk_in_use 289 290 291 FUNCTION llwrk_in_use( kdim, index1, index2, index3, index4, & 292 & index5, index6, index7, index8, index9) 293 !!---------------------------------------------------------------------- 294 !! *** FUNCTION llwrk_in_use *** 295 295 !! 296 296 !! ** Purpose : Request a set of LOGICAL workspaces to use. Returns … … 303 303 INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 304 304 ! 305 LOGICAL :: llwrk_ use! Return value305 LOGICAL :: llwrk_in_use ! Return value 306 306 INTEGER :: iarg, iptr ! local integers 307 307 !!---------------------------------------------------------------------- 308 308 ! 309 llwrk_ use = .TRUE.309 llwrk_in_use = .TRUE. 310 310 iptr = index1 311 311 iarg = 1 312 312 ! 313 DO WHILE( llwrk_ use .AND. iarg <= max_num_wrkspaces )313 DO WHILE( llwrk_in_use .AND. iarg <= max_num_wrkspaces ) 314 314 ! 315 315 IF( kdim == 2 ) THEN 316 316 IF(iptr > num_2d_lwrkspaces)THEN 317 CALL wrk_stop('llwrk_ use - more 2D workspace arrays requested than defined in wrk_nemo module')318 llwrk_ use = .FALSE.317 CALL wrk_stop('llwrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module') 318 llwrk_in_use = .FALSE. 319 319 EXIT 320 320 ELSE IF( in_use_2dll(iptr) )THEN 321 llwrk_ use = .FALSE.321 llwrk_in_use = .FALSE. 322 322 CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 323 323 END IF … … 327 327 ! 328 328 IF(iptr > num_3d_lwrkspaces)THEN 329 CALL wrk_stop('llwrk_ use - more 3D workspace arrays requested than defined in wrk_nemo module')330 llwrk_ use = .FALSE.329 CALL wrk_stop('llwrk_in_use - more 3D workspace arrays requested than defined in wrk_nemo module') 330 llwrk_in_use = .FALSE. 331 331 EXIT 332 332 ELSE IF( in_use_3dll(iptr) )THEN 333 llwrk_ use = .FALSE.333 llwrk_in_use = .FALSE. 334 334 CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 335 335 END IF … … 337 337 in_use_3dll(iptr) = .TRUE. 338 338 ELSE 339 IF(llwp) WRITE(kumout,*) 'llwrk_ use: unsupported value of kdim = ',kdim340 CALL wrk_stop('llwrk_ use: unrecognised value for number of dimensions')339 IF(llwp) WRITE(kumout,*) 'llwrk_in_use: unsupported value of kdim = ',kdim 340 CALL wrk_stop('llwrk_in_use: unrecognised value for number of dimensions') 341 341 END IF 342 342 … … 347 347 EXIT 348 348 ELSEIF( iarg == -99 ) THEN 349 CALL wrk_stop( 'llwrk_ use - ERROR, caught unexpected argument count - BUG' )350 EXIT 351 ENDIF 352 ! 353 END DO ! while(llwrk_ use .AND. iarg <= max_num_wrkspaces)354 ! 355 END FUNCTION llwrk_ use356 357 358 FUNCTION iwrk_ use( kdim, index1, index2, index3, index4, &359 & index5, index6, index7 )360 !!---------------------------------------------------------------------- 361 !! *** FUNCTION iwrk_ use ***349 CALL wrk_stop( 'llwrk_in_use - ERROR, caught unexpected argument count - BUG' ) 350 EXIT 351 ENDIF 352 ! 353 END DO ! while(llwrk_in_use .AND. iarg <= max_num_wrkspaces) 354 ! 355 END FUNCTION llwrk_in_use 356 357 358 FUNCTION iwrk_in_use( kdim, index1, index2, index3, index4, & 359 & index5, index6, index7 ) 360 !!---------------------------------------------------------------------- 361 !! *** FUNCTION iwrk_in_use *** 362 362 !! 363 363 !! ** Purpose : Request a set of INTEGER workspaces to use. Returns … … 370 370 INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7 371 371 ! 372 LOGICAL :: iwrk_ use ! Return value372 LOGICAL :: iwrk_in_use ! Return value 373 373 INTEGER :: iarg, iptr 374 374 !!---------------------------------------------------------------------- 375 375 376 iwrk_ use = .TRUE.376 iwrk_in_use = .TRUE. 377 377 iptr = index1 378 378 iarg = 1 379 379 380 DO WHILE( iwrk_ use .AND. iarg <= max_num_wrkspaces )380 DO WHILE( iwrk_in_use .AND. iarg <= max_num_wrkspaces ) 381 381 ! 382 382 IF( kdim == 2 ) THEN 383 383 IF( iptr > num_2d_wrkspaces ) THEN 384 CALL wrk_stop( 'wrk_ use - more 2D workspace arrays requested than defined in wrk_nemo module' )385 iwrk_ use = .FALSE.384 CALL wrk_stop( 'wrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module' ) 385 iwrk_in_use = .FALSE. 386 386 ELSEIF( in_use_2di(iptr) ) THEN 387 iwrk_ use = .FALSE.387 iwrk_in_use = .FALSE. 388 388 CALL print_in_use_list( 2, INTEGER_TYPE, in_use_2di ) 389 389 END IF … … 391 391 ! 392 392 ELSE 393 IF(llwp) WRITE(kumout,*) 'iwrk_ use: unsupported value of kdim = ',kdim394 CALL wrk_stop('iwrk_ use: unsupported value for number of dimensions')393 IF(llwp) WRITE(kumout,*) 'iwrk_in_use: unsupported value of kdim = ',kdim 394 CALL wrk_stop('iwrk_in_use: unsupported value for number of dimensions') 395 395 END IF 396 396 … … 424 424 EXIT 425 425 CASE DEFAULT 426 CALL wrk_stop( 'iwrk_ use : caught unexpected argument count - BUG' )426 CALL wrk_stop( 'iwrk_in_use : caught unexpected argument count - BUG' ) 427 427 EXIT 428 428 END SELECT … … 430 430 END DO ! end of DO WHILE() 431 431 ! 432 END FUNCTION iwrk_ use433 434 435 FUNCTION wrk_ use_xz( index1, index2, index3, index4, &436 & index5, index6, index7, index8, index9 )437 !!---------------------------------------------------------------------- 438 !! *** FUNCTION wrk_ use_xz ***432 END FUNCTION iwrk_in_use 433 434 435 FUNCTION wrk_in_use_xz( index1, index2, index3, index4, & 436 & index5, index6, index7, index8, index9 ) 437 !!---------------------------------------------------------------------- 438 !! *** FUNCTION wrk_in_use_xz *** 439 439 !! 440 440 !! ** Purpose : Request a set of 2D, xz (jpi,jpk) workspaces to use. … … 447 447 INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 448 448 ! Local variables 449 LOGICAL :: wrk_ use_xz ! Return value450 INTEGER :: iarg, iptr ! local integer451 !!---------------------------------------------------------------------- 452 453 wrk_ use_xz = .TRUE.449 LOGICAL :: wrk_in_use_xz ! Return value 450 INTEGER :: iarg, iptr ! local integer 451 !!---------------------------------------------------------------------- 452 453 wrk_in_use_xz = .TRUE. 454 454 iptr = index1 455 455 iarg = 1 456 456 457 DO WHILE( wrk_ use_xz .AND. iarg <= max_num_wrkspaces )457 DO WHILE( wrk_in_use_xz .AND. iarg <= max_num_wrkspaces ) 458 458 ! 459 459 IF(iptr > num_xz_wrkspaces)THEN 460 CALL wrk_stop('wrk_ use_xz - more 2D xz workspace arrays requested than defined in wrk_nemo module')461 wrk_ use_xz = .FALSE.460 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. 462 462 EXIT 463 463 ELSE IF( in_use_xz(iptr) )THEN 464 wrk_ use_xz = .FALSE.464 wrk_in_use_xz = .FALSE. 465 465 CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug 466 466 END IF … … 474 474 EXIT 475 475 ELSEIF( iarg == -99 ) THEN 476 CALL wrk_stop( 'wrk_ use_xz : caught unexpected argument count - BUG' ) ; EXIT476 CALL wrk_stop( 'wrk_in_use_xz : caught unexpected argument count - BUG' ) ; EXIT 477 477 END IF 478 478 ! 479 END DO ! while(wrk_ use_xz .AND. iarg <= max_num_wrkspaces)480 ! 481 END FUNCTION wrk_ use_xz482 483 484 FUNCTION wrk_ release( kdim, index1, index2, index3, index4, &485 & index5, index6, index7, index8, index9, &486 & index10, index11, index12, index13, index14, &487 & index15, index16, index17, index18, index19, &488 & index20, index21, index22, index23, index24, &489 & index25, index26, index27)490 !!---------------------------------------------------------------------- 491 !! *** FUNCTION wrk_ release***479 END DO ! while(wrk_in_use_xz .AND. iarg <= max_num_wrkspaces) 480 ! 481 END FUNCTION wrk_in_use_xz 482 483 484 FUNCTION wrk_not_released( kdim, index1, index2, index3, index4, & 485 & index5, index6, index7, index8, index9, & 486 & index10, index11, index12, index13, index14, & 487 & index15, index16, index17, index18, index19, & 488 & index20, index21, index22, index23, index24, & 489 & index25, index26, index27) 490 !!---------------------------------------------------------------------- 491 !! *** FUNCTION wrk_not_released *** 492 492 !! 493 493 !! ** Purpose : Flag that the specified workspace arrays are no-longer in use. 494 494 !!---------------------------------------------------------------------- 495 LOGICAL :: wrk_ release! Return value495 LOGICAL :: wrk_not_released ! Return value 496 496 INTEGER, INTENT(in) :: kdim ! Dimensionality of workspace(s) 497 497 INTEGER, INTENT(in) :: index1 ! Index of 1st workspace to release … … 503 503 !!---------------------------------------------------------------------- 504 504 505 wrk_ release= .TRUE.505 wrk_not_released = .TRUE. 506 506 iptr = index1 507 507 iarg = 1 … … 511 511 IF( kdim == 1 ) THEN 512 512 IF( iptr > num_1d_wrkspaces ) THEN 513 CALL wrk_stop( 'wrk_ release: attempt to release a non-existent 1D workspace array' )514 wrk_ release= .FALSE.513 CALL wrk_stop( 'wrk_not_released : attempt to release a non-existent 1D workspace array' ) 514 wrk_not_released = .FALSE. 515 515 ELSE 516 516 in_use_1d(iptr) = .FALSE. … … 519 519 ELSE IF(kdim == 2)THEN 520 520 IF( iptr > num_2d_wrkspaces ) THEN 521 CALL wrk_stop( 'wrk_ release: attempt to release a non-existent 2D workspace array' )522 wrk_ release= .FALSE.521 CALL wrk_stop( 'wrk_not_released : attempt to release a non-existent 2D workspace array' ) 522 wrk_not_released = .FALSE. 523 523 ENDIF 524 524 in_use_2d(iptr) = .FALSE. … … 526 526 ELSEIF( kdim == 3 ) THEN 527 527 IF( iptr > num_3d_wrkspaces ) THEN 528 CALL wrk_stop('wrk_ release: attempt to release a non-existent 3D workspace array')529 wrk_ release= .FALSE.528 CALL wrk_stop('wrk_not_released : attempt to release a non-existent 3D workspace array') 529 wrk_not_released = .FALSE. 530 530 END IF 531 531 in_use_3d(iptr) = .FALSE. … … 533 533 ELSEIF( kdim == 4 ) THEN 534 534 IF(iptr > num_4d_wrkspaces)THEN 535 CALL wrk_stop('wrk_ release- ERROR - attempt to release a non-existent 4D workspace array')536 wrk_ release= .FALSE.535 CALL wrk_stop('wrk_not_released - ERROR - attempt to release a non-existent 4D workspace array') 536 wrk_not_released = .FALSE. 537 537 END IF 538 538 in_use_4d(iptr) = .FALSE. 539 539 ! 540 540 ELSE 541 IF(llwp) WRITE(kumout,*) 'wrk_ release: unsupported value of kdim = ',kdim542 CALL wrk_stop('wrk_ release: unrecognised value for number of dimensions')541 IF(llwp) WRITE(kumout,*) 'wrk_not_released: unsupported value of kdim = ',kdim 542 CALL wrk_stop('wrk_not_released: unrecognised value for number of dimensions') 543 543 ENDIF 544 544 … … 555 555 EXIT 556 556 ELSEIF( iarg == -99 ) THEN 557 CALL wrk_stop('wrk_ release- caught unexpected argument count - BUG') ; EXIT557 CALL wrk_stop('wrk_not_released - caught unexpected argument count - BUG') ; EXIT 558 558 END IF 559 559 ! 560 560 END DO ! end of DO WHILE() 561 561 ! 562 END FUNCTION wrk_ release563 564 565 FUNCTION llwrk_ release( kdim, index1, index2, index3, index4, index5, &566 & index6, index7, index8, index9 )567 !!---------------------------------------------------------------------- 568 !! *** FUNCTION wrk_ release***562 END FUNCTION wrk_not_released 563 564 565 FUNCTION llwrk_not_released( kdim, index1, index2, index3, index4, index5, & 566 & index6, index7, index8, index9 ) 567 !!---------------------------------------------------------------------- 568 !! *** FUNCTION wrk_not_released *** 569 569 !!---------------------------------------------------------------------- 570 570 INTEGER , INTENT(in) :: kdim ! Dimensionality of workspace(s) … … 572 572 INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 573 573 ! 574 LOGICAL :: llwrk_ release! Return value575 INTEGER :: iarg, iptr ! local integer576 !!---------------------------------------------------------------------- 577 ! 578 llwrk_ release= .TRUE.574 LOGICAL :: llwrk_not_released ! Return value 575 INTEGER :: iarg, iptr ! local integer 576 !!---------------------------------------------------------------------- 577 ! 578 llwrk_not_released = .TRUE. 579 579 iptr = index1 580 580 iarg = 1 … … 585 585 ! 586 586 IF( iptr > num_2d_lwrkspaces ) THEN 587 CALL wrk_stop( 'llwrk_ release: attempt to release a non-existent 2D workspace array' )588 llwrk_ release= .FALSE.587 CALL wrk_stop( 'llwrk_not_released : attempt to release a non-existent 2D workspace array' ) 588 llwrk_not_released = .FALSE. 589 589 EXIT 590 590 ENDIF … … 593 593 ELSEIF( kdim == 3 ) THEN 594 594 IF( iptr > num_3d_lwrkspaces ) THEN 595 CALL wrk_stop('llwrk_ release: attempt to release a non-existent 3D workspace array')596 llwrk_ release= .FALSE.595 CALL wrk_stop('llwrk_not_released : attempt to release a non-existent 3D workspace array') 596 llwrk_not_released = .FALSE. 597 597 EXIT 598 598 ENDIF … … 600 600 ! 601 601 ELSE 602 IF(llwp) WRITE(kumout,*) 'llwrk_ release: unsupported value of kdim = ', kdim603 CALL wrk_stop( 'llwrk_ release: unrecognised value for number of dimensions' )602 IF(llwp) WRITE(kumout,*) 'llwrk_not_released: unsupported value of kdim = ', kdim 603 CALL wrk_stop( 'llwrk_not_released : unrecognised value for number of dimensions' ) 604 604 END IF 605 605 ! … … 611 611 EXIT 612 612 ELSEIF( iarg == -99 ) THEN 613 CALL wrk_stop( 'llwrk_ release: caught unexpected argument count - BUG' ) ; EXIT613 CALL wrk_stop( 'llwrk_not_released : caught unexpected argument count - BUG' ) ; EXIT 614 614 ENDIF 615 615 ! 616 616 END DO ! while (iarg <= max_num_wrkspaces) 617 617 ! 618 END FUNCTION llwrk_ release619 620 621 FUNCTION iwrk_ release( kdim, index1, index2, index3, index4, &622 & index5, index6, index7 )623 !!---------------------------------------------------------------------- 624 !! *** FUNCTION iwrk_ release***618 END FUNCTION llwrk_not_released 619 620 621 FUNCTION iwrk_not_released( kdim, index1, index2, index3, index4, & 622 & index5, index6, index7 ) 623 !!---------------------------------------------------------------------- 624 !! *** FUNCTION iwrk_not_released *** 625 625 !! 626 626 !! ** Purpose : Flag that the specified INTEGER workspace arrays are … … 631 631 INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7 632 632 ! 633 LOGICAL :: iwrk_ release! Return value634 INTEGER :: iarg, iptr ! local integer635 !!---------------------------------------------------------------------- 636 ! 637 iwrk_ release= .TRUE.633 LOGICAL :: iwrk_not_released ! Return value 634 INTEGER :: iarg, iptr ! local integer 635 !!---------------------------------------------------------------------- 636 ! 637 iwrk_not_released = .TRUE. 638 638 iptr = index1 639 639 iarg = 1 … … 643 643 IF( kdim == 2 ) THEN 644 644 IF( iptr > num_2d_iwrkspaces ) THEN 645 CALL wrk_stop('iwrk_ release: attempt to release a non-existant 2D workspace array')646 iwrk_ release= .FALSE.645 CALL wrk_stop('iwrk_not_released : attempt to release a non-existant 2D workspace array') 646 iwrk_not_released = .FALSE. 647 647 ENDIF 648 648 in_use_2di(iptr) = .FALSE. 649 649 ELSE 650 IF(llwp) WRITE(kumout,*) 'iwrk_ release: unsupported value of kdim = ',kdim651 CALL wrk_stop('iwrk_ release: unsupported value for number of dimensions')650 IF(llwp) WRITE(kumout,*) 'iwrk_not_released: unsupported value of kdim = ',kdim 651 CALL wrk_stop('iwrk_not_released: unsupported value for number of dimensions') 652 652 ENDIF 653 653 ! … … 681 681 EXIT 682 682 CASE DEFAULT 683 CALL wrk_stop( 'iwrk_ release: caught unexpected argument count - BUG' )683 CALL wrk_stop( 'iwrk_not_released : caught unexpected argument count - BUG' ) 684 684 EXIT 685 685 END SELECT … … 687 687 END DO ! end of DO WHILE() 688 688 ! 689 END FUNCTION iwrk_ release690 691 692 FUNCTION wrk_ release_xz( index1, index2, index3, index4, index5, &693 & index6, index7, index8, index9 )694 !!---------------------------------------------------------------------- 695 !! *** FUNCTION wrk_ release_xz ***689 END FUNCTION iwrk_not_released 690 691 692 FUNCTION wrk_not_released_xz( index1, index2, index3, index4, index5, & 693 & index6, index7, index8, index9 ) 694 !!---------------------------------------------------------------------- 695 !! *** FUNCTION wrk_not_released_xz *** 696 696 !! 697 697 !!---------------------------------------------------------------------- … … 699 699 INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 700 700 ! 701 LOGICAL :: wrk_ release_xz ! Return value702 INTEGER :: iarg, iptr ! local integer703 !!---------------------------------------------------------------------- 704 ! 705 wrk_ release_xz = .TRUE.701 LOGICAL :: wrk_not_released_xz ! Return value 702 INTEGER :: iarg, iptr ! local integer 703 !!---------------------------------------------------------------------- 704 ! 705 wrk_not_released_xz = .TRUE. 706 706 iptr = index1 707 707 iarg = 1 … … 710 710 ! 711 711 IF( iptr > num_xz_wrkspaces ) THEN 712 CALL wrk_stop('wrk_ release_xz : attempt to release a non-existant 2D xz workspace array')713 wrk_ release_xz = .FALSE.712 CALL wrk_stop('wrk_not_released_xz : attempt to release a non-existant 2D xz workspace array') 713 wrk_not_released_xz = .FALSE. 714 714 EXIT 715 715 ENDIF … … 723 723 EXIT 724 724 ELSEIF( iarg == -99 ) THEN 725 CALL wrk_stop('wrk_ release_xz : caught unexpected argument count - BUG')725 CALL wrk_stop('wrk_not_released_xz : caught unexpected argument count - BUG') 726 726 EXIT 727 727 END IF … … 729 729 END DO ! while (iarg <= max_num_wrkspaces) 730 730 ! 731 END FUNCTION wrk_ release_xz731 END FUNCTION wrk_not_released_xz 732 732 733 733
Note: See TracChangeset
for help on using the changeset viewer.
