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

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

Inclusion of river runoff (arrays rnf and rnf_b of module sbc_oce) in the nonlinear-model trajectory used by NEMOTAM; elimination of the use of an uninitialised array (array rnf_b of module sbc_oce) in the reconstruction of the vertical velocity field of the nonlinear-model trajectory used by NEMOTAM (fix for the bugs described in ticket #1876)

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