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

Changeset 15520


Ignore:
Timestamp:
2021-11-18T16:35:38+01:00 (6 months ago)
Author:
sparonuz
Message:

fix name of variables mispelled in subprogram declaration. Removed file added for error.

Location:
NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src
Files:
1 deleted
4 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_coare3p0.F90

    r14790 r15520  
    9191   SUBROUTINE turb_coare3p0( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    9292      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                               & 
    93       &                      nb_iter, Cdn, Chn, Cen,                                     & ! optional output 
     93      &                      nb_iter, CdN, ChN, CeN,                                     & ! optional output 
    9494      &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer) 
    9595      &                      pdT_wl, pHz_wl )                                              ! optionals for warm-layer only 
  • NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_coare3p6.F90

    r14788 r15520  
    8181   SUBROUTINE turb_coare3p6( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    8282      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                               & 
    83       &                      nb_iter, Cdn, Chn, Cen,                                     & ! optional output 
     83      &                      nb_iter, CdN, ChN, CeN,                                     & ! optional output 
    8484      &                      Qsw, rad_lw, slp, pdT_cs,                                   & ! optionals for cool-skin (and warm-layer) 
    8585      &                      pdT_wl, pHz_wl )                                              ! optionals for warm-layer only 
  • NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r14788 r15520  
    8585   SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 
    8686      &                      Cd, Ch, Ce, t_zu, q_zu, Ubzu,                            & 
    87       &                      nb_iter, Cdn, Chn, Cen,                                           & ! optional output 
     87      &                      nb_iter, CdN, ChN, CeN,                                           & ! optional output 
    8888      &                      Qsw, rad_lw, slp, pdT_cs,                                & ! optionals for cool-skin (and warm-layer) 
    8989      &                      pdT_wl, pHz_wl )                                           ! optionals for warm-layer only 
  • NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/eosbn2.F90

    r15066 r15520  
    5656   !                  !! * Interface 
    5757   INTERFACE eos 
    58       MODULE PROCEDURE eos_insitu_wp, eos_insitu_pot_wp, eos_insitu_2d, eos_insitu_pot_2d 
    59       MODULE PROCEDURE eos_insitu_mixed, eos_insitu_pot_mixed 
     58      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 
    6059   END INTERFACE 
    6160   ! 
    6261   INTERFACE eos_rab 
    63       MODULE PROCEDURE rab_3d_wp, rab_2d, rab_0d 
    64       MODULE PROCEDURE rab_3d_mixed 
     62      MODULE PROCEDURE rab_3d, rab_2d, rab_0d 
    6563   END INTERFACE 
    6664   ! 
     
    192190CONTAINS 
    193191 
    194    SUBROUTINE eos_insitu_wp( pts, prd, pdep ) 
     192   SUBROUTINE eos_insitu( pts, prd, pdep ) 
    195193      !! 
    196194      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     
    199197      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
    200198      !! 
    201       CALL eos_insitu_t_wp( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 
    202    END SUBROUTINE eos_insitu_wp 
    203  
    204    SUBROUTINE eos_insitu_mixed( pts, prd, pdep ) 
    205       !! 
    206       REAL(dp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    207       !                                                      ! 2 : salinity               [psu] 
    208       REAL(sp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
    209       REAL(sp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
    210       !! 
    211       CALL eos_insitu_t_mixed( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 
    212    END SUBROUTINE  
    213  
    214    SUBROUTINE eos_insitu_t_wp( pts, ktts, prd, ktrd, pdep, ktdep ) 
     199      CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 
     200   END SUBROUTINE eos_insitu 
     201 
     202 
     203   SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 
    215204      !!---------------------------------------------------------------------- 
    216205      !!                   ***  ROUTINE  
     
    318307      IF( ln_timing )   CALL timing_stop('eos-insitu') 
    319308      ! 
    320    END SUBROUTINE eos_insitu_t_wp 
    321    SUBROUTINE eos_insitu_t_mixed( pts, ktts, prd, ktrd, pdep, ktdep ) 
    322       !!---------------------------------------------------------------------- 
    323       !!                   ***  ROUTINE eos_insitu  *** 
    324       !! 
    325       !! ** Purpose :   Compute the in situ density (ratio rho/rho0) from 
    326       !!       potential temperature and salinity using an equation of state 
    327       !!       selected in the nameos namelist 
    328       !! 
    329       !! ** Method  :   prd(t,s,z) = ( rho(t,s,z) - rho0 ) / rho0 
    330       !!         with   prd    in situ density anomaly      no units 
    331       !!                t      TEOS10: CT or EOS80: PT      Celsius 
    332       !!                s      TEOS10: SA or EOS80: SP      TEOS10: g/kg or EOS80: psu 
    333       !!                z      depth                        meters 
    334       !!                rho    in situ density              kg/m^3 
    335       !!                rho0   reference density            kg/m^3 
    336       !! 
    337       !!     ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 
    338       !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg 
    339       !! 
    340       !!     ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z). 
    341       !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu 
    342       !! 
    343       !!     ln_seos : simplified equation of state 
    344       !!              prd(t,s,z) = ( -a0*(1+lambda/2*(T-T0)+mu*z+nu*(S-S0))*(T-T0) + b0*(S-S0) ) / rho0 
    345       !!              linear case function of T only: rn_alpha<>0, other coefficients = 0 
    346       !!              linear eos function of T and S: rn_alpha and rn_beta<>0, other coefficients=0 
    347       !!              Vallis like equation: use default values of coefficients 
    348       !! 
    349       !! ** Action  :   compute prd , the in situ density (no units) 
    350       !! 
    351       !! References :   Roquet et al, Ocean Modelling, in preparation (2014) 
    352       !!                Vallis, Atmospheric and Oceanic Fluid Dynamics, 2006 
    353       !!                TEOS-10 Manual, 2010 
    354       !!---------------------------------------------------------------------- 
    355       INTEGER                                 , INTENT(in   ) ::   ktts, ktrd, ktdep 
    356       REAL(dp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    357       !                                                                  ! 2 : salinity               [psu] 
    358       REAL(sp), DIMENSION(A2D_T(ktrd) ,JPK     ), INTENT(  out) ::   prd   ! in situ density            [-] 
    359       REAL(sp), DIMENSION(A2D_T(ktdep),JPK     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
    360       ! 
    361       INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    362       REAL(sp) ::   zt , zh , zs , ztm        ! local scalars 
    363       REAL(sp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
    364       !!---------------------------------------------------------------------- 
    365       ! 
    366       IF( ln_timing )   CALL timing_start('eos-insitu') 
    367       ! 
    368       SELECT CASE( neos ) 
    369       ! 
    370       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    371          ! 
    372          DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    373             ! 
    374             zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    375             zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    376             zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    377             ztm = tmask(ji,jj,jk)                                         ! tmask 
    378             ! 
    379             zn3 = EOS013*zt   & 
    380                &   + EOS103*zs+EOS003 
    381                ! 
    382             zn2 = (EOS022*zt   & 
    383                &   + EOS112*zs+EOS012)*zt   & 
    384                &   + (EOS202*zs+EOS102)*zs+EOS002 
    385                ! 
    386             zn1 = (((EOS041*zt   & 
    387                &   + EOS131*zs+EOS031)*zt   & 
    388                &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    389                &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    390                &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    391                ! 
    392             zn0 = (((((EOS060*zt   & 
    393                &   + EOS150*zs+EOS050)*zt   & 
    394                &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    395                &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    396                &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    397                &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    398                &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    399                ! 
    400             zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    401             ! 
    402             prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm  ! density anomaly (masked) 
    403             ! 
    404          END_3D 
    405          ! 
    406       CASE( np_seos )                !==  simplified EOS  ==! 
    407          ! 
    408          DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    409             zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
    410             zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
    411             zh  = pdep (ji,jj,jk) 
    412             ztm = tmask(ji,jj,jk) 
    413             ! 
    414             zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt   & 
    415                &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs   & 
    416                &  - rn_nu * zt * zs 
    417                ! 
    418             prd(ji,jj,jk) = zn * r1_rho0 * ztm                ! density anomaly (masked) 
    419          END_3D 
    420          ! 
    421       END SELECT 
    422       ! 
    423       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=REAL(prd, wp), clinfo1=' eos-insitu  : ', kdim=jpk ) 
    424       ! 
    425       IF( ln_timing )   CALL timing_stop('eos-insitu') 
    426       ! 
    427    END SUBROUTINE eos_insitu_t_mixed 
    428  
    429  
    430    SUBROUTINE eos_insitu_pot_wp( pts, prd, prhop, pdep ) 
     309   END SUBROUTINE eos_insitu_t 
     310   
     311   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
    431312      !! 
    432313      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     
    436317      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep   ! depth                      [m] 
    437318      !! 
    438       CALL eos_insitu_pot_t_wp( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 
    439    END SUBROUTINE eos_insitu_pot_wp 
    440  
    441    SUBROUTINE eos_insitu_pot_mixed( pts, prd, prhop, pdep ) 
    442       !! 
    443       REAL(dp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    444       !                                                       ! 2 : salinity               [psu] 
    445       REAL(sp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd    ! in situ density            [-] 
    446       REAL(dp), DIMENSION(:,:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    447       REAL(sp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep   ! depth                      [m] 
    448       !! 
    449       CALL eos_insitu_pot_t_mixed( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 
    450    END SUBROUTINE eos_insitu_pot_mixed 
    451  
    452  
    453    SUBROUTINE eos_insitu_pot_t_wp( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 
     319      CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 
     320   END SUBROUTINE eos_insitu_pot 
     321 
     322   SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 
    454323      !!---------------------------------------------------------------------- 
    455324      !!                  ***  ROUTINE eos_insitu_pot  *** 
     
    605474      IF( ln_timing )   CALL timing_stop('eos-pot') 
    606475      ! 
    607    END SUBROUTINE eos_insitu_pot_t_wp 
    608  
    609    SUBROUTINE eos_insitu_pot_t_mixed( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 
    610       !!---------------------------------------------------------------------- 
    611       !!                  ***  ROUTINE eos_insitu_pot  *** 
    612       !! 
    613       !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
    614       !!      potential volumic mass (Kg/m3) from potential temperature and 
    615       !!      salinity fields using an equation of state selected in the 
    616       !!     namelist. 
    617       !! 
    618       !! ** Action  : - prd  , the in situ density (no units) 
    619       !!              - prhop, the potential volumic mass (Kg/m3) 
    620       !! 
    621       !!---------------------------------------------------------------------- 
    622       INTEGER                                  , INTENT(in   ) ::   ktts, ktrd, ktrhop, ktdep 
    623       REAL(dp), DIMENSION(A2D_T(ktts)  ,JPK,JPTS), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    624       !                                                                    ! 2 : salinity               [psu] 
    625       REAL(sp), DIMENSION(A2D_T(ktrd)  ,JPK     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    626       REAL(dp), DIMENSION(A2D_T(ktrhop),JPK     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    627       REAL(sp), DIMENSION(A2D_T(ktdep) ,JPK     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    628       ! 
    629       INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
    630       INTEGER  ::   jdof 
    631       REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
    632       REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
    633       REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
    634       !!---------------------------------------------------------------------- 
    635       ! 
    636       IF( ln_timing )   CALL timing_start('eos-pot') 
    637       ! 
    638       SELECT CASE ( neos ) 
    639       ! 
    640       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    641          ! 
    642          ! Stochastic equation of state 
    643          IF ( ln_sto_eos ) THEN 
    644             ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 
    645             ALLOCATE(zn_sto(1:2*nn_sto_eos)) 
    646             ALLOCATE(zsign(1:2*nn_sto_eos)) 
    647             DO jsmp = 1, 2*nn_sto_eos, 2 
    648               zsign(jsmp)   = 1._wp 
    649               zsign(jsmp+1) = -1._wp 
    650             END DO 
    651             ! 
    652             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    653                ! 
    654                ! compute density (2*nn_sto_eos) times: 
    655                ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 
    656                ! (2) for t-dt, s-ds (with the opposite fluctuation) 
    657                DO jsmp = 1, nn_sto_eos*2 
    658                   jdof   = (jsmp + 1) / 2 
    659                   zh     = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    660                   zt     = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0    ! temperature 
    661                   zstemp = pts  (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 
    662                   zs     = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 )   ! square root salinity 
    663                   ztm    = tmask(ji,jj,jk)                                         ! tmask 
    664                   ! 
    665                   zn3 = EOS013*zt   & 
    666                      &   + EOS103*zs+EOS003 
    667                      ! 
    668                   zn2 = (EOS022*zt   & 
    669                      &   + EOS112*zs+EOS012)*zt   & 
    670                      &   + (EOS202*zs+EOS102)*zs+EOS002 
    671                      ! 
    672                   zn1 = (((EOS041*zt   & 
    673                      &   + EOS131*zs+EOS031)*zt   & 
    674                      &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    675                      &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    676                      &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    677                      ! 
    678                   zn0_sto(jsmp) = (((((EOS060*zt   & 
    679                      &   + EOS150*zs+EOS050)*zt   & 
    680                      &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    681                      &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    682                      &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    683                      &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    684                      &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    685                      ! 
    686                   zn_sto(jsmp)  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 
    687                END DO 
    688                ! 
    689                ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 
    690                prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 
    691                DO jsmp = 1, nn_sto_eos*2 
    692                   prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp)                      ! potential density referenced at the surface 
    693                   ! 
    694                   prd(ji,jj,jk) = prd(ji,jj,jk) + (  zn_sto(jsmp) * r1_rho0 - 1._wp  )   ! density anomaly (masked) 
    695                END DO 
    696                prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 
    697                prd  (ji,jj,jk) = 0.5_wp * prd  (ji,jj,jk) * ztm / nn_sto_eos 
    698             END_3D 
    699             DEALLOCATE(zn0_sto,zn_sto,zsign) 
    700          ! Non-stochastic equation of state 
    701          ELSE 
    702             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    703                ! 
    704                zh  = pdep(ji,jj,jk) * r1_Z0                                  ! depth 
    705                zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    706                zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    707                ztm = tmask(ji,jj,jk)                                         ! tmask 
    708                ! 
    709                zn3 = EOS013*zt   & 
    710                   &   + EOS103*zs+EOS003 
    711                   ! 
    712                zn2 = (EOS022*zt   & 
    713                   &   + EOS112*zs+EOS012)*zt   & 
    714                   &   + (EOS202*zs+EOS102)*zs+EOS002 
    715                   ! 
    716                zn1 = (((EOS041*zt   & 
    717                   &   + EOS131*zs+EOS031)*zt   & 
    718                   &   + (EOS221*zs+EOS121)*zs+EOS021)*zt   & 
    719                   &   + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt   & 
    720                   &   + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 
    721                   ! 
    722                zn0 = (((((EOS060*zt   & 
    723                   &   + EOS150*zs+EOS050)*zt   & 
    724                   &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    725                   &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    726                   &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    727                   &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    728                   &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    729                   ! 
    730                zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    731                ! 
    732                prhop(ji,jj,jk) = zn0 * ztm                           ! potential density referenced at the surface 
    733                ! 
    734                prd(ji,jj,jk) = (  zn * r1_rho0 - 1._wp  ) * ztm      ! density anomaly (masked) 
    735             END_3D 
    736          ENDIF 
    737  
    738       CASE( np_seos )                !==  simplified EOS  ==! 
    739          ! 
    740          DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    741             zt  = pts  (ji,jj,jk,jp_tem) - 10._wp 
    742             zs  = pts  (ji,jj,jk,jp_sal) - 35._wp 
    743             zh  = pdep (ji,jj,jk) 
    744             ztm = tmask(ji,jj,jk) 
    745             !                                                     ! potential density referenced at the surface 
    746             zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
    747                &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
    748                &  - rn_nu * zt * zs 
    749             prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 
    750             !                                                     ! density anomaly (masked) 
    751             zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 
    752             prd(ji,jj,jk) = zn * r1_rho0 * ztm 
    753             ! 
    754          END_3D 
    755          ! 
    756       END SELECT 
    757       ! 
    758       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=REAL(prd, wp), clinfo1=' eos-pot: ', & 
    759          &                                  tab3d_2=REAL(prhop, wp), clinfo2=' pot : ', kdim=jpk ) 
    760       ! 
    761       IF( ln_timing )   CALL timing_stop('eos-pot') 
    762       ! 
    763    END SUBROUTINE eos_insitu_pot_t_mixed 
    764  
    765  
     476   END SUBROUTINE eos_insitu_pot_t 
     477 
     478   
    766479   SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
    767480      !! 
     
    947660 
    948661 
    949    SUBROUTINE rab_3d_wp( pts, pab, Kmm ) 
     662   SUBROUTINE rab_3d( pts, pab, Kmm ) 
    950663      !! 
    951664      INTEGER                     , INTENT(in   ) ::   Kmm   ! time level index 
     
    953666      REAL(wp), DIMENSION(:,:,:,:), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
    954667      !! 
    955       CALL rab_3d_t_wp( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 
    956    END SUBROUTINE rab_3d_wp 
    957  
    958    SUBROUTINE rab_3d_mixed( pts, pab, Kmm ) 
    959       !! 
    960       INTEGER                     , INTENT(in   ) ::   Kmm   ! time level index 
    961       REAL(dp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
    962       REAL(sp), DIMENSION(:,:,:,:), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
    963       !! 
    964       CALL rab_3d_t_mixed( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 
    965    END SUBROUTINE rab_3d_mixed 
    966  
    967  
    968    SUBROUTINE rab_3d_t_wp( pts, ktts, pab, ktab, Kmm ) 
     668      CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 
     669   END SUBROUTINE rab_3d 
     670 
     671   SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 
    969672      !!---------------------------------------------------------------------- 
    970673      !!                 ***  ROUTINE rab_3d  *** 
     
    1070773      IF( ln_timing )   CALL timing_stop('rab_3d') 
    1071774      ! 
    1072    END SUBROUTINE rab_3d_t_wp 
    1073  
    1074    SUBROUTINE rab_3d_t_mixed( pts, ktts, pab, ktab, Kmm ) 
    1075       !!---------------------------------------------------------------------- 
    1076       !!                 ***  ROUTINE rab_3d  *** 
    1077       !! 
    1078       !! ** Purpose :   Calculates thermal/haline expansion ratio at T-points 
    1079       !! 
    1080       !! ** Method  :   calculates alpha / beta at T-points 
    1081       !! 
    1082       !! ** Action  : - pab     : thermal/haline expansion ratio at T-points 
    1083       !!---------------------------------------------------------------------- 
    1084       INTEGER                                , INTENT(in   ) ::   Kmm   ! time level index 
    1085       INTEGER                                , INTENT(in   ) ::   ktts, ktab 
    1086       REAL(dp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
    1087       REAL(sp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
    1088       ! 
    1089       INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    1090       REAL(wp) ::   zt , zh , zs , ztm        ! local scalars 
    1091       REAL(wp) ::   zn , zn0, zn1, zn2, zn3   !   -      - 
    1092       !!---------------------------------------------------------------------- 
    1093       ! 
    1094       IF( ln_timing )   CALL timing_start('rab_3d') 
    1095       ! 
    1096       SELECT CASE ( neos ) 
    1097       ! 
    1098       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    1099          ! 
    1100          DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    1101             ! 
    1102             zh  = gdept(ji,jj,jk,Kmm) * r1_Z0                                ! depth 
    1103             zt  = pts (ji,jj,jk,jp_tem) * r1_T0                           ! temperature 
    1104             zs  = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    1105             ztm = tmask(ji,jj,jk)                                         ! tmask 
    1106             ! 
    1107             ! alpha 
    1108             zn3 = ALP003 
    1109             ! 
    1110             zn2 = ALP012*zt + ALP102*zs+ALP002 
    1111             ! 
    1112             zn1 = ((ALP031*zt   & 
    1113                &   + ALP121*zs+ALP021)*zt   & 
    1114                &   + (ALP211*zs+ALP111)*zs+ALP011)*zt   & 
    1115                &   + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 
    1116                ! 
    1117             zn0 = ((((ALP050*zt   & 
    1118                &   + ALP140*zs+ALP040)*zt   & 
    1119                &   + (ALP230*zs+ALP130)*zs+ALP030)*zt   & 
    1120                &   + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt   & 
    1121                &   + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt   & 
    1122                &   + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 
    1123                ! 
    1124             zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    1125             ! 
    1126             pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 
    1127             ! 
    1128             ! beta 
    1129             zn3 = BET003 
    1130             ! 
    1131             zn2 = BET012*zt + BET102*zs+BET002 
    1132             ! 
    1133             zn1 = ((BET031*zt   & 
    1134                &   + BET121*zs+BET021)*zt   & 
    1135                &   + (BET211*zs+BET111)*zs+BET011)*zt   & 
    1136                &   + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 
    1137                ! 
    1138             zn0 = ((((BET050*zt   & 
    1139                &   + BET140*zs+BET040)*zt   & 
    1140                &   + (BET230*zs+BET130)*zs+BET030)*zt   & 
    1141                &   + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt   & 
    1142                &   + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt   & 
    1143                &   + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 
    1144                ! 
    1145             zn  = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 
    1146             ! 
    1147             pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 
    1148             ! 
    1149          END_3D 
    1150          ! 
    1151       CASE( np_seos )                  !==  simplified EOS  ==! 
    1152          ! 
    1153          DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    1154             zt  = pts (ji,jj,jk,jp_tem) - 10._wp   ! pot. temperature anomaly (t-T0) 
    1155             zs  = pts (ji,jj,jk,jp_sal) - 35._wp   ! abs. salinity anomaly (s-S0) 
    1156             zh  = gdept(ji,jj,jk,Kmm)                ! depth in meters at t-point 
    1157             ztm = tmask(ji,jj,jk)                  ! land/sea bottom mask = surf. mask 
    1158             ! 
    1159             zn  = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 
    1160             pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm   ! alpha 
    1161             ! 
    1162             zn  = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 
    1163             pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm   ! beta 
    1164             ! 
    1165          END_3D 
    1166          ! 
    1167       CASE DEFAULT 
    1168          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    1169          CALL ctl_stop( 'rab_3d:', ctmp1 ) 
    1170          ! 
    1171       END SELECT 
    1172       ! 
    1173       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=REAL(pab(:,:,:,jp_tem), wp), clinfo1=' rab_3d_t: ', & 
    1174          &                                  tab3d_2=REAL(pab(:,:,:,jp_sal),  wp), clinfo2=' rab_3d_s : ', kdim=jpk ) 
    1175       ! 
    1176       IF( ln_timing )   CALL timing_stop('rab_3d') 
    1177       ! 
    1178    END SUBROUTINE rab_3d_t_mixed 
    1179  
     775   END SUBROUTINE rab_3d_t 
    1180776 
    1181777   SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 
Note: See TracChangeset for help on using the changeset viewer.