Changeset 2737


Ignore:
Timestamp:
2011-04-11T12:30:51+02:00 (10 years ago)
Author:
rblod
Message:

Update module_example for dynamic allocation

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/module_example

    r2528 r2737  
    2323   PRIVATE 
    2424 
    25    PUBLIC   exa_mpl   ! routine called in xxx.F90 module 
     25   PUBLIC   exa_mpl        ! routine called in xxx.F90 module 
     26   PUBLIC   exa_mpl_init   ! routine called in nemogcm.F90 module 
    2627 
    2728   TYPE ::   FLD_E                !: Structure type definition 
     
    3031   END TYPE FLD_E  
    3132 
    32    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   var1         !: var1 description. CAUTION always use !: to describe 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var1         !: var1 description. CAUTION always use !: to describe 
    3334   !                                                          !  a PUBLIC variable: simplify its search :  
    3435   !                                                          !  grep var1 *90 | grep '!:' 
    35    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   var2, var2   !: several variable on a same line OK, but  
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   var2, var2   !: several variable on a same line OK, but  
    3637   !                                                          !  DO NOT use continuation lines in declaration 
    3738 
     
    4546   INTEGER                          ::   nint    ! nint  description (local permanent variable) 
    4647   REAL(wp)                         ::   var     ! var         -                - 
    47    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   array   ! array       -                - 
     48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   array   ! array       -                - 
    4849 
    4950   !! * Substitutions 
     
    5556   !!---------------------------------------------------------------------- 
    5657CONTAINS 
     58 
     59   INTEGER FUNCTION exa_mpl_alloc() 
     60      !!---------------------------------------------------------------------- 
     61      !!                ***  FUNCTION exa_mpl_alloc  *** 
     62      !!---------------------------------------------------------------------- 
     63      ALLOCATE( array(jpi,jpj,jpk) , STAT= exa_mpl_alloc )   ! Module array                                                                 
     64      ! 
     65      IF( lk_mpp             )   CALL mpp_sum ( exa_mpl_alloc ) 
     66      IF( exa_mpl_alloc /= 0 )   CALL ctl_warn('exa_mpl_alloc: failed to allocate arrays') 
     67      ! 
     68   END FUNCTION exa_mpl_alloc 
     69    
    5770 
    5871   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab ) 
     
    7386      !!                Give references if exist otherwise suppress these lines 
    7487      !!---------------------------------------------------------------------- 
    75       USE toto_module      ! description od the module 
     88      USE toto_module      ! description of the module 
     89      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     90      USE wrk_nemo, ONLY:   zztab => wrk_2d_5                     ! 2D workspace 
     91      USE wrk_nemo, ONLY:   zwx => wrk_3d_12 , zwy => wrk_3d_13   ! 3D workspace 
    7692      !! 
    7793      INTEGER , INTENT(in   )                     ::   kt      ! short description  
     
    84100      REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z) 
    85101      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration 
    86       REAL(wp), DIMENSION(jpi,jpk) ::   ztoto   ! 2D workspace 
    87102      !!-------------------------------------------------------------------- 
     103 
     104      IF( wrk_in_use(3, 12,13) .OR. wrk_in_use(2, 5 ) THEN 
     105         CALL ctl_stop('exa_mpl: requested workspace arrays unavailable')   ;   RETURN 
     106      ENDIF 
    88107 
    89108      IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only) 
     
    118137      CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (unchanged sign) 
    119138      ! 
     139      IF( wrk_not_released(3, 12,13) .OR. wrk_not_released(2, 5 ) THEN 
     140         CALL ctl_stop('exa_mpl: failed to release workspace arrays')   ;   RETURN 
     141      ENDIF 
     142      ! 
    120143   END SUBROUTINE exa_mpl 
    121144 
     
    156179      ENDIF 
    157180      ! 
    158       !                                          ! Parameter control 
     181      !                              ! allocate exa_mpl arrays       
     182      IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' ) 
     183      !                              ! Parameter control 
    159184      IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   ) 
    160185      IF( nn_opt == 2 )   CALL ctl_warn( 'exa_mpl_init: this work and option yyy may cause problems' ) 
Note: See TracChangeset for help on using the changeset viewer.