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 14002 for NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests – NEMO

Ignore:
Timestamp:
2020-12-02T15:08:53+01:00 (4 years ago)
Author:
emanuelaclementi
Message:

phasing with trunk rev14001 - ticket #2152 #2339

Location:
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
Files:
9 edited
2 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@13559        sette 
         10^/utils/CI/sette_MPI3_LoopFusion@13943         sette 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/domvvl.F90

    r13710 r14002  
    282282      ENDIF 
    283283      ! 
    284       IF(lwxios) THEN 
    285 ! define variables in restart file when writing with XIOS 
    286          CALL iom_set_rstw_var_active('e3t_b') 
    287          CALL iom_set_rstw_var_active('e3t_n') 
    288          !                                           ! ----------------------- ! 
    289          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    290             !                                        ! ----------------------- ! 
    291             CALL iom_set_rstw_var_active('tilde_e3t_b') 
    292             CALL iom_set_rstw_var_active('tilde_e3t_n') 
    293          END IF 
    294          !                                           ! -------------!     
    295          IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    296             !                                        ! ------------ ! 
    297             CALL iom_set_rstw_var_active('hdiv_lf') 
    298          ENDIF 
    299          ! 
    300       ENDIF 
    301       ! 
    302284   END SUBROUTINE dom_vvl_zgr 
    303285 
    … …  
    803785         IF( ln_rstart ) THEN                   !* Read the restart file 
    804786            CALL rst_read_open                  !  open the restart file if necessary 
    805             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     787            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    806788            ! 
    807789            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    816798            ! 
    817799            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    818                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    819                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     800               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
     801               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    820802               ! needed to restart if land processor not computed  
    821803               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    831813               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    832814               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    833                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     815               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    834816               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    835817               l_1st_euler = .true. 
    … …  
    838820               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    839821               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    840                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     822               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    841823               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    842824               l_1st_euler = .true. 
    … …  
    863845               !                          ! ----------------------- ! 
    864846               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    865                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    866                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     847                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     848                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
    867849               ELSE                            ! one at least array is missing 
    868850                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    873855                  !                       ! ------------ ! 
    874856                  IF( id5 > 0 ) THEN  ! required array exists 
    875                      CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     857                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    876858                  ELSE                ! array is missing 
    877859                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    947929         !                                   ! =================== 
    948930         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
    949          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    950931         !                                           ! --------- ! 
    951932         !                                           ! all cases ! 
    952933         !                                           ! --------- ! 
    953          CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 
    954          CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 
     934         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 
     935         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 
    955936         !                                           ! ----------------------- ! 
    956937         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    957938            !                                        ! ----------------------- ! 
    958             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 
    959             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
     939            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 
     940            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 
    960941         END IF 
    961942         !                                           ! -------------!     
    962943         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    963944            !                                        ! ------------ ! 
    964             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 
     945            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 
    965946         ENDIF 
    966947         ! 
    967          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    968948      ENDIF 
    969949      ! 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/CANAL/MY_SRC/trazdf.F90

    r13710 r14002  
    5454      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts                 ! active tracers and RHS of tracer equation 
    5555      ! 
    56       INTEGER  ::   jk   ! Dummy loop indices 
     56      INTEGER  ::   ji, jj, jk   ! Dummy loop indices 
    5757      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace 
    5858      !!--------------------------------------------------------------------- 
    … …  
    6161      ! 
    6262      IF( kt == nit000 )  THEN 
    63          IF(lwp)WRITE(numout,*) 
    64          IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 
    65          IF(lwp)WRITE(numout,*) '~~~~~~~ ' 
     63         IF( ntile == 0 .OR. ntile == 1 )  THEN                   ! Do only on the first tile 
     64            IF(lwp)WRITE(numout,*) 
     65            IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 
     66            IF(lwp)WRITE(numout,*) '~~~~~~~ ' 
     67         ENDIF 
    6668      ENDIF 
    6769      ! 
    … …  
    8385 
    8486      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    85          DO jk = 1, jpkm1 
    86             ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) & 
    87                &          / (e3t(:,:,jk,Kmm)*rDt) ) - ztrdt(:,:,jk) 
    88             ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) & 
    89               &           / (e3t(:,:,jk,Kmm)*rDt) ) - ztrds(:,:,jk) 
     87         DO jk = 1, jpk 
     88            ztrdt(:,:,jk) = (   (  pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa)     & 
     89               &                 - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb)  )  & 
     90               &              / (  e3t(:,:,jk,Kmm)*rDt  )   )                 & 
     91               &          - ztrdt(:,:,jk) 
     92            ztrds(:,:,jk) = (   (  pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa)     & 
     93               &                 - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb)  )  & 
     94               &             / (   e3t(:,:,jk,Kmm)*rDt  )   )                 & 
     95               &          - ztrds(:,:,jk) 
    9096         END DO 
    9197!!gm this should be moved in trdtra.F90 and done on all trends 
    … …  
    135141      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    136142      REAL(wp) ::  zrhs, zzwi, zzws ! local scalars 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwi, zwt, zwd, zws 
     143      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::  zwi, zwt, zwd, zws 
    138144      !!--------------------------------------------------------------------- 
    139145      ! 
    … …  
    149155            ! 
    150156            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 
    151             IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt(:,:,2:jpk) 
    152             ELSE                                            ;   zwt(:,:,2:jpk) = avs(:,:,2:jpk) 
     157            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 
     158               DO_3D( 1, 1, 1, 1, 2, jpk ) 
     159                  zwt(ji,jj,jk) = avt(ji,jj,jk) 
     160               END_3D 
     161            ELSE 
     162               DO_3D( 1, 1, 1, 1, 2, jpk ) 
     163                  zwt(ji,jj,jk) = avs(ji,jj,jk) 
     164               END_3D 
    153165            ENDIF 
    154166            zwt(:,:,1) = 0._wp 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90

    r13710 r14002  
    1818   USE sbc_ice         ! Surface boundary condition: ice fields 
    1919   USE phycst          ! physical constants 
    20    USE ice, ONLY       : at_i_b, a_i_b 
     20   USE ice, ONLY       : jpl, at_i_b, a_i_b 
    2121   USE icethd_dh       ! for CALL ice_thd_snwblow 
    2222   ! 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/dtatsd.F90

    r13710 r14002  
    1818   USE phycst          ! physical constants 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE domain, ONLY : dom_tile 
    2021   USE fldread         ! read input fields 
    2122   ! 
    … …  
    163164      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step 
    164165      CHARACTER(LEN=3)                     , INTENT(in   ) ::   cddta  ! dmp or ini 
    165       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
     166      REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
    166167      ! 
    167168      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    168169      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
     170      INTEGER ::   itile 
    169171      REAL(wp)::   zl, zi                             ! local scalars 
    170172      REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace 
    171173      !!---------------------------------------------------------------------- 
    172174      ! 
     175      IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
     176         itile = ntile 
     177         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     178 
     179         SELECT CASE(cddta) 
     180         CASE('ini') 
     181            CALL fld_read( kt, 1, sf_tsdini ) !==   read T & S data at kt time step   ==! 
     182         CASE('dmp') 
     183            CALL fld_read( kt, 1, sf_tsddmp ) !==   read T & S data at kt time step   ==! 
     184         CASE DEFAULT 
     185            CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') 
     186         END SELECT 
     187 
     188         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain 
     189      ENDIF 
     190      ! 
    173191      SELECT CASE(cddta) 
    174       CASE('ini')  
    175          CALL fld_read( kt, 1, sf_tsdini ) !==   read T & S data at kt time step   ==! 
    176          ptsd(:,:,:,jp_tem) = sf_tsdini(jp_tem)%fnow(:,:,:)    ! NO mask 
    177          ptsd(:,:,:,jp_sal) = sf_tsdini(jp_sal)%fnow(:,:,:)  
     192      CASE('ini') 
     193         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     194            ptsd(ji,jj,jk,jp_tem) = sf_tsdini(jp_tem)%fnow(ji,jj,jk)    ! NO mask 
     195            ptsd(ji,jj,jk,jp_sal) = sf_tsdini(jp_sal)%fnow(ji,jj,jk) 
     196         END_3D 
    178197      CASE('dmp') 
    179          CALL fld_read( kt, 1, sf_tsddmp ) !==   read T & S data at kt time step   ==! 
    180          ptsd(:,:,:,jp_tem) = sf_tsddmp(jp_tem)%fnow(:,:,:)    ! NO mask 
    181          ptsd(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:)  
     198         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     199            ptsd(ji,jj,jk,jp_tem) = sf_tsddmp(jp_tem)%fnow(ji,jj,jk)    ! NO mask 
     200            ptsd(ji,jj,jk,jp_sal) = sf_tsddmp(jp_sal)%fnow(ji,jj,jk) 
     201         END_3D 
    182202      CASE DEFAULT 
    183203         CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') 
    … …  
    186206      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    187207         ! 
    188          IF( kt == nit000 .AND. lwp )THEN 
    189             WRITE(numout,*) 
    190             WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
     208         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     209            IF( kt == nit000 .AND. lwp )THEN 
     210               WRITE(numout,*) 
     211               WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
     212            ENDIF 
    191213         ENDIF 
    192214         ! 
    … …  
    220242      ELSE                                !==   z- or zps- coordinate   ==! 
    221243         !                              
    222          ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask 
    223          ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 
     244         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     245            ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)    ! Mask 
     246            ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     247         END_3D 
    224248         ! 
    225249         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/eosbn2.F90

    r13710 r14002  
    3939   !!---------------------------------------------------------------------- 
    4040   USE dom_oce        ! ocean space and time domain 
     41   USE domutl, ONLY : is_tile 
    4142   USE phycst         ! physical constants 
    4243   USE stopar         ! Stochastic T/S fluctuations 
    … …  
    191192 
    192193   SUBROUTINE eos_insitu( pts, prd, pdep ) 
     194      !! 
     195      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     196      !                                                      ! 2 : salinity               [psu] 
     197      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
     198      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
     199      !! 
     200      CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 
     201   END SUBROUTINE eos_insitu 
     202 
     203   SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 
    193204      !!---------------------------------------------------------------------- 
    194205      !!                   ***  ROUTINE eos_insitu  *** 
    … …  
    228239      !!                TEOS-10 Manual, 2010 
    229240      !!---------------------------------------------------------------------- 
    230       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     241      INTEGER                                 , INTENT(in   ) ::   ktts, ktrd, ktdep 
     242      REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    231243      !                                                               ! 2 : salinity               [psu] 
    232       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
    233       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     244      REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK     ), INTENT(  out) ::   prd   ! in situ density            [-] 
     245      REAL(wp), DIMENSION(A2D_T(ktdep),JPK     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
    234246      ! 
    235247      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    … …  
    312324      IF( ln_timing )   CALL timing_stop('eos-insitu') 
    313325      ! 
    314    END SUBROUTINE eos_insitu 
     326   END SUBROUTINE eos_insitu_t 
    315327 
    316328 
    317329   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
     330      !! 
     331      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     332      !                                                       ! 2 : salinity               [psu] 
     333      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd    ! in situ density            [-] 
     334      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     335      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep   ! depth                      [m] 
     336      !! 
     337      CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 
     338   END SUBROUTINE eos_insitu_pot 
     339 
     340 
     341   SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 
    318342      !!---------------------------------------------------------------------- 
    319343      !!                  ***  ROUTINE eos_insitu_pot  *** 
    … …  
    328352      !! 
    329353      !!---------------------------------------------------------------------- 
    330       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     354      INTEGER                                  , INTENT(in   ) ::   ktts, ktrd, ktrhop, ktdep 
     355      REAL(wp), DIMENSION(A2D_T(ktts)  ,JPK,JPTS), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    331356      !                                                                ! 2 : salinity               [psu] 
    332       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    333       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    334       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
     357      REAL(wp), DIMENSION(A2D_T(ktrd)  ,JPK     ), INTENT(  out) ::   prd    ! in situ density            [-] 
     358      REAL(wp), DIMENSION(A2D_T(ktrhop),JPK     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     359      REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    335360      ! 
    336361      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
    … …  
    482507      IF( ln_timing )   CALL timing_stop('eos-pot') 
    483508      ! 
    484    END SUBROUTINE eos_insitu_pot 
     509   END SUBROUTINE eos_insitu_pot_t 
    485510 
    486511 
    487512   SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
     513      !! 
     514      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     515      !                                                    ! 2 : salinity               [psu] 
     516      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
     517      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   prd   ! in situ density 
     518      !! 
     519      CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 
     520   END SUBROUTINE eos_insitu_2d 
     521 
     522 
     523   SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 
    488524      !!---------------------------------------------------------------------- 
    489525      !!                  ***  ROUTINE eos_insitu_2d  *** 
    … …  
    496532      !! 
    497533      !!---------------------------------------------------------------------- 
    498       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     534      INTEGER                            , INTENT(in   ) ::   ktts, ktdep, ktrd 
     535      REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    499536      !                                                           ! 2 : salinity               [psu] 
    500       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    501       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
     537      REAL(wp), DIMENSION(A2D_T(ktdep)    ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     538      REAL(wp), DIMENSION(A2D_T(ktrd)     ), INTENT(  out) ::   prd   ! in situ density 
    502539      ! 
    503540      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    … …  
    584621      IF( ln_timing )   CALL timing_stop('eos2d') 
    585622      ! 
    586    END SUBROUTINE eos_insitu_2d 
     623   END SUBROUTINE eos_insitu_2d_t 
    587624 
    588625 
    589626   SUBROUTINE rab_3d( pts, pab, Kmm ) 
     627      !! 
     628      INTEGER                     , INTENT(in   ) ::   Kmm   ! time level index 
     629      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     630      REAL(wp), DIMENSION(:,:,:,:), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     631      !! 
     632      CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 
     633   END SUBROUTINE rab_3d 
     634 
     635 
     636   SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 
    590637      !!---------------------------------------------------------------------- 
    591638      !!                 ***  ROUTINE rab_3d  *** 
    … …  
    598645      !!---------------------------------------------------------------------- 
    599646      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
    600       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
    601       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     647      INTEGER                                , INTENT(in   ) ::   ktts, ktab 
     648      REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     649      REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
    602650      ! 
    603651      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    … …  
    706754      IF( ln_timing )   CALL timing_stop('rab_3d') 
    707755      ! 
    708    END SUBROUTINE rab_3d 
     756   END SUBROUTINE rab_3d_t 
    709757 
    710758 
    711759   SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 
     760      !! 
     761      INTEGER                   , INTENT(in   ) ::   Kmm   ! time level index 
     762      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     763      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pdep   ! depth                  [m] 
     764      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     765      !! 
     766      CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 
     767   END SUBROUTINE rab_2d 
     768 
     769 
     770   SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 
    712771      !!---------------------------------------------------------------------- 
    713772      !!                 ***  ROUTINE rab_2d  *** 
    … …  
    718777      !!---------------------------------------------------------------------- 
    719778      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
    720       REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
    721       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m] 
    722       REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     779      INTEGER                            , INTENT(in   ) ::   ktts, ktdep, ktab 
     780      REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     781      REAL(wp), DIMENSION(A2D_T(ktdep)    ), INTENT(in   ) ::   pdep   ! depth                  [m] 
     782      REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
    723783      ! 
    724784      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    … …  
    829889      IF( ln_timing )   CALL timing_stop('rab_2d') 
    830890      ! 
    831    END SUBROUTINE rab_2d 
     891   END SUBROUTINE rab_2d_t 
    832892 
    833893 
    … …  
    9421002 
    9431003   SUBROUTINE bn2( pts, pab, pn2, Kmm ) 
     1004      !! 
     1005      INTEGER                              , INTENT(in   ) ::  Kmm   ! time level index 
     1006      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
     1007      REAL(wp), DIMENSION(:,:,:,:)         , INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
     1008      REAL(wp), DIMENSION(:,:,:)           , INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     1009      !! 
     1010      CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 
     1011   END SUBROUTINE bn2 
     1012 
     1013 
     1014   SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 
    9441015      !!---------------------------------------------------------------------- 
    9451016      !!                  ***  ROUTINE bn2  *** 
    … …  
    9561027      !!---------------------------------------------------------------------- 
    9571028      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
     1029      INTEGER                                , INTENT(in   ) ::  ktab, ktn2 
    9581030      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
    959       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
    960       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     1031      REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
     1032      REAL(wp), DIMENSION(A2D_T(ktn2),JPK     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
    9611033      ! 
    9621034      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    … …  
    9821054      IF( ln_timing )   CALL timing_stop('bn2') 
    9831055      ! 
    984    END SUBROUTINE bn2 
     1056   END SUBROUTINE bn2_t 
    9851057 
    9861058 
    … …  
    10431115 
    10441116   SUBROUTINE  eos_fzp_2d( psal, ptf, pdep ) 
     1117      !! 
     1118      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
     1119      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
     1120      REAL(wp), DIMENSION(:,:)    , INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
     1121      !! 
     1122      CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 
     1123   END SUBROUTINE eos_fzp_2d 
     1124 
     1125 
     1126   SUBROUTINE  eos_fzp_2d_t( psal, ptf, kttf, pdep ) 
    10451127      !!---------------------------------------------------------------------- 
    10461128      !!                 ***  ROUTINE eos_fzp  *** 
    … …  
    10541136      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
    10551137      !!---------------------------------------------------------------------- 
     1138      INTEGER                       , INTENT(in   )           ::   kttf 
    10561139      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
    10571140      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
    1058       REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
     1141      REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
    10591142      ! 
    10601143      INTEGER  ::   ji, jj          ! dummy loop indices 
    … …  
    10891172      END SELECT       
    10901173      ! 
    1091   END SUBROUTINE eos_fzp_2d 
     1174  END SUBROUTINE eos_fzp_2d_t 
    10921175 
    10931176 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/ISOMIP+/MY_SRC/tradmp.F90

    r13710 r14002  
    9595      ! 
    9696      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    97       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta 
     97      REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts)     ::  zts_dta 
    9898      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
    9999      !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/VORTEX/MY_SRC/domvvl.F90

    r13710 r14002  
    282282      ENDIF 
    283283      ! 
    284       IF(lwxios) THEN 
    285 ! define variables in restart file when writing with XIOS 
    286          CALL iom_set_rstw_var_active('e3t_b') 
    287          CALL iom_set_rstw_var_active('e3t_n') 
    288          !                                           ! ----------------------- ! 
    289          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    290             !                                        ! ----------------------- ! 
    291             CALL iom_set_rstw_var_active('tilde_e3t_b') 
    292             CALL iom_set_rstw_var_active('tilde_e3t_n') 
    293          END IF 
    294          !                                           ! -------------!     
    295          IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    296             !                                        ! ------------ ! 
    297             CALL iom_set_rstw_var_active('hdiv_lf') 
    298          ENDIF 
    299          ! 
    300       ENDIF 
    301       ! 
    302284   END SUBROUTINE dom_vvl_zgr 
    303285 
    … …  
    803785         IF( ln_rstart ) THEN                   !* Read the restart file 
    804786            CALL rst_read_open                  !  open the restart file if necessary 
    805             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     787            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    806788            ! 
    807789            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    816798            ! 
    817799            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    818                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    819                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     800               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
     801               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    820802               ! needed to restart if land processor not computed  
    821803               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    831813               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    832814               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    833                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     815               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    834816               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    835817               l_1st_euler = .true. 
    … …  
    838820               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    839821               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    840                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     822               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    841823               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    842824               l_1st_euler = .true. 
    … …  
    863845               !                          ! ----------------------- ! 
    864846               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    865                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    866                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     847                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     848                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
    867849               ELSE                            ! one at least array is missing 
    868850                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    873855                  !                       ! ------------ ! 
    874856                  IF( id5 > 0 ) THEN  ! required array exists 
    875                      CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     857                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    876858                  ELSE                ! array is missing 
    877859                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    947929         !                                   ! =================== 
    948930         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
    949          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    950931         !                                           ! --------- ! 
    951932         !                                           ! all cases ! 
    952933         !                                           ! --------- ! 
    953          CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 
    954          CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 
     934         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 
     935         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 
    955936         !                                           ! ----------------------- ! 
    956937         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    957938            !                                        ! ----------------------- ! 
    958             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 
    959             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
     939            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 
     940            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 
    960941         END IF 
    961942         !                                           ! -------------!     
    962943         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    963944            !                                        ! ------------ ! 
    964             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 
     945            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 
    965946         ENDIF 
    966947         ! 
    967          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    968948      ENDIF 
    969949      ! 

  • NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/tests/demo_cfgs.txt

    r13710 r14002  
    1212STATION_ASF OCE 
    1313CPL_OASIS  OCE TOP ICE NST 
     14ICE_RHEO OCE SAS ICE 
Note: See TracChangeset for help on using the changeset viewer.