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.
Changeset 12453 for NEMO/branches/UKMO/r12083_India_uncoupled/src/OCE/DIA/diaharm.F90 – NEMO

Ignore:
Timestamp:
2020-02-25T16:29:34+01:00 (4 years ago)
Author:
jcastill
Message:

First implementation of the branch - compiling after merge

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/r12083_India_uncoupled/src/OCE/DIA/diaharm.F90

    r11715 r12453  
    55   !!====================================================================== 
    66   !! History :  3.1  !  2007  (O. Le Galloudec, J. Chanut)  Original code 
     7   !!  
     8   !!   NB: 2017-12 : add 3D harmonic analysis of velocities  
     9   !!                 integration of Maria Luneva's development  
     10   !!   'key_3Ddiaharm 
    711   !!---------------------------------------------------------------------- 
    812   USE oce             ! ocean dynamics and tracers variables 
     
    1317   USE sbctide         ! Tidal forcing or not 
    1418   ! 
     19# if defined key_3Ddiaharm  
     20   USE zdf_oce  
     21#endif  
     22   ! 
    1523   USE in_out_manager  ! I/O units 
    1624   USE iom             ! I/0 library 
     
    3341   INTEGER         ::   nb_ana        ! Number of harmonics to analyse 
    3442 
    35    INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name 
    36    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ana_temp 
    37    REAL(wp), ALLOCATABLE, DIMENSION(:)       ::   ana_freq, ut   , vt   , ft 
    38    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   out_eta , out_u, out_v 
     43   INTEGER , ALLOCATABLE, DIMENSION(:)           ::   name 
     44   REAL(wp), ALLOCATABLE, DIMENSION(:)           ::   ana_freq, ut, vt, ft  
     45# if defined key_3Ddiaharm  
     46   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:)   ::   ana_temp  
     47   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)     ::   out_eta, out_u, out_v, out_w, out_dzi  
     48# else  
     49   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)     ::   ana_temp  
     50   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)       ::   out_eta, out_u, out_v  
     51# endif 
    3952 
    4053   INTEGER ::   ninco, nsparse 
     
    7689         WRITE(numout,*) 
    7790         WRITE(numout,*) 'dia_harm_init: Tidal harmonic analysis initialization' 
     91# if defined key_3Ddiaharm  
     92         WRITE(numout,*) '  - 3D harmonic analysis of currents activated (key_3Ddiaharm)'  
     93#endif 
    7894         WRITE(numout,*) '~~~~~~~ ' 
    7995      ENDIF 
     
    155171         ! Initialize temporary arrays: 
    156172         ! ---------------------------- 
    157          ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
    158          ana_temp(:,:,:,:) = 0._wp 
     173# if defined key_3Ddiaharm  
     174         ALLOCATE( ana_temp( jpi, jpj, 2*nb_ana, 5, jpk ) )  
     175         ana_temp(:,:,:,:,:) = 0._wp  
     176# else  
     177         ALLOCATE( ana_temp( jpi, jpj, 2*nb_ana, 3      ) )  
     178         ana_temp(:,:,:,:  ) = 0._wp  
     179#endif 
    159180 
    160181      ENDIF 
     
    175196      ! 
    176197      INTEGER  :: ji, jj, jh, jc, nhc 
     198# if defined key_3Ddiaharm  
     199      INTEGER  :: jk  
     200# endif 
    177201      REAL(wp) :: ztime, ztemp 
    178202      !!-------------------------------------------------------------------- 
     
    190214                  &    +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 
    191215                  ! 
     216               ! ssh, ub, vb are stored at the last level of 5d array 
    192217               DO jj = 1,jpj 
    193218                  DO ji = 1,jpi 
    194                      ! Elevation 
    195                      ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)         
    196                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 
    197                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 
     219                     ! Elevation and currents  
     220# if defined key_3Ddiaharm  
     221                     ana_temp(ji,jj,nhc,1,jpk) = ana_temp(ji,jj,nhc,1,jpk) + ztemp*sshn(ji,jj)*ssmask (ji,jj)          
     222                     ana_temp(ji,jj,nhc,2,jpk) = ana_temp(ji,jj,nhc,2,jpk) + ztemp*un_b(ji,jj)*ssumask(ji,jj)  
     223                     ana_temp(ji,jj,nhc,3,jpk) = ana_temp(ji,jj,nhc,3,jpk) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj)  
     224  
     225                     ana_temp(ji,jj,nhc,5,jpk) = ana_temp(ji,jj,nhc,5,jpk)                               &  
     226                   &                              + ztemp*bfrva(ji,jj)*vn(ji,jj,mbkv(ji,jj))*ssvmask(ji,jj)  
     227                     ana_temp(ji,jj,nhc,4,jpk) = ana_temp(ji,jj,nhc,4,jpk)                               &   
     228                   &                              + ztemp*bfrua(ji,jj)*un(ji,jj,mbku(ji,jj))*ssumask(ji,jj)  
     229# else  
     230                      ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)          
     231                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj)  
     232                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj)  
     233# endif 
    198234                  END DO 
    199235               END DO 
    200236               ! 
     237# if defined key_3Ddiaharm  
     238! 3d velocity and density:  
     239             DO jk=1,jpk-1  
     240               DO jj = 1,jpj  
     241                  DO ji = 1,jpi  
     242                     ! density and velocity  
     243                     ana_temp(ji,jj,nhc,1,jk) = ana_temp(ji,jj,nhc,1,jk) + ztemp*rhd(ji,jj,jk)  
     244                     ana_temp(ji,jj,nhc,2,jk) = ana_temp(ji,jj,nhc,2,jk) + ztemp*(un(ji,jj,jk)-un_b(ji,jj)) &  
     245                &                                          *umask(ji,jj,jk)  
     246                     ana_temp(ji,jj,nhc,3,jk) = ana_temp(ji,jj,nhc,3,jk) + ztemp*(vn(ji,jj,jk)-vn_b(ji,jj)) &  
     247                &                                          *vmask(ji,jj,jk)   
     248                     ana_temp(ji,jj,nhc,4,jk) = ana_temp(ji,jj,nhc,4,jk) + ztemp*wn(ji,jj,jk)  
     249   
     250                     ana_temp(ji,jj,nhc,5,jk) = ana_temp(ji,jj,nhc,5,jk) - 0.5*grav*ztemp*(rhd(ji,jj,jk)+rhd(ji,jj,jk+1))/max(rn2(ji,jj,jk),1.e-8_wp)  
     251                  END DO  
     252               END DO  
     253             ENDDO  
     254# endif 
    201255            END DO 
    202256         END DO 
     
    221275      !!-------------------------------------------------------------------- 
    222276      INTEGER :: ji, jj, jh, jc, jn, nhan, jl 
     277# if defined key_3Ddiaharm  
     278      INTEGER :: jk  
     279# endif 
    223280      INTEGER :: ksp, kun, keq 
    224281      REAL(wp) :: ztime, ztime_ini, ztime_end 
     
    234291      ztime_end = nitend_han*rdt                 ! Final time in seconds at the end of analysis 
    235292      nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis 
     293 
     294# if defined key_3Ddiaharm  
     295      ALLOCATE( out_eta(jpi,jpj,jpk,2*nb_ana),   &  
     296         &      out_u  (jpi,jpj,jpk,2*nb_ana),   &  
     297         &      out_v  (jpi,jpj,jpk,2*nb_ana),   &  
     298         &      out_w  (jpi,jpj,jpk,2*nb_ana),   &  
     299         &      out_dzi(jpi,jpj,jpk,2*nb_ana) )  
     300# else  
     301      ALLOCATE( out_eta(jpi,jpj,2*nb_ana),   &  
     302         &      out_u  (jpi,jpj,2*nb_ana),   &  
     303         &      out_v  (jpi,jpj,2*nb_ana)  )  
     304# endif  
     305  
     306      IF(lwp) WRITE(numout,*) 'ANA F OLD', ft   
     307      IF(lwp) WRITE(numout,*) 'ANA U OLD', ut  
     308      IF(lwp) WRITE(numout,*) 'ANA V OLD', vt 
    236309 
    237310      ninco = 2*nb_ana 
     
    257330      nsparse = ksp 
    258331 
    259       ! Elevation: 
     332      ! Density and Elevation:  
     333# if defined key_3Ddiaharm  
     334    DO jk=1,jpk  
     335# endif 
    260336      DO jj = 1, jpj 
    261337         DO ji = 1, jpi 
     
    265341               DO jc = 1, 2 
    266342                  kun = kun + 1 
     343# if defined key_3Ddiaharm  
     344                  ztmp4(kun)=ana_temp(ji,jj,kun,1,jk)  
     345# else  
    267346                  ztmp4(kun)=ana_temp(ji,jj,kun,1) 
     347# endif 
    268348               END DO 
    269349            END DO 
     
    278358         END DO 
    279359      END DO 
    280  
    281       ALLOCATE( out_eta(jpi,jpj,2*nb_ana),   &  
    282          &      out_u  (jpi,jpj,2*nb_ana),   & 
    283          &      out_v  (jpi,jpj,2*nb_ana)  ) 
    284360 
    285361      DO jj = 1, jpj 
     
    288364               X1 = ana_amp(ji,jj,jh,1) 
    289365               X2 =-ana_amp(ji,jj,jh,2) 
    290                out_eta(ji,jj,jh       ) = X1 * tmask_i(ji,jj) 
    291                out_eta(ji,jj,jh+nb_ana) = X2 * tmask_i(ji,jj) 
    292             END DO 
    293          END DO 
    294       END DO 
    295  
    296       ! ubar: 
     366# if defined key_3Ddiaharm  
     367               out_eta(ji,jj,jk,jh       ) = X1 * tmask_i(ji,jj)  
     368               out_eta(ji,jj,jk,jh+nb_ana) = X2 * tmask_i(ji,jj)  
     369# else  
     370               out_eta(ji,jj   ,jh       ) = X1 * tmask_i(ji,jj)  
     371               out_eta(ji,jj   ,jh+nb_ana) = X2 * tmask_i(ji,jj)  
     372# endif  
     373            END DO  
     374         END DO  
     375      END DO  
     376  
     377      ! u-component of velocity 
    297378      DO jj = 1, jpj 
    298379         DO ji = 1, jpi 
     
    302383               DO jc = 1,2 
    303384                  kun = kun + 1 
     385# if defined key_3Ddiaharm  
     386                  ztmp4(kun)=ana_temp(ji,jj,kun,2,jk)  
     387# else 
    304388                  ztmp4(kun)=ana_temp(ji,jj,kun,2) 
     389# endif 
    305390               END DO 
    306391            END DO 
     
    322407               X1= ana_amp(ji,jj,jh,1) 
    323408               X2=-ana_amp(ji,jj,jh,2) 
    324                out_u(ji,jj,       jh) = X1 * ssumask(ji,jj) 
    325                out_u(ji,jj,nb_ana+jh) = X2 * ssumask(ji,jj) 
     409# if defined key_3Ddiaharm  
     410               out_u(ji,jj,jk,       jh) = X1 * ssumask(ji,jj)  
     411               out_u(ji,jj,jk,nb_ana+jh) = X2 * ssumask(ji,jj)  
     412# else  
     413               out_u(ji,jj,          jh) = X1 * ssumask(ji,jj)  
     414               out_u(ji,jj,   nb_ana+jh) = X2 * ssumask(ji,jj)  
     415# endif 
    326416            ENDDO 
    327417         ENDDO 
    328418      ENDDO 
    329419 
    330       ! vbar: 
     420      ! v- velocity 
    331421      DO jj = 1, jpj 
    332422         DO ji = 1, jpi 
     
    336426               DO jc = 1,2 
    337427                  kun = kun + 1 
     428# if defined key_3Ddiaharm  
     429                  ztmp4(kun)=ana_temp(ji,jj,kun,3,jk)  
     430# else 
    338431                  ztmp4(kun)=ana_temp(ji,jj,kun,3) 
     432# endif 
    339433               END DO 
    340434            END DO 
     
    356450               X1=ana_amp(ji,jj,jh,1) 
    357451               X2=-ana_amp(ji,jj,jh,2) 
    358                out_v(ji,jj,       jh)=X1 * ssvmask(ji,jj) 
    359                out_v(ji,jj,nb_ana+jh)=X2 * ssvmask(ji,jj) 
    360             END DO 
    361          END DO 
    362       END DO 
     452# if defined key_3Ddiaharm  
     453               out_v(ji,jj,jk,       jh)=X1 * ssvmask(ji,jj)  
     454               out_v(ji,jj,jk,nb_ana+jh)=X2 * ssvmask(ji,jj)  
     455# else  
     456               out_v(ji,jj,          jh)=X1 * ssvmask(ji,jj)  
     457               out_v(ji,jj,   nb_ana+jh)=X2 * ssvmask(ji,jj)  
     458# endif  
     459            END DO  
     460         END DO  
     461      END DO  
     462  
     463# if defined key_3Ddiaharm  
     464      ! w- velocity  
     465      DO jj = 1, jpj  
     466         DO ji = 1, jpi  
     467            ! Fill input array  
     468            kun=0  
     469            DO jh = 1,nb_ana  
     470               DO jc = 1,2  
     471                  kun = kun + 1  
     472                  ztmp4(kun)=ana_temp(ji,jj,kun,4,jk)  
     473               END DO  
     474            END DO  
     475  
     476            CALL SUR_DETERMINE(jj+1)  
     477  
     478            ! Fill output array  
     479            DO jh = 1, nb_ana  
     480               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1)  
     481               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2)  
     482            END DO  
     483  
     484         END DO  
     485      END DO  
     486  
     487      DO jj = 1, jpj  
     488         DO ji = 1, jpi  
     489            DO jh = 1, nb_ana  
     490               X1=ana_amp(ji,jj,jh,1)  
     491               X2=-ana_amp(ji,jj,jh,2)  
     492               out_w(ji,jj,jk,       jh)=X1 * tmask_i(ji,jj)  
     493               out_w(ji,jj,jk,nb_ana+jh)=X2 * tmask_i(ji,jj)  
     494            END DO  
     495         END DO  
     496      END DO  
     497  
     498       ! dzi- isopycnal displacements  
     499      DO jj = 1, jpj  
     500         DO ji = 1, jpi  
     501            ! Fill input array  
     502            kun=0  
     503            DO jh = 1,nb_ana  
     504               DO jc = 1,2  
     505                  kun = kun + 1  
     506                  ztmp4(kun)=ana_temp(ji,jj,kun,5,jk)  
     507               END DO  
     508            END DO  
     509  
     510            CALL SUR_DETERMINE(jj+1)  
     511  
     512            ! Fill output array  
     513            DO jh = 1, nb_ana  
     514               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1)  
     515               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2)  
     516            END DO  
     517  
     518         END DO  
     519      END DO  
     520  
     521      DO jj = 1, jpj  
     522         DO ji = 1, jpi  
     523            DO jh = 1, nb_ana  
     524               X1=ana_amp(ji,jj,jh,1)  
     525               X2=-ana_amp(ji,jj,jh,2)  
     526               out_dzi(ji,jj,jk,       jh)=X1 * tmask_i(ji,jj)  
     527               out_dzi(ji,jj,jk,nb_ana+jh)=X2 * tmask_i(ji,jj)  
     528            END DO  
     529         END DO  
     530      END DO  
     531  
     532   ENDDO ! jk  
     533# endif 
    363534      ! 
    364535      CALL dia_wri_harm ! Write results in files 
     
    379550         cdfile_name_V         ! name of the file created (V-points) 
    380551      INTEGER  ::   jh 
    381       !!---------------------------------------------------------------------- 
     552 
     553# if defined key_3Ddiaharm  
     554      CHARACTER(LEN=lc) :: cdfile_name_W         ! name of the file created (W-points)  
     555      INTEGER  :: jk  
     556      REAL(WP), ALLOCATABLE, DIMENSION (:,:,:) :: z3real, z3im   
     557      REAL(WP), ALLOCATABLE, DIMENSION (:,:)   :: z2real, z2im        
     558# endif  
     559!!----------------------------------------------------------------------  
     560  
     561#if defined key_dimgout  
     562      cdfile_name_T = TRIM(cexper)//'_Tidal_harmonics_gridT.dimgproc'  
     563      cdfile_name_U = TRIM(cexper)//'_Tidal_harmonics_gridU.dimgproc'  
     564      cdfile_name_V = TRIM(cexper)//'_Tidal_harmonics_gridV.dimgproc'  
     565#   if defined key_3Ddiaharm  
     566      cdfile_name_W = TRIM(cexper)//'_Tidal_harmonics_gridW.dimgproc'  
     567#   endif  
     568#endif 
    382569 
    383570      IF(lwp) WRITE(numout,*) '  ' 
    384571      IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results' 
     572#if defined key_dimgout  
     573      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  Output files: ', TRIM(cdfile_name_T)  
     574      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_U)  
     575      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_V)  
     576#   if defined key_3Ddiaharm  
     577      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_W)  
     578#   endif  
     579#endif 
    385580      IF(lwp) WRITE(numout,*) '  ' 
    386581 
    387       ! A) Elevation 
     582# if defined key_3Ddiaharm  
     583      ALLOCATE(z3real(jpi,jpj,jpk),z3im(jpi,jpj,jpk),z2real(jpi,jpj),z2im(jpi,jpj))  
     584# endif  
     585  
     586      ! A) density and elevation 
    388587      !///////////// 
    389588      ! 
     589#if defined key_dimgout  
     590      cltext='density amplitude and phase; elevation is level=jpk '  
     591      CALL dia_wri_dimg(TRIM(cdfile_name_T), TRIM(cltext), out_eta, 2*nb_ana, '2')  
     592#else  
     593#   if defined key_3Ddiaharm  
     594      z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp  
     595#   endif 
    390596      DO jh = 1, nb_ana 
     597#   if defined key_3Ddiaharm  
     598        DO jk=1,jpkm1  
     599          z3real(:,:,jk)=out_eta(:,:,jk,jh)  
     600          z3im  (:,:,jk)=out_eta(:,:,jk,jh+nb_ana)  
     601        ENDDO  
     602      z2real(:,:)=out_eta(:,:,jpk,jh); z2im(:,:)=out_eta(:,:,jpk,jh+nb_ana)  
     603      CALL iom_put( TRIM(tname(jh))//'x_ro', z3real(:,:,:) )  
     604      CALL iom_put( TRIM(tname(jh))//'y_ro', z3im  (:,:,:) )  
     605      CALL iom_put( TRIM(tname(jh))//'x'   , z2real(:,:  ) )  
     606      CALL iom_put( TRIM(tname(jh))//'y'   , z2im  (:,:  ) )  
     607#   else   
     608      WRITE(numout,*) "OUTPUT ORI: ", TRIM(tname(jh))//'x', ' & ', TRIM(tname(jh))//'y', MAXVAL(out_eta(:,:,jh)) 
    391609      CALL iom_put( TRIM(tname(jh))//'x', out_eta(:,:,jh) ) 
    392610      CALL iom_put( TRIM(tname(jh))//'y', out_eta(:,:,nb_ana+jh) ) 
    393       END DO 
    394  
    395       ! B) ubar 
     611#   endif  
     612      END DO  
     613#endif  
     614  
     615      ! B) u 
    396616      !///////// 
    397617      ! 
     618#if defined key_dimgout  
     619      cltext='3d u amplitude and phase; ubar is the last level'  
     620      CALL dia_wri_dimg(TRIM(cdfile_name_U), TRIM(cltext), out_u, 2*nb_ana, '2')  
     621#else  
     622#   if defined key_3Ddiaharm  
     623      z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp  
     624#   endif 
    398625      DO jh = 1, nb_ana 
    399       CALL iom_put( TRIM(tname(jh))//'x_u', out_u(:,:,jh) ) 
    400       CALL iom_put( TRIM(tname(jh))//'y_u', out_u(:,:,nb_ana+jh) ) 
    401       END DO 
    402  
    403       ! C) vbar 
     626#   if defined key_3Ddiaharm  
     627        DO jk=1,jpkm1  
     628          z3real(:,:,jk)=out_u(:,:,jk,jh)  
     629          z3im  (:,:,jk)=out_u(:,:,jk,jh+nb_ana)  
     630        ENDDO  
     631        z2real(:,:)=out_u(:,:,jpk,jh); z2im(:,:)=out_u(:,:,jpk,jh+nb_ana)  
     632        CALL iom_put( TRIM(tname(jh))//'x_u3d', z3real(:,:,:) )  
     633        CALL iom_put( TRIM(tname(jh))//'y_u3d', z3im (:,:,:)  )  
     634        CALL iom_put( TRIM(tname(jh))//'x_u2d', z2real(:,:) )  
     635        CALL iom_put( TRIM(tname(jh))//'y_u2d', z2im (:,:)  )  
     636        z2real(:,:)=out_w(:,:,jpk,jh); z2im(:,:)=out_w(:,:,jpk,jh+nb_ana)  
     637        CALL iom_put( TRIM(tname(jh))//'x_tabx', z2real(:,:) )  
     638        CALL iom_put( TRIM(tname(jh))//'y_tabx', z2im (:,:)  )  
     639#   else  
     640        CALL iom_put( TRIM(tname(jh))//'x_u2d', out_u(:,:,jh) )  
     641        CALL iom_put( TRIM(tname(jh))//'y_u2d', out_u(:,:,nb_ana+jh) )  
     642#   endif  
     643      END DO  
     644#endif  
     645  
     646      ! C) v 
    404647      !///////// 
    405648      ! 
     649#if defined key_dimgout  
     650      cltext='3d v amplitude and phase; vbar is the last level'  
     651      CALL dia_wri_dimg(TRIM(cdfile_name_V), TRIM(cltext), out_v, 2*nb_ana, '2')  
     652#else  
     653#   if defined key_3Ddiaharm  
     654      z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp  
     655#   endif 
    406656      DO jh = 1, nb_ana 
    407          CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh       ) ) 
    408          CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) ) 
    409       END DO 
    410       ! 
     657#   if defined key_3Ddiaharm  
     658        DO jk=1,jpkm1  
     659          z3real(:,:,jk)=out_v(:,:,jk,jh)  
     660          z3im  (:,:,jk)=out_v(:,:,jk,jh+nb_ana)  
     661        ENDDO  
     662        z2real(:,:)=out_v(:,:,jpk,jh); z2im(:,:)=out_v(:,:,jpk,jh+nb_ana)  
     663        CALL iom_put( TRIM(tname(jh))//'x_v3d', z3real(:,:,:) )  
     664        CALL iom_put( TRIM(tname(jh))//'y_v3d', z3im (:,:,:)  )  
     665        CALL iom_put( TRIM(tname(jh))//'x_v2d'  , z2real(:,:) )  
     666        CALL iom_put( TRIM(tname(jh))//'y_v2d'  , z2im (:,:)  )  
     667        z2real(:,:)=out_dzi(:,:,jpk,jh); z2im(:,:)=out_dzi(:,:,jpk,jh+nb_ana)  
     668        CALL iom_put( TRIM(tname(jh))//'x_taby', z2real(:,:) )  
     669        CALL iom_put( TRIM(tname(jh))//'y_taby', z2im (:,:)  )  
     670#   else  
     671         CALL iom_put( TRIM(tname(jh))//'x_v2d', out_v(:,:,jh ) )  
     672         CALL iom_put( TRIM(tname(jh))//'y_v2d', out_v(:,:,jh+nb_ana) )  
     673#   endif  
     674       END DO  
     675  
     676#endif  
     677      ! D) w  
     678# if defined key_3Ddiaharm  
     679#   if defined key_dimgout  
     680      cltext='3d w amplitude and phase; vort_baro is the last level'  
     681      CALL dia_wri_dimg(TRIM(cdfile_name_W), TRIM(cltext), out_w, 2*nb_ana, '2')  
     682#   else  
     683      DO jh = 1, nb_ana  
     684        DO jk=1,jpkm1  
     685         z3real(:,:,jk)=out_w(:,:,jk,jh)  
     686         z3im(:,:,jk)=out_w(:,:,jk,jh+nb_ana)  
     687        ENDDO  
     688        CALL iom_put( TRIM(tname(jh))//'x_w3d', z3real(:,:,:) )  
     689        CALL iom_put( TRIM(tname(jh))//'y_w3d', z3im(:,:,:) )  
     690      END DO  
     691#   endif  
     692  
     693!       E) dzi + tau_bot  
     694#   if defined key_dimgout  
     695      cltext='dzi=g*ro/N2 amplitude and phase'  
     696      CALL dia_wri_dimg(TRIM(cdfile_name_W), TRIM(cltext), out_w, 2*nb_ana, '2')  
     697#   else  
     698      DO jh = 1, nb_ana  
     699        DO jk=1,jpkm1  
     700         z3real(:,:,jk)=out_dzi(:,:,jk,jh)  
     701         z3im(:,:,jk)=out_dzi(:,:,jk,jh+nb_ana)  
     702        ENDDO  
     703        CALL iom_put( TRIM(tname(jh))//'x_dzi', z3real(:,:,:) )  
     704        CALL iom_put( TRIM(tname(jh))//'y_dzi', z3im(:,:,:) )  
     705      END DO  
     706#   endif  
     707# endif   
     708  
     709      !  
     710# if defined key_3Ddiaharm  
     711   DEALLOCATE(z3real, z3im, z2real,z2im)  
     712# endif 
     713 
    411714   END SUBROUTINE dia_wri_harm 
    412715 
Note: See TracChangeset for help on using the changeset viewer.