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.
trj_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/TAM – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/TAM/trj_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: 32.1 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
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
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 ) 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 ( kstp == nit000-1 ) THEN
594         tsb(:,:,:,:) = tsn(:,:,:,:)
595         ub(:,:,:) = un(:,:,:)
596         vb(:,:,:) = vn(:,:,:)
597      END IF
598      avmu(:,:,:)   = zwtr1 * avmur1  (:,:,:) + zwtr2 * avmur2  (:,:,:)
599      avmv(:,:,:)   = zwtr1 * avmvr1  (:,:,:) + zwtr2 * avmvr2  (:,:,:)
600      avt(:,:,:)    = zwtr1 * avtr1   (:,:,:) + zwtr2 * avtr2   (:,:,:)
601#if defined key_ldfslp
602      uslp(:,:,:)   = zwtr1 * uslpr1  (:,:,:) + zwtr2 * uslpr2  (:,:,:)
603      vslp(:,:,:)   = zwtr1 * vslpr1  (:,:,:) + zwtr2 * vslpr2  (:,:,:)
604      wslpi(:,:,:)  = zwtr1 * wslpir1 (:,:,:) + zwtr2 * wslpir2 (:,:,:)
605      wslpj(:,:,:)  = zwtr1 * wslpjr1 (:,:,:) + zwtr2 * wslpjr2 (:,:,:)
606#endif
607#if defined key_zdfddm
608      avs(:,:,:)    = zwtr1 * avsr1   (:,:,:) + zwtr2 * avsr2   (:,:,:)
609#endif
610      etot3(:,:,:)  = zwtr1 * etot3r1 (:,:,:) + zwtr2 * etot3r2 (:,:,:)
611#if defined key_tradmp
612      hmlp(:,:)     = zwtr1 * hmlp1(:,:)    + zwtr2 * hmlp2(:,:)
613#endif
614#if defined key_traldf_eiv
615#if defined key_traldf_c3d
616      aeiu(:,:,:)   = zwtr1 * aeiur1  (:,:,:) + zwtr2 * aeiur2  (:,:,:)
617      aeiv(:,:,:)   = zwtr1 * aeivr1  (:,:,:) + zwtr2 * aeivr2  (:,:.:)
618      aeiw(:,:,:)   = zwtr1 * aeiwr1  (:,:,:) + zwtr2 * aeiwr2  (:,:.:)
619#elif defined key_traldf_c2d
620      aeiu(:,:)     = zwtr1 * aeiur1  (:,:)   + zwtr2 * aeiur2  (:,:)
621      aeiv(:,:)     = zwtr1 * aeivr1  (:,:)   + zwtr2 * aeivr2  (:,:)
622      aeiw(:,:)     = zwtr1 * aeiwr1  (:,:)   + zwtr2 * aeiwr2  (:,:)
623#elif defined key_traldf_c1d
624      aeiu(:)       = zwtr1 * aeiur1  (:)     + zwtr2 * aeiur2  (:)
625      aeiv(:)       = zwtr1 * aeivr1  (:)     + zwtr2 * aeivr2  (:)
626      aeiw(:)       = zwtr1 * aeiwr1  (:)     + zwtr2 * aeiwr2  (:)
627#else
628      aeiu          = zwtr1 * aeiur1          + zwtr2 * aeiur2
629      aeiv          = zwtr1 * aeivr1          + zwtr2 * aeivr2
630      aeiw          = zwtr1 * aeiwr1          + zwtr2 * aeiwr2
631#endif
632#endif
633
634      CALL ssh_wzv( kstp )
635
636   END SUBROUTINE trj_rea
637
638
639   SUBROUTINE trj_wri_spl(filename)
640      !!-----------------------------------------------------------------------
641      !!
642      !!                  ***  ROUTINE trj_wri_spl ***
643      !!
644      !! ** Purpose : Write SimPLe data to file the model state trajectory
645      !!
646      !! ** Method  :
647      !!
648      !! ** Action  :
649      !!
650      !! History :
651      !!        ! 09-07 (F. Vigilant)
652      !!-----------------------------------------------------------------------
653      !! *Module udes
654      USE iom
655      USE sol_oce, ONLY : & ! solver variables
656      & gcb, gcx
657      !! * Arguments
658      !! * Local declarations
659      INTEGER :: &
660         & inum, &                  ! File unit number
661         & fd                       ! field number
662      CHARACTER (LEN=50) :: &
663         & filename
664
665      fd=1
666      WRITE(filename, FMT='(A,A)' ) TRIM( filename ), '.nc'
667      filename = TRIM( filename )
668      CALL iom_open( filename, inum, ldwrt = .TRUE., kiolib = jprstlib)
669
670      ! Output trajectory fields
671      CALL iom_rstput( fd, fd, inum, 'un'   , un   )
672      CALL iom_rstput( fd, fd, inum, 'vn'   , vn   )
673      CALL iom_rstput( fd, fd, inum, 'tn'   , tsn(:,:,:,jp_tem)   )
674      CALL iom_rstput( fd, fd, inum, 'sn'   , tsn(:,:,:,jp_sal)   )
675      CALL iom_rstput( fd, fd, inum, 'sshn' , sshn )
676      CALL iom_rstput( fd, fd, inum, 'wn'   , wn   )
677      CALL iom_rstput( fd, fd, inum, 'tb'   , tsb(:,:,:,jp_tem)   )
678      CALL iom_rstput( fd, fd, inum, 'sb'   , tsb(:,:,:,jp_sal)   )
679      CALL iom_rstput( fd, fd, inum, 'ua'   , ua   )
680      CALL iom_rstput( fd, fd, inum, 'va'   , va   )
681      CALL iom_rstput( fd, fd, inum, 'ta'   , tsa(:,:,:,jp_tem)   )
682      CALL iom_rstput( fd, fd, inum, 'sa'   , tsa(:,:,:,jp_sal)   )
683      CALL iom_rstput( fd, fd, inum, 'sshb' , sshb )
684      CALL iom_rstput( fd, fd, inum, 'rhd'  , rhd  )
685      CALL iom_rstput( fd, fd, inum, 'rhop' , rhop )
686      CALL iom_rstput( fd, fd, inum, 'gtu'  , gtsu(:,:,jp_tem)  )
687      CALL iom_rstput( fd, fd, inum, 'gsu'  , gtsu(:,:,jp_sal)  )
688      CALL iom_rstput( fd, fd, inum, 'gru'  , gru  )
689      CALL iom_rstput( fd, fd, inum, 'gtv'  , gtsv(:,:,jp_tem)  )
690      CALL iom_rstput( fd, fd, inum, 'gsv'  , gtsv(:,:,jp_sal)  )
691      CALL iom_rstput( fd, fd, inum, 'grv'  , grv  )
692      CALL iom_rstput( fd, fd, inum, 'rn2'  , rn2  )
693      CALL iom_rstput( fd, fd, inum, 'gcb'  , gcb  )
694      CALL iom_rstput( fd, fd, inum, 'gcx'  , gcx  )
695
696      CALL iom_close( inum )
697
698   END SUBROUTINE trj_wri_spl
699
700   SUBROUTINE trj_rd_spl(filename)
701      !!-----------------------------------------------------------------------
702      !!
703      !!                  ***  ROUTINE asm_trj__wop_rd ***
704      !!
705      !! ** Purpose : Read SimPLe data from file the model state trajectory
706      !!
707      !! ** Method  :
708      !!
709      !! ** Action  :
710      !!
711      !! History :
712      !!        ! 09-07 (F. Vigilant)
713      !!-----------------------------------------------------------------------
714      !! *Module udes
715      USE iom                 ! I/O module
716      USE sol_oce, ONLY : & ! solver variables
717      & gcb, gcx
718      !! * Arguments
719      !! * Local declarations
720      INTEGER :: &
721         & inum, &                  ! File unit number
722         & fd                       ! field number
723      CHARACTER (LEN=50) :: &
724         & filename
725
726      fd=1
727      WRITE(filename, FMT='(A,A)' ) TRIM( filename ), '.nc'
728      filename = TRIM( filename )
729      CALL iom_open( filename, inum)
730
731      ! Output trajectory fields
732      CALL iom_get( inum, jpdom_autoglo, 'un'   , un,   fd )
733      CALL iom_get( inum, jpdom_autoglo, 'vn'   , vn,   fd )
734      CALL iom_get( inum, jpdom_autoglo, 'tn'   , tsn(:,:,:,jp_tem),   fd )
735      CALL iom_get( inum, jpdom_autoglo, 'sn'   , tsn(:,:,:,jp_sal),   fd )
736      CALL iom_get( inum, jpdom_autoglo, 'sshn' , sshn, fd )
737      CALL iom_get( inum, jpdom_autoglo, 'wn'   , wn,   fd )
738      CALL iom_get( inum, jpdom_autoglo, 'tb'   , tsb(:,:,:,jp_tem),   fd )
739      CALL iom_get( inum, jpdom_autoglo, 'sb'   , tsb(:,:,:,jp_sal),   fd )
740      CALL iom_get( inum, jpdom_autoglo, 'ua'   , ua,   fd )
741      CALL iom_get( inum, jpdom_autoglo, 'va'   , va,   fd )
742      CALL iom_get( inum, jpdom_autoglo, 'ta'   , tsa(:,:,:,jp_tem),   fd )
743      CALL iom_get( inum, jpdom_autoglo, 'sa'   , tsa(:,:,:,jp_sal),   fd )
744      CALL iom_get( inum, jpdom_autoglo, 'sshb' , sshb, fd )
745      CALL iom_get( inum, jpdom_autoglo, 'rhd'  , rhd,  fd )
746      CALL iom_get( inum, jpdom_autoglo, 'rhop' , rhop, fd )
747      CALL iom_get( inum, jpdom_autoglo, 'gtu'  , gtsu(:,:,jp_tem),  fd )
748      CALL iom_get( inum, jpdom_autoglo, 'gsu'  , gtsu(:,:,jp_sal),  fd )
749      CALL iom_get( inum, jpdom_autoglo, 'gru'  , gru,  fd )
750      CALL iom_get( inum, jpdom_autoglo, 'gtv'  , gtsv(:,:,jp_tem),  fd )
751      CALL iom_get( inum, jpdom_autoglo, 'gsv'  , gtsv(:,:,jp_sal),  fd )
752      CALL iom_get( inum, jpdom_autoglo, 'grv'  , grv,  fd )
753      CALL iom_get( inum, jpdom_autoglo, 'rn2'  , rn2,  fd )
754      CALL iom_get( inum, jpdom_autoglo, 'gcb'  , gcb,  fd )
755      CALL iom_get( inum, jpdom_autoglo, 'gcx'  , gcx,  fd )
756
757      CALL iom_close( inum )
758
759   END SUBROUTINE trj_rd_spl
760
761   SUBROUTINE tl_trj_wri(kstp)
762      !!-----------------------------------------------------------------------
763      !!
764      !!                  ***  ROUTINE tl_trj_wri ***
765      !!
766      !! ** Purpose : Write SimPLe data to file the model state trajectory
767      !!
768      !! ** Method  :
769      !!
770      !! ** Action  :
771      !!
772      !! History :
773      !!        ! 10-07 (F. Vigilant)
774      !!-----------------------------------------------------------------------
775      !! *Module udes
776      USE iom
777      !! * Arguments
778      INTEGER, INTENT(in) :: &
779         & kstp           ! Step for requested trajectory
780      !! * Local declarations
781      INTEGER :: &
782         & inum           ! File unit number
783      INTEGER :: &
784         & it
785      CHARACTER (LEN=50) :: &
786         & filename
787      CHARACTER (LEN=100) :: &
788         & cl_tantrj
789
790      ! Initialize data and open file
791      !! if step time is corresponding to a saved state
792      IF ( ( MOD( kstp - nit000 + 1, nn_ittrjfrq_tan ) == 0 )  ) THEN
793
794         it = kstp - nit000 + 1
795
796            ! Define the input file
797            WRITE(cl_tantrj, FMT='(I5.5, A,A,".nc")' ) it, '_', TRIM( cn_tantrj )
798            cl_tantrj = TRIM( cl_tantrj )
799
800            IF(lwp) THEN
801               WRITE(numout,*)
802               WRITE(numout,*)'Writing linear-tangent fields from : ',TRIM(cl_tantrj)
803               WRITE(numout,*)
804            ENDIF
805
806            CALL iom_open( cl_tantrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
807
808            ! Output trajectory fields
809            CALL iom_rstput( it, it, inum, 'un_tl'   , un_tl   )
810            CALL iom_rstput( it, it, inum, 'vn_tl'   , vn_tl   )
811            CALL iom_rstput( it, it, inum, 'un'   , un   )
812            CALL iom_rstput( it, it, inum, 'vn'   , vn   )
813            CALL iom_rstput( it, it, inum, 'tn_tl'   , tsn_tl(:,:,:,jp_tem)   )
814            CALL iom_rstput( it, it, inum, 'sn_tl'   , tsn_tl(:,:,:,jp_sal)   )
815            CALL iom_rstput( it, it, inum, 'wn_tl'   , wn_tl   )
816            CALL iom_rstput( it, it, inum, 'hdivn_tl', hdivn_tl)
817            CALL iom_rstput( it, it, inum, 'rotn_tl' , rotn_tl )
818            CALL iom_rstput( it, it, inum, 'rhd_tl' , rhd_tl )
819            CALL iom_rstput( it, it, inum, 'rhop_tl' , rhop_tl )
820            CALL iom_rstput( it, it, inum, 'sshn_tl' , sshn_tl )
821
822            CALL iom_close( inum )
823
824         ENDIF
825
826   END SUBROUTINE tl_trj_wri
827
828
829   SUBROUTINE trj_deallocate
830      !!-----------------------------------------------------------------------
831      !!
832      !!                  ***  ROUTINE trj_deallocate ***
833      !!
834      !! ** Purpose : Deallocate saved trajectory arrays
835      !!
836      !! ** Method  :
837      !!
838      !! ** Action  :
839      !!
840      !! History :
841      !!        ! 2010-06 (A. Vidard)
842      !!-----------------------------------------------------------------------
843
844         IF ( ln_mem ) THEN
845            DEALLOCATE(  &
846               & empr1,  &
847               & empsr1, &
848               & empr2,  &
849               & empsr2, &
850               & bfruar1,&
851               & bfrvar1,&
852               & bfruar2,&
853               & bfrvar2 &
854               & )
855
856            DEALLOCATE(    &
857               & unr1,     &
858               & vnr1,     &
859               & tnr1,     &
860               & snr1,     &
861               & avmur1,   &
862               & avmvr1,   &
863               & avtr1,    &
864               & etot3r1,  &
865               & unr2,     &
866               & vnr2,     &
867               & tnr2,     &
868               & snr2,     &
869               & avmur2,   &
870               & avmvr2,   &
871               & avtr2,    &
872               & etot3r2   &
873               & )
874
875#if defined key_traldf_eiv
876#if defined key_traldf_c3d
877#elif defined key_traldf_c2d
878            DEALLOCATE(  &
879               & aeiur1, &
880               & aeivr1, &
881               & aeiwr1, &
882               & aeiur2, &
883               & aeivr2, &
884               & aeiwr2  &
885               & )
886#elif defined key_traldf_c1d
887#endif
888#endif
889
890#if defined key_ldfslp
891            DEALLOCATE(    &
892               & uslpr1,   &
893               & vslpr1,   &
894               & wslpir1,  &
895               & wslpjr1,  &
896               & uslpr2,   &
897               & vslpr2,   &
898               & wslpir2,  &
899               & wslpjr2   &
900               & )
901#endif
902
903#if defined key_zdfddm
904            DEALLOCATE(    &
905               & avsr1,    &
906               & avsr2     &
907               & )
908#endif
909
910#if defined key_tradmp
911            DEALLOCATE(    &
912               & hmlp1,    &
913               & hmlp2     &
914               & )
915#endif
916    ENDIF
917         END SUBROUTINE trj_deallocate
918#endif
919END MODULE trj_tam
Note: See TracBrowser for help on using the repository browser.