source: trunk/NEMOGCM/NEMO/OPA_SRC/TAM/tamtrj.F90 @ 3604

Last change on this file since 3604 was 3604, checked in by rblod, 8 years ago

Adding routines and modules for TAM - Ticket #1005

  • Property svn:executable set to *
File size: 8.7 KB
Line 
1MODULE tamtrj
2   !!======================================================================
3   !!                       ***  MODULE tamtrj  ***
4   !! Tangent and adjoint  trajectory interface: Write to file
5   !!                                    the model state trajectory
6   !!======================================================================
7   !!----------------------------------------------------------------------
8   !!   tam_trj_ini  : init: read the namelist
9   !!   tam_trj_wri  : Write out the model state trajectory
10   !!----------------------------------------------------------------------
11   !! * Modules used
12   USE oce                ! Dynamics and active tracers defined in memory
13   USE sbc_oce            ! Ocean surface boundary conditions
14   USE zdf_oce            ! Vertical mixing variables
15#if defined key_zdfddm
16   USE zdfddm             ! Double diffusion mixing parameterization
17#endif
18   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
19#if   defined key_ldfslp
20   USE ldfslp
21#endif
22#if defined key_traldf_c2d
23   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
24#endif
25#if defined key_zdftke
26   USE zdftke             ! TKE vertical physics
27#endif
28   USE eosbn2             ! Equation of state (eos_bn2 routine)
29   USE zdfbfr
30   USE tradmp             ! Tracer damping
31   USE sol_oce
32   USE trc_oce
33   USE in_out_manager
34   USE dom_oce
35   USE iom                 ! I/O module
36   USE zdfmxl
37
38   IMPLICIT NONE
39
40   !! * Routine accessibility
41   PRIVATE
42   PUBLIC tam_trj_init, &  !: Write out the background state
43      &   tam_trj_wri      !: Write out the background state
44
45   LOGICAL, PUBLIC :: &
46      & ln_trjhand = .FALSE.   !: No output of the state trajectory fields
47
48   LOGICAL :: &
49      & ln_trj_spl            !: save the trajectory at simple precision
50
51   CHARACTER (LEN=40), PUBLIC :: &
52      & cn_dirtrj                                  !: Filename for storing the
53                                                   !: reference trajectory
54   INTEGER, PUBLIC :: &
55      & nn_ittrjfrq         !: Frequency of trajectory output for 4D-VAR
56
57CONTAINS
58   SUBROUTINE tam_trj_init
59      !!-----------------------------------------------------------------------
60      !!
61      !!                  ***  ROUTINE tam_trj_init ***
62      !!
63      !! ** Purpose : initialize the model state trajectory
64      !!
65      !! ** Method  :
66      !!
67      !! ** Action  :
68      !!
69      !! References :
70      !!
71      !! History :
72      !!        ! 10-01 (A. Vidard)
73      !!-----------------------------------------------------------------------
74
75      IMPLICIT NONE
76
77      !! * Modules used
78      NAMELIST/namtrj/ nn_ittrjfrq, ln_trjhand, cn_dirtrj, ln_trj_spl
79
80      cn_dirtrj   = 'tam_trajectory'
81      ln_trjhand = .FALSE.
82      nn_ittrjfrq = 1
83      ln_trj_spl  = .TRUE.
84
85      REWIND ( numnam )
86      READ   ( numnam, namtrj )
87
88      ! Control print
89      IF(lwp) THEN
90         WRITE(numout,*)
91         WRITE(numout,*) 'tam_trj_ini : Trajectory handling:'
92         WRITE(numout,*) '~~~~~~~~~~~~'
93         WRITE(numout,*) '          Namelist namtam : set trajectory parameters'
94         WRITE(numout,*) '             Logical switch for handling state trajectory         ', &
95            &            ' ln_trjhand = ', ln_trjhand
96         WRITE(numout,*) '             Logical switch for handling it at simple precision       ', &
97            &            ' ln_trj_spl  = ', ln_trj_spl
98         WRITE(numout,*) '             Frequency of trajectory output (or input for TAM)                          ', &
99            &            ' nn_ittrjfrq = ', nn_ittrjfrq
100      END IF
101   END SUBROUTINE tam_trj_init
102   SUBROUTINE tam_trj_wri( kt )
103      !!-----------------------------------------------------------------------
104      !!
105      !!                  ***  ROUTINE tam_trj_wri ***
106      !!
107      !! ** Purpose : Write to file the model state trajectory
108      !!
109      !! ** Method  :
110      !!
111      !! ** Action  :
112      !!
113      !! References :
114      !!
115      !! History :
116      !!        ! 2007-04 (A. Weaver)
117      !!        ! 2009-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2
118      !!        ! 2009-06 (F. Vigilant) special case when kt=nit000-1
119      !!        ! 2009-07 (F. Vigilant) add computation of eiv at restart
120      !!        ! 2010-01 (A. Vidard) asm_trj_wri->tam_trj_wri
121      !!        ! 2010-04 (F. Vigilant) converison to 3.2
122      !!-----------------------------------------------------------------------
123
124      !! * Arguments
125      INTEGER, INTENT( IN ) :: &
126         & kt                    ! Current time-step
127
128      !! * Local declarations
129      INTEGER :: &
130         & inum                  ! File unit number
131      INTEGER :: &
132         & it
133      INTEGER :: &
134         & ntype
135      CHARACTER (LEN=50) :: &
136         & cl_dirtrj
137      REAL(wp) :: &
138         & zdate            ! Date
139
140      IF ( ln_trj_spl ) THEN ; ntype = jp_r4
141                        ELSE ; ntype = jp_r8 ; ENDIF
142      !------------------------------------------------------------------------
143      ! Write a single file for each trajectory time step
144      !------------------------------------------------------------------------
145      !------------------------------------------------------------------------
146      ! Write a single file for each trajectory time step
147      !------------------------------------------------------------------------
148      IF( ( MOD( kt - nit000 + 1, nn_ittrjfrq ) == 0 ) .OR. ( kt == nitend ) ) THEN
149
150         IF( kt == nit000 - 1 ) THEN         ! Treat special case when kt = nit000-1
151            !
152#if defined key_zdftke
153            IF(lwp) WRITE(numout,*) ' Computing  zdf_tke coeff. form restart...'
154            ! Compute the vertical eddy viscosity and diffusivity coefficients
155            CALL zdf_tke( nit000 )
156#endif
157#if defined key_zdfddm
158            IF(lwp) WRITE(numout,*) ' Computing zdf_ddm coeff. from restart...'
159            ! Compute the vertical eddy viscosity and diffusivity coefficients (salt effect)
160            CALL zdf_ddm( nit000 )
161#endif
162            IF(lwp) WRITE(numout,*) ' Computing zdf_mxl coeff. from restart...'
163            ! Compute the turbocline depth and the mixed layer depth
164            CALL zdf_mxl( nit000 )
165#if defined key_ldfslp
166            IF(lwp) WRITE(numout,*) ' Compute the slopes of neutral surface...'
167            CALL bn2( tsb, rn2 )
168            CALL ldf_slp( nit000, rhd, rn2 )
169#endif
170#if defined key_traldf_c2d
171            IF(lwp) WRITE(numout,*) ' Computing ldf_eiv coeff. from restart...'
172            ! Compute eddy induced velocity coefficient
173            IF( lk_traldf_eiv )   CALL ldf_eiv( nit000 )
174#endif
175         ENDIF
176         !
177         it = kt - nit000 + 1
178         !
179         ! Define the output file
180         WRITE(cl_dirtrj, FMT='(I5.5,A,A)' ) it, '_', TRIM( cn_dirtrj )
181         cl_dirtrj = TRIM( cl_dirtrj )
182         CALL iom_open( cl_dirtrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
183
184         ! Output trajectory fields
185         CALL iom_rstput( it, it, inum, 'emp'   , emp   , ktype = ntype )
186         CALL iom_rstput( it, it, inum, 'emps'  , emps  , ktype = ntype )
187         CALL iom_rstput( it, it, inum, 'un'    , un    , ktype = ntype )
188         CALL iom_rstput( it, it, inum, 'vn'    , vn    , ktype = ntype )
189         CALL iom_rstput( it, it, inum, 'tn'    , tsn(:,:,:,jp_tem)    , ktype = ntype )
190         CALL iom_rstput( it, it, inum, 'sn'    , tsn(:,:,:,jp_sal)    , ktype = ntype )
191         CALL iom_rstput( it, it, inum, 'avmu'  , avmu  , ktype = ntype )
192         CALL iom_rstput( it, it, inum, 'avmv'  , avmv  , ktype = ntype )
193         CALL iom_rstput( it, it, inum, 'avt'   , avt   , ktype = ntype )
194         CALL iom_rstput( it, it, inum, 'bfrua' , bfrua , ktype = ntype )
195         CALL iom_rstput( it, it, inum, 'bfrva' , bfrva , ktype = ntype )
196         CALL iom_rstput( it, it, inum, 'etot3' , etot3 , ktype = ntype )
197#if defined key_ldfslp
198         CALL iom_rstput( it, it, inum, 'uslp'  , uslp  , ktype = ntype )
199         CALL iom_rstput( it, it, inum, 'vslp'  , vslp  , ktype = ntype )
200         CALL iom_rstput( it, it, inum, 'wslpi' , wslpi , ktype = ntype )
201         CALL iom_rstput( it, it, inum, 'wslpj' , wslpj , ktype = ntype )
202#endif
203#if defined key_zdfddm
204         CALL iom_rstput( it, it, inum, 'avs'   , avs , ktype = ntype )
205#endif
206         IF( ln_tradmp ) THEN
207            CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp  , ktype = ntype )
208            CALL iom_rstput( it, it, inum, 'strdmp', strdmp, ktype = ntype )
209         END IF
210         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu, ktype = ntype )
211         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv, ktype = ntype )
212         CALL iom_rstput( it, it, inum, 'aeiw'  , aeiw, ktype = ntype )
213
214         CALL iom_close( inum )
215
216      ENDIF
217
218   END SUBROUTINE tam_trj_wri
219END MODULE tamtrj
Note: See TracBrowser for help on using the repository browser.