diff --git a/src/2d/m2d.F90 b/src/2d/m2d.F90 index 6866a7d613d07f12581fc970612e5d3f90240cc7..e25bad2534d616c1c0185270cd4d67b24c794881 100644 --- a/src/2d/m2d.F90 +++ b/src/2d/m2d.F90 @@ -140,7 +140,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, & @@ -405,8 +404,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(zo,z,D,Dvel,DU,DV) diff --git a/src/2d/variables_2d.F90 b/src/2d/variables_2d.F90 index d08b4f3f13d49b09ce6c36d56afb0e1fc97c98d3..c78e68d8c5ff6cdffcfe7e48849ef0568f3e0331 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_) REALTYPE,dimension(:,:),pointer :: zo,z #ifdef STATIC @@ -94,7 +95,6 @@ ! ! !LOCAL VARIABLES: integer :: rc - integer,parameter :: rk = kind(_ONE_) !EOP !------------------------------------------------------------------------- !BOC @@ -119,7 +119,7 @@ break_stat = 0 #endif - z = -9999*_ONE_; zo =_ZERO_ + z = -9999._rk ; zo =_ZERO_ zub=_ZERO_ ; zub0=_ZERO_ zvb=_ZERO_ ; zvb0=_ZERO_ @@ -174,7 +174,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 700356b6c50ee245abb6d51773adba0c3c90c875..0b2b268f66b3c2d445a055ba77610803774eea7f 100644 --- a/src/3d/coordinates.F90 +++ b/src/3d/coordinates.F90 @@ -104,9 +104,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 1406af1b4dcdc276d98e290710a96992dfafaaf5..dc10bf3078f60fa0de9e8e0423aa761fd32c87f1 100644 --- a/src/3d/m3d.F90 +++ b/src/3d/m3d.F90 @@ -400,8 +400,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 415ea4b7d97876853b54dcc832144cfca1029c0e..25ac76626983453baf74d1c995571bc47ea5b770 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 1a85914e605e4b157843044a0f4fe4f5928b822d..3805a4f18d2cfe4e0c7014b08aefaf8e7088db55 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)