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.
sbc_oce_tam.F90 in branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/SBC – NEMO

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/SBC/sbc_oce_tam.F90 @ 2587

Last change on this file since 2587 was 2587, checked in by vidard, 13 years ago

refer to ticket #798
File size: 14.2 KB
Line 
1MODULE sbc_oce_tam
2   !!----------------------------------------------------------------------
3   !!    This software is governed by the CeCILL licence (Version 2)
4   !!----------------------------------------------------------------------
5#if defined key_tam
6   !!======================================================================
7   !!                       ***  MODULE  sbc_oce_tam  ***
8   !! Surface module :   variables defined in core memory
9   !!                    Tangent and Adjoint Module
10   !!======================================================================
11   !! History of the direct module:
12   !!            9.0   !  06-06  (G. Madec)  Original code
13   !! History of the TAM module:
14   !!            9.0   !  08-11  (A. Vidard)  Original code
15   !!            9.0   !  09-03  (A. Weaver)  Allocate/initialization routine
16   !!----------------------------------------------------------------------
17   USE par_kind, ONLY : &       ! Precision variables
18      & wp
19   USE par_oce, ONLY : &        ! Ocean space and time domain variables
20      & jpi,   &
21      & jpj
22
23   IMPLICIT NONE
24
25   !! * Routine accessibility
26   PRIVATE
27
28   PUBLIC &
29      & sbc_oce_tam_init, & !: Initialize the TAM fields
30      & sbc_oce_tam_deallocate, & !: Deallocate the TAM fields
31   !!----------------------------------------------------------------------
32   !!              Ocean Surface Boundary Condition fields
33   !!----------------------------------------------------------------------
34      & utau_tl, & !: Tangent linear of sea surface i-stress (ocean referential)     [N/m2]
35      & vtau_tl, & !: Tangent linear of sea surface j-stress (ocean referential)     [N/m2]
36      & wndm_tl, & !: Tangent linear of wind speed module at T-point (=|U10m-Uoce|)  [m/s
37      & qns_tl,  & !: Tangent linear of sea heat flux: non solar                     [W/m2]
38      & qsr_tl,  & !: Tangent linear of sea heat flux:     solar                     [W/m2]
39      & emp_tl,  & !: Tangent linear of freshwater budget: volume flux               [Kg/m2/s]
40      & emps_tl, & !: Tangent linear of freshwater budget: concentration/dillution   [Kg/m2/s]
41      & fr_i_tl, & !: Tangent linear of ice fraction  (between 0 to 1)               -
42                   !
43      & utau_ad, & !: Adjoint of sea surface i-stress (ocean referential)     [N/m2]
44      & vtau_ad, & !: Adjoint of sea surface j-stress (ocean referential)     [N/m2]
45      & wndm_ad, & !: Adjoint of wind speed module at T-point (=|U10m-Uoce|)  [m/s]
46      & qns_ad,  & !: Adjoint of sea heat flux: non solar                     [W/m2
47      & qsr_ad,  & !: Adjoint of sea heat flux:     solar                     [W/m2]
48      & emp_ad,  & !: Adjoint of freshwater budget: volume flux               [Kg/m2/s]
49      & emps_ad, & !: Adjoint of freshwater budget: concentration/dillution   [Kg/m2/s]
50      & fr_i_ad, & !: Adjoint of ice fraction  (between 0 to 1)               -
51   !!----------------------------------------------------------------------
52   !!                     Sea Surface Mean fields
53   !!----------------------------------------------------------------------
54      & ssu_m_tl, & !: Tangent linear of mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
55      & ssv_m_tl, & !: Tangent linear of mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
56      & sst_m_tl, & !: Tangent linear of mean (nn_fsbc time-step) surface sea temperature     [Celsius]
57      & sss_m_tl, & !: Tangent linear of mean (nn_fsbc time-step) surface sea salinity            [psu]
58                    !
59      & ssu_m_ad, & !: Adjoint of mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
60      & ssv_m_ad, & !: Adjoint of mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
61      & sst_m_ad, & !: Adjoint of mean (nn_fsbc time-step) surface sea temperature     [Celsius]
62      & sss_m_ad    !: Adjoint of mean (nn_fsbc time-step) surface sea salinity            [psu]
63
64   !!----------------------------------------------------------------------
65   !!              Ocean Surface Boundary Condition fields
66   !!----------------------------------------------------------------------
67   REAL(wp),  DIMENSION(:,:), ALLOCATABLE :: &
68      & utau_tl, & !: Tangent linear of sea surface i-stress (ocean referential)     [N/m2]
69      & vtau_tl, & !: Tangent linear of sea surface j-stress (ocean referential)     [N/m2]
70      & wndm_tl, & !: Tangent linear of wind speed module at T-point (=|U10m-Uoce|)  [m/s
71      & qns_tl,  & !: Tangent linear of sea heat flux: non solar                     [W/m2]
72      & qsr_tl,  & !: Tangent linear of sea heat flux:     solar                     [W/m2]
73      & emp_tl,  & !: Tangent linear of freshwater budget: volume flux               [Kg/m2/s]
74      & emps_tl, & !: Tangent linear of freshwater budget: concentration/dillution   [Kg/m2/s]
75      & fr_i_tl    !: Tangent linear of ice fraction  (between 0 to 1)               -
76
77   REAL(wp),  DIMENSION(:,:), ALLOCATABLE :: &
78      & utau_ad, & !: Adjoint of sea surface i-stress (ocean referential)     [N/m2]
79      & vtau_ad, & !: Adjoint of sea surface j-stress (ocean referential)     [N/m2]
80      & wndm_ad, & !: Adjoint of wind speed module at T-point (=|U10m-Uoce|)  [m/s]
81      & qns_ad,  & !: Adjoint of sea heat flux: non solar                     [W/m2
82      & qsr_ad,  & !: Adjoint of sea heat flux:     solar                     [W/m2]
83      & emp_ad,  & !: Adjoint of freshwater budget: volume flux               [Kg/m2/s]
84      & emps_ad, & !: Adjoint of freshwater budget: concentration/dillution   [Kg/m2/s]
85      & fr_i_ad    !: Adjoint of ice fraction  (between 0 to 1)               -
86
87   !!----------------------------------------------------------------------
88   !!                     Sea Surface Mean fields
89   !!----------------------------------------------------------------------
90   REAL(wp),  DIMENSION(:,:), ALLOCATABLE :: &
91      & ssu_m_tl, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
92      & ssv_m_tl, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
93      & sst_m_tl, & !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
94      & sss_m_tl    !: mean (nn_fsbc time-step) surface sea salinity            [psu]
95                   
96   REAL(wp),  DIMENSION(:,:), ALLOCATABLE :: &
97      & ssu_m_ad, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
98      & ssv_m_ad, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
99      & sst_m_ad, & !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
100      & sss_m_ad    !: mean (nn_fsbc time-step) surface sea salinity            [psu]
101
102CONTAINS
103
104   SUBROUTINE sbc_oce_tam_init( kindic )
105      !!-----------------------------------------------------------------------
106      !!
107      !!                  ***  ROUTINE sbc_oce_tam_init  ***
108      !!
109      !! ** Purpose : Allocate and initialize the tangent linear and
110      !!              adjoint arrays
111      !!
112      !! ** Method  : kindic = 0  allocate/initialize both tl and ad variables
113      !!              kindic = 1  allocate/initialize only tl variables
114      !!              kindic = 2  allocate/initialize only ad variables
115      !!
116      !! ** Action  :
117      !!                   
118      !! References :
119      !!
120      !! History :
121      !!        ! 09-03 (A. Weaver) Initial version (based on oce_tam_init)
122      !!-----------------------------------------------------------------------
123      !! * Arguments
124      INTEGER, INTENT(IN) :: &
125         & kindic        ! indicate which variables to allocate/initialize
126
127      !! * Local declarations
128     
129      ! Allocate tangent linear variable arrays
130      ! ---------------------------------------
131     
132      IF ( kindic == 0 .OR. kindic == 1 ) THEN
133
134         IF ( .NOT. ALLOCATED(utau_tl) ) THEN
135
136            ALLOCATE( utau_tl(jpi,jpj) )
137           
138         ENDIF
139         IF ( .NOT. ALLOCATED(vtau_tl) ) THEN
140
141            ALLOCATE( vtau_tl(jpi,jpj) )
142           
143         ENDIF
144         IF ( .NOT. ALLOCATED(wndm_tl) ) THEN
145
146            ALLOCATE( wndm_tl(jpi,jpj) )
147           
148         ENDIF
149         IF ( .NOT. ALLOCATED(qns_tl) ) THEN
150
151            ALLOCATE( qns_tl(jpi,jpj) )
152           
153         ENDIF
154         IF ( .NOT. ALLOCATED(qsr_tl) ) THEN
155
156            ALLOCATE( qsr_tl(jpi,jpj) )
157           
158         ENDIF
159         IF ( .NOT. ALLOCATED(emp_tl) ) THEN
160
161            ALLOCATE( emp_tl(jpi,jpj) )
162           
163         ENDIF
164         IF ( .NOT. ALLOCATED(emps_tl) ) THEN
165
166            ALLOCATE( emps_tl(jpi,jpj) )
167           
168         ENDIF
169         IF ( .NOT. ALLOCATED(fr_i_tl) ) THEN
170
171            ALLOCATE( fr_i_tl(jpi,jpj) )
172           
173         ENDIF
174         IF ( .NOT. ALLOCATED(ssu_m_tl) ) THEN
175
176            ALLOCATE( ssu_m_tl(jpi,jpj) )
177           
178         ENDIF
179         IF ( .NOT. ALLOCATED(ssv_m_tl) ) THEN
180
181            ALLOCATE( ssv_m_tl(jpi,jpj) )
182           
183         ENDIF
184         IF ( .NOT. ALLOCATED(sst_m_tl) ) THEN
185
186            ALLOCATE( sst_m_tl(jpi,jpj) )
187           
188         ENDIF
189         IF ( .NOT. ALLOCATED(sss_m_tl) ) THEN
190
191            ALLOCATE( sss_m_tl(jpi,jpj) )
192           
193         ENDIF
194
195         ! Initialize tangent linear variable arrays to zero
196         ! -------------------------------------------------
197
198         utau_tl (:,:) = 0.0_wp
199         vtau_tl (:,:) = 0.0_wp
200         wndm_tl (:,:) = 0.0_wp
201         qns_tl  (:,:) = 0.0_wp
202         qsr_tl  (:,:) = 0.0_wp
203         emp_tl  (:,:) = 0.0_wp
204         emps_tl (:,:) = 0.0_wp
205         fr_i_tl (:,:) = 0.0_wp
206         ssu_m_tl(:,:) = 0.0_wp
207         ssv_m_tl(:,:) = 0.0_wp
208         sst_m_tl(:,:) = 0.0_wp
209         sss_m_tl(:,:) = 0.0_wp
210
211      ENDIF
212
213      IF ( kindic == 0 .OR. kindic == 2 ) THEN
214
215         ! Allocate adjoint variable arrays
216         ! --------------------------------
217     
218         IF ( .NOT. ALLOCATED(utau_ad) ) THEN
219
220            ALLOCATE( utau_ad(jpi,jpj) )
221           
222         ENDIF
223         IF ( .NOT. ALLOCATED(vtau_ad) ) THEN
224
225            ALLOCATE( vtau_ad(jpi,jpj) )
226           
227         ENDIF
228         IF ( .NOT. ALLOCATED(wndm_ad) ) THEN
229
230            ALLOCATE( wndm_ad(jpi,jpj) )
231           
232         ENDIF
233         IF ( .NOT. ALLOCATED(qns_ad) ) THEN
234
235            ALLOCATE( qns_ad(jpi,jpj) )
236           
237         ENDIF
238         IF ( .NOT. ALLOCATED(qsr_ad) ) THEN
239
240            ALLOCATE( qsr_ad(jpi,jpj) )
241           
242         ENDIF
243         IF ( .NOT. ALLOCATED(emp_ad) ) THEN
244
245            ALLOCATE( emp_ad(jpi,jpj) )
246           
247         ENDIF
248         IF ( .NOT. ALLOCATED(emps_ad) ) THEN
249
250            ALLOCATE( emps_ad(jpi,jpj) )
251           
252         ENDIF
253         IF ( .NOT. ALLOCATED(fr_i_ad) ) THEN
254
255            ALLOCATE( fr_i_ad(jpi,jpj) )
256           
257         ENDIF
258         IF ( .NOT. ALLOCATED(ssu_m_ad) ) THEN
259
260            ALLOCATE( ssu_m_ad(jpi,jpj) )
261           
262         ENDIF
263         IF ( .NOT. ALLOCATED(ssv_m_ad) ) THEN
264
265            ALLOCATE( ssv_m_ad(jpi,jpj) )
266           
267         ENDIF
268         IF ( .NOT. ALLOCATED(sst_m_ad) ) THEN
269
270            ALLOCATE( sst_m_ad(jpi,jpj) )
271           
272         ENDIF
273         IF ( .NOT. ALLOCATED(sss_m_ad) ) THEN
274
275            ALLOCATE( sss_m_ad(jpi,jpj) )
276           
277         ENDIF
278
279         ! Initialize adjoint variable arrays to zero
280         ! ------------------------------------------
281
282         utau_ad (:,:) = 0.0_wp
283         vtau_ad (:,:) = 0.0_wp
284         wndm_ad (:,:) = 0.0_wp
285         qns_ad  (:,:) = 0.0_wp
286         qsr_ad  (:,:) = 0.0_wp
287         emp_ad  (:,:) = 0.0_wp
288         emps_ad (:,:) = 0.0_wp
289         fr_i_ad (:,:) = 0.0_wp
290         ssu_m_ad(:,:) = 0.0_wp
291         ssv_m_ad(:,:) = 0.0_wp
292         sst_m_ad(:,:) = 0.0_wp
293         sss_m_ad(:,:) = 0.0_wp
294
295      ENDIF
296
297   END SUBROUTINE sbc_oce_tam_init
298   SUBROUTINE sbc_oce_tam_deallocate( kindic )
299      !!-----------------------------------------------------------------------
300      !!
301      !!                  ***  ROUTINE sbc_oce_tam_init  ***
302      !!
303      !! ** Purpose : Allocate and initialize the tangent linear and
304      !!              adjoint arrays
305      !!
306      !! ** Method  : kindic = 0  deallocate both tl and ad variables
307      !!              kindic = 1  deallocate only tl variables
308      !!              kindic = 2  deallocate only ad variables
309      !!
310      !! ** Action  :
311      !!                   
312      !! References :
313      !!
314      !! History :
315      !!        ! 2010-06 (A. Vidard) Initial version
316      !!-----------------------------------------------------------------------
317      !! * Arguments
318      INTEGER, INTENT(IN) :: &
319         & kindic        ! indicate which variables to deallocate
320
321      !! * Local declarations
322     
323      ! Deallocate tangent linear variable arrays
324      ! ---------------------------------------
325     
326      IF ( kindic == 0 .OR. kindic == 1 ) THEN
327
328         IF ( ALLOCATED(utau_tl) )    DEALLOCATE( utau_tl )
329         IF ( ALLOCATED(vtau_tl) )    DEALLOCATE( vtau_tl )
330         IF ( ALLOCATED(wndm_tl) )    DEALLOCATE( wndm_tl )
331         IF ( ALLOCATED(qns_tl) )     DEALLOCATE( qns_tl )
332         IF ( ALLOCATED(qsr_tl) )     DEALLOCATE( qsr_tl )
333         IF ( ALLOCATED(emp_tl) )     DEALLOCATE( emp_tl )
334         IF ( ALLOCATED(emps_tl) )    DEALLOCATE( emps_tl )
335         IF ( ALLOCATED(fr_i_tl) )    DEALLOCATE( fr_i_tl )
336         IF ( ALLOCATED(ssu_m_tl) )   DEALLOCATE( ssu_m_tl )
337         IF ( ALLOCATED(ssv_m_tl) )   DEALLOCATE( ssv_m_tl )
338         IF ( ALLOCATED(sst_m_tl) )   DEALLOCATE( sst_m_tl )
339         IF ( ALLOCATED(sss_m_tl) )   DEALLOCATE( sss_m_tl )
340
341
342      ENDIF
343
344      IF ( kindic == 0 .OR. kindic == 2 ) THEN
345
346         ! Deallocate adjoint variable arrays
347         ! --------------------------------
348     
349         IF ( ALLOCATED(utau_ad) )    DEALLOCATE( utau_ad )
350         IF ( ALLOCATED(vtau_ad) )    DEALLOCATE( vtau_ad )
351         IF ( ALLOCATED(wndm_ad) )    DEALLOCATE( wndm_ad )
352         IF ( ALLOCATED(qns_ad) )     DEALLOCATE( qns_ad )
353         IF ( ALLOCATED(qsr_ad) )     DEALLOCATE( qsr_ad )
354         IF ( ALLOCATED(emp_ad) )     DEALLOCATE( emp_ad )
355         IF ( ALLOCATED(emps_ad) )    DEALLOCATE( emps_ad )
356         IF ( ALLOCATED(fr_i_ad) )    DEALLOCATE( fr_i_ad )
357         IF ( ALLOCATED(ssu_m_ad) )   DEALLOCATE( ssu_m_ad )
358         IF ( ALLOCATED(ssv_m_ad) )   DEALLOCATE( ssv_m_ad )
359         IF ( ALLOCATED(sst_m_ad) )   DEALLOCATE( sst_m_ad )
360         IF ( ALLOCATED(sss_m_ad) )   DEALLOCATE( sss_m_ad )
361         
362      ENDIF
363
364   END SUBROUTINE sbc_oce_tam_deallocate
365#endif
366
367END MODULE sbc_oce_tam
Note: See TracBrowser for help on using the repository browser.