source: NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/TAM/trj_tam.F90 @ 11774

Last change on this file since 11774 was 11774, checked in by smueller, 12 months ago

Correction of the state-variable advancement in adjoint mode (application of the patch attached to ticket #1443)

  • Property svn:executable set to *
File size: 33.0 KB
Line 
1MODULE trj_tam
2#ifdef key_tam
3   !!======================================================================
4   !!                       ***  MODULE trj_tam ***
5   !! NEMOVAR trajectory: Allocate and read the trajectory for linearzation
6   !!======================================================================
7
8   !!----------------------------------------------------------------------
9   !!----------------------------------------------------------------------
10   !!   bkg_init : Initialize the background fields from disk
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE par_oce
14   USE tamtrj             ! Parameters for the assmilation interface
15   USE in_out_manager
16   USE oce                ! Model variables
17   USE zdf_oce            ! Vertical mixing variables
18   USE zdfddm             ! Double diffusion mixing parameterization
19   USE zdfbfr
20   USE trc_oce
21   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
22   USE ldfslp             ! Slopes of neutral surfaces
23   USE tradmp             ! Tracer damping
24   USE sbc_oce            ! Ocean surface boundary conditions
25   USE iom                ! Library to read input files
26   USE zdfmxl
27   USE divcur             ! horizontal divergence and relative vorticity
28   USE sshwzv
29   USE oce_tam
30
31   IMPLICIT NONE
32
33   !! * Routine accessibility
34   PRIVATE
35   PUBLIC &
36      & trj_rea,     &   !: Read trajectory at time step kstep into now fields
37      & trj_rd_spl,  &   !: Read simple data (without interpolation)
38      & trj_wri_spl, &   !: Write simple data (without interpolation)
39      & tl_trj_wri,  &   !: Write simple linear-tangent data
40      & tl_trj_ini,  &   !: initialize the model-tangent state trajectory
41      & trj_deallocate   !: Deallocate all the saved variable
42
43   LOGICAL, PUBLIC :: &
44      & ln_trjwri_tan = .FALSE.   !: No output of the state trajectory fields
45
46   CHARACTER (LEN=40), PUBLIC :: &
47      & cn_tantrj                                  !: Filename for storing the
48                                                   !: linear-tangent trajectory
49   INTEGER, PUBLIC :: &
50      & nn_ittrjfrq_tan         !: Frequency of trajectory output for linear-tangent
51
52   !! * Module variables
53   LOGICAL, SAVE :: &
54      & ln_mem = .FALSE.      !: Flag for allocation
55   INTEGER, SAVE :: inumtrj1 = -1, inumtrj2 = -1
56   REAL(wp), SAVE :: &
57      & stpr1, &
58      & stpr2
59   REAL(wp), ALLOCATABLE, DIMENSION(:,:), SAVE :: &
60      & empr1,    &
61      & empsr1,   &
62      & empr2,    &
63      & empsr2,   &
64      & bfruar1,  &
65      & bfrvar1,  &
66      & bfruar2,  &
67      & bfrvar2
68#if defined key_traldf_eiv
69#if defined key_traldf_c3d
70   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: &
71#elif defined key_traldf_c2d
72   REAL(wp), ALLOCATABLE, DIMENSION(:,:), SAVE :: &
73#elif defined key_traldf_c1d
74   REAL(wp), ALLOCATABLE, DIMENSION(:), SAVE :: &
75#else
76   REAL(wp) ::
77#endif
78      & aeiur1,   &
79      & aeivr1,   &
80      & aeiwr1,   &
81      & aeiur2,   &
82      & aeivr2,   &
83      & aeiwr2
84#endif
85  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: &
86      & unr1,     &
87      & vnr1,     &
88      & tnr1,     &
89      & snr1,     &
90      & avmur1,   &
91      & avmvr1,   &
92      & avtr1,    &
93      & uslpr1,   &
94      & vslpr1,   &
95      & wslpir1,  &
96      & wslpjr1,  &
97      & avsr1,    &
98      & etot3r1,  &
99      & unr2,     &
100      & vnr2,     &
101      & tnr2,     &
102      & snr2,     &
103      & avmur2,   &
104      & avmvr2,   &
105      & avtr2,    &
106      & uslpr2,   &
107      & vslpr2,   &
108      & wslpir2,  &
109      & wslpjr2,  &
110      & avsr2,    &
111      & etot3r2
112  REAL(wp), ALLOCATABLE, DIMENSION(:,:), SAVE :: &
113      & hmlp1,    &
114      & hmlp2
115
116CONTAINS
117
118   SUBROUTINE tl_trj_ini
119      !!-----------------------------------------------------------------------
120      !!
121      !!                  ***  ROUTINE tl_trj_ini ***
122      !!
123      !! ** Purpose : initialize the model-tangent state trajectory
124      !!
125      !! ** Method  :
126      !!
127      !! ** Action  :
128      !!
129      !! References :
130      !!
131      !! History :
132      !!        ! 10-07 (F. Vigilant)
133      !!-----------------------------------------------------------------------
134
135      IMPLICIT NONE
136
137      !! * Modules used
138      NAMELIST/namtl_trj/ nn_ittrjfrq_tan, ln_trjwri_tan, cn_tantrj
139
140      ln_trjwri_tan = .FALSE.
141      nn_ittrjfrq_tan = 1
142      cn_tantrj = 'tl_trajectory'
143      REWIND ( numnam )
144      READ   ( numnam, namtl_trj )
145
146      ! Control print
147      IF(lwp) THEN
148         WRITE(numout,*)
149         WRITE(numout,*) 'tl_trj_ini : Linear-Tagent Trajectory handling:'
150         WRITE(numout,*) '~~~~~~~~~~~~'
151         WRITE(numout,*) '          Namelist namtl_trj : set trajectory parameters'
152         WRITE(numout,*) '             Logical switch for writing out state trajectory         ', &
153            &            ' ln_trjwri_tan = ', ln_trjwri_tan
154         WRITE(numout,*) '             Frequency of trajectory output                          ', &
155            &            ' nn_ittrjfrq_tan = ', nn_ittrjfrq_tan
156      END IF
157   END SUBROUTINE tl_trj_ini
158
159   SUBROUTINE trj_rea( kstp, kdir )
160      !!-----------------------------------------------------------------------
161      !!
162      !!                  ***  ROUTINE trj_reat  ***
163      !!
164      !! ** Purpose : Read from file the trjectory from the outer loop
165      !!
166      !! ** Method  : IOM
167      !!
168      !! ** Action  :
169      !!
170      !! References :
171      !!
172      !! History :
173      !!        ! 08-05 (K. Mogensen) Initial version
174      !!        ! 09-03 (F.Vigilant) Add reading of hmlp and calls (divcur, wzvmod)
175      !!        ! 2010-04 (F. Vigilant) converison to 3.2
176      !!        ! 2012-07 (P.-A. Bouttier) converison to 3.4
177      !!-----------------------------------------------------------------------
178      !! * Modules used
179      !! * Arguments
180      INTEGER, INTENT(in) :: &
181         & kstp, &           ! Step for requested trajectory
182         & kdir              ! Direction for stepping (1 forward, -1 backward)
183      !! * Local declarations
184      CHARACTER (LEN=100) :: &
185         & cl_dirtrj
186      INTEGER :: &
187         & inrcm,  &
188         & inrcp,  &
189         & inrc,   &
190         & istpr1, &
191         & istpr2, &
192    & it
193      REAL(KIND=wp) :: &
194         & zwtr1, &
195         & zwtr2, &
196         & zden,  &
197         & zstp
198      ! Initialize data and open file
199      !! if step time is corresponding to a saved state
200      IF ( ( MOD( kstp - nit000 + 1, nn_ittrjfrq ) == 0 )  ) THEN
201
202         it = kstp - nit000 + 1
203
204         IF ( inumtrj1 == -1 ) THEN
205
206            ! Define the input file
207            WRITE(cl_dirtrj, FMT='(I5.5,A,A,".nc")' ) it, '_', TRIM( cn_dirtrj )
208
209            !         WRITE(cl_dirtrj, FMT='(A,".nc")' ) TRIM( c_dirtrj )
210            cl_dirtrj = TRIM( cl_dirtrj )
211
212            IF(lwp) THEN
213
214               WRITE(numout,*)
215               WRITE(numout,*)'Reading non-linear fields from : ',TRIM(cl_dirtrj)
216               WRITE(numout,*)
217
218            ENDIF
219            CALL iom_open( cl_dirtrj, inumtrj1 )
220            if ( inumtrj1 == -1)  CALL ctl_stop( 'No tam_trajectory cl_amstrj found' )
221            IF ( .NOT. ln_mem ) THEN
222               ALLOCATE( &
223                  & empr1(jpi,jpj),  &
224                  & empsr1(jpi,jpj), &
225                  & empr2(jpi,jpj),  &
226                  & empsr2(jpi,jpj), &
227                  & bfruar1(jpi,jpj),&
228                  & bfrvar1(jpi,jpj),&
229                  & bfruar2(jpi,jpj),&
230                  & bfrvar2(jpi,jpj) &
231                  & )
232
233               ALLOCATE( &
234                  & unr1(jpi,jpj,jpk),     &
235                  & vnr1(jpi,jpj,jpk),     &
236                  & tnr1(jpi,jpj,jpk),     &
237                  & snr1(jpi,jpj,jpk),     &
238                  & avmur1(jpi,jpj,jpk),   &
239                  & avmvr1(jpi,jpj,jpk),   &
240                  & avtr1(jpi,jpj,jpk),    &
241                  & etot3r1(jpi,jpj,jpk),  &
242                  & unr2(jpi,jpj,jpk),     &
243                  & vnr2(jpi,jpj,jpk),     &
244                  & tnr2(jpi,jpj,jpk),     &
245                  & snr2(jpi,jpj,jpk),     &
246                  & avmur2(jpi,jpj,jpk),   &
247                  & avmvr2(jpi,jpj,jpk),   &
248                  & avtr2(jpi,jpj,jpk),    &
249                  & etot3r2(jpi,jpj,jpk)   &
250                  & )
251#if defined key_traldf_eiv
252#if defined key_traldf_c3d
253#elif defined key_traldf_c2d
254               ALLOCATE( &
255                  & aeiur1(jpi,jpj), &
256                  & aeivr1(jpi,jpj), &
257                  & aeiwr1(jpi,jpj), &
258                  & aeiur2(jpi,jpj), &
259                  & aeivr2(jpi,jpj), &
260                  & aeiwr2(jpi,jpj)  &
261                  & )
262#elif defined key_traldf_c1d
263#endif
264#endif
265
266#if defined key_ldfslp
267               ALLOCATE( &
268                  & uslpr1(jpi,jpj,jpk),   &
269                  & vslpr1(jpi,jpj,jpk),   &
270                  & wslpir1(jpi,jpj,jpk),  &
271                  & wslpjr1(jpi,jpj,jpk),  &
272                  & uslpr2(jpi,jpj,jpk),   &
273                  & vslpr2(jpi,jpj,jpk),   &
274                  & wslpir2(jpi,jpj,jpk),  &
275                  & wslpjr2(jpi,jpj,jpk)   &
276                  & )
277#endif
278
279#if defined key_zdfddm
280               ALLOCATE( &
281                  & avsr1(jpi,jpj,jpk),    &
282                  & avsr2(jpi,jpj,jpk)     &
283                  & )
284#endif
285
286#if defined key_tradmp
287               ALLOCATE( &
288                  & hmlp1(jpi,jpj),    &
289                  & hmlp2(jpi,jpj)     &
290                  & )
291#endif
292               ln_mem = .TRUE.
293            ENDIF
294         ENDIF
295
296
297      ! Read records
298
299         inrcm = INT( ( kstp - nit000 + 1 ) / nn_ittrjfrq ) + 1
300
301         ! Copy record 1 into record 2
302
303         IF ( ( kstp /= nitend )         .AND. &
304            & ( kstp - nit000 + 1 /= 0 ) .AND. &
305            & ( kdir == -1 ) ) THEN
306
307            stpr2           = stpr1
308
309            empr2   (:,:)   = empr1   (:,:)
310            empsr2  (:,:)   = empsr1  (:,:)
311            bfruar2  (:,:)  = bfruar1 (:,:)
312            bfrvar2  (:,:)  = bfrvar1 (:,:)
313
314            unr2    (:,:,:) = unr1    (:,:,:)
315            vnr2    (:,:,:) = vnr1    (:,:,:)
316            tnr2    (:,:,:) = tnr1    (:,:,:)
317            snr2    (:,:,:) = snr1    (:,:,:)
318            avmur2  (:,:,:) = avmur1  (:,:,:)
319            avmvr2  (:,:,:) = avmvr1  (:,:,:)
320            avtr2   (:,:,:) = avtr1   (:,:,:)
321#if defined key_ldfslp
322            uslpr2  (:,:,:) = uslpr1  (:,:,:)
323            vslpr2  (:,:,:) = vslpr1  (:,:,:)
324            wslpir2 (:,:,:) = wslpir1 (:,:,:)
325            wslpjr2 (:,:,:) = wslpjr1 (:,:,:)
326#endif
327#if defined key_zdfddm
328            avsr2   (:,:,:) = avsr1   (:,:,:)
329#endif
330            etot3r2 (:,:,:) = etot3r1 (:,:,:)
331#if defined key_tradmp
332            hmlp1   (:,:)   = hmlp2   (:,:)
333#endif
334#if defined key_traldf_eiv
335#if defined key_traldf_c3d
336            aeiur2  (:,:,:) = aeiur1  (:,:,:)
337            aeivr2  (:,:,:) = aeivr1  (:,:.:)
338            aeiwr2  (:,:,:) = aeiwr1  (:,:.:)
339#elif defined key_traldf_c2d
340            aeiur2  (:,:)   = aeiur1  (:,:)
341            aeivr2  (:,:)   = aeivr1  (:,:)
342            aeiwr2  (:,:)   = aeiwr1  (:,:)
343#elif defined key_traldf_c1d
344            aeiur2  (:)     = aeiur1  (:)
345            aeivr2  (:)     = aeivr1  (:)
346            aeiwr2  (:)     = aeiwr1  (:)
347#else
348            aeiur2          = aeiur1
349            aeivr2          = aeivr1
350            aeiwr2          = aeiwr1
351#endif
352#endif
353
354            istpr1 = INT( stpr1 )
355
356            IF(lwp) WRITE(numout,*) &
357               &                 '    Trajectory record copy time step = ', istpr1
358
359         ENDIF
360
361         IF ( ( kstp - nit000 + 1 /= 0 ) .AND. ( kdir == -1 ) ) THEN
362            ! We update the input filename
363            WRITE(cl_dirtrj, FMT='(I5.5,A,A,".nc")' ) (it-nn_ittrjfrq), '_', TRIM(cn_dirtrj )
364            cl_dirtrj = TRIM( cl_dirtrj )
365            IF(lwp) THEN
366               WRITE(numout,*)
367               WRITE(numout,*)'Reading non-linear fields from : ',TRIM(cl_dirtrj)
368               WRITE(numout,*)
369            ENDIF
370         ENDIF
371
372         ! Read record 1
373
374         IF ( ( kstp - nit000 + 1 == 0 ) .AND.( kdir == 1           ) .OR. &
375            & ( kstp - nit000 + 1 /= 0 ) .AND.( kdir == -1          ) ) THEN
376
377            IF ( kdir == -1 ) inrcm = inrcm - 1
378!            inrc = inrcm
379            ! temporary fix: currently, only one field by step time
380            inrc = 1
381            stpr1 = (inrcm - 1) * nn_ittrjfrq
382
383            ! bug fixed to read several time the initial data
384            IF ( ( kstp - nit000 + 1 == 0 ) .AND. ( kdir == 1 ) ) THEN
385               ! Define the input file
386               WRITE(cl_dirtrj, FMT='(I5.5, A,A,".nc")' ) it, '_', TRIM( cn_dirtrj )
387
388               cl_dirtrj = TRIM( cl_dirtrj )
389
390               IF(lwp) THEN
391                  WRITE(numout,*)
392                  WRITE(numout,*)'Reading non-linear fields from : ',TRIM(cl_dirtrj)
393                  WRITE(numout,*)
394               ENDIF
395            END IF
396            IF ( inumtrj1 /= -1 )   CALL iom_open( cl_dirtrj, inumtrj1 )
397
398            CALL iom_get( inumtrj1, jpdom_autoglo, 'emp'   , empr1   , inrc )
399            CALL iom_get( inumtrj1, jpdom_autoglo, 'emps'  , empsr1  , inrc )
400            CALL iom_get( inumtrj1, jpdom_autoglo, 'un'    , unr1    , inrc )
401            CALL iom_get( inumtrj1, jpdom_autoglo, 'vn'    , vnr1    , inrc )
402            CALL iom_get( inumtrj1, jpdom_autoglo, 'tn'    , tnr1    , inrc )
403            CALL iom_get( inumtrj1, jpdom_autoglo, 'sn'    , snr1    , inrc )
404            CALL iom_get( inumtrj1, jpdom_autoglo, 'avmu'  , avmur1  , inrc )
405            CALL iom_get( inumtrj1, jpdom_autoglo, 'avmv'  , avmvr1  , inrc )
406            CALL iom_get( inumtrj1, jpdom_autoglo, 'avt'   , avtr1   , inrc )
407            CALL iom_get( inumtrj1, jpdom_autoglo, 'bfrua' , bfruar1 , inrc )
408            CALL iom_get( inumtrj1, jpdom_autoglo, 'bfrva' , bfrvar1 , inrc )
409#if defined key_ldfslp
410            CALL iom_get( inumtrj1, jpdom_autoglo, 'uslp'  , uslpr1  , inrc )
411            CALL iom_get( inumtrj1, jpdom_autoglo, 'vslp'  , vslpr1  , inrc )
412            CALL iom_get( inumtrj1, jpdom_autoglo, 'wslpi' , wslpir1 , inrc )
413            CALL iom_get( inumtrj1, jpdom_autoglo, 'wslpj' , wslpjr1 , inrc )
414#endif
415#if defined key_zdfddm
416            CALL iom_get( inumtrj1, jpdom_autoglo, 'avs'   , avsr1   , inrc )
417#endif
418            CALL iom_get( inumtrj1, jpdom_autoglo, 'etot3' , etot3r1 , inrc )
419#if defined key_tradmp
420            CALL iom_get( inumtrj1, jpdom_autoglo, 'hmlp'  , hmlp1   , inrc )
421#endif
422#if defined key_traldf_eiv
423            CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiu'  , aeiur1  , inrc )
424            CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiv'  , aeivr1  , inrc )
425            CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiw'  , aeiwr1  , inrc )
426#endif
427            CALL iom_close( inumtrj1 )
428
429            istpr1 = INT( stpr1 )
430            IF(lwp)WRITE(numout,*) '   trajectory read time step = ', istpr1,&
431               &                   '  record = ', inrc
432
433         ENDIF
434
435
436         ! Copy record 2 into record 1
437
438         IF ( ( kstp - nit000 + 1 /= 0 ) .AND. &
439            & ( kstp /= nitend         ) .AND. &
440            & ( kdir == 1              ) ) THEN
441
442            stpr1           = stpr2
443            empr1   (:,:)   = empr2   (:,:)
444            empsr1  (:,:)   = empsr2  (:,:)
445            bfruar1 (:,:)   = bfruar2 (:,:)
446            bfrvar1 (:,:)   = bfrvar2 (:,:)
447            unr1    (:,:,:) = unr2    (:,:,:)
448            vnr1    (:,:,:) = vnr2    (:,:,:)
449            tnr1    (:,:,:) = tnr2    (:,:,:)
450            snr1    (:,:,:) = snr2    (:,:,:)
451            avmur1  (:,:,:) = avmur2  (:,:,:)
452            avmvr1  (:,:,:) = avmvr2  (:,:,:)
453            avtr1   (:,:,:) = avtr2   (:,:,:)
454#if defined key_ldfslp
455            uslpr1  (:,:,:) = uslpr2  (:,:,:)
456            vslpr1  (:,:,:) = vslpr2  (:,:,:)
457            wslpir1 (:,:,:) = wslpir2 (:,:,:)
458            wslpjr1 (:,:,:) = wslpjr2 (:,:,:)
459#endif
460#if defined key_zdfddm
461            avsr1   (:,:,:) = avsr2   (:,:,:)
462#endif
463            etot3r1 (:,:,:) = etot3r2 (:,:,:)
464#if defined key_tradmp
465            hmlp1   (:,:)   = hmlp2   (:,:)
466#endif
467#if defined key_traldf_eiv
468#if defined key_traldf_c3d
469            aeiur1  (:,:,:) = aeiur2  (:,:,:)
470            aeivr1  (:,:,:) = aeivr2  (:,:.:)
471            aeiwr1  (:,:,:) = aeiwr2  (:,:.:)
472#elif defined key_traldf_c2d
473            aeiur1  (:,:)   = aeiur2  (:,:)
474            aeivr1  (:,:)   = aeivr2  (:,:)
475            aeiwr1  (:,:)   = aeiwr2  (:,:)
476#elif defined key_traldf_c1d
477            aeiur1  (:)     = aeiur2  (:)
478            aeivr1  (:)     = aeivr2  (:)
479            aeiwr1  (:)     = aeiwr2  (:)
480#else
481            aeiur1          = aeiur2
482            aeivr1          = aeivr2
483            aeiwr1          = aeiwr2
484#endif
485#endif
486
487            istpr1 = INT( stpr1 )
488            IF(lwp) WRITE(numout,*) &
489               &                 '   Trajectory record copy time step = ', istpr1
490
491         ENDIF
492
493         ! Read record 2
494
495         IF ( ( ( kstp /= nitend ) .AND. ( kdir == 1  )) .OR. &
496            &   ( kstp == nitend ) .AND.(  kdir == -1   ) ) THEN
497
498               ! Define the input file
499               IF  (  kdir == -1   ) THEN
500                   WRITE(cl_dirtrj, FMT='(I5.5,A,A,".nc")' ) it, '_', TRIM( cn_dirtrj )
501               ELSE
502                  WRITE(cl_dirtrj, FMT='(I5.5,A,A,".nc")' ) (it+nn_ittrjfrq), '_', TRIM( cn_dirtrj )
503               ENDIF
504               cl_dirtrj = TRIM( cl_dirtrj )
505
506               IF(lwp) THEN
507                  WRITE(numout,*)
508                  WRITE(numout,*)'Reading non-linear fields from : ',TRIM(cl_dirtrj)
509                  WRITE(numout,*)
510               ENDIF
511
512               CALL iom_open( cl_dirtrj, inumtrj2 )
513
514
515            inrcp = inrcm + 1
516            !            inrc  = inrcp
517            inrc = 1  ! temporary  fix
518
519            stpr2 = (inrcp - 1) * nn_ittrjfrq
520            CALL iom_get( inumtrj2, jpdom_autoglo, 'emp'   , empr2   , inrc )
521            CALL iom_get( inumtrj2, jpdom_autoglo, 'emps'  , empsr2  , inrc )
522            CALL iom_get( inumtrj2, jpdom_autoglo, 'un'    , unr2    , inrc )
523            CALL iom_get( inumtrj2, jpdom_autoglo, 'vn'    , vnr2    , inrc )
524            CALL iom_get( inumtrj2, jpdom_autoglo, 'tn'    , tnr2    , inrc )
525            CALL iom_get( inumtrj2, jpdom_autoglo, 'sn'    , snr2    , inrc )
526            CALL iom_get( inumtrj2, jpdom_autoglo, 'avmu'  , avmur2  , inrc )
527            CALL iom_get( inumtrj2, jpdom_autoglo, 'avmv'  , avmvr2  , inrc )
528            CALL iom_get( inumtrj2, jpdom_autoglo, 'avt'   , avtr2   , inrc )
529            CALL iom_get( inumtrj2, jpdom_autoglo, 'bfrua' , bfruar2 , inrc )
530            CALL iom_get( inumtrj2, jpdom_autoglo, 'bfrva' , bfrvar2 , inrc )
531#if defined key_ldfslp
532            CALL iom_get( inumtrj2, jpdom_autoglo, 'uslp'  , uslpr2  , inrc )
533            CALL iom_get( inumtrj2, jpdom_autoglo, 'vslp'  , vslpr2  , inrc )
534            CALL iom_get( inumtrj2, jpdom_autoglo, 'wslpi' , wslpir2 , inrc )
535            CALL iom_get( inumtrj2, jpdom_autoglo, 'wslpj' , wslpjr2 , inrc )
536#endif
537#if defined key_zdfddm
538            CALL iom_get( inumtrj2, jpdom_autoglo, 'avs'   , avsr2   , inrc )
539#endif
540            CALL iom_get( inumtrj2, jpdom_autoglo, 'etot3' , etot3r2 , inrc )
541#if defined key_tradmp
542            CALL iom_get( inumtrj2, jpdom_autoglo, 'hmlp'  , hmlp2   , inrc )
543#endif
544#if defined key_traldf_eiv
545            CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiu'  , aeiur2  , inrc )
546            CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiv'  , aeivr2  , inrc )
547            CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiw'  , aeiwr2  , inrc )
548#endif
549            CALL iom_close( inumtrj2 )
550
551            istpr2 = INT( stpr2 )
552            IF(lwp)WRITE(numout,*) '   trajectory read2 time step = ', istpr2,&
553               &                   '  record = ', inrc
554         ENDIF
555
556      ENDIF
557
558      ! Add warning for user
559      IF ( (kstp == nitend) .AND. ( MOD( kstp - nit000 + 1, nn_ittrjfrq ) /= 0 )  ) THEN
560          IF(lwp) WRITE(numout,*) '   Warning ! nitend (=',nitend, ')', &
561               &                  ' and saving frequency (=',nn_ittrjfrq,') not compatible.'
562      ENDIF
563
564      ! Linear interpolate to the current step
565
566      IF(lwp)WRITE(numout,*) '   linear interpolate to current', &
567         &                   ' time step = ', kstp
568
569      ! Interpolation coefficients
570
571      zstp = kstp - nit000 + 1
572      zden   = 1.0 / ( stpr2 - stpr1 )
573
574      zwtr1  = ( stpr2 - zstp      ) * zden
575      zwtr2  = ( zstp  - stpr1     ) * zden
576
577      IF(lwp)WRITE(numout,*) '   linear interpolate coeff.', &
578         &                   '  = ', zwtr1, zwtr2
579
580      IF ( ( kstp /= nit000-1 ).AND.( kdir == 1 ) ) THEN
581         tsb(:,:,:,:) = tsn(:,:,:,:)
582         ub(:,:,:) = un(:,:,:)
583         vb(:,:,:) = vn(:,:,:)
584      END IF
585      emp(:,:)      = zwtr1 * empr1   (:,:)   + zwtr2 * empr2   (:,:)
586      emps(:,:)     = zwtr1 * empsr1  (:,:)   + zwtr2 * empsr2  (:,:)
587      bfrua(:,:)    = zwtr1 * bfruar1 (:,:)   + zwtr2 * bfruar2 (:,:)
588      bfrva(:,:)    = zwtr1 * bfrvar1 (:,:)   + zwtr2 * bfrvar2 (:,:)
589      un(:,:,:)     = zwtr1 * unr1    (:,:,:) + zwtr2 * unr2    (:,:,:)
590      vn(:,:,:)     = zwtr1 * vnr1    (:,:,:) + zwtr2 * vnr2    (:,:,:)
591      tsn(:,:,:,jp_tem)     = zwtr1 * tnr1    (:,:,:) + zwtr2 * tnr2    (:,:,:)
592      tsn(:,:,:,jp_sal)     = zwtr1 * snr1    (:,:,:) + zwtr2 * snr2    (:,:,:)
593      IF ( kdir == -1 ) THEN
594         zwtr1  = ( stpr2 - zstp + 1  ) * zden
595         zwtr2  = ( zstp - 1 - stpr1 ) * zden
596         ub(:,:,:)     = zwtr1 * unr1    (:,:,:) + zwtr2 * unr2    (:,:,:)
597         vb(:,:,:)     = zwtr1 * vnr1    (:,:,:) + zwtr2 * vnr2    (:,:,:)
598         tsb(:,:,:,jp_tem)     = zwtr1 * tnr1    (:,:,:) + zwtr2 * tnr2    (:,:,:)
599         tsb(:,:,:,jp_sal)     = zwtr1 * snr1    (:,:,:) + zwtr2 * snr2    (:,:,:)
600         IF(lwp)WRITE(numout,*) ' before lin. interp. coeff.', &
601           &                   '  = ', zwtr1, zwtr2
602
603         zwtr1  = ( stpr2 - zstp      ) * zden
604         zwtr2  = ( zstp  - stpr1     ) * zden     
605      END IF
606      IF ( kstp == nit000-1 ) THEN
607         tsb(:,:,:,:) = tsn(:,:,:,:)
608         ub(:,:,:) = un(:,:,:)
609         vb(:,:,:) = vn(:,:,:)
610      END IF
611      avmu(:,:,:)   = zwtr1 * avmur1  (:,:,:) + zwtr2 * avmur2  (:,:,:)
612      avmv(:,:,:)   = zwtr1 * avmvr1  (:,:,:) + zwtr2 * avmvr2  (:,:,:)
613      avt(:,:,:)    = zwtr1 * avtr1   (:,:,:) + zwtr2 * avtr2   (:,:,:)
614#if defined key_ldfslp
615      uslp(:,:,:)   = zwtr1 * uslpr1  (:,:,:) + zwtr2 * uslpr2  (:,:,:)
616      vslp(:,:,:)   = zwtr1 * vslpr1  (:,:,:) + zwtr2 * vslpr2  (:,:,:)
617      wslpi(:,:,:)  = zwtr1 * wslpir1 (:,:,:) + zwtr2 * wslpir2 (:,:,:)
618      wslpj(:,:,:)  = zwtr1 * wslpjr1 (:,:,:) + zwtr2 * wslpjr2 (:,:,:)
619#endif
620#if defined key_zdfddm
621      avs(:,:,:)    = zwtr1 * avsr1   (:,:,:) + zwtr2 * avsr2   (:,:,:)
622#endif
623      etot3(:,:,:)  = zwtr1 * etot3r1 (:,:,:) + zwtr2 * etot3r2 (:,:,:)
624#if defined key_tradmp
625      hmlp(:,:)     = zwtr1 * hmlp1(:,:)    + zwtr2 * hmlp2(:,:)
626#endif
627#if defined key_traldf_eiv
628#if defined key_traldf_c3d
629      aeiu(:,:,:)   = zwtr1 * aeiur1  (:,:,:) + zwtr2 * aeiur2  (:,:,:)
630      aeiv(:,:,:)   = zwtr1 * aeivr1  (:,:,:) + zwtr2 * aeivr2  (:,:.:)
631      aeiw(:,:,:)   = zwtr1 * aeiwr1  (:,:,:) + zwtr2 * aeiwr2  (:,:.:)
632#elif defined key_traldf_c2d
633      aeiu(:,:)     = zwtr1 * aeiur1  (:,:)   + zwtr2 * aeiur2  (:,:)
634      aeiv(:,:)     = zwtr1 * aeivr1  (:,:)   + zwtr2 * aeivr2  (:,:)
635      aeiw(:,:)     = zwtr1 * aeiwr1  (:,:)   + zwtr2 * aeiwr2  (:,:)
636#elif defined key_traldf_c1d
637      aeiu(:)       = zwtr1 * aeiur1  (:)     + zwtr2 * aeiur2  (:)
638      aeiv(:)       = zwtr1 * aeivr1  (:)     + zwtr2 * aeivr2  (:)
639      aeiw(:)       = zwtr1 * aeiwr1  (:)     + zwtr2 * aeiwr2  (:)
640#else
641      aeiu          = zwtr1 * aeiur1          + zwtr2 * aeiur2
642      aeiv          = zwtr1 * aeivr1          + zwtr2 * aeivr2
643      aeiw          = zwtr1 * aeiwr1          + zwtr2 * aeiwr2
644#endif
645#endif
646
647      CALL ssh_wzv( kstp )
648
649   END SUBROUTINE trj_rea
650
651
652   SUBROUTINE trj_wri_spl(filename)
653      !!-----------------------------------------------------------------------
654      !!
655      !!                  ***  ROUTINE trj_wri_spl ***
656      !!
657      !! ** Purpose : Write SimPLe data to file the model state trajectory
658      !!
659      !! ** Method  :
660      !!
661      !! ** Action  :
662      !!
663      !! History :
664      !!        ! 09-07 (F. Vigilant)
665      !!-----------------------------------------------------------------------
666      !! *Module udes
667      USE iom
668      USE sol_oce, ONLY : & ! solver variables
669      & gcb, gcx
670      !! * Arguments
671      !! * Local declarations
672      INTEGER :: &
673         & inum, &                  ! File unit number
674         & fd                       ! field number
675      CHARACTER (LEN=50) :: &
676         & filename
677
678      fd=1
679      WRITE(filename, FMT='(A,A)' ) TRIM( filename ), '.nc'
680      filename = TRIM( filename )
681      CALL iom_open( filename, inum, ldwrt = .TRUE., kiolib = jprstlib)
682
683      ! Output trajectory fields
684      CALL iom_rstput( fd, fd, inum, 'un'   , un   )
685      CALL iom_rstput( fd, fd, inum, 'vn'   , vn   )
686      CALL iom_rstput( fd, fd, inum, 'tn'   , tsn(:,:,:,jp_tem)   )
687      CALL iom_rstput( fd, fd, inum, 'sn'   , tsn(:,:,:,jp_sal)   )
688      CALL iom_rstput( fd, fd, inum, 'sshn' , sshn )
689      CALL iom_rstput( fd, fd, inum, 'wn'   , wn   )
690      CALL iom_rstput( fd, fd, inum, 'tb'   , tsb(:,:,:,jp_tem)   )
691      CALL iom_rstput( fd, fd, inum, 'sb'   , tsb(:,:,:,jp_sal)   )
692      CALL iom_rstput( fd, fd, inum, 'ua'   , ua   )
693      CALL iom_rstput( fd, fd, inum, 'va'   , va   )
694      CALL iom_rstput( fd, fd, inum, 'ta'   , tsa(:,:,:,jp_tem)   )
695      CALL iom_rstput( fd, fd, inum, 'sa'   , tsa(:,:,:,jp_sal)   )
696      CALL iom_rstput( fd, fd, inum, 'sshb' , sshb )
697      CALL iom_rstput( fd, fd, inum, 'rhd'  , rhd  )
698      CALL iom_rstput( fd, fd, inum, 'rhop' , rhop )
699      CALL iom_rstput( fd, fd, inum, 'gtu'  , gtsu(:,:,jp_tem)  )
700      CALL iom_rstput( fd, fd, inum, 'gsu'  , gtsu(:,:,jp_sal)  )
701      CALL iom_rstput( fd, fd, inum, 'gru'  , gru  )
702      CALL iom_rstput( fd, fd, inum, 'gtv'  , gtsv(:,:,jp_tem)  )
703      CALL iom_rstput( fd, fd, inum, 'gsv'  , gtsv(:,:,jp_sal)  )
704      CALL iom_rstput( fd, fd, inum, 'grv'  , grv  )
705      CALL iom_rstput( fd, fd, inum, 'rn2'  , rn2  )
706      CALL iom_rstput( fd, fd, inum, 'gcb'  , gcb  )
707      CALL iom_rstput( fd, fd, inum, 'gcx'  , gcx  )
708
709      CALL iom_close( inum )
710
711   END SUBROUTINE trj_wri_spl
712
713   SUBROUTINE trj_rd_spl(filename)
714      !!-----------------------------------------------------------------------
715      !!
716      !!                  ***  ROUTINE asm_trj__wop_rd ***
717      !!
718      !! ** Purpose : Read SimPLe data from file the model state trajectory
719      !!
720      !! ** Method  :
721      !!
722      !! ** Action  :
723      !!
724      !! History :
725      !!        ! 09-07 (F. Vigilant)
726      !!-----------------------------------------------------------------------
727      !! *Module udes
728      USE iom                 ! I/O module
729      USE sol_oce, ONLY : & ! solver variables
730      & gcb, gcx
731      !! * Arguments
732      !! * Local declarations
733      INTEGER :: &
734         & inum, &                  ! File unit number
735         & fd                       ! field number
736      CHARACTER (LEN=50) :: &
737         & filename
738
739      fd=1
740      WRITE(filename, FMT='(A,A)' ) TRIM( filename ), '.nc'
741      filename = TRIM( filename )
742      CALL iom_open( filename, inum)
743
744      ! Output trajectory fields
745      CALL iom_get( inum, jpdom_autoglo, 'un'   , un,   fd )
746      CALL iom_get( inum, jpdom_autoglo, 'vn'   , vn,   fd )
747      CALL iom_get( inum, jpdom_autoglo, 'tn'   , tsn(:,:,:,jp_tem),   fd )
748      CALL iom_get( inum, jpdom_autoglo, 'sn'   , tsn(:,:,:,jp_sal),   fd )
749      CALL iom_get( inum, jpdom_autoglo, 'sshn' , sshn, fd )
750      CALL iom_get( inum, jpdom_autoglo, 'wn'   , wn,   fd )
751      CALL iom_get( inum, jpdom_autoglo, 'tb'   , tsb(:,:,:,jp_tem),   fd )
752      CALL iom_get( inum, jpdom_autoglo, 'sb'   , tsb(:,:,:,jp_sal),   fd )
753      CALL iom_get( inum, jpdom_autoglo, 'ua'   , ua,   fd )
754      CALL iom_get( inum, jpdom_autoglo, 'va'   , va,   fd )
755      CALL iom_get( inum, jpdom_autoglo, 'ta'   , tsa(:,:,:,jp_tem),   fd )
756      CALL iom_get( inum, jpdom_autoglo, 'sa'   , tsa(:,:,:,jp_sal),   fd )
757      CALL iom_get( inum, jpdom_autoglo, 'sshb' , sshb, fd )
758      CALL iom_get( inum, jpdom_autoglo, 'rhd'  , rhd,  fd )
759      CALL iom_get( inum, jpdom_autoglo, 'rhop' , rhop, fd )
760      CALL iom_get( inum, jpdom_autoglo, 'gtu'  , gtsu(:,:,jp_tem),  fd )
761      CALL iom_get( inum, jpdom_autoglo, 'gsu'  , gtsu(:,:,jp_sal),  fd )
762      CALL iom_get( inum, jpdom_autoglo, 'gru'  , gru,  fd )
763      CALL iom_get( inum, jpdom_autoglo, 'gtv'  , gtsv(:,:,jp_tem),  fd )
764      CALL iom_get( inum, jpdom_autoglo, 'gsv'  , gtsv(:,:,jp_sal),  fd )
765      CALL iom_get( inum, jpdom_autoglo, 'grv'  , grv,  fd )
766      CALL iom_get( inum, jpdom_autoglo, 'rn2'  , rn2,  fd )
767      CALL iom_get( inum, jpdom_autoglo, 'gcb'  , gcb,  fd )
768      CALL iom_get( inum, jpdom_autoglo, 'gcx'  , gcx,  fd )
769
770      CALL iom_close( inum )
771
772   END SUBROUTINE trj_rd_spl
773
774   SUBROUTINE tl_trj_wri(kstp)
775      !!-----------------------------------------------------------------------
776      !!
777      !!                  ***  ROUTINE tl_trj_wri ***
778      !!
779      !! ** Purpose : Write SimPLe data to file the model state trajectory
780      !!
781      !! ** Method  :
782      !!
783      !! ** Action  :
784      !!
785      !! History :
786      !!        ! 10-07 (F. Vigilant)
787      !!-----------------------------------------------------------------------
788      !! *Module udes
789      USE iom
790      !! * Arguments
791      INTEGER, INTENT(in) :: &
792         & kstp           ! Step for requested trajectory
793      !! * Local declarations
794      INTEGER :: &
795         & inum           ! File unit number
796      INTEGER :: &
797         & it
798      CHARACTER (LEN=50) :: &
799         & filename
800      CHARACTER (LEN=100) :: &
801         & cl_tantrj
802
803      ! Initialize data and open file
804      !! if step time is corresponding to a saved state
805      IF ( ( MOD( kstp - nit000 + 1, nn_ittrjfrq_tan ) == 0 )  ) THEN
806
807         it = kstp - nit000 + 1
808
809            ! Define the input file
810            WRITE(cl_tantrj, FMT='(I5.5, A,A,".nc")' ) it, '_', TRIM( cn_tantrj )
811            cl_tantrj = TRIM( cl_tantrj )
812
813            IF(lwp) THEN
814               WRITE(numout,*)
815               WRITE(numout,*)'Writing linear-tangent fields from : ',TRIM(cl_tantrj)
816               WRITE(numout,*)
817            ENDIF
818
819            CALL iom_open( cl_tantrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
820
821            ! Output trajectory fields
822            CALL iom_rstput( it, it, inum, 'un_tl'   , un_tl   )
823            CALL iom_rstput( it, it, inum, 'vn_tl'   , vn_tl   )
824            CALL iom_rstput( it, it, inum, 'un'   , un   )
825            CALL iom_rstput( it, it, inum, 'vn'   , vn   )
826            CALL iom_rstput( it, it, inum, 'tn_tl'   , tsn_tl(:,:,:,jp_tem)   )
827            CALL iom_rstput( it, it, inum, 'sn_tl'   , tsn_tl(:,:,:,jp_sal)   )
828            CALL iom_rstput( it, it, inum, 'wn_tl'   , wn_tl   )
829            CALL iom_rstput( it, it, inum, 'hdivn_tl', hdivn_tl)
830            CALL iom_rstput( it, it, inum, 'rotn_tl' , rotn_tl )
831            CALL iom_rstput( it, it, inum, 'rhd_tl' , rhd_tl )
832            CALL iom_rstput( it, it, inum, 'rhop_tl' , rhop_tl )
833            CALL iom_rstput( it, it, inum, 'sshn_tl' , sshn_tl )
834
835            CALL iom_close( inum )
836
837         ENDIF
838
839   END SUBROUTINE tl_trj_wri
840
841
842   SUBROUTINE trj_deallocate
843      !!-----------------------------------------------------------------------
844      !!
845      !!                  ***  ROUTINE trj_deallocate ***
846      !!
847      !! ** Purpose : Deallocate saved trajectory arrays
848      !!
849      !! ** Method  :
850      !!
851      !! ** Action  :
852      !!
853      !! History :
854      !!        ! 2010-06 (A. Vidard)
855      !!-----------------------------------------------------------------------
856
857         IF ( ln_mem ) THEN
858            DEALLOCATE(  &
859               & empr1,  &
860               & empsr1, &
861               & empr2,  &
862               & empsr2, &
863               & bfruar1,&
864               & bfrvar1,&
865               & bfruar2,&
866               & bfrvar2 &
867               & )
868
869            DEALLOCATE(    &
870               & unr1,     &
871               & vnr1,     &
872               & tnr1,     &
873               & snr1,     &
874               & avmur1,   &
875               & avmvr1,   &
876               & avtr1,    &
877               & etot3r1,  &
878               & unr2,     &
879               & vnr2,     &
880               & tnr2,     &
881               & snr2,     &
882               & avmur2,   &
883               & avmvr2,   &
884               & avtr2,    &
885               & etot3r2   &
886               & )
887
888#if defined key_traldf_eiv
889#if defined key_traldf_c3d
890#elif defined key_traldf_c2d
891            DEALLOCATE(  &
892               & aeiur1, &
893               & aeivr1, &
894               & aeiwr1, &
895               & aeiur2, &
896               & aeivr2, &
897               & aeiwr2  &
898               & )
899#elif defined key_traldf_c1d
900#endif
901#endif
902
903#if defined key_ldfslp
904            DEALLOCATE(    &
905               & uslpr1,   &
906               & vslpr1,   &
907               & wslpir1,  &
908               & wslpjr1,  &
909               & uslpr2,   &
910               & vslpr2,   &
911               & wslpir2,  &
912               & wslpjr2   &
913               & )
914#endif
915
916#if defined key_zdfddm
917            DEALLOCATE(    &
918               & avsr1,    &
919               & avsr2     &
920               & )
921#endif
922
923#if defined key_tradmp
924            DEALLOCATE(    &
925               & hmlp1,    &
926               & hmlp2     &
927               & )
928#endif
929    ENDIF
930         END SUBROUTINE trj_deallocate
931#endif
932END MODULE trj_tam
Note: See TracBrowser for help on using the repository browser.