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.
sol_oce_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SOL – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SOL/sol_oce_tam.F90 @ 3611

Last change on this file since 3611 was 3611, checked in by pabouttier, 11 years ago

Add TAM code and ORCA2_TAM configuration - see Ticket #1007
  • Property svn:executable set to *
File size: 6.8 KB
Line 
1MODULE sol_oce_tam
2   !!======================================================================
3   !!                    ***  MODULE  sol_oce_tam  ***
4   !! NEMOVAR : variables controlling the solver for tangent and adjoint models
5   !!======================================================================
6   !! History of the direct module:
7   !!            1.0  ! 2002-11  (G. Madec)  F90: Free form and module
8   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
9   !! History of the TAM module:
10   !!            9.0  !  09-03  (A. Weaver) original version
11   !!       NEMO 3.4  ! 2012-04 (P.-A. Bouttier) update
12   !!       NEMO 3.4  ! 2012-09 (A. Vidard) Deallocating and initialising options
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   sol_oce_alloc : allocate the solver arrays
17   !!----------------------------------------------------------------------
18   USE par_oce        ! ocean parameters
19   USE in_out_manager ! I/O manager
20   USE lib_mpp        ! distributed memory computing
21   USE sol_oce
22#if defined key_dynspg_flt
23   USE solver
24#endif
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC                  &
30      & sol_oce_alloc_tam,   &
31      & sol_oce_dealloc_tam, &
32      & sol_oce_tam_init
33
34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcx_tl, gcx_ad   !: TA of now solution of the elliptic eq.
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcxb_tl, gcxb_ad !: TA of before solution of the elliptic eq.
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcb_tl, gcb_ad   !: TA of second member of the elliptic eq.
37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcr_tl           !: Tangent of residu =b-a.x
38   INTEGER,  PUBLIC, DIMENSION(:), SAVE, ALLOCATABLE :: nitsor          ! Number of SOR iterations
39   LOGICAL, PRIVATE, SAVE :: ll_alloctl = .FALSE., ll_allocad = .FALSE.
40
41   !!----------------------------------------------------------------------
42   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
43   !! $Id$
44   !! Software governed by the CeCILL licence    (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47   INTEGER FUNCTION sol_oce_alloc_tam( kmode )
48      !!----------------------------------------------------------------------
49      !!                ***  FUNCTION sol_oce_alloc  ***
50      !!----------------------------------------------------------------------
51      INTEGER, OPTIONAL :: kmode
52      INTEGER  :: ierr(3)
53      INTEGER :: imode
54      !!----------------------------------------------------------------------
55      IF ( PRESENT(kmode) ) THEN
56         imode = kmode
57      ELSE
58         imode = 0
59      END IF
60      ierr(:) = 0
61      !
62      IF ( .NOT. ALLOCATED(nitsor) ) THEN
63      ALLOCATE( nitsor(nitend - nit000 - 1) , STAT=ierr(1) )
64      nitsor(:) = nn_nmin
65      END IF
66      IF ( ( imode == 0 ) .OR. ( imode == 1 ) .AND. ( .NOT. ll_alloctl ) ) THEN
67      ALLOCATE( gcx_tl (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ,     &
68         &      gcxb_tl(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ,     &
69         &      gcb_tl (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ,     &
70         &      gcr_tl (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   , STAT=ierr(2) )
71         ll_alloctl = .TRUE.
72      END IF
73      IF ( ( imode == 0 ) .OR. ( imode == 2 ) .AND. ( .NOT. ll_allocad ) ) THEN
74      ALLOCATE( gcx_ad (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ,     &
75         &      gcxb_ad(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ,     &
76         &      gcb_ad (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   , STAT=ierr(3) )
77         ll_allocad = .TRUE.
78      END IF
79         !
80      sol_oce_alloc_tam = MAXVAL(ierr)
81      !
82      IF( lk_mpp            )   CALL mpp_sum ( sol_oce_alloc_tam )
83      IF( sol_oce_alloc_tam > 0 )   CALL ctl_warn('sol_oce_alloc_tam: allocation of arrays failed')
84      !
85   END FUNCTION sol_oce_alloc_tam
86   !
87   INTEGER FUNCTION sol_oce_dealloc_tam( kmode )
88      !!----------------------------------------------------------------------
89      !!                ***  FUNCTION sol_oce_dealloc  ***
90      !!----------------------------------------------------------------------
91      INTEGER, OPTIONAL :: kmode
92      INTEGER  :: ierr(3)
93      INTEGER :: imode
94      !!----------------------------------------------------------------------
95      IF ( PRESENT(kmode) ) THEN
96         imode = kmode
97      ELSE
98         imode = 0
99      END IF
100
101      ierr(:) = 0
102      !
103
104      IF ( ( imode == 0 ) .OR. ( imode == 1 ) .AND. ( ll_alloctl ) ) THEN
105         DEALLOCATE( gcx_tl ,     &
106              &      gcxb_tl,     &
107              &      gcb_tl ,     &
108              &      gcr_tl , STAT=ierr(2) )
109         ll_alloctl = .FALSE.
110      END IF
111      IF ( ( imode == 0 ) .OR. ( imode == 2 ) .AND. ( ll_allocad ) ) THEN
112         DEALLOCATE( gcx_ad  ,     &
113            &        gcxb_ad ,     &
114            &        gcb_ad  , STAT=ierr(3) )
115         ll_allocad = .FALSE.
116      END IF
117         !
118      sol_oce_dealloc_tam = MAXVAL(ierr)
119      !
120      IF( lk_mpp                  )   CALL mpp_sum ( sol_oce_dealloc_tam )
121      IF( sol_oce_dealloc_tam > 0 )   CALL ctl_warn('sol_oce_dealloc_tam: allocation of arrays failed')
122      !
123   END FUNCTION sol_oce_dealloc_tam
124   !
125   SUBROUTINE sol_oce_tam_init( kmode )
126      !!-----------------------------------------------------------------------
127      !!
128      !!                  ***  ROUTINE sol_oce_tam_init  ***
129      !!
130      !! ** Purpose : Allocate and initialize the tangent linear and
131      !!              adjoint arrays
132      !!
133      !! ** Method  : kindic = 0  allocate/initialize both tl and ad variables
134      !!              kindic = 1  allocate/initialize only tl variables
135      !!              kindic = 2  allocate/initialize only ad variables
136      !!
137      !! ** Action  :
138      !!
139      !! References :
140      !!
141      !! History :
142      !!        ! 2009-03 (A. Weaver) Initial version (based on oce_tam_init)
143      !!        ! 2010-04 (A. Vidard) Nemo3.2 update
144      !!        ! 2012-09 (A. Vidard) Nemo3.4 update
145      !!-----------------------------------------------------------------------
146      !! * Arguments
147      INTEGER, INTENT(IN) :: kmode
148      INTEGER :: ierr
149      IF ( ( kmode == 0 ) .OR. ( kmode == 1 ) ) THEN
150         IF ( .NOT. ll_alloctl ) ierr = sol_oce_alloc_tam ( 1 )
151         gcx_tl (:,:) = 0.0_wp
152         gcxb_tl(:,:) = 0.0_wp
153         gcb_tl (:,:) = 0.0_wp
154         gcr_tl (:,:) = 0.0_wp
155      END IF
156      IF ( ( kmode == 0 ) .OR. ( kmode == 2 ) ) THEN
157         IF ( .NOT. ll_allocad ) ierr = sol_oce_alloc_tam ( 2 )
158         gcx_ad (:,:) = 0.0_wp
159         gcxb_ad(:,:) = 0.0_wp
160         gcb_ad (:,:) = 0.0_wp
161      END IF
162   END SUBROUTINE sol_oce_tam_init
163   !!======================================================================
164
165END MODULE sol_oce_tam
Note: See TracBrowser for help on using the repository browser.