New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2634 – NEMO

Changeset 2634


Ignore:
Timestamp:
2011-03-01T12:37:26+01:00 (12 years ago)
Author:
trackstand2
Message:

Updated wrk_in_use and wrk_not_released routines to switch when they return TRUE/FALSE

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r2633 r2634  
    200200      !! 
    201201      !! ** 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. 
    205207      !!---------------------------------------------------------------------- 
    206208      INTEGER, INTENT(in) ::   kdim        ! Dimensionality of requested workspace(s) 
     
    214216      !!---------------------------------------------------------------------- 
    215217 
    216       wrk_in_use = .TRUE. 
     218      wrk_in_use = .FALSE. 
    217219      iptr    = index1 
    218220      iarg    = 1 
     
    223225            IF( iptr > num_1d_wrkspaces ) THEN 
    224226               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. 
    226228               EXIT 
    227229            ELSEIF( in_use_1d(iptr) ) THEN 
    228                wrk_in_use = .FALSE. 
     230               wrk_in_use = .TRUE. 
    229231               CALL print_in_use_list(1, REAL_TYPE, in_use_1d) 
    230232            ENDIF 
     
    234236            IF( iptr > num_2d_wrkspaces ) THEN 
    235237               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. 
    237239               EXIT 
    238240            ELSEIF( in_use_2d(iptr) ) THEN 
    239                wrk_in_use = .FALSE. 
     241               wrk_in_use = .TRUE. 
    240242               CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 
    241243            ENDIF 
     
    245247            IF( iptr > num_3d_wrkspaces ) THEN 
    246248               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. 
    248250               EXIT 
    249251            ELSEIF( in_use_3d(iptr) ) THEN 
    250                wrk_in_use = .FALSE. 
     252               wrk_in_use = .TRUE. 
    251253               CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 
    252254            ENDIF 
     
    256258            IF(iptr > num_4d_wrkspaces)THEN 
    257259               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. 
    259261               EXIT 
    260262            ELSEIF( in_use_4d(iptr) ) THEN 
    261                wrk_in_use = .FALSE. 
     263               wrk_in_use = .TRUE. 
    262264               CALL print_in_use_list( 4, REAL_TYPE, in_use_4d ) 
    263265            ENDIF 
     
    295297      !! 
    296298      !! ** 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. 
    300304      !!---------------------------------------------------------------------- 
    301305      INTEGER, INTENT(in) ::   kdim     ! Dimensionality of requested workspace(s) 
     
    307311      !!---------------------------------------------------------------------- 
    308312      ! 
    309       llwrk_in_use = .TRUE. 
     313      llwrk_in_use = .FALSE. 
    310314      iptr      = index1 
    311315      iarg      = 1 
     
    316320            IF(iptr > num_2d_lwrkspaces)THEN 
    317321               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. 
    319323               EXIT 
    320324            ELSE IF( in_use_2dll(iptr) )THEN 
    321                llwrk_in_use = .FALSE. 
     325               llwrk_in_use = .TRUE. 
    322326               CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 
    323327            END IF 
     
    328332            IF(iptr > num_3d_lwrkspaces)THEN 
    329333               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. 
    331335               EXIT 
    332336            ELSE IF( in_use_3dll(iptr) )THEN 
    333                llwrk_in_use = .FALSE. 
     337               llwrk_in_use = .TRUE. 
    334338               CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 
    335339            END IF 
     
    362366      !! 
    363367      !! ** 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. 
    367373      !!---------------------------------------------------------------------- 
    368374      INTEGER          , INTENT(in) :: kdim        ! Dimensionality of requested workspace(s) 
     
    374380      !!---------------------------------------------------------------------- 
    375381 
    376       iwrk_in_use = .TRUE. 
     382      iwrk_in_use = .FALSE. 
    377383      iptr     = index1 
    378384      iarg     = 1 
     
    383389            IF( iptr > num_2d_wrkspaces ) THEN 
    384390               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. 
    386392            ELSEIF( in_use_2di(iptr) ) THEN 
    387                iwrk_in_use = .FALSE. 
     393               iwrk_in_use = .TRUE. 
    388394               CALL print_in_use_list( 2, INTEGER_TYPE, in_use_2di ) 
    389395            END IF 
     
    439445      !! 
    440446      !! ** 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. 
    445452      !!---------------------------------------------------------------------- 
    446453      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 
    448456      ! Local variables 
    449457      LOGICAL ::   wrk_in_use_xz   ! Return value 
     
    451459      !!---------------------------------------------------------------------- 
    452460 
    453       wrk_in_use_xz = .TRUE. 
     461      wrk_in_use_xz = .FALSE. 
    454462      iptr       = index1 
    455463      iarg       = 1 
     
    459467         IF(iptr > num_xz_wrkspaces)THEN 
    460468            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. 
    462470            EXIT 
    463471         ELSE IF( in_use_xz(iptr) )THEN 
    464             wrk_in_use_xz = .FALSE. 
     472            wrk_in_use_xz = .TRUE. 
    465473            CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug 
    466474         END IF 
     
    491499      !!                 ***  FUNCTION wrk_not_released  *** 
    492500      !! 
    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. 
    494503      !!---------------------------------------------------------------------- 
    495504      LOGICAL             :: wrk_not_released ! Return value 
     
    503512      !!---------------------------------------------------------------------- 
    504513 
    505       wrk_not_released = .TRUE. 
     514      wrk_not_released = .FALSE. 
    506515      iptr = index1 
    507516      iarg = 1 
     
    512521            IF( iptr > num_1d_wrkspaces ) THEN 
    513522               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. 
    515524            ELSE 
    516525               in_use_1d(iptr) = .FALSE. 
     
    520529            IF( iptr > num_2d_wrkspaces ) THEN 
    521530               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. 
    523532            ENDIF 
    524533            in_use_2d(iptr) = .FALSE. 
     
    527536            IF( iptr > num_3d_wrkspaces ) THEN 
    528537               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. 
    530539            END IF 
    531540            in_use_3d(iptr) = .FALSE. 
     
    533542          ELSEIF( kdim == 4 ) THEN 
    534543            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. 
    537546            END IF 
    538547            in_use_4d(iptr) = .FALSE. 
     
    576585      !!---------------------------------------------------------------------- 
    577586      ! 
    578       llwrk_not_released = .TRUE. 
     587      llwrk_not_released = .FALSE. 
    579588      iptr = index1 
    580589      iarg = 1 
     
    586595            IF( iptr > num_2d_lwrkspaces ) THEN 
    587596               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. 
    589598               EXIT 
    590599            ENDIF 
     
    594603            IF( iptr > num_3d_lwrkspaces ) THEN 
    595604               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. 
    597606               EXIT 
    598607            ENDIF 
     
    635644      !!---------------------------------------------------------------------- 
    636645      ! 
    637       iwrk_not_released = .TRUE. 
     646      iwrk_not_released = .FALSE. 
    638647      iptr         = index1 
    639648      iarg         = 1 
     
    644653            IF( iptr > num_2d_iwrkspaces ) THEN 
    645654               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. 
    647656            ENDIF 
    648657            in_use_2di(iptr) = .FALSE. 
     
    703712      !!---------------------------------------------------------------------- 
    704713      ! 
    705       wrk_not_released_xz = .TRUE. 
     714      wrk_not_released_xz = .FALSE. 
    706715      iptr           = index1 
    707716      iarg           = 1 
     
    711720         IF( iptr > num_xz_wrkspaces ) THEN 
    712721            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. 
    714723            EXIT 
    715724         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.