Changeset 2688


Ignore:
Timestamp:
2011-03-15T14:40:08+01:00 (10 years ago)
Author:
gm
Message:

dynamic mem: #785 ; suppression of unused logical workspace function

File:
1 edited

Legend:

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

    r2676 r2688  
    1010   !!---------------------------------------------------------------------- 
    1111   !!   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 
     12   !!   wrk_in_use, iwrk_in_use, wrk_in_use_xz : check the availability of a workspace  
     13   !!   wrk_not_released, iwrk_not_released, wrk_not_released_xz : release the workspace 
    1514   !!   print_in_use_list : print out the table holding which workspace arrays are currently marked as in use 
    1615   !!   get_next_arg      : get the next argument 
     
    2322 
    2423   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 
     24   PUBLIC   wrk_in_use, iwrk_in_use, wrk_in_use_xz                     ! function called almost everywhere 
     25   PUBLIC   wrk_not_released, iwrk_not_released, wrk_not_released_xz   ! function called almost everywhere 
    2726 
    2827   INTEGER, PARAMETER :: num_1d_wrkspaces  = 27   ! No. of 1D workspace arrays ( MAX(jpi*jpj,jpi*jpk,jpj*jpk) ) 
     
    7675   !                                                               !!**  4D, x-y-z-tra, REAL(wp) workspaces  ** 
    7776   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), TARGET, PUBLIC ::   wrk_4d_1, wrk_4d_2, wrk_4d_3, wrk_4d_4  
    78  
    79 !!gm   !                                                               !!**  2D-3D logical workspace  ** 
    80 !!gm   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)            , PUBLIC ::   llwrk_2d_1, llwrk_2d_2, llwrk_2d_3  
    81 !!gm   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   llwrk_3d_1 !: 3D logical workspace 
    8277    
    8378   !                                                               !!** 2D integer workspace  ** 
     
    106101   !!---------------------------------------------------------------------- 
    107102   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    108    !! $Id$ 
     103   !! $Id:$ 
    109104   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    110105   !!---------------------------------------------------------------------- 
     
    123118      INTEGER ::   wrk_alloc   ! Return value 
    124119      INTEGER ::   extent_1d   ! Extent to allocate for 1D arrays 
    125       INTEGER ::   ierror(8)   ! local integer 
     120      INTEGER ::   ierror(6)   ! local integer 
    126121      !!---------------------------------------------------------------------- 
    127122      ! 
     
    136131      ELSEIF( jpj < jpi .AND. jpj < jpk ) THEN   ;   extent_1d = jpi*jpk 
    137132      ELSE                                       ;   extent_1d = jpi*jpj 
    138       END IF 
     133      ENDIF 
    139134      ! 
    140135      ! Initialise the 'in use' flags for each work-space array 
     
    147142      in_use_3dll(:) = .FALSE. 
    148143      in_use_2di (:) = .FALSE. 
    149        
     144      ! 
    150145      ierror(:) = 0 
    151  
     146      ! 
    152147      ALLOCATE( wrk_1d_1 (extent_1d) , wrk_1d_2 (extent_1d) , wrk_1d_3 (extent_1d) , wrk_1d_4 (extent_1d) ,     & 
    153148         &      wrk_1d_5 (extent_1d) , wrk_1d_6 (extent_1d) , wrk_1d_7 (extent_1d) , wrk_1d_8 (extent_1d) ,     & 
     
    182177      ALLOCATE( wrk_xz_1(jpi,jpk) , wrk_xz_2(jpi,jpk) , wrk_xz_3(jpi,jpk) , wrk_xz_4(jpi,jpk) , STAT=ierror(5) ) 
    183178         ! 
    184 !!gm      ALLOCATE( llwrk_2d_1(jpi,jpj) , llwrk_2d_2(jpi,jpj) , llwrk_2d_3(jpi,jpj)               , STAT=ierror(6) ) 
    185          ! 
    186 !!gm      ALLOCATE( llwrk_3d_1(jpi,jpj,jpk) , STAT=ierror(7) ) 
    187          ! 
    188       ALLOCATE( iwrk_2d_1(jpi,jpj)      , STAT=ierror(8) ) 
     179      ALLOCATE( iwrk_2d_1(jpi,jpj)      , STAT=ierror(6) ) 
    189180      ! 
    190181      wrk_alloc = MAXVAL( ierror ) 
     
    195186         WRITE(kumout,cform_war2) 
    196187         WRITE(kumout,*) 'wrk_alloc: allocation of workspace arrays failed' 
    197       END IF 
     188      ENDIF 
    198189      ! 
    199190   END FUNCTION wrk_alloc 
     
    225216      INTEGER ::   iarg, iptr   ! local integer 
    226217      !!---------------------------------------------------------------------- 
    227  
     218      ! 
    228219      wrk_in_use = .FALSE. 
    229        
    230 #if ! defined   key_no_workspace_check || ! defined key_agrif 
     220      ! 
     221#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif 
     222      ! NB: check not available with AGRIF 
     223      ! 
    231224      iptr    = index1 
    232225      iarg    = 1 
    233        
    234       DO WHILE( (.NOT. wrk_in_use) .AND. iarg <= max_num_wrkspaces ) 
     226      ! 
     227      DO WHILE( .NOT. wrk_in_use .AND. iarg <= max_num_wrkspaces ) 
    235228         ! 
    236229         IF( kdim == 1 ) THEN 
     
    282275            IF(llwp) WRITE(kumout,*) 'wrk_in_use: unsupported value of kdim = ',kdim 
    283276            CALL wrk_stop( 'wrk_in_use: unrecognised value for number of dimensions' ) 
    284          END IF 
     277         ENDIF 
    285278 
    286279         CALL get_next_arg( iarg  ,  iptr  ,  index2,  index3,  index4,    & 
     
    296289            CALL wrk_stop( 'wrk_in_use : caught unexpected argument count - BUG' ) 
    297290            EXIT 
    298          END IF 
     291         ENDIF 
    299292         ! 
    300293      END DO ! end of DO WHILE() 
    301294#endif 
    302295      ! 
    303     END FUNCTION wrk_in_use 
    304  
    305  
    306    FUNCTION llwrk_in_use( kdim,   index1, index2, index3, index4,   & 
    307       &                   index5, index6, index7, index8, index9) 
    308       !!---------------------------------------------------------------------- 
    309       !!                   ***  FUNCTION llwrk_in_use  *** 
    310       !! 
    311       !! ** Purpose :   Request a set of LOGICAL workspaces to use. Returns  
    312       !!                .TRUE. if any of those requested are already in use,  
    313       !!                .FALSE. otherwise.  
    314       !! 
    315       !! ** Method  :   Sets internal flags to signal that requested workspaces 
    316       !!                are in use. 
    317       !!---------------------------------------------------------------------- 
    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 
    321       ! 
    322       LOGICAL ::   llwrk_in_use  ! Return value 
    323       INTEGER ::   iarg, iptr    ! local integers 
    324       !!---------------------------------------------------------------------- 
    325       ! 
    326       llwrk_in_use = .FALSE. 
    327       ! 
    328 #if ! defined   key_no_workspace_check || ! defined key_agrif 
    329       ! 
    330       iptr      = index1 
    331       iarg      = 1 
    332       ! 
    333       DO WHILE( (.NOT. llwrk_in_use) .AND. iarg <= max_num_wrkspaces ) 
    334          ! 
    335          IF( kdim == 2 ) THEN 
    336             IF(iptr > num_2d_lwrkspaces)THEN 
    337                CALL wrk_stop('llwrk_in_use - more 2D workspace arrays requested than defined in wrk_nemo module') 
    338                llwrk_in_use = .TRUE. 
    339                EXIT 
    340             ELSE IF( in_use_2dll(iptr) )THEN 
    341                llwrk_in_use = .TRUE. 
    342                CALL print_in_use_list(2, REAL_TYPE, in_use_2d) 
    343             END IF 
    344             in_use_2dll(iptr) = .TRUE. 
    345             ! 
    346          ELSE IF (kdim == 3)THEN 
    347             ! 
    348             IF(iptr > num_3d_lwrkspaces)THEN 
    349                CALL wrk_stop('llwrk_in_use - more 3D workspace arrays requested than defined in wrk_nemo module') 
    350                llwrk_in_use = .TRUE. 
    351                EXIT 
    352             ELSE IF( in_use_3dll(iptr) )THEN 
    353                llwrk_in_use = .TRUE. 
    354                CALL print_in_use_list(3, REAL_TYPE, in_use_3d) 
    355             END IF 
    356             ! 
    357             in_use_3dll(iptr) = .TRUE. 
    358          ELSE  
    359             IF(llwp) WRITE(kumout,*) 'llwrk_in_use: unsupported value of kdim = ',kdim 
    360             CALL wrk_stop('llwrk_in_use: unrecognised value for number of dimensions') 
    361          END IF 
    362  
    363          CALL get_next_arg( iarg  , iptr  , index2, index3, index4, & 
    364             &               index5, index6, index7, index8, index9) 
    365  
    366          IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done 
    367             EXIT 
    368          ELSEIF( iarg == -99 ) THEN 
    369             CALL wrk_stop( 'llwrk_in_use - ERROR, caught unexpected argument count - BUG' ) 
    370             EXIT 
    371          ENDIF 
    372          ! 
    373       END DO ! while( (.NOT. llwrk_in_use) .AND. iarg <= max_num_wrkspaces) 
    374 #endif 
    375       ! 
    376    END FUNCTION llwrk_in_use 
     296   END FUNCTION wrk_in_use 
    377297 
    378298 
     
    399319      iwrk_in_use = .FALSE. 
    400320      ! 
    401 #if ! defined   key_no_workspace_check 
     321#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif 
     322      ! NB: check not available with AGRIF 
    402323      ! 
    403324      iptr     = index1 
    404325      iarg     = 1 
    405        
    406       DO WHILE( (.NOT. iwrk_in_use) .AND. iarg <= max_num_wrkspaces ) 
     326      ! 
     327      DO WHILE( .NOT.iwrk_in_use .AND. iarg <= max_num_wrkspaces ) 
    407328         ! 
    408329         IF( kdim == 2 ) THEN 
     
    413334               iwrk_in_use = .TRUE. 
    414335               CALL print_in_use_list( 2, INTEGER_TYPE, in_use_2di ) 
    415             END IF 
     336            ENDIF 
    416337            in_use_2di(iptr) = .TRUE. 
    417338            ! 
     
    419340            IF(llwp) WRITE(kumout,*) 'iwrk_in_use: unsupported value of kdim = ',kdim 
    420341            CALL wrk_stop('iwrk_in_use: unsupported value for number of dimensions') 
    421          END IF 
    422  
    423          ! Move on to next optional argument 
    424          SELECT CASE (iarg) 
     342         ENDIF 
     343         ! 
     344         SELECT CASE (iarg)         ! Move on to next optional argument 
    425345         CASE ( 1 ) 
    426346            IF( .NOT. PRESENT(index2) ) THEN   ;   EXIT 
    427347            ELSE                               ;   iarg = 2   ;   iptr = index2 
    428             END IF 
     348            ENDIF 
    429349         CASE ( 2 ) 
    430350            IF( .NOT. PRESENT(index3) ) THEN   ;   EXIT 
    431351            ELSE                               ;   iarg = 3   ;   iptr = index3 
    432             END IF 
     352            ENDIF 
    433353         CASE ( 3 ) 
    434354            IF( .NOT. PRESENT(index4) ) THEN   ;   EXIT 
    435355            ELSE                               ;   iarg = 4   ;   iptr = index4 
    436             END IF 
     356            ENDIF 
    437357         CASE ( 4 ) 
    438358            IF( .NOT. PRESENT(index5) ) THEN   ;   EXIT 
    439359            ELSE                               ;   iarg = 5   ;   iptr = index5 
    440             END IF 
     360            ENDIF 
    441361         CASE ( 5 ) 
    442362            IF( .NOT. PRESENT(index6) ) THEN   ;   EXIT 
    443363            ELSE                               ;   iarg = 6   ;   iptr = index6 
    444             END IF 
     364            ENDIF 
    445365         CASE ( 6 ) 
    446366            IF( .NOT. PRESENT(index7) ) THEN   ;   EXIT 
    447367            ELSE                               ;   iarg = 7   ;   iptr = index7 
    448             END IF 
     368            ENDIF 
    449369         CASE ( 7 ) 
    450370            EXIT 
     
    457377#endif 
    458378      ! 
    459     END FUNCTION iwrk_in_use 
     379   END FUNCTION iwrk_in_use 
    460380 
    461381 
     
    482402      wrk_in_use_xz = .FALSE. 
    483403      ! 
    484 #if ! defined   key_no_workspace_check 
    485       ! 
    486       iptr       = index1 
    487       iarg       = 1 
    488         
    489       DO WHILE( (.NOT. wrk_in_use_xz) .AND. iarg <= max_num_wrkspaces ) 
    490          ! 
    491          IF(iptr > num_xz_wrkspaces) THEN 
     404#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif 
     405      ! NB: check not available with AGRIF 
     406      ! 
     407      iptr = index1 
     408      iarg = 1 
     409      ! 
     410      DO WHILE( .NOT. wrk_in_use_xz .AND. iarg <= max_num_wrkspaces ) 
     411         ! 
     412         IF( iptr > num_xz_wrkspaces ) THEN 
    492413            CALL wrk_stop('wrk_in_use_xz - more 2D xz workspace arrays requested than defined in wrk_nemo module') 
    493414            wrk_in_use_xz = .TRUE. 
     
    496417            wrk_in_use_xz = .TRUE. 
    497418            CALL print_in_use_list(2, REAL_TYPE, in_use_xz) !ARPDBG - bug 
    498          END IF 
     419         ENDIF 
    499420         ! 
    500421         in_use_xz(iptr) = .TRUE. 
    501422         ! 
    502          CALL get_next_arg(iarg  , iptr  , index2, index3, index4, & 
    503             &              index5, index6, index7, index8, index9) 
     423         CALL get_next_arg( iarg  , iptr  , index2, index3, index4,  & 
     424            &               index5, index6, index7, index8, index9 ) 
    504425         ! 
    505426         IF( iarg == -1 ) THEN      ! We've checked all of the arguments and are done 
     
    507428         ELSEIF( iarg == -99 ) THEN 
    508429            CALL wrk_stop( 'wrk_in_use_xz : caught unexpected argument count - BUG' )   ;   EXIT 
    509          END IF 
     430         ENDIF 
    510431         ! 
    511432      END DO ! while( (.NOT. wrk_in_use_xz) .AND. iarg <= max_num_wrkspaces) 
     
    539460      wrk_not_released = .FALSE. 
    540461      ! 
    541 #if ! defined   key_no_workspace_check 
     462#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif 
     463      ! NB: check not available with AGRIF 
    542464      ! 
    543465      iptr = index1 
    544466      iarg = 1 
    545  
     467      ! 
    546468      DO WHILE( iarg <= max_num_wrkspaces ) 
    547469         ! 
     
    554476            ENDIF 
    555477            ! 
    556          ELSE IF(kdim == 2)THEN 
     478         ELSE IF(kdim == 2) THEN 
    557479            IF( iptr > num_2d_wrkspaces ) THEN 
    558480               CALL wrk_stop( 'wrk_not_released : attempt to release a non-existent 2D workspace array' ) 
     
    565487               CALL wrk_stop('wrk_not_released : attempt to release a non-existent 3D workspace array') 
    566488               wrk_not_released = .TRUE. 
    567             END IF 
     489            ENDIF 
    568490            in_use_3d(iptr) = .FALSE. 
    569491            ! 
    570492          ELSEIF( kdim == 4 ) THEN 
    571             IF(iptr > num_4d_wrkspaces) THEN 
     493            IF( iptr > num_4d_wrkspaces ) THEN 
    572494               CALL wrk_stop('wrk_not_released : attempt to release a non-existent 4D workspace array') 
    573495               wrk_not_released = .TRUE. 
    574             END IF 
     496            ENDIF 
    575497            in_use_4d(iptr) = .FALSE. 
    576498            ! 
     
    579501            CALL wrk_stop('wrk_not_released: unrecognised value for number of dimensions') 
    580502         ENDIF 
    581           
     503         ! 
    582504         ! Move on to next optional argument 
    583505         CALL get_next_arg( iarg  ,  iptr  ,  index2,  index3,  index4,   & 
     
    593515         ELSEIF( iarg == -99 ) THEN 
    594516             CALL wrk_stop('wrk_not_released - caught unexpected argument count - BUG')   ;   EXIT 
    595          END IF 
     517         ENDIF 
    596518         ! 
    597519      END DO ! end of DO WHILE() 
     
    599521      ! 
    600522   END FUNCTION wrk_not_released 
    601  
    602  
    603    FUNCTION llwrk_not_released( kdim, index1, index2, index3, index4, index5,   & 
    604       &                               index6, index7, index8, index9 ) 
    605       !!---------------------------------------------------------------------- 
    606       !!                 ***  FUNCTION wrk_not_released  *** 
    607       !!---------------------------------------------------------------------- 
    608       INTEGER          , INTENT(in) ::   kdim             ! Dimensionality of workspace(s) 
    609       INTEGER          , INTENT(in) ::   index1           ! Index of 1st workspace to release 
    610       INTEGER, OPTIONAL, INTENT(in) ::   index2, index3, index4, index5, index6, index7, index8, index9 
    611       ! 
    612       LOGICAL ::   llwrk_not_released   ! Return value 
    613       INTEGER ::   iarg, iptr           ! local integer 
    614       !!---------------------------------------------------------------------- 
    615       ! 
    616       llwrk_not_released = .FALSE. 
    617       ! 
    618 #if ! defined   key_no_workspace_check 
    619       ! 
    620       iptr = index1 
    621       iarg = 1 
    622       ! 
    623       DO WHILE(iarg <= max_num_wrkspaces) 
    624          ! 
    625          IF( kdim == 2 ) THEN 
    626             ! 
    627             IF( iptr > num_2d_lwrkspaces ) THEN 
    628                CALL wrk_stop( 'llwrk_not_released : attempt to release a non-existent 2D workspace array' ) 
    629                llwrk_not_released = .TRUE. 
    630                EXIT 
    631             ENDIF 
    632             in_use_2dll(iptr) = .FALSE. 
    633             ! 
    634          ELSEIF( kdim == 3 ) THEN 
    635             IF( iptr > num_3d_lwrkspaces ) THEN 
    636                CALL wrk_stop('llwrk_not_released : attempt to release a non-existent 3D workspace array') 
    637                llwrk_not_released = .TRUE. 
    638                EXIT 
    639             ENDIF 
    640             in_use_3dll(iptr) = .FALSE. 
    641             ! 
    642          ELSE  
    643             IF(llwp) WRITE(kumout,*) 'llwrk_not_released: unsupported value of kdim = ', kdim 
    644             CALL wrk_stop( 'llwrk_not_released : unrecognised value for number of dimensions' ) 
    645          END IF 
    646          ! 
    647          ! Move on to next optional argument 
    648          CALL get_next_arg(iarg, iptr, index2, index3, index4,   & 
    649             &                          index5, index6, index7, index8, index9) 
    650          ! 
    651          IF( iarg == -1 ) THEN         ! We've checked all of the arguments and are done 
    652              EXIT 
    653          ELSEIF( iarg == -99 ) THEN 
    654             CALL wrk_stop( 'llwrk_not_released : caught unexpected argument count - BUG' )   ;   EXIT 
    655          ENDIF 
    656          ! 
    657       END DO ! while (iarg <= max_num_wrkspaces) 
    658 #endif 
    659       ! 
    660    END FUNCTION llwrk_not_released 
    661523 
    662524 
     
    679541      iwrk_not_released = .FALSE. 
    680542      ! 
    681 #if ! defined   key_no_workspace_check 
    682       ! 
    683       iptr         = index1 
    684       iarg         = 1 
     543#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif 
     544      ! NB: check not available with AGRIF 
     545      ! 
     546      iptr = index1 
     547      iarg = 1 
    685548      ! 
    686549      DO WHILE(iarg <= max_num_wrkspaces) 
     
    702565            IF( .NOT. PRESENT(index2) ) THEN   ;   EXIT 
    703566            ELSE                               ;   iarg = 2   ;   iptr = index2 
    704             END IF 
     567            ENDIF 
    705568         CASE ( 2 ) 
    706569            IF( .NOT. PRESENT(index3) ) THEN   ;   EXIT 
    707570            ELSE                               ;   iarg = 3   ;   iptr = index3 
    708             END IF 
     571            ENDIF 
    709572         CASE ( 3 ) 
    710573            IF( .NOT. PRESENT(index4) ) THEN   ;   EXIT 
    711574            ELSE                               ;   iarg = 4   ;   iptr = index4 
    712             END IF 
     575            ENDIF 
    713576         CASE ( 4 ) 
    714577            IF( .NOT. PRESENT(index5) ) THEN   ;   EXIT 
    715578            ELSE                               ;   iarg = 5   ;   iptr = index5 
    716             END IF 
     579            ENDIF 
    717580         CASE ( 5 ) 
    718581            IF( .NOT. PRESENT(index6) ) THEN   ;   EXIT 
    719582            ELSE                               ;   iarg = 6   ;   iptr = index6 
    720             END IF 
     583            ENDIF 
    721584         CASE ( 6 ) 
    722585            IF( .NOT. PRESENT(index7) ) THEN   ;   EXIT 
    723586            ELSE                               ;   iarg = 7   ;   iptr = index7 
    724             END IF 
     587            ENDIF 
    725588         CASE ( 7 ) 
    726589            EXIT 
     
    751614      wrk_not_released_xz = .FALSE. 
    752615      ! 
    753 #if ! defined   key_no_workspace_check 
     616#if ! defined   key_no_workspace_check   ||   ! defined   key_agrif 
     617      ! NB: check not available with AGRIF 
    754618      ! 
    755619      iptr           = index1 
     
    774638            CALL wrk_stop('wrk_not_released_xz : caught unexpected argument count - BUG') 
    775639            EXIT 
    776          END IF 
     640         ENDIF 
    777641         ! 
    778642      END DO ! while (iarg <= max_num_wrkspaces) 
     
    796660      CHARACTER(LEN=7) ::   type_string 
    797661      !!---------------------------------------------------------------------- 
    798  
     662      ! 
    799663      IF(.NOT. llwp)   RETURN 
    800  
     664      ! 
    801665      SELECT CASE ( kdim ) 
    802666      ! 
     
    832696      ! 
    833697      END SELECT 
    834  
     698      ! 
    835699      ! Set character string with type of workspace 
    836700      SELECT CASE (itype) 
     
    839703      CASE (REAL_TYPE   )   ;   type_string = "REAL"  
    840704      END SELECT 
    841  
     705      ! 
    842706      WRITE(kumout,*) 
    843707      WRITE(kumout,"('------------------------------------------')") 
     
    866730      INTEGER, OPTIONAL, INTENT(in   ) ::   index21, index22, index23, index24, index25, index26, index27 
    867731      !!---------------------------------------------------------------------- 
    868  
     732      ! 
    869733      SELECT CASE (iargidx)       ! Move on to next optional argument 
    870734      CASE ( 1 ) 
     
    931795         IF( .NOT. PRESENT(index17) ) THEN   ;   iargidx = -1 
    932796         ELSE                                ;   iargidx = 17   ;   iargval = index17 
    933          END IF 
     797         ENDIF 
    934798      CASE ( 17 ) 
    935799         IF( .NOT. PRESENT(index18) ) THEN   ;   iargidx = -1 
     
    991855      CHARACTER(LEN=*), INTENT(in) :: cmsg 
    992856      !!---------------------------------------------------------------------- 
    993  
     857      ! 
    994858      WRITE(kumout, cform_err2) 
    995859      WRITE(kumout,*) TRIM(cmsg) 
     
    999863      ! deal with the error passed back from the wrk_X routine? 
    1000864      !CALL mppstop 
    1001  
     865      ! 
    1002866   END SUBROUTINE wrk_stop 
    1003867 
Note: See TracChangeset for help on using the changeset viewer.