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

Context Navigation

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

Last change on this file since 4583 was 3668, checked in by pabouttier, 12 years ago
Missing allocation for sbc_ice variables in TAM - See Ticket #1026
Property svn:executable set to ``*
File size: 16.4 KB

Line
1	MODULE 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
120	CONTAINS
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) , fr_i_tl(jpi,jpj), &
138	& STAT=ierr(1) )
139	!
140	ALLOCATE( qns_tot_tl(jpi,jpj) , qns_tl (jpi,jpj) , qns_b_tl(jpi,jpj), &
141	& qsr_tot_tl(jpi,jpj) , qsr_tl (jpi,jpj) , &
142	& emp_tl (jpi,jpj) , emp_b_tl (jpi,jpj) , &
143	& rnf_tl (jpi,jpj) , rnf_b_tl (jpi,jpj) , &
144	& emps_tl (jpi,jpj) , emps_b_tl(jpi,jpj) , emp_tot_tl(jpi,jpj) , STAT=ierr(2) )
145	!
146	ALLOCATE( &
147	#if defined key_cpl_carbon_cycle
148	& atm_co2_tl(jpi,jpj) , &
149	#endif
150	& ssu_m_tl (jpi,jpj) , sst_m_tl(jpi,jpj) , &
151	& ssv_m_tl (jpi,jpj) , sss_m_tl (jpi,jpj), ssh_m_tl(jpi,jpj) , STAT=ierr(3) )
152	!
153	ALLOCATE( qsr_hc_tl (jpi,jpj,jpk) , qsr_hc_b_tl(jpi,jpj,jpk) , &
154	& sbc_tsc_b_tl(jpi,jpj,jpts) , sbc_tsc_tl(jpi,jpj,jpts), STAT=ierr(4) )
155
156	sbc_oce_alloc_tam = MAXVAL( ierr )
157	IF( lk_mpp ) CALL mpp_sum ( sbc_oce_alloc_tam )
158	IF( sbc_oce_alloc_tam > 0 ) CALL ctl_warn('sbc_oce_alloci_tam: allocation of tangent linear arrays failed')
159
160	ll_alloctl = .TRUE.
161	!
162	END IF
163
164	IF ( ( imode == 0 ) .OR. ( imode == 2 ) .AND. ( .NOT. ll_allocad ) ) THEN
165	ierr(:) = 0
166	!
167	ALLOCATE( utau_ad(jpi,jpj) , utau_b_ad(jpi,jpj) , taum_ad(jpi,jpj) , &
168	& vtau_ad(jpi,jpj) , vtau_b_ad(jpi,jpj) , wndm_ad(jpi,jpj) , fr_i_ad(jpi,jpj), &
169	& STAT=ierr(1) )
170	!
171	ALLOCATE( qns_tot_ad(jpi,jpj) , qns_ad (jpi,jpj) , qns_b_ad(jpi,jpj), &
172	& qsr_tot_ad(jpi,jpj) , qsr_ad (jpi,jpj) , &
173	& emp_ad (jpi,jpj) , emp_b_ad (jpi,jpj) , &
174	& rnf_ad (jpi,jpj) , rnf_b_ad (jpi,jpj) , &
175	& emps_ad (jpi,jpj) , emps_b_ad(jpi,jpj) , emp_tot_ad(jpi,jpj) , STAT=ierr(2) )
176	!
177	ALLOCATE( &
178	#if defined key_cpl_carbon_cycle
179	& atm_co2_ad(jpi,jpj) , &
180	#endif
181	& ssu_m_ad (jpi,jpj) , sst_m_ad(jpi,jpj) , &
182	& ssv_m_ad (jpi,jpj) , sss_m_ad (jpi,jpj), ssh_m_ad(jpi,jpj) , STAT=ierr(3) )
183	!
184	ALLOCATE( qsr_hc_ad(jpi,jpj,jpk), qsr_hc_b_ad(jpi,jpj,jpk), &
185	& sbc_tsc_b_ad(jpi,jpj,jpts), sbc_tsc_ad(jpi,jpj,jpts), STAT=ierr(4) )
186
187	sbc_oce_alloc_tam = MAXVAL( ierr )
188	IF( lk_mpp ) CALL mpp_sum ( sbc_oce_alloc_tam )
189	IF( sbc_oce_alloc_tam > 0 ) CALL ctl_warn('sbc_oce_alloc_tam: allocation of adjoint arrays failed')
190	!
191	ll_allocad = .TRUE.
192	END IF
193	END FUNCTION sbc_oce_alloc_tam
194	!
195	INTEGER FUNCTION sbc_oce_dealloc_tam( kmode )
196	!! * Arguments
197	INTEGER, OPTIONAL :: kmode
198	INTEGER :: ierr(4)
199	INTEGER :: imode
200	IF ( PRESENT(kmode) ) THEN
201	imode = kmode
202	ELSE
203	imode = 0
204	END IF
205	!------------------------------------------------------------------------
206	ierr(:) = 0
207	!
208	IF ( ( imode == 0 ) .OR. ( imode == 1 ) .AND. ( ll_alloctl ) ) THEN
209	DEALLOCATE( utau_tl , utau_b_tl , taum_tl , &
210	& vtau_tl , vtau_b_tl , wndm_tl , STAT=ierr(1) )
211	!
212	DEALLOCATE( qns_tot_tl , qns_tl , qns_b_tl, &
213	& qsr_tot_tl , qsr_tl , &
214	& emp_tl , emp_b_tl , &
215	& rnf_tl , rnf_b_tl , &
216	& emps_tl , emps_b_tl , emp_tot_tl , STAT=ierr(2) )
217	!
218	DEALLOCATE( &
219	#if defined key_cpl_carbon_cycle
220	& atm_co2_tl , &
221	#endif
222	& ssu_m_tl , sst_m_tl , &
223	& ssv_m_tl , sss_m_tl , ssh_m_tl , STAT=ierr(3) )
224	!
225	DEALLOCATE( qsr_hc_tl, qsr_hc_b_tl, sbc_tsc_b_tl , sbc_tsc_tl, STAT=ierr(4) )
226
227	sbc_oce_dealloc_tam = MAXVAL( ierr )
228	IF( lk_mpp ) CALL mpp_sum ( sbc_oce_dealloc_tam )
229	IF( sbc_oce_dealloc_tam > 0 ) CALL ctl_warn('sbc_oce_dealloci_tam: allocation of tangent linear arrays failed')
230
231	ll_alloctl = .FALSE.
232	!
233	END IF
234
235	IF ( ( imode == 0 ) .OR. ( imode == 2 ) .and. ( ll_allocad ) ) THEN
236	ierr(:) = 0
237	!
238	DEALLOCATE( utau_ad , utau_b_ad , taum_ad , &
239	& vtau_ad , vtau_b_ad , wndm_ad , STAT=ierr(1) )
240	!
241	DEALLOCATE( qns_tot_ad , qns_ad , qns_b_ad, &
242	& qsr_tot_ad , qsr_ad , &
243	& emp_ad , emp_b_ad , &
244	& rnf_ad , rnf_b_ad , &
245	& emps_ad , emps_b_ad , emp_tot_ad , STAT=ierr(2) )
246	!
247	DEALLOCATE( &
248	#if defined key_cpl_carbon_cycle
249	& atm_co2_ad , &
250	#endif
251	& ssu_m_ad , sst_m_ad , &
252	& ssv_m_ad , sss_m_ad , ssh_m_ad , STAT=ierr(3) )
253	!
254	DEALLOCATE( qsr_hc_ad, qsr_hc_b_ad, sbc_tsc_b_ad, sbc_tsc_ad, STAT=ierr(4) )
255
256	sbc_oce_dealloc_tam = MAXVAL( ierr )
257	IF( lk_mpp ) CALL mpp_sum ( sbc_oce_dealloc_tam )
258	IF( sbc_oce_dealloc_tam > 0 ) CALL ctl_warn('sbc_oce_dealloc_tam: allocation of adjoint arrays failed')
259	!
260	ll_allocad = .FALSE.
261	END IF
262	END FUNCTION sbc_oce_dealloc_tam
263	!
264	SUBROUTINE sbc_oce_tam_init( kmode )
265	!!-----------------------------------------------------------------------
266	!!
267	!! * ROUTINE sbc_oce_tam_init *
268	!!
269	!! ** Purpose : Allocate and initialize the tangent linear and
270	!! adjoint arrays
271	!!
272	!! ** Method : kindic = 0 allocate/initialize both tl and ad variables
273	!! kindic = 1 allocate/initialize only tl variables
274	!! kindic = 2 allocate/initialize only ad variables
275	!!
276	!! ** Action :
277	!!
278	!! References :
279	!!
280	!! History :
281	!! ! 2009-03 (A. Weaver) Initial version (based on oce_tam_init)
282	!! ! 2010-04 (A. Vidard) Nemo3.2 update
283	!! ! 2012-09 (P.-A. Bouttier) Nemo3.4 update
284	!!-----------------------------------------------------------------------
285	INTEGER, INTENT(in) :: kmode
286	INTEGER :: ierr
287	IF ( ( kmode == 0 ) .OR. ( kmode == 1 ) ) THEN
288	IF ( .NOT. ll_alloctl ) ierr = sbc_oce_alloc_tam ( 1 )
289	qsr_hc_tl(:,:,:) = 0.0_wp
290	qsr_hc_b_tl(:,:,:) = 0.0_wp
291	sbc_tsc_tl(:,:,:) = 0.0_wp
292	sbc_tsc_b_tl(:,:,:) = 0.0_wp
293	utau_tl (:,:) = 0.0_wp
294	vtau_tl (:,:) = 0.0_wp
295	utau_b_tl (:,:) = 0.0_wp
296	vtau_b_tl (:,:) = 0.0_wp
297	taum_tl (:,:) = 0.0_wp
298	wndm_tl (:,:) = 0.0_wp
299	qns_tl (:,:) = 0.0_wp
300	qns_b_tl (:,:) = 0.0_wp
301	rnf_tl (:,:) = 0.0_wp
302	rnf_b_tl (:,:) = 0.0_wp
303	qsr_tl (:,:) = 0.0_wp
304	qns_tot_tl (:,:) = 0.0_wp
305	qsr_tot_tl (:,:) = 0.0_wp
306	emp_tl (:,:) = 0.0_wp
307	emps_tl (:,:) = 0.0_wp
308	emp_b_tl (:,:) = 0.0_wp
309	emps_b_tl (:,:) = 0.0_wp
310	fr_i_tl (:,:) = 0.0_wp
311	ssu_m_tl(:,:) = 0.0_wp
312	ssv_m_tl(:,:) = 0.0_wp
313	sst_m_tl(:,:) = 0.0_wp
314	sss_m_tl(:,:) = 0.0_wp
315	ssh_m_tl(:,:) = 0.0_wp
316	END IF
317	IF ( ( kmode == 0 ) .OR. ( kmode == 2 ) ) THEN
318	IF ( .NOT. ll_allocad ) ierr = sbc_oce_alloc_tam ( 2 )
319	qsr_hc_ad(:,:,:) = 0.0_wp
320	qsr_hc_b_ad(:,:,:) = 0.0_wp
321	sbc_tsc_ad(:,:,:) = 0.0_wp
322	sbc_tsc_b_ad(:,:,:) = 0.0_wp
323	utau_ad (:,:) = 0.0_wp
324	vtau_ad (:,:) = 0.0_wp
325	utau_b_ad (:,:) = 0.0_wp
326	vtau_b_ad (:,:) = 0.0_wp
327	taum_ad (:,:) = 0.0_wp
328	wndm_ad (:,:) = 0.0_wp
329	qns_ad (:,:) = 0.0_wp
330	qns_b_ad (:,:) = 0.0_wp
331	rnf_ad (:,:) = 0.0_wp
332	rnf_b_ad (:,:) = 0.0_wp
333	qsr_ad (:,:) = 0.0_wp
334	qns_tot_ad (:,:) = 0.0_wp
335	qsr_tot_ad (:,:) = 0.0_wp
336	emp_ad (:,:) = 0.0_wp
337	emps_ad (:,:) = 0.0_wp
338	emp_b_ad (:,:) = 0.0_wp
339	emps_b_ad (:,:) = 0.0_wp
340	fr_i_ad (:,:) = 0.0_wp
341	ssu_m_ad(:,:) = 0.0_wp
342	ssv_m_ad(:,:) = 0.0_wp
343	sst_m_ad(:,:) = 0.0_wp
344	sss_m_ad(:,:) = 0.0_wp
345	ssh_m_ad(:,:) = 0.0_wp
346	END IF
347	END SUBROUTINE sbc_oce_tam_init
348	#endif
349
350	END MODULE sbc_oce_tam

Note: See TracBrowser for help on using the repository browser.

Download in other formats: