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.
solver.F90 in branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SOL – NEMO

source: branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/SOL/solver.F90 @ 1976

Last change on this file since 1976 was 1976, checked in by acc, 14 years ago

ticket #684 step 6: Add in changes between the head of the DEV_r1879_mpp_rep branch and the trunk@1879.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 6.0 KB
Line 
1MODULE solver
2   !!======================================================================
3   !!                     ***  MODULE  solver  ***
4   !! Ocean solver :  initialization of ocean solver
5   !!=====================================================================
6   !! History :  OPA  ! 1990-10  (G. Madec)  Original code           
7   !!                 ! 1993-02  (O. Marti)                         
8   !!                 ! 1997-02  (G. Madec)  local depth inverse computation
9   !!                 ! 1998-10  (G. Roullet, G. Madec)  free surface
10   !!   NEMO     1.0  ! 2003-07  (G. Madec)  free form, F90
11   !!            3.2  ! 2009-07  (R. Benshila) suppression of rigid-lid & FETI solver
12   !!----------------------------------------------------------------------
13#if defined key_dynspg_flt   ||   defined key_esopa 
14   !!----------------------------------------------------------------------
15   !!   'key_dynspg_flt'                              filtered free surface
16   !!----------------------------------------------------------------------
17   !!   solver_init: solver initialization
18   !!----------------------------------------------------------------------
19   USE oce             ! ocean dynamics and tracers variables
20   USE dom_oce         ! ocean space and time domain variables
21   USE zdf_oce         ! ocean vertical physics variables
22   USE sol_oce         ! solver variables
23   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
24   USE solmat          ! matrix of the solver
25   USE obc_oce         ! Lateral open boundary condition
26   USE in_out_manager  ! I/O manager
27   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
28   USE lib_mpp
29
30   IMPLICIT NONE
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009)
34   !! $Id$
35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37
38CONTAINS
39
40   SUBROUTINE solver_init( kt )
41      !!----------------------------------------------------------------------
42      !!                  ***  ROUTINE solver_init  ***
43      !!                   
44      !! ** Purpose :   Initialization of the elliptic solver
45      !!     
46      !! ** Method  :   a solver is required when using the filtered free
47      !!              surface.
48      !!
49      !! ** Action  : - c_solver_pt : nature of the gridpoint at which the solver is applied
50      !!
51      !! References : Jensen, 1986: Adv. Phys. Oceanogr. Num. Mod.,Ed. O Brien,87-110.
52      !!----------------------------------------------------------------------
53      INTEGER, INTENT(in) :: kt
54      !!
55      NAMELIST/namsol/ nn_solv, nn_sol_arp, nn_nmin, nn_nmax, nn_nmod, rn_eps, rn_resmax, rn_sor
56      !!----------------------------------------------------------------------
57
58      IF(lwp) THEN                  !* open elliptic solver statistics file (only on the printing processors)
59         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
60      ENDIF
61
62      REWIND( numnam )              !* Namelist namsol : elliptic solver / free surface
63      READ  ( numnam, namsol )
64
65      IF(lwp) THEN                  !* Control print
66         WRITE(numout,*)
67         WRITE(numout,*) 'solver_init : solver to compute the surface pressure gradient'
68         WRITE(numout,*) '~~~~~~~~~~~'
69         WRITE(numout,*) '   Namelist namsol : set solver parameters'
70         WRITE(numout,*) '      type of elliptic solver            nn_solv    = ', nn_solv
71         WRITE(numout,*) '      absolute/relative (0/1) precision  nn_sol_arp = ', nn_sol_arp
72         WRITE(numout,*) '      minimum iterations for solver      nn_nmin    = ', nn_nmin
73         WRITE(numout,*) '      maximum iterations for solver      nn_nmax    = ', nn_nmax
74         WRITE(numout,*) '      frequency for test                 nn_nmod    = ', nn_nmod
75         WRITE(numout,*) '      absolute precision of solver       rn_eps     = ', rn_eps
76         WRITE(numout,*) '      absolute precision for SOR solver  rn_resmax  = ', rn_resmax
77         WRITE(numout,*) '      optimal coefficient of sor         rn_sor     = ', rn_sor
78         WRITE(numout,*)
79      ENDIF
80      eps = rn_eps
81
82      SELECT CASE( nn_solv )          !* parameter check
83      !
84      CASE ( 1 )                          ! preconditioned conjugate gradient solver
85         IF(lwp) WRITE(numout,*) '   a preconditioned conjugate gradient solver is used'
86         IF( jpr2di /= 0 .AND. jpr2dj /= 0 )   CALL ctl_stop( ' jpr2di and jpr2dj should be equal to zero' )
87         !
88      CASE ( 2 )                          ! successive-over-relaxation solver
89         IF(lwp) WRITE(numout,*) '   a successive-over-relaxation solver with extra outer halo is used'
90         IF(lwp) WRITE(numout,*) '   with jpr2di =', jpr2di, ' and  jpr2dj =', jpr2dj
91         IF( .NOT. lk_mpp .AND. jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN
92             CALL ctl_stop( 'jpr2di and jpr2dj are not equal to zero',   &
93             &              'In this case the algorithm should be used only with the key_mpp_... option' )
94         ELSE
95            IF( ( ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) .OR. ( jpni /= 1 ) ) &
96              &  .AND. ( jpr2di /= jpr2dj ) )   CALL ctl_stop( 'jpr2di should be equal to jpr2dj' )
97         ENDIF
98         !
99      CASE DEFAULT                        ! error in parameter
100         WRITE(ctmp1,*) '          bad flag value for nn_solv = ', nn_solv
101         CALL ctl_stop( ctmp1 )
102      END SELECT
103      !
104
105      !                             !* Grid-point at which the solver is applied
106!!gm  c_solver_pt should be removed: nomore bsf, only T-point is used
107      IF( lk_mpp ) THEN   ;    c_solver_pt = 'S'   ! S=T with special staff ??? which one?
108      ELSE                ;    c_solver_pt = 'T'
109      ENDIF
110
111      CALL sol_mat( kt )            !* Construction of the elliptic system matrix
112      !
113   END SUBROUTINE solver_init
114#endif
115
116   !!======================================================================
117END MODULE solver
Note: See TracBrowser for help on using the repository browser.