diff --git a/src/2d/m2d.F90 b/src/2d/m2d.F90 index c3b94c28b441443a208f899efa05037f9fd38c9e..0cf042f0713fb4024b3c287c5ecb47362c8ea06d 100644 --- a/src/2d/m2d.F90 +++ b/src/2d/m2d.F90 @@ -131,7 +131,6 @@ integer :: i,j integer :: elev_method=1 REALTYPE :: elev_const=_ZERO_ - integer,parameter :: rk = kind(_ONE_) character(LEN = PATH_MAX) :: elev_file='elev.nc' namelist /m2d/ & elev_method,elev_const,elev_file, & @@ -392,8 +391,8 @@ ! This is only needed for proper flexible output where (az .eq. 0) - z = -9999.0d0 - zo = -9999.0d0 + z = -9999._rk + zo = -9999._rk end where call depth_update() diff --git a/src/2d/variables_2d.F90 b/src/2d/variables_2d.F90 index c0ab8e64d1a6b4319d70f90207d5bd654fa7856f..70197cbe2f56db4beeb8ac502825373cd733ace2 100644 --- a/src/2d/variables_2d.F90 +++ b/src/2d/variables_2d.F90 @@ -22,6 +22,7 @@ IMPLICIT NONE ! ! !PUBLIC DATA MEMBERS: + integer, parameter :: rk = kind(_ONE_) #ifdef STATIC #include "static_2d.h" #else @@ -92,7 +93,6 @@ ! ! !LOCAL VARIABLES: integer :: rc - integer,parameter :: rk = kind(_ONE_) !EOP !------------------------------------------------------------------------- !BOC @@ -115,7 +115,7 @@ break_stat = 0 #endif - z = -9999*_ONE_; zo =_ZERO_ + z = -9999._rk ; zo =_ZERO_ zub=_ZERO_ ; zub0=_ZERO_ zvb=_ZERO_ ; zvb0=_ZERO_ @@ -170,7 +170,6 @@ ! ! !LOCAL VARIABLES: logical :: used - integer,parameter :: rk = kind(_ONE_) !EOP !----------------------------------------------------------------------- !BOC diff --git a/src/3d/coordinates.F90 b/src/3d/coordinates.F90 index 3b189183c6d479ecb0f9fa2249a0a30592a4ba05..e1de3313f65bec483ae9cb4c786b90de573e4a2e 100644 --- a/src/3d/coordinates.F90 +++ b/src/3d/coordinates.F90 @@ -101,9 +101,9 @@ stop ! calculate the z-coordinate of the cell centers ! references to mean sea level zc(:,:,0)=-H(:,:) - zc(:,:,1)=-H(:,:) + 0.5*hn(:,:,1) + zc(:,:,1)=-H(:,:) + _HALF_*hn(:,:,1) do k=2,kmax - zc(:,:,k)=zc(:,:,k-1)+0.5*(hn(:,:,k-1)+hn(:,:,k)) + zc(:,:,k)=zc(:,:,k-1)+_HALF_*(hn(:,:,k-1)+hn(:,:,k)) end do #ifdef SLICE_MODEL diff --git a/src/3d/m3d.F90 b/src/3d/m3d.F90 index 11a0b695232848e4081c8b63d19ea31d6eb8da78..d46e8628e4fa8459bf93bebb7a03c30953f716d0 100644 --- a/src/3d/m3d.F90 +++ b/src/3d/m3d.F90 @@ -397,8 +397,8 @@ num(i,j,:) = 1.e-15 nuh(i,j,:) = 1.e-15 #ifndef NO_BAROCLINIC - S(i,j,:) = -9999.0 - T(i,j,:) = -9999.0 + S(i,j,:) = -9999._rk + T(i,j,:) = -9999._rk #endif end if end do diff --git a/src/3d/salinity.F90 b/src/3d/salinity.F90 index a383cb8d378c7ba1a0a9a86eeaa9fa08818e63af..92c8712df6b7acd827fcbdbbeedd2a14ad3a9de6 100644 --- a/src/3d/salinity.F90 +++ b/src/3d/salinity.F90 @@ -20,7 +20,7 @@ use domain, only: H,az !KB use get_field, only: get_3d_field use variables_2d, only: fwf_int - use variables_3d, only: S,hn,kmin + use variables_3d, only: rk,S,hn,kmin use halo_zones, only: update_3d_halo,wait_halo,D_TAG,H_TAG IMPLICIT NONE ! @@ -201,8 +201,8 @@ stop 'init_salinity' end select - S(:,:,0) = -9999*_ONE_ - forall(i=imin:imax,j=jmin:jmax, az(i,j).eq.0) S(i,j,:) = -9999*_ONE_ + S(:,:,0) = -9999._rk + forall(i=imin:imax,j=jmin:jmax, az(i,j).eq.0) S(i,j,:) = -9999._rk call update_3d_halo(S,S,az,imin,jmin,imax,jmax,kmax,D_TAG) call wait_halo(D_TAG) diff --git a/src/3d/temperature.F90 b/src/3d/temperature.F90 index 8656f9b05595b2c2f21462047e1f7a4f4e4c3255..c5ac3f4eba6e48b51e13ee7822e5d410f6fd62a6 100644 --- a/src/3d/temperature.F90 +++ b/src/3d/temperature.F90 @@ -21,7 +21,7 @@ use domain, only: ill,ihl,jll,jhl use domain, only: ilg,ihg,jlg,jhg !KB use get_field, only: get_3d_field - use variables_3d, only: T,rad,hn,kmin,A,g1,g2 + use variables_3d, only: rk,T,rad,hn,kmin,A,g1,g2 use halo_zones, only: update_3d_halo,wait_halo,D_TAG,H_TAG IMPLICIT NONE ! @@ -279,8 +279,8 @@ end interface stop 'init_temperature' end select - T(:,:,0) = -9999*_ONE_ - forall(i=imin:imax,j=jmin:jmax, az(i,j).eq.0) T(i,j,:) = -9999*_ONE_ + T(:,:,0) = -9999._rk + forall(i=imin:imax,j=jmin:jmax, az(i,j).eq.0) T(i,j,:) = -9999._rk call update_3d_halo(T,T,az,imin,jmin,imax,jmax,kmax,D_TAG) call wait_halo(D_TAG) diff --git a/src/3d/variables_3d.F90 b/src/3d/variables_3d.F90 index 7c4c83f1d84ff9bac155d9eb7d19ef3f884588b0..3d7715e837b55011f84a3675a9135861dbc9dff1 100644 --- a/src/3d/variables_3d.F90 +++ b/src/3d/variables_3d.F90 @@ -116,6 +116,7 @@ IMPLICIT NONE ! ! !PUBLIC DATA MEMBERS: + integer, parameter :: rk = kind(_ONE_) REALTYPE :: dt,cnpar=0.9 REALTYPE :: avmback=_ZERO_,avhback=_ZERO_ logical :: do_numerical_analyses=.false. @@ -173,7 +174,6 @@ ! ! !LOCAL VARIABLES: integer :: rc - integer,parameter :: rk = kind(_ONE_) !EOP !------------------------------------------------------------------------- !BOC @@ -219,8 +219,8 @@ #endif ! must be nonzero for gotm_fabm in case of calc_temp=F - g1 = -9999*_ONE_ - g2 = -9999*_ONE_ + g1 = -9999._rk + g2 = -9999._rk #ifdef DEBUG write(debug,*) 'Leaving init_variables_3d()' @@ -253,7 +253,7 @@ ! Original author(s): Karsten Bolding & Jorn Bruggeman ! ! !LOCAL VARIABLES: - integer,parameter :: rk = kind(_ONE_) +! !EOP !----------------------------------------------------------------------- !BOC diff --git a/src/getm/initialise.F90 b/src/getm/initialise.F90 index 4b4484e3760fc0c84dbb06c973ce79d6ba4fbd65..9e5eef256e639093a80d66483008c4073d0fc068 100644 --- a/src/getm/initialise.F90 +++ b/src/getm/initialise.F90 @@ -350,6 +350,8 @@ #endif end if + call finalize_register_all_variables(runtype) + if (.not. dryrun) then if (save_initial) then call output_manager_prepare_save(julianday, int(secondsofday), 0, int(MinN-1)) diff --git a/src/getm/register_all_variables.F90 b/src/getm/register_all_variables.F90 index a4b65501292c7689f26849b1fff32fc5c2ba7fb0..937c573abfa6c5dd12fdf3174f6f45d17b9bc4c8 100644 --- a/src/getm/register_all_variables.F90 +++ b/src/getm/register_all_variables.F90 @@ -16,7 +16,7 @@ #ifdef _FABM_ use getm_fabm, only: register_fabm_variables #endif - use output_processing, only: register_processed_variables + use output_processing, only: register_processed_variables, finalize_register_processed_variables IMPLICIT NONE ! ! default: all is private. @@ -359,6 +359,8 @@ !BOC LEVEL1 'finalize_register_all_variables()' + call finalize_register_processed_variables(fm) + return end subroutine finalize_register_all_variables !EOC diff --git a/src/output/output_processing.F90 b/src/output/output_processing.F90 index 76fdb744080c317aeff70089f5d84f8bf6d53cad..1029d7f445375e19843b380374f9cc5944eed232 100644 --- a/src/output/output_processing.F90 +++ b/src/output/output_processing.F90 @@ -18,18 +18,22 @@ private ! ! !PUBLIC DATA FUNCTIONS: - public init_output_processing, register_processed_variables, do_output_processing + public init_output_processing, do_output_processing + public register_processed_variables, finalize_register_processed_variables ! ! !PUBLIC DATA MEMBERS: +! +! !PRIVATE DATA MEMBERS: REALTYPE, dimension(:,:), allocatable, target :: u2d, v2d - REALTYPE, dimension(:,:), allocatable, target :: u2d_destag, v2d_destag REALTYPE, dimension(:,:,:), allocatable, target :: u3d, v3d + REALTYPE, dimension(:,:), allocatable, target :: u2d_destag, v2d_destag REALTYPE, dimension(:,:,:), allocatable, target :: u3d_destag, v3d_destag -! -! !PRIVATE DATA MEMBERS: - logical, target:: u2d_use, v2d_use + + logical :: u2d_used, v2d_used + logical :: u3d_used, v3d_used + logical, target :: u2d_now, v2d_now + logical, target :: u3d_now, v3d_now logical, target:: u2d_destag_use, v2d_destag_use - logical, target:: u3d_use, v3d_use logical, target:: u3d_destag_use, v3d_destag_use integer, parameter :: rk = kind(_ONE_) ! @@ -65,12 +69,7 @@ !EOP !------------------------------------------------------------------------- !BOC - allocate(u2d(E2DFIELD),stat=rc) - if (rc /= 0) stop 'init_output_processing: Error allocating memory (u2d)' - u2d = 0._rk - allocate(v2d(E2DFIELD),stat=rc) - if (rc /= 0) stop 'init_output_processing: Error allocating memory (v2d)' - v2d = 0._rk + allocate(u2d_destag(E2DFIELD),stat=rc) if (rc /= 0) stop 'init_output_processing: Error allocating memory (u2d_destag)' u2d_destag = 0._rk @@ -79,10 +78,6 @@ v2d_destag = 0._rk #if 0 - allocate(u3d(I3DFIELD),stat=rc) - if (rc /= 0) stop 'init_output_processing: Error allocating memory (u3d)' - allocate(v3d(I3DFIELD),stat=rc) - if (rc /= 0) stop 'init_output_processing: Error allocating memory (v3d)' allocate(u3d_destag(I3DFIELD),stat=rc) if (rc /= 0) stop 'init_output_processing: Error allocating memory (u3d_destag)' allocate(v3d_destag(I3DFIELD),stat=rc) @@ -117,8 +112,15 @@ !BOC LEVEL2 'register_processed_variables()' - call fm%register('u2d', 'm/s', 'velocity in local x-direction', standard_name='', data2d=u2d(_2D_W_), fill_value=-9999._rk, category='velocities', used_now=u2d_use) - call fm%register('v2d', 'm/s', 'velocity in local y-direction', standard_name='', data2d=v2d(_2D_W_), fill_value=-9999._rk, category='velocities', used_now=v2d_use) + call fm%register('u2d', 'm/s', 'velocity in local x-direction', standard_name='', fill_value=-9999._rk, category='velocities', output_level=output_level_debug, used=u2d_used, used_now=u2d_now) + call fm%register('v2d', 'm/s', 'velocity in local y-direction', standard_name='', fill_value=-9999._rk, category='velocities', output_level=output_level_debug, used=v2d_used, used_now=v2d_now) + +#ifndef NO_3D + call fm%register('u3d', 'm/s', 'velocity in local x-direction (3D)', standard_name='', dimensions=(/id_dim_z/), fill_value=-9999._rk, category='velocities', output_level=output_level_debug, used=u3d_used, used_now=u3d_now) + call fm%register('v3d', 'm/s', 'velocity in local y-direction (3D)', standard_name='', dimensions=(/id_dim_z/), fill_value=-9999._rk, category='velocities', output_level=output_level_debug, used=v3d_used, used_now=v3d_now) +#endif + + call fm%register('u2d-destag', 'm/s', 'velocity in local x-direction(destag)', standard_name='', data2d=u2d_destag(_2D_W_), fill_value=-9999._rk, category='velocities',output_level=output_level_debug, used_now=u2d_destag_use) call fm%register('v2d-destag', 'm/s', 'velocity in local y-direction(destag)', standard_name='', data2d=v2d_destag(_2D_W_), fill_value=-9999._rk, category='velocities',output_level=output_level_debug, used_now=v2d_destag_use) @@ -126,6 +128,67 @@ end subroutine register_processed_variables !EOC +!----------------------------------------------------------------------- +!BOP +! +! !ROUTINE: finalize_register_processed_variables() - send optional variables. +! +! !INTERFACE: + subroutine finalize_register_processed_variables(fm) +! +! !DESCRIPTION: +! +! !USES: + use field_manager + IMPLICIT NONE +! +! !INPUT PARAMETERS: + type (type_field_manager) :: fm +! +! !REVISION HISTORY: +! Original author(s): Knut Klingbeil +! +! !LOCAL VARIABLES: + integer :: rc +!EOP +!----------------------------------------------------------------------- +!BOC + LEVEL1 'finalize_register_processed_variables()' + + if (u2d_used) then + allocate(u2d(E2DFIELD),stat=rc) + if (rc /= 0) stop 'finalize_register_processed_variables: Error allocating memory (u2d)' + u2d = 0._rk + call fm%send_data('u2d', u2d(_2D_W_)) + end if + + if (v2d_used) then + allocate(v2d(E2DFIELD),stat=rc) + if (rc /= 0) stop 'finalize_register_processed_variables: Error allocating memory (v2d)' + v2d = 0._rk + call fm%send_data('v2d', v2d(_2D_W_)) + end if + +#ifndef NO_3D + if (u3d_used) then + allocate(u3d(I3DFIELD),stat=rc) + if (rc /= 0) stop 'finalize_register_processed_variables: Error allocating memory (u3d)' + u3d = 0._rk + call fm%send_data('u3d', u3d(_3D_W_)) + end if + + if (v3d_used) then + allocate(v3d(I3DFIELD),stat=rc) + if (rc /= 0) stop 'finalize_register_processed_variables: Error allocating memory (v3d)' + v3d = 0._rk + call fm%send_data('v3d', v3d(_3D_W_)) + end if +#endif + + return + end subroutine finalize_register_processed_variables +!EOC + !----------------------------------------------------------------------- !BOP ! !IROUTINE: do_output_processing - read required variables @@ -137,7 +200,9 @@ use domain, only: az, au, av use variables_2d, only: z,D use variables_2d, only: U,V,DU,DV +#ifndef NO_3D use variables_3d, only: kmin,hn,uu,hun,vv,hvn +#endif IMPLICIT NONE ! ! !DESCRIPTION: @@ -154,29 +219,40 @@ !BOC ! 2D - velocities - if (u2d_use .and. v2d_use) then + + if (u2d_now) then call to_2d_vel(imin,jmin,imax,jmax,au,U,DU,vel_missing, & imin,jmin,imax,jmax,u2d) + end if + + if (v2d_now) then call to_2d_vel(imin,jmin,imax,jmax,av,V,DV,vel_missing, & imin,jmin,imax,jmax,v2d) end if - if (u2d_destag_use .and. v2d_destag_use) then - call to_2d_u(imin,jmin,imax,jmax,az,U,DU,vel_missing, & - imin,jmin,imax,jmax,u2d_destag) - call to_2d_v(imin,jmin,imax,jmax,az,V,DV,vel_missing, & - imin,jmin,imax,jmax,v2d_destag) - end if -#if 0 ! 3D - velocities #ifndef NO_3D - if (allocated(u3d) .and. allocated(v3d)) then + if (u3d_now) then call to_3d_uu(imin,jmin,imax,jmax,kmin,kmax,az, & hun,uu,vel_missing,u3d) + end if + + if (v3d_now) then call to_3d_vv (imin,jmin,imax,jmax,kmin,kmax,az, & hvn,vv,vel_missing,v3d) end if +#endif + + + if (u2d_destag_use .and. v2d_destag_use) then + call to_2d_u(imin,jmin,imax,jmax,az,U,DU,vel_missing, & + imin,jmin,imax,jmax,u2d_destag) + call to_2d_v(imin,jmin,imax,jmax,az,V,DV,vel_missing, & + imin,jmin,imax,jmax,v2d_destag) + end if +#if 0 +#ifndef NO_3D if (allocated(u3d_destag) .and. allocated(v3d_destag)) then call to_3d_vel(imin,jmin,imax,jmax,kmin,kmax,au, & hun,uu,vel_missing,u3d_destag)