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.
sbcana_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/sbcana_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: 23.4 KB
Line 
1MODULE sbcana_tam
2#if defined key_tam
3   !!======================================================================
4   !!                       ***  MODULE  sbcana  ***
5   !! Ocean forcing:  analytical momentum, heat and freshwater forcings
6   !!=====================================================================
7   !! History of the direct module :
8   !!            3.0   ! 2006-06  (G. Madec)  Original code
9   !!            3.2   ! 2009-07  (G. Madec)  Style only
10   !! History of the T&A module :
11   !!            3.0   ! 2009-10  (F. Vigilant) original verison
12   !!            3.2   ! 2020-04  (A. Vidard) nemo 3.2 update
13   !!            3.4   ! 2012-07  (P.-A. Bouttier) 3.4 update
14   !!----------------------------------------------------------------------
15
16   !!----------------------------------------------------------------------
17   !!   sbc_ana  : set an analytical ocean forcing
18   !!   sbc_gyre : set the GYRE configuration analytical forcing
19   !!   sbc_sqb  : set the SQB configuration analytical forcing
20   !!----------------------------------------------------------------------
21   USE par_kind
22   USE oce_tam
23   USE par_oce
24   USE dom_oce
25   USE in_out_manager
26   USE lib_mpp
27   USE sbc_oce_tam
28   USE tstool_tam
29   USE gridrandom
30   USE dotprodfld
31   USE lib_fortran
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   sbc_sqb_tan
37   PUBLIC   sbc_sqb_adj
38   PUBLIC   sbc_ana_tan        ! routine called sbcmod_tam
39   PUBLIC   sbc_ana_adj        ! routine called sbcmod_tam
40   PUBLIC   sbc_gyre_tan       ! routine called sbcmod_tam
41   PUBLIC   sbc_gyre_adj       ! routine called sbcmod_tam
42   PUBLIC   sbc_gyre_adj_tst   ! routine called by tst
43
44   !! * Namelist namsbc_ana
45   INTEGER  ::   nn_tau000 = 1       ! nb of time-step during which the surface stress
46      !                              ! increase from 0 to its nominal value
47   REAL(wp) ::   rn_utau0  = 0._wp   ! constant wind stress value in i-direction
48   REAL(wp) ::   rn_vtau0  = 0._wp   ! constant wind stress value in j-direction
49   REAL(wp) ::   rn_qns0   = 0._wp   ! non solar heat flux
50   REAL(wp) ::   rn_qsr0   = 0._wp   !     solar heat flux
51   REAL(wp) ::   rn_emp0   = 0._wp   ! net freshwater flux
52
53   REAL(wp) ::   rhoa      = 1.22_wp   ! Air density kg/m3
54   REAL(wp) ::   cdrag     = 1.5e-3_wp ! drag coefficient
55
56   !! * Substitutions
57#  include "domzgr_substitute.h90"
58#  include "vectopt_loop_substitute.h90"
59   !!----------------------------------------------------------------------
60   !!   OPA 9.0 , LOCEAN-IPSL (2006)
61   !! $Id$
62   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
63   !!----------------------------------------------------------------------
64
65CONTAINS
66
67   SUBROUTINE sbc_ana_tan( kt )
68      !!---------------------------------------------------------------------
69      !!                    ***  ROUTINE sbc_ana_tan ***
70      !!
71      !! ** Purpose :   provide at each time-step the ocean surface boundary
72      !!              condition, i.e. the momentum, heat and freshwater fluxes.
73      !!
74      !! ** Method  :   Constant and uniform surface forcing specified from
75      !!              namsbc_ana namelist parameters. All the fluxes are time
76      !!              independant except the stresses which increase from zero
77      !!              during the first nn_tau000 time-step
78      !!                CAUTION : never mask the surface stress field !
79      !!
80      !! ** Action  : - set the ocean surface boundary condition, i.e.
81      !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps
82      !!----------------------------------------------------------------------
83      INTEGER, INTENT(in) ::   kt       ! ocean time step
84      !!
85      NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0
86      !!---------------------------------------------------------------------
87      !
88      IF( kt == nit000 ) THEN
89         !
90         REWIND ( numnam )                   ! Read Namelist namsbc : surface fluxes
91         READ   ( numnam, namsbc_ana )
92         !
93         IF(lwp) WRITE(numout,*)' '
94         IF(lwp) WRITE(numout,*)' sbc_ana_tan : Constant surface fluxes read in namsbc_ana namelist'
95         IF(lwp) WRITE(numout,*)' ~~~~~~~ '
96         IF(lwp) WRITE(numout,*)'              spin up of the stress  nn_tau000 = ', nn_tau000, ' time-steps'
97         IF(lwp) WRITE(numout,*)'              constant i-stress      rn_utau0  = ', rn_utau0 , ' N/m2'
98         IF(lwp) WRITE(numout,*)'              constant j-stress      rn_vtau0  = ', rn_vtau0 , ' N/m2'
99         IF(lwp) WRITE(numout,*)'              non solar heat flux    rn_qns0   = ', rn_qns0  , ' W/m2'
100         IF(lwp) WRITE(numout,*)'              solar heat flux        rn_qsr0   = ', rn_qsr0  , ' W/m2'
101         IF(lwp) WRITE(numout,*)'              net heat flux          rn_emp0   = ', rn_emp0  , ' Kg/m2/s'
102         !
103         nn_tau000 = MAX( nn_tau000, 1 )   ! must be >= 1
104         qns_tl   (:,:) = 0.0_wp
105         qsr_tl   (:,:) = 0.0_wp
106         emp_tl   (:,:) = 0.0_wp
107         emps_tl  (:,:) = 0.0_wp
108         utau_tl  (:,:) = 0.0_wp
109         vtau_tl  (:,:) = 0.0_wp
110         taum_tl  (:,:) = 0.0_wp
111         wndm_tl  (:,:) = 0.0_wp
112         !
113      ENDIF
114      !
115   END SUBROUTINE sbc_ana_tan
116
117   SUBROUTINE sbc_ana_adj( kt )
118      !!---------------------------------------------------------------------
119      !!                    ***  ROUTINE sbc_ana_adj ***
120      !!
121      !! ** Purpose :   provide at each time-step the ocean surface boundary
122      !!              condition, i.e. the momentum, heat and freshwater fluxes.
123      !!
124      !! ** Method  :   Constant and uniform surface forcing specified from
125      !!              namsbc_ana namelist parameters. All the fluxes are time
126      !!              independant except the stresses which increase from zero
127      !!              during the first nn_tau000 time-step
128      !!                CAUTION : never mask the surface stress field !
129      !!
130      !! ** Action  : - set the ocean surface boundary condition, i.e.
131      !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps
132      !!----------------------------------------------------------------------
133      INTEGER, INTENT(in) ::   kt       ! ocean time step
134      !!
135      NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0
136      !!---------------------------------------------------------------------
137      !
138      IF( kt == nitend ) THEN
139         !
140         IF(lwp) WRITE(numout,*)' '
141         IF(lwp) WRITE(numout,*)' sbc_ana_adj : Constant surface fluxes read in namsbc_ana namelist'
142         IF(lwp) WRITE(numout,*)' ~~~~~~~ '
143
144         nn_tau000 = MAX( nn_tau000, 1 )   ! must be >= 1
145         qns_ad   (:,:) = 0.0_wp
146         qsr_ad   (:,:) = 0.0_wp
147         emp_ad   (:,:) = 0.0_wp
148         emps_ad  (:,:) = 0.0_wp
149         utau_ad  (:,:) = 0.0_wp
150         vtau_ad  (:,:) = 0.0_wp
151         taum_ad  (:,:) = 0.0_wp
152         wndm_ad  (:,:) = 0.0_wp
153         !
154      ENDIF
155      !
156   END SUBROUTINE sbc_ana_adj
157
158
159   SUBROUTINE sbc_gyre_tan( kt )
160      !!---------------------------------------------------------------------
161      !!                    ***  ROUTINE sbc_gyre_tam ***
162      !!
163      !! ** Purpose :   provide at each time-step the GYRE surface boundary
164      !!              condition, i.e. the momentum, heat and freshwater fluxes.
165      !!
166      !! ** Method  :   analytical seasonal cycle for GYRE configuration.
167      !!                CAUTION : never mask the surface stress field !
168      !!
169      !! ** Action  : - set the ocean surface boundary condition, i.e.
170      !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps
171      !!----------------------------------------------------------------------
172      INTEGER, INTENT(in) ::   kt          ! ocean time step
173      !!
174      INTEGER  ::   ji, jj                 ! dummy loop indices
175      REAL(wp) ::   ztstar
176      REAL(wp) ::   ztrp
177      REAL(wp) ::   zsumemp_tl, zsurf
178      !!---------------------------------------------------------------------
179
180      ! ---------------------------- !
181      !  heat and freshwater fluxes  !
182      ! ---------------------------- !
183      !same temperature, E-P as in HAZELEGER 2000
184
185      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K)
186      DO jj = 1, jpj
187         DO ji = 1, jpi
188            ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3
189            ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period :
190            ! 64.5 in summer, 42.5 in winter
191            ! 23.5 deg : tropics
192            qsr_tl (ji,jj) =  0.0_wp
193            qns_tl (ji,jj) = ztrp *  tsb_tl(ji,jj,1,jp_tem)
194            emp_tl (ji,jj) =  0.0_wp
195         END DO
196      END DO
197      emps_tl(:,:) = emp_tl(:,:)
198
199      ! Compute the emp flux such as its integration on the whole domain at each time is zero
200      IF( nbench /= 1 ) THEN
201         zsumemp_tl = GLOB_SUM( emp_tl(:,:) )
202         zsurf      = GLOB_SUM( tmask (:,:,1) )
203         ! Default GYRE configuration
204         zsumemp_tl = zsumemp_tl / zsurf
205      ELSE
206         ! Benchmark GYRE configuration (to allow the bit to bit comparison between Mpp/Mono case)
207         zsumemp_tl = 0.e0   ;    zsurf = 0.e0
208      ENDIF
209
210      !salinity terms
211      emp_tl (:,:) = emp_tl(:,:) - zsumemp_tl * tmask(:,:,1)
212      emps_tl(:,:) = emp_tl(:,:)
213
214   END SUBROUTINE sbc_gyre_tan
215
216   SUBROUTINE sbc_gyre_adj( kt )
217      !!---------------------------------------------------------------------
218      !!                    ***  ROUTINE sbc_gyre_adj ***
219      !!
220      !! ** Purpose :   provide at each time-step the ocean surface boundary
221      !!      condition, i.e. the momentum, heat and freshwater fluxes.
222      !!
223      !! ** Method  :   analytical seasonal cycle for GYRE configuration.
224      !!      * C A U T I O N : never mask the surface stress field !
225      !!
226      !! ** Action  : - set the ocean surface boundary condition, i.e.
227      !!                   utau, vtau, qns, qsr, emp, emps
228      !!
229      !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000.
230      !!----------------------------------------------------------------------
231      INTEGER, INTENT(in) ::   kt          ! ocean time step
232
233      INTEGER  ::   ji, jj                 ! dummy loop indices
234      REAL(wp) ::   ztstar
235      REAL(wp) ::   ztrp
236      REAL(wp) ::   zsumemp_ad, zsurf
237      !!---------------------------------------------------------------------
238
239      zsumemp_ad = 0.0_wp
240      zsurf = 0.0_wp
241      DO jj = 1, jpj
242         DO ji = 1, jpi
243            emp_ad (ji,jj) = emp_ad(ji,jj) + emps_ad(ji,jj)
244            emps_ad(ji,jj) = 0.0_wp
245         END DO
246      END DO
247      DO jj = 1, jpj
248         DO ji = 1, jpi
249            zsumemp_ad = zsumemp_ad - emp_ad (ji,jj) * tmask(ji,jj,1)
250         END DO
251      END DO
252
253      ! Compute the emp flux such as its integration on the whole domain at each time is zero
254      IF( nbench /= 1 ) THEN
255         zsurf = GLOB_SUM( tmask (:,:,1) )
256         ! Default GYRE configuration
257         zsumemp_ad = zsumemp_ad / zsurf
258
259         IF( lk_mpp )   CALL mpp_sum( zsurf    )       ! sum over the global domain
260         IF( lk_mpp )   CALL mpp_sum( zsumemp_ad  )       ! sum over the global domain
261
262         DO jj = 1, jpj
263            DO ji = 1, jpi
264               emp_ad(ji,jj) = emp_ad(ji,jj) + zsumemp_ad * tmask(ji,jj,1) * tmask_i(ji,jj)
265            END DO
266         END DO
267         zsumemp_ad = 0.0_wp   ;   zsurf = 0.0_wp
268      ELSE
269         ! Benchmark GYRE configuration (to allow the bit to bit comparison between Mpp/Mono case)
270         zsumemp_ad = 0.0_wp   ;    zsurf = 0.0_wp
271      ENDIF
272
273      DO jj = 1, jpj
274         DO ji = 1, jpi
275            emp_ad (ji,jj) = emp_ad(ji,jj) + emps_ad(ji,jj)
276            emps_ad(ji,jj) = 0.0_wp
277         END DO
278      END DO
279
280      ! ---------------------------- !
281      !  heat and freshwater fluxes  !
282      ! ---------------------------- !
283      !same temperature, E-P as in HAZELEGER 2000
284
285      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K)
286      DO jj = 1, jpj
287         DO ji = 1, jpi
288            ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3
289            ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period :
290            ! 64.5 in summer, 42.5 in winter
291            ! 23.5 deg : tropics
292            emp_ad (ji,jj)   =  0.0_wp
293            tsb_ad  (ji,jj,1,jp_tem) = tsb_ad(ji,jj,1,jp_tem) + ztrp * qns_ad (ji,jj)
294            qns_ad (ji,jj)   = 0.0_wp
295            qsr_ad (ji,jj)   =  0.0_wp
296         END DO
297      END DO
298
299   END SUBROUTINE sbc_gyre_adj
300
301   SUBROUTINE sbc_gyre_adj_tst ( kumadt )
302      !!-----------------------------------------------------------------------
303      !!
304      !!                  ***  ROUTINE example_adj_tst ***
305      !!
306      !! ** Purpose : Test the adjoint routine.
307      !!
308      !! ** Method  : Verify the scalar product
309      !!
310      !!                 ( L dx )^T W dy  =  dx^T L^T W dy
311      !!
312      !!              where  L   = tangent routine
313      !!                     L^T = adjoint routine
314      !!                     W   = diagonal matrix of scale factors
315      !!                     dx  = input perturbation (random field)
316      !!                     dy  = L dx
317      !!
318      !! History :
319      !!        ! 09-10 (F. Vigilant)
320      !!-----------------------------------------------------------------------
321      !! * Modules used
322
323      !! * Arguments
324      INTEGER, INTENT(IN) :: &
325         & kumadt             ! Output unit
326
327      !! * Local declarations
328      INTEGER ::  &
329         & istp,  &
330         & jstp,  &
331         & ji,    &        ! dummy loop indices
332         & jj,    &
333         & jk
334      INTEGER, DIMENSION(jpi,jpj) :: &
335         & iseed_2d        ! 2D seed for the random number generator
336      REAL(KIND=wp) :: &
337         & zsp1,         & ! scalar product involving the tangent routine
338         & zsp2            ! scalar product involving the adjoint routine
339      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
340         & zemp_tlin ,     & ! Tangent input
341         & zemp_tlout,     & ! Tangent output
342         & zemps_tlout,    & ! Tangent output
343         & zqns_tlout,     & ! Tangent output
344         & zemp_adin ,     & ! Adjoint input
345         & zemps_adin,     & ! Adjoint input
346         & zqns_adin ,     & ! Adjoint input
347         & zemp_adout,     & ! Adjoint output
348         & zr                ! 2D random field
349      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: &
350         & ztb_tlin  ,     & ! Tangent input
351         & ztb_adout ,     & ! Adjoint output
352         & z3r               ! 3D random field
353      CHARACTER(LEN=14) :: cl_name
354      ! Allocate memory
355
356      ALLOCATE( &
357         & zemp_tlin(  jpi,jpj),     &
358         & ztb_tlin(jpi,jpj,jpk),    &
359         & zemp_tlout( jpi,jpj),     &
360         & zemps_tlout( jpi,jpj),    &
361         & zqns_tlout(  jpi,jpj),    &
362         & ztb_adout(jpi,jpj,jpk),   &
363         & zemp_adin(  jpi,jpj),     &
364         & zemps_adin( jpi,jpj),     &
365         & zqns_adin(  jpi,jpj),     &
366         & zemp_adout( jpi,jpj),     &
367         & zr(         jpi,jpj),     &
368         & z3r(     jpi,jpj,jpk)     &
369         & )
370      !==================================================================
371      ! 1) dx = ( emp_tl, emps_tl, ssh_tl ) and
372      !    dy = ( emp_tl, emps_tl )
373      !==================================================================
374      ! Test for time steps nit000 and nit000 + 1 (the matrix changes)
375
376      DO jstp = nit000, nit000 + 1
377
378      !--------------------------------------------------------------------
379      ! Reset the tangent and adjoint variables
380      !--------------------------------------------------------------------
381          zemp_tlin  (:,:) = 0.0_wp
382          ztb_tlin (:,:,:) = 0.0_wp
383          zemp_tlout (:,:) = 0.0_wp
384          zemps_tlout(:,:) = 0.0_wp
385          zqns_tlout (:,:) = 0.0_wp
386          zemp_adin  (:,:) = 0.0_wp
387          zemps_adin (:,:) = 0.0_wp
388          zqns_adin  (:,:) = 0.0_wp
389          zemp_adout (:,:) = 0.0_wp
390          ztb_adout(:,:,:) = 0.0_wp
391          z3r(:,:,:)       = 0.0_wp
392          zr(:,:)          = 0.0_wp
393
394          qns_tl (:,:)     = 0.0_wp
395          qsr_tl (:,:)     = 0.0_wp
396          emps_tl(:,:)     = 0.0_wp
397          qsr_ad (:,:)     = 0.0_wp
398          tsb_ad(:,:,:,:)     = 0.0_wp
399
400      !--------------------------------------------------------------------
401      ! Initialize the tangent input with random noise: dx
402      !--------------------------------------------------------------------
403
404          CALL grid_random( zr, 'T', 0.0_wp, stdemp )
405          DO jj = nldj, nlej
406             DO ji = nldi, nlei
407                zemp_tlin(ji,jj) = zr(ji,jj)
408             END DO
409          END DO
410          CALL grid_random( z3r, 'T', 0.0_wp, stdt )
411          DO jk = 1, jpk
412             DO jj = nldj, nlej
413                DO ji = nldi, nlei
414                   ztb_tlin(ji,jj,jk) = z3r(ji,jj,jk)
415                END DO
416             END DO
417          END DO
418
419          tsb_tl(:,:,:,jp_tem) = ztb_tlin(:,:,:)
420          emp_tl (:,:) = zemp_tlin (:,:)
421
422          CALL sbc_gyre_tan( istp )
423
424          zemps_tlout(:,:) = emps_tl(:,:)
425          zemp_tlout (:,:) = emp_tl (:,:)
426          zqns_tlout(:,:) = qns_tl(:,:)
427
428         !-----------------------------------------------------------------
429         ! Initialize the adjoint variables: dy^* = W dy
430         !-----------------------------------------------------------------
431
432          DO jj = nldj, nlej
433             DO ji = nldi, nlei
434                zemp_adin( ji,jj) = zemp_tlout( ji,jj) &
435                     &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) &
436                     &               * tmask(ji,jj,1)
437                zemps_adin(ji,jj) = zemps_tlout(ji,jj) &
438                     &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) &
439                     &               * tmask(ji,jj,1)
440                zqns_adin(ji,jj) = zqns_tlout(ji,jj) &
441                     &               * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) &
442                     &               * tmask(ji,jj,1)
443             END DO
444          END DO
445
446         !-----------------------------------------------------------------
447         ! Compute the scalar product: ( L dx )^T W dy
448         !-----------------------------------------------------------------
449
450          zsp1 = DOT_PRODUCT( zemp_tlout,  zemp_adin  )   &
451               & + DOT_PRODUCT( zemps_tlout, zemps_adin ) &
452               & + DOT_PRODUCT( zqns_tlout, zqns_adin )
453
454         !-----------------------------------------------------------------
455         ! Call the adjoint routine: dx^* = L^T dy^*
456         !-----------------------------------------------------------------
457
458         emp_ad (:,:) = zemp_adin (:,:)
459         emps_ad(:,:) = zemps_adin(:,:)
460         qns_ad( :,:) = zqns_adin( :,:)
461
462         CALL sbc_gyre_adj ( istp )
463
464         ztb_adout(:,:,:) = tsb_ad(:,:,:,jp_tem)
465         zemp_adout (:,:) = emp_ad (:,:)
466
467         zsp2 = DOT_PRODUCT( zemp_tlin,  zemp_adout  ) &
468            & + DOT_PRODUCT( ztb_tlin,  ztb_adout  )
469
470         ! 14 char:'12345678901234'
471         IF ( jstp == nit000 ) THEN
472             WRITE (cl_name,"(A14)") 'sbc_gyre_adj 1'
473         ELSEIF ( jstp == nit000 + 1 ) THEN
474             WRITE (cl_name,"(A14)") 'sbc_gyre_adj 2'
475         END IF
476!         WRITE (cl_name,"(A11,2x,i1)") 'sbc_fwb_adj',jn_fwb
477         CALL prntst_adj( cl_name, kumadt, zsp1, zsp2 )
478
479      END DO
480
481      DEALLOCATE(       &
482         & zemp_tlin,   &
483         & ztb_tlin,    &
484         & zemp_tlout,  &
485         & zemps_tlout, &
486         & zqns_tlout,  &
487         & zemp_adin,   &
488         & zemps_adin,  &
489         & zqns_adin,   &
490         & zemp_adout,  &
491         & ztb_adout,   &
492         & z3r,         &
493         & zr           &
494         & )
495
496   END SUBROUTINE sbc_gyre_adj_tst
497
498   SUBROUTINE sbc_sqb_tan( kt )
499      !!---------------------------------------------------------------------
500      !!                    ***  ROUTINE sbc_sqb ***
501      !!
502      !! ** Purpose :   provide at each time-step the ocean surface boundary
503      !!      condition, i.e. the momentum, heat and freshwater fluxes.
504      !!
505      !! ** Method  :   Constant and uniform surface forcing specified from
506      !!      namsbc_ana namelist parameters. All the fluxes are time inde-
507      !!      pendant except the stresses which increase from zero during
508      !!      the first nn_tau000 time-step
509      !!      * C A U T I O N : never mask the surface stress field !
510      !!
511      !! ** Action  : - set the ocean surface boundary condition, i.e.
512      !!                   utau, vtau, qns, qsr, emp, emps
513      !!----------------------------------------------------------------------
514      INTEGER, INTENT(in) ::   kt       ! ocean time step
515      !!
516      NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0
517      !!---------------------------------------------------------------------
518      !
519      IF( kt == nit000 ) THEN
520         !
521         REWIND ( numnam )                   ! Read Namelist namsbc : surface fluxes
522         READ   ( numnam, namsbc_ana )
523         !
524         IF(lwp) WRITE(numout,*)' '
525         IF(lwp) WRITE(numout,*)' sbc_ana_tan : Constant surface fluxes read in namsbc_ana namelist'
526         IF(lwp) WRITE(numout,*)' ~~~~~~~ '
527         IF(lwp) WRITE(numout,*)'              spin up of the stress  nn_tau000 = ', nn_tau000, ' time-steps'
528         IF(lwp) WRITE(numout,*)'              constant i-stress      rn_utau0  = ', rn_utau0 , ' N/m2'
529         IF(lwp) WRITE(numout,*)'              constant j-stress      rn_vtau0  = ', rn_vtau0 , ' N/m2'
530         IF(lwp) WRITE(numout,*)'              non solar heat flux    rn_qns0   = ', rn_qns0  , ' W/m2'
531         IF(lwp) WRITE(numout,*)'              solar heat flux        rn_qsr0   = ', rn_qsr0  , ' W/m2'
532         IF(lwp) WRITE(numout,*)'              net heat flux          rn_emp0   = ', rn_emp0  , ' Kg/m2/s'
533         !
534         nn_tau000 = MAX( nn_tau000, 1 )   ! must be >= 1
535         qns_tl   (:,:) = 0.0_wp
536         qsr_tl   (:,:) = 0.0_wp
537         emp_tl   (:,:) = 0.0_wp
538         emps_tl  (:,:) = 0.0_wp
539         !
540      ENDIF
541      !
542   END SUBROUTINE sbc_sqb_tan
543
544   SUBROUTINE sbc_sqb_adj( kt )
545      !!---------------------------------------------------------------------
546      !!                    ***  ROUTINE sbc_ana ***
547      !!
548      !! ** Purpose :   provide at each time-step the ocean surface boundary
549      !!      condition, i.e. the momentum, heat and freshwater fluxes.
550      !!
551      !! ** Method  :   Constant and uniform surface forcing specified from
552      !!      namsbc_ana namelist parameters. All the fluxes are time inde-
553      !!      pendant except the stresses which increase from zero during
554      !!      the first nn_tau000 time-step
555      !!      * C A U T I O N : never mask the surface stress field !
556      !!
557      !! ** Action  : - set the ocean surface boundary condition, i.e.
558      !!                   utau, vtau, qns, qsr, emp, emps
559      !!----------------------------------------------------------------------
560      INTEGER, INTENT(in) ::   kt       ! ocean time step
561      !!
562      NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0
563      !!---------------------------------------------------------------------
564      !
565      IF( kt == nitend ) THEN
566         !
567         IF(lwp) WRITE(numout,*)' '
568         IF(lwp) WRITE(numout,*)' sbc_ana_adj : Constant surface fluxes read in namsbc_ana namelist'
569         IF(lwp) WRITE(numout,*)' ~~~~~~~ '
570
571         nn_tau000 = MAX( nn_tau000, 1 )   ! must be >= 1
572         qns_ad   (:,:) = 0.0_wp
573         qsr_ad   (:,:) = 0.0_wp
574         emp_ad   (:,:) = 0.0_wp
575         emps_ad  (:,:) = 0.0_wp
576         !
577      ENDIF
578      !
579   END SUBROUTINE sbc_sqb_adj
580
581
582
583#endif
584   !!======================================================================
585END MODULE sbcana_tam
Note: See TracBrowser for help on using the repository browser.