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.
nemotam.F90 in tags/TAM_v3_0/NEMOTAM/OPATAM_SRC – NEMO

source: tags/TAM_v3_0/NEMOTAM/OPATAM_SRC/nemotam.F90 @ 5643

Last change on this file since 5643 was 1885, checked in by rblod, 14 years ago

add TAM sources
  • Property svn:executable set to *
File size: 12.5 KB
Line 
1MODULE nemotam
2   !!==========================================================================
3   !!                       ***  MODULE nemovar ***
4   !! NEMOTAM system : Tangent and Adjoint for NEMO.
5   !!==========================================================================
6
7   !!----------------------------------------------------------------------
8   !!   nemotam_main   : Main driver routine for NEMOTAM
9   !!   nemotam_init   : Initialization of NEMOTAM
10   !!   nemotam_final  : Finish up NEMOTAM
11   !!----------------------------------------------------------------------
12   !! History :
13   !!   1.0  !  07-06  (K. Mogensen) Initial version
14   !!        !  09-06  (F. Vigilant)  Modified to split NEMOVAR / NEMOTAM
15   !!                                     module tamctl     i/o varctl
16   !!---------------------------------------------------------------------
17   !!----------------------------------------------------------------------
18   !! * Modules used
19   USE dom_oce         ! ocean space domain variables
20   USE lib_mpp         ! distributed memory computing
21   USE daymod          ! Date computations
22   USE in_out_manager  ! I/O manager
23   USE domcfg          ! domain configuration               (dom_cfg routine)
24   USE mppini          ! shared/distributed memory setting (mpp_init routine)
25   USE domain          ! domain initialization             (dom_init routine)
26   USE obc_par
27   USE obcini
28   USE phycst          ! physical constant                  (par_cst routine)
29   USE tamtrj          ! handling of the trajectory
30   USE tamctl          ! Control parameters
31   USE oce_tam         ! TL and adjoint data
32   USE sbc_oce_tam     ! Surface BCs tangent and adjoint arrays
33   USE trc_oce_tam     ! Trend tangent and adjoint arrays
34   USE sol_oce_tam     ! Solver tangent and adjoint arrays
35   USE tamtst          ! Gradient testing
36   ! ocean physics
37#if defined key_tam
38   USE ldfdyn        ! lateral viscosity setting  (ldfdyn_init routine)
39   USE ldftra        ! lateral diffusivity setting (ldftra_init routine)
40#endif
41   USE zdfini 
42
43#if defined key_tam
44   USE opatam_tst_ini, ONLY :  &
45     & opa_opatam_ini,          &
46     & opa_4_tst_ini,          &
47     & opatam_4_tst_ini
48#endif
49
50   IMPLICIT NONE
51   PRIVATE
52
53   !! * Module variables
54
55   CHARACTER (len=64) ::        &
56      cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
57   LOGICAL, PUBLIC :: lini = .TRUE.         ! initialisation flag
58
59   !! * Routine accessibility
60
61   PUBLIC &
62      & nemotam_main,           &
63      & nemotam_banner   
64
65CONTAINS
66
67   SUBROUTINE nemotam_main 
68      !!----------------------------------------------------------------------
69      !!                    ***  ROUTINE nemotam_main  ***
70      !!         
71      !! ** Purpose : Main driver routine for NEMOTAM
72      !!
73      !! ** Method  : Nothing yet
74      !!
75      !! ** Action  : Nothing yet
76      !!
77      !! History :
78      !!        !  07-06  (K. Mogensen) Original code
79      !!----------------------------------------------------------------------
80
81      !! * Local declarations
82
83      ! Initialize grids and observations
84      CALL nemotam_root
85
86      ! Main inner loop
87      CALL nemotam_sub
88
89      ! Close all open files.
90      CALL nemotam_final
91
92   END SUBROUTINE nemotam_main
93
94   SUBROUTINE nemotam_init
95      !!----------------------------------------------------------------------
96      !!                    ***  ROUTINE nemotam_init  ***
97      !!         
98      !! ** Purpose : Initialize grids and read observations and background
99      !!
100      !! ** Method  : Read the namelist and call reading routines
101      !!
102      !! ** Action  : Read the namelist and call reading routines
103      !!
104      !! History :
105      !!        !  07-06  (K. Mogensen) Original code
106      !!        !  01-09  (A. Weaver) Include ocean physics initialization
107      !!----------------------------------------------------------------------
108
109      !! * Local declarations
110      CHARACTER (len=128) :: file_out = 'nemovar.output'
111      CHARACTER (len=*), PARAMETER  ::  namelistname = 'namelist.nemovar' 
112      NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   &
113         &             isplt , jsplt , njctls, njctle, nbench, nbit_cmp
114
115      ! open listing and namelist units
116      CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   &
117         &         'SEQUENTIAL', 1, numout, .FALSE., 1 )
118      CALL nemotam_banner( numout )
119
120!      Commented as opening is done in Nemotam_root
121!      CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
122!         &           1, numout, .FALSE., 1 )
123
124      ! Namelist namctl : Control prints & Benchmark
125      REWIND( numnam )
126      READ  ( numnam, namctl )
127
128      ! Nodes selection
129      narea = mynode()
130      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 )
131      lwp   = narea == 1
132
133      ! open additionnal listing
134      IF( narea-1 > 0 )   THEN
135         WRITE(file_out,FMT="('nemotam.output_',I4.4)") narea-1
136         IF( numout /= 0 .AND. numout /= 6 ) THEN
137            CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   &
138               &         'SEQUENTIAL', 1, numout, .FALSE., 1 )
139         ENDIF
140         CALL nemotam_banner( numout )
141         lwp = .TRUE.
142         !
143      ENDIF     
144
145      IF(lwp) THEN
146         WRITE(numout,*)
147         WRITE(numout,*) 'nemotam_init: Control prints & Benchmark'
148         WRITE(numout,*) '~~~~~~~~~~~~ '
149         WRITE(numout,*) '          Namelist namctl'
150         WRITE(numout,*) '             run control (for debugging)     ln_ctl    = ', ln_ctl
151         WRITE(numout,*) '             level of print                  nprint    = ', nprint
152         WRITE(numout,*) '             bit comparison mode (0/1)       nbit_cmp  = ', nbit_cmp
153      ENDIF
154
155      IF( jpni*jpnj == jpnij ) THEN
156         CALL mpp_init                      ! standard cutting out
157      ELSE
158         CALL mpp_init2                     ! eliminate land processors
159      ENDIF
160     
161      CALL phy_cst                          ! Physical constants
162
163      CALL dom_cfg                          ! Domain configuration
164     
165      CALL dom_init                         ! Domain
166     
167      IF( lk_obc    )   CALL obc_init       ! Open boundaries
168
169      !                                     ! Ocean physics
170
171#if defined key_tam
172      CALL ldf_dyn_init                         ! Lateral ocean momentum physics
173
174      CALL ldf_tra_init                         ! Lateral ocean tracer physics
175#endif
176
177      CALL zdf_init                             ! Vertical ocean physics
178
179      CALL     oce_tam_init( 0 )            ! OCE TAM field
180      CALL sol_oce_tam_init( 0 )            ! Initialize elliptic solver
181      CALL trc_oce_tam_init( 0 )            ! TRC TAM fields
182#if defined key_tam
183      CALL sbc_oce_tam_init( 0 )            ! SBC TAM fields
184#endif
185      CALL     tam_trj_ini
186
187      CALL day( nit000 )
188
189   END SUBROUTINE nemotam_init
190
191   SUBROUTINE nemotam_sub
192      !!----------------------------------------------------------------------
193      !!                    ***  ROUTINE nemotam_sub  ***
194      !!         
195      !! ** Purpose : Main driver routine for the NEMOTAM
196      !!
197      !! ** Method  :
198      !!
199      !! ** Action  :
200      !!
201      !! History :
202      !!        !  07-08  (K. Mogensen) Original code based on appvar.F.
203      !!----------------------------------------------------------------------
204
205      !! * Local declarations
206      NAMELIST/namtst/ ln_tst, ln_tst_bkgadj, ln_tst_obsadj, ln_tst_nemotam, &
207         &             ln_tst_grad, ln_tst_cpd_tam, ln_tst_stp_tam, &
208         &             ln_tst_tan_cpd, ln_tst_tan
209
210      REAL(wp) :: &
211         & zcost,   &
212         & zcostf,  &
213         & zepsg,   &
214         & zctemp,  &
215         & zci_sim, &
216         & zgi_sim, &
217         & zcf_sim, &
218         & zgf_sim, &
219         & zcf_min, &
220         & zgf_min, &
221         & zcf_err, &
222         & zgf_err, &
223         & zcf_rel, &
224         & zgf_rel
225      INTEGER, DIMENSION(2) :: &
226         & izs
227      INTEGER :: &
228         & i_prec_vecs, &
229         & i_flag_rc,   &
230         & indic,       &
231         & ioutbef,     &
232         & iitr,        &
233         & isim,        &
234         & iabort
235      INTEGER :: &
236         & jnd1
237      CHARACTER(len=12) :: &
238         & clstp, &
239         & clend
240
241      i_flag_rc = 0
242
243      ln_tst         = .TRUE.
244      ln_tst_obsadj  = .FALSE.
245      ln_tst_bkgadj  = .FALSE.
246      ln_tst_nemotam = .FALSE.
247      ln_tst_grad    = .FALSE.
248      ln_tst_cpd_tam = .FALSE.
249      ln_tst_stp_tam = .FALSE.
250      ln_tst_tan_cpd = .FALSE.
251      ln_tst_tan     = .FALSE.
252
253      REWIND( numnam )
254      READ  ( numnam, namtst )
255
256      IF(lwp) THEN
257
258         WRITE(numout,*) ' namtst'
259         WRITE(numout,*) ' '
260         WRITE(numout,*) ' master switch for operator tests     ln_tst = ',ln_tst
261         WRITE(numout,*) ' switch for H adjoint tests    ln_tst_obsadj = ',ln_tst_obsadj
262         WRITE(numout,*) ' switch for B adjoint tests    ln_tst_bkgadj = ',ln_tst_bkgadj
263         WRITE(numout,*) ' switch for M adjoint tests   ln_tst_nemotam = ',ln_tst_nemotam
264         WRITE(numout,*) ' switch for gradient test        ln_tst_grad = ',ln_tst_grad
265         WRITE(numout,*) ' '
266
267      ENDIF
268
269      ! B.4 Tests
270
271      IF ( ln_tst ) CALL tstopt
272
273   END SUBROUTINE nemotam_sub
274
275   SUBROUTINE nemotam_final
276      !!----------------------------------------------------------------------
277      !!                    ***  ROUTINE nemotam_final ***
278      !!         
279      !! ** Purpose : Finalize the NEMOTAM run
280      !!
281      !! ** Method  : Close open files
282      !!
283      !! ** Action  : Close open files
284      !!
285      !! History :
286      !!        !  07-06  (K. Mogensen) Original code
287      !!----------------------------------------------------------------------
288
289      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
290
291      IF( nstop /= 0 ) THEN                 ! error print
292         IF(lwp) WRITE(numout,cform_err)
293         IF(lwp) WRITE(numout,*) nstop, ' error have been found' 
294      ENDIF
295
296      IF ( lk_mpp ) CALL mppsync
297
298      ! Unit close
299      ! ----------
300
301      CLOSE( numnam )       ! namelist
302      CLOSE( numout )       ! standard model output file
303      IF ( .NOT. lini ) THEN
304         CLOSE( numtan_sc )    ! tangent test diagnostic output
305         CLOSE( numtan )       ! tangent diagnostic output
306      ENDIF
307
308      IF ( lk_mpp ) CALL mppstop
309
310   END SUBROUTINE nemotam_final
311
312   SUBROUTINE nemotam_banner(kumout)
313      !!----------------------------------------------------------------------
314      !!                    ***  ROUTINE nemotam_banner ***
315      !!         
316      !! ** Purpose : Print a banner to a unit
317      !!
318      !! ** Method  : Fortran
319      !!
320      !! ** Action  : Fortran
321      !!
322      !! History :
323      !!        !  07-06  (A. Vidard) Original code
324      !!----------------------------------------------------------------------
325      !! * Arguments
326      INTEGER, INTENT(in) :: &
327         & kumout  ! Unit to print the banner to.
328
329      WRITE(kumout,*)
330      WRITE(kumout,*) '                         VODA '
331      WRITE(kumout,*) '             NEMO Tangent and Adjoint Model'
332      WRITE(kumout,*) '                    Version 3.0b  (2010) '
333      WRITE(kumout,*)
334
335   END SUBROUTINE nemotam_banner
336
337   SUBROUTINE nemotam_root
338      !!----------------------------------------------------------------------
339      !!                    ***  ROUTINE nemovar_root ***
340      !!         
341      !! ** Purpose : Choose which init must be done according to test
342      !!
343      !! ** Method  : Fortran
344      !!
345      !! ** Action  : Fortran
346      !!
347      !! History :
348      !!        !  09-07  (F. Vigilant) Original code
349      !!----------------------------------------------------------------------
350      !! * Local declarations
351      NAMELIST/namtst/ ln_tst, ln_tst_bkgadj, ln_tst_obsadj, ln_tst_nemotam, &
352         &             ln_tst_grad, ln_tst_cpd_tam, ln_tst_stp_tam, &
353         &             ln_tst_tan_cpd, ln_tst_tan
354      CHARACTER (len=*), PARAMETER  ::  namelistname = 'namelist.nemotam'
355      !! * Arguments
356
357      ln_tst         = .TRUE.
358      ln_tst_obsadj  = .FALSE.
359      ln_tst_bkgadj  = .FALSE.
360      ln_tst_nemotam = .FALSE.
361      ln_tst_grad    = .FALSE.
362      ln_tst_cpd_tam = .FALSE.
363      ln_tst_stp_tam = .FALSE.
364      ln_tst_tan_cpd = .FALSE.
365      ln_tst_tan     = .FALSE.
366
367      CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
368         &           1, numout, .FALSE., 1 )
369
370      REWIND( numnam )
371      READ  ( numnam, namtst )
372
373      IF ( ln_tst_tan ) THEN
374         CALL  opa_opatam_ini
375         lini = .FALSE.            ! not standard initialisation
376      ELSE
377         CALL nemotam_init
378      END IF
379
380   END SUBROUTINE nemotam_root
381
382END MODULE nemotam
Note: See TracBrowser for help on using the repository browser.