Changeset 2590 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL
- Timestamp:
- 2011-02-18T13:49:27+01:00 (13 years ago)
- 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 10 10 IMPLICIT NONE 11 11 PRIVATE 12 13 PUBLIC sol_oce_alloc ! routine called in nemogcm.F90 12 14 13 15 ! !!* Namelist namsol : elliptic solver * … … 35 37 REAL(wp), PUBLIC :: rr !: coefficient =(rn,rn) 36 38 37 REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) :: gcp !: matrix extra-diagonal elements38 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 matrix41 REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) :: gcdmat !: diagonal preconditioning matrix42 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.x44 REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) :: gcdes !: vector descente45 REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) :: gccd !: gccd= gcdprc^-1.a.d39 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 46 48 47 49 #if defined key_agrif 48 REAL(wp), DIMENSION(jpi,jpj) :: laplacu, laplacv50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: laplacu, laplacv 49 51 #endif 50 52 … … 54 56 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 55 57 !!---------------------------------------------------------------------- 58 CONTAINS 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 56 93 END MODULE sol_oce -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r2528 r2590 35 35 PRIVATE 36 36 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 38 42 39 43 !!---------------------------------------------------------------------- … … 44 48 45 49 CONTAINS 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 46 67 47 68 SUBROUTINE sol_mat( kt ) … … 321 342 INTEGER :: ji, jk ! dummy loop indices 322 343 INTEGER :: iloc ! temporary integers 323 REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) :: ztab ! 2D workspace324 344 !!---------------------------------------------------------------------- 325 345 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90
r2528 r2590 83 83 !! ! 08-01 (R. Benshila) mpp optimization 84 84 !!---------------------------------------------------------------------- 85 USE wrk_nemo, ONLY: wrk_use, wrk_release 86 USE wrk_nemo, ONLY: zgcr => wrk_2d_1 87 !! 85 88 INTEGER, INTENT( inout ) :: kindic ! solver indicator, < 0 if the conver- 86 89 ! ! gence is not reached: the model is … … 91 94 REAL(wp) :: zgcad ! temporary scalars 92 95 REAL(wp), DIMENSION(2) :: zsum 93 REAL(wp), DIMENSION(jpi,jpj) :: zgcr94 96 !!---------------------------------------------------------------------- 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 95 102 96 103 ! Initialization of the algorithm with standard PCG … … 209 216 CALL lbc_lnk( gcx, c_solver_pt, 1. ) 210 217 218 ! 219 IF( .not. wrk_release(2, 1) )THEN 220 CALL ctl_stop('sol_pcg: failed to release workspace array') 221 END IF 222 ! 211 223 END SUBROUTINE sol_pcg 212 224 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90
r2528 r2590 58 58 !! Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 59 59 !!---------------------------------------------------------------------- 60 USE wrk_nemo, ONLY: wrk_use, wrk_release 61 USE wrk_nemo, ONLY: ztab => wrk_2d_1 62 !! 60 63 INTEGER, INTENT(inout) :: kindic ! solver indicator, < 0 if the convergence is not reached: 61 64 ! ! the model is stopped in step (set to zero before the call of solsor) … … 65 68 INTEGER :: ijmppodd, ijmppeven, ijpr2d 66 69 REAL(wp) :: ztmp, zres, zres2 67 REAL(wp), DIMENSION(jpi,jpj) ::ztab68 70 !!---------------------------------------------------------------------- 69 71 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 70 77 ijmppeven = MOD( nimpp+njmpp+jpr2di+jpr2dj , 2 ) 71 78 ijmppodd = MOD( nimpp+njmpp+jpr2di+jpr2dj+1 , 2 ) … … 163 170 ! ------------- 164 171 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 165 176 ! 166 177 END SUBROUTINE sol_sor
Note: See TracChangeset
for help on using the changeset viewer.