Changeset 111 for trunk/NEMO/OPA_SRC/SOL
- Timestamp:
- 2004-06-28T15:22:55+02:00 (20 years ago)
- Location:
- trunk/NEMO/OPA_SRC/SOL
- Files:
-
- 4 edited
-
sol_oce.F90 (modified) (1 diff)
-
solmat.F90 (modified) (8 diffs)
-
solsor.F90 (modified) (5 diffs)
-
solver.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/SOL/sol_oce.F90
r16 r111 22 22 !! ---------------------------------- 23 23 INTEGER , PUBLIC :: & !!: namsol elliptic solver / island / free surface 24 nsolv = 1 , & !: = 1/2/3 type of elliptic solver 25 nmax = 800 , & !: maximum of iterations for the solver 26 nmisl = 4000 !: maximum pcg iterations for island 24 nsolv = 1 , & !: = 1/2/3 type of elliptic solver 25 nsol_arp = 1 , & !: = 1/0 absolute/relative precision convergence test 26 nmin = 300 , & !: minimum of iterations for the solver 27 nmax = 800 , & !: maximum of iterations for the solver 28 nmod = 10 , & !: frequency of test for the solver 29 nmisl = 4000 !: maximum pcg iterations for island 27 30 28 31 REAL(wp), PUBLIC :: & !!: namsol elliptic solver / island / free surface 29 32 eps = 1.e-6_wp , & !: absolute precision of the solver 30 sor = 1. 76_wp , & !: optimal coefficient for sor solver33 sor = 1.92_wp , & !: optimal coefficient for sor solver 31 34 epsisl = 1.e-10_wp, & !: absolute precision on stream function solver 32 35 rnu = 1.0_wp !: strength of the additional force used in free surface -
trunk/NEMO/OPA_SRC/SOL/solmat.F90
r85 r111 222 222 DO jj = 1, jpj 223 223 DO ji = 1, jpi 224 IF( bmask(ji,jj) /= 0. ) gcdprc(ji,jj) = 1.e0 / gcdmat(ji,jj)224 IF( bmask(ji,jj) /= 0.e0 ) gcdprc(ji,jj) = 1.e0 / gcdmat(ji,jj) 225 225 END DO 226 226 END DO … … 240 240 DO jj = 1, jpj 241 241 DO ji = 1, jpi 242 IF( bmask(ji,jj) /= 0. ) THEN243 gcdprc(ji,jj) = 1. 242 IF( bmask(ji,jj) /= 0.e0 ) THEN 243 gcdprc(ji,jj) = 1.e0 244 244 ELSE 245 gcdprc(ji,jj) = 0. 245 gcdprc(ji,jj) = 0.e0 246 246 ENDIF 247 247 END DO … … 531 531 DO jj = 1, jpj 532 532 IF( iimask(1,jj) /= 0 ) THEN 533 gcp(1,jj,2) = 0. 533 gcp(1,jj,2) = 0.e0 534 534 gcp(1,jj,1) = zdemi * gcp(1,jj,1) 535 535 gcp(1,jj,4) = zdemi * gcp(1,jj,4) … … 546 546 DO jj = 1, jpj 547 547 IF( iimask(iiend,jj) /= 0 ) THEN 548 gcp(iiend,jj,3) = 0. 548 gcp(iiend,jj,3) = 0.e0 549 549 gcp(iiend,jj,1) = zdemi * gcp(iiend,jj,1) 550 550 gcp(iiend,jj,4) = zdemi * gcp(iiend,jj,4) … … 564 564 DO ji = 1, jpi 565 565 IF( iimask(ji,1) /= 0 ) THEN 566 gcp(ji,1,1) = 0. 566 gcp(ji,1,1) = 0.e0 567 567 gcp(ji,1,2) = zdemi * gcp(ji,1,2) 568 568 gcp(ji,1,3) = zdemi * gcp(ji,1,3) … … 580 580 DO ji = 1, jpi 581 581 IF( iimask(ji,ijend) /= 0 ) THEN 582 gcp(ji,ijend,4) = 0. 582 gcp(ji,ijend,4) = 0.e0 583 583 gcp(ji,ijend,2) = zdemi * gcp(ji,ijend,2) 584 584 gcp(ji,ijend,3) = zdemi * gcp(ji,ijend,3) … … 682 682 CALL feti_vsub(noeuds,wfeti(may),wfeti(maz),wfeti(maz)) 683 683 684 zres2 = 0. 684 zres2 = 0.e0 685 685 DO jl = 1, noeuds 686 686 zres2 = zres2 + wfeti(may+jl-1) * wfeti(may+jl-1) … … 688 688 CALL mpp_sum(zres2,1,zres) 689 689 690 res2 = 0. 690 res2 = 0.e0 691 691 DO jl = 1, noeuds 692 692 res2 = res2 + wfeti(maz+jl-1) * wfeti(maz+jl-1) -
trunk/NEMO/OPA_SRC/SOL/solsor.F90
r95 r111 76 76 ! ! ============== 77 77 78 CALL lbc_lnk( gcx, c_solver_pt, 1. ) ! applied the lateral bou bary conditions78 CALL lbc_lnk( gcx, c_solver_pt, 1. ) ! applied the lateral boundary conditions 79 79 80 80 ! Residus 81 81 ! ------- 82 82 83 zres2 = 0.e084 85 83 ! Guess black update 86 DO jj = 2, jpjm184 DO jj = 2, jpjm1 87 85 ishift = MOD( jj-ijmppodd, 2 ) 88 86 DO ji = 2+ishift, jpim1, 2 … … 93 91 & - gcp(ji,jj,4) * gcx(ji ,jj+1) 94 92 ! Estimate of the residual 95 zres = ztmp - gcx(ji,jj) 96 zres2 = zres2 + zres * gcdmat(ji,jj) * zres 93 zres = ztmp - gcx(ji,jj) 97 94 gcr(ji,jj) = zres * gcdmat(ji,jj) * zres 98 95 ! Guess update … … 113 110 & - gcp(ji,jj,4) * gcx(ji ,jj+1) 114 111 ! Estimate of the residual 115 zres = ztmp - gcx(ji,jj) 116 zres2 = zres2 + zres * gcdmat(ji,jj) * zres 112 zres = ztmp - gcx(ji,jj) 117 113 gcr(ji,jj) = zres * gcdmat(ji,jj) * zres 118 114 ! Guess update 119 gcx(ji,jj) = sor * ztmp +(1-sor) * gcx(ji,jj)115 gcx(ji,jj) = sor * ztmp + (1-sor) * gcx(ji,jj) 120 116 END DO 121 117 END DO … … 123 119 CALL lbc_lnk( gcx, c_solver_pt, 1. ) ! applied the lateral boubary conditions 124 120 125 ! relative precision 126 rnorme = zres2 127 !!!! IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 128 !i 129 zres2 = MAXVAL( gcr(2:jpim1,2:jpjm1) ) 121 ! test of convergence 122 IF ( jn > nmin .AND. MOD( jn-nmin, nmod ) == 0 ) then 130 123 131 IF( lk_mpp ) CALL mpp_max( zres2 ) ! sum over the global domain 132 !i 133 ! test of convergence 134 ! old test (either res<resmax or jn=nmax) 135 ! IF( res < resmax .OR. jn == nmax ) THEN 136 IF( zres2 < 1.e-10 .OR. jn == nmax ) THEN 137 ! relative precision 138 ! IF( rnorme < epsr .OR. jn == nmax ) THEN 139 ! res = SQRT( rnorme ) 140 res = SQRT( zres2 ) 141 niter = jn 142 ncut = 999 143 ! write(numout,*) 'solsor : res max = ', zres2, 'niter= ', niter 144 ENDIF 124 SELECT CASE ( nsol_arp ) 125 CASE ( 1 ) ! relative precision 126 rnorme = SUM( gcr(2:jpim1,2:jpjm1) ) 127 IF( lk_mpp ) CALL mpp_sum( rnorme ) ! sum over the global domain 128 ! test of convergence 129 IF( rnorme < epsr .OR. jn == nmax ) THEN 130 res = SQRT( rnorme ) 131 niter = jn 132 ncut = 999 133 ENDIF 134 CASE ( 0 ) ! absolute precision (maximum value of the residual) 135 zres2 = MAXVAL( gcr(2:jpim1,2:jpjm1) ) 136 IF( lk_mpp ) CALL mpp_max( zres2 ) ! max over the global domain 137 ! test of convergence 138 IF( zres2 < resmax .OR. jn == nmax ) THEN 139 res = SQRT( zres2 ) 140 niter = jn 141 ncut = 999 142 ENDIF 143 END CASE 145 144 146 145 !**** … … 149 148 !**** 150 149 150 ENDIF 151 151 ! indicator of non-convergence or explosion 152 152 IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 -
trunk/NEMO/OPA_SRC/SOL/solver.F90
r79 r111 79 79 INTEGER :: ji, jj ! dummy loop indices 80 80 81 NAMELIST/namsol/ nsolv, n max, eps, sor, epsisl, nmisl, rnu81 NAMELIST/namsol/ nsolv, nsol_arp, nmin, nmax, nmod, eps, sor, epsisl, nmisl, rnu 82 82 !!---------------------------------------------------------------------- 83 83 … … 110 110 111 111 IF(lwp) THEN 112 WRITE(numout,*) ' type of elliptic solver nsolv = ', nsolv 113 WRITE(numout,*) ' maximum iterations for solver nmax = ', nmax 114 WRITE(numout,*) ' absolute precision of solver eps = ', eps 115 WRITE(numout,*) ' optimal coefficient of sor sor = ', sor 116 IF(lk_isl) WRITE(numout,*) ' absolute precision stream fct epsisl = ', epsisl 117 IF(lk_isl) WRITE(numout,*) ' maximum pcg iterations island nmisl = ', nmisl 112 WRITE(numout,*) ' type of elliptic solver nsolv = ', nsolv 113 WRITE(numout,*) ' absolute/relative (1/0) precision nsol_arp = ', nsol_arp 114 WRITE(numout,*) ' minimum iterations for solver nmin = ', nmin 115 WRITE(numout,*) ' maximum iterations for solver nmax = ', nmax 116 WRITE(numout,*) ' frequency for test nmod = ', nmod 117 WRITE(numout,*) ' absolute precision of solver eps = ', eps 118 WRITE(numout,*) ' optimal coefficient of sor sor = ', sor 119 IF(lk_isl) WRITE(numout,*) ' absolute precision stream fct epsisl = ', epsisl 120 IF(lk_isl) WRITE(numout,*) ' maximum pcg iterations island nmisl = ', nmisl 118 121 WRITE(numout,*) ' free surface parameter rnu = ', rnu 119 122 WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.
