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 10685 – NEMO

Changeset 10685


Ignore:
Timestamp:
2019-02-14T16:55:25+01:00 (5 years ago)
Author:
jcastill
Message:

Changes as Ash's files

Location:
branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC
Files:
2 added
10 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r10684 r10685  
    167167      ! Check and write out namelist parameters 
    168168      ! ----------------------------------------- 
    169       IF( jperio /= 0 )   CALL ctl_stop( 'bdy_segs: Cyclic or symmetric,',   & 
    170          &                               ' and general open boundary condition are not compatible' ) 
     169!     IF( jperio /= 0 )   CALL ctl_stop( 'bdy_segs: Cyclic or symmetric,',   & 
     170!        &                               ' and general open boundary condition are not compatible' ) 
    171171 
    172172      IF( nb_bdy == 0 ) THEN  
    … …  
    11611161      bdytmask(:,:) = ssmask(:,:) 
    11621162 
    1163       IF( ln_mask_file ) THEN 
    1164          CALL iom_open( cn_mask_file, inum ) 
    1165          CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) ) 
    1166          CALL iom_close( inum ) 
    1167  
    1168          ! Derive mask on U and V grid from mask on T grid 
    1169          bdyumask(:,:) = 0._wp 
    1170          bdyvmask(:,:) = 0._wp 
    1171          DO ij=1, jpjm1 
    1172             DO ii=1, jpim1 
    1173                bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 
    1174                bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    1175             END DO 
     1163      ! we need to derive mask on U and V grid from mask on T grid here. 
     1164      bdyumask(:,:) = 0._wp 
     1165      bdyvmask(:,:) = 0._wp 
     1166      DO ij = 1, jpjm1 
     1167         DO ii = 1, jpim1 
     1168            bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 
     1169            bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    11761170         END DO 
    1177          CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond. 
    1178  
    1179       ENDIF ! ln_mask_file=.TRUE. 
    1180        
    1181       IF( .NOT.ln_mask_file ) THEN 
    1182          ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here. 
    1183          bdyumask(:,:) = 0._wp 
    1184          bdyvmask(:,:) = 0._wp 
    1185          DO ij = 1, jpjm1 
    1186             DO ii = 1, jpim1 
    1187                bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 
    1188                bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    1189             END DO 
    1190          END DO 
    1191          CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond. 
    1192       ENDIF 
    1193  
     1171      END DO 
     1172      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond. 
     1173      
    11941174      ! bdy masks are now set to zero on boundary points: 
    11951175      ! 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r10684 r10685  
    99   !!---------------------------------------------------------------------- 
    1010   !!   'key_diaharm' 
     11   !! 
     12   !!   NB: 2017-12 : add 3D harmonic analysis of velocities 
     13   !!                 integration of Maria Luneva's development 
     14   !!   'key_3Ddiaharm' 
    1115   !!---------------------------------------------------------------------- 
    1216   USE oce             ! ocean dynamics and tracers variables 
    … …  
    1721   USE sbctide         ! Tidal forcing or not 
    1822   ! 
     23# if defined key_3Ddiaharm 
     24   USE zdf_oce 
     25#endif 
     26   ! 
    1927   USE in_out_manager  ! I/O units 
    2028   USE iom             ! I/0 library 
    … …  
    3846   INTEGER ::   nb_ana        ! Number of harmonics to analyse 
    3947 
    40    INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name 
    41    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ana_temp 
    42    REAL(wp), ALLOCATABLE, DIMENSION(:)       ::   ana_freq, ut   , vt   , ft 
    43    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   out_eta , out_u, out_v 
     48 
     49   INTEGER , ALLOCATABLE, DIMENSION(:)           ::   name 
     50   REAL(wp), ALLOCATABLE, DIMENSION(:)           ::   ana_freq, ut   , vt   , ft 
     51# if defined key_3Ddiaharm 
     52   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:)   ::   ana_temp 
     53   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)     ::   out_eta , out_u, out_v , out_w , out_dzi 
     54# else 
     55   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)     ::   ana_temp 
     56   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)       ::   out_eta , out_u, out_v 
     57# endif 
    4458 
    4559   INTEGER ::   ninco, nsparse 
    … …  
    7185      !! 
    7286      !!-------------------------------------------------------------------- 
    73       INTEGER :: jh, nhan, jk, ji 
     87      INTEGER :: jh, nhan, jl 
    7488      INTEGER ::   ios                 ! Local integer output status for namelist read 
    7589 
    … …  
    8094         WRITE(numout,*) 
    8195         WRITE(numout,*) 'dia_harm_init: Tidal harmonic analysis initialization' 
     96# if defined key_3Ddiaharm 
     97         WRITE(numout,*) '  - 3D harmonic analysis of currents actovated (key_3Ddiaharm)' 
     98#endif 
    8299         WRITE(numout,*) '~~~~~~~ ' 
    83100      ENDIF 
    … …  
    113130 
    114131      nb_ana = 0 
    115       DO jk=1,jpmax_harmo 
    116          DO ji=1,jpmax_harmo 
    117             IF(TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN 
     132      DO jh=1,jpmax_harmo 
     133         DO jl=1,jpmax_harmo 
     134            IF(TRIM(tname(jh)) == Wave(jl)%cname_tide) THEN 
    118135               nb_ana=nb_ana+1 
    119136            ENDIF 
    … …  
    134151 
    135152      ALLOCATE(name    (nb_ana)) 
    136       DO jk=1,nb_ana 
    137        DO ji=1,jpmax_harmo 
    138           IF (TRIM(tname(jk)) ==  Wave(ji)%cname_tide) THEN 
    139              name(jk) = ji 
     153      DO jh=1,nb_ana 
     154       DO jl=1,jpmax_harmo 
     155          IF (TRIM(tname(jh)) .eq. Wave(jl)%cname_tide) THEN 
     156             name(jh) = jl 
    140157             EXIT 
    141158          END IF 
    … …  
    157174      ! Initialize temporary arrays: 
    158175      ! ---------------------------- 
    159       ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
    160       ana_temp(:,:,:,:) = 0._wp 
     176# if defined key_3Ddiaharm 
     177      ALLOCATE( ana_temp( jpi, jpj, 2*nb_ana, 5, jpk ) ) 
     178      ana_temp(:,:,:,:,:) = 0._wp 
     179# else 
     180      ALLOCATE( ana_temp( jpi, jpj, 2*nb_ana, 3      ) ) 
     181      ana_temp(:,:,:,:  ) = 0._wp 
     182#endif 
    161183 
    162184   END SUBROUTINE dia_harm_init 
    … …  
    175197      ! 
    176198      INTEGER  :: ji, jj, jh, jc, nhc 
     199# if defined key_3Ddiaharm 
     200      INTEGER  :: jk 
     201# endif 
    177202      REAL(wp) :: ztime, ztemp 
    178203      !!-------------------------------------------------------------------- 
    … …  
    184209 
    185210         ztime = (kt-nit000+1) * rdt  
    186         
     211 
    187212         nhc = 0 
    188213         DO jh = 1, nb_ana 
    … …  
    192217                  &    +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 
    193218 
     219               ! ssh, ub, vb are stored at the last level of 5d array 
    194220               DO jj = 1,jpj 
    195221                  DO ji = 1,jpi 
    196                      ! Elevation 
    197                      ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)         
    198                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 
    199                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 
     222                     ! Elevation and currents 
     223# if defined key_3Ddiaharm 
     224                     ana_temp(ji,jj,nhc,1,jpk) = ana_temp(ji,jj,nhc,1,jpk) + ztemp*sshn(ji,jj)*ssmask (ji,jj)         
     225                     ana_temp(ji,jj,nhc,2,jpk) = ana_temp(ji,jj,nhc,2,jpk) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 
     226                     ana_temp(ji,jj,nhc,3,jpk) = ana_temp(ji,jj,nhc,3,jpk) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 
     227 
     228                     ana_temp(ji,jj,nhc,5,jpk) = ana_temp(ji,jj,nhc,5,jpk)                               & 
     229                   &                              + ztemp*bfrva(ji,jj)*vn(ji,jj,mbkv(ji,jj))*ssvmask(ji,jj) 
     230                     ana_temp(ji,jj,nhc,4,jpk) = ana_temp(ji,jj,nhc,4,jpk)                               &  
     231                   &                              + ztemp*bfrua(ji,jj)*un(ji,jj,mbku(ji,jj))*ssumask(ji,jj) 
     232# else 
     233                      ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj)         
     234                      ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 
     235                      ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 
     236# endif 
    200237                  END DO 
    201238               END DO 
    202239               ! 
     240# if defined key_3Ddiaharm 
     241! 3d velocity and density: 
     242             DO jk=1,jpk-1 
     243               DO jj = 1,jpj 
     244                  DO ji = 1,jpi 
     245                     ! density and velocity 
     246                     ana_temp(ji,jj,nhc,1,jk) = ana_temp(ji,jj,nhc,1,jk) + ztemp*rhd(ji,jj,jk) 
     247                     ana_temp(ji,jj,nhc,2,jk) = ana_temp(ji,jj,nhc,2,jk) + ztemp*(un(ji,jj,jk)-un_b(ji,jj)) & 
     248                &                                          *umask(ji,jj,jk) 
     249                     ana_temp(ji,jj,nhc,3,jk) = ana_temp(ji,jj,nhc,3,jk) + ztemp*(vn(ji,jj,jk)-vn_b(ji,jj)) & 
     250                &                                          *vmask(ji,jj,jk)  
     251                     ana_temp(ji,jj,nhc,4,jk) = ana_temp(ji,jj,nhc,4,jk) + ztemp*wn(ji,jj,jk) 
     252  
     253                     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) 
     254                  END DO 
     255               END DO 
     256             ENDDO 
     257# endif 
     258 
    203259            END DO 
    204260         END DO 
    … …  
    223279      !!-------------------------------------------------------------------- 
    224280      INTEGER :: ji, jj, jh, jc, jn, nhan, jl 
     281# if defined key_3Ddiaharm 
     282      INTEGER  :: jk 
     283# endif 
    225284      INTEGER :: ksp, kun, keq 
    226285      REAL(wp) :: ztime, ztime_ini, ztime_end 
    … …  
    238297      nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis 
    239298 
     299# if defined key_3Ddiaharm 
     300      ALLOCATE( out_eta(jpi,jpj,jpk,2*nb_ana),   & 
     301         &      out_u  (jpi,jpj,jpk,2*nb_ana),   & 
     302         &      out_v  (jpi,jpj,jpk,2*nb_ana),   & 
     303         &      out_w  (jpi,jpj,jpk,2*nb_ana),   & 
     304         &      out_dzi(jpi,jpj,jpk,2*nb_ana) ) 
     305# else 
     306      ALLOCATE( out_eta(jpi,jpj,2*nb_ana),   & 
     307         &      out_u  (jpi,jpj,2*nb_ana),   & 
     308         &      out_v  (jpi,jpj,2*nb_ana)  ) 
     309# endif 
     310 
     311      IF(lwp) WRITE(numout,*) 'ANA F OLD', ft  
     312      IF(lwp) WRITE(numout,*) 'ANA U OLD', ut 
     313      IF(lwp) WRITE(numout,*) 'ANA V OLD', vt 
     314 
     315 
    240316      ninco = 2*nb_ana 
    241  
    242317      ksp = 0 
    243318      keq = 0         
    … …  
    260335      nsparse = ksp 
    261336 
    262       ! Elevation: 
     337      ! Density and Elevation: 
     338# if defined key_3Ddiaharm 
     339    DO jk=1,jpk 
     340# endif 
    263341      DO jj = 1, jpj 
    264342         DO ji = 1, jpi 
    … …  
    268346               DO jc = 1, 2 
    269347                  kun = kun + 1 
     348# if defined key_3Ddiaharm 
     349                  ztmp4(kun)=ana_temp(ji,jj,kun,1,jk) 
     350# else 
    270351                  ztmp4(kun)=ana_temp(ji,jj,kun,1) 
     352# endif 
    271353               END DO 
    272354            END DO 
    … …  
    282364      END DO 
    283365 
    284       ALLOCATE( out_eta(jpi,jpj,2*nb_ana),   &  
    285          &      out_u  (jpi,jpj,2*nb_ana),   & 
    286          &      out_v  (jpi,jpj,2*nb_ana)  ) 
    287366 
    288367      DO jj = 1, jpj 
    … …  
    291370               X1 = ana_amp(ji,jj,jh,1) 
    292371               X2 =-ana_amp(ji,jj,jh,2) 
    293                out_eta(ji,jj,jh       ) = X1 * tmask_i(ji,jj) 
    294                out_eta(ji,jj,jh+nb_ana) = X2 * tmask_i(ji,jj) 
    295             END DO 
    296          END DO 
    297       END DO 
    298  
    299       ! ubar: 
     372# if defined key_3Ddiaharm 
     373               out_eta(ji,jj,jk,jh       ) = X1 * tmask_i(ji,jj) 
     374               out_eta(ji,jj,jk,jh+nb_ana) = X2 * tmask_i(ji,jj) 
     375# else 
     376               out_eta(ji,jj   ,jh       ) = X1 * tmask_i(ji,jj) 
     377               out_eta(ji,jj   ,jh+nb_ana) = X2 * tmask_i(ji,jj) 
     378# endif 
     379            END DO 
     380         END DO 
     381      END DO 
     382 
     383      ! u-component of velocity 
    300384      DO jj = 1, jpj 
    301385         DO ji = 1, jpi 
    … …  
    305389               DO jc = 1,2 
    306390                  kun = kun + 1 
     391# if defined key_3Ddiaharm 
     392                  ztmp4(kun)=ana_temp(ji,jj,kun,2,jk) 
     393# else 
    307394                  ztmp4(kun)=ana_temp(ji,jj,kun,2) 
     395# endif 
    308396               END DO 
    309397            END DO 
    … …  
    325413               X1= ana_amp(ji,jj,jh,1) 
    326414               X2=-ana_amp(ji,jj,jh,2) 
    327                out_u(ji,jj,       jh) = X1 * ssumask(ji,jj) 
    328                out_u(ji,jj,nb_ana+jh) = X2 * ssumask(ji,jj) 
     415# if defined key_3Ddiaharm 
     416               out_u(ji,jj,jk,       jh) = X1 * ssumask(ji,jj) 
     417               out_u(ji,jj,jk,nb_ana+jh) = X2 * ssumask(ji,jj) 
     418# else 
     419               out_u(ji,jj,          jh) = X1 * ssumask(ji,jj) 
     420               out_u(ji,jj,   nb_ana+jh) = X2 * ssumask(ji,jj) 
     421# endif 
    329422            ENDDO 
    330423         ENDDO 
    331424      ENDDO 
    332425 
    333       ! vbar: 
     426      ! v- velocity 
    334427      DO jj = 1, jpj 
    335428         DO ji = 1, jpi 
    … …  
    339432               DO jc = 1,2 
    340433                  kun = kun + 1 
     434# if defined key_3Ddiaharm 
     435                  ztmp4(kun)=ana_temp(ji,jj,kun,3,jk) 
     436# else 
    341437                  ztmp4(kun)=ana_temp(ji,jj,kun,3) 
     438# endif 
    342439               END DO 
    343440            END DO 
    … …  
    359456               X1=ana_amp(ji,jj,jh,1) 
    360457               X2=-ana_amp(ji,jj,jh,2) 
    361                out_v(ji,jj,       jh)=X1 * ssvmask(ji,jj) 
    362                out_v(ji,jj,nb_ana+jh)=X2 * ssvmask(ji,jj) 
    363             END DO 
    364          END DO 
    365       END DO 
     458# if defined key_3Ddiaharm 
     459               out_v(ji,jj,jk,       jh)=X1 * ssvmask(ji,jj) 
     460               out_v(ji,jj,jk,nb_ana+jh)=X2 * ssvmask(ji,jj) 
     461# else 
     462               out_v(ji,jj,          jh)=X1 * ssvmask(ji,jj) 
     463               out_v(ji,jj,   nb_ana+jh)=X2 * ssvmask(ji,jj) 
     464# endif 
     465            END DO 
     466         END DO 
     467      END DO 
     468 
     469# if defined key_3Ddiaharm 
     470      ! w- velocity 
     471      DO jj = 1, jpj 
     472         DO ji = 1, jpi 
     473            ! Fill input array 
     474            kun=0 
     475            DO jh = 1,nb_ana 
     476               DO jc = 1,2 
     477                  kun = kun + 1 
     478                  ztmp4(kun)=ana_temp(ji,jj,kun,4,jk) 
     479               END DO 
     480            END DO 
     481 
     482            CALL SUR_DETERMINE(jj+1) 
     483 
     484            ! Fill output array 
     485            DO jh = 1, nb_ana 
     486               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 
     487               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 
     488            END DO 
     489 
     490         END DO 
     491      END DO 
     492 
     493      DO jj = 1, jpj 
     494         DO ji = 1, jpi 
     495            DO jh = 1, nb_ana 
     496               X1=ana_amp(ji,jj,jh,1) 
     497               X2=-ana_amp(ji,jj,jh,2) 
     498               out_w(ji,jj,jk,       jh)=X1 * tmask_i(ji,jj) 
     499               out_w(ji,jj,jk,nb_ana+jh)=X2 * tmask_i(ji,jj) 
     500            END DO 
     501         END DO 
     502      END DO 
     503 
     504       ! dzi- isopycnal displacements 
     505      DO jj = 1, jpj 
     506         DO ji = 1, jpi 
     507            ! Fill input array 
     508            kun=0 
     509            DO jh = 1,nb_ana 
     510               DO jc = 1,2 
     511                  kun = kun + 1 
     512                  ztmp4(kun)=ana_temp(ji,jj,kun,5,jk) 
     513               END DO 
     514            END DO 
     515 
     516            CALL SUR_DETERMINE(jj+1) 
     517 
     518            ! Fill output array 
     519            DO jh = 1, nb_ana 
     520               ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 
     521               ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 
     522            END DO 
     523 
     524         END DO 
     525      END DO 
     526 
     527      DO jj = 1, jpj 
     528         DO ji = 1, jpi 
     529            DO jh = 1, nb_ana 
     530               X1=ana_amp(ji,jj,jh,1) 
     531               X2=-ana_amp(ji,jj,jh,2) 
     532               out_dzi(ji,jj,jk,       jh)=X1 * tmask_i(ji,jj) 
     533               out_dzi(ji,jj,jk,nb_ana+jh)=X2 * tmask_i(ji,jj) 
     534            END DO 
     535         END DO 
     536      END DO 
     537 
     538   ENDDO ! jk 
     539# endif 
    366540 
    367541      CALL dia_wri_harm ! Write results in files 
    … …  
    383557         cdfile_name_V         ! name of the file created (V-points) 
    384558      INTEGER  ::   jh 
    385       !!---------------------------------------------------------------------- 
     559 
     560# if defined key_3Ddiaharm 
     561      CHARACTER(LEN=lc) :: cdfile_name_W         ! name of the file created (W-points) 
     562      INTEGER  :: jk 
     563      REAL(WP), ALLOCATABLE, DIMENSION (:,:,:) :: z3real, z3im  
     564      REAL(WP), ALLOCATABLE, DIMENSION (:,:)   :: z2real, z2im       
     565# endif 
     566!!---------------------------------------------------------------------- 
     567 
     568#if defined key_dimgout 
     569      cdfile_name_T = TRIM(cexper)//'_Tidal_harmonics_gridT.dimgproc' 
     570      cdfile_name_U = TRIM(cexper)//'_Tidal_harmonics_gridU.dimgproc' 
     571      cdfile_name_V = TRIM(cexper)//'_Tidal_harmonics_gridV.dimgproc' 
     572#   if defined key_3Ddiaharm 
     573      cdfile_name_W = TRIM(cexper)//'_Tidal_harmonics_gridW.dimgproc' 
     574#   endif 
     575#endif 
    386576 
    387577      IF(lwp) WRITE(numout,*) '  ' 
    388578      IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results' 
     579#if defined key_dimgout 
     580      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  Output files: ', TRIM(cdfile_name_T) 
     581      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_U) 
     582      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_V) 
     583#   if defined key_3Ddiaharm 
     584      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_W) 
     585#   endif 
     586#endif 
    389587      IF(lwp) WRITE(numout,*) '  ' 
    390588 
    391       ! A) Elevation 
     589# if defined key_3Ddiaharm 
     590      ALLOCATE( z3real(jpi,jpj,jpk),z3im(jpi,jpj,jpk),z2real(jpi,jpj),z2im(jpi,jpj)) 
     591# endif 
     592 
     593      ! A) density and elevation 
    392594      !///////////// 
    393595      ! 
     596#if defined key_dimgout 
     597      cltext='density amplitude and phase; elevation is level=jpk ' 
     598      CALL dia_wri_dimg(TRIM(cdfile_name_T), TRIM(cltext), out_eta, 2*nb_ana, '2') 
     599#else 
     600#   if defined key_3Ddiaharm 
     601      z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp 
     602#   endif 
    394603      DO jh = 1, nb_ana 
     604#   if defined key_3Ddiaharm 
     605        DO jk=1,jpkm1 
     606          z3real(:,:,jk)=out_eta(:,:,jk,jh) 
     607          z3im  (:,:,jk)=out_eta(:,:,jk,jh+nb_ana) 
     608        ENDDO 
     609      z2real(:,:)=out_eta(:,:,jpk,jh); z2im(:,:)=out_eta(:,:,jpk,jh+nb_ana) 
     610      CALL iom_put( TRIM(tname(jh))//'x_ro', z3real(:,:,:) ) 
     611      CALL iom_put( TRIM(tname(jh))//'y_ro', z3im  (:,:,:) ) 
     612      CALL iom_put( TRIM(tname(jh))//'x'   , z2real(:,:  ) ) 
     613      CALL iom_put( TRIM(tname(jh))//'y'   , z2im  (:,:  ) ) 
     614#   else  
     615      WRITE(numout,*) "OUTPUT ORI: ", TRIM(tname(jh))//'x', ' & ', TRIM(tname(jh))//'y', MAXVAL(out_eta(:,:,jh)) 
    395616      CALL iom_put( TRIM(tname(jh))//'x', out_eta(:,:,jh) ) 
    396617      CALL iom_put( TRIM(tname(jh))//'y', out_eta(:,:,nb_ana+jh) ) 
    397       END DO 
    398  
    399       ! B) ubar 
     618#   endif 
     619      END DO 
     620#endif 
     621 
     622      ! B) u 
    400623      !///////// 
    401624      ! 
     625#if defined key_dimgout 
     626      cltext='3d u amplitude and phase; ubar is the last level' 
     627      CALL dia_wri_dimg(TRIM(cdfile_name_U), TRIM(cltext), out_u, 2*nb_ana, '2') 
     628#else 
     629#   if defined key_3Ddiaharm 
     630      z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp 
     631#   endif 
    402632      DO jh = 1, nb_ana 
    403       CALL iom_put( TRIM(tname(jh))//'x_u', out_u(:,:,jh) ) 
    404       CALL iom_put( TRIM(tname(jh))//'y_u', out_u(:,:,nb_ana+jh) ) 
    405       END DO 
    406  
    407       ! C) vbar 
     633#   if defined key_3Ddiaharm 
     634        DO jk=1,jpkm1 
     635          z3real(:,:,jk)=out_u(:,:,jk,jh) 
     636          z3im  (:,:,jk)=out_u(:,:,jk,jh+nb_ana) 
     637        ENDDO 
     638        z2real(:,:)=out_u(:,:,jpk,jh); z2im(:,:)=out_u(:,:,jpk,jh+nb_ana) 
     639        CALL iom_put( TRIM(tname(jh))//'x_u3d', z3real(:,:,:) ) 
     640        CALL iom_put( TRIM(tname(jh))//'y_u3d', z3im (:,:,:)  ) 
     641        CALL iom_put( TRIM(tname(jh))//'x_u2d', z2real(:,:) ) 
     642        CALL iom_put( TRIM(tname(jh))//'y_u2d', z2im (:,:)  ) 
     643        z2real(:,:)=out_w(:,:,jpk,jh); z2im(:,:)=out_w(:,:,jpk,jh+nb_ana) 
     644        CALL iom_put( TRIM(tname(jh))//'x_tabx', z2real(:,:) ) 
     645        CALL iom_put( TRIM(tname(jh))//'y_tabx', z2im (:,:)  ) 
     646#   else 
     647        CALL iom_put( TRIM(tname(jh))//'x_u2d', out_u(:,:,jh) ) 
     648        CALL iom_put( TRIM(tname(jh))//'y_u2d', out_u(:,:,nb_ana+jh) ) 
     649#   endif 
     650      END DO 
     651#endif 
     652 
     653      ! C) v 
    408654      !///////// 
    409655      ! 
     656#if defined key_dimgout 
     657      cltext='3d v amplitude and phase; vbar is the last level' 
     658      CALL dia_wri_dimg(TRIM(cdfile_name_V), TRIM(cltext), out_v, 2*nb_ana, '2') 
     659#else 
     660#   if defined key_3Ddiaharm 
     661      z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp 
     662#   endif 
    410663      DO jh = 1, nb_ana 
    411          CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh       ) ) 
    412          CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) ) 
    413       END DO 
    414       ! 
     664#   if defined key_3Ddiaharm 
     665        DO jk=1,jpkm1 
     666          z3real(:,:,jk)=out_v(:,:,jk,jh) 
     667          z3im  (:,:,jk)=out_v(:,:,jk,jh+nb_ana) 
     668        ENDDO 
     669        z2real(:,:)=out_v(:,:,jpk,jh); z2im(:,:)=out_v(:,:,jpk,jh+nb_ana) 
     670        CALL iom_put( TRIM(tname(jh))//'x_v3d', z3real(:,:,:) ) 
     671        CALL iom_put( TRIM(tname(jh))//'y_v3d', z3im (:,:,:)  ) 
     672        CALL iom_put( TRIM(tname(jh))//'x_v2d'  , z2real(:,:) ) 
     673        CALL iom_put( TRIM(tname(jh))//'y_v2d'  , z2im (:,:)  ) 
     674        z2real(:,:)=out_dzi(:,:,jpk,jh); z2im(:,:)=out_dzi(:,:,jpk,jh+nb_ana) 
     675        CALL iom_put( TRIM(tname(jh))//'x_taby', z2real(:,:) ) 
     676        CALL iom_put( TRIM(tname(jh))//'y_taby', z2im (:,:)  ) 
     677#   else 
     678         CALL iom_put( TRIM(tname(jh))//'x_v2d', out_v(:,:,jh       ) ) 
     679         CALL iom_put( TRIM(tname(jh))//'y_v2d', out_v(:,:,jh+nb_ana) ) 
     680#   endif 
     681       END DO 
     682 
     683#endif 
     684      ! D) w 
     685# if defined key_3Ddiaharm 
     686#   if defined key_dimgout 
     687      cltext='3d w amplitude and phase; vort_baro is the last level' 
     688      CALL dia_wri_dimg(TRIM(cdfile_name_W), TRIM(cltext), out_w, 2*nb_ana, '2') 
     689#   else 
     690      DO jh = 1, nb_ana 
     691        DO jk=1,jpkm1 
     692         z3real(:,:,jk)=out_w(:,:,jk,jh) 
     693         z3im(:,:,jk)=out_w(:,:,jk,jh+nb_ana) 
     694        ENDDO 
     695        CALL iom_put( TRIM(tname(jh))//'x_w3d', z3real(:,:,:) ) 
     696        CALL iom_put( TRIM(tname(jh))//'y_w3d', z3im(:,:,:) ) 
     697      END DO 
     698#   endif 
     699 
     700!       E) dzi + tau_bot 
     701#   if defined key_dimgout 
     702      cltext='dzi=g*ro/N2 amplitude and phase' 
     703      CALL dia_wri_dimg(TRIM(cdfile_name_W), TRIM(cltext), out_w, 2*nb_ana, '2') 
     704#   else 
     705      DO jh = 1, nb_ana 
     706        DO jk=1,jpkm1 
     707         z3real(:,:,jk)=out_dzi(:,:,jk,jh) 
     708         z3im(:,:,jk)=out_dzi(:,:,jk,jh+nb_ana) 
     709        ENDDO 
     710        CALL iom_put( TRIM(tname(jh))//'x_dzi', z3real(:,:,:) ) 
     711        CALL iom_put( TRIM(tname(jh))//'y_dzi', z3im(:,:,:) ) 
     712      END DO 
     713#   endif 
     714# endif  
     715 
     716      ! 
     717# if defined key_3Ddiaharm 
     718   DEALLOCATE(z3real, z3im, z2real,z2im) 
     719# endif 
     720 
    415721   END SUBROUTINE dia_wri_harm 
    416722 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r10684 r10685  
    2828   USE bdy_oce       
    2929   USE in_out_manager ! I/O manager 
     30   USE iom 
    3031   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3132   USE lib_mpp        ! Massively Parallel Processing library 
    … …  
    161162      ! ------------------------ 
    162163      IF ( ln_bdy .AND. ln_mask_file ) THEN 
     164         CALL iom_open( cn_mask_file, inum ) 
     165         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) ) 
     166         CALL iom_close( inum ) 
    163167         DO jk = 1, jpkm1 
    164168            DO jj = 1, jpj 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r10684 r10685  
    2323   USE wrk_nemo        ! Memory allocation 
    2424   USE timing          ! Timing 
     25   USE iom 
    2526 
    2627   IMPLICIT NONE 
    … …  
    3132 
    3233   LOGICAL , PUBLIC ::   ln_tsd_init      !: T & S data flag 
     34   LOGICAL , PUBLIC ::   ln_tsd_interp    !: vertical interpolation flag 
    3335   LOGICAL , PUBLIC ::   ln_tsd_tradmp    !: internal damping toward input data flag 
    3436 
    3537   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read) 
     38   INTEGER                                 ::   jpk_init , inum_dta 
     39   INTEGER                                 ::   id ,linum   ! local integers 
     40   INTEGER                                 ::   zdim(4) 
    3641 
    3742   !!---------------------------------------------------------------------- 
    … …  
    5358      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used 
    5459      ! 
    55       INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers 
     60      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3, ierr4, ierr5   ! local integers 
    5661      !! 
    5762      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files 
    58       TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read 
    59       TYPE(FLD_N)                   ::   sn_tem, sn_sal 
     63      TYPE(FLD_N), DIMENSION(jpts+2)::   slf_i           ! array of namelist informations on the fields to read 
     64      TYPE(FLD_N)                   ::   sn_tem, sn_sal, sn_dep, sn_msk 
     65       
    6066      !! 
    61       NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 
     67      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_interp, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal, sn_dep, sn_msk 
    6268      !!---------------------------------------------------------------------- 
    6369      ! 
    … …  
    6571      ! 
    6672      !  Initialisation 
    67       ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
     73      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0  ; ierr4 = 0  ;  ierr5 = 0  
    6874      ! 
    6975      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :  
    … …  
    8490         WRITE(numout,*) '   Namelist namtsd' 
    8591         WRITE(numout,*) '      Initialisation of ocean T & S with T &S input data   ln_tsd_init   = ', ln_tsd_init 
     92         WRITE(numout,*) '      iInterpolation of initial conditions in the vertical ln_tsd_interp = ', ln_tsd_interp 
    8693         WRITE(numout,*) '      damping of ocean T & S toward T &S input data        ln_tsd_tradmp = ', ln_tsd_tradmp 
    8794         WRITE(numout,*) 
    … …  
    97104         ln_tsd_init = .FALSE. 
    98105      ENDIF 
     106      IF( ln_tsd_interp .AND. ln_tsd_tradmp ) THEN 
     107            CALL ctl_stop( 'dta_tsd_init: Tracer damping and vertical interpolation not yet configured' )   ;   RETURN 
     108      ENDIF 
     109      IF( ln_tsd_interp .AND. LEN(TRIM(sn_msk%wname)) > 0 ) THEN 
     110            CALL ctl_stop( 'dta_tsd_init: Using vertical interpolation and weights files not recommended' )   ;   RETURN 
     111      ENDIF 
    99112      ! 
    100113      !                             ! allocate the arrays (if necessary) 
    101114      IF(  ln_tsd_init .OR. ln_tsd_tradmp  ) THEN 
    102115         ! 
    103          ALLOCATE( sf_tsd(jpts), STAT=ierr0 ) 
     116         IF( ln_tsd_interp ) THEN 
     117           ALLOCATE( sf_tsd(jpts+2), STAT=ierr0 ) ! to carry the addtional depth information 
     118         ELSE 
     119           ALLOCATE( sf_tsd(jpts  ), STAT=ierr0 )  
     120         ENDIF  
    104121         IF( ierr0 > 0 ) THEN 
    105122            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN 
    106123         ENDIF 
    107124         ! 
    108                                 ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 ) 
    109          IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 
    110                                 ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
    111          IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    112          ! 
    113          IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN 
     125         IF( ln_tsd_interp ) THEN 
     126            CALL iom_open ( trim(cn_dir) // trim(sn_dep%clname), inum_dta )  
     127            id = iom_varid( inum_dta, sn_dep%clvar, zdim ) 
     128            jpk_init = zdim(3) 
     129            IF(lwp) WRITE(numout,*) 'Dimension of veritcal coordinate in ICs: ', jpk_init 
     130            CALL iom_close( inum_dta )   ! Close the input file 
     131            ! 
     132                                 ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk_init  ) , STAT=ierr0 ) 
     133            IF( sn_tem%ln_tint ) ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk_init,2) , STAT=ierr1 ) 
     134                                 ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk_init  ) , STAT=ierr2 ) 
     135            IF( sn_sal%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk_init,2) , STAT=ierr3 )   
     136                                 ALLOCATE( sf_tsd(jp_dep)%fnow(jpi,jpj,jpk_init  ) , STAT=ierr4 ) 
     137                                 ALLOCATE( sf_tsd(jp_msk)%fnow(jpi,jpj,jpk_init  ) , STAT=ierr5 ) 
     138         ELSE 
     139                                 ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 ) 
     140            IF( sn_tem%ln_tint ) ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 
     141                                 ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
     142            IF( sn_sal%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )   
     143         ENDIF ! ln_tsd_interp 
     144 
     145         ! 
     146         IF( ierr0 + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 > 0 ) THEN 
    114147            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN 
    115148         ENDIF 
    116149         !                         ! fill sf_tsd with sn_tem & sn_sal and control print 
    117150         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal 
     151         IF( ln_tsd_interp ) slf_i(jp_dep) = sn_dep   ;   slf_i(jp_msk) = sn_msk 
    118152         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print ) 
    119153         ! 
    … …  
    143177      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
    144178      ! 
    145       INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    146       INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
     179      INTEGER ::   ji, jj, jk, jl, jk_init   ! dummy loop indicies 
     180      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1        ! local integers 
    147181      REAL(wp)::   zl, zi 
    148       REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace 
    149182      !!---------------------------------------------------------------------- 
    150183      ! 
    … …  
    181214!!gm end 
    182215      ! 
    183       ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask 
    184       ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:)  
    185       ! 
    186       IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    187          ! 
    188          CALL wrk_alloc( jpk, ztp, zsp ) 
    189          ! 
    190          IF( kt == nit000 .AND. lwp )THEN 
    191             WRITE(numout,*) 
    192             WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
    193          ENDIF 
    194          ! 
    195          DO jj = 1, jpj                         ! vertical interpolation of T & S 
    196             DO ji = 1, jpi 
    197                DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     216      IF( kt == nit000 .AND. lwp )THEN 
     217         WRITE(numout,*) 
     218         WRITE(numout,*) 'dta_tsd: interpolates T & S data onto current mesh' 
     219      ENDIF 
     220      ! 
     221      IF( ln_tsd_interp ) THEN                 ! probably should use pointers in the following to make more readable 
     222      ! 
     223         DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     224            DO jj= 1, jpj 
     225               DO ji= 1, jpi 
    198226                  zl = gdept_0(ji,jj,jk) 
    199                   IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data 
    200                      ztp(jk) =  ptsd(ji,jj,1    ,jp_tem) 
    201                      zsp(jk) =  ptsd(ji,jj,1    ,jp_sal) 
    202                   ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data 
    203                      ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem) 
    204                      zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal) 
    205                   ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    206                      DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    207                         IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    208                            zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    209                            ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi  
    210                            zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 
     227                  IF( zl < sf_tsd(jp_dep)%fnow(ji,jj,1) ) THEN                     ! above the first level of data 
     228                     ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,1)  
     229                     ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,1) 
     230                  ELSEIF( zl > sf_tsd(jp_dep)%fnow(ji,jj,jpk_init) ) THEN          ! below the last level of data 
     231                     ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jpk_init) 
     232                     ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jpk_init) 
     233                  ELSE                                                             ! inbetween : vertical interpolation between jk_init & jk_init+1 
     234                     DO jk_init = 1, jpk_init-1                                    ! when  gdept(jk_init) < zl < gdept(jk_init+1) 
     235                        IF( sf_tsd(jp_msk)%fnow(ji,jj,jk_init+1) == 0 ) THEN       ! if there is no data fill down 
     236                           sf_tsd(jp_tem)%fnow(ji,jj,jk_init+1) = sf_tsd(jp_tem)%fnow(ji,jj,jk_init) 
     237                           sf_tsd(jp_sal)%fnow(ji,jj,jk_init+1) = sf_tsd(jp_sal)%fnow(ji,jj,jk_init) 
     238                        ENDIF 
     239                        IF( (zl-sf_tsd(jp_dep)%fnow(ji,jj,jk_init)) * (zl-sf_tsd(jp_dep)%fnow(ji,jj,jk_init+1)) <= 0._wp ) THEN 
     240                           zi = ( zl - sf_tsd(jp_dep)%fnow(ji,jj,jk_init) ) / & 
     241                        &       (sf_tsd(jp_dep)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_dep)%fnow(ji,jj,jk_init)) 
     242                           ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk_init) + & 
     243                        &                          (sf_tsd(jp_tem)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_tem)%fnow(ji,jj,jk_init)) * zi 
     244                           ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk_init) + & 
     245                        &                          (sf_tsd(jp_sal)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_sal)%fnow(ji,jj,jk_init)) * zi 
    211246                        ENDIF 
    212247                     END DO 
    213248                  ENDIF 
    214                END DO 
    215                DO jk = 1, jpkm1 
    216                   ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    217                   ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 
    218                END DO 
    219                ptsd(ji,jj,jpk,jp_tem) = 0._wp 
    220                ptsd(ji,jj,jpk,jp_sal) = 0._wp 
    221             END DO 
     249               ENDDO 
     250            ENDDO 
    222251         END DO 
    223          !  
    224          CALL wrk_dealloc( jpk, ztp, zsp ) 
    225          !  
     252         ! 
     253         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) *tmask(:,:,:) 
     254         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) *tmask(:,:,:) 
    226255      ELSE                                !==   z- or zps- coordinate   ==! 
    227256         !                              
    228          ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask 
    229          ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 
     257         ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)  * tmask(:,:,:)  ! Mask 
     258         ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) * tmask(:,:,:) 
    230259         ! 
    231260         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
    … …  
    257286                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure 
    258287         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta ) 
     288         IF( ln_tsd_interp )            DEALLOCATE( sf_tsd(jp_dep)%fnow )     ! T arrays in the structure 
     289         IF( ln_tsd_interp )            DEALLOCATE( sf_tsd(jp_msk)%fnow )     ! T arrays in the structure 
    259290                                        DEALLOCATE( sf_tsd              )     ! the structure itself 
    260291      ENDIF 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90

    r10684 r10685  
    1616   USE ioipsl         ! NetCDF IPSL library 
    1717   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     18   USE bdytides 
    1819 
    1920   IMPLICIT NONE 
    … …  
    9899 
    99100      DO jk = 1, nb_harmo 
    100          zcons = 0.7_wp * Wave(ntide(jk))%equitide * ftide(jk) 
     101         ! love number now provides in tide namelist 
     102         zcons = dn_love_number * Wave(ntide(jk))%equitide * ftide(jk) 
    101103         DO ji = 1, jpi 
    102104            DO jj = 1, jpj 
    … …  
    109111               IF    ( Wave(ntide(jk))%nutide == 1 )  THEN  ;  zcs = zcons * SIN( 2._wp*zlat ) 
    110112               ELSEIF( Wave(ntide(jk))%nutide == 2 )  THEN  ;  zcs = zcons * COS( zlat )**2 
     113               ! Add tide potential for long period tides 
     114               ELSEIF( Wave(ntide(jk))%nutide == 0 )  THEN  ;  zcs = zcons * (0.5_wp-1.5_wp*SIN(zlat)**2._wp) 
    111115               ELSE                                         ;  zcs = 0._wp 
    112116               ENDIF 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90

    r10684 r10685  
    1616   PUBLIC   tide_init_Wave   ! called by tideini and diaharm modules 
    1717 
     18# if defined key_FES14_tides 
     19   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 34   !: maximum number of harmonic 
     20# else 
    1821   INTEGER, PUBLIC, PARAMETER ::   jpmax_harmo = 19   !: maximum number of harmonic 
     22# endif 
    1923 
    2024   TYPE, PUBLIC ::    tide 
    … …  
    4145 
    4246   SUBROUTINE tide_init_Wave 
     47# if defined key_FES14_tides 
     48#     include "tide_FES14.h90" 
     49# else 
    4350#     include "tide.h90" 
     51# endif 
    4452   END SUBROUTINE tide_init_Wave 
    4553 
    … …  
    331339         zf = zf * zf1 * zf1 
    332340         ! 
     341      CASE( 20 )                 !==  formule 20,  compound waves ( 78 x 78 x 78 x 78 ) 
     342         zf1 = nodal_factort(78) 
     343         zf  = zf1 * zf1 * zf1 * zf1 
     344         ! 
    333345      CASE( 73 )                 !==  formule 73 
    334346         zs = sin(sh_I) 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

    r10684 r10685  
    3131   INTEGER , PUBLIC ::   kt_tide         !: 
    3232   REAL(wp), PUBLIC ::   rdttideramp     !: 
    33     
     33   REAL(wp), PUBLIC ::   dn_love_number  !: 
    3434   INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) ::   ntide   !: 
    3535 
    … …  
    4949      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    5050      ! 
    51       NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_tide_ramp, rdttideramp, clname 
     51      NAMELIST/nam_tide/ln_tide, ln_tide_pot, ln_tide_ramp, rdttideramp, dn_love_number, clname 
    5252      !!---------------------------------------------------------------------- 
    5353      ! 
    … …  
    7070            WRITE(numout,*) '              Use tidal components : ln_tide      = ', ln_tide 
    7171            WRITE(numout,*) '      Apply astronomical potential : ln_tide_pot  = ', ln_tide_pot 
    72             WRITE(numout,*) '                                     nb_harmo     = ', nb_harmo 
    7372            WRITE(numout,*) '                                     ln_tide_ramp = ', ln_tide_ramp 
    74             WRITE(numout,*) '                                     rdttideramp  = ', rdttideramp 
     73            WRITE(numout,*) '                                     dn_love_number = ', dn_love_number 
    7574         ENDIF 
    7675      ELSE 
    … …  
    8988         END DO 
    9089      END DO 
    91       !        
     90      IF (ln_tide .and.lwp) WRITE(numout,*) '                                     nb_harmo     = ', nb_harmo 
     91 
    9292      ! Ensure that tidal components have been set in namelist_cfg 
    9393      IF( nb_harmo == 0 )   CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r10684 r10685  
    6868   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature 
    6969   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity 
     70   INTEGER, PUBLIC, PARAMETER ::   jp_dep = 3    !: indice for depth 
     71   INTEGER, PUBLIC, PARAMETER ::   jp_msk = 4    !: indice for depth 
    7072 
    7173   !!---------------------------------------------------------------------- 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/step.F90

    r10684 r10685  
    238238                         CALL dia_ar5( kstp )         ! ar5 diag 
    239239      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis 
     240      IF( lk_diaharm_fast )                           & 
     241            &            CALL dia_harm_fast( kstp )   ! Tidal harmonic analysis - restart and faster version 
    240242                         CALL dia_wri( kstp )         ! ocean model: outputs 
    241243      ! 

  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r10684 r10685  
    8787   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine) 
    8888   USE diaharm 
     89   USE diaharm_fast     ! harmonic analysis of tides (harm_ana routine)  
    8990   USE diacfl 
    9091   USE flo_oce          ! floats variables 
Note: See TracChangeset for help on using the changeset viewer.