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 2661 – NEMO

Changeset 2661


Ignore:
Timestamp:
2011-03-05T10:13:53+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; add key_no_workspace_check to by-pass the check in production runs

File:
1 edited

Legend:

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

    r2635 r2661  
    44   !! NEMO work space:  define and allocate work-space arrays used in  
    55   !! all components of NEMO 
    6    !!===================================================================== 
     6   !!====================================================================== 
    77   !! History :  4.0  !  2011-01  (A Porter)  Original code 
    88   !!---------------------------------------------------------------------- 
     9 
     10   !!---------------------------------------------------------------------- 
     11   !!   wrk_alloc         : define in memory the work space arrays 
     12   !!   wrk_in_use, llwrk_in_use, iwrk_in_use, wrk_in_use_xz : 
     13   !!                       check whether the requested workspace is already used or not 
     14   !!   wrk_not_released, llwrk_not_released, iwrk_not_released, wrk_not_released_xz : release the workspace 
     15   !!   print_in_use_list : print out the table holding which workspace arrays are currently marked as in use 
     16   !!   get_next_arg      : get the next argument 
     17   !!   wrk_stop          : act as local alternative to ctl_stop 
     18   !!---------------------------------------------------------------------- 
    919   USE par_oce        ! ocean parameters 
    1020 
     
    1222   PRIVATE 
    1323 
    14    PUBLIC wrk_alloc   ! routine called in nemogcm module (nemo_init routine) 
    15    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 
     24   PUBLIC   wrk_alloc   ! function called in nemogcm module (nemo_init routine) 
     25   PUBLIC   wrk_in_use, llwrk_in_use, iwrk_in_use, wrk_in_use_xz                           ! function called almost everywhere 
     26   PUBLIC   wrk_not_released, llwrk_not_released, iwrk_not_released, wrk_not_released_xz   ! function called almost everywhere 
    1727 
    1828   INTEGER, PARAMETER :: num_1d_wrkspaces  = 27   ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) ) 
     
    3949   ! num_Xd_wrkspaces parameter above and to allocate them in wrk_alloc() 
    4050 
    41    !                                                                    !!**  1D, REAL(wp) workspaces  ** 
     51   !                                                               !!**  1D, REAL(wp) workspaces  ** 
    4252   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_1 , wrk_1d_2 , wrk_1d_3 , wrk_1d_4 , wrk_1d_5 
    4353   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_6 , wrk_1d_7 , wrk_1d_8 , wrk_1d_9 , wrk_1d_10 
     
    4757   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)      , TARGET, PUBLIC ::   wrk_1d_26, wrk_1d_27 
    4858 
    49    !                                                                    !!**  2D, x-y, REAL(wp) workspaces  ** 
     59   !                                                               !!**  2D, x-y, REAL(wp) workspaces  ** 
    5060   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_1 , wrk_2d_2 , wrk_2d_3 , wrk_2d_4 , wrk_2d_5 
    5161   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_6 , wrk_2d_7 , wrk_2d_8 , wrk_2d_9 , wrk_2d_10 
     
    5666   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    , TARGET, PUBLIC ::   wrk_2d_31, wrk_2d_32, wrk_2d_33, wrk_2d_34, wrk_2d_35 
    5767 
    58    !                                                                    !!**  2D, x-z, REAL(wp) workspaces  ** 
     68   !                                                               !!**  2D, x-z, REAL(wp) workspaces  ** 
    5969   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   wrk_xz_1, wrk_xz_2, wrk_xz_3, wrk_xz_4  
    6070    
    61    !                                                                    !!**  3D, x-y-z, REAL(wp) workspaces  ** 
     71   !                                                               !!**  3D, x-y-z, REAL(wp) workspaces  ** 
    6272   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_1 , wrk_3d_2 , wrk_3d_3 , wrk_3d_4 , wrk_3d_5 
    6373   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_6 , wrk_3d_7 , wrk_3d_8 , wrk_3d_9 , wrk_3d_10 
    6474   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_11, wrk_3d_12, wrk_3d_13, wrk_3d_14, wrk_3d_15 
    6575 
    66    !                                                                    !!**  4D, x-y-z-tra, REAL(wp) workspaces  ** 
     76   !                                                               !!**  4D, x-y-z-tra, REAL(wp) workspaces  ** 
    6777   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), TARGET, PUBLIC ::   wrk_4d_1, wrk_4d_2, wrk_4d_3, wrk_4d_4  
    6878 
    69  
    70    LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   llwrk_2d_1, llwrk_2d_2, llwrk_2d_3 !: 2D logical workspace 
     79   !                                                               !!**  2D-3D logical workspace  ** 
     80   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   llwrk_2d_1, llwrk_2d_2, llwrk_2d_3  
    7181   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   llwrk_3d_1 !: 3D logical workspace 
    72    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   iwrk_2d_1 !: 2D integer workspace 
    73  
    74    LOGICAL, DIMENSION(num_1d_wrkspaces)  :: in_use_1d     !: Flags to track which 1D workspace arrays are in use   
    75    LOGICAL, DIMENSION(num_2d_wrkspaces)  :: in_use_2d     !: Flags to track which 2D workspace arrays are in use 
    76    LOGICAL, DIMENSION(num_3d_wrkspaces)  :: in_use_3d     !: Flags to track which 3D workspace arrays are in use 
    77    LOGICAL, DIMENSION(num_4d_wrkspaces)  :: in_use_4d     !: Flags to track which 4D workspace arrays are in use 
    78    LOGICAL, DIMENSION(num_xz_wrkspaces)  :: in_use_xz     !: Flags to track which 2D, xz workspace arrays are in use 
    79    LOGICAL, DIMENSION(num_2d_lwrkspaces) :: in_use_2dll   !: Flags to track which 2D, logical workspace arrays are in use 
    80    LOGICAL, DIMENSION(num_3d_lwrkspaces) :: in_use_3dll   !: Flags to track which 3D, logical workspace arrays are in use 
    81    LOGICAL, DIMENSION(num_2d_iwrkspaces) :: in_use_2di    !: Flags to track which 2D, integer workspace arrays are in use 
     82    
     83   !                                                               !!** 2D integer workspace  ** 
     84   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   iwrk_2d_1 
     85 
     86   LOGICAL, DIMENSION(num_1d_wrkspaces)  ::   in_use_1d     !: Flags to track which 1D workspace arrays are in use   
     87   LOGICAL, DIMENSION(num_2d_wrkspaces)  ::   in_use_2d     !: Flags to track which 2D workspace arrays are in use 
     88   LOGICAL, DIMENSION(num_3d_wrkspaces)  ::   in_use_3d     !: Flags to track which 3D workspace arrays are in use 
     89   LOGICAL, DIMENSION(num_4d_wrkspaces)  ::   in_use_4d     !: Flags to track which 4D workspace arrays are in use 
     90   LOGICAL, DIMENSION(num_xz_wrkspaces)  ::   in_use_xz     !: Flags to track which 2D, xz workspace arrays are in use 
     91   LOGICAL, DIMENSION(num_2d_lwrkspaces) ::   in_use_2dll   !: Flags to track which 2D, logical workspace arrays are in use 
     92   LOGICAL, DIMENSION(num_3d_lwrkspaces) ::   in_use_3dll   !: Flags to track which 3D, logical workspace arrays are in use 
     93   LOGICAL, DIMENSION(num_2d_iwrkspaces) ::   in_use_2di    !: Flags to track which 2D, integer workspace arrays are in use 
    8294 
    8395   ! Labels for specifying workspace type in call to print_in_use_list() 
    84    INTEGER, PARAMETER :: INTEGER_TYPE = 0 
    85    INTEGER, PARAMETER :: LOGICAL_TYPE = 1 
    86    INTEGER, PARAMETER :: REAL_TYPE    = 2 
    87  
    88    INTEGER :: kumout  ! Local copy of numout unit number for error/warning 
    89                       ! messages 
     96   INTEGER, PARAMETER ::   INTEGER_TYPE = 0 
     97   INTEGER, PARAMETER ::   LOGICAL_TYPE = 1 
     98   INTEGER, PARAMETER ::   REAL_TYPE    = 2 
     99 
     100   INTEGER :: kumout  ! Local copy of numout unit number for error/warning messages 
    90101   LOGICAL :: llwp    ! Local copy of lwp - whether we are master PE or not 
    91102 
     
    107118      !!                work space arrays 
    108119      !!---------------------------------------------------------------------- 
    109       INTEGER, INTENT(in) :: iunit         ! Unit no. to use for error/warning 
    110                                            ! messages in this module 
    111       LOGICAL, INTENT(in) :: lwp_arg       ! Value of lwp 
    112       INTEGER             :: wrk_alloc     ! Return value 
    113       ! 
    114       INTEGER :: extent_1d     ! Extent to allocate for 1D arrays 
    115       INTEGER :: ierror(8)     ! local integer 
     120      INTEGER, INTENT(in) ::   iunit         ! Unit no. to use for error/warning messages in this module 
     121      LOGICAL, INTENT(in) ::   lwp_arg       ! Value of lwp 
     122      ! 
     123      INTEGER ::   wrk_alloc   ! Return value 
     124      INTEGER ::   extent_1d   ! Extent to allocate for 1D arrays 
     125      INTEGER ::   ierror(8)   ! local integer 
    116126      !!---------------------------------------------------------------------- 
    117127      ! 
     
    148158         &      wrk_1d_21(extent_1d) , wrk_1d_22(extent_1d) , wrk_1d_23(extent_1d) , wrk_1d_24(extent_1d) ,     & 
    149159         &      wrk_1d_25(extent_1d) , wrk_1d_26(extent_1d) , wrk_1d_27(extent_1d)                        , STAT=ierror(1) ) 
    150       ! 
     160         ! 
    151161      ALLOCATE( wrk_2d_1 (jpi,jpj) , wrk_2d_2 (jpi,jpj) , wrk_2d_3 (jpi,jpj) , wrk_2d_4 (jpi,jpj) ,     &  
    152162         &      wrk_2d_5 (jpi,jpj) , wrk_2d_6 (jpi,jpj) , wrk_2d_7 (jpi,jpj) , wrk_2d_8 (jpi,jpj) ,     & 
     
    160170         &      wrk_2d_31(jpi,jpj) , wrk_2d_32(jpi,jpj) , wrk_2d_33(jpi,jpj) , wrk_2d_34(jpi,jpj) ,     & 
    161171         &      wrk_2d_35(jpi,jpj)                                                                , STAT=ierror(2) ) 
    162       ! 
     172         ! 
    163173      ALLOCATE( wrk_3d_1 (jpi,jpj,jpk) , wrk_3d_2 (jpi,jpj,jpk) , wrk_3d_3 (jpi,jpj,jpk) , wrk_3d_4 (jpi,jpj,jpk) ,     & 
    164174         &      wrk_3d_5 (jpi,jpj,jpk) , wrk_3d_6 (jpi,jpj,jpk) , wrk_3d_7 (jpi,jpj,jpk) , wrk_3d_8 (jpi,jpj,jpk) ,     & 
     
    166176         &      wrk_3d_11(jpi,jpj,jpk) , wrk_3d_12(jpi,jpj,jpk) , wrk_3d_13(jpi,jpj,jpk) , wrk_3d_14(jpi,jpj,jpk) ,     &  
    167177         &      wrk_3d_15(jpi,jpj,jpk)                                                                            , STAT=ierror(3) ) 
    168       ! 
     178         ! 
    169179      ALLOCATE( wrk_4d_1(jpi,jpj,jpk,jpts) , wrk_4d_2(jpi,jpj,jpk,jpts),     & 
    170180         &      wrk_4d_3(jpi,jpj,jpk,jpts) , wrk_4d_4(jpi,jpj,jpk,jpts), STAT=ierror(4) ) 
    171       ! 
     181         ! 
    172182      ALLOCATE( wrk_xz_1(jpi,jpk) , wrk_xz_2(jpi,jpk) , wrk_xz_3(jpi,jpk) , wrk_xz_4(jpi,jpk) , STAT=ierror(5) ) 
    173       ! 
     183         ! 
    174184      ALLOCATE( llwrk_2d_1(jpi,jpj) , llwrk_2d_2(jpi,jpj) , llwrk_2d_3(jpi,jpj)               , STAT=ierror(6) ) 
    175       ! 
     185         ! 
    176186      ALLOCATE( llwrk_3d_1(jpi,jpj,jpk) , STAT=ierror(7) ) 
    177       ! 
     187         ! 
    178188      ALLOCATE( iwrk_2d_1(jpi,jpj)      , STAT=ierror(8) ) 
    179189      ! 
    180190      wrk_alloc = MAXVAL( ierror ) 
    181  
     191      ! 
    182192      ! Calling routine, nemo_alloc(), checks for errors and takes  
    183193      ! appropriate action - we just print a warning message 
     
    203213      !!                .FALSE. otherwise.  
    204214      !! 
    205       !! ** Method  :   Sets internal flags to signal that requested workspaces 
    206       !!                are in use. 
    207       !!---------------------------------------------------------------------- 
    208       INTEGER, INTENT(in) ::   kdim        ! Dimensionality of requested workspace(s) 
    209       INTEGER, INTENT(in) ::   index1      ! Index of first requested workspace 
    210       INTEGER, OPTIONAL, INTENT(in) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9, index10 
     215      !! ** Method  :   Sets internal flags to signal that requested workspaces are in use. 
     216      !!                key_no_workspace_check defined ==> always return FALSE 
     217      !!---------------------------------------------------------------------- 
     218      INTEGER          , INTENT(in) ::   kdim        ! Dimensionality of requested workspace(s) 
     219      INTEGER          , INTENT(in) ::   index1      ! Index of first requested workspace 
     220      INTEGER, OPTIONAL, INTENT(in) ::             index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9, index10 
    211221      INTEGER, OPTIONAL, INTENT(in) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20 
    212222      INTEGER, OPTIONAL, INTENT(in) ::   index21, index22, index23, index24, index25, index26, index27 
     
    217227 
    218228      wrk_in_use = .FALSE. 
     229       
     230#if ! defined   key_no_workspace_check 
    219231      iptr    = index1 
    220232      iarg    = 1 
     
    287299         ! 
    288300      END DO ! end of DO WHILE() 
     301#endif 
    289302      ! 
    290303    END FUNCTION wrk_in_use 
     
    303316      !!                are in use. 
    304317      !!---------------------------------------------------------------------- 
    305       INTEGER, INTENT(in) ::   kdim     ! Dimensionality of requested workspace(s) 
    306       INTEGER, INTENT(in) ::   index1   ! Index of first requested workspace 
    307       INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 
     318      INTEGER          , INTENT(in) ::   kdim     ! Dimensionality of requested workspace(s) 
     319      INTEGER          , INTENT(in) ::   index1   ! Index of first requested workspace 
     320      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7, index8, index9 
    308321      ! 
    309322      LOGICAL ::   llwrk_in_use  ! Return value 
     
    312325      ! 
    313326      llwrk_in_use = .FALSE. 
     327      ! 
     328#if ! defined   key_no_workspace_check 
     329      ! 
    314330      iptr      = index1 
    315331      iarg      = 1 
     
    356372         ! 
    357373      END DO ! while( (.NOT. llwrk_in_use) .AND. iarg <= max_num_wrkspaces) 
     374#endif 
    358375      ! 
    359376   END FUNCTION llwrk_in_use 
     
    372389      !!                are in use. 
    373390      !!---------------------------------------------------------------------- 
    374       INTEGER          , INTENT(in) :: kdim        ! Dimensionality of requested workspace(s) 
    375       INTEGER          , INTENT(in) :: index1      ! Index of first requested workspace 
     391      INTEGER          , INTENT(in) ::   kdim        ! Dimensionality of requested workspace(s) 
     392      INTEGER          , INTENT(in) ::   index1      ! Index of first requested workspace 
    376393      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7 
    377394      ! 
    378       LOGICAL             :: iwrk_in_use    ! Return value 
    379       INTEGER :: iarg, iptr 
    380       !!---------------------------------------------------------------------- 
    381  
     395      LOGICAL ::  iwrk_in_use    ! Return value 
     396      INTEGER ::   iarg, iptr 
     397      !!---------------------------------------------------------------------- 
     398      ! 
    382399      iwrk_in_use = .FALSE. 
     400      ! 
     401#if ! defined   key_no_workspace_check 
     402      ! 
    383403      iptr     = index1 
    384404      iarg     = 1 
     
    435455         ! 
    436456      END DO ! end of DO WHILE() 
     457#endif 
    437458      ! 
    438459    END FUNCTION iwrk_in_use 
     
    451472      !!                are in use. 
    452473      !!---------------------------------------------------------------------- 
    453       INTEGER          , INTENT(in) :: index1      ! Index of first requested workspace 
    454       INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, & 
    455                                        index6, index7, index8, index9 
    456       ! Local variables 
     474      INTEGER          , INTENT(in) ::   index1      ! Index of first requested workspace 
     475      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5 
     476      INTEGER, OPTIONAL, INTENT(in) ::   index6, index7, index8, index9 
     477      ! 
    457478      LOGICAL ::   wrk_in_use_xz   ! Return value 
    458479      INTEGER ::   iarg, iptr      ! local integer 
    459480      !!---------------------------------------------------------------------- 
    460  
     481      ! 
    461482      wrk_in_use_xz = .FALSE. 
     483      ! 
     484#if ! defined   key_no_workspace_check 
     485      ! 
    462486      iptr       = index1 
    463487      iarg       = 1 
     
    465489      DO WHILE( (.NOT. wrk_in_use_xz) .AND. iarg <= max_num_wrkspaces ) 
    466490         ! 
    467          IF(iptr > num_xz_wrkspaces)THEN 
     491         IF(iptr > num_xz_wrkspaces) THEN 
    468492            CALL wrk_stop('wrk_in_use_xz - more 2D xz workspace arrays requested than defined in wrk_nemo module') 
    469493            wrk_in_use_xz = .TRUE. 
    470494            EXIT 
    471          ELSE IF( in_use_xz(iptr) )THEN 
     495         ELSE IF( in_use_xz(iptr) ) THEN 
    472496            wrk_in_use_xz = .TRUE. 
    473497            CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug 
     
    486510         ! 
    487511      END DO ! while( (.NOT. wrk_in_use_xz) .AND. iarg <= max_num_wrkspaces) 
     512#endif 
    488513      ! 
    489514   END FUNCTION wrk_in_use_xz 
     
    502527      !!                in use. 
    503528      !!---------------------------------------------------------------------- 
    504       LOGICAL             :: wrk_not_released ! Return value 
    505       INTEGER, INTENT(in) :: kdim             ! Dimensionality of workspace(s) 
    506       INTEGER, INTENT(in) :: index1           ! Index of 1st workspace to release 
     529      INTEGER          , INTENT(in) ::   kdim             ! Dimensionality of workspace(s) 
     530      INTEGER          , INTENT(in) ::   index1           ! Index of 1st workspace to release 
    507531      INTEGER, OPTIONAL, INTENT(in) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9 , index10 
    508532      INTEGER, OPTIONAL, INTENT(in) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20 
    509533      INTEGER, OPTIONAL, INTENT(in) ::   index21, index22, index23, index24, index25, index26, index27 
    510534      ! 
    511       INTEGER :: iarg, iptr 
    512       !!---------------------------------------------------------------------- 
    513  
     535      LOGICAL ::   wrk_not_released   ! Return value 
     536      INTEGER ::   iarg, iptr 
     537      !!---------------------------------------------------------------------- 
     538      ! 
    514539      wrk_not_released = .FALSE. 
     540      ! 
     541#if ! defined   key_no_workspace_check 
     542      ! 
    515543      iptr = index1 
    516544      iarg = 1 
     
    541569            ! 
    542570          ELSEIF( kdim == 4 ) THEN 
    543             IF(iptr > num_4d_wrkspaces)THEN 
     571            IF(iptr > num_4d_wrkspaces) THEN 
    544572               CALL wrk_stop('wrk_not_released : attempt to release a non-existent 4D workspace array') 
    545573               wrk_not_released = .TRUE. 
     
    568596         ! 
    569597      END DO ! end of DO WHILE() 
     598#endif 
    570599      ! 
    571600   END FUNCTION wrk_not_released 
     
    586615      ! 
    587616      llwrk_not_released = .FALSE. 
     617      ! 
     618#if ! defined   key_no_workspace_check 
     619      ! 
    588620      iptr = index1 
    589621      iarg = 1 
     
    624656         ! 
    625657      END DO ! while (iarg <= max_num_wrkspaces) 
     658#endif 
    626659      ! 
    627660   END FUNCTION llwrk_not_released 
     
    636669      !!                no-longer in use. 
    637670      !!---------------------------------------------------------------------- 
    638       INTEGER, INTENT(in) ::   kdim             ! Dimensionality of workspace(s) 
    639       INTEGER, INTENT(in) ::   index1           ! Index of 1st workspace to release 
    640       INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7 
     671      INTEGER          , INTENT(in) ::   kdim             ! Dimensionality of workspace(s) 
     672      INTEGER          , INTENT(in) ::   index1           ! Index of 1st workspace to release 
     673      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7 
    641674      ! 
    642675      LOGICAL :: iwrk_not_released   ! Return value 
     
    645678      ! 
    646679      iwrk_not_released = .FALSE. 
     680      ! 
     681#if ! defined   key_no_workspace_check 
     682      ! 
    647683      iptr         = index1 
    648684      iarg         = 1 
     
    695731         ! 
    696732      END DO ! end of DO WHILE() 
     733#endif 
    697734      ! 
    698735   END FUNCTION iwrk_not_released 
     
    705742      !! 
    706743      !!---------------------------------------------------------------------- 
    707       INTEGER, INTENT(in) :: index1           ! Index of 1st workspace to release 
    708       INTEGER, OPTIONAL, INTENT(in) :: index2, index3, index4, index5, index6, index7, index8, index9 
     744      INTEGER          , INTENT(in) ::   index1   ! Index of 1st workspace to release 
     745      INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7, index8, index9 
    709746      ! 
    710747      LOGICAL ::   wrk_not_released_xz   ! Return value 
     
    713750      ! 
    714751      wrk_not_released_xz = .FALSE. 
     752      ! 
     753#if ! defined   key_no_workspace_check 
     754      ! 
    715755      iptr           = index1 
    716756      iarg           = 1 
     
    737777         ! 
    738778      END DO ! while (iarg <= max_num_wrkspaces) 
     779#endif 
    739780      ! 
    740781   END FUNCTION wrk_not_released_xz 
     
    745786      !!                 *** ROUTINE print_in_use_list *** 
    746787      !! 
    747       !!    Purpose: to print out the table holding which workspace arrays 
     788      !! ** Purpose:  to print out the table holding which workspace arrays 
    748789      !!             are currently marked as in use. 
    749790      !!---------------------------------------------------------------------- 
     
    819860      &                     index25, index26, index27 ) 
    820861      !!---------------------------------------------------------------------- 
    821       INTEGER, INTENT(inout) :: iargidx ! Index of current arg 
    822       INTEGER, INTENT(inout) :: iargval ! Value of current arg 
    823       INTEGER, OPTIONAL, INTENT(in) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9 , index10 
    824       INTEGER, OPTIONAL, INTENT(in) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20 
    825       INTEGER, OPTIONAL, INTENT(in) ::   index21, index22, index23, index24, index25, index26, index27 
     862      INTEGER          , INTENT(inout) ::   iargidx  ! Index of current arg 
     863      INTEGER          , INTENT(inout) ::   iargval  ! Value of current arg 
     864      INTEGER, OPTIONAL, INTENT(in   ) ::            index2 , index3 , index4 , index5 , index6 , index7 , index8 , index9 , index10 
     865      INTEGER, OPTIONAL, INTENT(in   ) ::   index11, index12, index13, index14, index15, index16, index17, index18, index19, index20 
     866      INTEGER, OPTIONAL, INTENT(in   ) ::   index21, index22, index23, index24, index25, index26, index27 
    826867      !!---------------------------------------------------------------------- 
    827868 
     
    945986      !!---------------------------------------------------------------------- 
    946987      !!               ***  ROUTINE wrk_stop  *** 
    947       !!    Purpose: to act as local alternative to ctl_stop. Avoids 
    948       !!             dependency on in_out_manager module. 
     988      !! ** Purpose :   to act as local alternative to ctl_stop.  
     989      !!                Avoids dependency on in_out_manager module. 
    949990      !!---------------------------------------------------------------------- 
    950991      CHARACTER(LEN=*), INTENT(in) :: cmsg 
Note: See TracChangeset for help on using the changeset viewer.