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/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC/sbc_oce_tam.F90 @ 3627

Last change on this file since 3627 was 3627, checked in by rblod, 10 years ago

Correct long lines in TAM 4.3 see ticket #1010

  • Property svn:executable set to *
File size: 16.4 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   !!            3.4   !  2012-07  (P.-A. Bouttier) 3.4 update
19   !!             3.4  ! 2012-09   (A. Vidard) Deallocating and initialising options
20   !!----------------------------------------------------------------------
21   USE par_oce
22   USE sbc_oce
23   USE in_out_manager
24   USE lib_mpp
25
26   IMPLICIT NONE
27
28   !! * Routine accessibility
29   PRIVATE
30
31   PUBLIC &
32      & sbc_oce_alloc_tam,   & !: Allocate teh TAM fields
33      & sbc_oce_dealloc_tam, & !: Deallocate the TAM fields
34      & sbc_oce_tam_init       !: Initialize the TAM fields
35
36   !!----------------------------------------------------------------------
37   !!              Ocean Surface Boundary Condition fields
38   !!----------------------------------------------------------------------
39   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: &
40      & qsr_hc_tl,  &
41      & sbc_tsc_b_tl,  &
42      & sbc_tsc_tl,  &
43      & qsr_hc_b_tl
44   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
45      & utau_tl, & !: Tangent linear of sea surface i-stress (ocean referential)     [N/m2]
46      & vtau_tl, & !: Tangent linear of sea surface j-stress (ocean referential)     [N/m2]
47      & utau_b_tl, & !: Tangent linear of sea surface i-stress (ocean referential)     [N/m2]
48      & vtau_b_tl, & !: Tangent linear of sea surface j-stress (ocean referential)     [N/m2]
49      & taum_tl, & !: Tangent linear of module of sea surface stress (at T-point)    [N/m2]
50      & wndm_tl, & !: Tangent linear of wind speed module at T-point (=|U10m-Uoce|)  [m/s
51      & qns_tl,  & !: Tangent linear of sea heat flux: non solar                     [W/m2]
52      & qns_b_tl,  & !: Tangent linear of sea heat flux: non solar                     [W/m2]
53      & rnf_tl,  & !: Tangent linear of sea heat flux: non solar                     [W/m2]
54      & rnf_b_tl,  & !: Tangent linear of sea heat flux: non solar                     [W/m2]
55      & qsr_tl,  & !: Tangent linear of sea heat flux:     solar                     [W/m2]
56      & qns_tot_tl,  & !: Tangent linear of total sea heat flux: non solar                     [W/m2]
57      & qsr_tot_tl,  & !: Tangent linear of total sea heat flux:     solar                     [W/m2]
58      & emp_tl,  & !: Tangent linear of freshwater budget: volume flux               [Kg/m2/s]
59      & emp_tot_tl,  & !: Tangent linear of freshwater budget: volume flux               [Kg/m2/s]
60      & emps_tl, & !: Tangent linear of freshwater budget: concentration/dillution   [Kg/m2/s]
61      & emp_b_tl,  & !: Tangent linear of freshwater budget: volume flux               [Kg/m2/s]
62      & emps_b_tl, & !: Tangent linear of freshwater budget: concentration/dillution   [Kg/m2/s]
63      & fr_i_tl    !: Tangent linear of ice fraction  (between 0 to 1)               -
64#if defined key_cpl_carbon_cycle
65   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2_tl   !: tangent of atmospheric pCO2                             [ppm]
66#endif
67   LOGICAL, SAVE, PRIVATE :: ll_alloctl = .FALSE.
68
69   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: &
70      & qsr_hc_ad,  &
71      & sbc_tsc_b_ad,  &
72      & sbc_tsc_ad,  &
73      & qsr_hc_b_ad
74
75   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
76      & utau_ad, & !: Adjoint of sea surface i-stress (ocean referential)     [N/m2]
77      & vtau_ad, & !: Adjoint of sea surface j-stress (ocean referential)     [N/m2]
78      & utau_b_ad, & !: Adjoint of sea surface i-stress (ocean referential)     [N/m2]
79      & vtau_b_ad, & !: Adjoint of sea surface j-stress (ocean referential)     [N/m2]
80      & taum_ad, & !: Adjoint of module of sea surface stress (at T-point)    [N/m2]
81      & wndm_ad, & !: Adjoint of wind speed module at T-point (=|U10m-Uoce|)  [m/s]
82      & qns_ad,  & !: Adjoint of sea heat flux: non solar                     [W/m2
83      & qns_b_ad,  & !: Adjoint of sea heat flux: non solar                     [W/m2
84      & rnf_ad,  & !: Adjoint of sea heat flux: non solar                     [W/m2
85      & rnf_b_ad,  & !: Adjoint of sea heat flux: non solar                     [W/m2
86      & qsr_ad,  & !: Adjoint of sea heat flux:     solar                     [W/m2]
87      & qns_tot_ad,  & !: Adjoint of total sea heat flux: non solar                     [W/m2
88      & qsr_tot_ad,  & !: Adjoint of total sea heat flux:     solar                     [W/m2]
89      & emp_ad,  & !: Adjoint of freshwater budget: volume flux               [Kg/m2/s]
90      & emp_tot_ad,  & !: Adjoint of freshwater budget: volume flux               [Kg/m2/s]
91      & emps_ad, & !: Adjoint of freshwater budget: concentration/dillution   [Kg/m2/s]
92      & emp_b_ad,  & !: Adjoint of freshwater budget: volume flux               [Kg/m2/s]
93      & emps_b_ad, & !: Adjoint of freshwater budget: concentration/dillution   [Kg/m2/s]
94      & fr_i_ad    !: Adjoint of ice fraction  (between 0 to 1)               -
95#if defined key_cpl_carbon_cycle
96   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2_ad   !: adjoint of atmospheric pCO2                             [ppm]
97#endif
98
99   !!----------------------------------------------------------------------
100   !!                     Sea Surface Mean fields
101   !!----------------------------------------------------------------------
102   REAL(wp), PUBLIC,  DIMENSION(:,:), ALLOCATABLE :: &
103      & ssu_m_tl, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
104      & ssv_m_tl, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
105      & sst_m_tl, & !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
106      & sss_m_tl, & !: mean (nn_fsbc time-step) surface sea salinity            [psu]
107      & ssh_m_tl    !: mean (nn_fsbc time-step) surface sea height                [m]
108
109   REAL(wp), PUBLIC,  DIMENSION(:,:), ALLOCATABLE :: &
110      & ssu_m_ad, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
111      & ssv_m_ad, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
112      & sst_m_ad, & !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
113      & sss_m_ad, & !: mean (nn_fsbc time-step) surface sea salinity            [psu]
114      & ssh_m_ad    !: mean (nn_fsbc time-step) surface sea height                [m]
115
116   LOGICAL, SAVE, PRIVATE :: ll_allocad = .FALSE.
117   !! * Substitutions
118#  include "vectopt_loop_substitute.h90"
119
120CONTAINS
121
122   INTEGER FUNCTION sbc_oce_alloc_tam( kmode )
123      !! * Arguments
124      INTEGER, OPTIONAL :: kmode
125      INTEGER :: imode
126      INTEGER :: ierr(4)
127      IF ( PRESENT(kmode) ) THEN
128         imode = kmode
129      ELSE
130         imode = 0
131      END IF
132      !------------------------------------------------------------------------
133      ierr(:) = 0
134      !
135      IF ( ( imode == 0 ) .OR. ( imode == 1 ) .AND. ( .NOT. ll_alloctl ) ) THEN
136      ALLOCATE( utau_tl(jpi,jpj) , utau_b_tl(jpi,jpj) , taum_tl(jpi,jpj) ,     &
137         &      vtau_tl(jpi,jpj) , vtau_b_tl(jpi,jpj) , wndm_tl(jpi,jpj) , STAT=ierr(1) )
138         !
139      ALLOCATE( qns_tot_tl(jpi,jpj) , qns_tl   (jpi,jpj) , qns_b_tl(jpi,jpj),     &
140         &      qsr_tot_tl(jpi,jpj) , qsr_tl   (jpi,jpj) ,                        &
141         &      emp_tl    (jpi,jpj) , emp_b_tl (jpi,jpj) ,                        &
142         &      rnf_tl    (jpi,jpj) , rnf_b_tl (jpi,jpj) ,                        &
143         &      emps_tl   (jpi,jpj) , emps_b_tl(jpi,jpj) , emp_tot_tl(jpi,jpj) , STAT=ierr(2) )
144         !
145      ALLOCATE(                                                                 &
146#if defined key_cpl_carbon_cycle
147         &      atm_co2_tl(jpi,jpj) ,                                           &
148#endif
149         &      ssu_m_tl  (jpi,jpj) , sst_m_tl(jpi,jpj) ,                       &
150         &      ssv_m_tl  (jpi,jpj) , sss_m_tl  (jpi,jpj), ssh_m_tl(jpi,jpj) , STAT=ierr(3) )
151         !
152      ALLOCATE( qsr_hc_tl   (jpi,jpj,jpk)  , qsr_hc_b_tl(jpi,jpj,jpk) ,         &
153         &      sbc_tsc_b_tl(jpi,jpj,jpts) , sbc_tsc_tl(jpi,jpj,jpts), STAT=ierr(4) )
154
155      sbc_oce_alloc_tam = MAXVAL( ierr )
156      IF( lk_mpp            )   CALL mpp_sum ( sbc_oce_alloc_tam )
157      IF( sbc_oce_alloc_tam > 0 )   CALL ctl_warn('sbc_oce_alloci_tam: allocation of tangent linear arrays failed')
158
159         ll_alloctl = .TRUE.
160         !
161      END IF
162
163      IF ( ( imode == 0 ) .OR. ( imode == 2 ) .AND. ( .NOT. ll_allocad ) ) THEN
164         ierr(:) = 0
165         !
166         ALLOCATE( utau_ad(jpi,jpj) , utau_b_ad(jpi,jpj) , taum_ad(jpi,jpj) ,      &
167            &      vtau_ad(jpi,jpj) , vtau_b_ad(jpi,jpj) , wndm_ad(jpi,jpj) , STAT=ierr(1) )
168         !
169         ALLOCATE( qns_tot_ad(jpi,jpj) , qns_ad   (jpi,jpj) , qns_b_ad(jpi,jpj),   &
170            &      qsr_tot_ad(jpi,jpj) , qsr_ad   (jpi,jpj) ,                      &
171            &      emp_ad    (jpi,jpj) , emp_b_ad (jpi,jpj) ,                      &
172            &      rnf_ad    (jpi,jpj) , rnf_b_ad (jpi,jpj) ,                      &
173            &      emps_ad   (jpi,jpj) , emps_b_ad(jpi,jpj) , emp_tot_ad(jpi,jpj) , STAT=ierr(2) )
174         !
175         ALLOCATE(                                                                 &
176#if defined key_cpl_carbon_cycle
177            &      atm_co2_ad(jpi,jpj) ,                                           &
178#endif
179            &      ssu_m_ad  (jpi,jpj) , sst_m_ad(jpi,jpj) ,                       &
180            &      ssv_m_ad  (jpi,jpj) , sss_m_ad  (jpi,jpj), ssh_m_ad(jpi,jpj) , STAT=ierr(3) )
181         !
182         ALLOCATE( qsr_hc_ad(jpi,jpj,jpk), qsr_hc_b_ad(jpi,jpj,jpk),               & 
183            &      sbc_tsc_b_ad(jpi,jpj,jpts), sbc_tsc_ad(jpi,jpj,jpts), STAT=ierr(4) )
184
185         sbc_oce_alloc_tam = MAXVAL( ierr )
186         IF( lk_mpp            )   CALL mpp_sum ( sbc_oce_alloc_tam )
187         IF( sbc_oce_alloc_tam > 0 )   CALL ctl_warn('sbc_oce_alloc_tam: allocation of adjoint arrays failed')
188      !
189         ll_allocad = .TRUE.
190      END IF
191   END FUNCTION sbc_oce_alloc_tam
192   !
193   INTEGER FUNCTION sbc_oce_dealloc_tam( kmode )
194      !! * Arguments
195      INTEGER, OPTIONAL :: kmode
196      INTEGER :: ierr(4)
197      INTEGER :: imode
198      IF ( PRESENT(kmode) ) THEN
199         imode = kmode
200      ELSE
201         imode = 0
202      END IF
203      !------------------------------------------------------------------------
204      ierr(:) = 0
205      !
206      IF ( ( imode == 0 ) .OR. ( imode == 1 ) .AND. ( ll_alloctl ) ) THEN
207         DEALLOCATE( utau_tl , utau_b_tl , taum_tl ,     &
208            &        vtau_tl , vtau_b_tl , wndm_tl , STAT=ierr(1) )
209         !
210         DEALLOCATE( qns_tot_tl , qns_tl    , qns_b_tl,              &
211            &        qsr_tot_tl , qsr_tl    ,                        &
212            &        emp_tl     , emp_b_tl  ,                        &
213            &        rnf_tl     , rnf_b_tl  ,                        &
214            &        emps_tl    , emps_b_tl , emp_tot_tl , STAT=ierr(2) )
215         !
216         DEALLOCATE(                                                 &
217#if defined key_cpl_carbon_cycle
218            &        atm_co2_tl ,                                    &
219#endif
220            &        ssu_m_tl   , sst_m_tl ,                         &
221            &        ssv_m_tl   , sss_m_tl  , ssh_m_tl , STAT=ierr(3) )
222         !
223         DEALLOCATE( qsr_hc_tl, qsr_hc_b_tl, sbc_tsc_b_tl , sbc_tsc_tl, STAT=ierr(4) )
224
225         sbc_oce_dealloc_tam = MAXVAL( ierr )
226         IF( lk_mpp                  )   CALL mpp_sum ( sbc_oce_dealloc_tam )
227         IF( sbc_oce_dealloc_tam > 0 )   CALL ctl_warn('sbc_oce_dealloci_tam: allocation of tangent linear arrays failed')
228
229         ll_alloctl = .FALSE.
230         !
231      END IF
232
233      IF ( ( imode == 0 ) .OR. ( imode == 2 ) .and. ( ll_allocad ) ) THEN
234         ierr(:) = 0
235         !
236         DEALLOCATE( utau_ad , utau_b_ad , taum_ad ,                 &
237            &        vtau_ad , vtau_b_ad , wndm_ad , STAT=ierr(1) )
238         !
239         DEALLOCATE( qns_tot_ad , qns_ad    , qns_b_ad,              &
240            &        qsr_tot_ad , qsr_ad    ,                        &
241            &        emp_ad     , emp_b_ad  ,                        &
242            &        rnf_ad     , rnf_b_ad  ,                        &
243            &        emps_ad    , emps_b_ad , emp_tot_ad , STAT=ierr(2) )
244         !
245         DEALLOCATE(                                                 &
246#if defined key_cpl_carbon_cycle
247            &        atm_co2_ad ,                                    &
248#endif
249            &        ssu_m_ad   , sst_m_ad ,                         &
250            &        ssv_m_ad   , sss_m_ad  , ssh_m_ad , STAT=ierr(3) )
251         !
252         DEALLOCATE( qsr_hc_ad, qsr_hc_b_ad, sbc_tsc_b_ad, sbc_tsc_ad, STAT=ierr(4) )
253
254         sbc_oce_dealloc_tam = MAXVAL( ierr )
255         IF( lk_mpp                  )   CALL mpp_sum ( sbc_oce_dealloc_tam )
256         IF( sbc_oce_dealloc_tam > 0 )   CALL ctl_warn('sbc_oce_dealloc_tam: allocation of adjoint arrays failed')
257      !
258         ll_allocad = .FALSE.
259      END IF
260   END FUNCTION sbc_oce_dealloc_tam
261   !
262   SUBROUTINE sbc_oce_tam_init( kmode )
263      !!-----------------------------------------------------------------------
264      !!
265      !!                  ***  ROUTINE sbc_oce_tam_init  ***
266      !!
267      !! ** Purpose : Allocate and initialize the tangent linear and
268      !!              adjoint arrays
269      !!
270      !! ** Method  : kindic = 0  allocate/initialize both tl and ad variables
271      !!              kindic = 1  allocate/initialize only tl variables
272      !!              kindic = 2  allocate/initialize only ad variables
273      !!
274      !! ** Action  :
275      !!
276      !! References :
277      !!
278      !! History :
279      !!        ! 2009-03 (A. Weaver) Initial version (based on oce_tam_init)
280      !!        ! 2010-04 (A. Vidard) Nemo3.2 update
281      !!        ! 2012-09 (P.-A. Bouttier) Nemo3.4 update
282      !!-----------------------------------------------------------------------
283      INTEGER, INTENT(in) :: kmode
284      INTEGER :: ierr
285      IF ( ( kmode == 0 ) .OR. ( kmode == 1 ) ) THEN
286         IF ( .NOT. ll_alloctl ) ierr = sbc_oce_alloc_tam ( 1 )
287      qsr_hc_tl(:,:,:) = 0.0_wp
288      qsr_hc_b_tl(:,:,:) = 0.0_wp
289      sbc_tsc_tl(:,:,:) = 0.0_wp
290      sbc_tsc_b_tl(:,:,:) = 0.0_wp
291      utau_tl (:,:) = 0.0_wp
292      vtau_tl (:,:) = 0.0_wp
293      utau_b_tl (:,:) = 0.0_wp
294      vtau_b_tl (:,:) = 0.0_wp
295      taum_tl (:,:) = 0.0_wp
296      wndm_tl (:,:) = 0.0_wp
297      qns_tl  (:,:) = 0.0_wp
298      qns_b_tl  (:,:) = 0.0_wp
299      rnf_tl  (:,:) = 0.0_wp
300      rnf_b_tl  (:,:) = 0.0_wp
301      qsr_tl  (:,:) = 0.0_wp
302      qns_tot_tl  (:,:) = 0.0_wp
303      qsr_tot_tl  (:,:) = 0.0_wp
304      emp_tl  (:,:) = 0.0_wp
305      emps_tl (:,:) = 0.0_wp
306      emp_b_tl  (:,:) = 0.0_wp
307      emps_b_tl (:,:) = 0.0_wp
308      fr_i_tl (:,:) = 0.0_wp
309      ssu_m_tl(:,:) = 0.0_wp
310      ssv_m_tl(:,:) = 0.0_wp
311      sst_m_tl(:,:) = 0.0_wp
312      sss_m_tl(:,:) = 0.0_wp
313      ssh_m_tl(:,:) = 0.0_wp
314      END IF
315      IF ( ( kmode == 0 ) .OR. ( kmode == 2 ) ) THEN
316         IF ( .NOT. ll_allocad ) ierr = sbc_oce_alloc_tam ( 2 )
317      qsr_hc_ad(:,:,:) = 0.0_wp
318      qsr_hc_b_ad(:,:,:) = 0.0_wp
319      sbc_tsc_ad(:,:,:) = 0.0_wp
320      sbc_tsc_b_ad(:,:,:) = 0.0_wp
321      utau_ad (:,:) = 0.0_wp
322      vtau_ad (:,:) = 0.0_wp
323      utau_b_ad (:,:) = 0.0_wp
324      vtau_b_ad (:,:) = 0.0_wp
325      taum_ad (:,:) = 0.0_wp
326      wndm_ad (:,:) = 0.0_wp
327      qns_ad  (:,:) = 0.0_wp
328      qns_b_ad  (:,:) = 0.0_wp
329      rnf_ad  (:,:) = 0.0_wp
330      rnf_b_ad  (:,:) = 0.0_wp
331      qsr_ad  (:,:) = 0.0_wp
332      qns_tot_ad  (:,:) = 0.0_wp
333      qsr_tot_ad  (:,:) = 0.0_wp
334      emp_ad  (:,:) = 0.0_wp
335      emps_ad (:,:) = 0.0_wp
336      emp_b_ad  (:,:) = 0.0_wp
337      emps_b_ad (:,:) = 0.0_wp
338      fr_i_ad (:,:) = 0.0_wp
339      ssu_m_ad(:,:) = 0.0_wp
340      ssv_m_ad(:,:) = 0.0_wp
341      sst_m_ad(:,:) = 0.0_wp
342      sss_m_ad(:,:) = 0.0_wp
343      ssh_m_ad(:,:) = 0.0_wp
344      END IF
345   END SUBROUTINE sbc_oce_tam_init
346#endif
347
348END MODULE sbc_oce_tam
Note: See TracBrowser for help on using the repository browser.