Changeset 1601 for trunk/NEMO/OPA_SRC/SOL/solsor.F90
- Timestamp:
- 2009-08-11T12:09:19+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/SOL/solsor.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/SOL/solsor.F90
r1528 r1601 4 4 !! Ocean solver : Successive Over-Relaxation solver 5 5 !!===================================================================== 6 !! History : OPA ! 1990-10 (G. Madec) Original code 7 !! 7.1 ! 1993-04 (G. Madec) time filter 8 !! ! 1996-05 (G. Madec) merge sor and pcg formulations 9 !! ! 1996-11 (A. Weaver) correction to preconditioning 10 !! NEMO 1.0 ! 2003-04 (C. Deltel, G. Madec) Red-Black SOR in free form 11 !! 2.0 ! 2005-09 (R. Benshila, G. Madec) MPI optimization 12 !!---------------------------------------------------------------------- 6 13 7 14 !!---------------------------------------------------------------------- 8 15 !! sol_sor : Red-Black Successive Over-Relaxation solver 9 16 !!---------------------------------------------------------------------- 10 !! * Modules used11 17 USE oce ! ocean dynamics and tracers variables 12 18 USE dom_oce ! ocean space and time domain variables … … 20 26 PRIVATE 21 27 22 !! * Routine accessibility 23 PUBLIC sol_sor ! ??? 28 PUBLIC sol_sor ! 24 29 25 30 !!---------------------------------------------------------------------- 26 !! OPA 9.0 , LOCEAN-IPSL (2005)31 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 27 32 !! $Id$ 28 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 29 34 !!---------------------------------------------------------------------- 30 35 … … 49 54 !! conditions only when the inside domain is reached. 50 55 !! 51 !! References : 52 !! Madec et al. 1988, Ocean Modelling, issue 78, 1-6. 53 !! Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 56 !! References : Madec et al. 1988, Ocean Modelling, issue 78, 1-6. 57 !! Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 58 !!---------------------------------------------------------------------- 59 INTEGER, INTENT(inout) :: kindic ! solver indicator, < 0 if the convergence is not reached: 60 ! ! the model is stopped in step (set to zero before the call of solsor) 54 61 !! 55 !! History :56 !! ! 90-10 (G. Madec) Original code57 !! ! 91-11 (G. Madec)58 !! 7.1 ! 93-04 (G. Madec) time filter59 !! ! 96-05 (G. Madec) merge sor and pcg formulations60 !! ! 96-11 (A. Weaver) correction to preconditioning61 !! 9.0 ! 03-04 (C. Deltel, G. Madec) Red-Black SOR in free form62 !! 9.0 ! 05-09 (R. Benshila, G. Madec) MPI optimization63 !!----------------------------------------------------------------------64 !! * Arguments65 INTEGER, INTENT( inout ) :: kindic ! solver indicator, < 0 if the conver-66 ! ! gence is not reached: the model is67 ! ! stopped in step68 ! ! set to zero before the call of solsor69 !! * Local declarations70 62 INTEGER :: ji, jj, jn ! dummy loop indices 71 63 INTEGER :: ishift, icount 64 INTEGER :: ijmppodd, ijmppeven, ijpr2d 72 65 REAL(wp) :: ztmp, zres, zres2 73 74 INTEGER :: ijmppodd, ijmppeven75 INTEGER :: ijpr2d76 66 !!---------------------------------------------------------------------- 77 67 78 ijmppeven = MOD( nimpp+njmpp+jpr2di+jpr2dj,2)79 ijmppodd = MOD( nimpp+njmpp+jpr2di+jpr2dj+1,2)80 ijpr2d = MAX(jpr2di,jpr2dj)68 ijmppeven = MOD( nimpp+njmpp+jpr2di+jpr2dj , 2 ) 69 ijmppodd = MOD( nimpp+njmpp+jpr2di+jpr2dj+1 , 2 ) 70 ijpr2d = MAX( jpr2di , jpr2dj ) 81 71 icount = 0 82 72 ! ! ============== 83 DO jn = 1, n max! Iterative loop73 DO jn = 1, nn_nmax ! Iterative loop 84 74 ! ! ============== 85 75 86 ! applied the lateral boundary conditions 87 IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) 76 IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) ! lateral boundary conditions 88 77 89 78 ! Residus … … 103 92 gcr(ji,jj) = zres * gcdmat(ji,jj) * zres 104 93 ! Guess update 105 gcx(ji,jj) = sor * ztmp + (1-sor) * gcx(ji,jj)94 gcx(ji,jj) = rn_sor * ztmp + (1-rn_sor) * gcx(ji,jj) 106 95 END DO 107 96 END DO 108 97 icount = icount + 1 109 98 110 ! applied the lateral boundary conditions 111 IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) 99 IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) ! lateral boundary conditions 112 100 113 101 ! Guess red update … … 124 112 gcr(ji,jj) = zres * gcdmat(ji,jj) * zres 125 113 ! Guess update 126 gcx(ji,jj) = sor * ztmp + (1-sor) * gcx(ji,jj)114 gcx(ji,jj) = rn_sor * ztmp + (1-rn_sor) * gcx(ji,jj) 127 115 END DO 128 116 END DO … … 130 118 131 119 ! test of convergence 132 IF ( jn > n min .AND. MOD( jn-nmin, nmod ) == 0 ) then120 IF ( jn > nn_nmin .AND. MOD( jn-nn_nmin, nn_nmod ) == 0 ) THEN 133 121 134 SELECT CASE ( n sol_arp )122 SELECT CASE ( nn_sol_arp ) 135 123 CASE ( 0 ) ! absolute precision (maximum value of the residual) 136 124 zres2 = MAXVAL( gcr(2:nlci-1,2:nlcj-1) ) 137 125 IF( lk_mpp ) CALL mpp_max( zres2 ) ! max over the global domain 138 126 ! test of convergence 139 IF( zres2 < r esmax .OR. jn ==nmax ) THEN127 IF( zres2 < rn_resmax .OR. jn == nn_nmax ) THEN 140 128 res = SQRT( zres2 ) 141 129 niter = jn … … 146 134 IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 147 135 ! test of convergence 148 IF( rnorme < epsr .OR. jn == n max ) THEN136 IF( rnorme < epsr .OR. jn == nn_nmax ) THEN 149 137 res = SQRT( rnorme ) 150 138 niter = jn … … 160 148 ENDIF 161 149 ! indicator of non-convergence or explosion 162 IF( jn == n max .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2150 IF( jn == nn_nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 163 151 IF( ncut == 999 ) GOTO 999 164 152 … … 169 157 999 CONTINUE 170 158 171 172 159 ! Output in gcx 173 160 ! ------------- 174 175 161 CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) ! boundary conditions 176 177 162 ! 178 163 END SUBROUTINE sol_sor 179 164
Note: See TracChangeset
for help on using the changeset viewer.
