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 NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/TAM – NEMO

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

Last change on this file since 13422 was 13422, checked in by smueller, 23 months ago

Addition of optional reinitialisation of the trajectory interpolation to subroutine trj_rea

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