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_2_2/NEMOTAM/OPATAM_SRC/SBC – NEMO

source: branches/TAM_V3_2_2/NEMOTAM/OPATAM_SRC/SBC/sbc_oce_tam.F90 @ 3032

Last change on this file since 3032 was 2578, checked in by rblod, 13 years ago

first import of NEMOTAM 3.2.2
File size: 14.6 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   !!            3.0   !  2006-06  (G. Madec)  Original code
13   !!             -    !  2008-08  (G. Madec)  namsbc moved from sbcmod
14   !! History of the TAM module:
15   !!            3.0   !  2008-11  (A. Vidard)  Original code
16   !!            3.0   !  2009-03  (A. Weaver)  Allocate/initialization routine
17   !!            3.2   !  2010-04  (A. Vidard)  3.2 update
18   !!----------------------------------------------------------------------
19   USE par_kind, ONLY : &       ! Precision variables
20      & wp
21   USE par_oce, ONLY : &        ! Ocean space and time domain variables
22      & jpi,   &
23      & jpj
24
25   IMPLICIT NONE
26
27   !! * Routine accessibility
28   PRIVATE
29
30   PUBLIC &
31      & sbc_oce_tam_init,      & !: Initialize the TAM fields
32      & sbc_oce_tam_deallocate   !: Initialize the TAM fields
33
34   !!----------------------------------------------------------------------
35   !!              Ocean Surface Boundary Condition fields
36   !!----------------------------------------------------------------------
37   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
38      & utau_tl, & !: Tangent linear of sea surface i-stress (ocean referential)     [N/m2]
39      & vtau_tl, & !: Tangent linear of sea surface j-stress (ocean referential)     [N/m2]
40      & taum_tl, & !: Tangent linear of module of sea surface stress (at T-point)    [N/m2]
41      & wndm_tl, & !: Tangent linear of wind speed module at T-point (=|U10m-Uoce|)  [m/s
42      & qns_tl,  & !: Tangent linear of sea heat flux: non solar                     [W/m2]
43      & qsr_tl,  & !: Tangent linear of sea heat flux:     solar                     [W/m2]
44      & qns_tot_tl,  & !: Tangent linear of total sea heat flux: non solar                     [W/m2]
45      & qsr_tot_tl,  & !: Tangent linear of total sea heat flux:     solar                     [W/m2]
46      & emp_tl,  & !: Tangent linear of freshwater budget: volume flux               [Kg/m2/s]
47      & emps_tl, & !: Tangent linear of freshwater budget: concentration/dillution   [Kg/m2/s]
48      & fr_i_tl    !: Tangent linear of ice fraction  (between 0 to 1)               -
49#if defined key_cpl_carbon_cycle
50   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2_tl   !: tangent of atmospheric pCO2                             [ppm]
51#endif
52
53   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
54      & utau_ad, & !: Adjoint of sea surface i-stress (ocean referential)     [N/m2]
55      & vtau_ad, & !: Adjoint of sea surface j-stress (ocean referential)     [N/m2]
56      & taum_ad, & !: Adjoint of module of sea surface stress (at T-point)    [N/m2]
57      & wndm_ad, & !: Adjoint of wind speed module at T-point (=|U10m-Uoce|)  [m/s]
58      & qns_ad,  & !: Adjoint of sea heat flux: non solar                     [W/m2
59      & qsr_ad,  & !: Adjoint of sea heat flux:     solar                     [W/m2]
60      & qns_tot_ad,  & !: Adjoint of total sea heat flux: non solar                     [W/m2
61      & qsr_tot_ad,  & !: Adjoint of total sea heat flux:     solar                     [W/m2]
62      & emp_ad,  & !: Adjoint of freshwater budget: volume flux               [Kg/m2/s]
63      & emps_ad, & !: Adjoint of freshwater budget: concentration/dillution   [Kg/m2/s]
64      & fr_i_ad    !: Adjoint of ice fraction  (between 0 to 1)               -
65#if defined key_cpl_carbon_cycle
66   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2_ad   !: adjoint of atmospheric pCO2                             [ppm]
67#endif
68
69   !!----------------------------------------------------------------------
70   !!                     Sea Surface Mean fields
71   !!----------------------------------------------------------------------
72   REAL(wp), PUBLIC,  DIMENSION(:,:), ALLOCATABLE :: &
73      & ssu_m_tl, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
74      & ssv_m_tl, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
75      & sst_m_tl, & !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
76      & sss_m_tl, & !: mean (nn_fsbc time-step) surface sea salinity            [psu]
77      & ssh_m_tl    !: mean (nn_fsbc time-step) surface sea height                [m]
78                   
79   REAL(wp), PUBLIC,  DIMENSION(:,:), ALLOCATABLE :: &
80      & ssu_m_ad, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
81      & ssv_m_ad, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
82      & sst_m_ad, & !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
83      & sss_m_ad, & !: mean (nn_fsbc time-step) surface sea salinity            [psu]
84      & ssh_m_ad    !: mean (nn_fsbc time-step) surface sea height                [m]
85
86CONTAINS
87
88   SUBROUTINE sbc_oce_tam_init( kindic )
89      !!-----------------------------------------------------------------------
90      !!
91      !!                  ***  ROUTINE sbc_oce_tam_init  ***
92      !!
93      !! ** Purpose : Allocate and initialize the tangent linear and
94      !!              adjoint arrays
95      !!
96      !! ** Method  : kindic = 0  allocate/initialize both tl and ad variables
97      !!              kindic = 1  allocate/initialize only tl variables
98      !!              kindic = 2  allocate/initialize only ad variables
99      !!
100      !! ** Action  :
101      !!                   
102      !! References :
103      !!
104      !! History :
105      !!        ! 2009-03 (A. Weaver) Initial version (based on oce_tam_init)
106      !!        ! 2010-04 (A. Vidard) Nemo3.2 update
107      !!-----------------------------------------------------------------------
108      !! * Arguments
109      INTEGER, INTENT(IN) :: &
110         & kindic        ! indicate which variables to allocate/initialize
111
112      !! * Local declarations
113     
114      ! Allocate tangent linear variable arrays
115      ! ---------------------------------------
116     
117      IF ( kindic == 0 .OR. kindic == 1 ) THEN
118
119         IF ( .NOT. ALLOCATED(utau_tl) ) THEN
120
121            ALLOCATE( utau_tl(jpi,jpj) )
122           
123         ENDIF
124         IF ( .NOT. ALLOCATED(vtau_tl) ) THEN
125
126            ALLOCATE( vtau_tl(jpi,jpj) )
127           
128         ENDIF
129         IF ( .NOT. ALLOCATED(taum_tl) ) THEN
130
131            ALLOCATE( taum_tl(jpi,jpj) )
132           
133         ENDIF
134         IF ( .NOT. ALLOCATED(wndm_tl) ) THEN
135
136            ALLOCATE( wndm_tl(jpi,jpj) )
137           
138         ENDIF
139         IF ( .NOT. ALLOCATED(qns_tl) ) THEN
140
141            ALLOCATE( qns_tl(jpi,jpj) )
142           
143         ENDIF
144         IF ( .NOT. ALLOCATED(qsr_tl) ) THEN
145
146            ALLOCATE( qsr_tl(jpi,jpj) )
147           
148         ENDIF
149         IF ( .NOT. ALLOCATED(qns_tot_tl) ) THEN
150
151            ALLOCATE( qns_tot_tl(jpi,jpj) )
152           
153         ENDIF
154         IF ( .NOT. ALLOCATED(qsr_tot_tl) ) THEN
155
156            ALLOCATE( qsr_tot_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         IF ( .NOT. ALLOCATED(ssh_m_tl) ) THEN
195
196            ALLOCATE( ssh_m_tl(jpi,jpj) )
197           
198         ENDIF
199
200         ! Initialize tangent linear variable arrays to zero
201         ! -------------------------------------------------
202
203         utau_tl (:,:) = 0.0_wp
204         vtau_tl (:,:) = 0.0_wp
205         taum_tl (:,:) = 0.0_wp
206         wndm_tl (:,:) = 0.0_wp
207         qns_tl  (:,:) = 0.0_wp
208         qsr_tl  (:,:) = 0.0_wp
209         qns_tot_tl  (:,:) = 0.0_wp
210         qsr_tot_tl  (:,:) = 0.0_wp
211         emp_tl  (:,:) = 0.0_wp
212         emps_tl (:,:) = 0.0_wp
213         fr_i_tl (:,:) = 0.0_wp
214         ssu_m_tl(:,:) = 0.0_wp
215         ssv_m_tl(:,:) = 0.0_wp
216         sst_m_tl(:,:) = 0.0_wp
217         sss_m_tl(:,:) = 0.0_wp
218         ssh_m_tl(:,:) = 0.0_wp
219
220      ENDIF
221
222      IF ( kindic == 0 .OR. kindic == 2 ) THEN
223
224         ! Allocate adjoint variable arrays
225         ! --------------------------------
226     
227         IF ( .NOT. ALLOCATED(utau_ad) ) THEN
228
229            ALLOCATE( utau_ad(jpi,jpj) )
230           
231         ENDIF
232         IF ( .NOT. ALLOCATED(vtau_ad) ) THEN
233
234            ALLOCATE( vtau_ad(jpi,jpj) )
235           
236         ENDIF
237         IF ( .NOT. ALLOCATED(taum_ad) ) THEN
238
239            ALLOCATE( taum_ad(jpi,jpj) )
240           
241         ENDIF
242         IF ( .NOT. ALLOCATED(wndm_ad) ) THEN
243
244            ALLOCATE( wndm_ad(jpi,jpj) )
245           
246         ENDIF
247         IF ( .NOT. ALLOCATED(qns_ad) ) THEN
248
249            ALLOCATE( qns_ad(jpi,jpj) )
250           
251         ENDIF
252         IF ( .NOT. ALLOCATED(qsr_ad) ) THEN
253
254            ALLOCATE( qsr_ad(jpi,jpj) )
255           
256         ENDIF
257          IF ( .NOT. ALLOCATED(qns_tot_ad) ) THEN
258
259            ALLOCATE( qns_tot_ad(jpi,jpj) )
260           
261         ENDIF
262         IF ( .NOT. ALLOCATED(qsr_tot_ad) ) THEN
263
264            ALLOCATE( qsr_tot_ad(jpi,jpj) )
265           
266         ENDIF
267        IF ( .NOT. ALLOCATED(emp_ad) ) THEN
268
269            ALLOCATE( emp_ad(jpi,jpj) )
270           
271         ENDIF
272         IF ( .NOT. ALLOCATED(emps_ad) ) THEN
273
274            ALLOCATE( emps_ad(jpi,jpj) )
275           
276         ENDIF
277         IF ( .NOT. ALLOCATED(fr_i_ad) ) THEN
278
279            ALLOCATE( fr_i_ad(jpi,jpj) )
280           
281         ENDIF
282         IF ( .NOT. ALLOCATED(ssu_m_ad) ) THEN
283
284            ALLOCATE( ssu_m_ad(jpi,jpj) )
285           
286         ENDIF
287         IF ( .NOT. ALLOCATED(ssv_m_ad) ) THEN
288
289            ALLOCATE( ssv_m_ad(jpi,jpj) )
290           
291         ENDIF
292         IF ( .NOT. ALLOCATED(sst_m_ad) ) THEN
293
294            ALLOCATE( sst_m_ad(jpi,jpj) )
295           
296         ENDIF
297         IF ( .NOT. ALLOCATED(sss_m_ad) ) THEN
298
299            ALLOCATE( sss_m_ad(jpi,jpj) )
300           
301         ENDIF
302         IF ( .NOT. ALLOCATED(ssh_m_ad) ) THEN
303
304            ALLOCATE( ssh_m_ad(jpi,jpj) )
305           
306         ENDIF
307
308         ! Initialize adjoint variable arrays to zero
309         ! ------------------------------------------
310
311         utau_ad (:,:) = 0.0_wp
312         vtau_ad (:,:) = 0.0_wp
313         taum_ad (:,:) = 0.0_wp
314         wndm_ad (:,:) = 0.0_wp
315         qns_ad  (:,:) = 0.0_wp
316         qsr_ad  (:,:) = 0.0_wp
317         qns_tot_ad  (:,:) = 0.0_wp
318         qsr_tot_ad  (:,:) = 0.0_wp
319         emp_ad  (:,:) = 0.0_wp
320         emps_ad (:,:) = 0.0_wp
321         fr_i_ad (:,:) = 0.0_wp
322         ssu_m_ad(:,:) = 0.0_wp
323         ssv_m_ad(:,:) = 0.0_wp
324         sst_m_ad(:,:) = 0.0_wp
325         sss_m_ad(:,:) = 0.0_wp
326         ssh_m_ad(:,:) = 0.0_wp
327
328      ENDIF
329
330   END SUBROUTINE sbc_oce_tam_init
331   SUBROUTINE sbc_oce_tam_deallocate( kindic )
332      !!-----------------------------------------------------------------------
333      !!
334      !!                  ***  ROUTINE sbc_oce_tam_init  ***
335      !!
336      !! ** Purpose : Allocate and initialize the tangent linear and
337      !!              adjoint arrays
338      !!
339      !! ** Method  : kindic = 0  deallocate both tl and ad variables
340      !!              kindic = 1  deallocate only tl variables
341      !!              kindic = 2  deallocate only ad variables
342      !!
343      !! ** Action  :
344      !!                   
345      !! References :
346      !!
347      !! History :
348      !!        ! 2010-06 (A. Vidard) Initial version
349      !!-----------------------------------------------------------------------
350      !! * Arguments
351      INTEGER, INTENT(IN) :: &
352         & kindic        ! indicate which variables to deallocate
353
354      !! * Local declarations
355     
356      ! Deallocate tangent linear variable arrays
357      ! ---------------------------------------
358     
359      IF ( kindic == 0 .OR. kindic == 1 ) THEN
360
361         IF ( ALLOCATED(utau_tl) )    DEALLOCATE( utau_tl )
362         IF ( ALLOCATED(vtau_tl) )    DEALLOCATE( vtau_tl )
363         IF ( ALLOCATED(taum_tl) )    DEALLOCATE( taum_tl )
364         IF ( ALLOCATED(wndm_tl) )    DEALLOCATE( wndm_tl )
365         IF ( ALLOCATED(qns_tl) )     DEALLOCATE( qns_tl )
366         IF ( ALLOCATED(qsr_tl) )     DEALLOCATE( qsr_tl )
367         IF ( ALLOCATED(qns_tot_tl) ) DEALLOCATE( qns_tot_tl )
368         IF ( ALLOCATED(qsr_tot_tl) ) DEALLOCATE( qsr_tot_tl )
369         IF ( ALLOCATED(emp_tl) )     DEALLOCATE( emp_tl )
370         IF ( ALLOCATED(emps_tl) )    DEALLOCATE( emps_tl )
371         IF ( ALLOCATED(fr_i_tl) )    DEALLOCATE( fr_i_tl )
372         IF ( ALLOCATED(ssu_m_tl) )   DEALLOCATE( ssu_m_tl )
373         IF ( ALLOCATED(ssv_m_tl) )   DEALLOCATE( ssv_m_tl )
374         IF ( ALLOCATED(sst_m_tl) )   DEALLOCATE( sst_m_tl )
375         IF ( ALLOCATED(sss_m_tl) )   DEALLOCATE( sss_m_tl )
376         IF ( ALLOCATED(ssh_m_tl) )   DEALLOCATE( ssh_m_tl )
377
378
379      ENDIF
380
381      IF ( kindic == 0 .OR. kindic == 2 ) THEN
382
383         ! Deallocate adjoint variable arrays
384         ! --------------------------------
385     
386         IF ( ALLOCATED(utau_ad) )    DEALLOCATE( utau_ad )
387         IF ( ALLOCATED(vtau_ad) )    DEALLOCATE( vtau_ad )
388         IF ( ALLOCATED(taum_ad) )    DEALLOCATE( taum_ad )
389         IF ( ALLOCATED(wndm_ad) )    DEALLOCATE( wndm_ad )
390         IF ( ALLOCATED(qns_ad) )     DEALLOCATE( qns_ad )
391         IF ( ALLOCATED(qsr_ad) )     DEALLOCATE( qsr_ad )
392         IF ( ALLOCATED(qns_tot_ad) ) DEALLOCATE( qns_tot_ad )
393         IF ( ALLOCATED(qsr_tot_ad) ) DEALLOCATE( qsr_tot_ad )
394         IF ( ALLOCATED(emp_ad) )     DEALLOCATE( emp_ad )
395         IF ( ALLOCATED(emps_ad) )    DEALLOCATE( emps_ad )
396         IF ( ALLOCATED(fr_i_ad) )    DEALLOCATE( fr_i_ad )
397         IF ( ALLOCATED(ssu_m_ad) )   DEALLOCATE( ssu_m_ad )
398         IF ( ALLOCATED(ssv_m_ad) )   DEALLOCATE( ssv_m_ad )
399         IF ( ALLOCATED(sst_m_ad) )   DEALLOCATE( sst_m_ad )
400         IF ( ALLOCATED(sss_m_ad) )   DEALLOCATE( sss_m_ad )
401         IF ( ALLOCATED(ssh_m_ad) )   DEALLOCATE( ssh_m_ad )
402         
403      ENDIF
404
405   END SUBROUTINE sbc_oce_tam_deallocate
406#endif
407
408END MODULE sbc_oce_tam
Note: See TracBrowser for help on using the repository browser.