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/TAM_V3_0/NEMOTAM/OPATAM_SRC/TAM – NEMO

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/TAM/trj_tam.F90 @ 2587

Last change on this file since 2587 was 2587, checked in by vidard, 13 years ago

refer to ticket #798

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