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.
dtadyn.F90 in trunk/NEMO/OFF_SRC – NEMO

source: trunk/NEMO/OFF_SRC/dtadyn.F90 @ 1152

Last change on this file since 1152 was 1152, checked in by rblod, 16 years ago

Convert cvs header to svn Id, step II
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 30.5 KB
Line 
1MODULE dtadyn
2   !!======================================================================
3   !!                       ***  MODULE  dtadyn  ***
4   !! OFFLINE : interpolation of the physical fields
5   !!=====================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dta_dyn_init : initialization, namelist read, and parameters control
9   !!   dta_dyn      : Interpolation of the fields
10   !!----------------------------------------------------------------------
11   !! * Modules used
12   USE oce             ! ocean dynamics and tracers variables
13   USE dom_oce         ! ocean space and time domain variables
14   USE zdf_oce         ! ocean vertical physics
15   USE in_out_manager  ! I/O manager
16   USE phycst          ! physical constants
17   USE sbc_oce
18   USE ldfslp
19   USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine)
20   USE ldftra_oce      ! ocean tracer   lateral physics
21   USE zdfmxl
22   USE trabbl          ! tracers: bottom boundary layer
23   USE zdfddm          ! vertical  physics: double diffusion
24   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
25   USE lib_mpp         ! distributed memory computing library
26
27   IMPLICIT NONE
28   PRIVATE
29
30   !! *  Routine accessibility
31   PUBLIC dta_dyn_init   ! called by opa.F90
32   PUBLIC dta_dyn        ! called by step.F90
33
34   !! * Module variables
35   INTEGER , PUBLIC, PARAMETER :: jpflx = 7
36   INTEGER , PUBLIC, PARAMETER :: &
37      jptaux = 1 , & ! indice in flux for taux
38      jptauy = 2 , & ! indice in flux for tauy
39      jpwind = 3 , & ! indice in flux for wind speed
40      jpemp = 4  , & ! indice in flux for E-P
41      jpice = 5  , & ! indice in flux for ice concentration
42      jpqsr = 6      ! indice in flux for shortwave heat flux
43
44   LOGICAL , PUBLIC :: &
45      lperdyn = .TRUE. , & ! boolean for periodic fields or not
46      lfirdyn = .TRUE.     ! boolean for the first call or not
47
48   INTEGER , PUBLIC :: &
49      ndtadyn = 12 ,  & ! Number of dat in one year
50      ndtatot = 12 ,  & ! Number of data in the input field
51      nsptint = 1 ,   & ! type of spatial interpolation
52      nficdyn = 2       ! number of dynamical fields
53
54   INTEGER ::     &
55      ndyn1, ndyn2 , &
56      nlecoff = 0  , & ! switch for the first read
57      numfl_t, numfl_u, &
58      numfl_v, numfl_w
59     
60
61   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
62      tdta   ,   & ! temperature at two consecutive times
63      sdta   ,   & ! salinity at two consecutive times
64      udta   ,   & ! zonal velocity at two consecutive times
65      vdta   ,   & ! meridional velocity at two consecutive times
66      wdta   ,   & ! vertical velocity at two consecutive times
67#if defined key_trc_diatrd
68      hdivdta,   & ! horizontal divergence
69#endif
70      avtdta       ! vertical diffusivity coefficient
71
72
73#if defined key_ldfslp
74   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
75      uslpdta ,  & ! zonal isopycnal slopes
76      vslpdta ,  & ! meridional isopycnal slopes
77      wslpidta , & ! zonal diapycnal slopes
78      wslpjdta     ! meridional diapycnal slopes
79#endif
80
81#if ! defined key_off_degrad
82
83# if defined key_traldf_c2d
84   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
85      ahtwdta      ! Lateral diffusivity
86# if defined key_trcldf_eiv 
87   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
88      aeiwdta      ! G&M coefficient
89# endif
90# endif
91
92#else
93
94   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
95      ahtudta, ahtvdta, ahtwdta  !  Lateral diffusivity
96# if defined key_trcldf_eiv
97   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
98      aeiudta, aeivdta, aeiwdta  ! G&M coefficient
99# endif
100
101#endif
102# if defined key_diaeiv
103   !! GM Velocity : to be used latter
104      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
105        eivudta, eivvdta, eivwdta
106# endif
107
108   REAL(wp), DIMENSION(jpi,jpj,jpflx,2) ::   &
109      flxdta       ! auxiliary 2-D forcing fields at two consecutive times
110   REAL(wp), DIMENSION(jpi,jpj,2) ::       &
111      zmxldta      ! mixed layer depth at two consecutive times
112
113#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
114   REAL(wp), DIMENSION(jpi,jpj,2) ::       &
115      bblxdta ,  & ! frequency of bbl in the x direction at 2 consecutive times
116      bblydta      ! frequency of bbl in the y direction at 2 consecutive times
117#endif
118
119   !! * Substitutions
120#  include "domzgr_substitute.h90"
121#  include "vectopt_loop_substitute.h90"
122   !!----------------------------------------------------------------------
123   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
124   !!   $Id$
125   !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
126   !!----------------------------------------------------------------------
127
128CONTAINS
129
130   SUBROUTINE dta_dyn_init
131      !!----------------------------------------------------------------------
132      !!                  ***  ROUTINE dta_dyn_init  ***
133      !!
134      !! ** Purpose :   initializations of parameters for the interpolation
135      !!
136      !! ** Method :
137      !!
138      !! History :
139      !!    ! original  : 92-01 (M. Imbard: sub domain)
140      !!    ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
141      !!    ! 98-05 (L. Bopp read output of coupled run)
142      !!    ! 05-03 (O. Aumont and A. El Moussaoui) F90
143      !!----------------------------------------------------------------------
144      !! * Modules used
145
146      !! * Local declarations
147
148
149      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint,            & 
150          &                nficdyn, lperdyn
151      !!----------------------------------------------------------------------
152
153      !  Define the dynamical input parameters
154      ! ======================================
155
156      ! Read Namelist namdyn : Lateral physics on tracers
157      REWIND( numnam )
158      READ  ( numnam, namdyn )
159
160      IF(lwp) THEN
161         WRITE(numout,*)
162         WRITE(numout,*) 'namdyn : offline dynamical selection'
163         WRITE(numout,*) '~~~~~~~'
164         WRITE(numout,*) '  Namelist namdyn : set parameters for the lecture of the dynamical fields'
165         WRITE(numout,*) 
166         WRITE(numout,*) ' number of elements in the FILE for a year  ndtadyn = ' , ndtadyn
167         WRITE(numout,*) ' total number of elements in the FILE       ndtatot = ' , ndtatot
168         WRITE(numout,*) ' type of interpolation                      nsptint = ' , nsptint
169         WRITE(numout,*) ' number of dynamics FILE                    nficdyn = ' , nficdyn
170         WRITE(numout,*) ' loop on the same FILE                      lperdyn = ' , lperdyn
171         WRITE(numout,*) ' '
172      ENDIF
173
174   END SUBROUTINE dta_dyn_init
175
176   SUBROUTINE dta_dyn(kt)
177      !!----------------------------------------------------------------------
178      !!                  ***  ROUTINE dta_dyn  ***
179      !!
180      !! ** Purpose : Prepares dynamics and physics fields from an
181      !!              OPA9 simulation  for an off-line simulation
182      !!               for passive tracer
183      !!
184      !! ** Method : calculates the position of DATA to read READ DATA
185      !!             (example month changement) computes slopes IF needed
186      !!             interpolates DATA IF needed
187      !!
188      !! ** History :
189      !!   ! original  : 92-01 (M. Imbard: sub domain)
190      !!   ! addition  : 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
191      !!   ! addition  : 98-05 (L. Bopp read output of coupled run)
192      !!   ! addition  : 05-03 (O. Aumont and A. El Moussaoui) F90
193      !!   ! addition  : 05-12 (C. Ethe) Adapted for DEGINT
194      !!----------------------------------------------------------------------
195      !! * Modules used
196      USE eosbn2
197
198      !! * Arguments
199      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
200
201      !! * Local declarations
202      INTEGER ::   iper, iperm1, iswap   
203
204      REAL(wp) :: zpdtan, zpdtpe, zdemi, zt
205      REAL(wp) :: zweigh, zweighm1
206
207      REAL(wp), DIMENSION(jpi,jpj,jpflx) ::   &
208         flx  ! auxiliary field for 2-D surface boundary conditions
209
210
211      ! 0. Initialization
212      ! -----------------
213
214      IF (lfirdyn) THEN
215      !
216      ! time step MUST BE nint000
217      !
218          IF (kt.ne.nit000) THEN
219              IF (lwp) THEN
220                  WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt=',kt  &
221                     ,' nit000=',nit000
222              END IF
223              STOP 'dtadyn'
224          END if
225      ! Initialize the parameters of the interpolation
226      CALL dta_dyn_init
227      ENDIF
228
229
230      zpdtan = raass / rdt
231      zpdtpe = ((zpdtan / FLOAT (ndtadyn)))
232      zdemi  = zpdtpe * 0.5
233      zt     = (FLOAT (kt) + zdemi ) / zpdtpe
234
235      zweigh   = zt - FLOAT(INT(zt))
236      zweighm1 = 1. - zweigh
237
238      IF (lperdyn) THEN
239         iperm1 = MOD(INT(zt),ndtadyn)
240      ELSE
241         iperm1 = MOD(INT(zt),(ndtatot-1)) + 1
242      ENDIF
243      iper = iperm1 + 1
244      IF (iperm1 == 0) THEN
245          IF (lperdyn) THEN
246              iperm1 = ndtadyn
247          ELSE
248              IF (lfirdyn) THEN
249                  IF (lwp) THEN
250                      WRITE (numout,*) ' dynamic file is not periodic '
251                      WRITE (numout,*) ' with or without interpolation, '
252                      WRITE (numout,*) ' we take the first value'
253                      WRITE (numout,*) ' for the previous period '
254                      WRITE (numout,*) ' iperm1 = 0  '
255                  END IF
256              END IF
257          END IF
258      END IF
259
260      iswap  = 0
261
262      ! 1. First call lfirdyn = true
263      ! ----------------------------
264
265      IF (lfirdyn) THEN
266      !
267      ! store the information of the period read
268      !
269          ndyn1 = iperm1
270          ndyn2 = iper
271
272          IF (lwp) THEN
273              WRITE (numout,*)         &
274                 ' dynamics DATA READ for the period ndyn1 =',ndyn1, &
275              & ' and for the period ndyn2 = ',ndyn2
276              WRITE (numout,*) ' time step is :',kt
277              WRITE (numout,*) ' we have ndtadyn = ',ndtadyn,&
278                 &         ' records in the dynamic FILE for one year'
279          END IF 
280      !
281      ! DATA READ for the iperm1 period
282      !
283          IF( iperm1 /= 0 ) THEN
284             CALL dynrea( kt, iperm1 ) 
285          ELSE
286             CALL dynrea( kt, 1 )
287          ENDIF
288      !
289      ! Computes dynamical fields
290      !
291                tn(:,:,:)=tdta(:,:,:,2)
292                sn(:,:,:)=sdta(:,:,:,2)
293                avt(:,:,:)=avtdta(:,:,:,2)
294
295
296         IF(lwp) THEN
297            WRITE(numout,*)' temperature '
298            WRITE(numout,*)
299            CALL prihre(tn(1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
300            WRITE(numout,*) '  level = ',jpk/2
301            CALL prihre(tn(1,1,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
302            WRITE(numout,*) '  level = ',jpkm1
303            CALL prihre(tn(1,1,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
304        ENDIF
305
306#if defined key_ldfslp
307            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density
308            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
309            CALL zdf_mxl( kt )              ! mixed layer depth
310            CALL ldf_slp( kt, rhd, rn2 )
311
312            uslpdta(:,:,:,2)=uslp(:,:,:)
313            vslpdta(:,:,:,2)=vslp(:,:,:)
314            wslpidta(:,:,:,2)=wslpi(:,:,:)
315            wslpjdta(:,:,:,2)=wslpj(:,:,:)
316#endif
317       !
318       ! swap from record 2 to 1
319       !
320                udta(:,:,:,1)=udta(:,:,:,2)
321                vdta(:,:,:,1)=vdta(:,:,:,2)
322                wdta(:,:,:,1)=wdta(:,:,:,2)
323#if defined key_trc_diatrd
324                hdivdta(:,:,:,1)=hdivdta(:,:,:,2)
325#endif
326                avtdta(:,:,:,1)=avtdta(:,:,:,2)
327                tdta(:,:,:,1)=tdta(:,:,:,2)
328                sdta(:,:,:,1)=sdta(:,:,:,2)
329#if defined key_ldfslp
330                uslpdta(:,:,:,1)=uslpdta(:,:,:,2)
331                vslpdta(:,:,:,1)=vslpdta(:,:,:,2)
332                wslpidta(:,:,:,1)=wslpidta(:,:,:,2)
333                wslpjdta(:,:,:,1)=wslpjdta(:,:,:,2)
334#endif
335                flxdta(:,:,:,1) = flxdta(:,:,:,2)
336                zmxldta(:,:,1)=zmxldta(:,:,2)
337#if ! defined key_off_degrad
338
339#  if defined key_traldf_c2d
340                ahtwdta(:,:,1)= ahtwdta(:,:,2)
341#    if defined key_trcldf_eiv
342                aeiwdta(:,:,1)= aeiwdta(:,:,2)
343#    endif
344#  endif
345
346#else
347                ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
348                ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
349                ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
350#  if defined key_trcldf_eiv
351                aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
352                aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
353                aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
354#  endif
355
356#endif
357
358#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
359                bblxdta(:,:,1)=bblxdta(:,:,2)
360                bblydta(:,:,1)=bblydta(:,:,2)
361#endif
362      !
363      ! indicates a swap
364      !
365          iswap = 1
366      !
367      ! DATA READ for the iper period
368      !
369          CALL dynrea( kt, iper )
370      !
371      ! Computes wdta (and slopes if key_trahdfiso)
372      !
373                tn(:,:,:)=tdta(:,:,:,2)
374                sn(:,:,:)=sdta(:,:,:,2)
375                avt(:,:,:)=avtdta(:,:,:,2)
376
377
378#if defined key_ldfslp
379            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density
380            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
381            CALL zdf_mxl( kt )              ! mixed layer depth
382            CALL ldf_slp( kt, rhd, rn2 )
383
384            uslpdta(:,:,:,2)=uslp(:,:,:)
385            vslpdta(:,:,:,2)=vslp(:,:,:)
386            wslpidta(:,:,:,2)=wslpi(:,:,:)
387            wslpjdta(:,:,:,2)=wslpj(:,:,:)
388#endif
389      !
390      ! trace the first CALL
391      !
392          lfirdyn=.FALSE. 
393      ENDIF
394      !
395      ! and now what we have to DO at every time step
396      !
397      ! check the validity of the period in memory
398      !
399      IF (iperm1.NE.ndyn1) THEN
400          IF (iperm1.EQ.0.) THEN
401              IF (lwp) THEN
402                  WRITE (numout,*) ' dynamic file is not periodic '
403                  WRITE (numout,*) ' with or without interpolation, '
404                  WRITE (numout,*) ' we take the last value'
405                  WRITE (numout,*) ' for the last period '
406                  WRITE (numout,*) ' iperm1 = 12  '
407                  WRITE (numout,*) ' iper = 13'
408              ENDIF
409              iperm1 = 12
410              iper =13
411          ENDIF
412      !
413      ! we have to prepare a NEW READ of DATA
414      !
415      ! swap from record 2 to 1
416      !
417                udta(:,:,:,1) = udta(:,:,:,2)
418                vdta(:,:,:,1) = vdta(:,:,:,2)
419                wdta(:,:,:,1) = wdta(:,:,:,2)
420#if defined key_trc_diatrd
421                hdivdta(:,:,:,1)=hdivdta(:,:,:,2)
422#endif
423                avtdta(:,:,:,1) = avtdta(:,:,:,2)
424                tdta(:,:,:,1) = tdta(:,:,:,2)
425                sdta(:,:,:,1) = sdta(:,:,:,2)
426#if defined key_ldfslp
427                uslpdta(:,:,:,1) = uslpdta(:,:,:,2)
428                vslpdta(:,:,:,1) = vslpdta(:,:,:,2)
429                wslpidta(:,:,:,1) = wslpidta(:,:,:,2)
430                wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2)
431#endif
432                flxdta(:,:,:,1) = flxdta(:,:,:,2)
433                zmxldta(:,:,1) = zmxldta(:,:,2)
434
435#if ! defined key_off_degrad
436
437#  if defined key_traldf_c2d
438                ahtwdta(:,:,1)= ahtwdta(:,:,2)
439#    if defined key_trcldf_eiv
440                aeiwdta(:,:,1)= aeiwdta(:,:,2)
441#    endif
442#  endif
443
444#else
445                ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
446                ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
447                ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
448#  if defined key_trcldf_eiv
449                aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
450                aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
451                aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
452#  endif
453
454#endif
455
456#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
457                bblxdta(:,:,1) = bblxdta(:,:,2)
458                bblydta(:,:,1) = bblydta(:,:,2)
459#endif
460      !
461      ! indicates a swap
462      !
463          iswap = 1
464      !
465      ! READ DATA for the iper period
466      !
467          CALL dynrea( kt, iper )
468      !
469      ! Computes wdta (and slopes if key_trahdfiso)
470      !
471                tn(:,:,:)=tdta(:,:,:,2)
472                sn(:,:,:)=sdta(:,:,:,2)
473                avt(:,:,:)=avtdta(:,:,:,2)
474
475#if defined key_ldfslp
476            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density
477            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
478            CALL zdf_mxl( kt )              ! mixed layer depth
479            CALL ldf_slp( kt, rhd, rn2 )
480
481            uslpdta(:,:,:,2)=uslp(:,:,:)
482            vslpdta(:,:,:,2)=vslp(:,:,:)
483            wslpidta(:,:,:,2)=wslpi(:,:,:)
484            wslpjdta(:,:,:,2)=wslpj(:,:,:)
485#endif
486       !
487       ! store the information of the period read
488       !
489          ndyn1 = ndyn2
490          ndyn2 = iper
491       !
492       ! we have READ another period of DATA       !
493          IF (lwp) THEN
494              WRITE (numout,*) ' dynamics DATA READ for the period ndyn1 =',ndyn1
495              WRITE (numout,*) ' and the period ndyn2 = ',ndyn2
496              WRITE (numout,*) ' time step is :',kt
497          END IF
498
499      END IF 
500
501      !
502      ! compute the DATA at the given time step
503      !
504      IF ( nsptint == 0 ) THEN
505      !
506      ! no spatial interpolation
507      !
508      ! DATA are probably correct
509      ! we have to initialize DATA IF we have changed the period
510      !
511          IF (iswap.eq.1) THEN
512      !
513      ! initialize now fields with the NEW DATA READ
514      !
515                    un(:,:,:)=udta(:,:,:,2)
516                    vn(:,:,:)=vdta(:,:,:,2)
517                    wn(:,:,:)=wdta(:,:,:,2)
518#if defined key_trc_diatrd
519                    hdivn(:,:,:)=hdivdta(:,:,:,2)
520#endif
521#if defined key_trc_zdfddm
522                    avs(:,:,:)=avtdta(:,:,:,2)
523#endif
524                    avt(:,:,:)=avtdta(:,:,:,2)
525                    tn(:,:,:)=tdta(:,:,:,2)
526                    sn(:,:,:)=sdta(:,:,:,2)
527#if defined key_ldfslp
528                    uslp(:,:,:)=uslpdta(:,:,:,2)
529                    vslp(:,:,:)=vslpdta(:,:,:,2)
530                    wslpi(:,:,:)=wslpidta(:,:,:,2)
531                    wslpj(:,:,:)=wslpjdta(:,:,:,2)
532#endif
533                    flx(:,:,:) = flxdta(:,:,:,2)
534                    hmld(:,:)=zmxldta(:,:,2)
535#if ! defined key_off_degrad
536
537#  if defined key_traldf_c2d
538                ahtwdta(:,:,1)= ahtwdta(:,:,2)
539#    if defined key_trcldf_eiv
540                aeiwdta(:,:,1)= aeiwdta(:,:,2)
541#    endif
542#  endif
543
544#else
545                ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
546                ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
547                ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
548#  if defined key_trcldf_eiv
549                aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
550                aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
551                aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
552#  endif
553
554#endif
555
556#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
557                    bblx(:,:)=bblxdta(:,:,2)
558                    bbly(:,:)=bblydta(:,:,2)
559#endif
560       !
561       ! keep needed fluxes
562       !
563                    wndm(:,:) = flx(:,:,jpwind)
564                    fr_i(:,:) = flx(:,:,jpice)
565                    emp(:,:) = flx(:,:,jpemp)
566                    emps(:,:) = emp(:,:)
567                    qsr(:,:) = flx(:,:,jpqsr)
568
569          END IF
570
571      ELSE
572          IF ( nsptint == 1 ) THEN
573      !
574      ! linear interpolation
575      !
576      ! initialize now fields with a linear interpolation
577      !
578                    un(:,:,:) = zweighm1 * udta(:,:,:,1) + zweigh * udta(:,:,:,2) 
579                    vn(:,:,:) = zweighm1 * vdta(:,:,:,1) + zweigh * vdta(:,:,:,2)
580                    wn(:,:,:) = zweighm1 * wdta(:,:,:,1) + zweigh * wdta(:,:,:,2)
581#if defined key_trc_diatrd
582                    hdivn(:,:,:) = zweighm1 * hdivdta(:,:,:,1) + zweigh * hdivdta(:,:,:,2)
583#endif
584#if defined key_zdfddm
585                    avs(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
586#endif
587                    avt(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
588                    tn(:,:,:) = zweighm1 * tdta(:,:,:,1) + zweigh * tdta(:,:,:,2)
589                    sn(:,:,:) = zweighm1 * sdta(:,:,:,1) + zweigh * sdta(:,:,:,2)
590   
591         
592#if defined key_ldfslp
593                    uslp(:,:,:) = zweighm1 * uslpdta(:,:,:,1) + zweigh * uslpdta(:,:,:,2) 
594                    vslp(:,:,:) = zweighm1 * vslpdta(:,:,:,1) + zweigh * vslpdta(:,:,:,2) 
595                    wslpi(:,:,:) = zweighm1 * wslpidta(:,:,:,1) + zweigh * wslpidta(:,:,:,2) 
596                    wslpj(:,:,:) = zweighm1 * wslpjdta(:,:,:,1) + zweigh * wslpjdta(:,:,:,2) 
597#endif
598                    flx(:,:,:) = zweighm1 * flxdta(:,:,:,1) + zweigh * flxdta(:,:,:,2) 
599                    hmld(:,:) = zweighm1 * zmxldta(:,:,1) + zweigh  * zmxldta(:,:,2) 
600#if ! defined key_off_degrad
601
602#  if defined key_traldf_c2d
603                    ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + zweigh * ahtwdta(:,:,2)
604#    if defined key_trcldf_eiv
605                    aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + zweigh * aeiwdta(:,:,2)
606#    endif
607#  endif
608
609#else
610                    ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + zweigh * ahtudta(:,:,:,2)
611                    ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + zweigh * ahtvdta(:,:,:,2)
612                    ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + zweigh * ahtwdta(:,:,:,2)
613#  if defined key_trcldf_eiv
614                    aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + zweigh * aeiudta(:,:,:,2)
615                    aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + zweigh * aeivdta(:,:,:,2)
616                    aeiw(:,:,:) = zweighm1 * aeiwdta(:,:,:,1) + zweigh * aeiwdta(:,:,:,2)
617#  endif
618                   
619#endif
620
621#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
622                    bblx(:,:) = zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2)
623                    bbly(:,:) = zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2)
624#endif
625       !
626       ! keep needed fluxes
627       !
628                  wndm(:,:) = flx(:,:,jpwind)
629                  fr_i(:,:) = flx(:,:,jpice)
630                  emp(:,:)  = flx(:,:,jpemp)
631                  emps(:,:) = emp(:,:)
632                  qsr(:,:)  = flx(:,:,jpqsr)
633       !
634       ! other interpolation
635       !
636          ELSE
637
638              WRITE (numout,*) ' this kind of interpolation don t EXIST'
639              WRITE (numout,*) ' at the moment. we STOP '
640              STOP 'dtadyn'
641
642          END IF
643
644      END IF
645      !
646      ! lb in any case, we need rhop
647      !
648      CALL eos( tn, sn, rhd, rhop ) 
649
650#if ! defined key_off_degrad && defined key_traldf_c2d
651      ! In case of 2D varying coefficients, we need aeiv and aeiu
652      IF( lk_traldf_eiv )   CALL ldf_eiv( kt )      ! eddy induced velocity coefficient
653#endif
654
655   END SUBROUTINE dta_dyn
656
657   SUBROUTINE dynrea( kt, kenr )
658      !!----------------------------------------------------------------------
659      !!                  ***  ROUTINE dynrea  ***
660      !!
661      !! ** Purpose : READ dynamics fiels from OPA9 netcdf output
662      !!
663      !! ** Method : READ the kenr records of DATA and store in
664      !!             in udta(...,2), .... 
665      !!
666      !! ** History : additions : M. Levy et M. Benjelloul jan 2001
667      !!              (netcdf FORMAT)
668      !!              05-03 (O. Aumont and A. El Moussaoui) F90
669      !!              06-07 : (C. Ethe) use of iom module
670      !!----------------------------------------------------------------------
671      !! * Modules used
672      USE iom
673
674      !! * Arguments
675      INTEGER, INTENT( in ) ::   kt, kenr       ! time index
676      !! * Local declarations
677      INTEGER ::  ji, jj, jk, jkenr
678
679      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
680        zu, zv, zw, zt, zs, zavt ,   &     ! 3-D dynamical fields
681        zhdiv                              ! horizontal divergence
682
683      REAL(wp), DIMENSION(jpi,jpj) :: &
684         zemp, zqsr, zmld, zice, zwspd
685#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
686      REAL(wp), DIMENSION(jpi,jpj) :: &
687        zbblx, zbbly
688#endif
689
690#if ! defined key_off_degrad
691
692#  if defined key_traldf_c2d
693      REAL(wp), DIMENSION(jpi,jpj) ::   &
694         zahtw
695#   if defined key_trcldf_eiv
696      REAL(wp), DIMENSION(jpi,jpj) ::   &
697         zaeiw
698#   endif
699#  endif
700
701#else
702
703   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
704      zahtu, zahtv, zahtw  !  Lateral diffusivity
705# if defined key_trcldf_eiv
706   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
707      zaeiu, zaeiv, zaeiw  ! G&M coefficient
708# endif
709
710#endif
711
712# if defined key_diaeiv
713   !! GM Velocity : to be used latter
714      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
715        zeivu, zeivv, zeivw
716# endif
717
718      CHARACTER(len=45)  ::  &
719         clname_t = 'dyna_grid_T.nc', &
720         clname_u = 'dyna_grid_U.nc', &
721         clname_v = 'dyna_grid_V.nc', &
722         clname_w = 'dyna_grid_W.nc'
723      !
724      ! 0. Initialization
725      ! cas d'un fichier non periodique : on utilise deux fois le premier et
726      ! le dernier champ temporel
727
728      jkenr = kenr
729
730      IF(lwp) THEN
731         WRITE(numout,*)
732         WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr
733         WRITE(numout,*) ' ~~~~~~~'
734#if defined key_off_degrad
735         WRITE(numout,*) ' Degraded fields'
736#endif
737         WRITE(numout,*)
738      ENDIF
739
740
741      IF( kt == nit000 .AND. nlecoff == 0 ) THEN
742
743         nlecoff = 1
744
745         CALL  iom_open ( clname_t, numfl_t )
746         CALL  iom_open ( clname_u, numfl_u )
747         CALL  iom_open ( clname_v, numfl_v )
748         CALL  iom_open ( clname_w, numfl_w )
749
750      ENDIF
751
752      ! file grid-T
753      !---------------
754      CALL iom_get ( numfl_t, jpdom_data, 'votemper', zt   (:,:,:), jkenr )
755      CALL iom_get ( numfl_t, jpdom_data, 'vosaline', zs   (:,:,:), jkenr )
756      CALL iom_get ( numfl_t, jpdom_data, 'somixhgt', zmld (:,:  ), jkenr )
757      CALL iom_get ( numfl_t, jpdom_data, 'sowaflcd', zemp (:,:  ), jkenr )
758      CALL iom_get ( numfl_t, jpdom_data, 'soshfldo', zqsr (:,:  ), jkenr )
759      CALL iom_get ( numfl_t, jpdom_data, 'soicecov', zice (:,:  ), jkenr )
760      CALL iom_get ( numfl_t, jpdom_data, 'sowindsp', zwspd(:,:  ), jkenr )
761
762      ! file grid-U
763      !---------------
764      CALL iom_get ( numfl_u, jpdom_data, 'vozocrtx', zu   (:,:,:), jkenr )
765#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
766      CALL iom_get ( numfl_u, jpdom_data, 'sobblcox', zbblx(:,:  ), jkenr )
767#endif
768
769#if defined key_diaeiv
770      !! GM Velocity : to be used latter
771      CALL iom_get ( numfl_u, jpdom_data, 'vozoeivu', zeivu(:,:,:), jkenr )
772#endif
773
774# if defined key_off_degrad
775      CALL iom_get ( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr )
776# if defined key_trcldf_eiv
777      CALL iom_get ( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr )
778# endif
779#endif
780
781      ! file grid-V
782      !---------------
783      CALL iom_get ( numfl_v, jpdom_data, 'vomecrty', zv   (:,:,:), jkenr )
784#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
785      CALL iom_get ( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,:  ), jkenr )
786#endif
787
788#if defined key_diaeiv
789      !! GM Velocity : to be used latter
790      CALL iom_get ( numfl_v, jpdom_data, 'vomeeivv', zeivv(:,:,:), jkenr )
791#endif
792
793#if defined key_off_degrad
794      CALL iom_get ( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr )
795#   if defined key_trcldf_eiv
796      CALL iom_get ( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr )
797#   endif
798#endif
799
800      ! file grid-W
801      !---------------
802!!      CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw   (:,:,:), jkenr )
803# if defined key_zdfddm
804      CALL iom_get ( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr )
805#else
806      CALL iom_get ( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr )
807#endif 
808
809# if defined key_diaeiv
810      !! GM Velocity : to be used latter
811      CALL iom_get ( numfl_w, jpdom_data, 'voveeivw', zeivw(:,:,:), jkenr )
812#endif 
813
814#if ! defined key_off_degrad
815#  if defined key_traldf_c2d
816      CALL iom_get ( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr )
817#   if   defined key_trcldf_eiv 
818      CALL iom_get ( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr )
819#   endif
820#  endif
821#else
822      !! degradation-integration
823      CALL iom_get ( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr )
824# if defined key_trcldf_eiv
825      CALL iom_get ( numfl_w, jpdom_data, 'voveaeiw', zaeiw(:,:,:), jkenr )
826# endif
827#endif
828
829      udta(:,:,:,2) = zu(:,:,:) * umask(:,:,:)
830      vdta(:,:,:,2) = zv(:,:,:) * vmask(:,:,:)
831!!       wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
832
833
834      ! Computation of vertical velocity using horizontal divergence
835      zhdiv(:,:,:) = 0.
836      DO jk = 1, jpkm1
837         DO jj = 2, jpjm1
838            DO ji = fs_2, fs_jpim1   ! vector opt.
839#if defined key_zco
840               zhdiv(ji,jj,jk) = (  e2u(ji,jj) * udta(ji,jj,jk,2) - e2u(ji-1,jj  ) * udta(ji-1,jj  ,jk,2)      &
841                  &               + e1v(ji,jj) * vdta(ji,jj,jk,2) - e1v(ji  ,jj-1) * vdta(ji  ,jj-1,jk,2)  )   &
842                  &            / ( e1t(ji,jj) * e2t(ji,jj) )
843#else
844               zhdiv(ji,jj,jk) =   &
845                  (  e2u(ji,jj)*fse3u(ji,jj,jk)*udta(ji,jj,jk,2) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*udta(ji-1,jj,jk,2)       &
846                  +  e1v(ji,jj)*fse3v(ji,jj,jk)*vdta(ji,jj,jk,2) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*vdta(ji,jj-1,jk,2)  )    &
847                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
848#endif
849            END DO
850         END DO         
851      ENDDO
852
853      ! Lateral boundary conditions on hdiv
854      CALL lbc_lnk( zhdiv, 'T', 1. )
855
856
857      ! computation of vertical velocity from the bottom
858      zw(:,:,jpk) = 0.
859      DO jk = jpkm1, 1, -1
860         zw(:,:,jk) = zw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)
861      END DO
862
863      wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
864#if defined key_trc_diatrd
865      hdivdta(:,:,:,2) = zhdiv(:,:,:) * tmask(:,:,:)
866#endif
867
868      tdta(:,:,:,2)   = zt(:,:,:)   * tmask(:,:,:)
869      sdta(:,:,:,2)   = zs(:,:,:)   * tmask(:,:,:)
870      avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:)
871#if ! defined key_off_degrad && defined key_traldf_c2d
872      ahtwdta(:,:,2)  = zahtw(:,:) * tmask(:,:,1)
873#if defined key_trcldf_eiv
874      aeiwdta(:,:,2)  = zaeiw(:,:) * tmask(:,:,1)
875#endif
876#endif
877
878#if defined key_off_degrad
879        ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:)
880        ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:)
881        ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:)
882#  if defined key_trcldf_eiv
883        aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:)
884        aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:)
885        aeiwdta(:,:,:,2) = zaeiw(:,:,:) * tmask(:,:,:)
886#  endif
887#endif
888
889      !
890      ! flux :
891      !
892      flxdta(:,:,jpwind,2) = zwspd(:,:) * tmask(:,:,1)
893      flxdta(:,:,jpice,2)  = MIN( 1., zice(:,:) ) * tmask(:,:,1)
894      flxdta(:,:,jpemp,2)  = zemp(:,:) * tmask(:,:,1)
895      flxdta(:,:,jpqsr,2)  = zqsr(:,:) * tmask(:,:,1)
896      zmxldta(:,:,2)       = zmld(:,:) * tmask(:,:,1)
897     
898#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
899      bblxdta(:,:,2) = MAX( 0., zbblx(:,:) )
900      bblydta(:,:,2) = MAX( 0., zbbly(:,:) )
901
902      WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0.
903      WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0.
904
905#endif
906
907      IF( kt == nitend ) THEN
908         CALL iom_close ( numfl_t )
909         CALL iom_close ( numfl_u )
910         CALL iom_close ( numfl_v )
911         CALL iom_close ( numfl_w )
912      ENDIF
913     
914   END SUBROUTINE dynrea
915
916
917
918END MODULE dtadyn
Note: See TracBrowser for help on using the repository browser.