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 2590 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL – NEMO

Ignore:
Timestamp:
2011-02-18T13:49:27+01:00 (13 years ago)
Author:
trackstand2
Message:

Merge branch 'dynamic_memory' into master-svn-dyn

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL
Files:
4 edited

Legend:

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

    r2528 r2590  
    1010   IMPLICIT NONE 
    1111   PRIVATE 
     12 
     13   PUBLIC sol_oce_alloc ! routine called in nemogcm.F90 
    1214 
    1315   !                                             !!* Namelist namsol : elliptic solver * 
     
    3537   REAL(wp), PUBLIC ::   rr          !: coefficient  =(rn,rn) 
    3638 
    37    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   gcp     !: matrix extra-diagonal elements 
    38    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcx     !: now    solution of the elliptic eq. 
    39    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcxb    !: before solution of the elliptic eq. 
    40    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdprc  !: inverse diagonal preconditioning matrix 
    41    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdmat  !: diagonal preconditioning matrix 
    42    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcb     !: second member of the elliptic eq. 
    43    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcr     !: residu =b-a.x 
    44    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdes   !: vector descente 
    45    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gccd    !: gccd= gcdprc^-1.a.d  
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gcp     !: matrix extra-diagonal elements 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcx     !: now    solution of the elliptic eq. 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcxb    !: before solution of the elliptic eq. 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdprc  !: inverse diagonal preconditioning matrix 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdmat  !: diagonal preconditioning matrix 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcb     !: second member of the elliptic eq. 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcr     !: residu =b-a.x 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdes   !: vector descente 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gccd    !: gccd= gcdprc^-1.a.d  
    4648 
    4749#if defined key_agrif 
    48       REAL(wp), DIMENSION(jpi,jpj) :: laplacu, laplacv 
     50      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: laplacu, laplacv 
    4951#endif 
    5052 
     
    5456   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5557   !!---------------------------------------------------------------------- 
     58CONTAINS 
     59 
     60   FUNCTION sol_oce_alloc() 
     61      USE in_out_manager, ONLY: ctl_warn 
     62      IMPLICIT none 
     63      INTEGER  :: sol_oce_alloc 
     64      ! Local vars 
     65      INTEGER  :: ierr(3) 
     66 
     67      ierr(:) = 0 
     68 
     69      ALLOCATE(gcp(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), & 
     70               gcx(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),   & 
     71               gcxb(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), Stat=ierr(1)) 
     72 
     73      ALLOCATE(gcdprc(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),&  
     74               gcdmat(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),&  
     75               gcb(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), Stat=ierr(2)) 
     76 
     77      ALLOCATE(gcr(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),   &  
     78               gcdes(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), &  
     79               gccd(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),  & 
     80#if defined key_agrif 
     81               laplacu(jpi,jpj), laplacv(jpi,jpj),             & 
     82#endif 
     83               Stat=ierr(3)) 
     84 
     85      sol_oce_alloc = MAXVAL(ierr) 
     86 
     87      IF(sol_oce_alloc > 0)THEN 
     88         CALL ctl_warn('sol_oce_alloc: allocation of arrays failed.') 
     89      END IF 
     90 
     91  END FUNCTION sol_oce_alloc 
     92 
    5693END MODULE sol_oce 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    r2528 r2590  
    3535   PRIVATE 
    3636 
    37    PUBLIC   sol_mat    ! routine called by inisol.F90 
     37   PUBLIC   sol_mat        ! routine called by inisol.F90 
     38   PUBLIC   sol_mat_alloc  ! routine called by nemogcm.F90 
     39 
     40   ! Workspace array for sol_exd(). 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ztab 
    3842 
    3943   !!---------------------------------------------------------------------- 
     
    4448 
    4549CONTAINS 
     50 
     51   FUNCTION sol_mat_alloc() 
     52      !!---------------------------------------------------------------------- 
     53      !!                ***  ROUTINE sol_mat_alloc  *** 
     54      !!---------------------------------------------------------------------- 
     55      INTEGER :: sol_mat_alloc 
     56      !!---------------------------------------------------------------------- 
     57 
     58      ALLOCATE(ztab(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), & 
     59               Stat=sol_mat_alloc) 
     60 
     61      IF(sol_mat_alloc /= 0)THEN 
     62         CALL ctl_warn('sol_mat_alloc: failed to allocate array.') 
     63      END IF 
     64 
     65   END FUNCTION sol_mat_alloc 
     66 
    4667 
    4768   SUBROUTINE sol_mat( kt ) 
     
    321342      INTEGER  ::   ji, jk   ! dummy loop indices 
    322343      INTEGER  ::   iloc     ! temporary integers 
    323       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   ztab   ! 2D workspace 
    324344      !!---------------------------------------------------------------------- 
    325345 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90

    r2528 r2590  
    8383      !!        !  08-01  (R. Benshila) mpp optimization 
    8484      !!---------------------------------------------------------------------- 
     85      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     86      USE wrk_nemo, ONLY: zgcr => wrk_2d_1 
     87      !! 
    8588      INTEGER, INTENT( inout ) ::   kindic   ! solver indicator, < 0 if the conver- 
    8689      !                                      ! gence is not reached: the model is 
     
    9194      REAL(wp) ::  zgcad                     ! temporary scalars 
    9295      REAL(wp), DIMENSION(2) :: zsum 
    93       REAL(wp), DIMENSION(jpi,jpj) :: zgcr 
    9496      !!---------------------------------------------------------------------- 
     97       
     98      IF( .not. wrk_use(2, 1) )THEN 
     99         CALL ctl_stop('sol_pcg: requested workspace array is unavailable') 
     100         RETURN 
     101      END IF 
    95102 
    96103      ! Initialization of the algorithm with standard PCG 
     
    209216      CALL lbc_lnk( gcx, c_solver_pt, 1. ) 
    210217      
     218      !  
     219      IF( .not. wrk_release(2, 1) )THEN 
     220         CALL ctl_stop('sol_pcg: failed to release workspace array') 
     221      END IF 
     222      ! 
    211223   END SUBROUTINE sol_pcg 
    212224 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90

    r2528 r2590  
    5858      !!                Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 
    5959      !!---------------------------------------------------------------------- 
     60      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     61      USE wrk_nemo, ONLY: ztab => wrk_2d_1 
     62      !! 
    6063      INTEGER, INTENT(inout) ::   kindic   ! solver indicator, < 0 if the convergence is not reached: 
    6164      !                                    ! the model is stopped in step (set to zero before the call of solsor) 
     
    6568      INTEGER  ::   ijmppodd, ijmppeven, ijpr2d 
    6669      REAL(wp) ::   ztmp, zres, zres2 
    67       REAL(wp), DIMENSION(jpi,jpj) ::ztab 
    6870      !!---------------------------------------------------------------------- 
    6971       
     72      IF( .not. wrk_use(2, 1) )THEN 
     73         CALL ctl_stop('sol_sor: requested workspace array is unavailable') 
     74         RETURN 
     75      END IF 
     76 
    7077      ijmppeven = MOD( nimpp+njmpp+jpr2di+jpr2dj   , 2 ) 
    7178      ijmppodd  = MOD( nimpp+njmpp+jpr2di+jpr2dj+1 , 2 ) 
     
    163170      !  ------------- 
    164171      CALL lbc_lnk_e( gcx, c_solver_pt, 1. )    ! boundary conditions 
     172      !  
     173      IF( .not. wrk_release(2, 1) )THEN 
     174         CALL ctl_stop('sol_sor: failed to release workspace array') 
     175      END IF 
    165176      ! 
    166177   END SUBROUTINE sol_sor 
Note: See TracChangeset for help on using the changeset viewer.