Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
No results found
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 396 additions and 89 deletions
src/OCE/CRS/crsdomwri.F90
View file @ 672ff863
......@@ -201,5 +201,3 @@ CONTAINS
!!======================================================================
END MODULE crsdomwri
src/OCE/CRS/crsfld.F90
View file @ 672ff863
......@@ -32,6 +32,7 @@ MODULE crsfld
!! * Substitutions
# include "do_loop_substitute.h90"
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -116,30 +117,30 @@ CONTAINS
CALL iom_put( "sss" , tsn_crs(:,:,1,jp_sal) ) ! sss
! U-velocity
CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
CALL crs_dom_ope( CASTSP(uu(:,:,:,Kmm)), 'SUM', 'U', umask, un_crs, p_e12=CASTDP(e2u), p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
!
zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zt(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
zs(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
END_3D
CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=CASTDP(e2u), p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=CASTDP(e2u), p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0_wp )
CALL iom_put( "uoce" , un_crs ) ! i-current
CALL iom_put( "uocet" , zt_crs ) ! uT
CALL iom_put( "uoces" , zs_crs ) ! uS
! V-velocity
CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
CALL crs_dom_ope( CASTSP(vv(:,:,:,Kmm)), 'SUM', 'V', vmask, vn_crs, p_e12=CASTDP(e1v), p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
!
zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
zt(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
zs(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
END_3D
CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=CASTDP(e1v), p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=CASTDP(e1v), p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0_wp )
CALL iom_put( "voce" , vn_crs ) ! i-current
CALL iom_put( "vocet" , zt_crs ) ! vT
......@@ -210,9 +211,9 @@ CONTAINS
CALL iom_put( "avs", avs_crs ) ! Kz on S
! sbc fields
CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp )
CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0_wp )
CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0_wp )
CALL crs_dom_ope( CASTSP(ssh(:,:,Kmm)) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0_wp )
CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=CASTDP(e2u) , p_surf_crs=e2u_crs , psgn=1.0_wp )
CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=CASTDP(e1v) , p_surf_crs=e1v_crs , psgn=1.0_wp )
CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
CALL crs_dom_ope( rnf , 'MAX', 'T', tmask, rnf_crs , psgn=1.0_wp )
CALL crs_dom_ope( qsr , 'SUM', 'T', tmask, qsr_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0_wp )
......
src/OCE/CRS/crsini.F90
View file @ 672ff863
......@@ -28,6 +28,7 @@ MODULE crsini
PUBLIC crs_init ! called by nemogcm.F90 module
!! * Substitutions
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -153,8 +154,8 @@ CONTAINS
! 3.c.1 Horizontal scale factors
CALL crs_dom_hgr( e1t, e2t, 'T', e1t_crs, e2t_crs )
CALL crs_dom_hgr( e1u, e2u, 'U', e1u_crs, e2u_crs )
CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs )
CALL crs_dom_hgr( e1u, CASTDP(e2u), 'U', e1u_crs, e2u_crs )
CALL crs_dom_hgr( CASTDP(e1v), e2v, 'V', e1v_crs, e2v_crs )
CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
......@@ -183,7 +184,7 @@ CONTAINS
END DO
! 3.d.2 Surfaces
CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t )
CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=CASTSP(e1t), p_e2=CASTSP(e2t) )
CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=ze3u )
CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=ze3v )
......@@ -193,8 +194,8 @@ CONTAINS
! 3.d.3 Vertical scale factors
!
CALL crs_dom_e3( e1t, e2t, ze3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
CALL crs_dom_e3( e1u, e2u, ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
CALL crs_dom_e3( e1v, e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
CALL crs_dom_e3( e1u, CASTDP(e2u), ze3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
CALL crs_dom_e3( CASTDP(e1v), e2v, ze3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
CALL crs_dom_e3( e1t, e2t, ze3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
! Replace 0 by e3t_0 or e3w_0
......
src/OCE/DIA/dia25h.F90
View file @ 672ff863
......@@ -140,7 +140,7 @@ CONTAINS
INTEGER :: ji, jj, jk
INTEGER :: iyear0, nimonth0,iday0 ! start year,imonth,day
LOGICAL :: ll_print = .FALSE. ! =T print and flush numout
REAL(wp) :: zsto, zout, zmax, zjulian, zmdi ! local scalars
REAL(dp) :: zsto, zout, zmax, zjulian, zmdi ! local scalars
INTEGER :: i_steps ! no of timesteps per hour
REAL(wp), DIMENSION(A2D(0) ) :: zw2d, un_dm, vn_dm ! workspace
REAL(wp), DIMENSION(A2D(0),jpk) :: zw3d ! workspace
......
src/OCE/DIA/diaar5.F90
View file @ 672ff863
......@@ -38,6 +38,7 @@ MODULE diaar5
!! * Substitutions
# include "do_loop_substitute.h90"
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -86,7 +87,7 @@ CONTAINS
IF( l_ar5 ) THEN
ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) )
ALLOCATE( zrhd(jpi,jpj,jpk) )
ALLOCATE( zrhd(jpi,jpj,jpk), z3d(jpi,jpj,jpk) )
ALLOCATE( ztsn(jpi,jpj,jpk,jpts) )
zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm)
ENDIF
......@@ -117,7 +118,7 @@ CONTAINS
!
IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN
! ! total volume of liquid seawater
zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) )
zvolssh =glob_sum( 'diaar5', CASTDP(zarea_ssh(:,:)) )
zvol = vol0 + zvolssh
CALL iom_put( 'voltot', zvol )
......@@ -134,7 +135,7 @@ CONTAINS
DO jk = 1, jpk
zgdept(:,:,jk) = gdept(:,:,jk,Kmm)
END DO
CALL eos( ztsn, zrhd, zgdept) ! now in situ density using initial salinity
CALL eos( CASTDP(ztsn), zrhd, zgdept) ! now in situ density using initial salinity
!
zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice
DO jk = 1, jpkm1
......@@ -212,8 +213,8 @@ CONTAINS
END IF
ENDIF
!
ztemp = glob_sum( 'diaar5', ztsn(:,:,1,jp_tem) )
zsal = glob_sum( 'diaar5', ztsn(:,:,1,jp_sal) )
ztemp =glob_sum( 'diaar5', CASTDP(ztsn(:,:,1,jp_tem)) )
zsal =glob_sum( 'diaar5', CASTDP(ztsn(:,:,1,jp_sal)) )
zmass = rho0 * ( zarho + zvol )
!
CALL iom_put( 'masstot', zmass )
......@@ -229,7 +230,7 @@ CONTAINS
ALLOCATE( ztpot(jpi,jpj,jpk) )
ztpot(:,:,jpk) = 0._wp
DO jk = 1, jpkm1
ztpot(:,:,jk) = eos_pt_from_ct( ts(:,:,jk,jp_tem,Kmm), ts(:,:,jk,jp_sal,Kmm) )
ztpot(:,:,jk) =eos_pt_from_ct( CASTSP(ts(:,:,jk,jp_tem,Kmm)), CASTSP(ts(:,:,jk,jp_sal,Kmm)) )
END DO
!
CALL iom_put( 'toce_pot', ztpot(:,:,:) ) ! potential temperature (TEOS-10 case)
......@@ -240,7 +241,7 @@ CONTAINS
DO jk = 1, jpkm1
z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk)
END DO
ztemp = glob_sum( 'diaar5', z2d(:,:) )
ztemp =glob_sum( 'diaar5', CASTDP(z2d(:,:)) )
CALL iom_put( 'temptot_pot', ztemp / zvol )
ENDIF
!
......@@ -294,8 +295,9 @@ CONTAINS
ENDIF
IF( l_ar5 ) THEN
DEALLOCATE( zarea_ssh , zbotpres, z2d )
DEALLOCATE( ztsn )
DEALLOCATE( zarea_ssh, zbotpres, z2d )
DEALLOCATE( z3d )
DEALLOCATE( ztsn )
ENDIF
!
IF( ln_timing ) CALL timing_stop('dia_ar5')
......@@ -319,7 +321,7 @@ CONTAINS
REAL(wp), DIMENSION(A2D(nn_hls)) :: z2d
!!----------------------------------------------------------------------
z2d(:,:) = puflx(:,:,1)
z2d(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)
END_3D
......@@ -388,7 +390,7 @@ CONTAINS
zvol0 (ji,jj) = zvol0 (ji,jj) + zztmp * e1e2t(ji,jj)
thick0(ji,jj) = thick0(ji,jj) + zztmp
END_3D
vol0 = glob_sum( 'diaar5', zvol0 )
vol0 =glob_sum( 'diaar5', CASTDP(zvol0) )
DEALLOCATE( zvol0 )
IF( iom_use( 'sshthster' ) ) THEN
......
src/OCE/DIA/diacfl.F90
View file @ 672ff863
......@@ -33,6 +33,7 @@ MODULE diacfl
!! * Substitutions
# include "do_loop_substitute.h90"
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -87,11 +88,11 @@ CONTAINS
! ! calculate maximum values and locations
llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
CALL mpp_maxloc( 'diacfl', zCu_cfl, llmsk, zCu_max, iloc_u )
CALL mpp_maxloc( 'diacfl', CASTDP(zCu_cfl), llmsk, zCu_max, iloc_u )
llmsk(Nis0:Nie0,Njs0:Nje0,:) = vmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
CALL mpp_maxloc( 'diacfl', zCv_cfl, llmsk, zCv_max, iloc_v )
CALL mpp_maxloc( 'diacfl', CASTDP(zCv_cfl), llmsk, zCv_max, iloc_v )
llmsk(Nis0:Nie0,Njs0:Nje0,:) = wmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
CALL mpp_maxloc( 'diacfl', zCw_cfl, llmsk, zCw_max, iloc_w )
CALL mpp_maxloc( 'diacfl', CASTDP(zCw_cfl), llmsk, zCw_max, iloc_w )
!
IF( lwp ) THEN ! write out to file
WRITE(numcfl,FMT='(2x,i6,3x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3)
......
src/OCE/DIA/diadct.F90
View file @ 672ff863
......@@ -26,6 +26,7 @@ MODULE diadct
USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
USE in_out_manager ! I/O manager
USE iom
USE daymod ! calendar
USE dianam ! build name of file
USE lib_mpp ! distributed memory computing library
......@@ -42,9 +43,7 @@ MODULE diadct
PUBLIC dia_dct_init ! routine called by nemogcm.F90
! !!** namelist variables **
LOGICAL, PUBLIC :: ln_diadct !: Calculate transport thru a section or not
INTEGER :: nn_dct ! Frequency of computation
INTEGER :: nn_dctwri ! Frequency of output
INTEGER :: nn_secdebug ! Number of the section to debug
INTEGER, PARAMETER :: nb_class_max = 10
......@@ -53,7 +52,6 @@ MODULE diadct
INTEGER, PARAMETER :: nb_type_class = 10
INTEGER, PARAMETER :: nb_3d_vars = 3
INTEGER, PARAMETER :: nb_2d_vars = 2
INTEGER :: nb_sec
TYPE POINT_SECTION
INTEGER :: I,J
......@@ -87,9 +85,15 @@ MODULE diadct
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: transports_3d
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d
#if defined key_xios
REAL(wp), ALLOCATABLE, DIMENSION(:) :: heat_transport
REAL(wp), ALLOCATABLE, DIMENSION(:) :: salt_transport
REAL(wp), ALLOCATABLE, DIMENSION(:) :: vol_transport
#endif
!! * Substitutions
# include "single_precision_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
......@@ -159,13 +163,14 @@ CONTAINS
!Read section_ijglobal.diadct
CALL readsec
#if ! defined key_xios
!open output file
IF( lwm ) THEN
CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
CALL ctl_opn( numdct_heat, 'heat_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
CALL ctl_opn( numdct_salt, 'salt_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
ENDIF
#endif
! Initialise arrays to zero
transports_3d(:,:,:,:)=0.0
transports_2d(:,:,:) =0.0
......@@ -251,7 +256,10 @@ CONTAINS
ENDDO
!Sum on all procs
IF( lk_mpp )THEN
! IF( lk_mpp )THEN
! removed by AV do not know the significance of this test, following test taken from diaprt
#if ! defined key_mpi_off
IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
ish(1) = nb_sec_max*nb_type_class*nb_class_max
ish2 = (/nb_sec_max,nb_type_class,nb_class_max/)
DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport(:,:) ; ENDDO
......@@ -260,11 +268,21 @@ CONTAINS
zsum(:,:,:)= RESHAPE(zwork,ish2)
DO jsec=1,nb_sec ; secs(jsec)%transport(:,:) = zsum(jsec,:,:) ; ENDDO
ENDIF
#endif
!Write the transport
#if defined key_xios
! IF( lwm ) sec_transport(:) = 0
ALLOCATE(heat_transport(nb_sec),salt_transport(nb_sec),vol_transport(nb_sec))
#endif
DO jsec=1,nb_sec
#if defined key_xios
! xios waits for a send from all procs
CALL dia_dct_wri(kt,jsec,secs(jsec))
#else
IF( lwm )CALL dia_dct_wri(kt,jsec,secs(jsec))
#endif
!nullify transports values after writing
transports_3d(:,jsec,:,:)=0.
......@@ -272,6 +290,14 @@ CONTAINS
secs(jsec)%transport(:,:)=0.
ENDDO
#if defined key_xios
IF ( .NOT. l_istiled .OR. ntile == nijtile ) THEN
CALL iom_put('mfo' , vol_transport )
CALL iom_put('sfo' , salt_transport )
CALL iom_put('hfo' , heat_transport )
ENDIF
DEALLOCATE(heat_transport, salt_transport, vol_transport)
#endif
ENDIF
......@@ -678,13 +704,13 @@ CONTAINS
ztn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )
zsn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )
zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)
zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rho0+rho0)
zrhoi =interp(Kmm,k%I,k%J,jk,'V',CASTDP(rhd*rho0+rho0))
zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I,k%J+1,Kmm) ) * vmask(k%I,k%J,1)
CASE(2,3)
ztn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )
zsn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )
zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)
zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rho0+rho0)
zrhoi =interp(Kmm,k%I,k%J,jk,'U',CASTDP(rhd*rho0+rho0))
zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm) ) * umask(k%I,k%J,1)
END SELECT
!
......@@ -851,13 +877,13 @@ CONTAINS
ztn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )
zsn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )
zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)
zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rho0+rho0)
zrhoi =interp(Kmm,k%I,k%J,jk,'V',CASTDP(rhd*rho0+rho0))
CASE(2,3)
ztn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )
zsn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )
zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)
zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rho0+rho0)
zrhoi =interp(Kmm,k%I,k%J,jk,'U',CASTDP(rhd*rho0+rho0))
zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm) ) * umask(k%I,k%J,1)
END SELECT
......@@ -1039,6 +1065,7 @@ CONTAINS
zbnd2 = sec%ztem(jclass+1)
ENDIF
#if ! defined key_xios
!write volume transport per class
WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
jclass,classe,zbnd1,zbnd2,&
......@@ -1058,9 +1085,16 @@ CONTAINS
sec%transport(5,jclass)*1.e-9,sec%transport(6,jclass)*1.e-9,&
(sec%transport(5,jclass)+sec%transport(6,jclass))*1.e-9
ENDIF
#endif
ENDDO
#if defined key_xios
IF ( .NOT. l_istiled .OR. ntile == nijtile ) THEN
vol_transport(ksec) = zsumclasses(1)+zsumclasses(2)
salt_transport(ksec) = ( zsumclasses(5)+zsumclasses(6) )*1e-9
heat_transport(ksec) = ( zsumclasses(3)+zsumclasses(4) )*1e-15
ENDIF
#else
zbnd1 = 0._wp
zbnd2 = 0._wp
jclass=0
......@@ -1100,7 +1134,7 @@ CONTAINS
118 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3F12.4)
119 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6)
!
#endif
END SUBROUTINE dia_dct_wri
......@@ -1168,7 +1202,7 @@ CONTAINS
INTEGER, INTENT(IN) :: Kmm ! time level index
INTEGER, INTENT(IN) :: ki, kj, kk ! coordinate of point
CHARACTER(len=1), INTENT(IN) :: cd_point ! type of point (U, V)
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab ! variable to compute at (ki, kj, kk )
REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab ! variable to compute at (ki, kj, kk )
REAL(wp) :: interp ! interpolated variable
!*local declations
......
src/OCE/DIA/diadetide.F90
View file @ 672ff863
......@@ -5,6 +5,7 @@ MODULE diadetide
!!======================================================================
!! History : ! 2019 (S. Mueller)
!!----------------------------------------------------------------------
USE par_kind
USE par_oce , ONLY : wp, jpi, jpj
USE in_out_manager , ONLY : lwp, numout
USE iom , ONLY : iom_put
......
src/OCE/DIA/diahsb.F90
View file @ 672ff863
......@@ -40,17 +40,21 @@ MODULE diahsb
LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets
REAL(wp) :: surf_tot ! ocean surface
REAL(wp) :: frc_t, frc_s, frc_v ! global forcing trends
REAL(wp) :: frc_s! global forcing trends
REAL(dp) :: frc_t, frc_v! global forcing trends
REAL(wp) :: frc_wn_t, frc_wn_s ! global forcing trends
!
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini !
REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_ini!
REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini!
REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini !
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini !
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini!
REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: sc_loc_ini, e3t_ini!
REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_ini
!! * Substitutions
# include "domzgr_substitute.h90"
# include "single_precision_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: diahsb.F90 15062 2021-06-28 11:19:48Z jchanut $
......@@ -75,16 +79,16 @@ CONTAINS
INTEGER :: ji, jj, jk ! dummy loop indice
REAL(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations
REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - -
REAL(wp) :: zdiff_v1 , zdiff_v2 ! volume variation
REAL(dp) :: zdiff_v1 , zdiff_v2 ! volume variation
REAL(wp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit
REAL(wp) :: zvol_tot ! volume
REAL(wp) :: z_frc_trd_t , z_frc_trd_s ! - -
REAL(wp) :: z_frc_trd_v ! - -
REAL(dp) :: z_frc_trd_v ! - -
REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - -
REAL(wp) :: z_ssh_hc , z_ssh_sc ! - -
REAL(wp), DIMENSION(jpi,jpj,13) :: ztmp
REAL(wp), DIMENSION(jpi,jpj,jpkm1,4) :: ztmpk
REAL(wp), DIMENSION(17) :: zbg
REAL(dp), DIMENSION(jpi,jpj,13) :: ztmp
REAL(dp), DIMENSION(jpi,jpj,jpkm1,4) :: ztmpk
REAL(dp), DIMENSION(17) :: zbg
!!---------------------------------------------------------------------------
IF( ln_timing ) CALL timing_start('dia_hsb')
!
......
src/OCE/DIA/diahth.F90
View file @ 672ff863
......@@ -15,6 +15,7 @@ MODULE diahth
USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
USE zdfmxl, ONLY: zdf_mxl_zint
!
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
......@@ -292,6 +293,9 @@ CONTAINS
!
ENDIF
! Vertically-interpolated mixed-layer depth diagnostic
CALL zdf_mxl_zint( kt, Kmm )
!
IF( ln_timing ) CALL timing_stop('dia_hth')
!
......@@ -326,8 +330,8 @@ CONTAINS
iid = iktem(ji,jj)
IF( iid /= 1 ) THEN
zztmp = gdept(ji,jj,iid ,Kmm) & ! linear interpolation
& + ( gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm) ) &
& * ( 20.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm) ) &
& + ( gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm) ) &
& * ( ptem * tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm) ) &
& / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) )
pdept(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1) ! bound by the ocean depth
ELSE
......@@ -342,7 +346,7 @@ CONTAINS
!
INTEGER , INTENT(in) :: Kmm ! ocean time level index
REAL(wp), INTENT(in) :: pdep ! depth over the heat content
REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pt
REAL(dp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pt
REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc
!
INTEGER :: ji, jj, jk, ik
......
src/OCE/DIA/diamlr.F90
View file @ 672ff863
......@@ -5,7 +5,7 @@ MODULE diamlr
!!======================================================================
!! History : 4.0 ! 2019 (S. Mueller) Original code
!!----------------------------------------------------------------------
USE par_kind
USE par_oce , ONLY : wp, jpi, jpj
USE phycst , ONLY : rpi
USE dom_oce , ONLY : adatrj
......
src/OCE/DIA/dianam.F90
View file @ 672ff863
......@@ -19,6 +19,11 @@ MODULE dianam
IMPLICIT NONE
PRIVATE
INTEGER, PUBLIC :: nn_dctwri ! Frequency of output for dct diags
LOGICAL, PUBLIC :: ln_diadct = .FALSE. ! Calculate transport thru a section or not
! set to FALSE because some configs do not read it in nml
INTEGER, PUBLIC :: nb_sec ! nb of sections
PUBLIC dia_nam
!!----------------------------------------------------------------------
......@@ -60,8 +65,8 @@ CONTAINS
INTEGER :: inbday, inbmo, inbyr ! output frequency in days, months and years
INTEGER :: iyyss, iddss, ihhss, immss ! number of seconds in 1 year, 1 day, 1 hour and 1 minute
INTEGER :: iyymo ! number of months in 1 year
REAL(wp) :: zsec1, zsec2 ! not used
REAL(wp) :: zdrun, zjul ! temporary scalars
REAL(dp) :: zsec1, zsec2 ! not used
REAL(dp) :: zdrun, zjul ! temporary scalars
!!----------------------------------------------------------------------
! name for output frequency
......
src/OCE/DIA/diaprod.F90 0 → 100644
View file @ 672ff863
MODULE diaprod
! Requires key_iom_put
# if defined key_xios
!!======================================================================
!! *** MODULE diaprod ***
!! Ocean diagnostics : write ocean product diagnostics
!!=====================================================================
!! History : 3.4 ! 2012 (D. Storkey) Original code
!! 4.0 ! 2019 (D. Storkey)
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! dia_prod : calculate and write out product diagnostics
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain
USE domvvl ! for thickness weighted diagnostics if key_vvl
USE eosbn2 ! equation of state (eos call)
USE phycst ! physical constants
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
USE in_out_manager ! I/O manager
USE iom
USE ioipsl
USE lib_mpp ! MPP library
USE timing ! preformance summary
IMPLICIT NONE
PRIVATE
PUBLIC dia_prod ! routines called by step.F90
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OPA 3.4 , NEMO Consortium (2012)
!! $Id$
!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE dia_prod( kt, Kmm )
!!---------------------------------------------------------------------
!! *** ROUTINE dia_prod ***
!!
!! ** Purpose : Write out product diagnostics (uT, vS etc.)
!!
!! ** Method : use iom_put
!! Product diagnostics are not thickness-weighted in this routine.
!! They should be thickness-weighted using XIOS if key_vvl is set.
!!----------------------------------------------------------------------
!!
INTEGER, INTENT( in ) :: kt ! ocean time-step index
INTEGER, INTENT( in ) :: Kmm ! ocean time level index
!!
INTEGER :: ji, jj, jk ! dummy loop indices
REAL(wp) :: zztmp, zztmpx, zztmpy !
!!
REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace
REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace
REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhop ! potential density
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dia_prod')
!
ALLOCATE( z2d(jpi,jpj), z3d(jpi,jpj,jpk), zrhop(jpi,jpj,jpk) )
!
IF( iom_use("urhop") .OR. iom_use("vrhop") .OR. iom_use("wrhop") &
#if ! defined key_diaar5
& .OR. iom_use("rhop") &
#endif
& ) THEN
CALL eos( ts(:,:,:,:,Kmm), z3d, zrhop ) ! now in situ and potential density
zrhop(:,:,:) = zrhop(:,:,:)-1000.e0 ! reference potential density to 1000 to avoid precision issues in rhop2 calculation
zrhop(:,:,jpk) = 0._wp
#if ! defined key_diaar5
CALL iom_put( 'rhop', zrhop )
#else
! If key_diaar5 set then there is already an iom_put call to output rhop.
! Really should be a standard diagnostics option?
#endif
ENDIF
IF( iom_use("ut") ) THEN
z3d(:,:,:) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) )
END_3D
CALL iom_put( "ut", z3d ) ! product of temperature and zonal velocity at U points
ENDIF
IF( iom_use("vt") ) THEN
z3d(:,:,:) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) )
END_3D
CALL iom_put( "vt", z3d ) ! product of temperature and meridional velocity at V points
ENDIF
IF( iom_use("wt") ) THEN
z3d(:,:,:) = 0.e0
DO_2D( 0, 0, 0, 0 )
z3d(ji,jj,1) = ww(ji,jj,1) * ts(ji,jj,1,jp_tem,Kmm)
END_2D
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = ww(ji,jj,jk) * 0.5 * ( ts(ji,jj,jk-1,jp_tem,Kmm) + ts(ji,jj,jk,jp_tem,Kmm) )
END_3D
CALL iom_put( "wt", z3d ) ! product of temperature and vertical velocity at W points
ENDIF
IF( iom_use("us") ) THEN
z3d(:,:,:) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) )
END_3D
CALL iom_put( "us", z3d ) ! product of salinity and zonal velocity at U points
ENDIF
IF( iom_use("vs") ) THEN
z3d(:,:,:) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) )
END_3D
CALL iom_put( "vs", z3d ) ! product of salinity and meridional velocity at V points
ENDIF
IF( iom_use("ws") ) THEN
z3d(:,:,:) = 0.e0
DO_2D( 0, 0, 0, 0 )
z3d(ji,jj,1) = ww(ji,jj,1) * ts(ji,jj,1,jp_sal,Kmm)
END_2D
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = ww(ji,jj,jk) * 0.5 * ( ts(ji,jj,jk-1,jp_sal,Kmm) + ts(ji,jj,jk,jp_sal,Kmm) )
END_3D
CALL iom_put( "ws", z3d ) ! product of salinity and vertical velocity at W points
ENDIF
IF( iom_use("uv") ) THEN
z3d(:,:,:) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = 0.25 * ( uu(ji-1,jj,jk,Kmm) + uu(ji,jj,jk,Kmm) ) * ( vv(ji,jj-1,jk,Kmm) + vv(ji,jj,jk,Kmm) )
END_3D
CALL iom_put( "uv", z3d ) ! product of zonal velocity and meridional velocity at T points
ENDIF
IF( iom_use("uw") ) THEN
z3d(:,:,:) = 0.e0
DO_2D( 0, 0, 0, 0 )
z3d(ji,jj,1) = 0.5 * ( ww(ji,jj,1) + ww(ji+1,jj,1) ) * uu(ji,jj,1,Kmm)
END_2D
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = 0.25 * ( ww(ji,jj,jk) + ww(ji+1,jj,jk) ) * ( uu(ji,jj,jk-1,Kmm) + uu(ji,jj,jk,Kmm) )
END_3D
CALL iom_put( "uw", z3d ) ! product of zonal velocity and vertical velocity at UW points
ENDIF
IF( iom_use("vw") ) THEN
z3d(:,:,:) = 0.e0
DO_2D( 0, 0, 0, 0 )
z3d(ji,jj,1) = 0.5 * ( ww(ji,jj,1) + ww(ji,jj+1,1) ) * vv(ji,jj,1,Kmm)
END_2D
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = 0.25 * ( ww(ji,jj,jk) + ww(ji,jj+1,jk) ) * ( vv(ji,jj,jk-1,Kmm) + vv(ji,jj,jk,Kmm) )
END_3D
CALL iom_put( "vw", z3d ) ! product of meriodional velocity and vertical velocity at VW points
ENDIF
IF( iom_use("urhop") ) THEN
z3d(:,:,:) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji+1,jj,jk) )
END_3D
CALL iom_put( "urhop", z3d ) ! product of density and zonal velocity at U points
ENDIF
IF( iom_use("vrhop") ) THEN
z3d(:,:,:) = 0.e0
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( zrhop(ji,jj,jk) + zrhop(ji,jj+1,jk) )
END_3D
CALL iom_put( "vrhop", z3d ) ! product of density and meridional velocity at V points
ENDIF
IF( iom_use("wrhop") ) THEN
z3d(:,:,:) = 0.e0
DO_2D( 0, 0, 0, 0 )
z3d(ji,jj,1) = ww(ji,jj,1) * zrhop(ji,jj,1)
END_2D
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = ww(ji,jj,jk) * 0.5 * ( zrhop(ji,jj,jk-1) + zrhop(ji,jj,jk) )
END_3D
CALL iom_put( "wrhop", z3d ) ! product of density and vertical velocity at W points
ENDIF
!
DEALLOCATE( z2d, z3d, zrhop )
!
IF( ln_timing ) CALL timing_stop('dia_prod')
!
END SUBROUTINE dia_prod
#else
!!----------------------------------------------------------------------
!! Default option : NO diaprod
!!----------------------------------------------------------------------
LOGICAL, PUBLIC, PARAMETER :: lk_diaprod = .FALSE. ! coupled flag
CONTAINS
SUBROUTINE dia_prod( kt , Kmm) ! Empty routine
INTEGER :: kt, Kmm
!WRITE(*,*) 'dia_prod: You should not have seen this print! error?', kt
END SUBROUTINE dia_prod
#endif
!!======================================================================
END MODULE diaprod
src/OCE/DIA/diaptr.F90
View file @ 672ff863
......@@ -87,13 +87,14 @@ CONTAINS
IF( l_diaptr ) THEN
! Calculate zonal integrals
IF( PRESENT( pvtr ) ) THEN
CALL dia_ptr_zint( Kmm, pvtr )
CALL dia_ptr_zint( Kmm, pvtr)
ELSE
CALL dia_ptr_zint( Kmm )
ENDIF
! Calculate diagnostics only when zonal integrals have finished
IF( .NOT. l_istiled .OR. ntile == nijtile ) CALL dia_ptr_iom(kt, Kmm, pvtr)
ENDIF
IF( ln_timing ) CALL timing_stop('dia_ptr')
......
src/OCE/DIA/diawri.F90
View file @ 672ff863
......@@ -46,6 +46,7 @@ MODULE diawri
USE zdf_oce ! ocean vertical physics
USE zdfdrg ! ocean vertical physics: top/bottom friction
USE zdfmxl ! mixed layer
USE zdftke , ONLY: htau
USE zdfosm ! mixed layer
!
USE lbclnk ! ocean lateral boundary conditions (or mpp link)
......@@ -53,6 +54,7 @@ MODULE diawri
USE dia25h ! 25h Mean output
USE iom !
USE ioipsl !
USE eosbn2
#if defined key_si3
USE ice
......@@ -124,9 +126,33 @@ CONTAINS
REAL(wp):: ze3
REAL(wp), DIMENSION(A2D( 0)) :: z2d ! 2D workspace
REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: z3d ! 3D workspace
CHARACTER(len=4),SAVE :: ttype , stype ! temperature and salinity type
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('dia_wri')
!
IF( kt == nit000 ) THEN
IF( ln_TEOS10 ) THEN
IF ( iom_use("toce_pot") .OR. iom_use("soce_pra") .OR. iom_use("sst_pot") .OR. iom_use("sss_pra") &
& .OR. iom_use("sbt_pot") .OR. iom_use("sbs_pra") .OR. iom_use("sstgrad_pot") .OR. iom_use("sstgrad2_pot") &
& .OR. iom_use("tosmint_pot") .OR. iom_use("somint_pra")) THEN
CALL ctl_stop( 'diawri: potential temperature and practical salinity not available with ln_TEOS10' )
ELSE
ttype='con' ; stype='abs' ! teos-10 using conservative temperature and absolute salinity
ENDIF
ELSE IF ( ln_SEOS) THEN
ttype='seos' ; stype='seos' ! seos using Simplified Equation of state
ELSE
IF ( iom_use("toce_con") .OR. iom_use("soce_abs") .OR. iom_use("sst_con") .OR. iom_use("sss_abs") &
& .OR. iom_use("sbt_con") .OR. iom_use("sbs_abs") .OR. iom_use("sstgrad_con") .OR. iom_use("sstgrad2_con") &
& .OR. iom_use("tosmint_con") .OR. iom_use("somint_abs")) THEN
CALL ctl_stop( 'diawri: conservative temperature and absolute salinity not available with ln_EOS80' )
ELSE
ttype='pot' ; stype='pra' ! eos-80 using potential temperature and practical salinity
ENDIF
ENDIF
ENDIF
!
! Output the initial state and forcings
IF( ninist == 1 ) THEN
......@@ -207,25 +233,25 @@ CONTAINS
#endif
! --- tracers T&S --- !
CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) ) ! 3D temperature
CALL iom_put( "sst", ts(:,:,1,jp_tem,Kmm) ) ! surface temperature
CALL iom_put( "toce_"//ttype, ts(:,:,:,jp_tem,Kmm) ) ! 3D temperature
CALL iom_put( "sst_"//ttype, ts(:,:,1,jp_tem,Kmm) ) ! surface temperature
IF ( iom_use("sbt") ) THEN
IF ( iom_use("sbt_"//ttype) ) THEN
DO_2D( 0, 0, 0, 0 )
ikbot = mbkt(ji,jj)
z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm)
END_2D
CALL iom_put( "sbt", z2d ) ! bottom temperature
CALL iom_put( "sbt_"//ttype, z2d ) ! bottom temperature
ENDIF
CALL iom_put( "soce", ts(:,:,:,jp_sal,Kmm) ) ! 3D salinity
CALL iom_put( "sss", ts(:,:,1,jp_sal,Kmm) ) ! surface salinity
IF ( iom_use("sbs") ) THEN
CALL iom_put( "soce_"//stype, ts(:,:,:,jp_sal,Kmm) ) ! 3D salinity
CALL iom_put( "sss_"//stype, ts(:,:,1,jp_sal,Kmm) ) ! surface salinity
IF ( iom_use("sbs_"//stype) ) THEN
DO_2D( 0, 0, 0, 0 )
ikbot = mbkt(ji,jj)
z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm)
END_2D
CALL iom_put( "sbs", z2d ) ! bottom salinity
CALL iom_put( "sbs_"//stype, z2d ) ! bottom salinity
ENDIF
IF( .NOT.lk_SWE ) CALL iom_put( "rhop", rhop(:,:,:) ) ! 3D potential density (sigma0)
......@@ -295,6 +321,7 @@ CONTAINS
CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.
CALL iom_put( "avs" , avs ) ! S vert. eddy diff. coef.
CALL iom_put( "avm" , avm ) ! T vert. eddy visc. coef.
CALL iom_put( "htau" , htau ) ! htau scaling
IF( iom_use('logavt') ) CALL iom_put( "logavt", LOG( MAX( 1.e-20_wp, avt(:,:,:) ) ) )
IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) )
......@@ -316,7 +343,7 @@ CONTAINS
ENDIF
ENDIF
IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN
IF ( iom_use("sstgrad_"//ttype) .OR. iom_use("sstgrad2_"//ttype) ) THEN
DO_2D( 0, 0, 0, 0 ) ! sst gradient
zztmp = ts(ji,jj,1,jp_tem,Kmm)
zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj)
......@@ -324,12 +351,12 @@ CONTAINS
z2d(ji,jj) = 0.25_wp * ( zztmpx * zztmpx + zztmpy * zztmpy ) &
& * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * vmask(ji,jj-1,1)
END_2D
CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient
IF ( iom_use("sstgrad") ) THEN
CALL iom_put( "sstgrad2_"//ttype, z2d ) ! square of module of sst gradient
IF ( iom_use("sstgrad_"//ttype) ) THEN
DO_2D( 0, 0, 0, 0 )
z2d(ji,jj) = SQRT( z2d(ji,jj) )
END_2D
CALL iom_put( "sstgrad", z2d ) ! module of sst gradient
CALL iom_put( "sstgrad_"//ttype, z2d ) ! module of sst gradient
ENDIF
ENDIF
......@@ -456,19 +483,28 @@ CONTAINS
ENDIF
IF( iom_use("tosmint") ) THEN
IF( (.NOT.l_ldfeiv_time) .AND. ( iom_use('RossRad') .OR. iom_use('RossRadlim') &
& .OR. iom_use('Tclinic_recip') .OR. iom_use('RR_GS') &
& .OR. iom_use('aeiu_2d') .OR. iom_use('aeiv_2d') ) ) THEN
CALL ldf_eiv(kt, 75.0, z2d, z3d(:,:,1), Kmm)
CALL iom_put('aeiu_2d', z2d)
CALL iom_put('aeiv_2d', z3d(:,:,1))
ENDIF
IF( iom_use("tosmint_"//ttype) ) THEN
z2d(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)
END_3D
CALL iom_put( "tosmint", z2d ) ! Vertical integral of temperature
CALL iom_put( "tosmint_"//ttype, z2d ) ! Vertical integral of temperature
ENDIF
IF( iom_use("somint") ) THEN
IF( iom_use("somint_"//stype) ) THEN
z2d(:,:) = 0._wp
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm)
END_3D
CALL iom_put( "somint", z2d ) ! Vertical integral of salinity
CALL iom_put( "somint_"//stype, z2d ) ! Vertical integral of salinity
ENDIF
CALL iom_put( "bn2", rn2 ) ! Brunt-Vaisala buoyancy frequency (N^2)
......@@ -580,7 +616,7 @@ CONTAINS
INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers
INTEGER :: ipka ! ABL
INTEGER :: jn, ierror ! local integers
REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars
REAL(dp) :: zsto, zout, zmax, zjulian ! local scalars
!
REAL(wp), DIMENSION(jpi,jpj ) :: z2d ! 2D workspace
REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace
......
src/OCE/DIU/diu_bulk.F90
View file @ 672ff863
......@@ -96,9 +96,9 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: psolflux ! solar flux (Watts)
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: pqflux ! heat (non-solar) flux (Watts)
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: ptauflux ! wind stress (kg/ m s^2)
REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: prho ! water density (kg/m^3)
REAL(dp), DIMENSION(jpi,jpj) , INTENT(in) :: prho ! water density (kg/m^3)
REAL(wp) , INTENT(in) :: p_rdt ! time-step
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pLa ! Langmuir number
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pla ! Langmuir number
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pthick ! warm layer thickness (m)
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pcoolthick ! cool skin thickness (m)
REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: pmu ! mu parameter
......@@ -185,7 +185,7 @@ CONTAINS
REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: p_fla ! Langmuir number
REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pmu ! Structure parameter
REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: pthick ! Layer thickness
REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: prho ! Water density
REAL(dp), DIMENSION(jpi,jpj), INTENT(IN) :: prho ! Water density
! Local variables
REAL(wp) :: z_olength ! Obukhov length
......
src/OCE/DIU/diu_coolskin.F90
View file @ 672ff863
......@@ -79,7 +79,7 @@ MODULE diu_coolskin
! Dummy variables
REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psqflux ! Heat (non-solar)(Watts)
REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: pstauflux ! Wind stress (kg/ m s^2)
REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho ! Water density (kg/m^3)
REAL(dp), INTENT(IN), DIMENSION(jpi,jpj) :: psrho ! Water density (kg/m^3)
REAL(wp), INTENT(IN) :: pDt ! Time-step
! Local variables
......
src/OCE/DIU/solfrac_mod.F90
View file @ 672ff863
......@@ -51,6 +51,6 @@ CONTAINS
& - exp ( -pbottom / pp_len(jt) ) )
END DO
END FUNCTION
END FUNCTION solfrac
END MODULE solfrac_mod
src/OCE/DOM/closea.F90
View file @ 672ff863
......@@ -258,6 +258,6 @@ CONTAINS
ALLOCATE( kmask(jpi,jpj) , STAT=ierr )
IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array')
!
END SUBROUTINE
END SUBROUTINE alloc_csmask
END MODULE closea
src/OCE/DOM/daymod.F90
View file @ 672ff863
......@@ -68,7 +68,7 @@ CONTAINS
!! - nmonth_len, nyear_len, nmonth_beg through day_mth
!!----------------------------------------------------------------------
INTEGER :: inbday, imonday, isecrst ! local integers
REAL(wp) :: zjul ! local scalar
REAL(dp) :: zjul ! local scalar
!!----------------------------------------------------------------------
!
! max number of seconds between each restart
......@@ -93,7 +93,7 @@ CONTAINS
nminute = ( nn_time0 - nhour * 100 )
isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss)
CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday )
CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,dp), fjulday )
IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error
IF( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1. ! move back to the day at nit000 (and not at nit000 - 1)
......@@ -115,7 +115,8 @@ CONTAINS
nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
!compute number of days between last Monday and today
CALL ymds2ju( 1900, 01, 01, 0.0_wp, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday)
CALL ymds2ju( 1900, 01, 01, 0.0_dp, zjul ) ! compute julian day value of 01.01.1900 (our reference that was a Monday)
inbday = FLOOR(fjulday - zjul) ! compute nb day between 01.01.1900 and start of current day
imonday = MOD(inbday, 7) ! compute nb day between last monday and current day
IF (imonday .LT. 0) imonday = imonday + 7 ! Avoid negative values for dates before 01.01.1900
......@@ -198,7 +199,7 @@ CONTAINS
nmonth_beg(jm) = nmonth_beg(jm+1) - nsecd * nmonth_len(jm)
END DO
!
END SUBROUTINE
END SUBROUTINE day_mth
SUBROUTINE day( kt )
......@@ -220,7 +221,7 @@ CONTAINS
INTEGER, INTENT(in) :: kt ! ocean time-step indices
!
CHARACTER (len=25) :: charout
REAL(wp) :: zprec ! fraction of day corresponding to 0.1 second
REAL(dp) :: zprec ! fraction of day corresponding to 0.1 second
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('day')
......@@ -259,7 +260,7 @@ CONTAINS
ndastp = nyear * 10000 + nmonth * 100 + nday ! New date
!
!compute first day of the year in julian days
CALL ymds2ju( nyear, 01, 01, 0.0_wp, fjulstartyear )
CALL ymds2ju( nyear, 01, 01, 0.0_dp, fjulstartyear )
!
IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt, &
& ' New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year
......@@ -310,7 +311,7 @@ CONTAINS
INTEGER , INTENT(in) :: kt ! ocean time-step
CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
!
REAL(wp) :: zkt, zndastp, zdayfrac, ksecs, ktime
REAL(dp) :: zkt, zndastp, zdayfrac, ksecs, ktime
INTEGER :: ihour, iminute, isecond
!!----------------------------------------------------------------------
......